module Aftok.Billing.PaymentRequest where import Prelude import Control.Monad.Trans.Class (lift) import Data.Either (Either(..), note) import Data.Foldable (any) import Data.Maybe (Maybe(..), fromMaybe) import Data.Symbol (SProxy(..)) import Data.Tuple (Tuple(..)) import Data.Validation.Semigroup (V(..), toEither) import Effect.Aff (Aff) import DOM.HTML.Indexed.ButtonType (ButtonType(..)) 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 Halogen.HTML.Properties.ARIA as ARIA import Aftok.Api.Types (APIError(..), Zip321Request(..)) import Aftok.Api.Billing ( BillableId , PaymentRequest'(..) , PaymentRequest , PaymentRequestMeta , createPaymentRequest ) import Aftok.Components.Zip321QR as Zip321QR import Aftok.HTML.Classes as C import Aftok.Modals.ModalFFI as ModalFFI import Aftok.Types (System, ProjectId) data FieldError = PidFieldNotSet | BillableIdNotSet | NameRequired derive instance fieldEq :: Eq FieldError derive instance fieldOrd :: Ord FieldError type CState = { projectId :: Maybe ProjectId , billableId :: Maybe BillableId , name :: Maybe String , description :: Maybe String , fieldErrors :: Array FieldError , mode :: Mode } data Mode = Form | QrScan Zip321Request data Query a = OpenModal ProjectId BillableId a data Action = SetName String | SetDesc String | SavePaymentRequest | Close type Slot id = forall output. H.Slot Query output id type Slots = ( requestQR :: Zip321QR.Slot Unit ) _requestQR = SProxy :: SProxy "requestQR" type Capability (m :: Type -> Type) = { createPaymentRequest :: ProjectId -> BillableId -> PaymentRequestMeta -> m (Either APIError PaymentRequest) } modalId :: String modalId = "createPaymentRequest" component :: forall input output m. Monad m => System m -> Capability m -> H.Component HH.HTML Query input output m component system caps = H.mkComponent { initialState: const initialState , render , eval: H.mkEval $ H.defaultEval { handleAction = handleAction , handleQuery = handleQuery } } where initialState :: CState initialState = { projectId: Nothing , billableId: Nothing , name: Nothing , description: Nothing , fieldErrors: [] , mode: Form } render :: CState -> H.ComponentHTML Action Slots m 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 "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" ] ] ] ] ] 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) ] ] ] formGroup :: forall i a. CState -> Array FieldError -> 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 -> FieldError -> Array (HH.HTML i a) fieldError st field = if any (_ == field) st.fieldErrors then case field of PidFieldNotSet -> err "The project id is missing. Close this dialog and try again." BillableIdNotSet -> err "The billable id is missing. Close this dialog and try again." NameRequired -> err "The name field is required" else [] where err str = [ HH.div_ [ HH.span [ P.classes (ClassName <$> [ "badge", "badge-danger-soft" ]) ] [ HH.text str ] ] ] handleQuery :: forall slots a. Query a -> H.HalogenM CState Action slots output m (Maybe a) handleQuery = case _ of OpenModal pid bid a -> do H.modify_ (\_ -> initialState { projectId = Just pid, billableId = Just bid } ) lift $ system.toggleModal modalId ModalFFI.ShowModal pure (Just a) 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 pidV <- V <<< note [PidFieldNotSet] <$> H.gets (_.projectId) 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 case toEither (Tuple <$> pidV <*> (Tuple <$> bidV <*> reqV)) of Right (Tuple pid (Tuple bid reqMeta)) -> do res <- lift $ caps.createPaymentRequest pid bid reqMeta case res of Right (PaymentRequest req) -> do H.modify_ (_ { mode = QrScan $ Zip321Request req.native_request.zip321_request }) 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 "createPaymentRequest" ModalFFI.HideModal apiCapability :: Capability Aff apiCapability = { createPaymentRequest: createPaymentRequest } mockCapability :: Capability Aff mockCapability = { createPaymentRequest: \_ _ _ -> pure $ Left Forbidden }