, cryptonite

    "kjua": {
      "version": "0.9.0",
      "resolved": "https://registry.npmjs.org/kjua/-/kjua-0.9.0.tgz",
      "integrity": "sha512-Wmh5k6hpl+wiYkcEIx0/Ocj1DOxacw/myh/SQ3NbY0RWD4360CXaaAJkdeeV+moqf7fxvACYK95LXQ8vtLWKxA=="
    },

    "kjua": "^0.9.0",

-- import Control.Monad.Except.Trans (runExceptT, except, withExceptT)

import Control.Monad.Except.Trans (runExceptT)

import Data.BigInt (toNumber, fromNumber) as BigInt

import Data.BigInt (toNumber) as BigInt

-- import Data.DateTime.Instant (Instant, toDateTime)

import Data.DateTime.Instant (toDateTime)

import Foreign.Object (Object)
-- import Data.Foldable (class Foldable, foldr, foldl, foldMapDefaultR)

import Data.Foldable (class Foldable, foldMapDefaultR)

import Data.Traversable (traverse, sequence)
import Data.UUID (UUID, parseUUID)

import Data.Traversable (class Traversable, traverse, sequence)
import Data.UUID (UUID, parseUUID, toString)

import Effect.Class (liftEffect)

-- import Foreign.Object (Object)

import Foreign.Object (Object)

  ( Zatoshi(..) )

  ( Zatoshi )

  , parseDatedResponse
  , parseZatoshi

billableIdStr :: BillableId -> String
billableIdStr (BillableId uuid) = toString uuid

  amount <- 
    map Zatoshi 
      $   (note (TypeMismatch "Failed to decode as Zatoshi") <<< BigInt.fromNumber) 
      =<< (_ .: "zatoshi")
      =<< (bobj .: "amount")

  amount <- parseZatoshi =<< (bobj .: "amount")

createBillable :: ProjectId -> Billable -> Aff (Either APIError BillableId)
createBillable pid billable = do
  let body = RB.json $ billableJSON billable
  response <- post RF.json ("/api/projects/" <> pidStr pid <> "/billables") (Just body)
  parseResponse decodeJson response
