From 4b5c2ed7ec9d93201f50066281b6401005a25519 Mon Sep 17 00:00:00 2001 From: Erik Post Date: Thu, 19 Mar 2020 18:15:19 +0100 Subject: [PATCH 01/12] console: Initial work on cloud console app and Stripe. #376 --- console/.gitignore | 10 ++ console/html/console.css | 1 + console/html/index.css | 3 + console/html/index.html | 23 +++ console/html/index.js | 63 ++++++++ console/package.json | 37 +++++ console/spago.dhall | 17 ++ console/src/Statebox/Console.purs | 143 +++++++++++++++++ console/src/Statebox/Console/DAO.purs | 66 ++++++++ console/src/Statebox/Console/Main.purs | 24 +++ console/src/Stripe.purs | 205 +++++++++++++++++++++++++ 11 files changed, 592 insertions(+) create mode 100644 console/.gitignore create mode 100644 console/html/console.css create mode 100644 console/html/index.css create mode 100644 console/html/index.html create mode 100644 console/html/index.js create mode 100644 console/package.json create mode 100644 console/spago.dhall create mode 100644 console/src/Statebox/Console.purs create mode 100644 console/src/Statebox/Console/DAO.purs create mode 100644 console/src/Statebox/Console/Main.purs create mode 100644 console/src/Stripe.purs 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..71aad98b --- /dev/null +++ b/console/html/console.css @@ -0,0 +1 @@ +background: red; 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..784de5a0 --- /dev/null +++ b/console/package.json @@ -0,0 +1,37 @@ +{ + "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.5", + "purescript-psa": "^0.7.3", + "spago": "^0.13" + }, + "dependencies": { + "@statebox/stbx-js": "0.0.31", + "@statebox/style": "0.0.6", + "dagre": "^0.8.4" + } +} diff --git a/console/spago.dhall b/console/spago.dhall new file mode 100644 index 00000000..21630026 --- /dev/null +++ b/console/spago.dhall @@ -0,0 +1,17 @@ +{ name = + "stbx-cloud-console" +, dependencies = + [ "affjax" + , "argonaut" + , "argonaut-codecs" + , "console" + , "debug" + , "effect" + , "halogen" + , "psci-support" + ] +, 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..37d6610f --- /dev/null +++ b/console/src/Statebox/Console.purs @@ -0,0 +1,143 @@ +module Statebox.Console where + +import Prelude +import Data.Either (either) +import Data.Lens +import Data.Lens.Record (prop) +import Data.Symbol (SProxy(..)) +import Data.Foldable (fold, foldMap) +import Data.Maybe (Maybe(..), maybe, fromMaybe) +import Effect.Aff.Class (class MonadAff) +import Effect.Console (log) +import Halogen as H +import Halogen (ComponentHTML) +import Halogen.HTML (HTML, p, text, div, ul, li, h2, table, tr, th, td) +import Halogen.Query.HalogenM (HalogenM) + +import Statebox.Console.DAO as DAO + +import Stripe as Stripe + +import Debug.Trace (spy) + +-------------------------------------------------------------------------------- + +type State = + { customer :: Maybe Stripe.Customer + , paymentMethods :: Array Stripe.PaymentMethod + , accounts :: Array { invoices :: Array Stripe.Invoice + } + , status :: AppStatus + } + +_accounts = prop (SProxy :: SProxy "accounts") +_invoices = prop (SProxy :: SProxy "invoices") + +-------------------------------------------------------------------------------- + +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 = 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) + +handleAction :: ∀ m. MonadAff m => Action -> HalogenM State Action ChildSlots Void m Unit +handleAction = case _ of + FetchStuff -> do + H.liftEffect $ log "handling action FetchStuff..." + 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 + + 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 + + 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 [] + [ p [] [ text $ if state.status == Ok then "" else "status: " <> show state.status ] + , h2 [] [ text "Customer" ] + , div [] (maybe [] (pure <<< customerHtml) state.customer) + , h2 [] [ text "Invoices" ] + , div [] + (state.accounts <#> \account -> table [] + (account.invoices <#> invoiceSummaryLineHtml) + ) + ] + +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 $ i.currency ] + , td [] [ text $ show 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 "email" ] + , td [] [ text $ c.email ] + ] + , tr [] [ th [] [ text "phone" ] + , td [] [ text $ fold c.phone ] + ] + , tr [] [ th [] [ text "description" ] + , td [] [ text $ fold c.description ] + ] + , tr [] [ th [] [ text "balance" ] + , td [] [ text $ c.currency <> " " <> show c.balance <> " cents" ] + ] + ] + +-------------------------------------------------------------------------------- + +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..3bd85890 --- /dev/null +++ b/console/src/Statebox/Console/DAO.purs @@ -0,0 +1,66 @@ +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 + +-------------------------------------------------------------------------------- + +type InvoicesResponse = + { object :: String + , "data" :: Array Stripe.Invoice + } + +listInvoices :: Aff (Affjax.Error \/ String \/ InvoicesResponse) +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 + } + +-------------------------------------------------------------------------------- + +type PaymentMethodsResponse = + { object :: Stripe.ObjectTag + , "data" :: Array Stripe.PaymentMethod + , has_more :: Boolean + , url :: Stripe.URLSuffix + } + +listPaymentMethods :: Aff (Affjax.Error \/ String \/ PaymentMethodsResponse) +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 + } diff --git a/console/src/Statebox/Console/Main.purs b/console/src/Statebox/Console/Main.purs new file mode 100644 index 00000000..b4cfddfd --- /dev/null +++ b/console/src/Statebox/Console/Main.purs @@ -0,0 +1,24 @@ +module Statebox.Console.Main where + +import Prelude +import Data.Maybe +import Effect (Effect) +import Halogen as H +import Halogen.Aff (awaitBody, runHalogenAff) +import Halogen.VDom.Driver (runUI) + +import Statebox.Console as Console + +main :: Effect Unit +main = runHalogenAff do + body <- awaitBody + io <- runUI Console.ui initialState body + _ <- io.query $ H.tell $ Console.DoAction Console.FetchStuff + pure io + where + initialState :: Console.State + initialState = { customer: Nothing + , paymentMethods: mempty + , accounts: [ { invoices: mempty } ] + , status: Console.Ok + } diff --git a/console/src/Stripe.purs b/console/src/Stripe.purs new file mode 100644 index 00000000..4794e571 --- /dev/null +++ b/console/src/Stripe.purs @@ -0,0 +1,205 @@ +module Stripe where + +import Data.Maybe (Maybe) + + +-- | Stripe populates this with things like `"customer"`, `"object"`, `"list"` and so on. +type ObjectTag = String + +-------------------------------------------------------------------------------- + +-- | https://stripe.com/docs/api/customers/object +type Customer = + { object :: ObjectTag + , id :: CustomerId + , name :: Maybe String + , description :: Maybe String + , email :: Email + , phone :: Maybe String + , balance :: Amount + , currency :: Currency + , invoice_prefix :: String + , invoice_settings :: InvoiceSettings + , subscriptions :: SubscriptionsInfo + , delinquent :: Boolean + } + +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 = + { name :: Maybe String + , phone :: Maybe Phone + , email :: Maybe Email + , address :: Maybe Address + } + +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"` | `"prepeaid"` | `"unknown"`. +type Funding = 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 SubscriptionsInfo = + { object :: ObjectTag + , has_more :: Boolean + , total_count :: Int + , url :: URLSuffix -- ^ e.g. "/v1/customers/:customerId:/subscriptions" + , data :: Array Subscription + } + +-------------------------------------------------------------------------------- + +type Subscription = + { id :: SubscriptionId + , customer :: CustomerId + , object :: ObjectTag + , created :: Timestamp + , current_period_start :: Timestamp + , current_period_end :: Timestamp + , latest_invoice :: Maybe InvoiceId + , items :: { object :: ObjectTag + , data :: Array SubscriptionItem + , url :: URLSuffix + , has_more :: Boolean + } + } + +type SubscriptionId = String + +type SubscriptionItem = + { id :: SubscriptionItemId + , object :: ObjectTag + , quantity :: Int + , subscription :: SubscriptionId + , plan :: Plan + , created :: Timestamp + } + +type SubscriptionItemId = String + +-- | E.g. `"charge_automatically"` +type CollectionMethod = String + +type Plan = + { id :: PlanId + , object :: ObjectTag + , nickname :: Maybe String + , product :: ProductId + , amount :: Amount + , amount_decimal :: AmountDecimal + , currency :: Currency + , billing_scheme :: BillingScheme + , created :: Timestamp + , interval :: Interval + , interval_count :: Int + } + +type PlanId = String + +-- | E.g. `"per_unit"` +type BillingScheme = String + +-- | E.g. `"month"` +type Interval = String + +type ProductId = String + +-------------------------------------------------------------------------------- + +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 From cf8bed01c457306c920f8fe2412523966be54a46 Mon Sep 17 00:00:00 2001 From: Erik Post Date: Fri, 20 Mar 2020 00:51:02 +0100 Subject: [PATCH 02/12] console: Get and render tax info for customer. #376 * Define additional fields and types. * Render them. * Factor Stripe API array wrapper out into separate type ArrayWrapper. --- console/src/Statebox/Console.purs | 13 ++++++ console/src/Statebox/Console/DAO.purs | 16 +------- console/src/Stripe.purs | 59 +++++++++++++++++---------- 3 files changed, 52 insertions(+), 36 deletions(-) diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs index 37d6610f..c01a3c6c 100644 --- a/console/src/Statebox/Console.purs +++ b/console/src/Statebox/Console.purs @@ -133,6 +133,19 @@ customerHtml c = , tr [] [ th [] [ text "balance" ] , td [] [ text $ c.currency <> " " <> show c.balance <> " cents" ] ] + , tr [] [ th [] [ text "tax" ] + , 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 ] ] -------------------------------------------------------------------------------- diff --git a/console/src/Statebox/Console/DAO.purs b/console/src/Statebox/Console/DAO.purs index 3bd85890..8a265095 100644 --- a/console/src/Statebox/Console/DAO.purs +++ b/console/src/Statebox/Console/DAO.purs @@ -19,12 +19,7 @@ mkUrl suffix = "http://localhost" <> suffix -------------------------------------------------------------------------------- -type InvoicesResponse = - { object :: String - , "data" :: Array Stripe.Invoice - } - -listInvoices :: Aff (Affjax.Error \/ String \/ InvoicesResponse) +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) @@ -48,14 +43,7 @@ fetchCustomer' = -------------------------------------------------------------------------------- -type PaymentMethodsResponse = - { object :: Stripe.ObjectTag - , "data" :: Array Stripe.PaymentMethod - , has_more :: Boolean - , url :: Stripe.URLSuffix - } - -listPaymentMethods :: Aff (Affjax.Error \/ String \/ PaymentMethodsResponse) +listPaymentMethods :: Aff (Affjax.Error \/ String \/ Stripe.ArrayWrapper Stripe.PaymentMethod) listPaymentMethods = listPaymentMethods' # map (map (_.body >>> spy "paymentMethods dump" >>> decodeJson)) listPaymentMethods' :: Aff (Affjax.Error \/ Response Json) diff --git a/console/src/Stripe.purs b/console/src/Stripe.purs index 4794e571..e97489fe 100644 --- a/console/src/Stripe.purs +++ b/console/src/Stripe.purs @@ -2,12 +2,6 @@ module Stripe where import Data.Maybe (Maybe) - --- | Stripe populates this with things like `"customer"`, `"object"`, `"list"` and so on. -type ObjectTag = String - --------------------------------------------------------------------------------- - -- | https://stripe.com/docs/api/customers/object type Customer = { object :: ObjectTag @@ -20,8 +14,10 @@ type Customer = , currency :: Currency , invoice_prefix :: String , invoice_settings :: InvoiceSettings - , subscriptions :: SubscriptionsInfo + , subscriptions :: { | ArrayWrapperRow Subscription ( total_count :: Int ) } , delinquent :: Boolean + , tax_ids :: ArrayWrapper TaxIdData + , tax_exempt :: TaxExemptType } type CustomerId = String @@ -94,16 +90,6 @@ type InvoiceId = String -------------------------------------------------------------------------------- -type SubscriptionsInfo = - { object :: ObjectTag - , has_more :: Boolean - , total_count :: Int - , url :: URLSuffix -- ^ e.g. "/v1/customers/:customerId:/subscriptions" - , data :: Array Subscription - } - --------------------------------------------------------------------------------- - type Subscription = { id :: SubscriptionId , customer :: CustomerId @@ -112,11 +98,7 @@ type Subscription = , current_period_start :: Timestamp , current_period_end :: Timestamp , latest_invoice :: Maybe InvoiceId - , items :: { object :: ObjectTag - , data :: Array SubscriptionItem - , url :: URLSuffix - , has_more :: Boolean - } + , items :: ArrayWrapper SubscriptionItem } type SubscriptionId = String @@ -161,6 +143,23 @@ type ProductId = 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 + +-------------------------------------------------------------------------------- + type Address = { postal_code :: Maybe PostalCode , city :: Maybe String @@ -203,3 +202,19 @@ 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 () } From df1e18800656b9be44821e3609cd6ff1d0e8da29 Mon Sep 17 00:00:00 2001 From: Erik Post Date: Fri, 20 Mar 2020 16:24:47 +0100 Subject: [PATCH 03/12] console: More work on Stripe Customer, Card, and BillingDetails. #376 --- console/src/Statebox/Console.purs | 70 ++++++++++++++++++++++++++++++- console/src/Stripe.purs | 34 +++++++++------ 2 files changed, 89 insertions(+), 15 deletions(-) diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs index c01a3c6c..1828360c 100644 --- a/console/src/Statebox/Console.purs +++ b/console/src/Statebox/Console.purs @@ -11,7 +11,7 @@ import Effect.Aff.Class (class MonadAff) import Effect.Console (log) import Halogen as H import Halogen (ComponentHTML) -import Halogen.HTML (HTML, p, text, div, ul, li, h2, table, tr, th, td) +import Halogen.HTML (HTML, p, text, br, div, ul, li, h2, h3, table, tr, th, td) import Halogen.Query.HalogenM (HalogenM) import Statebox.Console.DAO as DAO @@ -100,6 +100,8 @@ render state = [ p [] [ text $ if state.status == Ok then "" else "status: " <> show state.status ] , h2 [] [ text "Customer" ] , div [] (maybe [] (pure <<< customerHtml) state.customer) + , h3 [] [ text "Customer's payment methods" ] + , div [] (state.paymentMethods <#> paymentMethodHtml) , h2 [] [ text "Invoices" ] , div [] (state.accounts <#> \account -> table [] @@ -122,7 +124,7 @@ customerHtml c = , td [] [ text $ fold c.name ] ] , tr [] [ th [] [ text "email" ] - , td [] [ text $ c.email ] + , td [] [ text $ fold c.email ] ] , tr [] [ th [] [ text "phone" ] , td [] [ text $ fold c.phone ] @@ -130,6 +132,9 @@ customerHtml c = , tr [] [ th [] [ text "description" ] , td [] [ text $ fold c.description ] ] + , tr [] [ th [] [ text "address" ] + , td [] [ maybe (text "no address") addressHtml c.address ] + ] , tr [] [ th [] [ text "balance" ] , td [] [ text $ c.currency <> " " <> show c.balance <> " cents" ] ] @@ -148,6 +153,67 @@ taxIdDataHtml x = , 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 = + table [] + [ tr [] [ th [] [ text "name" ] + , td [] [ text $ fold bd.name ] + ] + , tr [] [ th [] [ text "email" ] + , td [] [ text $ fold bd.email ] + ] + , tr [] [ th [] [ text "phone" ] + , td [] [ text $ fold bd.phone ] + ] + , tr [] [ th [] [ text "address" ] + , td [] [ maybe (text "no address") addressHtml bd.address ] + ] + ] + +addressHtml :: ∀ m. MonadAff m => Stripe.Address -> ComponentHTML Action ChildSlots m +addressHtml a = + table [] + [ 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 + -------------------------------------------------------------------------------- spyM :: ∀ m a. Applicative m => String -> a -> m Unit diff --git a/console/src/Stripe.purs b/console/src/Stripe.purs index e97489fe..798a4ac4 100644 --- a/console/src/Stripe.purs +++ b/console/src/Stripe.purs @@ -8,8 +8,9 @@ type Customer = , id :: CustomerId , name :: Maybe String , description :: Maybe String - , email :: Email + , email :: Maybe Email , phone :: Maybe String + , address :: Maybe Address , balance :: Amount , currency :: Currency , invoice_prefix :: String @@ -44,21 +45,25 @@ type PaymentMethodId = String type PaymentMethodType = String type BillingDetails = - { name :: Maybe String - , phone :: Maybe Phone - , email :: Maybe Email - , address :: Maybe Address + { name :: Maybe String + , phone :: Maybe Phone + , email :: Maybe Email + , address :: Maybe Address } +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 - } + { 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. @@ -70,6 +75,9 @@ type CardBrand = String -- | One of `"credit"` | `"debit"` | `"prepeaid"` | `"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 From c19b6be41936a04a0533ceca515d01f2b70c2035 Mon Sep 17 00:00:00 2001 From: Erik Post Date: Fri, 20 Mar 2020 16:40:45 +0100 Subject: [PATCH 04/12] stripe: Fix typo: prepeaid -> prepaid. #376 --- console/src/Stripe.purs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/console/src/Stripe.purs b/console/src/Stripe.purs index 798a4ac4..394d27f9 100644 --- a/console/src/Stripe.purs +++ b/console/src/Stripe.purs @@ -72,7 +72,7 @@ type CardFingerprint = String -- | One of `"amex"` | `"diners"` | `"discover"` | `"jcb"` | `"mastercard"` | `"unionpay"` | `"visa"` | `"unknown"`. type CardBrand = String --- | One of `"credit"` | `"debit"` | `"prepeaid"` | `"unknown"`. +-- | One of `"credit"` | `"debit"` | `"prepaid"` | `"unknown"`. type Funding = String -- | If a CVC was provided, results of the check: `"pass"` | `"fail"` | `"unavailable"` | `"unchecked"`. From 5c38b073e957339be3dbebc5d89eaf68fd3dd826 Mon Sep 17 00:00:00 2001 From: Erik Post Date: Fri, 20 Mar 2020 17:02:47 +0100 Subject: [PATCH 05/12] console: Tweak Customer and Invoice rendering. #376 --- console/src/Statebox/Console.purs | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs index 1828360c..b0f3a26a 100644 --- a/console/src/Statebox/Console.purs +++ b/console/src/Statebox/Console.purs @@ -103,19 +103,20 @@ render state = , h3 [] [ text "Customer's payment methods" ] , div [] (state.paymentMethods <#> paymentMethodHtml) , h2 [] [ text "Invoices" ] - , div [] - (state.accounts <#> \account -> table [] - (account.invoices <#> invoiceSummaryLineHtml) - ) + , div [] (state.accounts <#> \account -> invoiceSummaries account.invoices) ] -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 $ i.currency ] - , td [] [ text $ show i.amount_due ] - ] +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 $ i.currency ] + , td [] [ text $ show i.amount_due ] + ] customerHtml :: ∀ m. MonadAff m => Stripe.Customer -> ComponentHTML Action ChildSlots m customerHtml c = @@ -138,7 +139,7 @@ customerHtml c = , tr [] [ th [] [ text "balance" ] , td [] [ text $ c.currency <> " " <> show c.balance <> " cents" ] ] - , tr [] [ th [] [ text "tax" ] + , tr [] [ th [] [ text "tax ids" ] , td [] [ taxIdsHtml c.tax_ids ] ] ] From c14a37b5f986cca07f7dfb792a3a3abc7a18a22f Mon Sep 17 00:00:00 2001 From: Erik Post Date: Fri, 20 Mar 2020 17:03:24 +0100 Subject: [PATCH 06/12] console: Fetch Customer first. #376 --- console/src/Statebox/Console.purs | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs index b0f3a26a..63cc84c3 100644 --- a/console/src/Statebox/Console.purs +++ b/console/src/Statebox/Console.purs @@ -72,18 +72,22 @@ handleAction :: ∀ m. MonadAff m => Action -> HalogenM State Action ChildSlots handleAction = case _ of FetchStuff -> do H.liftEffect $ log "handling action FetchStuff..." - 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 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 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."}) From 20e2cc3f82a4fd212620254b2ae5d6de0927827b Mon Sep 17 00:00:00 2001 From: Erik Post Date: Fri, 20 Mar 2020 17:04:10 +0100 Subject: [PATCH 07/12] console: Factor out common fields form Stripe data structures. #376 --- console/src/Statebox/Console.purs | 13 ++++++++----- console/src/Stripe.purs | 23 +++++++++++++---------- 2 files changed, 21 insertions(+), 15 deletions(-) diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs index 63cc84c3..341dbcbb 100644 --- a/console/src/Statebox/Console.purs +++ b/console/src/Statebox/Console.purs @@ -170,19 +170,22 @@ paymentMethodHtml pm = ] billingDetailsHtml :: ∀ m. MonadAff m => Stripe.BillingDetails -> ComponentHTML Action ChildSlots m -billingDetailsHtml bd = +billingDetailsHtml bd = nameAddressPhoneHtml bd + +nameAddressPhoneHtml :: ∀ r m. MonadAff m => { | Stripe.NameAddressPhoneRow () } -> ComponentHTML Action ChildSlots m +nameAddressPhoneHtml x = table [] [ tr [] [ th [] [ text "name" ] - , td [] [ text $ fold bd.name ] + , td [] [ text $ fold x.name ] ] , tr [] [ th [] [ text "email" ] - , td [] [ text $ fold bd.email ] + , td [] [ text $ fold x.email ] ] , tr [] [ th [] [ text "phone" ] - , td [] [ text $ fold bd.phone ] + , td [] [ text $ fold x.phone ] ] , tr [] [ th [] [ text "address" ] - , td [] [ maybe (text "no address") addressHtml bd.address ] + , td [] [ maybe (text "no address") addressHtml x.address ] ] ] diff --git a/console/src/Stripe.purs b/console/src/Stripe.purs index 394d27f9..430a6bf8 100644 --- a/console/src/Stripe.purs +++ b/console/src/Stripe.purs @@ -6,11 +6,7 @@ import Data.Maybe (Maybe) type Customer = { object :: ObjectTag , id :: CustomerId - , name :: Maybe String , description :: Maybe String - , email :: Maybe Email - , phone :: Maybe String - , address :: Maybe Address , balance :: Amount , currency :: Currency , invoice_prefix :: String @@ -19,6 +15,7 @@ type Customer = , delinquent :: Boolean , tax_ids :: ArrayWrapper TaxIdData , tax_exempt :: TaxExemptType + | NameAddressPhoneRow () } type CustomerId = String @@ -44,12 +41,7 @@ type PaymentMethodId = String -- | One of `"card"` | `"fpx"` | `"ideal"` | `"sepa_debit"`. See https://stripe.com/docs/api/payment_methods/object. type PaymentMethodType = String -type BillingDetails = - { name :: Maybe String - , phone :: Maybe Phone - , email :: Maybe Email - , address :: Maybe Address - } +type BillingDetails = { | NameAddressPhoneRow () } type BillingDetailsId = String @@ -168,6 +160,17 @@ 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 From 022bd9f185e66809f1c16c7b732077a8b54bcff1 Mon Sep 17 00:00:00 2001 From: Erik Post Date: Fri, 20 Mar 2020 17:16:32 +0100 Subject: [PATCH 08/12] console: Visually clean up Address rendering. #376 --- console/src/Statebox/Console.purs | 62 +++++++++++++++---------------- 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs index 341dbcbb..2ce46c2a 100644 --- a/console/src/Statebox/Console.purs +++ b/console/src/Statebox/Console.purs @@ -124,23 +124,22 @@ invoiceSummaries invoices = customerHtml :: ∀ m. MonadAff m => Stripe.Customer -> ComponentHTML Action ChildSlots m customerHtml c = - table [] + 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 ] ] - , tr [] [ th [] [ text "description" ] - , td [] [ text $ fold c.description ] - ] - , tr [] [ th [] [ text "address" ] - , td [] [ maybe (text "no address") addressHtml c.address ] - ] - , tr [] [ th [] [ text "balance" ] + ] <> + foldMap addressRowsHtml c.address <> + [ tr [] [ th [] [ text "balance" ] , td [] [ text $ c.currency <> " " <> show c.balance <> " cents" ] ] , tr [] [ th [] [ text "tax ids" ] @@ -174,7 +173,7 @@ billingDetailsHtml bd = nameAddressPhoneHtml bd nameAddressPhoneHtml :: ∀ r m. MonadAff m => { | Stripe.NameAddressPhoneRow () } -> ComponentHTML Action ChildSlots m nameAddressPhoneHtml x = - table [] + table [] $ [ tr [] [ th [] [ text "name" ] , td [] [ text $ fold x.name ] ] @@ -184,30 +183,31 @@ nameAddressPhoneHtml x = , tr [] [ th [] [ text "phone" ] , td [] [ text $ fold x.phone ] ] - , tr [] [ th [] [ text "address" ] - , td [] [ maybe (text "no address") addressHtml x.address ] - ] - ] + ] <> + foldMap addressRowsHtml x.address addressHtml :: ∀ m. MonadAff m => Stripe.Address -> ComponentHTML Action ChildSlots m -addressHtml a = - table [] - [ 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 ] - ] - ] +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 = From e9728892d740320190f3933bded0056706583a70 Mon Sep 17 00:00:00 2001 From: Erik Post Date: Thu, 7 May 2020 22:09:10 +0200 Subject: [PATCH 09/12] console: Cover more Stripe API Surface (Plan, Product, etc). #376 --- console/package.json | 7 +- console/src/Statebox/Console.purs | 148 ++++++++++++++++++++++++- console/src/Statebox/Console/DAO.purs | 24 ++++ console/src/Statebox/Console/Main.purs | 2 + console/src/Stripe.purs | 46 ++++++-- 5 files changed, 212 insertions(+), 15 deletions(-) diff --git a/console/package.json b/console/package.json index 784de5a0..557fd8b0 100644 --- a/console/package.json +++ b/console/package.json @@ -25,13 +25,14 @@ "devDependencies": { "concurrently": "^5.0.2", "parcel-bundler": "^1.12.4", - "purescript": "^0.13.5", + "purescript": "^0.13.6", "purescript-psa": "^0.7.3", - "spago": "^0.13" + "spago": "^0.14" }, "dependencies": { "@statebox/stbx-js": "0.0.31", "@statebox/style": "0.0.6", - "dagre": "^0.8.4" + "dagre": "^0.8.4", + "firebaseui": "^4.5.0" } } diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs index 2ce46c2a..c961519d 100644 --- a/console/src/Statebox/Console.purs +++ b/console/src/Statebox/Console.purs @@ -11,7 +11,7 @@ import Effect.Aff.Class (class MonadAff) import Effect.Console (log) import Halogen as H import Halogen (ComponentHTML) -import Halogen.HTML (HTML, p, text, br, div, ul, li, h2, h3, table, tr, th, td) +import Halogen.HTML (HTML, p, text, br, span, div, ul, li, h2, h3, table, tr, th, td) import Halogen.Query.HalogenM (HalogenM) import Statebox.Console.DAO as DAO @@ -25,6 +25,8 @@ import Debug.Trace (spy) type State = { customer :: Maybe Stripe.Customer , paymentMethods :: Array Stripe.PaymentMethod + , subscriptions :: Array Stripe.Subscription + , plans :: Array Stripe.PlanWithExpandedProduct , accounts :: Array { invoices :: Array Stripe.Invoice } , status :: AppStatus @@ -87,6 +89,20 @@ handleAction = case _ of (\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." }) @@ -106,6 +122,10 @@ render state = , div [] (maybe [] (pure <<< customerHtml) state.customer) , h3 [] [ text "Customer's payment methods" ] , div [] (state.paymentMethods <#> paymentMethodHtml) + , h2 [] [ text "Subscriptions" ] + , div [] (state.subscriptions <#> subscriptionHtml) + , h2 [] [ text "Plans" ] + , div [] (state.plans <#> planWithExpandedProductHtml) , h2 [] [ text "Invoices" ] , div [] (state.accounts <#> \account -> invoiceSummaries account.invoices) ] @@ -118,8 +138,7 @@ invoiceSummaries invoices = invoiceSummaryLineHtml i = tr [] [ td [] [ text $ i.customer_email ] , td [] [ text $ i.account_name ] - , td [] [ text $ i.currency ] - , td [] [ text $ show i.amount_due ] + , td [] [ text $ formatCurrency i.currency i.amount_due ] ] customerHtml :: ∀ m. MonadAff m => Stripe.Customer -> ComponentHTML Action ChildSlots m @@ -140,7 +159,7 @@ customerHtml c = ] <> foldMap addressRowsHtml c.address <> [ tr [] [ th [] [ text "balance" ] - , td [] [ text $ c.currency <> " " <> show c.balance <> " cents" ] + , td [] [ text $ formatCurrency c.currency c.balance ] ] , tr [] [ th [] [ text "tax ids" ] , td [] [ taxIdsHtml c.tax_ids ] @@ -171,7 +190,7 @@ paymentMethodHtml pm = billingDetailsHtml :: ∀ m. MonadAff m => Stripe.BillingDetails -> ComponentHTML Action ChildSlots m billingDetailsHtml bd = nameAddressPhoneHtml bd -nameAddressPhoneHtml :: ∀ r m. MonadAff m => { | Stripe.NameAddressPhoneRow () } -> ComponentHTML Action ChildSlots m +nameAddressPhoneHtml :: ∀ m. MonadAff m => { | Stripe.NameAddressPhoneRow () } -> ComponentHTML Action ChildSlots m nameAddressPhoneHtml x = table [] $ [ tr [] [ th [] [ text "name" ] @@ -222,6 +241,125 @@ cardHtml c = 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 diff --git a/console/src/Statebox/Console/DAO.purs b/console/src/Statebox/Console/DAO.purs index 8a265095..6d01d79a 100644 --- a/console/src/Statebox/Console/DAO.purs +++ b/console/src/Statebox/Console/DAO.purs @@ -52,3 +52,27 @@ listPaymentMethods' = , 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 index b4cfddfd..b0d9fd21 100644 --- a/console/src/Statebox/Console/Main.purs +++ b/console/src/Statebox/Console/Main.purs @@ -19,6 +19,8 @@ main = runHalogenAff do initialState :: Console.State initialState = { customer: Nothing , paymentMethods: mempty + , subscriptions: mempty + , plans: mempty , accounts: [ { invoices: mempty } ] , status: Console.Ok } diff --git a/console/src/Stripe.purs b/console/src/Stripe.purs index 430a6bf8..7ff68dda 100644 --- a/console/src/Stripe.purs +++ b/console/src/Stripe.purs @@ -95,10 +95,17 @@ type Subscription = , 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 @@ -106,7 +113,6 @@ type SubscriptionId = String type SubscriptionItem = { id :: SubscriptionItemId , object :: ObjectTag - , quantity :: Int , subscription :: SubscriptionId , plan :: Plan , created :: Timestamp @@ -114,14 +120,18 @@ type SubscriptionItem = type SubscriptionItemId = String --- | E.g. `"charge_automatically"` -type CollectionMethod = 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 -type Plan = +-- | Either `"charge_automatically"` | `"send_invoice"`. +type CollectionMethodString = String + +type Plan' product = { id :: PlanId , object :: ObjectTag , nickname :: Maybe String - , product :: ProductId + , product :: product , amount :: Amount , amount_decimal :: AmountDecimal , currency :: Currency @@ -131,6 +141,10 @@ type Plan = , interval_count :: Int } +type Plan = Plan' ProductId + +type PlanWithExpandedProduct = Plan' Product + type PlanId = String -- | E.g. `"per_unit"` @@ -139,8 +153,27 @@ 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 = @@ -216,8 +249,7 @@ type Year = Int -------------------------------------------------------------------------------- --- | Stripe populates this with things like `"customer"`, `"object"`, --- | `"list"` and so on. +-- | Stripe populates this with things like `"customer"`, `"object"`, `"list"` and so on. type ObjectTag = String type ArrayWrapperRow a r = From ce8cb7736317d1518f0e69dece8b5c63904b9f2f Mon Sep 17 00:00:00 2001 From: Erik Post Date: Sun, 31 May 2020 17:43:32 +0200 Subject: [PATCH 10/12] console: Routing WIP. #376 --- console/package.json | 4 +- console/spago.dhall | 3 + console/src/Statebox/Console.purs | 121 +++++++++++++++++++++---- console/src/Statebox/Console/Main.purs | 40 +++++++- 4 files changed, 148 insertions(+), 20 deletions(-) diff --git a/console/package.json b/console/package.json index 557fd8b0..f6fd35f7 100644 --- a/console/package.json +++ b/console/package.json @@ -25,9 +25,9 @@ "devDependencies": { "concurrently": "^5.0.2", "parcel-bundler": "^1.12.4", - "purescript": "^0.13.6", + "purescript": "^0.13.8", "purescript-psa": "^0.7.3", - "spago": "^0.14" + "spago": "^0.15.2" }, "dependencies": { "@statebox/stbx-js": "0.0.31", diff --git a/console/spago.dhall b/console/spago.dhall index 21630026..118922b6 100644 --- a/console/spago.dhall +++ b/console/spago.dhall @@ -9,6 +9,9 @@ , "effect" , "halogen" , "psci-support" + , "routing" + , "routing-duplex" + , "studio" ] , packages = ../packages.dhall diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs index c961519d..defe2c01 100644 --- a/console/src/Statebox/Console.purs +++ b/console/src/Statebox/Console.purs @@ -2,34 +2,45 @@ module Statebox.Console where import Prelude 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, p, text, br, span, div, ul, li, h2, h3, table, tr, th, td) +import Halogen.HTML (HTML, p, text, br, span, div, ul, li, h2, h3, table, tr, th, td, button) +import Halogen.HTML.Events (onClick, onValueInput) import Halogen.Query.HalogenM (HalogenM) import Statebox.Console.DAO as DAO +import View.Model (Project(..), ProjectId) import Stripe as Stripe import Debug.Trace (spy) +-- TODO +fakeCustomerId = "TODO" + -------------------------------------------------------------------------------- type State = - { customer :: Maybe Stripe.Customer + { route :: Route + , customer :: Maybe Stripe.Customer , paymentMethods :: Array Stripe.PaymentMethod , subscriptions :: Array Stripe.Subscription , plans :: Array Stripe.PlanWithExpandedProduct , accounts :: Array { invoices :: Array Stripe.Invoice } , status :: AppStatus + , projects :: Map ProjectId Project } _accounts = prop (SProxy :: SProxy "accounts") @@ -37,6 +48,22 @@ _invoices = prop (SProxy :: SProxy "invoices") -------------------------------------------------------------------------------- +data Route + = Home + | Projects + | ProjectR ProjectId + | APIKeys + | Invoices Stripe.CustomerId + | Account + | 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 @@ -48,9 +75,12 @@ instance showAppStatus :: Show AppStatus where type Input = State -data Action = FetchStuff +data Action + = SelectRoute Route + | FetchStuff -data Query a = DoAction Action a +data Query a + = DoAction Action a type ChildSlots = () @@ -66,12 +96,16 @@ mkInitialState :: Input -> State mkInitialState input = input handleQuery = case _ of - (DoAction x next) -> do + DoAction x next -> do handleAction x pure (Just next) handleAction :: ∀ m. MonadAff m => Action -> HalogenM State Action ChildSlots Void m Unit handleAction = case _ of + + SelectRoute newRoute -> do + H.modify_ \state -> state { route = newRoute } + FetchStuff -> do H.liftEffect $ log "handling action FetchStuff..." @@ -117,19 +151,74 @@ handleAction = case _ of render :: ∀ m. MonadAff m => State -> ComponentHTML Action ChildSlots m render state = div [] - [ p [] [ text $ if state.status == Ok then "" else "status: " <> show state.status ] - , h2 [] [ text "Customer" ] - , div [] (maybe [] (pure <<< customerHtml) state.customer) - , h3 [] [ text "Customer's payment methods" ] - , div [] (state.paymentMethods <#> paymentMethodHtml) - , h2 [] [ text "Subscriptions" ] - , div [] (state.subscriptions <#> subscriptionHtml) - , h2 [] [ text "Plans" ] - , div [] (state.plans <#> planWithExpandedProductHtml) - , h2 [] [ text "Invoices" ] - , div [] (state.accounts <#> \account -> invoiceSummaries account.invoices) + [ 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 = + div [] + [ button [ onClick \e -> Just $ SelectRoute $ Home ] [ text "Home" ] + , button [ onClick \e -> Just $ SelectRoute $ Projects ] [ text "Projects" ] + , button [ onClick \e -> Just $ SelectRoute $ Account ] [ text "Billing Accounts" ] + , button [ onClick \e -> Just $ SelectRoute $ APIKeys ] [ text "API Keys" ] + , button [ onClick \e -> Just $ SelectRoute $ Invoices fakeCustomerId ] [ text "Invoices" ] + , button [ onClick \e -> Just $ SelectRoute $ Subscription ] [ text "Subscriptions" ] + , button [ onClick \e -> Just $ SelectRoute $ Plan ] [ text "Plans" ] + ] + +contentHtml :: ∀ m. MonadAff m => State -> ComponentHTML Action ChildSlots m +contentHtml state = case state.route of + Home -> + div [] + [ h2 [] [ text "Statebox Cloud Admin Console" ] + , text "Welcome!" + ] + Projects -> + div [] $ + [ h2 [] [ text "Projects" ] + , div [] $ Map.toUnfoldable state.projects <#> + (\(projectId /\ project) -> button [ onClick \e -> Just $ SelectRoute $ ProjectR projectId ] [ text project.name ]) + ] + APIKeys -> + div [] $ + [ h2 [] [ text "API keys" ] + , p [] [ text "* Create" ] + , p [] [ text "* Deprecate" ] + , p [] [ text "* Assign to a root" ] + ] + ProjectR projectId -> + div [] + [ h2 [] [ text $ "Project " <> show projectId ] + , h3 [] [ text $ "API keys" ] + , h3 [] [ text $ "Roots" ] + ] + Account -> + div [] + [ 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) diff --git a/console/src/Statebox/Console/Main.purs b/console/src/Statebox/Console/Main.purs index b0d9fd21..19382804 100644 --- a/console/src/Statebox/Console/Main.purs +++ b/console/src/Statebox/Console/Main.purs @@ -1,26 +1,62 @@ module Statebox.Console.Main where -import Prelude +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 ExampleData as ExampleData +import View.Model (ProjectId, Project) -- TODO rm, 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 = { customer: Nothing + initialState = { route: Home + , customer: Nothing , paymentMethods: mempty , subscriptions: mempty , plans: mempty , accounts: [ { invoices: mempty } ] + , projects: exampleProjects + -- , projects: [ ExampleData.project1 ] , status: Console.Ok } + + +routesCodex :: RouteDuplex' Route +routesCodex = root $ sum + { "Home": noArgs + , "ProjectR": "project" / segment + , "Projects": "project" / noArgs + , "APIKeys": "key" / noArgs + , "Account": "account" / noArgs + , "Invoices": "invoices" / segment + , "Subscription": "subscriptions" / noArgs + , "Plan": "plans" / noArgs + } + +-------------------------------------------------------------------------------- + +exampleProjects :: Map ProjectId Project +exampleProjects = Map.fromFoldable + [ "project1" /\ ExampleData.project1 + ] From 32d4d916c780cea7d6697eb789a20374a317710d Mon Sep 17 00:00:00 2001 From: Erik Post Date: Mon, 1 Jun 2020 20:09:37 +0200 Subject: [PATCH 11/12] console: Make some routes and buttons do stuff. #376 --- console/spago.dhall | 1 - console/src/Statebox/Console.purs | 140 +++++++++++++++++++++---- console/src/Statebox/Console/Main.purs | 22 ++-- 3 files changed, 136 insertions(+), 27 deletions(-) diff --git a/console/spago.dhall b/console/spago.dhall index 118922b6..e6ce4e0b 100644 --- a/console/spago.dhall +++ b/console/spago.dhall @@ -11,7 +11,6 @@ , "psci-support" , "routing" , "routing-duplex" - , "studio" ] , packages = ../packages.dhall diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs index defe2c01..f3f40137 100644 --- a/console/src/Statebox/Console.purs +++ b/console/src/Statebox/Console.purs @@ -1,6 +1,7 @@ module Statebox.Console where import Prelude +import Data.Array (cons, filter) import Data.Either (either) import Data.Generic.Rep import Data.Lens @@ -20,7 +21,6 @@ import Halogen.HTML.Events (onClick, onValueInput) import Halogen.Query.HalogenM (HalogenM) import Statebox.Console.DAO as DAO -import View.Model (Project(..), ProjectId) import Stripe as Stripe @@ -29,18 +29,44 @@ import Debug.Trace (spy) -- TODO fakeCustomerId = "TODO" +type ApiKey = { hex :: Hex, name :: String } +type RootId = String -- TODO get from stbx-core +type TxHash = Hex -- TODO get from stbx-core +type Hex = String -- TODO get from stbx-core + +-------------------------------------------------------------------------------- + +-- | 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 - } - , status :: AppStatus - , projects :: Map ProjectId Project + { 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") @@ -53,8 +79,9 @@ data Route | Projects | ProjectR ProjectId | APIKeys + | RootTx | Invoices Stripe.CustomerId - | Account + | Account Stripe.CustomerId | Subscription | Plan @@ -77,6 +104,15 @@ type Input = State data Action = SelectRoute Route + + | CreateRootTx + | PublishRootTx TxPubInfo + + | CreateApiKey + | DeprecateApiKey ApiKey + | AssociateApiKeyWithProject ApiKey ProjectId + | AssociateApiKeyWithRoot ApiKey RootId + | FetchStuff data Query a @@ -100,12 +136,41 @@ handleQuery = case _ of 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..." @@ -161,7 +226,6 @@ navMenuHtml state = div [] [ button [ onClick \e -> Just $ SelectRoute $ Home ] [ text "Home" ] , button [ onClick \e -> Just $ SelectRoute $ Projects ] [ text "Projects" ] - , button [ onClick \e -> Just $ SelectRoute $ Account ] [ text "Billing Accounts" ] , button [ onClick \e -> Just $ SelectRoute $ APIKeys ] [ text "API Keys" ] , button [ onClick \e -> Just $ SelectRoute $ Invoices fakeCustomerId ] [ text "Invoices" ] , button [ onClick \e -> Just $ SelectRoute $ Subscription ] [ text "Subscriptions" ] @@ -173,28 +237,64 @@ contentHtml state = case state.route of Home -> div [] [ h2 [] [ text "Statebox Cloud Admin Console" ] - , text "Welcome!" + + , h3 [] [ text "Projects" ] + , ul [] $ Map.toUnfoldable state.projects <#> (\(projectId /\ project) -> + li [] [ button [ onClick \e -> Just $ SelectRoute $ ProjectR projectId ] [ text project.name ] ]) + + , h3 [] [ text "Billing accounts" ] + , ul [] $ customers <#> \customer -> + li [] [ button [ onClick \e -> Just $ SelectRoute $ Account customer.id ] [ text $ fold customer.name ] + , text $ fold customer.description + ] + + , h3 [] [ text "API keys" ] + , ul [] $ state.apiKeys <#> \key -> li [] [ p [] [ 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 [] [ text "* Create" ] - , p [] [ text "* Deprecate" ] + , 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 [] [ button [ onClick \e -> Just $ DeprecateApiKey key ] [ text "Deprecate" ] ] + ] , p [] [ text "* Assign to a root" ] ] - ProjectR projectId -> + RootTx -> div [] - [ h2 [] [ text $ "Project " <> show projectId ] - , h3 [] [ text $ "API keys" ] - , h3 [] [ text $ "Roots" ] + [ 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 -> + Account customerId -> div [] [ h2 [] [ text "Customer" ] , div [] (maybe [] (pure <<< customerHtml) state.customer) diff --git a/console/src/Statebox/Console/Main.purs b/console/src/Statebox/Console/Main.purs index 19382804..3dad2cec 100644 --- a/console/src/Statebox/Console/Main.purs +++ b/console/src/Statebox/Console/Main.purs @@ -17,9 +17,7 @@ import Routing.PushState as Routing.PushState import Statebox.Console as Console import Statebox.Console (Route(..)) - -import ExampleData as ExampleData -import View.Model (ProjectId, Project) -- TODO rm, used to define example data +import Statebox.Console (ProjectId, Project) -- TODO remove, used to define example data main :: Effect Unit main = runHalogenAff do @@ -36,8 +34,11 @@ main = runHalogenAff do , subscriptions: mempty , plans: mempty , accounts: [ { invoices: mempty } ] + , apiKeys : [ { name: "My API key #1", hex: "01010101" } + , { name: "My API key #2", hex: "02020202" } + ] , projects: exampleProjects - -- , projects: [ ExampleData.project1 ] + , rootTransactions: ["00AA00", "00BB00", "00CC00" ] , status: Console.Ok } @@ -47,8 +48,9 @@ routesCodex = root $ sum { "Home": noArgs , "ProjectR": "project" / segment , "Projects": "project" / noArgs + , "RootTx": "tx" / noArgs , "APIKeys": "key" / noArgs - , "Account": "account" / noArgs + , "Account": "account" / segment , "Invoices": "invoices" / segment , "Subscription": "subscriptions" / noArgs , "Plan": "plans" / noArgs @@ -58,5 +60,13 @@ routesCodex = root $ sum exampleProjects :: Map ProjectId Project exampleProjects = Map.fromFoldable - [ "project1" /\ ExampleData.project1 + [ "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" ] + } ] From b5b98234b98c45d0b1bb8218e49da2c82b5fbbfa Mon Sep 17 00:00:00 2001 From: Erik Post Date: Mon, 1 Jun 2020 23:07:38 +0200 Subject: [PATCH 12/12] console: Some work to make the UI look more like it should. #376 --- console/html/console.css | 6 ++- console/package.json | 2 +- console/src/Statebox/Console.purs | 68 ++++++++++++++++---------- console/src/Statebox/Console/Main.purs | 4 +- 4 files changed, 50 insertions(+), 30 deletions(-) diff --git a/console/html/console.css b/console/html/console.css index 71aad98b..7fdeafd3 100644 --- a/console/html/console.css +++ b/console/html/console.css @@ -1 +1,5 @@ -background: red; +#user { + position: fixed; + z-index: 2; + right: 70px; +} diff --git a/console/package.json b/console/package.json index f6fd35f7..3844c5e5 100644 --- a/console/package.json +++ b/console/package.json @@ -31,7 +31,7 @@ }, "dependencies": { "@statebox/stbx-js": "0.0.31", - "@statebox/style": "0.0.6", + "@statebox/style": "0.0.9", "dagre": "^0.8.4", "firebaseui": "^4.5.0" } diff --git a/console/src/Statebox/Console.purs b/console/src/Statebox/Console.purs index f3f40137..881e5044 100644 --- a/console/src/Statebox/Console.purs +++ b/console/src/Statebox/Console.purs @@ -16,7 +16,9 @@ import Effect.Aff.Class (class MonadAff) import Effect.Console (log) import Halogen as H import Halogen (ComponentHTML) -import Halogen.HTML (HTML, p, text, br, span, div, ul, li, h2, h3, table, tr, th, td, button) +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) @@ -29,13 +31,22 @@ import Debug.Trace (spy) -- TODO fakeCustomerId = "TODO" -type ApiKey = { hex :: Hex, name :: String } 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 @@ -223,35 +234,38 @@ render state = navMenuHtml :: ∀ m. MonadAff m => State -> ComponentHTML Action ChildSlots m navMenuHtml state = - div [] - [ button [ onClick \e -> Just $ SelectRoute $ Home ] [ text "Home" ] - , button [ onClick \e -> Just $ SelectRoute $ Projects ] [ text "Projects" ] - , button [ onClick \e -> Just $ SelectRoute $ APIKeys ] [ text "API Keys" ] - , button [ onClick \e -> Just $ SelectRoute $ Invoices fakeCustomerId ] [ text "Invoices" ] - , button [ onClick \e -> Just $ SelectRoute $ Subscription ] [ text "Subscriptions" ] - , button [ onClick \e -> Just $ SelectRoute $ Plan ] [ text "Plans" ] + 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 [] - [ h2 [] [ text "Statebox Cloud Admin Console" ] - - , h3 [] [ text "Projects" ] - , ul [] $ Map.toUnfoldable state.projects <#> (\(projectId /\ project) -> - li [] [ button [ onClick \e -> Just $ SelectRoute $ ProjectR projectId ] [ text project.name ] ]) - - , h3 [] [ text "Billing accounts" ] - , ul [] $ customers <#> \customer -> - li [] [ button [ onClick \e -> Just $ SelectRoute $ Account customer.id ] [ text $ fold customer.name ] - , text $ fold customer.description + 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 ] ] - - , h3 [] [ text "API keys" ] - , ul [] $ state.apiKeys <#> \key -> li [] [ p [] [ text key.name ] - , p [] [ text key.hex ] - ] ] where -- TODO in reality we should have multiple customers @@ -281,6 +295,7 @@ contentHtml state = case state.route of , 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" ] @@ -296,7 +311,8 @@ contentHtml state = case state.route of ] Account customerId -> div [] - [ h2 [] [ text "Customer" ] + [ 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) diff --git a/console/src/Statebox/Console/Main.purs b/console/src/Statebox/Console/Main.purs index 3dad2cec..c48f357c 100644 --- a/console/src/Statebox/Console/Main.purs +++ b/console/src/Statebox/Console/Main.purs @@ -34,8 +34,8 @@ main = runHalogenAff do , subscriptions: mempty , plans: mempty , accounts: [ { invoices: mempty } ] - , apiKeys : [ { name: "My API key #1", hex: "01010101" } - , { name: "My API key #2", hex: "02020202" } + , 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" ]