46PUXHTYRNWQEELXOM7M7NTAFABN5JYQSB5HPN5VF4HWBDQWJU7QC
AKM2VYBLAGDWVBPBF2RXKBU3LQCLD7BTVFKCN5UE45ZUGQWE4ADAC
I5MPORH45P3FYFJU4DINO2PW3YPIPGE2FYSSF4XUQ6WGKWWMSKZQC
3HTCTHHULQUAHAQFUKDIFO3S7FVVFXMAQLLS3T44MLHGDIT5DZGAC
NAFJ6RB3KYDBSTSNB3WQSVUQEPUGG2RZCBWRF4XNT2UKSOXDNMDQC
Z5KNL332YCRMHKU3NG7YWNLUCNHKSLXBZ3O22FSS47MNVXU2FDLAC
APOATM4XGEQZHANT5IY57SKA2QEQ34BZHGNTRAV5KRVPEHUCDYKAC
U7YAT2ZK6GMS7KVFFEQTDRFX6GIN7HVHNWGKIFDGJGE2G2IXSF6QC
7TQPQW3NPNUK6CMTOT5ZE4MDENJ5SUOJ2VF2M4JGKHLZHXVX4F3QC
T2DN23M7W53UMRV46SKDP6UDMCZB7VG2J772LXKMAJNL6NA62MKAC
V54JCKJX4WL5UGJBCX7VR5O6QKABGUHPLYB4MD2NQQW45OFH5OBAC
YBLHJFCNW52TJ37UIHPZ6UD22SQVGG27SP5UQR7YAIJ7F7SYJZSAC
KKJSBWO6RNORAPTJPCCUJJNVI2OYTGLQKB3XJGOASH43GNTJBMKAC
DAPLYXHYFBC6C642AAQ4MHRS44TDFWHLZYM646JZ3WLEK5EMUY4AC
ANDJ6GEY2IRDNKPVXESYEZKU24BAXFB5PPSZFIJRMBGL57A622FQC
4GOBY5NQYPISPYKVN74SM7JYWV7PALUDWWGVXWRHW2J2CPPMC42QC
QAC2QJ32ZLAK25KJ7SWT27WOZKD2MMDE7OZPHIRRFP2W2QZW7PBAC
GLQSD33YYNRDK23R7W2LEIXODI4N5JD3RHX5VMRR5WPMSVMS333QC
RV7ZIULZWHAD5N4ELJYGKUK7GBPJ3L7UWLTIWJRKGLVEXQAHZVFQC
QH4UB73NUR2XPHZQ2RGJBKKUBN43RKC7ZJBCFPP4ESUIIEDDR5XQC
ZHV75AEN7ZYS4LMQK3THSU7O25UIVURBR6XNKUFRN7NVPGHULWDAC
EA5BFM5GMM7KNMDLTVOSUKVKMSIDD72TAFVHDVGEOUY5VELECU3QC
5R2Z7FSXJD7Z53QSU2NSTEBONTYK43FIJOSOMUST5XMYIWRXY2HQC
O2BZOX7MS4JCDS3C6EJQXAWUEQV6HVDCIF2FIN2BCJNRLIU6ZVKAC
SAESJLLYCQJUIHKFYFV53AWHFOSGI5SKLVS7DPTQO6BKGITPYPUQC
I4W76IFVZEKUHNVCNK3DKETL7BMOUCSZHQJ57F4EOUZBW7NHWIBAC
ENNZIQJG4XJ62QCNRMLNAXN7ICTPCHQFZTURX6QSUYYWNADFJHXQC
M4PWY5RUV72AEDCNC4O7UKBPHBIACR4354YTSC3SUZGWFV5UBJBQC
IPG33FAWXGEQ2PO6OXRT2PWWXHRNMPVUKKADL6UKKN5GD2CNZ25AC
H2ABVZI2NFTERQMJ2Z7WGMRNORV3OQQWCCFEN6YO5GAUT2ONM2MAC
X3ES7NUA42D2BF7CQDDKXM5CLMVCYA3H5YU5KXLPTGDBFPE2LNVAC
MU6WOCCJQWG4A5NLD3GBFATCE3SRE3QQCYXYH6WIKSGLHQOOBVRAC
5IDB3IWSB6LFW4U772Y7BH5Y3FQOQ7IFWLVXDZE5XS6SKJITFV4QC
V2VDN77HCSRYYWXDJJ2XOVHV4P6PVWNJZLXZ7JUYPQEZQIH5BZ3QC
NEDDHXUK3GNFMOFO3KLU7NRIHCTYNWBT3D6HTKZAOXFDE6HMDZ6AC
IR75ZMX32SFFMDNV2I2L22X5JTWCOC4UUBCSPU7S6VHR6HFV6ADQC
EFSXYZPOGA5M4DN65IEIDO7JK6U34DMQELAPHOIL2UAT6HRC66BAC
PBD7LZYQHXAA3KLH2ZUX5GW4UFML6BQ32KXZF4KZ6OYFASUYFJ5QC
4354Y4PECM6BOEYIKW2L6WP6ULDIQK2KMNLORWPVKHKQTHUI6CRQC
XXJFUZOVELM3KIPRU6C2NHB3YQ3B3A3GGF2YYBTYJGPU3PR2OV4AC
2XQD6KKKD6QVHFHAEMVE3XXY7X2T7BLTLL7XIILZAXNJJH2YONUQC
U256ZALIPTVWLNACYPIMWLNEYDQWP7CHF4Y4CGMILQTONJHMGQVQC
6L5BK5EHPAOQX3JCKUJ273UDNAC23LPQL4HIJGM4AV3P3QK5OKIQC
ADMKQQGCGVSHHIMVQ4XFRDCG544SBJCYALSKZV45CQQBZ4ACUH2AC
encodeInviteBy :: CommsAddress -> Json
encodeInviteBy = case _ of
EmailCommsAddr email -> encodeJson ({ email: email })
ZcashCommsAddr zaddr -> encodeJson ({ zaddr: zaddr })
type Invitation' by =
{ greetName :: String
, message :: Maybe String
, inviteBy :: by
}
type Invitation = Invitation' CommsAddress
encodeInvitation :: Invitation' Json -> Json
encodeInvitation = encodeJson
type InvResult =
{ zip321_request :: Maybe String
}
decodeInvResult :: Json -> Either JsonDecodeError InvResult
decodeInvResult = decodeJson
invite :: ProjectId -> Invitation -> Aff (Either APIError (Maybe Zip321Request))
invite pid inv = do
let inv' = inv { inviteBy = encodeInviteBy inv.inviteBy }
let body = RB.json $ encodeInvitation inv'
response <- post RF.json ("/api/projects/" <> pidStr pid <> "/invite") (Just body)
map (\r -> Zip321Request <$> r.zip321_request) <$> parseResponse decodeInvResult response
data CommsType
= EmailComms
| ZcashComms
derive instance commsTypeEq :: Eq CommsType
data CommsAddress
= EmailCommsAddr String
| ZcashCommsAddr String
newtype Zip321Request = Zip321Request String
derive instance zip321RequestNewtype :: Newtype Zip321Request _
renderQR :: PaymentRequest -> m String
renderQR (PaymentRequest r) =
system.renderQR { value: r.native_request.zip321_request, size: 300 }
renderQR :: Zip321Request -> m String
renderQR (Zip321Request r) =
system.renderQR { value: r, size: 300 }
module Aftok.HTML.Forms where
import Prelude
import Data.Maybe (Maybe(..), fromMaybe)
import Halogen.HTML.Core (AttrName(..), ClassName(..))
import Halogen.HTML as HH
import Halogen.HTML.CSS as CSS
import Halogen.HTML.Events as E
import Halogen.HTML.Properties as P
import CSS.Display (display, flex)
import CSS.Flexbox (flexFlow, row, nowrap)
import Aftok.Api.Types (CommsType(..))
type CommsState r =
{ recoveryType :: CommsType
, recoveryEmail :: Maybe String
, recoveryZAddr :: Maybe String
| r }
type SetCommsType action = CommsType -> action
type SetEmail action = String -> action
type SetZaddr action = String -> action
commsSwitch :: forall i a. SetCommsType a -> CommsType -> HH.HTML i a
commsSwitch setCommsType rt =
HH.div
[ P.classes (ClassName <$> [ "form-group", "mb-3" ]) ]
[ HH.label
[ P.for "commsSwitch" ]
[ HH.text "Choose a communications method" ]
, HH.div
[ P.classes (ClassName <$> [ "form-group", "mb-3" ])
, CSS.style do
display flex
flexFlow row nowrap
]
[ HH.span
[ P.classes (ClassName <$> [ if rt == EmailComms then "text-success" else "text-muted" ]) ]
$ [ HH.text "Email" ]
, HH.div
[ P.classes (ClassName <$> [ "custom-control", "custom-switch", "custom-switch-light", "mx-3" ]) ]
[ HH.input
[ P.type_ P.InputCheckbox
, P.classes (ClassName <$> [ "custom-control-input" ])
, P.id_ "commsSwitch"
, P.checked (rt == ZcashComms)
, E.onChecked (\b -> Just <<< setCommsType $ if b then ZcashComms else EmailComms)
]
, HH.label [ P.classes (ClassName <$> [ "custom-control-label" ]), P.for "commsSwitch" ] []
]
, HH.span
[ P.classes (ClassName <$> [ if rt == ZcashComms then "text-success" else "text-muted" ]) ]
[ HH.text "Z-Address" ]
]
]
type CommsErrors i a = CommsType -> Array (HH.HTML i a)
commsField ::
forall i a r.
SetEmail a ->
SetZaddr a ->
CommsState r ->
CommsErrors i a ->
HH.HTML i a
commsField setEmail setZAddr st errs = case st.recoveryType of
EmailComms ->
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)
]
]
<> errs EmailComms
ZcashComms ->
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)
]
]
<> errs ZcashComms
<>
[ HH.div
[ P.classes (ClassName <$> [ "row", "pt-3", "font-weight-bold" ]) ]
[ HH.div
[ P.classes (ClassName <$> [ "col-md-2" ]) ]
[ Modals.modalButton Invite.modalId "Invite a collaborator" Nothing]
, system.portal
_invitationModal
unit
(Invite.component system caps.invitationCaps)
project.projectId
Nothing
(Just <<< InvitationCreated)
, system.portal
_inviteQRModal
unit
(PaymentRequest.qrcomponent system)
Nothing
Nothing
(const Nothing)
]
]
-- </section>
-- <!-- Map payouts -->
-- <div class="row font-weight-bold">
-- <div class="col-md-2">
-- </div>
-- <div class="col-md-4">
-- Payments
-- </div>
-- <div class="col-md-6">
--
-- </div>
-- </div>
-- <div class="row">
-- <div class="col-md-2">
-- </div>
-- <div class="col-md-2">
-- Oct 20 2020
-- </div>
-- <div class="col-md-2">
-- 100 zec
-- </div>
-- <div class="col-md-2">
-- Acme PaidUsRight
-- </div>
-- <div class="col-md-4">
-- </div>
-- </div>
-- <!-- map payout creditTos-->
-- <div class="row pt-3">
-- <div class="col-md-4">
-- </div>
-- <div class="col-md-2">
-- Freuline Fred
-- </div>
-- <div class="col-md-2">
-- 2.4 zec
-- </div>
-- <div class="col-md-2">
-- 2.4 %
-- </div>
-- <div class="col-md-2">
-- </div>
-- </div>
-- <div class="row pt-3">
-- <div class="col-md-4">
-- </div>
-- <div class="col-md-2">
-- Goobie Works A Lot
-- </div>
-- <div class="col-md-2">
-- 50 zec
-- </div>
-- <div class="col-md-2">
-- 50 %
-- </div>
-- <div class="col-md-2">
-- </div>
-- </div> <div class="row pt-3">
-- <div class="col-md-4">
-- </div>
-- <div class="col-md-2">
-- Average Fella
-- </div>
-- <div class="col-md-2">
-- 25 zec
-- </div>
-- <div class="col-md-2">
-- 25 %
-- </div>
-- <div class="col-md-2">
-- </div>
-- </div> <div class="row pt-3">
-- <div class="col-md-4">
-- </div>
-- <div class="col-md-2">
-- Cool Kid
-- </div>
-- <div class="col-md-2">
-- 24.6 zec
-- </div>
-- <div class="col-md-2">
-- 24.6 %
-- </div>
-- <div class="col-md-2">
-- </div>
-- </div>
--
-- </section>
--
--
-- <!-- New Project form-->
-- <section id="addProject">
--
-- <div class="row pt-3">
-- <div class="col-md-4">
-- <span class="float-right">Project Name</span>
-- </div>
-- <div class="col-md-4">
-- <input type="text" id="projectName" name="projectName" />
-- </div>
-- </div>
--
-- <div class="row pt-3">
-- <div class="col-md-4">
-- <span class="float-right">Undepreciated Period ( Months )</span>
-- </div>
-- <div class="col-md-4">
-- <input type="text" id="undepreciatedPeriod" name="undepreciatedPeriod" />
-- </div>
-- </div>
--
-- <div class="row pt-3">
-- <div class="col-md-4">
-- <span class="float-right">Depreciation Duration ( Months )</span>
-- </div>
-- <div class="col-md-4">
-- <input type="text" id="depreciationDuration" name="depreciationDuration" />
-- </div>
-- </div>
--
-- <div class="row pt-3 pb-3">
-- <div class="col-md-2">
-- </div>
-- <div class="col-md-10">
-- <button class="btn btn-sm btn-primary lift ml-auto">Add Project</button>
-- </div>
-- </div>
--
-- </section>
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.Validation.Semigroup (V(..), toEither)
import Effect.Aff (Aff)
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 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.HTML.Forms (commsSwitch, commsField)
import Aftok.HTML.Classes as C
import Aftok.Modals as Modals
import Aftok.Modals.ModalFFI as ModalFFI
import Aftok.Types (System, ProjectId)
data Field
= NameField
| EmailField
| ZAddrField
derive instance fieldEq :: Eq Field
derive instance fieldOrd :: Ord Field
type CState =
{ projectId :: ProjectId
, greetName :: Maybe String
, message :: Maybe String
, recoveryType :: CommsType
, recoveryEmail :: Maybe String
, recoveryZAddr :: Maybe String
, fieldErrors :: Array Field
}
type Input = ProjectId
type Output = Maybe Zip321Request
data Action
= ProjectChanged ProjectId
| SetGreetName String
| SetMessage String
| SetCommsType CommsType
| SetEmail String
| SetZAddr String
| CreateInvitation
type Slot id
= forall query. H.Slot query Output id
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 query 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
, greetName : Nothing
, message : Nothing
, recoveryType: EmailComms
, recoveryEmail: Nothing
, recoveryZAddr: Nothing
, fieldErrors : []
}
render :: forall slots. CState -> H.ComponentHTML Action slots m
render st =
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)
]
]
, 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.recoveryType
, 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
NameField -> err "The name field is required"
EmailField -> err "The email field is 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 ] ] ]
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] })
-- 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)
apiCapability :: Capability Aff
apiCapability
= { createInvitation: Project.invite
, checkZAddr: Acc.checkZAddr
}
<> signupErrors ConfirmField st
, recoverySwitch st.recoveryType
, recoveryField st
<> signupErrors st ConfirmField
, commsSwitch SetRecoveryType st.recoveryType
, commsField SetRecoveryEmail SetRecoveryZAddr st $
case _ of
EmailComms -> signupErrors st EmailField
ZcashComms -> signupErrors st ZAddrField
SetRecoveryType t -> H.modify_ (_ { recoveryType = t })
SetRecoveryEmail email -> H.modify_ (_ { recoveryEmail = Just email })
SetRecoveryType t ->
H.modify_ (_ { recoveryType = t })
SetRecoveryEmail email ->
H.modify_ (_ { recoveryEmail = Just email })
RecoveryEmail -> V <<< note [ EmailRequired ] <<< map Acc.RecoverByEmail <$> H.gets (_.recoveryEmail)
RecoveryZAddr -> V <<< note [ ZAddrRequired ] <<< map Acc.RecoverByZAddr <$> H.gets (_.recoveryZAddr)
EmailComms -> V <<< note [ EmailRequired ] <<< map Acc.RecoverByEmail <$> H.gets (_.recoveryEmail)
ZcashComms -> V <<< note [ ZAddrRequired ] <<< map Acc.RecoverByZAddr <$> H.gets (_.recoveryZAddr)
signupErrors :: forall i a. SignupField -> SignupState -> Array (HH.HTML i a)
signupErrors field st = case M.lookup field st.signupErrors of
signupErrors :: forall i a. SignupState -> SignupField -> Array (HH.HTML i a)
signupErrors st field = case M.lookup field st.signupErrors of
recoverySwitch :: forall i. RecoveryType -> HH.HTML i SignupAction
recoverySwitch rt =
HH.div
[ P.classes (ClassName <$> [ "form-group", "mb-3" ]) ]
[ HH.label
[ P.for "recoverySwitch" ]
[ HH.text "Choose a recovery method" ]
, HH.div
[ P.classes (ClassName <$> [ "form-group", "mb-3" ])
, CSS.style do
display flex
flexFlow row nowrap
]
[ HH.span
[ P.classes (ClassName <$> [ if rt == RecoveryEmail then "text-success" else "text-muted" ]) ]
$ [ HH.text "Email" ]
, HH.div
[ P.classes (ClassName <$> [ "custom-control", "custom-switch", "custom-switch-light", "mx-3" ]) ]
[ HH.input
[ P.type_ P.InputCheckbox
, P.classes (ClassName <$> [ "custom-control-input" ])
, P.id_ "recoverySwitch"
, P.checked (rt == RecoveryZAddr)
, E.onChecked (\b -> Just <<< SetRecoveryType $ if b then RecoveryZAddr else RecoveryEmail)
]
, HH.label [ P.classes (ClassName <$> [ "custom-control-label" ]), P.for "recoverySwitch" ] []
]
, HH.span
[ P.classes (ClassName <$> [ if rt == RecoveryZAddr then "text-success" else "text-muted" ]) ]
[ HH.text "Z-Address" ]
]
]
recoveryField :: forall i. SignupState -> HH.HTML i SignupAction
recoveryField st = case st.recoveryType of
RecoveryEmail ->
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 <<< SetRecoveryEmail)
]
]
<> signupErrors EmailField st
RecoveryZAddr ->
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 <<< SetRecoveryZAddr)
]
]
<> signupErrors ZAddrField st
pure $ PaymentsConfig {
_bitcoinBillingOps = btcOps,
_bitcoinPaymentsConfig = btcCfg,
_zcashBillingOps = _zcashMemoGen,
_zcashPaymentsConfig = cfg ^. zcashConfig
}
pure $
PaymentsConfig
{ _bitcoinBillingOps = btcOps,
_bitcoinPaymentsConfig = btcCfg,
_zcashBillingOps = _zcashMemoGen,
_zcashPaymentsConfig = cfg ^. zcashConfig
}
pure $ PaymentItem
{ _address = a,
_label = Nothing,
_message = billable ^. messageText,
_amount = z,
_memo = memo,
_other = []
}
pure $
PaymentItem
{ _address = a,
_label = Nothing,
_message = billable ^. messageText,
_amount = z,
_memo = memo,
_other = []
}
zip321PaymentRequestJSON :: Zip321.PaymentRequest -> Value
zip321PaymentRequestJSON r =
v1 . obj $
["zip321_request" .= (toJSON . Zip321.toURI $ r)]
projectInviteHandler :: ServerConfig -> S.Handler App App ()
instance A.FromJSON ProjectInviteRequest where
parseJSON (A.Object v) = do
name <- v .: "greetName"
message <- v .:? "message"
comms <- v .: "inviteBy"
emailComms <- fmap EmailComms <$> (comms .:? "email")
zcashComms <- fmap ZcashComms <$> (comms .:? "zaddr")
case emailComms <|> zcashComms of
Nothing -> mzero
Just addr -> pure $ PIR name message addr
parseJSON _ = mzero
data ProjectInviteResponse
= ProjectInviteResponse
{ zip321URI :: Maybe Zip321.PaymentRequest
}
projectInviteResponseJSON :: ProjectInviteResponse -> Value
projectInviteResponseJSON resp =
case zip321URI resp of
Just r -> zip321PaymentRequestJSON r
Nothing -> object []
projectInviteHandler :: ServerConfig -> S.Handler App App ProjectInviteResponse
toEmail <- parseParam "email" (fmap (Email . decodeUtf8) takeByteString)
requestBody <- readRequestBody 4096
req <- either (snapError 400 . show) pure $ A.eitherDecode requestBody
(Just p, invCode) <-
snapEval $
(,)
<$> (runMaybeT $ findUserProject uid pid)
<*> createInvitation pid uid toEmail t
liftIO $
sendProjectInviteEmail
cfg
(p ^. projectName)
(Email "noreply@aftok.com")
toEmail
invCode
let invite email =
snapEval $
(,)
<$> (runMaybeT $ findUserProject uid pid)
<*> createInvitation pid uid email t
case inviteBy req of
EmailComms email -> do
(Just p, invCode) <- invite (Email email)
liftIO $
sendProjectInviteEmail
cfg
(p ^. projectName)
(Email "noreply@aftok.com")
(Email email)
invCode
pure (ProjectInviteResponse Nothing)
ZcashComms zaddr -> do
(Just p, invCode) <- invite (Email "")
pure . ProjectInviteResponse . Just
$ Zip321.PaymentRequest . pure
$ Zip321.PaymentItem
{ _address = Zcash.Address zaddr,
_amount = Zcash.Zatoshi 1000,
_memo =
Just . Zcash.Memo . encodeUtf8 $
"Welcome to the " <> (p ^. projectName) <> " aftok, " <> greetName req <> "\n"
<> maybe "" (<> "\n") (message req)
<> "https://aftok.com/app/?invcode="
<> renderInvCode invCode
<> "&zaddr="
<> zaddr,
_message = Nothing,
_label = Nothing,
_other = []
}
inviteRoute = void $ method POST (projectInviteHandler cfg)
acceptInviteRoute = void $ method POST acceptInvitationHandler
inviteRoute =
serveJSON (projectInviteResponseJSON) $ method POST (projectInviteHandler cfg)
acceptInviteRoute =
void $ method POST acceptInvitationHandler