listProjectBillables :: ProjectId -> Aff (Either APIError (Array (Tuple BillableId Billable)))
listProjectBillables pid = do
  response <- get RF.json ("/api/projects/" <> pidStr pid <> "/billables")
  parseResponse (traverse parseBillableJSON <=< decodeJson) response

  {

  { payment_request_id :: String
  , native_request :: {
      zip321_request :: String,
      schemaVersion :: String 
    }
  , expires_at :: t
  , total :: Zatoshi

derive instance paymentRequestFunctor :: Functor PaymentRequest'

instance paymentRequestFoldable :: Foldable PaymentRequest' where
  foldr f b (PaymentRequest r) = 
    f r.expires_at b
  foldl f b (PaymentRequest r) = 
    f b r.expires_at
  foldMap = foldMapDefaultR
instance paymentRequestTraversable :: Traversable PaymentRequest' where
  traverse f (PaymentRequest r) = 
    map (\b -> PaymentRequest (r { expires_at = b })) (f r.expires_at)
  sequence = traverse identity

createBillable :: ProjectId -> Billable -> Aff (Either APIError BillableId)
createBillable pid billable = do
  let body = RB.json $ billableJSON billable
  response <- post RF.json ("/api/projects/" <> pidStr pid <> "/billables") (Just body)
  parseResponse decodeJson response

type PaymentRequestMeta =
  { requestName :: String
  , requestDesc :: Maybe String
  }

listProjectBillables :: ProjectId -> Aff (Either APIError (Array (Tuple BillableId Billable)))
listProjectBillables pid = do
  response <- get RF.json ("/api/projects/" <> pidStr pid <> "/billables")
  parseResponse (traverse parseBillableJSON <=< decodeJson) response

decodePaymentRequest :: Json -> Either JsonDecodeError (PaymentRequest' String)
decodePaymentRequest json = do
  obj <- decodeJson json
  payment_request_id <- obj .: "payment_request_id"
  native_request <- obj .: "native_request"
  expires_at <- obj .: "expires_at"
  total <- parseZatoshi =<< (obj .: "total")
  pure $ PaymentRequest { payment_request_id, native_request, expires_at, total }

listUnpaidPaymentRequests :: BillableId -> Aff (Either APIError (Array (Tuple PaymentRequestId PaymentRequest)))

createPaymentRequest :: 
  ProjectId -> 
  BillableId -> 
  PaymentRequestMeta -> 
  Aff (Either APIError PaymentRequest)
createPaymentRequest pid bid m = do
  let body = RB.json (encodeJson m)
      uri = "/api/projects/" <> pidStr pid <> "/billables/" <> billableIdStr bid <> "/paymentRequests"
  response <- post RF.json uri (Just body)
  liftEffect 
    <<< runExceptT 
    <<< map (map toDateTime)
    $ parseDatedResponse decodePaymentRequest response
listUnpaidPaymentRequests :: 
  BillableId -> 
  Aff (Either APIError (Array (Tuple PaymentRequestId PaymentRequest)))

import Data.Argonaut.Decode (class DecodeJson, decodeJson, JsonDecodeError(..))

import Data.Argonaut.Decode (class DecodeJson, decodeJson, JsonDecodeError(..), (.:))
import Data.BigInt (fromNumber) as BigInt

import Foreign.Object (Object)

import Aftok.Zcash (Zatoshi(..))

parseZatoshi :: Object Json -> Either JsonDecodeError Zatoshi
parseZatoshi obj = 
  map Zatoshi 
    $   (note (TypeMismatch "Failed to decode as Zatoshi") <<< BigInt.fromNumber) 
    =<< (obj .: "zatoshi")

-- import Data.DateTime (DateTime, date)

import Control.Monad.State.Class (get)

import Data.Fixed as Fixed

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.Maybe (Maybe(..))
import Data.Tuple (Tuple(..))

import Data.Time.Duration (Hours(..), Days(..))
-- import Data.Traversable (traverse)
import Data.Tuple (Tuple(..))

import Data.Traversable (traverse_)

-- import Effect.Class (liftEffect)
-- import Effect.Now (nowDateTime)

  , Billable
  , Recurrence(..)
  , createBillable

  , PaymentRequest'(..)
  , PaymentRequest
  , PaymentRequestMeta
  , createPaymentRequest

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

data FieldError
  = NameRequired
  | BillableIdNotSet

derive instance rtypeEq :: Eq RType

derive instance fieldEq :: Eq FieldError
derive instance fieldOrd :: Ord FieldError

  , billableId :: Maybe BillableId

  , message :: Maybe String
  , recurrenceType :: RType
  , recurrenceValue :: Maybe Int
  , amount :: Maybe ZEC
  , gracePeriod :: Maybe Days
  , requestExpiry :: Maybe Hours
  , fieldErrors :: Array Field

  , fieldErrors :: Array FieldError

data Query a
  = Tell a

type Input = 
  { projectId :: ProjectId
  , billableId :: Maybe BillableId
  }

type Input = ProjectId

data Query a = 
  SetBillableId BillableId a

type Output = Tuple BillableId Billable

type Output = PaymentRequest

  = ProjectChanged ProjectId
  | SetName String

  = SetName String

  | SetMessage String
  | SetRecurrenceType RType
  | SetRecurrenceMonths String
  | SetRecurrenceWeeks String
  | SetBillingAmount String
  | SetGracePeriod String
  | SetRequestExpiry String
  | SaveBillable

  | SavePaymentRequest

  = { createBillable :: ProjectId -> Billable -> m (Either APIError BillableId)

  = { createPaymentRequest ::
        ProjectId ->
        BillableId ->
        PaymentRequestMeta ->
        m (Either APIError PaymentRequest)

modalId :: String
modalId = "createPaymentRequest"

              { handleAction = eval
              , receive = Just <<< ProjectChanged

              { handleAction = handleAction
              , handleQuery = handleQuery

    { projectId: input

    { projectId: input.projectId
    , billableId: input.billableId

    , message : Nothing
    , recurrenceType : RTOneTime
    , recurrenceValue : Nothing
    , amount : Nothing
    , gracePeriod : Nothing
    , requestExpiry : Nothing

    Modals.modalWithSave "createBillable" "Create Billable" SaveBillable

    Modals.modalWithSave modalId "Create Payment Request" SavePaymentRequest

          [ NameField ]
          [ HH.label 
            [ P.for "billableName"]
            [ HH.text "Product Name" ] 

          [ NameRequired ]
          [ HH.label
            [ P.for "requestName"]
            [ HH.text "Request Name" ]

            , P.classes [ C.formControlSm ]
            , P.id_ "billableName"
            , P.placeholder "A name for the product or service you want to bill for"

            , P.classes [ C.formControl, C.formControlSm ]
            , P.id_ "requestName"
            , P.placeholder "A name for the payment request"

          ] 
        , 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)
              ]

          [ MessageField ]
          [ HH.label 
              [ P.for "billableMsg"]
              [ HH.text "Message to be included with bill" ] 

          [ ]
          [ HH.label
              [ P.for "requestDesc"]
              [ HH.text "Request Description" ]

              , 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)

              , P.classes [ C.formControl, C.formControlSm ]
              , P.id_ "requestDesc"
              , P.placeholder "Additional descriptive information"
              , E.onValueInput (Just <<< SetDesc)

          , 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 = 

  formGroup :: forall i a. CState -> Array FieldError -> Array (HH.HTML i a) -> HH.HTML i a
  formGroup st fields body =

     (body <> (fieldError st =<< fields)) 

     (body <> (fieldError st =<< fields))

  fieldError :: forall i a. CState -> Field -> Array (HH.HTML i a)
  fieldError st field = 
    if any (_ == field) st.fieldErrors 

  fieldError :: forall i a. CState -> FieldError -> Array (HH.HTML i a)
  fieldError st field =
    if any (_ == field) st.fieldErrors

            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."

            NameRequired -> err "The name field is required"
            BillableIdNotSet -> err "The billable id is missing. Close this dialog and try again."

  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

  handleQuery :: forall slots a. Query a -> H.HalogenM CState Action slots Output m (Maybe a)
  handleQuery = case _ of
    SetBillableId bid a -> do
      H.modify_ (_ { billableId = Just bid })
      pure (Just a)

        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)

  handleAction :: forall slots. Action -> H.HalogenM CState Action slots Output m Unit
  handleAction = case _ of
    SetName name ->
      H.modify_ (_ { name = Just name })
    SetDesc desc ->
      H.modify_ (_ { description = Just desc })
    SavePaymentRequest -> do
      bidV <- V <<< note [BillableIdNotSet] <$> H.gets (_.billableId)
      nameV <- V <<< note [NameRequired] <$> H.gets (_.name)
      descV <- H.gets (_.description)
      let reqV = { requestName: _, requestDesc: _ } <$> nameV <*> pure descV
          breqV = Tuple <$> bidV <*> reqV
      case toEither breqV of
        Left errors -> do
          H.modify_ (_ { fieldErrors = errors })
        Right (Tuple bid reqMeta) -> do
          pid <- H.gets (_.projectId)
          res <- lift $ caps.createPaymentRequest pid bid reqMeta
          case res of
            Right content -> do
              lift $ system.log "Request created."
              H.raise content
              lift $ system.toggleModal "createPaymentRequest" ModalFFI.HideModal
            Left errs ->
              lift $ system.error (show errs)

  { createBillable: createBillable

  { createPaymentRequest: createPaymentRequest

  { createBillable: \_ _ -> pure $ Left Forbidden }

  { createPaymentRequest: \_ _ _ -> pure $ Left Forbidden }
type QrState = Maybe PaymentRequest
data QrQuery a
  = QrRender PaymentRequest a
data QrAction 
  = QrInit
type QrSlot id
  = H.Slot QrQuery Unit id
qrModalId :: String
qrModalId = "paymentRequestQR"
qrcomponent ::
  forall m output.
  Monad m =>
  System m ->
  H.Component HH.HTML QrQuery (Maybe PaymentRequest) output m
qrcomponent system =
  H.mkComponent
    { initialState
    , render
    , eval:
        H.mkEval 
          $ H.defaultEval
              { handleAction = handleAction
              , handleQuery = handleQuery
              , initialize = Just QrInit
              }
    }
  where
  initialState :: Maybe PaymentRequest -> Maybe PaymentRequest
  initialState input = input
  render :: forall slots. QrState -> H.ComponentHTML QrAction slots m
  render st =
    Modals.modalWithClose qrModalId "Payment Request"
      [ HH.div_
        [ HH.div [P.id_ "paymentRequestQRCode"] []
        ]
      ]
  handleQuery :: forall slots a. QrQuery a -> H.HalogenM QrState QrAction slots output m (Maybe a)
  handleQuery = case _ of
    QrRender r a -> do
      lift $ renderQR r
      pure (Just a)
  handleAction :: forall slots. QrAction -> H.HalogenM QrState QrAction slots output m Unit
  handleAction = case _ of
    QrInit -> do
      traverse_ (lift <<< renderQR) =<< get

  renderQR :: PaymentRequest -> m Unit
  renderQR (PaymentRequest r) = 
    system.renderQR "paymentRequestQRCode" { content: r.native_request.zip321_request }

import DOM.HTML.Indexed.ButtonType (ButtonType(..))

-- import Halogen.HTML.Events as E

import Halogen.HTML.Events as E

import Aftok.HTML.Classes as C

import Aftok.Modals.ModalFFI as ModalFFI

    , selectedBillable :: Maybe (Tuple BillableId Billable)

    , selectedBillable :: Maybe BillableId

  | CreatePaymentRequest BillableId
  | PaymentRequestCreated (PaymentRequest)

    , showPaymentRequest :: PaymentRequest.QrSlot Unit

_showPaymentRequest = SProxy :: SProxy "showPaymentRequest"

    , createPaymentRequest :: PaymentRequest.Capability m

                    [ Modals.modalButton "createBillable" "Create billable" ]

                    [ Modals.modalButton "createBillable" "Create billable" Nothing]

                      _createBillable

                      _createPaymentRequest

                      (Create.component system caps.createBillable)
                      (unwrap p).projectId

                      (PaymentRequest.component system caps.createPaymentRequest)
                      { projectId: (unwrap p).projectId, billableId: st.selectedBillable }

                      (Just <<< BillableCreated)

                      (Just <<< PaymentRequestCreated)
                  , system.portal
                      _showPaymentRequest
                      unit
                      (PaymentRequest.qrcomponent system)
                      Nothing
                      Nothing
                      (const Nothing)

            [ Modals.modalButton "createPaymentRequest" "New Payment Request" ]

            [ HH.button
              [ P.classes [ C.btn, C.btnPrimary ]
              , P.type_ ButtonButton
              , E.onClick (\_ -> Just $ CreatePaymentRequest bid)
              ]
              [ HH.text "New Payment Request" ]
            ]

      CreatePaymentRequest bid -> do
        H.modify_ (_ { selectedBillable = Just bid })
        _ <- H.query _createPaymentRequest unit $ H.tell (PaymentRequest.SetBillableId bid)
        lift $ system.toggleModal PaymentRequest.modalId ModalFFI.ShowModal
      PaymentRequestCreated req -> do
        lift $ system.log "Created payment request, closing modal."
        lift $ system.toggleModal PaymentRequest.modalId ModalFFI.HideModal
        lift $ system.log "About to show QR code modal"
        lift $ system.toggleModal PaymentRequest.qrModalId ModalFFI.ShowModal
        _ <- H.query _showPaymentRequest unit $ H.tell (PaymentRequest.QrRender req)
        pure unit

  , createPaymentRequest: PaymentRequest.apiCapability

  { createBillable: { createBillable: \_ _ -> pure $ Left Forbidden }

  { createBillable: Create.mockCapability
  , createPaymentRequest: PaymentRequest.mockCapability

exports.renderQRInternal = selector => content => () => {
  $('#' + selector).kjua(content)
}

module Aftok.HTML.KjuaQR 
  ( QRType(..)
  , QROpts
  , renderQR
  )
  where
import Prelude
import Effect (Effect)
data QRType
  = Canvas
  | Image
  | SVG
data ErrorCorrection = L | M | Q | H
renderQR :: String -> QROpts -> Effect Unit
renderQR = renderQRInternal
type QROpts = 
  { content :: String
  }
--     -- render method: 'canvas', 'image' or 'svg'
--     render :: QRType,
--     -- render pixel-perfect lines
--     crisp :: Boolean,
--     -- minimum version: 1..40
--     minVersion :: Int,
--     -- error correction level: 'L', 'M', 'Q' or 'H'
--     ecLevel :: ErrorCorrection,
--     -- size in pixel: 200
--     size :: Int,
--     -- pixel-ratio, null for devicePixelRatio
--     -- ratio :: null,
-- 
--     --code color: '#333',
--     fill :: String -- hack, fine for now
--     -- background color '#fff'
--     back :: String,
-- 
--     -- content
--     text :: String,
-- 
--     -- roundend corners in pc: 0..100
--     rounded: Int,
-- 
--     -- quiet zone in modules: 0
--     quiet: Int,
-- 
--     -- modes: 'plain', 'label' or 'image'
--     mode: 'plain',
-- 
--     -- label/image size and pos in pc: 0..100
--     mSize: 30,
--     mPosX: 50,
--     mPosY: 50,
-- 
--     -- label
--     label: 'no label',
--     fontname: 'sans',
--     fontcolor: '#333',
-- 
--     -- image element
--     image: null
-- 
-- type QROptsInternal = 
--   {
--     -- render method: 'canvas', 'image' or 'svg'
--     render :: String,
-- 
--     -- render pixel-perfect lines
--     crisp :: Boolean,
-- 
--     -- minimum version: 1..40
--     minVersion :: Int
-- 
--     -- error correction level: 'L', 'M', 'Q' or 'H'
--     ecLevel: 'L',
-- 
--     -- size in pixel
--     size: 200,
-- 
--     -- pixel-ratio, null for devicePixelRatio
--     ratio: null,
-- 
--     -- code color
--     fill: '#333',
-- 
--     -- background color
--     back: '#fff',
-- 
--     -- content
--     text: 'no text',
-- 
--     -- roundend corners in pc: 0..100
--     rounded: 0,
-- 
--     -- quiet zone in modules
--     quiet: 0,
-- 
--     -- modes: 'plain', 'label' or 'image'
--     mode: 'plain',
-- 
--     -- label/image size and pos in pc: 0..100
--     mSize: 30,
--     mPosX: 50,
--     mPosY: 50,
-- 
--     -- label
--     label: 'no label',
--     fontname: 'sans',
--     fontcolor: '#333',
-- 
--     -- image element
--     image: null
-- 
-- 
--   }
foreign import renderQRInternal :: String -> QROpts -> Effect Unit

modalButton :: forall w i. String -> String -> HH.HTML w i
modalButton target text =

modalButton :: forall action slots m. String -> String -> Maybe action -> H.ComponentHTML action slots m
modalButton target text action =

    , E.onClick (\_ -> action)

modalWithSave :: 
  forall action slots m. 
  String -> 
  String -> 

modalWithSave ::
  forall action slots m.
  String ->
  String ->

  Array (H.ComponentHTML action slots m) -> 

  Array (H.ComponentHTML action slots m) ->

modalWithClose ::
  forall i w.
  String ->
  String ->
  Array (HH.HTML i w) ->
  HH.HTML i w
modalWithClose modalId title contents =
  HH.div
    [ P.classes [ C.modal ]
    , P.id_ modalId
    , P.tabIndex (negate 1)
    , ARIA.role "dialog"
    , ARIA.labelledBy (modalId <> "Title")
    , ARIA.hidden "true"
    ]
    [ HH.div
      [ P.classes [C.modalDialog], ARIA.role "document" ]
      [ HH.div
        [ P.classes [C.modalContent] ]
        [ HH.div
          [ P.classes [C.modalHeader] ]
          [ HH.h5 [P.classes [C.modalTitle], P.id_ (modalId <>"Title") ] [HH.text title]
          , HH.button
            [ P.classes [ C.close ]
            , AP.dataDismiss "modal"
            , ARIA.label "Close"
            , P.type_ ButtonButton
            ]
            [ HH.span [ARIA.hidden "true"] [HH.text "×"]]
          ]
        , HH.div
          [ P.classes [C.modalBody] ]
          contents
        , HH.div
          [ P.classes [C.modalFooter] ]
          [ HH.button
            [ P.type_ ButtonButton
            , P.classes [ C.btn, C.btnSecondary]
            , AP.dataDismiss "modal"
            ]
            [ HH.text "Close" ]
          ]
        ]
      ]
    ]

import Aftok.HTML.KjuaQR as KjuaQR

    , renderQR :: String -> KjuaQR.QROpts -> m Unit

  , renderQR: \i opts -> liftEffect (KjuaQR.renderQR i opts)

import Aftok.Currency.Zcash.Types (Memo(..))

import Aftok.Types (AccountId)

  )
import Crypto.Random.Types
  ( MonadRandom,
    getRandomBytes,

import Haskoin.Address (encodeBase58Check)

toPaymentsConfig :: MonadDB m => BillingConfig -> IO (PaymentsConfig m)

toPaymentsConfig :: (MonadRandom m, MonadDB m) => BillingConfig -> IO (PaymentsConfig m)

  let btcOps = Bitcoin.BillingOps _memoGen (_uriGen $ cfg ^. bitcoinConfig . bip70Host) _payloadGen

  let btcOps = Bitcoin.BillingOps _btcMemoGen (_uriGen $ cfg ^. bitcoinConfig . bip70Host) _payloadGen

    _zcashBillingOps = _zcashMemoGen,

_memoGen ::

_btcMemoGen ::

_memoGen bill billingDate requestTime = do

_btcMemoGen bill billingDate requestTime = do

_zcashMemoGen ::
  (MonadRandom m, MonadDB m) =>
  B.Billable Zatoshi ->
  Day ->
  UTCTime ->
  AccountId ->
  m (Maybe Memo)
_zcashMemoGen _ _ _ _ = do
  pkey <- encodeBase58Check <$> getRandomBytes 32
  -- for now
  pure $ Just (Memo $ encodeUtf8 pkey)

paramIndex = maybe "" (\i -> pack (printf ".%d" i)) . find (> 0)

paramIndex = \case
  Just i | i > 0 -> pack (printf ".%d" i)
  _ -> ""

  intercalate "&" . toList . itemParams <$> zip (Just <$> fromList [1 ..]) xs

  intercalate "&" . toList . itemParams <$> zip (Just <$> fromList [0 ..]) xs

findUserPaymentAddress :: UserId -> Currency a c -> DBM (Maybe a)

findUserPaymentAddress :: UserId -> Currency a c -> DBM (Maybe (AccountId, a))

        (bitcoinAddressParser mode)
        [sql| SELECT btc_addr FROM cryptocurrency_accounts

        ((,) <$> idParser AccountId <*> bitcoinAddressParser mode)
        [sql| SELECT id, btc_addr FROM cryptocurrency_accounts

        (zcashAddressParser)
        [sql| SELECT zcash_addr FROM cryptocurrency_accounts

        ((,) <$> idParser AccountId <*> zcashAddressParser)
        [sql| SELECT id, zcash_addr FROM cryptocurrency_accounts

  FindUserPaymentAddress :: UserId -> Currency a c -> DBOp (Maybe a)

  FindUserPaymentAddress :: UserId -> Currency a c -> DBOp (Maybe (AccountId, a))

findUserPaymentAddress :: (MonadDB m) => UserId -> Currency a c -> MaybeT m a

findUserPaymentAddress :: (MonadDB m) => UserId -> Currency a c -> MaybeT m (AccountId, a)

findAccountPaymentAddress :: (MonadDB m) => AccountId -> Currency a c -> MaybeT m a
findAccountPaymentAddress uid n = MaybeT . liftdb $ FindAccountPaymentAddress uid n

findAccountPaymentAddress :: (MonadDB m) => AccountId -> Currency a c -> MaybeT m (AccountId, a)
findAccountPaymentAddress aid n = fmap (aid,) . MaybeT . liftdb $ FindAccountPaymentAddress aid n

import Aftok.Types (AccountId)

toOutput :: (Address, Satoshi) -> Either PaymentError Output
toOutput (addr, amt) = case addr of

toOutput :: ((AccountId, Address), Satoshi) -> Either PaymentError Output
toOutput ((_, addr), amt) = case addr of

import Aftok.Types (ProjectId)

import Aftok.Types (ProjectId, AccountId)

  ExceptT PaymentRequestError m (Map a c)

  ExceptT PaymentRequestError m (Map (AccountId, a) c)

  ExceptT PaymentRequestError m [(a, c)]

  ExceptT PaymentRequestError m [((AccountId, a), c)]

import Aftok.Currency.Zcash.Types (Memo(..))

import Aftok.Types (AccountId)

type MemoGen m = Billable Zatoshi -> C.Day -> C.UTCTime -> AccountId -> m (Maybe Memo)

  MemoGen m ->

paymentOps cfg =

paymentOps memoGen cfg =

    { PT.newPaymentRequest = ((fmap PT.Zip321Request .) .) . zip321PaymentRequest cfg

    { PT.newPaymentRequest = ((fmap PT.Zip321Request .) .) . zip321PaymentRequest cfg memoGen

-- TODO: Return a richer type that can include per-item uniqueness that can
-- be used for tracking payments. A payment request, though it's a request for
-- a single transaction, is really a request for multiple payments that we need
-- to be able to verify individually since they'll be independent notes.
--
-- However, this doesn't really become important until we start generating addresses
-- from Zcash IVKs, so it's not essential for right now.

  forall m.

  -- | generator for the memo to be associated with each item
  MemoGen m ->

zip321PaymentRequest cfg billable billingDay _ = do

zip321PaymentRequest cfg memoGen billable billingDay billTime = do

  PaymentRequest <$> (tryJust PT.NoRecipients $ nonEmpty (toPaymentItem <$> assocs payouts))

  itemsMay <- lift $ nonEmpty <$> traverse toPaymentItem (assocs payouts)
  PaymentRequest <$> tryJust PT.NoRecipients itemsMay

    toPaymentItem :: (Address, Zatoshi) -> PaymentItem
    toPaymentItem (a, z) =
      PaymentItem

    toPaymentItem :: ((AccountId, Address), Zatoshi) -> m PaymentItem
    toPaymentItem ((aid, a), z) = do
      memo <- memoGen billable billingDay billTime aid
      pure $ PaymentItem

          _memo = Nothing, -- Just . Memo $ toASCIIBytes (reqid ^. PT._PaymentRequestId),

          _memo = memo,

        _zcashBillingOps :: !(Zcash.MemoGen m),

              let ops = Zcash.paymentOps (cfg ^. zcashPaymentsConfig)

              let ops = Zcash.paymentOps (cfg ^. zcashBillingOps) (cfg ^. zcashPaymentsConfig)

import Aftok.Database.PostgreSQL (QDBM)

    MonadDB,

    zcashBillingOps

    qdbmEval

import Control.Monad.Trans.Except (mapExceptT)

  MonadDB m =>
  PaymentsConfig m ->

  PaymentsConfig QDBM ->

          let ops = Zcash.paymentOps (cfg ^. zcashPaymentsConfig)
          res <- snapEval . runExceptT $ createPaymentRequest ops now bid (b & B.amount .~ v) billDay

          let ops = Zcash.paymentOps (cfg ^. zcashBillingOps) (cfg ^. zcashPaymentsConfig)
          res <- runExceptT . mapExceptT qdbmEval $ createPaymentRequest ops now bid (b & B.amount .~ v) billDay

  obj $ ["payment_request_id" .= (rid ^. _PaymentRequestId)] <> fields req

  v1 . obj $
    ["payment_request_id" .= (rid ^. _PaymentRequestId)] <> fields req

import Aftok.Database.PostgreSQL (runQDBM)

import Aftok.Database.PostgreSQL (QDBM, runQDBM)

  either handleDBError pure e
qdbmEval ::
  (MonadSnap m, HasPostgres m, HasNetworkMode m) => QDBM a -> m a
qdbmEval p = do
  let handleDBError (OpForbidden (UserId uid) reason) =
        snapError 403 $ show reason <> " (User " <> show uid <> ")"
      handleDBError (SubjectNotFound) =
        snapError
          404
          "The subject of the requested operation could not be found."
      handleDBError (EventStorageFailed) =
        snapError 500 "The event submitted could not be saved to the log."
  nmode <- getNetworkMode
  e <- liftPG $
    \conn -> liftIO $ runExceptT (runQDBM nmode conn p)