Add createPaymentRequestHandler

[?]
Feb 6, 2021, 9:36 PM
KKJSBWO6RNORAPTJPCCUJJNVI2OYTGLQKB3XJGOASH43GNTJBMKAC

Dependencies

  • [2] XXJFUZOV Add first revenue date to project payout computation.
  • [3] KET5QGQP Add billable list (in-progress)
  • [4] YBLHJFCN Implement billing modal.
  • [5] 3PFXXJTL WIP
  • [6] SQ7UMLN5 Get z-addr checks working.
  • [7] T2DN23M7 Factor out billing create component.
  • [8] 4354Y4PE Add endpoint to list project contributors.
  • [9] IR75ZMX3 Return actual events for interval ends, not just timestamps.
  • [10] N6FG4EW6 Working bootstrap modal! Only a little FFI.
  • [11] ANDJ6GEY Add billing component skeleton.
  • [12] IPG33FAW Add billing daemon
  • [13] M4PWY5RU Preliminary work to add support for Zcash payments.
  • [14] GCVQD44V Create amends endpoint, switch to UUID primary keys
  • [15] O227CEAV Adds storage of original event JSON for some DBOp constructors.
  • [16] RFYEVKZQ Add nix-shell based build environment.
  • [17] DZ7G36NC Allow first-revenue cutoff for depreciation.
  • [18] UWMGUJOW Autoformat sources.
  • [19] DFOBMSAO Initial work on payments API
  • [20] SEWTRB6S Implement payment request creation functions.
  • [21] 4R7XIYK3 Switch from ClassyPrelude to Relude
  • [22] DJATFGIC Support client builds in nix-shell --pure.
  • [23] 27H4DECZ Add billing create API call.
  • [24] BSIUHCGF Add payment response handler.
  • [25] AL37SVTC Implement payments service endpoints.
  • [26] 4GOBY5NQ WIP on modals.
  • [27] B6HWAPDP Modularize & update to recent haskoin.
  • [28] U7YAT2ZK Add error reporting to signup form.
  • [29] EFSXYZPO Autoformat everything with brittany.
  • [30] X3ES7NUA Fine. I'll use ormolu. At least it doesn't break the code.
  • [*] VTZT2ILU Wire up billing navigation.
  • [*] W35DDBFY Factor common JSON conversions up into client lib module.
  • [*] NVOCQVAS Initial failing tests.
  • [*] KEP5WUFJ Convert project to stack-based build.

