XGMFJUERL5G2AX5H3UY27YAAUNO27BH36WM2PGMGXDZAVURWNVBAC
RUAQYIXI4G3RUD4L7536QFGFUFPWFAW7U4PTLFEDIW7FXNLRAMFAC
46PUXHTYRNWQEELXOM7M7NTAFABN5JYQSB5HPN5VF4HWBDQWJU7QC
EA5BFM5GMM7KNMDLTVOSUKVKMSIDD72TAFVHDVGEOUY5VELECU3QC
4GOBY5NQYPISPYKVN74SM7JYWV7PALUDWWGVXWRHW2J2CPPMC42QC
N6FG4EW6QU7V6QV7UHHYRA3EDKPGVCAEAT7IS3QI45N3GRRV2V7AC
V54JCKJX4WL5UGJBCX7VR5O6QKABGUHPLYB4MD2NQQW45OFH5OBAC
YBLHJFCNW52TJ37UIHPZ6UD22SQVGG27SP5UQR7YAIJ7F7SYJZSAC
AKM2VYBLAGDWVBPBF2RXKBU3LQCLD7BTVFKCN5UE45ZUGQWE4ADAC
T2DN23M7W53UMRV46SKDP6UDMCZB7VG2J772LXKMAJNL6NA62MKAC
3PFXXJTLLGDWIFVI32VDUSVGGQL73F6KBACLD2GGJO2AAIS4VPJAC
KKJSBWO6RNORAPTJPCCUJJNVI2OYTGLQKB3XJGOASH43GNTJBMKAC
DAPLYXHYFBC6C642AAQ4MHRS44TDFWHLZYM646JZ3WLEK5EMUY4AC
ANDJ6GEY2IRDNKPVXESYEZKU24BAXFB5PPSZFIJRMBGL57A622FQC
KET5QGQPM5STWGRDL72HTZ5T57QRKQQ3L564PST2PNG4YJHKATSAC
GLQSD33YYNRDK23R7W2LEIXODI4N5JD3RHX5VMRR5WPMSVMS333QC
QAC2QJ32ZLAK25KJ7SWT27WOZKD2MMDE7OZPHIRRFP2W2QZW7PBAC
NAFJ6RB3KYDBSTSNB3WQSVUQEPUGG2RZCBWRF4XNT2UKSOXDNMDQC
U7YAT2ZK6GMS7KVFFEQTDRFX6GIN7HVHNWGKIFDGJGE2G2IXSF6QC
QH4UB73NUR2XPHZQ2RGJBKKUBN43RKC7ZJBCFPP4ESUIIEDDR5XQC
5R2Z7FSXJD7Z53QSU2NSTEBONTYK43FIJOSOMUST5XMYIWRXY2HQC
I5MPORH45P3FYFJU4DINO2PW3YPIPGE2FYSSF4XUQ6WGKWWMSKZQC
module Aftok.Modals where
import Prelude ((<>), negate)
import DOM.HTML.Indexed.ButtonType (ButtonType(..))
import Halogen.HTML as HH
import Halogen.HTML.Properties as P
import Halogen.HTML.Properties.ARIA as ARIA
import Aftok.HTML.Classes as C
import Aftok.HTML.Properties as AP
modalButton :: forall action slots m. String -> String -> Maybe action -> H.ComponentHTML action slots m
modalButton target text action =
HH.button
[ P.classes [ C.btn, C.btnPrimary ]
, AP.dataToggle "modal"
, AP.dataTarget ("#" <> target)
, P.type_ ButtonButton
, E.onClick (\_ -> action)
]
[ HH.text text ]
modalWithSave ::
forall action slots m.
String ->
String ->
action ->
Array (H.ComponentHTML action slots m) ->
H.ComponentHTML action slots m
modalWithSave modalId title submit 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" ]
, HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnPrimary ]
]
[ HH.text "Save changes"]
]
]
]
]
modalWithClose ::
forall action slots m.
String ->
String ->
action ->
Array (H.ComponentHTML action slots m) ->
H.ComponentHTML action slots m
modalWithClose modalId title action 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" ]
]
]
]
]
, E.onClick (\_ -> Just action)
, E.onClick (\_ -> Just submit)
import Halogen.HTML.Events as E
import Halogen as H
import Data.Maybe (Maybe(..))
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.formControl, C.formControlSm ]
, P.id_ "billableName"
, P.placeholder "A name for the product or service you want to bill for"
, E.onValueInput (Just <<< SetName)
render st =
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 "Create a new billable item"]
, HH.button
[ P.classes [ C.close ]
, ARIA.label "Close"
, P.type_ ButtonButton
, E.onClick (\_ -> Just Close)
]
[ HH.span [ARIA.hidden "true"] [HH.text "×"]]
]
, formGroup st
[ DescField ]
[ HH.label
[ P.for "billableDesc"]
[ HH.text "Product Description" ]
, HH.input
[ P.type_ P.InputText
, P.classes [ C.formControl, 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.classes [C.formControl, C.formControlSm]
, P.id_ "billableMsg"
, P.placeholder "Enter your message here"
, E.onValueInput (Just <<< SetMessage)
]
]
, formGroup st
[MonthlyRecurrenceField, WeeklyRecurrenceField]
[ formCheckGroup
{ id: "recurAnnual"
, checked: (st.recurrenceType == RTAnnual)
, labelClasses: []
}
(\_ -> Just (SetRecurrenceType RTAnnual))
[ HH.text "Annual" ]
, formCheckGroup
{ id: "recurMonthly"
, checked: (st.recurrenceType == RTMonthly)
, labelClasses: [C.formInline]
}
(\_ -> Just (SetRecurrenceType RTMonthly))
[ HH.text "Every"
, HH.input
[ P.type_ P.InputNumber
, P.classes [ C.formControl, C.formControlXs, C.formControlFlush, C.marginX2 ]
, 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.div
[ P.classes [C.modalBody] ]
[ HH.form_
[ formGroup st
[ NameField ]
[ HH.label
[ P.for "billableName"]
[ HH.text "Product Name" ]
, HH.input
[ P.type_ P.InputText
, P.classes [ C.formControl, C.formControlSm ]
, P.id_ "billableName"
, P.placeholder "A name for the product or service you want to bill for"
, E.onValueInput (Just <<< SetName)
, HH.text "Months"]
, formCheckGroup
{ id: "recurWeekly"
, checked: (st.recurrenceType == RTWeekly)
, labelClasses: [C.formInline]
}
(\_ -> Just (SetRecurrenceType RTWeekly))
[ HH.text "Every"
, HH.input
[ P.type_ P.InputNumber
, P.classes [ C.formControl, C.formControlXs, C.formControlFlush, C.marginX2 ]
, P.value (if st.recurrenceType == RTWeekly
then maybe "" show st.recurrenceValue
else "")
, P.min 1.0
, P.max 12.0
, E.onValueInput (Just <<< SetRecurrenceWeeks)
]
, formGroup st
[ DescField ]
[ HH.label
[ P.for "billableDesc"]
[ HH.text "Product Description" ]
, HH.input
[ P.type_ P.InputText
, P.classes [ C.formControl, 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.classes [C.formControl, C.formControlSm]
, P.id_ "billableMsg"
, P.placeholder "Enter your message here"
, E.onValueInput (Just <<< SetMessage)
]
, HH.text "Weeks"
]
, formCheckGroup
{ id: "oneTime"
, checked: st.recurrenceType == RTOneTime
, labelClasses: []
}
(\_ -> Just (SetRecurrenceType RTOneTime))
[ HH.text "One-Time" ]
]
, formGroup st
[AmountField]
[ HH.label
[ P.for "billableAmount"]
[ HH.text "Amount" ]
, HH.div
[ P.classes [ ClassName "input-group", ClassName "input-group-sm" ] ]
[ HH.input
[ P.type_ P.InputNumber
, P.classes [ C.formControl ]
, P.id_ "billableAmount"
, P.value (maybe "" (Fixed.toString <<< unwrap) st.amount)
, P.placeholder "1.0"
, P.min 0.0
, E.onValueInput (Just <<< SetBillingAmount)
, formGroup st
[MonthlyRecurrenceField, WeeklyRecurrenceField]
[ formCheckGroup
{ id: "recurAnnual"
, checked: (st.recurrenceType == RTAnnual)
, labelClasses: []
}
(\_ -> Just (SetRecurrenceType RTAnnual))
[ HH.text "Annual" ]
, formCheckGroup
{ id: "recurMonthly"
, checked: (st.recurrenceType == RTMonthly)
, labelClasses: [C.formInline]
}
(\_ -> Just (SetRecurrenceType RTMonthly))
[ HH.text "Every"
, HH.input
[ P.type_ P.InputNumber
, P.classes [ C.formControl, C.formControlXs, C.formControlFlush, C.marginX2 ]
, 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"]
, formCheckGroup
{ id: "recurWeekly"
, checked: (st.recurrenceType == RTWeekly)
, labelClasses: [C.formInline]
}
(\_ -> Just (SetRecurrenceType RTWeekly))
[ HH.text "Every"
, HH.input
[ P.type_ P.InputNumber
, P.classes [ C.formControl, C.formControlXs, C.formControlFlush, C.marginX2 ]
, 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.div
[ P.classes [ ClassName "input-group-append"] ]
[ HH.span
[ P.classes [ ClassName "input-group-text" ]
, P.style "height: auto;" -- fix bad calculated height from LandKit
, formCheckGroup
{ id: "oneTime"
, checked: st.recurrenceType == RTOneTime
, labelClasses: []
}
(\_ -> Just (SetRecurrenceType RTOneTime))
[ HH.text "One-Time" ]
]
, formGroup st
[AmountField]
[ HH.label
[ P.for "billableAmount"]
[ HH.text "Amount" ]
, HH.div
[ P.classes [ ClassName "input-group", ClassName "input-group-sm" ] ]
[ HH.input
[ P.type_ P.InputNumber
, P.classes [ C.formControl ]
, 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" ]
, P.style "height: auto;" -- fix bad calculated height from LandKit
]
[ HH.text "ZEC" ] ]
[ 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.formControl, 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.formControl, 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 st
[GracePeriodField]
[ HH.label
[ P.for "gracePeriod"]
[ HH.text "Grace Period (Days)" ]
, HH.input
[ P.type_ P.InputNumber
, P.id_ "gracePeriod"
, P.classes [ C.formControl, 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 [PidField] []
]
, HH.div
[ P.classes [C.modalFooter] ]
[ HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnSecondary]
, E.onClick (\_ -> Just Close)
]
, 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.formControl, 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)
[ HH.text "Close" ]
, HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnPrimary ]
, E.onClick (\_ -> Just Save)
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))
err str = [ HH.div_ [ HH.span [ P.classes (ClassName <$> [ "badge", "badge-danger-soft" ]) ] [ HH.text str ] ] ]
err str =
[ HH.div_
[ HH.span
[ P.classes (ClassName <$> [ "badge", "badge-danger-soft" ]) ] [ HH.text str ] ]
]
-- we use a query to initialize, since this is a modal that doesn't actually get unloaded.
handleQuery :: forall slots a. Query a -> H.HalogenM CState Action slots Output m (Maybe a)
handleQuery = case _ of
OpenModal pid a -> do
H.modify_ (\_ -> initialState { projectId = Just pid })
lift $ system.toggleModal modalId ModalFFI.ShowModal
pure (Just a)
eval :: forall slots. Action -> H.HalogenM CState Action slots Output m Unit
eval = case _ of
ProjectChanged pid ->
H.modify_ (_ { projectId = pid })
handleAction :: forall slots. Action -> H.HalogenM CState Action slots Output m Unit
handleAction = case _ of
Modals.modalWithSave modalId "Create Payment Request" SavePaymentRequest
[ HH.form_
[ formGroup st
[ NameRequired ]
[ HH.label
[ P.for "requestName"]
[ HH.text "Request Name" ]
, HH.input
[ P.type_ P.InputText
, P.classes [ C.formControl, C.formControlSm ]
, P.id_ "requestName"
, P.placeholder "A name for the payment request"
, P.value (fromMaybe "" st.name)
, E.onValueInput (Just <<< SetName)
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 "Request a payment"]
, HH.button
[ P.classes [ C.close ]
, ARIA.label "Close"
, P.type_ ButtonButton
, E.onClick (\_ -> Just Close)
]
[ HH.span [ARIA.hidden "true"] [HH.text "×"]]
, HH.div
[ P.classes [C.modalBody] ]
case st.mode of
Form ->
[ requestForm st ]
QrScan req ->
[ HH.slot _requestQR unit (Zip321QR.component system) req (const Nothing) ]
, HH.div
[ P.classes [C.modalFooter] ] $
case st.mode of
Form ->
[ HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnSecondary]
, E.onClick (\_ -> Just Close)
]
[ HH.text "Close" ]
, HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnPrimary ]
, E.onClick (\_ -> Just SavePaymentRequest)
]
[ HH.text "Create Request" ]
]
QrScan _ ->
[ HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnPrimary]
, E.onClick (\_ -> Just Close)
]
[ HH.text "Close" ]
]
, formGroup st
[ ]
[ HH.label
[ P.for "requestDesc"]
[ HH.text "Request Description" ]
, HH.input
[ P.type_ P.InputText
, P.classes [ C.formControl, C.formControlSm ]
, P.id_ "requestDesc"
, P.placeholder "Additional descriptive information"
, P.value (fromMaybe "" st.description)
, E.onValueInput (Just <<< SetDesc)
]
]
]
requestForm st =
HH.form_
[ formGroup st
[ NameRequired ]
[ HH.label
[ P.for "requestName"]
[ HH.text "Request Name" ]
, HH.input
[ P.type_ P.InputText
, P.classes [ C.formControl, C.formControlSm ]
, P.id_ "requestName"
, P.placeholder "A name for the payment request"
, P.value (fromMaybe "" st.name)
, E.onValueInput (Just <<< SetName)
]
, formGroup st
[ ]
[ HH.label
[ P.for "requestDesc"]
[ HH.text "Request Description" ]
, HH.input
[ P.type_ P.InputText
, P.classes [ C.formControl, C.formControlSm ]
, P.id_ "requestDesc"
, P.placeholder "Additional descriptive information"
, P.value (fromMaybe "" st.description)
, E.onValueInput (Just <<< SetDesc)
]
SetProjectId pid a -> do
H.modify_ (_ { projectId = pid, billableId = Nothing, name = Nothing, description = Nothing })
pure (Just a)
SetBillableId bid a -> do
H.modify_ (_ { billableId = Just bid })
OpenModal pid bid a -> do
H.modify_ (\_ -> initialState { projectId = Just pid, billableId = Just bid } )
lift $ system.toggleModal modalId ModalFFI.ShowModal
breqV = Tuple <$> bidV <*> reqV
case toEither breqV of
Left errors -> do
H.modify_ (_ { fieldErrors = errors })
Right (Tuple bid reqMeta) -> do
pid <- H.gets (_.projectId)
case toEither (Tuple <$> pidV <*> (Tuple <$> bidV <*> reqV)) of
Right (Tuple pid (Tuple bid reqMeta)) -> do
Right content -> do
H.raise content
H.modify_ (_ { billableId = Nothing, name = Nothing, description = Nothing, fieldErrors = [] })
lift $ system.toggleModal "createPaymentRequest" ModalFFI.HideModal
Right (PaymentRequest req) -> do
H.modify_ (_ { mode = QrScan $ Zip321Request req.native_request.zip321_request })
data QrQuery a
= QrRender Zip321Request a
data QrAction
= QrInit
| QrClose
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 QrInput output m
qrcomponent system =
H.mkComponent
{ initialState
, render
, eval:
H.mkEval
$ H.defaultEval
{ handleAction = handleAction
, handleQuery = handleQuery
, initialize = Just QrInit
}
}
where
initialState :: QrInput -> QrState
initialState input =
{ req: input, dataUrl: Nothing }
render :: forall slots. QrState -> H.ComponentHTML QrAction slots m
render st =
Modals.modalWithClose qrModalId "Payment Request" QrClose
[ HH.div_
((\url -> HH.img [P.src url]) <$> U.fromMaybe st.dataUrl)
, HH.div_
[ HH.span
[ P.classes (ClassName <$> ["code", "zip321uri"]) ]
(HH.text <<< unwrap <$> U.fromMaybe st.req)
]
]
handleQuery :: forall slots a. QrQuery a -> H.HalogenM QrState QrAction slots output m (Maybe a)
handleQuery = case _ of
QrRender r a -> do
dataUrl <- lift $ renderQR r
H.modify_ (_ { req = Just r, dataUrl = Just dataUrl })
pure (Just a)
handleAction :: forall slots. QrAction -> H.HalogenM QrState QrAction slots output m Unit
handleAction = case _ of
QrInit -> do
req <- H.gets (_.req)
lift $ traverse_ renderQR req
QrClose ->
H.modify_ (_ { req = Nothing, dataUrl = Nothing })
renderQR :: Zip321Request -> m String
renderQR (Zip321Request r) =
system.renderQR { value: r, size: 300 }
| BillableCreated (Tuple BillableId Billable)
| CreatePaymentRequest BillableId
| PaymentRequestCreated (PaymentRequest)
| OpenBillableModal ProjectId
| BillableCreated BillableId
| OpenPaymentRequestModal ProjectId BillableId
renderBillableList :: Array (Tuple BillableId Billable) -> H.ComponentHTML BillingAction Slots m
renderBillableList billables =
renderBillableList :: ProjectId -> Array (Tuple BillableId Billable) -> H.ComponentHTML BillingAction Slots m
renderBillableList pid billables =
CreatePaymentRequest bid -> do
_ <- H.query _createPaymentRequest unit $ H.tell (PaymentRequest.SetBillableId bid)
lift $ system.toggleModal PaymentRequest.modalId ModalFFI.ShowModal
PaymentRequestCreated (PaymentRequest req) -> do
lift $ system.toggleModal PaymentRequest.modalId ModalFFI.HideModal
lift $ system.toggleModal PaymentRequest.qrModalId ModalFFI.ShowModal
let req' = Zip321Request req.native_request.zip321_request
_ <- H.query _showPaymentRequest unit $ H.tell (PaymentRequest.QrRender req')
pure unit
OpenPaymentRequestModal pid bid -> do
void $ H.query _createPaymentRequest unit $ H.tell (PaymentRequest.OpenModal pid bid)
module Aftok.Components.Zip321QR where
import Prelude
import Control.Monad.Trans.Class (lift)
import Data.Maybe (Maybe(..))
import Data.Newtype (unwrap)
import Data.Unfoldable as U
import Halogen as H
import Halogen.HTML.Core (ClassName(..))
import Halogen.HTML as HH
import Halogen.HTML.Properties as P
import Aftok.Types (System)
import Aftok.Api.Types (Zip321Request)
type Input = Zip321Request
type CState =
{ req :: Zip321Request
, dataUrl :: Maybe String
}
data Action
= QrInit
type Slot id
= forall query. H.Slot query Unit id
component ::
forall m output query.
Monad m =>
System m ->
H.Component HH.HTML query Input output m
component system =
H.mkComponent
{ initialState
, render
, eval:
H.mkEval
$ H.defaultEval
{ handleAction = handleAction
, initialize = Just QrInit
}
}
where
initialState :: Input -> CState
initialState input =
{ req: input, dataUrl: Nothing }
render :: forall slots. CState -> H.ComponentHTML Action slots m
render st =
HH.div_
[ HH.div_
((\url -> HH.img [P.src url]) <$> U.fromMaybe st.dataUrl)
, HH.div_
[ HH.span
[ P.classes (ClassName <$> ["code", "zip321uri"]) ]
[HH.text <<< unwrap $ st.req]
]
]
handleAction :: forall slots. Action -> H.HalogenM CState Action slots output m Unit
handleAction = case _ of
QrInit -> do
req <- H.gets (_.req)
uri <- lift $ system.renderQR { value: unwrap req, size: 300 }
H.modify_ (_ { dataUrl = Just uri })
HH.div
[ P.id_ "recoveryEmail" ]
$ [ HH.label [ P.for "email" ] [ HH.text "Email Address" ]
, HH.input
[ P.type_ P.InputEmail
, P.classes (ClassName <$> [ "form-control" ])
, P.id_ "email"
, P.placeholder "name@address.com"
, P.value (fromMaybe "" st.recoveryEmail)
, E.onValueInput (Just <<< setEmail)
]
]
HH.div_ $
[ HH.label [ P.for "email" ] [ HH.text "Email Address" ]
, HH.input
[ P.type_ P.InputEmail
, P.classes (ClassName <$> [ "form-control" ])
, P.id_ "email"
, P.placeholder "name@address.com"
, P.value (fromMaybe "" st.email)
, E.onValueInput (Just <<< setEmail)
]
]
HH.div
[ P.id_ "recoveryZAddr" ]
$ [ HH.label
[ P.for "zaddr" ]
[ HH.text "Zcash Shielded Address"
, HH.a
[ P.attr (AttrName "data-toggle") "modal"
, P.href "#modalAboutZAddr"
]
[ HH.img [ P.src "/assets/img/icons/duotone-icons/Code/Info-circle.svg" ]
]
]
, HH.input
[ P.type_ P.InputText
, P.classes (ClassName <$> [ "form-control" ])
, P.id_ "email"
, P.placeholder "Enter a Zcash shielded address"
, P.value (fromMaybe "" st.recoveryZAddr)
, E.onValueInput (Just <<< setZAddr)
]
]
HH.div_ $
[ HH.label
[ P.for "zaddr" ]
[ HH.text "Zcash Shielded Address"
, HH.a
[ P.attr (AttrName "data-toggle") "modal"
, P.href "#modalAboutZAddr"
]
[ HH.img [ P.src "/assets/img/icons/duotone-icons/Code/Info-circle.svg" ]
]
]
, HH.input
[ P.type_ P.InputText
, P.classes (ClassName <$> [ "form-control" ])
, P.id_ "email"
, P.placeholder "Enter a Zcash shielded address"
, P.value (fromMaybe "" st.zaddr)
, E.onValueInput (Just <<< setZAddr)
]
]
Modals.modalWithSave modalId "Invite a collaborator" CreateInvitation
[ HH.form_
[ formGroup st
[ NameField ]
[ HH.label
[ P.for "greetName"]
[ HH.text "Name" ]
, HH.input
[ P.type_ P.InputText
, P.classes [ C.formControl, C.formControlSm ]
, P.id_ "greetName"
, P.placeholder "Who are you inviting?"
, E.onValueInput (Just <<< SetGreetName)
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 "Invite a collaborator"]
, HH.button
[ P.classes [ C.close ]
, ARIA.label "Close"
, P.type_ ButtonButton
, E.onClick (\_ -> Just Close)
]
[ HH.span [ARIA.hidden "true"] [HH.text "×"]]
, HH.div
[ P.classes [C.modalBody] ]
case st.mode of
Form ->
[ inviteForm st ]
QrScan req ->
[ HH.slot _inviteQR unit (Zip321QR.component system) req (const Nothing) ]
, HH.div
[ P.classes [C.modalFooter] ] $
case st.mode of
Form ->
[ HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnSecondary]
, E.onClick (\_ -> Just Close)
]
[ HH.text "Close" ]
, HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnPrimary ]
, E.onClick (\_ -> Just CreateInvitation)
]
[ HH.text "Send invitation" ]
]
QrScan _ ->
[ HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnPrimary]
, E.onClick (\_ -> Just Close)
]
[ HH.text "Close" ]
]
, formGroup st
[ ]
[ HH.label
[ P.for "message"]
[ HH.text "Message" ]
, HH.input
[ P.type_ P.InputText
, P.classes [C.formControl, C.formControlSm]
, P.id_ "message"
, P.placeholder "Enter your message here"
, E.onValueInput (Just <<< SetMessage)
]
]
]
inviteForm st =
HH.form_
[ formGroup st
[ NameField ]
[ HH.label
[ P.for "greetName"]
[ HH.text "Name" ]
, HH.input
[ P.type_ P.InputText
, P.classes [ C.formControl, C.formControlSm ]
, P.id_ "greetName"
, P.placeholder "Who are you inviting?"
, E.onValueInput (Just <<< SetGreetName)
, commsSwitch SetCommsType st.recoveryType
, commsField SetEmail SetZAddr st $ case _ of
EmailComms -> fieldError st EmailField
ZcashComms -> fieldError st ZAddrField
]
, formGroup st
[ ]
[ HH.label
[ P.for "message"]
[ HH.text "Message" ]
, HH.input
[ P.type_ P.InputText
, P.classes [C.formControl, C.formControlSm]
, P.id_ "message"
, P.placeholder "Enter your message here"
, E.onValueInput (Just <<< SetMessage)
]
EmailField -> err "The email field is when email comms are selected"
ZAddrField -> err "Not a valid Zcash shielded address."
EmailField -> err "An email value is required when email comms are selected"
ZAddrField -> err "Not a valid Zcash shielded address"
setZAddr addr = do
zres <- lift $ caps.checkZAddr addr
H.modify_ (_ { recoveryZAddr = Just addr })
case zres of
Acc.ZAddrCheckValid ->
H.modify_ (\st -> st { fieldErrors = filter (_ /= ZAddrField) st.fieldErrors, recoveryType = ZcashComms })
Acc.ZAddrCheckInvalid ->
H.modify_ (\st -> st { fieldErrors = st.fieldErrors <> [ZAddrField] })
-- we use a query to initialize, since this is a modal that doesn't actually get unloaded.
handleQuery :: forall slots a. Query a -> H.HalogenM CState Action slots output m (Maybe a)
handleQuery = case _ of
OpenModal pid a -> do
H.modify_ (\_ -> initialState { projectId = Just pid })
lift $ system.toggleModal modalId ModalFFI.ShowModal
pure (Just a)
-- eval :: forall slots. Action -> H.HalogenM CState Action slots Output m Unit
eval = case _ of
ProjectChanged pid ->
H.modify_ (_ { projectId = pid })
SetGreetName name ->
H.modify_ (_ { greetName = Just name })
SetMessage msg ->
H.modify_ (_ { message = Just msg })
SetCommsType t ->
H.modify_ (_ { recoveryType = t })
SetEmail email ->
H.modify_ (_ { recoveryEmail = Just email })
SetZAddr addr ->
when (addr /= "") (setZAddr addr)
CreateInvitation -> do
nameV <- V <<< note [NameField] <$> H.gets (_.greetName)
message <- H.gets (_.message)
addrType <- H.gets (_.recoveryType)
addrV <-
case addrType of
EmailComms -> map EmailCommsAddr <<< V <<< note [EmailField] <$> H.gets (_.recoveryEmail)
ZcashComms -> map ZcashCommsAddr <<< V <<< note [ZAddrField] <$> H.gets (_.recoveryZAddr)
let reqV :: V (Array Field) (Invitation' CommsAddress)
reqV = { greetName: _, message: _, inviteBy: _ }
<$> nameV
<*> pure message
<*> addrV
case toEither reqV of
Left errors -> do
H.modify_ (_ { fieldErrors = errors })
Right invitation -> do
pid <- H.gets (_.projectId)
res <- lift $ caps.createInvitation pid invitation
case res of
Right result -> do
H.raise result
lift $ system.toggleModal modalId ModalFFI.HideModal
Left errs ->
lift $ system.error (show errs)
handleAction :: forall slots. Action -> H.HalogenM CState Action slots output m Unit
handleAction = case _ of
SetGreetName name ->
H.modify_ (_ { greetName = Just name })
SetMessage msg ->
H.modify_ (_ { message = Just msg })
SetCommsType t ->
H.modify_ (_ { channel = t })
SetEmail email ->
H.modify_ (_ { email = Just email })
SetZAddr addr -> do
let setZAddr addr' = do
zres <- lift $ caps.checkZAddr addr'
H.modify_ (_ { zaddr = Just addr' })
case zres of
Acc.ZAddrCheckValid ->
H.modify_ (\st -> st { fieldErrors = filter (_ /= ZAddrField) st.fieldErrors
, channel = ZcashComms
})
Acc.ZAddrCheckInvalid ->
H.modify_ (\st -> st { fieldErrors = st.fieldErrors <> [ZAddrField] })
when (addr /= "") (setZAddr addr)
CreateInvitation -> do
pidV <- V <<< note [PidField] <$> H.gets (_.projectId)
nameV <- V <<< note [NameField] <$> H.gets (_.greetName)
message <- H.gets (_.message)
channel <- H.gets (_.channel)
addrV <-
case channel of
EmailComms -> map EmailCommsAddr <<< V <<< note [EmailField] <$> H.gets (_.email)
ZcashComms -> map ZcashCommsAddr <<< V <<< note [ZAddrField] <$> H.gets (_.zaddr)
let reqV :: V (Array Field) (Invitation' CommsAddress)
reqV = { greetName: _, message: _, inviteBy: _ }
<$> nameV
<*> pure message
<*> addrV
case toEither (Tuple <$> pidV <*> reqV) of
Right (Tuple pid invitation) -> do
res <- lift $ caps.createInvitation pid invitation
case res of
Right (Just req) -> H.modify_ (_ { mode = QrScan req })
Right Nothing -> handleAction Close
Left errs -> lift $ system.error (show errs)
Left errors -> do
H.modify_ (_ { fieldErrors = errors })
Close -> do
H.modify_ (const initialState) -- wipe the state for safety
lift $ system.toggleModal modalId ModalFFI.HideModal
recoveryType <- H.gets (_.recoveryType)
recoveryV <- case recoveryType of
EmailComms -> V <<< note [ EmailRequired ] <<< map Acc.RecoverByEmail <$> H.gets (_.recoveryEmail)
ZcashComms -> V <<< note [ ZAddrRequired ] <<< map Acc.RecoverByZAddr <$> H.gets (_.recoveryZAddr)
channel <- H.gets (_.channel)
recoveryV <- case channel of
EmailComms -> V <<< note [ EmailRequired ] <<< map Acc.RecoverByEmail <$> H.gets (_.email)
ZcashComms -> V <<< note [ ZAddrRequired ] <<< map Acc.RecoverByZAddr <$> H.gets (_.zaddr)