Invite.purs
module Aftok.Projects.Invite where
import Prelude
import Control.Monad.Trans.Class (lift)
import Data.Array (filter)
import Data.Either (Either(..), note)
import Data.Foldable (any)
import Data.Maybe (Maybe(..))
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 as HH
import Halogen.HTML.Core (ClassName(..))
import Halogen.HTML.Events as E
import Halogen.HTML.Properties as P
import Halogen.HTML.Properties.ARIA as ARIA
import Aftok.Api.Account as Acc
import Aftok.Api.Project as Project
import Aftok.Api.Project (Invitation')
import Aftok.Api.Types (APIError, CommsType(..), CommsAddress(..), Zip321Request)
import Aftok.Components.Zip321QR as Zip321QR
import Aftok.HTML.Forms (commsSwitch, commsField)
import Aftok.HTML.Classes as C
import Aftok.Modals.ModalFFI as ModalFFI
import Aftok.Types (System, ProjectId)
data Field
= PidField
| NameField
| EmailField
| ZAddrField
derive instance fieldEq :: Eq Field
derive instance fieldOrd :: Ord Field
data Query a
= OpenModal ProjectId a
data Mode
= Form
| QrScan Zip321Request
type CState =
{ projectId :: Maybe ProjectId
, greetName :: Maybe String
, message :: Maybe String
, channel :: CommsType
, email :: Maybe String
, zaddr :: Maybe String
, fieldErrors :: Array Field
, mode :: Mode
}
data Action
= SetGreetName String
| SetMessage String
| SetCommsType CommsType
| SetEmail String
| SetZAddr String
| CreateInvitation
| Close
type Slot id
= forall output. H.Slot Query output id
type Slots
= ( inviteQR :: Zip321QR.Slot Unit
)
_inviteQR = SProxy :: SProxy "inviteQR"
type Capability (m :: Type -> Type)
= { createInvitation :: ProjectId -> Invitation' CommsAddress -> m (Either APIError (Maybe Zip321Request))
, checkZAddr :: String -> m Acc.ZAddrCheckResponse
}
modalId :: String
modalId = "createInvitation"
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
, greetName : Nothing
, message : Nothing
, channel: ZcashComms
, email: Nothing
, zaddr: 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 "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" ]
]
]
]
]
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)
]
]
, 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)
]
]
, commsSwitch SetCommsType st.channel
, commsField SetEmail SetZAddr st $ case _ of
EmailComms -> fieldError st EmailField
ZcashComms -> fieldError st ZAddrField
]
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
PidField -> err "No project id found; please report an error"
NameField -> err "The name field is required"
EmailField -> err "An email value is required when email comms are selected"
ZAddrField -> err "Not a valid Zcash shielded address"
else []
where
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)
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
apiCapability :: Capability Aff
apiCapability
= { createInvitation: Project.invite
, checkZAddr: Acc.checkZAddr
}