Change contents

  • edit in client/src/Aftok/Api/Billing.purs at line 9
    [4.234]
    [4.120]
    import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)
  • replacement in client/src/Aftok/Api/Billing.purs at line 26
    [3.370][3.370:405]()
    import Data.Traversable (traverse)
    [3.370]
    [4.842]
    import Data.Traversable (traverse, sequence)
  • edit in client/src/Aftok/Api/Billing.purs at line 69
    [32.400]
    [4.1634]
    instance showRecurrence :: Show Recurrence where
    show = case _ of
    Annually -> "Annually"
    Monthly i -> "Monthly " <> show i
    Weekly i -> "Weekly " <> show i
    OneTime -> "OneTime"
    recurrenceStr :: Recurrence -> String
    recurrenceStr = case _ of
    Annually -> "Annually"
    Monthly i -> "Every " <> show i <> " months"
    Weekly i -> "Every " <> show i <> " weeks"
    OneTime -> "One-time purchase"
  • replacement in client/src/Aftok/Api/Billing.purs at line 119
    [3.702][3.702:898]()
    let annually = traverse (map \(_ :: Unit) -> Annually) (obj .:? "annually")
    monthly = traverse (map Monthly) (obj .:? "monthly")
    weekly = traverse (map Weekly) (obj .:? "weekly")
    [3.702]
    [3.898]
    let parseInner f outer inner = map f ((MaybeT <<< (_ .:? inner)) =<< MaybeT (obj .:? outer))
    annually = traverse (map \(_ :: Unit) -> Annually) (obj .:? "annually")
    monthly = sequence $ runMaybeT (parseInner Monthly "monthly" "months")
    weekly = sequence $ runMaybeT (parseInner Weekly "weekly" "weeks")
  • edit in client/src/Aftok/Api/Billing.purs at line 125
    [3.1057][3.1057:1064]()
  • edit in client/src/Aftok/Api/Billing.purs at line 126
    [4.1711][4.975:976]()
  • replacement in client/src/Aftok/Api/Billing.purs at line 133
    [3.1370][3.1370:1441]()
    recurrence :: Recurrence <- parseRecurrence =<< bobj .: "recurrence"
    [3.1370]
    [3.1441]
    recurrence <- parseRecurrence =<< bobj .: "recurrence"
  • replacement in client/src/Aftok/Billing/PaymentRequest.purs at line 3
    [4.11214][4.11214:19121]()
    {--
    <div role="document" class="ant-modal" style="width: 520px; transform-origin: 724px 147.062px;">
    <div tabindex="0" style="width: 0px; height: 0px; overflow: hidden;">sentinelStart</div>
    <div class="ant-modal-content"><button aria-label="Close" class="ant-modal-close"><span class="ant-modal-close-x"><i aria-label="icon: close" class="anticon anticon-close ant-modal-close-icon"><svg viewBox="64 64 896 896" class="" data-icon="close" width="1em" height="1em" fill="currentColor" aria-hidden="true"><path d="M563.8 512l262.5-312.9c4.4-5.2.7-13.1-6.1-13.1h-79.8c-4.7 0-9.2 2.1-12.3 5.7L511.6 449.8 295.1 191.7c-3-3.6-7.5-5.7-12.3-5.7H203c-6.8 0-10.5 7.9-6.1 13.1L459.4 512 196.9 824.9A7.95 7.95 0 0 0 203 838h79.8c4.7 0 9.2-2.1 12.3-5.7l216.5-258.1 216.5 258.1c3 3.6 7.5 5.7 12.3 5.7h79.8c6.8 0 10.5-7.9 6.1-13.1L563.8 512z"></path></svg></i></span></button>
    <div class="ant-modal-header">
    <div class="ant-modal-title" id="rcDialogTitle0">Tip a proposal</div>
    </div>
    <div class="ant-modal-body">
    <div class="TipJarModal">
    <div class="TipJarModal-uri">
    <div>
    <div class="TipJarModal-uri-qr"><span style="opacity: 1;"><canvas height="128" width="128" style="height: 128px; width: 128px;"></canvas></span></div>
    </div>
    <div class="TipJarModal-uri-info">
    <div class="ant-row ant-form-item TipJarModal-uri-info-input CopyInput">
    <div class="ant-form-item-label"><label class="" title="Amount">Amount</label></div>
    <div class="ant-form-item-control-wrapper">
    <div class="ant-form-item-control"><span class="ant-form-item-children"><span class="ant-input-group-wrapper"><span class="ant-input-wrapper ant-input-group"><input type="number" placeholder="Amount to send" class="ant-input" value="0.2"><span class="ant-input-group-addon">ZEC</span></span>
    </span>
    </span>
    </div>
    </div>
    </div>
    <div class="ant-row ant-form-item CopyInput TipJarModal-uri-info-input is-textarea">
    <div class="ant-form-item-label"><label class="" title="Payment URI">Payment URI</label></div>
    <div class="ant-form-item-control-wrapper">
    <div class="ant-form-item-control"><span class="ant-form-item-children"><textarea readonly="" rows="3" class="ant-input">zcash:zs1xzymv205x8hhn8kt3pu43c6knjlelvxfgzgsyyus9yxhmdvqeu0yj0m2knzd3p93slsygkp94rz?amount=0.2</textarea><button type="button" class="ant-btn ant-btn-icon-only"><i aria-label="icon: copy" class="anticon anticon-copy"><svg viewBox="64 64 896 896" class="" data-icon="copy" width="1em" height="1em" fill="currentColor" aria-hidden="true"><path d="M832 64H296c-4.4 0-8 3.6-8 8v56c0 4.4 3.6 8 8 8h496v688c0 4.4 3.6 8 8 8h56c4.4 0 8-3.6 8-8V96c0-17.7-14.3-32-32-32zM704 192H192c-17.7 0-32 14.3-32 32v530.7c0 8.5 3.4 16.6 9.4 22.6l173.3 173.3c2.2 2.2 4.7 4 7.4 5.5v1.9h4.2c3.5 1.3 7.2 2 11 2H704c17.7 0 32-14.3 32-32V224c0-17.7-14.3-32-32-32zM350 856.2L263.9 770H350v86.2zM664 888H414V746c0-22.1-17.9-40-40-40H232V264h432v624z"></path></svg></i></button></span></div>
    </div>
    </div><a href="zcash:zs1xzymv205x8hhn8kt3pu43c6knjlelvxfgzgsyyus9yxhmdvqeu0yj0m2knzd3p93slsygkp94rz?amount=0.2" class="ant-btn ant-btn-ghost ant-btn-lg ant-btn-block"><span>Open in Wallet </span><i aria-label="icon: link" class="anticon anticon-link"><svg viewBox="64 64 896 896" class="" data-icon="link" width="1em" height="1em" fill="currentColor" aria-hidden="true"><path d="M574 665.4a8.03 8.03 0 0 0-11.3 0L446.5 781.6c-53.8 53.8-144.6 59.5-204 0-59.5-59.5-53.8-150.2 0-204l116.2-116.2c3.1-3.1 3.1-8.2 0-11.3l-39.8-39.8a8.03 8.03 0 0 0-11.3 0L191.4 526.5c-84.6 84.6-84.6 221.5 0 306s221.5 84.6 306 0l116.2-116.2c3.1-3.1 3.1-8.2 0-11.3L574 665.4zm258.6-474c-84.6-84.6-221.5-84.6-306 0L410.3 307.6a8.03 8.03 0 0 0 0 11.3l39.7 39.7c3.1 3.1 8.2 3.1 11.3 0l116.2-116.2c53.8-53.8 144.6-59.5 204 0 59.5 59.5 53.8 150.2 0 204L665.3 562.6a8.03 8.03 0 0 0 0 11.3l39.8 39.8c3.1 3.1 8.2 3.1 11.3 0l116.2-116.2c84.5-84.6 84.5-221.5 0-306.1zM610.1 372.3a8.03 8.03 0 0 0-11.3 0L372.3 598.7a8.03 8.03 0 0 0 0 11.3l39.6 39.6c3.1 3.1 8.2 3.1 11.3 0l226.4-226.4c3.1-3.1 3.1-8.2 0-11.3l-39.5-39.6z"></path></svg></i></a></div>
    </div>
    <div class="TipJarModal-fields">
    <div class="TipJarModal-fields-row">
    <div class="ant-row ant-form-item CopyInput TipJarModal-fields-row-address">
    <div class="ant-form-item-label"><label class="" title="Address">Address</label></div>
    <div class="ant-form-item-control-wrapper">
    <div class="ant-form-item-control"><span class="ant-form-item-children"><input readonly="" type="text" class="ant-input" value="zs1xzymv205x8hhn8kt3pu43c6knjlelvxfgzgsyyus9yxhmdvqeu0yj0m2knzd3p93slsygkp94rz"><button type="button" class="ant-btn ant-btn-icon-only"><i aria-label="icon: copy" class="anticon anticon-copy"><svg viewBox="64 64 896 896" class="" data-icon="copy" width="1em" height="1em" fill="currentColor" aria-hidden="true"><path d="M832 64H296c-4.4 0-8 3.6-8 8v56c0 4.4 3.6 8 8 8h496v688c0 4.4 3.6 8 8 8h56c4.4 0 8-3.6 8-8V96c0-17.7-14.3-32-32-32zM704 192H192c-17.7 0-32 14.3-32 32v530.7c0 8.5 3.4 16.6 9.4 22.6l173.3 173.3c2.2 2.2 4.7 4 7.4 5.5v1.9h4.2c3.5 1.3 7.2 2 11 2H704c17.7 0 32-14.3 32-32V224c0-17.7-14.3-32-32-32zM350 856.2L263.9 770H350v86.2zM664 888H414V746c0-22.1-17.9-40-40-40H232V264h432v624z"></path></svg></i></button></span></div>
    </div>
    </div>
    </div>
    <div class="TipJarModal-fields-row">
    <div class="ant-row ant-form-item ant-form-item-with-help CopyInput">
    <div class="ant-form-item-label"><label class="" title="Zcash CLI command">Zcash CLI command</label></div>
    <div class="ant-form-item-control-wrapper">
    <div class="ant-form-item-control"><span class="ant-form-item-children"><input readonly="" type="text" class="ant-input" value="zcash-cli z_sendmany YOUR_ADDRESS '[{&quot;address&quot;:&quot;zs1xzymv205x8hhn8kt3pu43c6knjlelvxfgzgsyyus9yxhmdvqeu0yj0m2knzd3p93slsygkp94rz&quot;,&quot;amount&quot;:0.2}]'"><button type="button" class="ant-btn ant-btn-icon-only"><i aria-label="icon: copy" class="anticon anticon-copy"><svg viewBox="64 64 896 896" class="" data-icon="copy" width="1em" height="1em" fill="currentColor" aria-hidden="true"><path d="M832 64H296c-4.4 0-8 3.6-8 8v56c0 4.4 3.6 8 8 8h496v688c0 4.4 3.6 8 8 8h56c4.4 0 8-3.6 8-8V96c0-17.7-14.3-32-32-32zM704 192H192c-17.7 0-32 14.3-32 32v530.7c0 8.5 3.4 16.6 9.4 22.6l173.3 173.3c2.2 2.2 4.7 4 7.4 5.5v1.9h4.2c3.5 1.3 7.2 2 11 2H704c17.7 0 32-14.3 32-32V224c0-17.7-14.3-32-32-32zM350 856.2L263.9 770H350v86.2zM664 888H414V746c0-22.1-17.9-40-40-40H232V264h432v624z"></path></svg></i></button></span>
    <div class="ant-form-explain">Make sure you replace YOUR_ADDRESS with your actual address</div>
    </div>
    </div>
    </div>
    </div>
    </div>
    </div>
    </div>
    <div class="ant-modal-footer"><button type="button" class="ant-btn ant-btn-primary"><span>Done</span></button></div>
    </div>
    <div tabindex="0" style="width: 0px; height: 0px; overflow: hidden;">sentinelEnd</div>
    </div>
    [4.11214]
    [4.19121]
    import Prelude
    import Control.Monad.Trans.Class (lift)
    -- import Data.DateTime (DateTime, date)
    import Data.Either (Either(..), note)
    import Data.Fixed as Fixed
    import Data.Foldable (any)
    import Data.Int as Int
    import Data.Maybe (Maybe(..), maybe)
    import Data.Newtype (unwrap)
    import Data.Number (fromString) as Number
    import Data.Number.Format (toString) as Number
    -- import Data.Unfoldable as U
    import Data.Validation.Semigroup (V(..), toEither)
    import Data.Time.Duration (Hours(..), Days(..))
    -- import Data.Traversable (traverse)
    import Data.Tuple (Tuple(..))
    import Effect.Aff (Aff)
    -- import Effect.Class (liftEffect)
    -- import Effect.Now (nowDateTime)
    import Halogen as H
    import Halogen.HTML.Core (ClassName(..))
    import Halogen.HTML as HH
    import Halogen.HTML.Events as E
    import Halogen.HTML.Properties as P
    import Aftok.Types (System, ProjectId)
    import Aftok.HTML.Classes as C
    import Aftok.Modals as Modals
    import Aftok.Modals.ModalFFI as ModalFFI
    import Aftok.Api.Types (APIError(..))
    import Aftok.Api.Billing
    ( BillableId
    , Billable
    , Recurrence(..)
    , createBillable
    )
    import Aftok.Zcash (ZEC(..), toZatoshi)
    data Field
    = NameField
    | DescField
    | MessageField
    | MonthlyRecurrenceField
    | WeeklyRecurrenceField
    | AmountField
    | GracePeriodField
    | RequestExpiryField
    derive instance fieldEq :: Eq Field
    derive instance fieldOrd :: Ord Field
    data RType
    = RTAnnual
    | RTMonthly
    | RTWeekly
    | RTOneTime
    derive instance rtypeEq :: Eq RType
    type CState =
    { projectId :: ProjectId
    , name :: Maybe String
    , description :: Maybe String
    , message :: Maybe String
    , recurrenceType :: RType
    , recurrenceValue :: Maybe Int
    , amount :: Maybe ZEC
    , gracePeriod :: Maybe Days
    , requestExpiry :: Maybe Hours
    , fieldErrors :: Array Field
    }
    data Query a
    = Tell a
    type Input = ProjectId
    type Output = Tuple BillableId Billable
    data Action
    = ProjectChanged ProjectId
    | SetName String
    | SetDesc String
    | SetMessage String
    | SetRecurrenceType RType
    | SetRecurrenceMonths String
    | SetRecurrenceWeeks String
    | SetBillingAmount String
    | SetGracePeriod String
    | SetRequestExpiry String
    | SaveBillable
    type Slot id
    = H.Slot Query Output id
    type Capability (m :: Type -> Type)
    = { createBillable :: ProjectId -> Billable -> m (Either APIError BillableId)
    }
    component ::
    forall m.
    Monad m =>
    System m ->
    Capability m ->
    H.Component HH.HTML Query Input Output m
    component system caps =
    H.mkComponent
    { initialState
    , render
    , eval:
    H.mkEval
    $ H.defaultEval
    { handleAction = eval
    , receive = Just <<< ProjectChanged
    }
    }
    where
    initialState :: Input -> CState
    initialState input =
    { projectId: input
    , name : Nothing
    , description : Nothing
    , message : Nothing
    , recurrenceType : RTOneTime
    , recurrenceValue : Nothing
    , amount : Nothing
    , gracePeriod : Nothing
    , requestExpiry : Nothing
    , fieldErrors : []
    }
  • replacement in client/src/Aftok/Billing/PaymentRequest.purs at line 133
    [4.19122][4.19122:19126]()
    --}
    [4.19122]
    render :: forall slots. CState -> H.ComponentHTML Action slots m
    render st =
    Modals.modalWithSave "createBillable" "Create Billable" SaveBillable
    [ HH.form_
    [ formGroup st
    [ NameField ]
    [ HH.label
    [ P.for "billableName"]
    [ HH.text "Product Name" ]
    , HH.input
    [ P.type_ P.InputText
    , P.classes [ C.formControlSm ]
    , P.id_ "billableName"
    , P.placeholder "A name for the product or service you want to bill for"
    , E.onValueInput (Just <<< SetName)
    ]
    ]
    , formGroup st
    [ DescField ]
    [ HH.label
    [ P.for "billableDesc"]
    [ HH.text "Product Description" ]
    , HH.input
    [ P.type_ P.InputText
    , P.classes [ C.formControlSm ]
    , P.id_ "billableDesc"
    , P.placeholder "Description of the product or service"
    , E.onValueInput (Just <<< SetDesc)
    ]
    ]
    , formGroup st
    [ MessageField ]
    [ HH.label
    [ P.for "billableMsg"]
    [ HH.text "Message to be included with bill" ]
    , HH.input
    [ P.type_ P.InputText
    , P.id_ "billableMsg"
    , P.placeholder "Enter your message here"
    , E.onValueInput (Just <<< SetMessage)
    ]
    ]
    , formGroup st
    [MonthlyRecurrenceField, WeeklyRecurrenceField]
    [ HH.label_
    [ HH.input
    ([ P.type_ P.InputRadio
    , P.name "recurType"
    , E.onClick \_ -> Just (SetRecurrenceType RTAnnual)
    ] <> (if st.recurrenceType == RTAnnual then [P.checked true] else []))
    , HH.text " Annual"
    ]
    , HH.label_
    [ HH.input
    ([ P.type_ P.InputRadio
    , P.name "recurType"
    , E.onClick \_ -> Just (SetRecurrenceType RTMonthly)
    ] <> (if st.recurrenceType == RTMonthly then [P.checked true] else []))
    , HH.text " every "
    , HH.input
    [ P.type_ P.InputNumber
    , P.classes [ C.formControlSm ]
    , P.value (if st.recurrenceType == RTMonthly
    then maybe "" show st.recurrenceValue
    else "")
    , P.min 1.0
    , P.max 12.0
    , E.onValueInput (Just <<< SetRecurrenceMonths)
    ]
    , HH.text " Months"
    ]
    , HH.label_
    [ HH.input
    ([ P.type_ P.InputRadio
    , P.name "recurType"
    , E.onClick \_ -> Just (SetRecurrenceType RTWeekly)
    ] <> (if st.recurrenceType == RTWeekly then [P.checked true] else []))
    , HH.text " every "
    , HH.input
    [ P.type_ P.InputNumber
    , P.classes [ C.formControlSm ]
    , P.value (if st.recurrenceType == RTWeekly
    then maybe "" show st.recurrenceValue
    else "")
    , P.min 1.0
    , P.max 12.0
    , E.onValueInput (Just <<< SetRecurrenceWeeks)
    ]
    , HH.text " Weeks"
    ]
    , HH.label_
    [ HH.input
    ([ P.type_ P.InputRadio
    , P.name "recurType"
    , E.onClick \_ -> Just (SetRecurrenceType RTOneTime)
    ] <> (if st.recurrenceType == RTOneTime then [P.checked true] else []))
    , HH.text " One-Time"
    ]
    ]
    , formGroup st
    [AmountField]
    [ HH.label
    [ P.for "billableAmount"]
    [ HH.text "Amount" ]
    , HH.input
    [ P.type_ P.InputNumber
    , P.classes [ C.formControlSm ]
    , P.id_ "billableAmount"
    , P.value (maybe "" (Fixed.toString <<< unwrap) st.amount)
    , P.placeholder "1.0"
    , P.min 0.0
    , E.onValueInput (Just <<< SetBillingAmount)
    ]
    , HH.div
    [ P.classes [ ClassName "input-group-append" ] ]
    [ HH.span [ P.classes [ ClassName "input-group-text" ] ] [ HH.text "ZEC" ] ]
    ]
    , formGroup st
    [GracePeriodField]
    [ HH.label
    [ P.for "gracePeriod"]
    [ HH.text "Grace Period (Days)" ]
    , HH.input
    [ P.type_ P.InputNumber
    , P.id_ "gracePeriod"
    , P.classes [ C.formControlSm ]
    , P.value (maybe "" (Number.toString <<< unwrap) st.gracePeriod)
    , P.placeholder "Days until a bill is considered overdue"
    , P.min 0.0
    , E.onValueInput (Just <<< SetGracePeriod)
    ]
    ]
    , formGroup st
    [RequestExpiryField]
    [ HH.label
    [ P.for "requestExpiry"]
    [ HH.text "Request Expiry Period (Hours)" ]
    , HH.input
    [ P.type_ P.InputNumber
    , P.id_ "gracePeriod"
    , P.classes [ C.formControlSm ]
    , P.value (maybe "" (Number.toString <<< unwrap) st.requestExpiry)
    , P.placeholder "Hours until a payment request expires"
    , P.min 0.0
    , E.onValueInput (Just <<< SetRequestExpiry)
    ]
    ]
    ]
    ]
    formGroup :: forall i a. CState -> Array Field -> Array (HH.HTML i a) -> HH.HTML i a
    formGroup st fields body =
    HH.div
    [ P.classes [C.formGroup] ]
    (body <> (fieldError st =<< fields))
    fieldError :: forall i a. CState -> Field -> Array (HH.HTML i a)
    fieldError st field =
    if any (_ == field) st.fieldErrors
    then case field of
    NameField -> err "The name field is required"
    DescField -> err "The description field is required"
    MessageField -> err "The message field is required"
    MonthlyRecurrenceField -> err "You must enter a valid number of months."
    WeeklyRecurrenceField -> err "You must enter a valid number of weeks."
    AmountField -> err "You must enter a valid amount of ZEC"
    GracePeriodField -> err "You must enter a valid number of hours."
    RequestExpiryField -> err "You must enter a valid number of hours."
    else []
    where
    err str = [ HH.div_ [ HH.span [ P.classes (ClassName <$> [ "badge", "badge-danger-soft" ]) ] [ HH.text str ] ] ]
    eval :: forall slots. Action -> H.HalogenM CState Action slots Output m Unit
    eval = case _ of
    ProjectChanged pid ->
    H.modify_ (_ { projectId = pid })
    SetName name ->
    H.modify_ (_ { name = Just name })
    SetDesc desc ->
    H.modify_ (_ { description = Just desc })
    SetMessage msg ->
    H.modify_ (_ { message = Just msg })
    SetRecurrenceType rtype -> do
    curRecurType <- H.gets _.recurrenceType
    curDuration <- H.gets _.recurrenceValue
    let rdur = case curRecurType of
    RTMonthly | rtype == RTMonthly -> curDuration
    RTWeekly | rtype == RTWeekly -> curDuration
    _ -> Nothing
    H.modify_ (_ { recurrenceType = rtype, recurrenceValue = rdur })
    SetRecurrenceMonths dur ->
    case Int.fromString dur of
    (Just n) -> H.modify_ (_ { recurrenceType = RTMonthly, recurrenceValue = Just n })
    (Nothing) -> pure unit
    SetRecurrenceWeeks dur ->
    case Int.fromString dur of
    (Just n) -> H.modify_ (_ { recurrenceType = RTWeekly, recurrenceValue = Just n })
    (Nothing) -> pure unit
    SetBillingAmount amt ->
    case Fixed.fromString amt of
    (Just zec) -> H.modify_ (_ { amount = Just (ZEC zec) })
    (Nothing) -> pure unit
    SetGracePeriod dur ->
    case Number.fromString dur of
    (Just n) -> H.modify_ (_ { gracePeriod = Just (Days n) })
    (Nothing) -> pure unit
    SetRequestExpiry dur ->
    case Number.fromString dur of
    (Just n) -> H.modify_ (_ { requestExpiry = Just (Hours n) })
    (Nothing) -> pure unit
    SaveBillable -> do
    nameV <- V <<< note [NameField] <$> H.gets (_.name)
    descV <- V <<< note [DescField] <$> H.gets (_.description)
    msgV <- V <<< note [MessageField] <$> H.gets (_.message)
    rtype <- H.gets (_.recurrenceType)
    rvalueV <- case rtype of
    RTAnnual -> pure $ V (Right Annually)
    RTMonthly -> V <<< maybe (Left [MonthlyRecurrenceField]) (Right <<< Monthly) <$> H.gets (_.recurrenceValue)
    RTWeekly -> V <<< maybe (Left [WeeklyRecurrenceField]) (Right <<< Weekly) <$> H.gets (_.recurrenceValue)
    RTOneTime -> pure $ V (Right OneTime)
    zatsV <- V <<< maybe (Left [AmountField]) (Right <<< toZatoshi) <$> H.gets (_.amount)
    gperV <- V <<< note [GracePeriodField] <$> H.gets (_.gracePeriod)
    expiryV <- V <<< note [RequestExpiryField] <$> H.gets (_.requestExpiry)
    let toBillable = { name: _
    , description: _
    , message: _
    , recurrence: _
    , amount: _
    , gracePeriod: _
    , expiryPeriod: _
    }
    reqV :: V (Array Field) Billable
    reqV =
    toBillable <$> nameV
    <*> descV
    <*> msgV
    <*> rvalueV
    <*> zatsV
    <*> gperV
    <*> expiryV
    case toEither reqV of
    Left errors -> do
    H.modify_ (_ { fieldErrors = errors })
    Right billable -> do
    pid <- H.gets (_.projectId)
    res <- lift $ caps.createBillable pid billable
    case res of
    Right bid -> do
    H.raise (Tuple bid billable)
    lift $ system.toggleModal "createBillable" ModalFFI.HideModal
    Left errs ->
    lift $ system.error (show errs)
    apiCapability :: Capability Aff
    apiCapability =
    { createBillable: createBillable
    }
    mockCapability :: Capability Aff
    mockCapability =
    { createBillable: \_ _ -> pure $ Left Forbidden }
  • replacement in client/src/Aftok/Billing.purs at line 13
    [4.2599][4.3072:3107](),[4.4493][4.3072:3107](),[4.3072][4.3072:3107]()
    import Data.Traversable (traverse)
    [4.2599]
    [3.2654]
    import Data.Traversable (traverse_)
  • edit in client/src/Aftok/Billing.purs at line 24
    [4.4565]
    [4.3351]
    import Aftok.Billing.PaymentRequest as PaymentRequest
  • edit in client/src/Aftok/Billing.purs at line 36
    [4.3670]
    [4.3670]
    , recurrenceStr
  • edit in client/src/Aftok/Billing.purs at line 62
    [4.4656]
    [4.4143]
    , createPaymentRequest :: PaymentRequest.Slot Unit
  • edit in client/src/Aftok/Billing.purs at line 67
    [4.4709]
    [4.4196]
    _createPaymentRequest = SProxy :: SProxy "createPaymentRequest"
  • replacement in client/src/Aftok/Billing.purs at line 127
    [3.2776][3.2776:2850]()
    , Modals.modalButton "createBillable" "Create billable"
    [3.2776]
    [4.2223]
    , HH.div
    [ P.classes (ClassName <$> [ "col-md-2" ]) ]
    [ Modals.modalButton "createBillable" "Create billable" ]
    , system.portal
    _createBillable
    unit
    (Create.component system caps.createBillable)
    (unwrap p).projectId
    Nothing
    (Just <<< BillableCreated)
  • edit in client/src/Aftok/Billing.purs at line 175
    [3.3801]
    [3.3801]
    , colmd2 (Just (recurrenceStr b.recurrence))
    , HH.div
    [ P.classes (ClassName <$> [ "col-md-2" ]) ]
    [ Modals.modalButton "createPaymentRequest" "New Payment Request" ]
  • replacement in client/src/Aftok/Billing.purs at line 190
    [4.6510][3.3967:4007]()
    refreshBillables currentProject
    [4.6510]
    [4.6796]
    traverse_ refreshBillables currentProject
  • replacement in client/src/Aftok/Billing.purs at line 194
    [4.6880][3.4008:4048]()
    refreshBillables currentProject
    [4.6880]
    [4.6880]
    refreshBillables p
  • replacement in client/src/Aftok/Billing.purs at line 202
    [3.4133][3.4133:4173]()
    refreshBillables currentProject
    [3.4133]
    [3.4173]
    traverse_ refreshBillables currentProject
  • replacement in client/src/Aftok/Billing.purs at line 205
    [3.4227][3.4227:4336]()
    billables <- lift $ traverse (caps.listProjectBillables <<< (_.projectId) <<< unwrap) currentProject
    [3.4227]
    [3.4336]
    billables <- lift $ caps.listProjectBillables (unwrap currentProject).projectId
  • replacement in client/src/Aftok/Billing.purs at line 207
    [3.4362][3.4362:4513]()
    Nothing -> pure unit
    Just (Left err) -> lift $ system.error (show err)
    Just (Right b) -> H.modify_ (_ { billables = b })
    [3.4362]
    [4.7093]
    Left err -> lift $ system.error (show err)
    Right b -> H.modify_ (_ { billables = b })
  • replacement in lib/Aftok/Database/PostgreSQL/Projects.hs at line 42
    [4.48166][4.48166:48182]()
    ( Email (..),
    [4.48166]
    [4.48182]
    ( DepreciationRules (..),
    Email (..),
  • replacement in lib/Aftok/Database/PostgreSQL/Projects.hs at line 49
    [4.48248][2.20:56]()
    DepreciationRules(..),
    depf
    [4.48248]
    [4.48248]
    depf,
  • replacement in lib/Aftok/Database/PostgreSQL/Projects.hs at line 67
    [4.48730][2.57:189]()
    <*> (
    DepreciationRules
    <$> (unSerDepFunction <$> fieldWith fromJSONField)
    <*> (fmap C.toThyme <$> field)
    [4.48730]
    [2.189]
    <*> ( DepreciationRules
    <$> (unSerDepFunction <$> fieldWith fromJSONField)
    <*> (fmap C.toThyme <$> field)
  • replacement in lib/Aftok/Json.hs at line 196
    [4.37249][4.37049:37127](),[4.37049][4.37049:37127]()
    recurrenceJSON' (B.Monthly i) = object ["monthly " .= object ["months" .= i]]
    [4.37249]
    [4.6375]
    recurrenceJSON' (B.Monthly i) = object ["monthly" .= object ["months" .= i]]
  • replacement in lib/Aftok/Json.hs at line 198
    [4.6442][4.37250:37325]()
    recurrenceJSON' (B.Weekly i) = object ["weekly " .= object ["weeks" .= i]]
    [4.6442]
    [4.37325]
    recurrenceJSON' (B.Weekly i) = object ["weekly" .= object ["weeks" .= i]]
  • replacement in lib/Aftok/TimeLog.hs at line 20
    [4.22356][2.650:677]()
    DepreciationRules(..),
    [4.22356]
    [4.22356]
    DepreciationRules (..),
  • replacement in lib/Aftok/TimeLog.hs at line 142
    [2.766][2.766:852]()
    toDepF (DepreciationRules (LinearDepreciation undepLength depLength) firstRevenue) =
    [2.766]
    [2.852]
    toDepF (DepreciationRules (LinearDepreciation undepLength depLength) firstRevenue) =
  • replacement in lib/Aftok/Types.hs at line 66
    [2.1158][2.1158:1276]()
    data DepreciationRules = DepreciationRules
    { _depf :: DepreciationFunction
    , _firstRevenue :: Maybe C.UTCTime
    }
    [2.1158]
    [2.1276]
    data DepreciationRules
    = DepreciationRules
    { _depf :: DepreciationFunction,
    _firstRevenue :: Maybe C.UTCTime
    }
  • edit in server/Aftok/Snaplet/Billing.hs at line 7
    [4.60128]
    [4.48263]
    createPaymentRequestHandler,
  • replacement in server/Aftok/Snaplet/Billing.hs at line 11
    [4.33876][4.25391:25417]()
    import Aftok.Billing as B
    [4.33876]
    [4.100280]
    import Aftok.Billing
    ( Billable,
    Billable' (..),
    BillableId (..),
    Recurrence (..),
    SubscriptionId,
    )
    import qualified Aftok.Billing as B
  • replacement in server/Aftok/Snaplet/Billing.hs at line 28
    [4.60244][4.60244:60262]()
    import Aftok.Json
    [4.60244]
    [4.60262]
    import Aftok.Json (Version (..), badVersion, unversion)
    import Aftok.Payments
    ( PaymentRequestId,
    PaymentsConfig,
    SomePaymentRequest (..),
    SomePaymentRequestDetail,
    createPaymentRequest,
    zcashPaymentsConfig,
    )
    import Aftok.Payments.Types
    ( PaymentRequestError (..),
    )
    import qualified Aftok.Payments.Zcash as Zcash
  • replacement in server/Aftok/Snaplet/Billing.hs at line 42
    [4.60283][4.60283:60328](),[4.60362][4.60362:60407]()
    import Aftok.Snaplet.Auth
    import Aftok.Types
    import Control.Lens ((^.))
    import Data.Aeson
    [4.60283]
    [4.60407]
    ( App,
    readRequestJSON,
    requireId,
    requireProjectId,
    snapError,
    snapEval,
    )
    import Aftok.Snaplet.Auth (requireUserId)
    import Aftok.Types (ProjectId, UserId)
    import Control.Lens ((.~), (^.))
    -- import Data.Aeson ()
  • edit in server/Aftok/Snaplet/Billing.hs at line 54
    [4.60431]
    [4.25418]
    ( (.:),
    (.:?),
    Object,
    Parser,
    Value (..),
    parseEither,
    parseJSON,
    )
  • replacement in server/Aftok/Snaplet/Billing.hs at line 63
    [4.25460][4.60431:60460](),[4.60431][4.60431:60460]()
    import Data.Thyme.Clock as C
    [4.25460]
    [4.60460]
    import qualified Data.Thyme.Clock as C
  • replacement in server/Aftok/Snaplet/Billing.hs at line 65
    [4.60498][4.60498:60523]()
    import Snap.Snaplet as S
    [4.60498]
    [4.33907]
    import Snap.Core (MonadSnap)
    import qualified Snap.Snaplet as S
  • replacement in server/Aftok/Snaplet/Billing.hs at line 113
    [4.25462][4.25462:25509]()
    -- subscriptionJSON :: B.Subscription -> Value
    [4.25462]
    [4.25509]
    createPaymentRequestHandler ::
    MonadSnap m =>
    PaymentsConfig m ->
    S.Handler App App (PaymentRequestId, SomePaymentRequestDetail)
    createPaymentRequestHandler cfg = do
    uid <- requireUserId
    pid <- requireProjectId
    bid <- requireId "billableId" BillableId
    billable <- snapEval $ withProjectAuth pid uid (FindBillable bid)
    now <- liftIO C.getCurrentTime
    let billDay = now ^. C._utctDay
    case billable of
    -- check that the billable is actually related to the project that the user
    -- is authorized for & the URL specifies
    Just b | (b ^. B.project == pid) ->
    case b ^. B.amount of
    Amount ZEC v -> do
    let ops = Zcash.paymentOps (cfg ^. zcashPaymentsConfig)
    res <- snapEval . runExceptT $ createPaymentRequest ops now bid (b & B.amount .~ v) billDay
    case res of
    Left AmountInvalid -> snapError 400 $ "Invalid payment amount requested."
    Left NoRecipients -> snapError 400 $ "This project has no payable members."
    Right (reqId, detail) ->
    pure (reqId, SomePaymentRequest detail)
    Amount BTC _ ->
    snapError 400 $ "Bitcoin payment requests not yet supported."
    _ ->
    snapError 404 $ "Billable not found."
    -- subscriptionJSON :: Subscription -> Value
  • replacement in server/Aftok/Snaplet/Billing.hs at line 145
    [4.25560][4.25560:25621]()
    -- subscriptionKV :: (KeyValue kv) => B.Subscription -> [kv]
    [4.25560]
    [4.25621]
    -- subscriptionKV :: (KeyValue kv) => Subscription -> [kv]
  • replacement in server/Aftok/Snaplet/Billing.hs at line 147
    [4.25645][4.25645:25852]()
    -- [ "user_id" .= idValue (B.customer . _UserId) sub,
    -- "billable_id" .= idValue (B.billable . B._BillableId) sub,
    -- "start_time" .= view B.startTime sub,
    -- "end_time" .= view B.endTime sub
    [4.25645]
    [4.25852]
    -- [ "user_id" .= idValue (customer . _UserId) sub,
    -- "billable_id" .= idValue (billable . _BillableId) sub,
    -- "start_time" .= view startTime sub,
    -- "end_time" .= view endTime sub
  • replacement in server/Aftok/Snaplet/Billing.hs at line 164
    [4.26297][4.26297:26346]()
    parseRecurrence :: Object -> Parser B.Recurrence
    [4.26297]
    [4.26346]
    parseRecurrence :: Object -> Parser Recurrence
  • replacement in server/Aftok/Snaplet/Billing.hs at line 166
    [4.26366][4.26366:26593](),[4.26593][4.2070:2143]()
    let parseAnnually o' = const (pure B.Annually) <$> O.lookup "annually" o'
    parseMonthly o' = fmap B.Monthly . parseJSON <$> O.lookup "monthly" o'
    parseWeekly o' = fmap B.Weekly . parseJSON <$> O.lookup "weekly" o'
    parseOneTime o' = const (pure B.OneTime) <$> O.lookup "onetime" o'
    [4.26366]
    [4.26667]
    let parseAnnually o' = const (pure Annually) <$> O.lookup "annually" o'
    parseMonthly o' = fmap Monthly . parseJSON <$> O.lookup "monthly" o'
    parseWeekly o' = fmap Weekly . parseJSON <$> O.lookup "weekly" o'
    parseOneTime o' = const (pure OneTime) <$> O.lookup "onetime" o'
  • replacement in server/Aftok/Snaplet/Billing.hs at line 179
    [4.26937][4.26937:26986]()
    parseRecurrence' :: Value -> Parser B.Recurrence
    [4.26937]
    [4.26986]
    parseRecurrence' :: Value -> Parser Recurrence
  • replacement in server/Aftok/Snaplet/Payments.hs at line 10
    [4.5963][4.61364:61385]()
    import Aftok.Billing
    [4.5963]
    [4.101156]
    import Aftok.Billing (SubscriptionId (..))
  • replacement in shell.nix at line 23
    [4.38][3.4684:4764]()
    haskellPackages.HDBC-postgresql
    haskellPackages.dbmigrations-postgresql
    [4.38]
    [4.99129]
    # haskellPackages.HDBC-postgresql
    # haskellPackages.dbmigrations-postgresql