diff --git a/console/.gitignore b/console/.gitignore
new file mode 100644
index 00000000..1caa3545
--- /dev/null
+++ b/console/.gitignore
@@ -0,0 +1,10 @@
+/.cache
+/.spago
+/node_modules/
+/output/
+/dist/
+/generated-docs/
+/.psc-package/
+/.psc*
+/.purs*
+/.psa*
diff --git a/console/html/console.css b/console/html/console.css
new file mode 100644
index 00000000..7fdeafd3
--- /dev/null
+++ b/console/html/console.css
@@ -0,0 +1,5 @@
+#user {
+ position: fixed;
+ z-index: 2;
+ right: 70px;
+}
diff --git a/console/html/index.css b/console/html/index.css
new file mode 100644
index 00000000..c995163a
--- /dev/null
+++ b/console/html/index.css
@@ -0,0 +1,3 @@
+@import "@statebox/style/style.min.css";
+
+@import "./console.css";
diff --git a/console/html/index.html b/console/html/index.html
new file mode 100644
index 00000000..90d2693f
--- /dev/null
+++ b/console/html/index.html
@@ -0,0 +1,23 @@
+
+
+
+
+ Statebox Cloud Console
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
+
diff --git a/console/html/index.js b/console/html/index.js
new file mode 100644
index 00000000..561e611f
--- /dev/null
+++ b/console/html/index.js
@@ -0,0 +1,63 @@
+var Main = require("../output/index.js")
+
+////////////////////////////////////////////////////////////////////////////////
+//
+// initialise Firebase
+//
+////////////////////////////////////////////////////////////////////////////////
+
+var firebaseConfig = {
+ apiKey: "AIzaSyAhl4uChdRK_yXiYybtXfqG6uUEk1hAB9A",
+ authDomain: "statebox-kdmoncat.firebaseapp.com",
+ databaseURL: "https://statebox-kdmoncat.firebaseio.com",
+ projectId: "statebox-kdmoncat",
+ storageBucket: "statebox-kdmoncat.appspot.com",
+ messagingSenderId: "455902306352",
+ appId: "1:455902306352:web:6fcdfeb29f583d118d0df5",
+ measurementId: "G-9FF747MDHW"
+}
+
+let firebase = window.firebase
+
+firebase.initializeApp(firebaseConfig)
+firebase.analytics()
+var db = firebase.firestore()
+
+firebase.auth().setPersistence(firebase.auth.Auth.Persistence.LOCAL)
+
+var ui = new firebaseui.auth.AuthUI(firebase.auth())
+var uiConfig = {
+ credentialHelper: firebaseui.auth.CredentialHelper.NONE,
+ signInFlow: 'popup', // use popup for IDP Providers sign-in flow instead of the default, redirect
+ signInOptions: [
+ firebase.auth.EmailAuthProvider.PROVIDER_ID,
+ ],
+}
+
+var loggedIn = false
+firebase.auth().onAuthStateChanged(function (user) {
+ if (user) {
+ start(user)
+ loggedIn = true
+ } else {
+ console.log("firebase auth: not logged in.")
+ if (!loggedIn) {
+ ui.start('#firebaseui-auth-container', uiConfig)
+ } else {
+ location.reload()
+ }
+ }
+})
+
+function start (user) {
+ console.log('user =', user)
+ document.getElementById('email').innerText = user && user.email || ""
+ document.getElementById('firebaseui-auth-container').style.display = 'none'
+
+ console.log("firebase auth: logged in.")
+
+ Main.main()
+ document.getElementById('sign-out').onclick = function () {
+ firebase.auth().signOut()
+ }
+}
diff --git a/console/package.json b/console/package.json
new file mode 100644
index 00000000..3844c5e5
--- /dev/null
+++ b/console/package.json
@@ -0,0 +1,38 @@
+{
+ "name": "stbx-cloud-console",
+ "version": "1.0.0",
+ "description": "Statebox Cloud Admin Console",
+ "main": "index.js",
+ "directories": {
+ "test": "test"
+ },
+ "scripts": {
+ "postinstall": "spago install",
+ "start": "npm run build && concurrently --kill-others --handle-input npm:watch npm:serve",
+ "build": "spago bundle-module --main Statebox.Console.Main --to output/index.js --purs-args --censor-codes=ImplicitImport,ImplicitQualifiedImport,HidingImport",
+ "watch": "spago bundle-module --main Statebox.Console.Main --to output/index.js --watch --purs-args --censor-codes=ImplicitImport,ImplicitQualifiedImport,HidingImport",
+ "test": "spago test",
+ "docs": "spago docs",
+ "repl": "spago repl",
+ "serve": "parcel html/index.html",
+ "bundle": "npm run build && rm -rf dist && parcel build html/index.html --public-url . --no-source-maps"
+ },
+ "keywords": [
+ "statebox"
+ ],
+ "author": "Erik Post ",
+ "license": "Commercial",
+ "devDependencies": {
+ "concurrently": "^5.0.2",
+ "parcel-bundler": "^1.12.4",
+ "purescript": "^0.13.8",
+ "purescript-psa": "^0.7.3",
+ "spago": "^0.15.2"
+ },
+ "dependencies": {
+ "@statebox/stbx-js": "0.0.31",
+ "@statebox/style": "0.0.9",
+ "dagre": "^0.8.4",
+ "firebaseui": "^4.5.0"
+ }
+}
diff --git a/console/spago.dhall b/console/spago.dhall
new file mode 100644
index 00000000..e6ce4e0b
--- /dev/null
+++ b/console/spago.dhall
@@ -0,0 +1,19 @@
+{ name =
+ "stbx-cloud-console"
+, dependencies =
+ [ "affjax"
+ , "argonaut"
+ , "argonaut-codecs"
+ , "console"
+ , "debug"
+ , "effect"
+ , "halogen"
+ , "psci-support"
+ , "routing"
+ , "routing-duplex"
+ ]
+, packages =
+ ../packages.dhall
+, sources =
+ [ "src/**/*.purs", "test/**/*.purs" ]
+}
diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs
new file mode 100644
index 00000000..881e5044
--- /dev/null
+++ b/console/src/Statebox/Console.purs
@@ -0,0 +1,573 @@
+module Statebox.Console where
+
+import Prelude
+import Data.Array (cons, filter)
+import Data.Either (either)
+import Data.Generic.Rep
+import Data.Lens
+import Data.Lens.Record (prop)
+import Data.Symbol (SProxy(..))
+import Data.Foldable (fold, foldMap)
+import Data.Map as Map
+import Data.Map (Map)
+import Data.Maybe (Maybe(..), maybe, fromMaybe)
+import Data.Tuple.Nested ((/\))
+import Effect.Aff.Class (class MonadAff)
+import Effect.Console (log)
+import Halogen as H
+import Halogen (ComponentHTML)
+import Halogen.HTML (HTML, a, p, text, br, span, div, ul, li, h2, h3, h4, nav, table, tr, th, td, button)
+import Halogen.HTML.Core (ClassName(..))
+import Halogen.HTML.Properties (classes)
+import Halogen.HTML.Events (onClick, onValueInput)
+import Halogen.Query.HalogenM (HalogenM)
+
+import Statebox.Console.DAO as DAO
+
+import Stripe as Stripe
+
+import Debug.Trace (spy)
+
+-- TODO
+fakeCustomerId = "TODO"
+
+type RootId = String -- TODO get from stbx-core
+type TxHash = Hex -- TODO get from stbx-core
+type Hex = String -- TODO get from stbx-core
+
+--------------------------------------------------------------------------------
+
+type ApiKey =
+ { name :: String
+ , hex :: Hex
+ , billingAccount :: Maybe BillingAccount
+ }
+
+type BillingAccount = Unit -- TODO tentative
+
+--------------------------------------------------------------------------------
+
+-- | projects are collections of root-transactions and are used to manage the public keys associated to those.
+type Project =
+ { name :: String
+ , rootTransactions :: Array TxHash
+ }
+
+type ProjectId = String
+
+--------------------------------------------------------------------------------
+
+type TxPubInfo =
+ { name :: String -- TODO seems redundant if we have the hash
+ , message :: String -- TODO seems redundant if we have the hash
+ , hash :: TxHash
+ , key :: Unit -- TODO is this the key of a genesis tx?
+ }
+
+--------------------------------------------------------------------------------
+
+type State =
+ { route :: Route
+ , customer :: Maybe Stripe.Customer
+ , paymentMethods :: Array Stripe.PaymentMethod
+ , subscriptions :: Array Stripe.Subscription
+ , plans :: Array Stripe.PlanWithExpandedProduct
+ , accounts :: Array { invoices :: Array Stripe.Invoice
+ }
+ , projects :: Map ProjectId Project
+ , apiKeys :: Array ApiKey
+ , rootTransactions :: Array TxHash
+ , status :: AppStatus
+ }
+
+_accounts = prop (SProxy :: SProxy "accounts")
+_invoices = prop (SProxy :: SProxy "invoices")
+
+--------------------------------------------------------------------------------
+
+data Route
+ = Home
+ | Projects
+ | ProjectR ProjectId
+ | APIKeys
+ | RootTx
+ | Invoices Stripe.CustomerId
+ | Account Stripe.CustomerId
+ | Subscription
+ | Plan
+
+derive instance eqRoute :: Eq Route
+derive instance ordRoute :: Ord Route
+derive instance genericRoute :: Generic Route _
+
+--------------------------------------------------------------------------------
+
+data AppStatus = Ok | ErrorStatus String
+
+derive instance eqAppStatus :: Eq AppStatus
+
+instance showAppStatus :: Show AppStatus where
+ show = case _ of
+ Ok -> "Ok"
+ ErrorStatus x -> "(ErrorStatus " <> x <> ")"
+
+type Input = State
+
+data Action
+ = SelectRoute Route
+
+ | CreateRootTx
+ | PublishRootTx TxPubInfo
+
+ | CreateApiKey
+ | DeprecateApiKey ApiKey
+ | AssociateApiKeyWithProject ApiKey ProjectId
+ | AssociateApiKeyWithRoot ApiKey RootId
+
+ | FetchStuff
+
+data Query a
+ = DoAction Action a
+
+type ChildSlots = ()
+
+ui :: ∀ m. MonadAff m => H.Component HTML Query Input Void m
+ui =
+ H.mkComponent
+ { initialState: mkInitialState
+ , eval: H.mkEval $ H.defaultEval { handleAction = handleAction, handleQuery = handleQuery }
+ , render: render
+ }
+
+mkInitialState :: Input -> State
+mkInitialState input = input
+
+handleQuery = case _ of
+ DoAction x next -> do
+ handleAction x
+ pure (Just next)
+
+ -- NavigateTo newRoute next -> do
+ -- H.modify_ $ \state -> state -- { route = newRoute }
+ -- pure (Just next)
+
+handleAction :: ∀ m. MonadAff m => Action -> HalogenM State Action ChildSlots Void m Unit
+handleAction = case _ of
+
+ -- NavigateTo newRoute ->
+ -- H.modify_ $ \state -> state { route = newRoute }
+
+ SelectRoute newRoute -> do
+ H.modify_ \state -> state { route = newRoute }
+
+ CreateRootTx -> do
+ H.modify_ $ _ { status = ErrorStatus "Create root transaction." }
+
+ PublishRootTx txPubInfo -> do
+ H.modify_ $ \state -> state { status = ErrorStatus "Publish root transaction."
+ , rootTransactions = txPubInfo.hash `cons` state.rootTransactions
+ }
+
+ CreateApiKey -> do
+ H.modify_ $ _ { status = ErrorStatus "Create API key." }
+
+ AssociateApiKeyWithProject apiKey projectId -> do
+ H.modify_ $ _ { status = ErrorStatus $ "Associate API Key '" <> apiKey.name <> "' (hex: " <> apiKey.hex <> ") with project " <> projectId <> "." }
+
+ AssociateApiKeyWithRoot apiKey rootTxId -> do
+ H.modify_ $ _ { status = ErrorStatus $ "Associate API Key '" <> apiKey.name <> "' (hex: " <> apiKey.hex <> ") with root transaction " <> rootTxId <> "." }
+
+ DeprecateApiKey apiKey -> do
+ H.modify_ $ \state -> state { status = ErrorStatus $ "Successfully deprecated API key '" <> apiKey.name <> "'."
+ , apiKeys = filter (\k -> k /= apiKey) state.apiKeys
+ }
+
+ FetchStuff -> do
+ H.liftEffect $ log "handling action FetchStuff..."
+
+ -- fetch the customer
+ customerEE <- H.liftAff $ DAO.fetchCustomer
+ customerEE # either (\e -> H.modify_ $ _ { customer = Nothing, status = ErrorStatus "Failed to fetch customer." })
+ (either (\e -> H.modify_ $ _ { customer = Nothing, status = ErrorStatus "Decoding customer failed."})
+ (\x -> H.modify_ $ _ { customer = Just x }))
+ spyM "customerEE" $ customerEE
+
+ -- fetch some invoices for the customer
+ invoicesEE <- H.liftAff $ DAO.listInvoices
+ invoicesEE # either (\e -> H.modify_ $ _ { status = ErrorStatus "Failed to fetch invoices." })
+ (either (\e -> H.modify_ $ _ { status = ErrorStatus "Decoding invoices failed."})
+ (\x -> H.modify_ $ _ { accounts = [ { invoices: x.data } ] }))
+ spyM "invoicesEE" $ invoicesEE
+
+ -- fetch subscriptions for this customer
+ subscriptionsEE <- H.liftAff $ DAO.listSubscriptions
+ subscriptionsEE # either (\e -> H.modify_ $ _ { status = ErrorStatus "Failed to fetch subscriptions." })
+ (either (\e -> H.modify_ $ _ { status = ErrorStatus "Decoding subscriptions failed."})
+ (\x -> H.modify_ $ _ { subscriptions = x.data }))
+ spyM "subscriptionsEE" $ subscriptionsEE
+
+ -- fetch plans for this customer
+ plansEE <- H.liftAff $ DAO.listPlans
+ plansEE # either (\e -> H.modify_ $ _ { status = ErrorStatus "Failed to fetch plans." })
+ (either (\e -> H.modify_ $ _ { status = ErrorStatus "Decoding plans failed."})
+ (\x -> H.modify_ $ _ { plans = x.data }))
+ spyM "plansEE" $ plansEE
+
+ -- fetch the payment methods for this customer
+ paymentMethodsEE <- H.liftAff $ DAO.listPaymentMethods
+ paymentMethodsEE # either (\e -> H.modify_ $ _ { status = ErrorStatus "Failed to fetch payment methods." })
+ (either (\e -> H.modify_ $ _ { status = ErrorStatus "Decoding payment methods failed."})
+ (\x -> H.modify_ $ _ { paymentMethods = x.data }))
+ spyM "paymentMethodsEE" $ paymentMethodsEE
+
+ H.liftEffect $ log "FetchStuff done."
+
+--------------------------------------------------------------------------------
+
+render :: ∀ m. MonadAff m => State -> ComponentHTML Action ChildSlots m
+render state =
+ div []
+ [ navMenuHtml state
+ , contentHtml state
+ , p [] [ text $ if state.status == Ok then "" else "status: " <> show state.status ]
+ ]
+
+navMenuHtml :: ∀ m. MonadAff m => State -> ComponentHTML Action ChildSlots m
+navMenuHtml state =
+ nav [ classes [ ClassName "stbx-menu" ] ]
+ [ ul []
+ [ text "Statebox Cloud Admin Console"
+ , a [ onClick \e -> Just $ SelectRoute $ Home ] [ text "Home" ]
+ , a [ onClick \e -> Just $ SelectRoute $ Projects ] [ text "Projects" ]
+ , a [ onClick \e -> Just $ SelectRoute $ APIKeys ] [ text "API Keys" ]
+ , a [ onClick \e -> Just $ SelectRoute $ Subscription ] [ text "Subscriptions" ]
+ , a [ onClick \e -> Just $ SelectRoute $ Plan ] [ text "Plans" ]
+ ]
+ ]
+
+contentHtml :: ∀ m. MonadAff m => State -> ComponentHTML Action ChildSlots m
+contentHtml state = case state.route of
+ Home ->
+ div [ classes [ ClassName "container", ClassName "is-flex", ClassName "has-rows" ] ]
+ [ h4 [] [ text "Projects" ]
+ , ul [ classes [ ClassName "stbx-cards" ] ] $ Map.toUnfoldable state.projects <#> \(projectId /\ project) ->
+ li [ onClick \e -> Just $ SelectRoute $ ProjectR projectId ]
+ [ h3 [] [ text project.name ] ]
+
+ , h4 [] [ text "Billing accounts" ]
+ , ul [ classes [ ClassName "stbx-cards" ] ] $ customers <#> \customer ->
+ li [ onClick \e -> Just $ SelectRoute $ Account customer.id ]
+ [ h3 [] [ text $ fold customer.name ]
+ , p [] [ text $ fold customer.description ]
+ ]
+
+ , h4 [] [ text "API keys" ]
+ , ul [ classes [ ClassName "stbx-cards" ] ] $ state.apiKeys <#> \key ->
+ li [] [ h3 [] [ text key.name ]
+ , p [] [ text key.hex ]
+ ]
+ ]
+ where
+ -- TODO in reality we should have multiple customers
+ customers :: Array Stripe.Customer
+ customers = maybe [] (\c -> [c]) state.customer
+ Projects ->
+ div [] $
+ [ h2 [] [ text "Projects" ]
+ , div [] $ Map.toUnfoldable state.projects <#>
+ (\(projectId /\ project) -> button [ onClick \e -> Just $ SelectRoute $ ProjectR projectId ] [ text project.name ])
+ ]
+ ProjectR projectId ->
+ projectMaybe # maybe (text $ "project " <> projectId <> " not found.") (\project ->
+ div []
+ [ h2 [] [ text $ "Project " <> show projectId ]
+ , h3 [] [ text $ "API keys" ]
+ , h3 [] [ text $ "Roots" ]
+ , ul [] (project.rootTransactions <#> \txHash -> li [] [ text txHash ])
+ , p [] [ button [ onClick \e -> Just $ SelectRoute $ RootTx ] [ text "Create new root tx" ] ]
+ ]
+ )
+ where
+ projectMaybe = Map.lookup projectId state.projects
+ APIKeys ->
+ div [] $
+ [ h2 [] [ text "API keys" ]
+ , p [] [ button [ onClick \e -> Just $ CreateApiKey ] [ text "Create new API key" ] ]
+ , ul [] $ state.apiKeys <#> \key -> li [] [ p [] [ text key.name ]
+ , p [] [ text key.hex ]
+ , p [] [ text $ show key.billingAccount ]
+ , p [] [ button [ onClick \e -> Just $ DeprecateApiKey key ] [ text "Deprecate" ] ]
+ ]
+ , p [] [ text "* Assign to a root" ]
+ ]
+ RootTx ->
+ div []
+ [ h2 [] [ text "Create root transaction" ]
+ , p [] [ text "name" ]
+ , p [] [ text "message" ]
+ , p [] [ text "hash" ]
+ , p [] [ text "valid key [key 1] (add)" ]
+ , p [] [ button [ onClick \e -> Just $ PublishRootTx { name: "Example tx", message: "Hi there!", hash: "CAF3CAF3", key: unit } ] [ text "Publish" ] ]
+ ]
+ Account customerId ->
+ div []
+ [ button [ onClick \e -> Just $ SelectRoute $ Invoices fakeCustomerId ] [ text "Invoices" ]
+ , h2 [] [ text "Customer" ]
+ , div [] (maybe [] (pure <<< customerHtml) state.customer)
+ , h3 [] [ text "Customer's payment methods" ]
+ , div [] (state.paymentMethods <#> paymentMethodHtml)
+ ]
+ Subscription ->
+ div []
+ [ h2 [] [ text "Subscriptions" ]
+ , div [] (state.subscriptions <#> subscriptionHtml)
+ ]
+ Invoices x ->
+ div []
+ [ h2 [] [ text "Invoices" ]
+ , div [] (state.accounts <#> \account -> invoiceSummaries account.invoices)
+ ]
+ Plan ->
+ div []
+ [ h2 [] [ text "Plans" ]
+ , div [] (state.plans <#> planWithExpandedProductHtml)
+ ]
+
+--------------------------------------------------------------------------------
+
+invoiceSummaries :: ∀ m. MonadAff m => Array Stripe.Invoice -> ComponentHTML Action ChildSlots m
+invoiceSummaries invoices =
+ table [] (invoices <#> invoiceSummaryLineHtml)
+ where
+ invoiceSummaryLineHtml :: ∀ m. MonadAff m => Stripe.Invoice -> ComponentHTML Action ChildSlots m
+ invoiceSummaryLineHtml i =
+ tr [] [ td [] [ text $ i.customer_email ]
+ , td [] [ text $ i.account_name ]
+ , td [] [ text $ formatCurrency i.currency i.amount_due ]
+ ]
+
+customerHtml :: ∀ m. MonadAff m => Stripe.Customer -> ComponentHTML Action ChildSlots m
+customerHtml c =
+ table [] $
+ [ tr [] [ th [] [ text "name" ]
+ , td [] [ text $ fold c.name ]
+ ]
+ , tr [] [ th [] [ text "description" ]
+ , td [] [ text $ fold c.description ]
+ ]
+ , tr [] [ th [] [ text "email" ]
+ , td [] [ text $ fold c.email ]
+ ]
+ , tr [] [ th [] [ text "phone" ]
+ , td [] [ text $ fold c.phone ]
+ ]
+ ] <>
+ foldMap addressRowsHtml c.address <>
+ [ tr [] [ th [] [ text "balance" ]
+ , td [] [ text $ formatCurrency c.currency c.balance ]
+ ]
+ , tr [] [ th [] [ text "tax ids" ]
+ , td [] [ taxIdsHtml c.tax_ids ]
+ ]
+ ]
+
+taxIdsHtml :: ∀ m. MonadAff m => Stripe.ArrayWrapper Stripe.TaxIdData -> ComponentHTML Action ChildSlots m
+taxIdsHtml x =
+ table [] (taxIdDataHtml <$> x.data)
+
+taxIdDataHtml :: ∀ m. MonadAff m => Stripe.TaxIdData -> ComponentHTML Action ChildSlots m
+taxIdDataHtml x =
+ tr [] [ td [] [ text x.value ]
+ , td [] [ text x.type ]
+ ]
+
+paymentMethodHtml :: ∀ m. MonadAff m => Stripe.PaymentMethod -> ComponentHTML Action ChildSlots m
+paymentMethodHtml pm =
+ table []
+ [ tr [] [ td [] [ text "type" ]
+ , td [] [ text pm.type ]
+ ]
+ , tr [] [ td [] [ text "card" ]
+ , td [] [ maybe (text "no card") cardHtml pm.card ]
+ ]
+ ]
+
+billingDetailsHtml :: ∀ m. MonadAff m => Stripe.BillingDetails -> ComponentHTML Action ChildSlots m
+billingDetailsHtml bd = nameAddressPhoneHtml bd
+
+nameAddressPhoneHtml :: ∀ m. MonadAff m => { | Stripe.NameAddressPhoneRow () } -> ComponentHTML Action ChildSlots m
+nameAddressPhoneHtml x =
+ table [] $
+ [ tr [] [ th [] [ text "name" ]
+ , td [] [ text $ fold x.name ]
+ ]
+ , tr [] [ th [] [ text "email" ]
+ , td [] [ text $ fold x.email ]
+ ]
+ , tr [] [ th [] [ text "phone" ]
+ , td [] [ text $ fold x.phone ]
+ ]
+ ] <>
+ foldMap addressRowsHtml x.address
+
+addressHtml :: ∀ m. MonadAff m => Stripe.Address -> ComponentHTML Action ChildSlots m
+addressHtml a = table [] (addressRowsHtml a)
+
+addressRowsHtml :: ∀ m. MonadAff m => Stripe.Address -> Array (ComponentHTML Action ChildSlots m)
+addressRowsHtml a =
+ [ tr [] [ th [] [ text "address" ]
+ , td [] [ text $ fold a.line1, br [], text $ fold a.line2 ]
+ ]
+ , tr [] [ th [] [ text "city" ]
+ , td [] [ text $ fold a.city ]
+ ]
+ , tr [] [ th [] [ text "postal code" ]
+ , td [] [ text $ fold a.postal_code ]
+ ]
+ , tr [] [ th [] [ text "state" ]
+ , td [] [ text $ fold a.state ]
+ ]
+ , tr [] [ th [] [ text "country" ]
+ , td [] [ text $ fold a.country ]
+ ]
+ ]
+
+
+cardHtml :: ∀ m. MonadAff m => Stripe.Card -> ComponentHTML Action ChildSlots m
+cardHtml c =
+ text $ c.country <> " " <> c.brand <> " " <>
+ formatCCNumber c <>
+ " EXP " <> formatExpiryDate c <>
+ " (" <> c.funding <> ")"
+ where
+ formatCCNumber :: Stripe.Card -> String
+ formatCCNumber card = "**** **** **** " <> card.last4
+
+ formatExpiryDate :: Stripe.Card -> String
+ formatExpiryDate card = show c.exp_month <> "/" <> show c.exp_year
+
+formatCurrency :: Stripe.Currency -> Stripe.Amount -> String
+formatCurrency currency amount =
+ show amount <> " " <> currency <> " cents"
+
+timestampHtml :: ∀ m. MonadAff m => Stripe.Timestamp -> ComponentHTML Action ChildSlots m
+timestampHtml ts = text $ show ts
+
+timestampRangeHtml :: ∀ m. MonadAff m => Stripe.Timestamp -> Stripe.Timestamp -> ComponentHTML Action ChildSlots m
+timestampRangeHtml start end =
+ span [] [ timestampHtml start, text " thru ", timestampHtml end ]
+
+subscriptionHtml :: ∀ m. MonadAff m => Stripe.Subscription -> ComponentHTML Action ChildSlots m
+subscriptionHtml s =
+ table []
+ [ tr [] [ td [] [ text "id" ]
+ , td [] [ text s.id ]
+ ]
+ , tr [] [ td [] [ text "status" ]
+ , td [] [ text s.status ]
+ ]
+ , tr [] [ td [] [ text "quantity" ]
+ , td [] [ text $ show s.quantity ]
+ ]
+ , tr [] [ td [] [ text "start date" ]
+ , td [] [ timestampHtml s.start_date ]
+ ]
+ , tr [] [ td [] [ text "current period" ]
+ , td [] [ timestampRangeHtml s.current_period_start s.current_period_end ]
+ ]
+ , tr [] [ td [] [ text "trial period" ]
+ , td [] [ timestampRangeHtml s.trial_start s.trial_end ]
+ ]
+ , tr [] [ td [] [ text "collection method" ]
+ , td [] [ text s.collection_method ]
+ ]
+ , tr [] [ td [] [ text "live mode" ]
+ , td [] [ text $ show s.livemode ]
+ ]
+ , tr [] [ td [] [ text "items" ]
+ , td [] (s.items.data <#> subscriptionItemHtml)
+ ]
+ ]
+
+subscriptionItemHtml :: ∀ m. MonadAff m => Stripe.SubscriptionItem -> ComponentHTML Action ChildSlots m
+subscriptionItemHtml item =
+ table []
+ [ tr [] [ td [] [ text "plan" ]
+ , td [] [ planHtml item.plan ]
+ ]
+ , tr [] [ td [] [ text "created" ]
+ , td [] [ text $ show item.created ]
+ ]
+ ]
+
+planHtml :: ∀ m. MonadAff m => Stripe.Plan -> ComponentHTML Action ChildSlots m
+planHtml plan =
+ table []
+ [ tr [] [ td [] [ text "nickname" ]
+ , td [] [ text $ fromMaybe "-" plan.nickname ]
+ ]
+ , tr [] [ td [] [ text "product id" ]
+ , td [] [ text plan.product ]
+ ]
+ , tr [] [ td [] [ text "created on" ]
+ , td [] [ timestampHtml plan.created ]
+ ]
+ , tr [] [ td [] [ text "amount" ]
+ , td [] [ text $ formatCurrency plan.currency plan.amount ]
+ ]
+ , tr [] [ td [] [ text "billing scheme" ]
+ , td [] [ text plan.billing_scheme ]
+ ]
+ , tr [] [ td [] [ text "interval" ]
+ , td [] [ text $ plan.interval <> " (" <> show plan.interval_count <> "x)" ]
+ ]
+ ]
+
+--------------------------------------------------------------------------------
+
+planWithExpandedProductHtml :: ∀ m. MonadAff m => Stripe.PlanWithExpandedProduct -> ComponentHTML Action ChildSlots m
+planWithExpandedProductHtml plan =
+ table []
+ [ tr [] [ td [] [ text "nickname" ]
+ , td [] [ text $ fromMaybe "-" plan.nickname ]
+ ]
+ , tr [] [ td [] [ text "product" ]
+ , td [] [ productHtml plan.product ]
+ ]
+ , tr [] [ td [] [ text "created on" ]
+ , td [] [ timestampHtml plan.created ]
+ ]
+ , tr [] [ td [] [ text "amount" ]
+ , td [] [ text $ formatCurrency plan.currency plan.amount ]
+ ]
+ , tr [] [ td [] [ text "billing scheme" ]
+ , td [] [ text plan.billing_scheme ]
+ ]
+ , tr [] [ td [] [ text "interval" ]
+ , td [] [ text $ plan.interval <> " (" <> show plan.interval_count <> "x)" ]
+ ]
+ ]
+
+productHtml :: ∀ m. MonadAff m => Stripe.Product -> ComponentHTML Action ChildSlots m
+productHtml product =
+ table []
+ [ tr [] [ td [] [ text "product id" ]
+ , td [] [ text product.id ]
+ ]
+ , tr [] [ td [] [ text "name" ]
+ , td [] [ text product.name ]
+ ]
+ , tr [] [ td [] [ text "description" ]
+ , td [] [ text $ fromMaybe "-" product.description ]
+ ]
+ , tr [] [ td [] [ text "unit" ]
+ , td [] [ text $ fromMaybe "-" product.unit_label ]
+ ]
+ ]
+
+--------------------------------------------------------------------------------
+
+spyM :: ∀ m a. Applicative m => String -> a -> m Unit
+spyM tag value = do
+ let dummy1 = spy tag value
+ pure unit
diff --git a/console/src/Statebox/Console/DAO.purs b/console/src/Statebox/Console/DAO.purs
new file mode 100644
index 00000000..6d01d79a
--- /dev/null
+++ b/console/src/Statebox/Console/DAO.purs
@@ -0,0 +1,78 @@
+module Statebox.Console.DAO where
+
+import Prelude
+import Affjax as Affjax
+import Affjax (Response, URL)
+import Affjax.ResponseFormat as ResponseFormat
+import Data.Argonaut.Core (Json)
+import Data.Argonaut.Decode (decodeJson)
+import Data.HTTP.Method (Method(GET))
+import Data.Either (Either(..), either)
+import Data.Either.Nested (type (\/))
+import Effect.Aff (Aff)
+
+import Stripe as Stripe
+
+import Debug.Trace (spy)
+
+mkUrl suffix = "http://localhost" <> suffix
+
+--------------------------------------------------------------------------------
+
+listInvoices :: Aff (Affjax.Error \/ String \/ Stripe.ArrayWrapper Stripe.Invoice)
+listInvoices = listInvoices' # map (map (_.body >>> spy "invoices body dump" >>> decodeJson))
+
+listInvoices' :: Aff (Affjax.Error \/ Response Json)
+listInvoices' =
+ Affjax.request $ Affjax.defaultRequest { url = mkUrl "/invoices"
+ , method = Left GET
+ , responseFormat = ResponseFormat.json
+ }
+
+--------------------------------------------------------------------------------
+
+fetchCustomer :: Aff (Affjax.Error \/ String \/ Stripe.Customer)
+fetchCustomer = fetchCustomer' # map (map (_.body >>> spy "customer body dump" >>> decodeJson))
+
+fetchCustomer' :: Aff (Affjax.Error \/ Response Json)
+fetchCustomer' =
+ Affjax.request $ Affjax.defaultRequest { url = mkUrl "/customer"
+ , method = Left GET
+ , responseFormat = ResponseFormat.json
+ }
+
+--------------------------------------------------------------------------------
+
+listPaymentMethods :: Aff (Affjax.Error \/ String \/ Stripe.ArrayWrapper Stripe.PaymentMethod)
+listPaymentMethods = listPaymentMethods' # map (map (_.body >>> spy "paymentMethods dump" >>> decodeJson))
+
+listPaymentMethods' :: Aff (Affjax.Error \/ Response Json)
+listPaymentMethods' =
+ Affjax.request $ Affjax.defaultRequest { url = mkUrl "/payment-methods"
+ , method = Left GET
+ , responseFormat = ResponseFormat.json
+ }
+
+--------------------------------------------------------------------------------
+
+listSubscriptions :: Aff (Affjax.Error \/ String \/ Stripe.ArrayWrapper Stripe.Subscription)
+listSubscriptions = listSubscriptions' # map (map (_.body >>> spy "subscriptions dump" >>> decodeJson))
+
+listSubscriptions' :: Aff (Affjax.Error \/ Response Json)
+listSubscriptions' =
+ Affjax.request $ Affjax.defaultRequest { url = mkUrl "/subscriptions"
+ , method = Left GET
+ , responseFormat = ResponseFormat.json
+ }
+
+--------------------------------------------------------------------------------
+
+listPlans :: Aff (Affjax.Error \/ String \/ Stripe.ArrayWrapper Stripe.PlanWithExpandedProduct)
+listPlans = listPlans' # map (map (_.body >>> spy "plans dump" >>> decodeJson))
+
+listPlans' :: Aff (Affjax.Error \/ Response Json)
+listPlans' =
+ Affjax.request $ Affjax.defaultRequest { url = mkUrl "/plans"
+ , method = Left GET
+ , responseFormat = ResponseFormat.json
+ }
diff --git a/console/src/Statebox/Console/Main.purs b/console/src/Statebox/Console/Main.purs
new file mode 100644
index 00000000..c48f357c
--- /dev/null
+++ b/console/src/Statebox/Console/Main.purs
@@ -0,0 +1,72 @@
+module Statebox.Console.Main where
+
+import Prelude hiding ((/))
+import Data.Map as Map
+import Data.Map (Map)
+import Data.Maybe
+import Data.Tuple.Nested ((/\))
+import Effect (Effect)
+import Effect.Class (liftEffect)
+import Halogen as H
+import Halogen.Aff (awaitBody, runHalogenAff)
+import Halogen.VDom.Driver (runUI)
+import Routing.Duplex (RouteDuplex', path, root, segment, int, optional, param)
+import Routing.Duplex.Generic (sum, noArgs)
+import Routing.Duplex.Generic.Syntax
+import Routing.PushState as Routing.PushState
+
+import Statebox.Console as Console
+import Statebox.Console (Route(..))
+import Statebox.Console (ProjectId, Project) -- TODO remove, used to define example data
+
+main :: Effect Unit
+main = runHalogenAff do
+ body <- awaitBody
+ pushStateInterface <- liftEffect Routing.PushState.makeInterface
+ io <- runUI Console.ui initialState body
+ _ <- io.query $ H.tell $ Console.DoAction Console.FetchStuff
+ pure io
+ where
+ initialState :: Console.State
+ initialState = { route: Home
+ , customer: Nothing
+ , paymentMethods: mempty
+ , subscriptions: mempty
+ , plans: mempty
+ , accounts: [ { invoices: mempty } ]
+ , apiKeys : [ { name: "My API key #1", hex: "01010101", billingAccount: Nothing }
+ , { name: "My API key #2", hex: "02020202", billingAccount: Nothing }
+ ]
+ , projects: exampleProjects
+ , rootTransactions: ["00AA00", "00BB00", "00CC00" ]
+ , status: Console.Ok
+ }
+
+
+routesCodex :: RouteDuplex' Route
+routesCodex = root $ sum
+ { "Home": noArgs
+ , "ProjectR": "project" / segment
+ , "Projects": "project" / noArgs
+ , "RootTx": "tx" / noArgs
+ , "APIKeys": "key" / noArgs
+ , "Account": "account" / segment
+ , "Invoices": "invoices" / segment
+ , "Subscription": "subscriptions" / noArgs
+ , "Plan": "plans" / noArgs
+ }
+
+--------------------------------------------------------------------------------
+
+exampleProjects :: Map ProjectId Project
+exampleProjects = Map.fromFoldable
+ [ "project1" /\ { name: "My Project 1"
+ , rootTransactions: [ "0100ABC123", "0100DEF456", "0100GHI789" ]
+ }
+ , "project2" /\ { name: "My Project 2"
+ , rootTransactions: [ "0200ABC123", "0200DEF456", "0200GHI789" ]
+ }
+ , "project3" /\ { name: "My Project 3"
+ , rootTransactions: [ "0300ABC123", "0300DEF456", "0300GHI789" ]
+ }
+ ]
diff --git a/console/src/Stripe.purs b/console/src/Stripe.purs
new file mode 100644
index 00000000..7ff68dda
--- /dev/null
+++ b/console/src/Stripe.purs
@@ -0,0 +1,263 @@
+module Stripe where
+
+import Data.Maybe (Maybe)
+
+-- | https://stripe.com/docs/api/customers/object
+type Customer =
+ { object :: ObjectTag
+ , id :: CustomerId
+ , description :: Maybe String
+ , balance :: Amount
+ , currency :: Currency
+ , invoice_prefix :: String
+ , invoice_settings :: InvoiceSettings
+ , subscriptions :: { | ArrayWrapperRow Subscription ( total_count :: Int ) }
+ , delinquent :: Boolean
+ , tax_ids :: ArrayWrapper TaxIdData
+ , tax_exempt :: TaxExemptType
+ | NameAddressPhoneRow ()
+ }
+
+type CustomerId = String
+
+type InvoiceSettings =
+ { default_payment_method :: PaymentMethodId
+ }
+
+--------------------------------------------------------------------------------
+
+-- | https://stripe.com/docs/api/payment_methods
+type PaymentMethod =
+ { id :: PaymentMethodId
+ , object :: ObjectTag
+ , "type" :: PaymentMethodType
+ , billing_details :: Maybe BillingDetails
+ , card :: Maybe Card
+ , customer :: CustomerId
+ }
+
+type PaymentMethodId = String
+
+-- | One of `"card"` | `"fpx"` | `"ideal"` | `"sepa_debit"`. See https://stripe.com/docs/api/payment_methods/object.
+type PaymentMethodType = String
+
+type BillingDetails = { | NameAddressPhoneRow () }
+
+type BillingDetailsId = String
+
+-- | https://stripe.com/docs/api/cards
+type Card =
+ { fingerprint :: String
+ , brand :: CardBrand
+ , last4 :: String -- ^ last four digits of the card number.
+ , exp_month :: MonthNr
+ , exp_year :: Year
+ , country :: Country
+ , funding :: String
+ }
+
+
+-- | Uniquely identifies this particular card number. You can use this attribute to check whether two
+-- | customers who’ve signed up with you are using the same card number, for example.
+type CardFingerprint = String
+
+-- | One of `"amex"` | `"diners"` | `"discover"` | `"jcb"` | `"mastercard"` | `"unionpay"` | `"visa"` | `"unknown"`.
+type CardBrand = String
+
+-- | One of `"credit"` | `"debit"` | `"prepaid"` | `"unknown"`.
+type Funding = String
+
+-- | If a CVC was provided, results of the check: `"pass"` | `"fail"` | `"unavailable"` | `"unchecked"`.
+type CVCCheckType = String
+
+--------------------------------------------------------------------------------
+
+-- | https://stripe.com/docs/api/invoices/object
+type Invoice =
+ { object :: ObjectTag
+ , id :: InvoiceId
+ , account_name :: String
+ , account_country :: Country
+ , customer :: CustomerId
+ , customer_email :: String
+ , currency :: String
+ , amount_due :: Amount
+ , amount_paid :: Amount
+ , amount_remaining :: Amount
+ }
+
+type InvoiceId = String
+
+--------------------------------------------------------------------------------
+
+type Subscription =
+ { id :: SubscriptionId
+ , customer :: CustomerId
+ , object :: ObjectTag
+ , created :: Timestamp
+ , status :: SubscriptionStatusString
+ , start_date :: Timestamp
+ , trial_start :: Timestamp
+ , trial_end :: Timestamp
+ , current_period_start :: Timestamp
+ , current_period_end :: Timestamp
+ , collection_method :: CollectionMethodString
+ , latest_invoice :: Maybe InvoiceId
+ , quantity :: Int
+ , items :: ArrayWrapper SubscriptionItem
+ , livemode :: Boolean
+ }
+
+type SubscriptionId = String
+
+type SubscriptionItem =
+ { id :: SubscriptionItemId
+ , object :: ObjectTag
+ , subscription :: SubscriptionId
+ , plan :: Plan
+ , created :: Timestamp
+ }
+
+type SubscriptionItemId = String
+
+-- | See https://stripe.com/docs/billing/subscriptions/overview#subscription-states.
+-- | One of `"trialing"` | `"active"` | `"incomplete"` | `"incomplete_expired"` | `"past_due"` | `"canceled"` | `"unpaid.
+type SubscriptionStatusString = String
+
+-- | Either `"charge_automatically"` | `"send_invoice"`.
+type CollectionMethodString = String
+
+type Plan' product =
+ { id :: PlanId
+ , object :: ObjectTag
+ , nickname :: Maybe String
+ , product :: product
+ , amount :: Amount
+ , amount_decimal :: AmountDecimal
+ , currency :: Currency
+ , billing_scheme :: BillingScheme
+ , created :: Timestamp
+ , interval :: Interval
+ , interval_count :: Int
+ }
+
+type Plan = Plan' ProductId
+
+type PlanWithExpandedProduct = Plan' Product
+
+type PlanId = String
+
+-- | E.g. `"per_unit"`
+type BillingScheme = String
+
+-- | E.g. `"month"`
+type Interval = String
+
+--------------------------------------------------------------------------------
+
+-- | https://stripe.com/docs/api/products/object
+type Product =
+ { id :: ProductId
+ , name :: String
+ , description :: Maybe String
+ , unit_label :: Maybe String
+ , statement_descriptor :: Maybe String -- ^ will appear on a customer's credit card statement
+ , created :: Timestamp
+ , updated :: Timestamp
+ , images :: Array URL
+ , active :: Boolean
+ , livemode :: Boolean
+ }
+
+type ProductId = String
+
+-- | One of `"good"` | `"service"`.
+type ProductTypeString = String
+
+--------------------------------------------------------------------------------
+
+type TaxIdData =
+ { type :: TaxIdType
+ , value :: String
+ }
+
+-- | One of `"eu_vat"` | `"nz_gst"` | `"au_abn"` | `"in_gst"` | `"no_vat"` |
+-- | `"za_vat"` | `"ch_vat"` | `"mx_rfc"` | `"sg_uen"` | `"ru_inn"` |
+-- | `"ca_bn"` | `"hk_br"` | `"es_cif"` | `"tw_vat"` | `"th_vat"` |
+-- | `"jp_cn"` | `"li_uid"` | `"my_itn"` | `"us_ein"` | `"kr_brn"` |
+-- | `"ca_qst"` | `"my_sst"`.
+type TaxIdType = String
+
+-- | One of `"none"`, `"exempt"`, or `"reverse`".
+type TaxExemptType = String
+
+--------------------------------------------------------------------------------
+
+-- TODO include or exclude 'name' field?
+type NameAddressPhoneRow r =
+ ( name :: Maybe String
+ , phone :: Maybe Phone
+ , email :: Maybe Email
+ , address :: Maybe Address
+ | r
+ )
+
+--------------------------------------------------------------------------------
+
+type Address =
+ { postal_code :: Maybe PostalCode
+ , city :: Maybe String
+ , country :: Maybe Country
+ , line1 :: Maybe String
+ , line2 :: Maybe String
+ , state :: Maybe State
+ }
+
+-- | Two-letter country code (ISO 3166-1 alpha-2).
+type Country = String
+
+type PostalCode = String
+
+type State = String
+
+type Phone = String
+
+type Email = String
+
+--------------------------------------------------------------------------------
+
+type Currency = String
+
+type Amount = Int
+
+type AmountDecimal = String
+
+--------------------------------------------------------------------------------
+
+type URLSuffix = URL
+
+type URL = String
+
+--------------------------------------------------------------------------------
+
+type Timestamp = Int
+
+type MonthNr = Int
+
+-- | Year, starting from zero, i.e. the year 2020 is represented as `2020`.
+type Year = Int
+
+--------------------------------------------------------------------------------
+
+-- | Stripe populates this with things like `"customer"`, `"object"`, `"list"` and so on.
+type ObjectTag = String
+
+type ArrayWrapperRow a r =
+ ( object :: ObjectTag
+ , data :: Array a
+ , has_more :: Boolean
+ , url :: URLSuffix
+ | r
+ )
+
+type ArrayWrapper a = { | ArrayWrapperRow a () }