U7YAT2ZK6GMS7KVFFEQTDRFX6GIN7HVHNWGKIFDGJGE2G2IXSF6QC
UD5T5B7ACLIM7CPSRYGXSQ3EFNS6DTPABPXJE4HQCBI7JYLE5K3QC
APOATM4XGEQZHANT5IY57SKA2QEQ34BZHGNTRAV5KRVPEHUCDYKAC
RV7ZIULZWHAD5N4ELJYGKUK7GBPJ3L7UWLTIWJRKGLVEXQAHZVFQC
O2BZOX7MS4JCDS3C6EJQXAWUEQV6HVDCIF2FIN2BCJNRLIU6ZVKAC
QH4UB73NUR2XPHZQ2RGJBKKUBN43RKC7ZJBCFPP4ESUIIEDDR5XQC
ENNZIQJG4XJ62QCNRMLNAXN7ICTPCHQFZTURX6QSUYYWNADFJHXQC
NAFJ6RB3KYDBSTSNB3WQSVUQEPUGG2RZCBWRF4XNT2UKSOXDNMDQC
7TQPQW3NPNUK6CMTOT5ZE4MDENJ5SUOJ2VF2M4JGKHLZHXVX4F3QC
Z5KNL332YCRMHKU3NG7YWNLUCNHKSLXBZ3O22FSS47MNVXU2FDLAC
RSF6UAJKG7CEKILSVXI6C4YZXY7PIYZM2EMA2IXKQ7SADKNVSH7QC
IR75ZMX32SFFMDNV2I2L22X5JTWCOC4UUBCSPU7S6VHR6HFV6ADQC
PPW6ROC5U7FZCJCH2RX7UJ3PJYNPUMNEZ6KKO3375VFRUM4VT3VQC
QAC2QJ32ZLAK25KJ7SWT27WOZKD2MMDE7OZPHIRRFP2W2QZW7PBAC
GLQSD33YYNRDK23R7W2LEIXODI4N5JD3RHX5VMRR5WPMSVMS333QC
5R2Z7FSXJD7Z53QSU2NSTEBONTYK43FIJOSOMUST5XMYIWRXY2HQC
SAESJLLYCQJUIHKFYFV53AWHFOSGI5SKLVS7DPTQO6BKGITPYPUQC
JXG3FCXYBDKMUD77DOM7RCIJYKB7BILC43OHHDZBE7YQRGAMUCCAC
QU5FW67RGCWOWT2YFM4NYMJFFHWIRPQANQBBAHBKZUY7UYMCSIMQC
QMEYU4MWLTSWPWEEOFRLK2IKE64BY3V5X73323WPLCGPP3TPDYGAC
RB2ETNIFLQUA6OA66DAEOXZ25ENMQGNKX5CZRSKEYHTD6BQ6NTFQC
XA7SOE6JNY7BKAUOUGAROVLGXO7E3MSHVG4LZYHSPITH5PU4W5ZQC
GMYPBCWEB6NKURRILAHR3TJUKDOGR2ZMK5I6MS6P5G2LAGH36P3QC
AAALU5A2FQQTNV7ZVAFCU2JTRUONEUWWZKENDUUXDOFUGWHM3KZQC
3GLHIR4FVKUCN5EIXCJROC3RDN3Y7DHBU3KN3QBRDHST7VPIOOUAC
X3ES7NUA42D2BF7CQDDKXM5CLMVCYA3H5YU5KXLPTGDBFPE2LNVAC
DFOBMSAODB3NKW37B272ZXA2ML5HMIH3N3C4GT2DPEQS7ZFK4SNAC
M4PWY5RUV72AEDCNC4O7UKBPHBIACR4354YTSC3SUZGWFV5UBJBQC
MU6WOCCJQWG4A5NLD3GBFATCE3SRE3QQCYXYH6WIKSGLHQOOBVRAC
IZEVQF627FA7VV25KJAWYWGGC35LZUUBBQRPN5ZAINTQLPEDRTEAC
64C6AWH66FDKU6UE6Z6JPX2J2GBM2JOPTH2GL6LHKAIUBGNGDZ5AC
U256ZALIPTVWLNACYPIMWLNEYDQWP7CHF4Y4CGMILQTONJHMGQVQC
O5FVTOM6YFBLEPF3S576K6IMT6ZZ5VQCSB3YVXNS4CKBITKCRZ7AC
B6HWAPDPXIWH7CHK5VLMWLL6EQN6NOFZEFYO47BPUY2ZO4SL7VDAC
NEDDHXUK3GNFMOFO3KLU7NRIHCTYNWBT3D6HTKZAOXFDE6HMDZ6AC
NVOCQVASZWTKQJG7GPH7KHKZZR7NUG4WLV5YY4KAIRPCJRWCZPIAC
A6HKMINBNGQLLX4QJMYWKQ4JAEHVJ4HIRVDKPPDI3FJUO2AAB7OQC
POX3UAMTGCNS3SU5I6IKDNCCSHEAUSFBZ3WCMQ3EXKPNXETOI6BAC
7KZP4RHZ3QSYTPPQ257A65Z5UPX44TF2LAI2U5EMULQCLDCEUK2AC
UWMGUJOW5X5HQTS76T2FD7MNAJF7SESPQVU5FDIZO52V75TT2X6AC
7HPY3QPFPN35PSPUBVNW2GTFB3CBQZBST4J2BAVJ7QMXLIUN52JAC
4QX5E5ACVN57KJLCWOM4JEI6JSV4XZNCWVYPOTKSOMUW3SOMCNJAC
QMRKFEPGFBCEWAIXPEIG5ILKAJ2JH5L3TOITHR4HNJXK5FN3KXBQC
KEP5WUFJXTMKRRNZLYTGYYWA4VLFCMHTKTJYF5EA5IWBYFMU6WYQC
PBD7LZYQHXAA3KLH2ZUX5GW4UFML6BQ32KXZF4KZ6OYFASUYFJ5QC
4354Y4PECM6BOEYIKW2L6WP6ULDIQK2KMNLORWPVKHKQTHUI6CRQC
EFSXYZPOGA5M4DN65IEIDO7JK6U34DMQELAPHOIL2UAT6HRC66BAC
HALRDT2F22DAQ54M334YSKD2XJCAXDXEZPDKGMOWKH7XELBAS6MAC
HMDM3B557TO5RYP2IGFFC2C2VN6HYZTDQ47CJY2O37BW55DSMFZAC
2XQD6KKKD6QVHFHAEMVE3XXY7X2T7BLTLL7XIILZAXNJJH2YONUQC
BROSTG5KP3NUNLSYPVQID254TE47E5RKQAKLPIY7PGWETE6JNMTAC
2J37EVJMX255K3XEJHTZGRPEIRMAQ62JQWOA7JU3YTZUB6PUPWVQC
XTBSG4C7SCZUFOU2BTNFR6B6TCGYI35BWUV4PVTS3N7KNH5VEARQC
GCVQD44VRPQVKPZEPIC4AOIXLJIG2ZMV3QI2Y7KALUT6NVUBSGSAC
I2KHGVD44KT4MQJXGCTVSQKMBO6TVCY72F26TLXGWRL6PHGF6RNQC
ADMKQQGCGVSHHIMVQ4XFRDCG544SBJCYALSKZV45CQQBZ4ACUH2AC
case result of
Left err -> do
log ("ZAddr validation failed: " <> printError err)
pure ZAddrCheckInvalid
Right r
| r.status == StatusCode 200 -> do
pure ZAddrCheckValid
Right r -> do
log ("ZAddr was determined to be invalid: " <> r.statusText)
pure ZAddrCheckInvalid
pure
$ case result of
Left err -> ZAddrCheckInvalid
Right r
| r.status == StatusCode 200 -> ZAddrCheckValid
Right r -> ZAddrCheckInvalid
decodeDatedJson :: forall t. Traversable t => DecodeJson (t String) => Json -> ExceptT String Effect (t DateTime)
decodeDatedJson json = do
decoded <- except $ decodeJson json
decodeDatedJson :: forall t. Traversable t => Decode (t String) -> Json -> ExceptT String Effect (t DateTime)
decodeDatedJson decode json = do
decoded <- except $ decode json
parseProject :: ProjectId -> Object Json -> Either String (Project' String)
parseProject projectId pjson = do
projectName <- pjson .: "projectName"
inceptionDate <- pjson .: "inceptionDate"
initiator <- pjson .: "initiator"
depf <- pjson .: "depf"
pure $ Project' { projectId, projectName, inceptionDate, initiator, depf }
projectName <- project .: "projectName"
inceptionDate <- project .: "inceptionDate"
initiator <- project .: "initiator"
depf <- project .: "depf"
pure $ Project' { projectId, projectName, inceptionDate, initiator, depf }
parseProject projectId pjson
instance decodeJsonProjectDetail :: DecodeJson (ProjectDetail' String) where
decodeJson json = do
x <- decodeJson json
project <- x .: "project"
contributors <- x .: "contributors"
pure $ ProjectDetail' { project, contributors }
parseProjectDetail :: ProjectId -> Decode (ProjectDetail' String)
parseProjectDetail pid json = do
x <- decodeJson json
project <- parseProject pid =<< x .: "project"
(contribList :: Array (Contributor' String)) <- x .: "contributors"
let
contributors = M.fromFoldable $ map (\c@(Contributor' xs) -> Tuple xs.userId c) contribList
pure $ ProjectDetail' { project, contributors }
response <- get RF.json ("/api/user/projects/" <> pidStr pid <> "/detail")
let parsed :: ExceptT APIError Effect (Maybe (ProjectDetail' Instant))
parsed = parseDatedResponseMay response
EC.liftEffect
response <- get RF.json ("/api/projects/" <> pidStr pid <> "/detail")
let
parsed :: ExceptT APIError Effect (Maybe (ProjectDetail' Instant))
parsed = parseDatedResponseMay (parseProjectDetail pid) response
EC.liftEffect
exports.recaptchaRenderInternal = siteKey => elemId => () => {
grecaptcha.render(
document.getElementById(elemId),
{ 'sitekey': siteKey }
);
}
foreign import recaptchaRenderInternal :: String -> String -> Effect Unit
import Aftok.Api.Project
(Project, Project'(..), ProjectDetail, ProjectDetail'(..)
import Aftok.Api.Project
( Project
, Project'(..)
, ProjectDetail
, ProjectDetail'(..)
[ P.classes (ClassName <$> [ "container", "pt-6" ]) ]
[ HH.h1
[ P.classes (ClassName <$> [ "mb-0", "font-weight-bold", "text-center" ]) ]
[ HH.text "Project Overview" ]
, HH.p
[ P.classes (ClassName <$> [ "col-md-5", "text-muted", "text-center", "mx-auto" ]) ]
[ HH.text "Your project details" ]
, HH.div_
[ HH.slot
_projectList
unit
(ProjectList.component system pcaps)
st.selectedProject
(Just <<< (\(ProjectList.ProjectChange p) -> ProjectSelected p))
[ P.classes (ClassName <$> [ "container", "pt-6" ]) ]
[ HH.h1
[ P.classes (ClassName <$> [ "mb-0", "font-weight-bold", "text-center" ]) ]
[ HH.text "Project Overview" ]
, HH.p
[ P.classes (ClassName <$> [ "col-md-5", "text-muted", "text-center", "mx-auto" ]) ]
[ HH.text "Your project details" ]
, HH.div_
[ HH.slot
_projectList
unit
(ProjectList.component system pcaps)
st.selectedProject
(Just <<< (\(ProjectList.ProjectChange p) -> ProjectSelected p))
]
, HH.div
[ P.classes (ClassName <$> if isNothing st.selectedProject then [ "collapse" ] else []) ]
(U.fromMaybe $ projectDetail <$> st.projectDetail)
[ P.id_ "projectOverview", P.classes (ClassName <$> ["pt-3"]) ]
[ HH.div
-- header
[ P.classes (ClassName <$> ["row", "pt-3", "font-weight-bold" ]) ]
[ colmd2 (Just "Project Name")
, colmd2 (Just "Undepreciated Period")
, colmd2 (Just "Depreciation Duration")
, colmd2 (Just "Originator")
, colmd2 (Just "Origination Date")
[ P.id_ "projectOverview", P.classes (ClassName <$> [ "pt-3" ]) ]
[ HH.div
-- header
[ P.classes (ClassName <$> [ "row", "pt-3", "font-weight-bold" ]) ]
[ colmd2 (Just "Project Name")
, colmd2 (Just "Undepreciated Period")
, colmd2 (Just "Depreciation Duration")
, colmd2 (Just "Originator")
, colmd2 (Just "Origination Date")
]
, HH.div
[ P.classes (ClassName <$> [ "row", "pt-3" ]) ]
( [ colmd2 (Just project.projectName) ]
<> depreciationCols project.depf
<> [ colmd2 ((\(Contributor' p) -> p.handle) <$> M.lookup project.initiator detail.contributors)
, colmd2 (Just $ dateStr (date project.inceptionDate))
]
)
, HH.div
[ P.classes (ClassName <$> ["row", "pt-3"]) ]
([ colmd2 (Just project.projectName) ] <>
depreciationCols project.depf <>
[ colmd2 ((\(Contributor' p) -> p.handle) <$> M.lookup project.initiator detail.contributors)
, colmd2 (Just $ dateStr (date project.inceptionDate))
])
]
[ P.id_ "contributors" ]
([ HH.div
-- header
[ P.classes (ClassName <$> ["row", "pt-3", "font-weight-bold" ]) ]
[ colmd2 (Just "Contributor")
, colmd2 (Just "Joined")
, colmd2 (Just "Contributed Hours")
, colmd2 (Just "Current Revenue Share")
]
] <>
(contributorCols <$> (L.toUnfoldable $ M.values detail.contributors))
)
[ P.id_ "contributors" ]
( [ HH.div
-- header
[ P.classes (ClassName <$> [ "row", "pt-3", "font-weight-bold" ]) ]
[ colmd2 (Just "Contributor")
, colmd2 (Just "Joined")
, colmd2 (Just "Contributed Hours")
, colmd2 (Just "Current Revenue Share")
]
]
<> (contributorCols <$> (L.toUnfoldable $ M.values detail.contributors))
)
contributorCols (Contributor' pud) =
let pct = maybe "N/A" (\f -> F.toString (f * F.fromInt 100)) (F.fromNumber (R.toNumber pud.revShare) :: Maybe (F.Fixed F.P10000))
in HH.div
[ P.classes (ClassName <$> ["row", "pt-3", "pb-2" ]) ]
[ colmd2 (Just pud.handle)
, colmd2 (Just $ dateStr (date pud.joinedOn))
, colmd2 (Just $ show (unwrap pud.timeDevoted))
, colmd2 (Just $ pct <> "%")
]
contributorCols (Contributor' pud) =
let
shareFrac = R.numerator pud.revShare `div` R.denominator pud.revShare
pct = maybe "N/A" (\f -> F.toString (f * F.fromInt 100)) (F.fromNumber shareFrac :: Maybe (F.Fixed F.P10000))
in
HH.div
[ P.classes (ClassName <$> [ "row", "pt-3", "pb-2" ]) ]
[ colmd2 (Just pud.handle)
, colmd2 (Just $ dateStr (date pud.joinedOn))
, colmd2 (Just $ show (unwrap pud.timeDevoted))
, colmd2 (Just $ pct <> "%")
]
-- </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>
-- </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>
detail <- lift $ caps.getProjectDetail pid
case detail of
Left err -> lift $ system.error (show err)
Right d -> H.modify_ (_ { projectDetail = d })
detail <- lift $ caps.getProjectDetail pid
case detail of
Left err -> lift $ system.error (show err)
Right d -> H.modify_ (_ { projectDetail = d })
{ getProjectDetail: \pid -> do
t <- liftEffect nowDateTime
uid <- UserId <$> liftEffect genUUID
pure <<< Right <<< Just $ ProjectDetail'
{ project: Project'
{ projectId: pid
, projectName: "Fake Project"
, inceptionDate: t
, initiator: uid
, depf: LinearDepreciation { undep: Days 30.0, dep: Days 300.0 }
}
, contributors: M.singleton uid $ Contributor'
{ userId: uid
, handle: "Joe"
, joinedOn: t
, timeDevoted: Hours 100.0
, revShare: 55 R.% 100
}
}
{ getProjectDetail:
\pid -> do
t <- liftEffect nowDateTime
uid <- UserId <$> liftEffect genUUID
pure <<< Right <<< Just
$ ProjectDetail'
{ project:
Project'
{ projectId: pid
, projectName: "Fake Project"
, inceptionDate: t
, initiator: uid
, depf: LinearDepreciation { undep: Days 30.0, dep: Days 300.0 }
}
, contributors:
M.singleton uid
$ Contributor'
{ userId: uid
, handle: "Joe"
, joinedOn: t
, timeDevoted: Hours 100.0
, revShare: 55.0 R.% 100.0
}
}
[ HH.label [ P.for "username" ] [ HH.text "Username" ]
, HH.input
[ P.type_ P.InputText
, P.classes (ClassName <$> [ "form-control" ])
, P.id_ "username"
, P.placeholder "Choose a handle (username)"
, P.required true
, P.autofocus true
, P.value (fromMaybe "" st.username)
, E.onValueInput (Just <<< SetUsername)
]
]
$ [ HH.label [ P.for "username" ] [ HH.text "Username" ]
, HH.input
[ P.type_ P.InputText
, P.classes (ClassName <$> [ "form-control" ])
, P.id_ "username"
, P.placeholder "Choose a handle (username)"
, P.required true
, P.autofocus true
, P.value (fromMaybe "" st.username)
, E.onValueInput (Just <<< SetUsername)
]
]
<> signupErrors UsernameField st
[ HH.label [ P.for "password" ] [ HH.text "Password" ]
, HH.input
[ P.type_ P.InputPassword
, P.classes (ClassName <$> [ "form-control" ])
, P.id_ "password"
, P.placeholder "Enter a unique password"
, P.required true
, P.value (fromMaybe "" st.password)
, E.onValueInput (Just <<< SetPassword)
]
, HH.input
[ P.type_ P.InputPassword
, P.classes (ClassName <$> [ "form-control" ])
, P.id_ "passwordConfirm"
, P.placeholder "Enter a unique password"
, P.required true
, P.value (fromMaybe "" st.passwordConfirm)
, E.onValueInput (Just <<< ConfirmPassword)
]
]
$ [ HH.label [ P.for "password" ] [ HH.text "Password" ]
, HH.input
[ P.type_ P.InputPassword
, P.classes (ClassName <$> [ "form-control" ])
, P.id_ "password"
, P.placeholder "Enter a unique password"
, P.required true
, P.value (fromMaybe "" st.password)
, E.onValueInput (Just <<< SetPassword)
]
]
<> signupErrors PasswordField st
<> [ HH.input
[ P.type_ P.InputPassword
, P.classes (ClassName <$> [ "form-control" ])
, P.id_ "passwordConfirm"
, P.placeholder "Enter a unique password"
, P.required true
, P.value (fromMaybe "" st.passwordConfirm)
, E.onValueInput (Just <<< ConfirmPassword)
]
]
<> signupErrors ConfirmField st
Acc.UsernameCheckOK -> pure unit
Acc.UsernameCheckTaken -> H.modify_ (_ { signupErrors = [ UsernameTaken ] })
Acc.UsernameCheckOK -> H.modify_ (\st -> st { signupErrors = M.delete UsernameField st.signupErrors })
Acc.UsernameCheckTaken -> H.modify_ (\st -> st { signupErrors = M.insert UsernameField UsernameTaken st.signupErrors })
when (any (notEq pass) confirm) (H.modify_ (_ { signupErrors = [ PasswordMismatch ] }))
if (any (notEq pass) confirm) then
(H.modify_ (\st -> st { signupErrors = M.insert ConfirmField PasswordMismatch st.signupErrors }))
else
(H.modify_ (\st -> st { signupErrors = M.delete ConfirmField st.signupErrors }))
password <- H.gets (_.password)
when (any (notEq confirm) password) (H.modify_ (_ { signupErrors = [ PasswordMismatch ] }))
pass <- H.gets (_.password)
if (any (notEq confirm) pass) then
(H.modify_ (\st -> st { signupErrors = M.insert ConfirmField PasswordMismatch st.signupErrors }))
else
(H.modify_ (\st -> st { signupErrors = M.delete ConfirmField st.signupErrors }))
SetRecoveryZAddr addr -> do
lift $ system.log "Switching to signin..."
zres <- lift $ caps.checkZAddr addr
H.modify_ (_ { recoveryZAddr = Just addr })
case zres of
Acc.ZAddrCheckValid -> pure unit
Acc.ZAddrCheckInvalid -> H.modify_ (_ { signupErrors = [ ZAddrInvalid ] })
Signin ev -> do
lift $ system.log "Switching to signin..."
lift $ system.preventDefault (ME.toEvent ev)
H.raise SigninNav
SetRecoveryZAddr addr ->
--lift $ system.log "Switching to signin..."
when (addr /= "")
$ do
zres <- lift $ caps.checkZAddr addr
H.modify_ (_ { recoveryZAddr = Just addr })
case zres of
Acc.ZAddrCheckValid -> H.modify_ (\st -> st { signupErrors = M.delete ZAddrField st.signupErrors })
Acc.ZAddrCheckInvalid -> H.modify_ (\st -> st { signupErrors = M.insert ZAddrField ZAddrInvalid st.signupErrors })
Acc.CaptchaInvalid -> H.modify_ (_ { signupErrors = [ CaptchaError ] })
Acc.ZAddrInvalid -> H.modify_ (_ { signupErrors = [ ZAddrInvalid ] })
Acc.UsernameTaken -> H.modify_ (_ { signupErrors = [ UsernameTaken ] })
Acc.ServiceError c m -> H.modify_ (_ { signupErrors = [ APIError { status: c, message: m } ] })
Acc.CaptchaInvalid -> H.modify_ (_ { signupErrors = M.singleton CaptchaField CaptchaError })
Acc.ZAddrInvalid -> H.modify_ (_ { signupErrors = M.singleton ZAddrField ZAddrInvalid })
Acc.UsernameTaken -> H.modify_ (_ { signupErrors = M.singleton UsernameField UsernameTaken })
Acc.ServiceError c m -> H.modify_ (_ { signupErrors = M.singleton ErrField (APIError { status: c, message: m }) })
errField :: SignupError -> SignupField
errField = case _ of
UsernameRequired -> UsernameField
UsernameTaken -> UsernameField
PasswordRequired -> PasswordField
ConfirmRequired -> ConfirmField
PasswordMismatch -> ConfirmField
EmailRequired -> EmailField
ZAddrRequired -> ZAddrField
ZAddrInvalid -> ZAddrField
CaptchaError -> CaptchaField
APIError _ -> ErrField
signupErrors :: forall i a. SignupField -> SignupState -> Array (HH.HTML i a)
signupErrors field st = case M.lookup field st.signupErrors of
(Just UsernameRequired) -> err "Username is required"
(Just UsernameTaken) -> err "Username is already taken"
(Just PasswordRequired) -> err "Password is required"
(Just ConfirmRequired) -> err "Confirm your password"
(Just PasswordMismatch) -> err "Passwords do not match"
(Just EmailRequired) -> err "Email address is required"
(Just ZAddrRequired) -> err "Zcash address is required"
(Just ZAddrInvalid) -> err "Not a valid Zcash address"
(Just CaptchaError) -> err "Captcha failed; please try again"
_ -> []
where
err str = [ HH.div_ [ HH.span [ P.classes (ClassName <$> [ "badge", "badge-danger-soft" ]) ] [ HH.text str ] ] ]
[ 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)
]
]
$ [ 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
[ 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)
]
]
$ [ 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
[ HH.slot
_projectList
unit
(ProjectList.component system pcaps)
st.selectedProject
(Just <<< (\(ProjectList.ProjectChange p) -> ProjectSelected p))
[ HH.slot
_projectList
unit
(ProjectList.component system pcaps)
st.selectedProject
(Just <<< (\(ProjectList.ProjectChange p) -> ProjectSelected p))
pure $ case result of
Acc.LoginForbidden -> VLogin
Acc.LoginError _ -> VLogin
_ -> case other of
"timeline" -> VTimeline
_ -> VOverview
pure
$ case result of
Acc.LoginForbidden -> VLogin
Acc.LoginError _ -> VLogin
_ -> case other of
"timeline" -> VTimeline
_ -> VOverview
import Aftok.TimeLog (
WorkIndex,
LogEntry(LogEntry),
LogEvent(..),
EventId(..),
EventAmendment(..),
AmendmentId(..),
eventMeta,
_ModTime,
_EventId,
_AmendmentId,
creditTo,
eventTime,
event,
workIndex,
eventName,
nameEvent,
import Aftok.TimeLog
( AmendmentId (..),
EventAmendment (..),
EventId (..),
LogEntry (LogEntry),
LogEvent (..),
WorkIndex,
_AmendmentId,
_EventId,
_ModTime,
creditTo,
event,
eventMeta,
eventName,
eventTime,
nameEvent,
workIndex,
findUserProjectDetail :: UserId -> ProjectId -> DBM (Maybe (User, C.UTCTime))
findUserProjectDetail (UserId uid) (ProjectId pid) = do
headMay
<$> pquery
((,) <$> userParser <*> utcParser)
[sql| SELECT u.handle, u.recovery_email, u.recovery_zaddr, p.joined_at
FROM users u
JOIN project_companions p on p.user_id = u.id
WHERE u.id = ? AND p.project_id = ? |]
(uid, pid)
let scaled frac = note AmountInvalid $ cscale amt frac
payoutFractions <- except $ traverse scaled (payouts ^. TL._Payouts)
fromListWith (<>) . join <$> traverse (uncurry (getPayoutAmounts t currency mp)) (assocs payoutFractions)
let scaled ws = note AmountInvalid $ cscale amt (ws ^. TL.wsShare)
payoutFractions <- except $ traverse scaled (payouts ^. TL.creditToShares)
fromListWith (<>) . join
<$> traverse (uncurry (getPayoutAmounts t currency mp)) (assocs payoutFractions)
LogEvent (..),
_StartWork,
_StopWork,
eventName,
nameEvent,
eventTime,
WorkIndex (WorkIndex),
_WorkIndex,
workIndex,
DepF,
toDepF,
EventId (EventId),
_EventId,
ModTime (ModTime),
_ModTime,
EventAmendment (..),
AmendmentId (AmendmentId),
_AmendmentId,
Payouts (..),
_Payouts,
FractionalPayouts,
payouts,
linearDepreciation,
import Control.Lens
import Data.AdditiveGroup ()
( CreditTo (..),
DepreciationFunction (..),
_CreditToAccount,
_CreditToProject,
_CreditToUser,
)
import Control.Lens ((.~), (^.), makeClassy, makeLenses, makePrisms, view)
-- - produce the total, depreciated length of work to be credited to an address.
workCredit :: (Foldable f, HasLogEntry le) => DepF -> C.UTCTime -> f (Interval le) -> NDT
workCredit df ptime ivals = getSum $ F.foldMap (Sum . df ptime . fmap (view $ event . eventTime)) ivals
-- - produce the total length and depreciated length of work to be credited to an recipient.
workCredit :: (Foldable f, HasLogEntry le) => DepF -> C.UTCTime -> f (Interval le) -> (NDT, NDT)
workCredit depf ptime ivals =
bimap getSum getSum $ F.foldMap ((Sum . ilen &&& Sum . depf ptime) . fmap (view $ event . eventTime)) ivals
-- | The number of initial months during which no depreciation occurs
Months ->
-- | The number of months over which each logged interval will be depreciated
Months ->
-- | The number of initial days during which no depreciation occurs
C.Days ->
-- | The number of days over which each logged interval will be depreciated
C.Days ->
data Contributor
= Contributor
{ _userId :: UserId,
_handle :: UserName,
_joinedOn :: C.UTCTime,
_timeDevoted :: Hours,
_revenueShare :: Rational
}
makeLenses ''Contributor
data ProjectDetail
= ProjectDetail
{ _pdProject :: Project,
_pdContributors :: M.Map UserId Contributor
}
makeLenses ''ProjectDetail
contributorJSON :: (UserId, UserName, C.UTCTime) -> Value
contributorJSON (uid, uname, t) =
object
[ "user_id" .= idValue _UserId uid,
"username" .= (uname ^. _UserName),
"joined_at" .= t
]
projectDetailGetHandler :: S.Handler App App ProjectDetail
projectDetailGetHandler = do
uid <- requireUserId
pid <- requireProjectId
project <-
fromMaybeT
(snapError 404 $ "Project not found for id " <> show pid)
(mapMaybeT snapEval $ findUserProject uid pid)
widx <- snapEval $ readWorkIndex pid uid
ptime <- liftIO $ C.getCurrentTime
let p = payouts (toDepF $ project ^. depf) ptime widx
toContributorRecord = \case
(CreditToUser uid', ws) -> do
(user, joinedOn') <-
fromMaybeT
(snapError 500 $ "No user record found for logged-in user.")
(mapMaybeT snapEval $ findUserProjectDetail uid pid)
pure . Just . (uid',) $
Contributor
{ _userId = uid',
_handle = user ^. username,
_joinedOn = joinedOn',
_timeDevoted = Hours . (`div` 360) . round . C.toSeconds' $ ws ^. wsLogged,
_revenueShare = ws ^. wsShare
}
_ -> pure Nothing
contributorRecords <-
fmap (M.fromList . catMaybes)
. traverse toContributorRecord
$ M.assocs (p ^. creditToShares)
pure $
ProjectDetail
{ _pdProject = project,
_pdContributors = contributorRecords
}
snapEval $ listProjectContributors pid uid
project <-
fromMaybeT
(snapError 400 $ "Project not found for id " <> show pid)
(mapMaybeT snapEval $ findUserProject uid pid)
widx <- snapEval $ readWorkIndex pid uid
ptime <- liftIO $ C.getCurrentTime
pure $ payouts (toDepF $ project ^. depf) ptime widx
v1 $
obj
[ "projectName" .= (p ^. projectName),
"inceptionDate" .= (p ^. inceptionDate),
"initiator" .= (p ^. initiator . _UserId)
]
obj
[ "projectName" .= (p ^. projectName),
"inceptionDate" .= (p ^. inceptionDate),
"initiator" .= (p ^. initiator . _UserId),
"depf" .= depfToJSON (p ^. depf)
]
qdbProjectJSON = identifiedJSON "project" (_1 . _ProjectId) (_2 . to projectJSON)
qdbProjectJSON = identifiedJSON "project" (_1 . _ProjectId) (_2 . to (v1 . projectJSON))
contributorJSON :: Contributor -> Value
contributorJSON c =
object
[ "userId" .= idValue _UserId (c ^. userId),
"username" .= (c ^. handle . _UserName),
"joinedOn" .= (c ^. joinedOn),
"timeDevoted" .= (c ^. timeDevoted . (to fromEnum)),
"revenureShare"
.= object
[ "numerator" .= (c ^. revenueShare . (to numerator)),
"denominator" .= (c ^. revenueShare . (to denominator))
]
]
projectDetailJSON :: ProjectDetail -> A.Object
projectDetailJSON detail =
obj
[ "project" .= Object (projectJSON $ detail ^. pdProject),
"contributors" .= (M.elems $ fmap contributorJSON (detail ^. pdContributors))
]
payoutsJSON :: WorkShares -> A.Object
payoutsJSON ws =
let payoutsRec :: (CreditTo, WorkShare Rational) -> Value
payoutsRec (c, r) =
object
[ "creditTo" .= creditToJSON c,
"payoutRatio" .= (r ^. wsShare),
"payoutPercentage" .= (fromRational @Double (r ^. wsShare) * 100)
]
in obj $ ["payouts" .= fmap payoutsRec (M.assocs (ws ^. creditToShares))]
checkUsernameHandler :: S.Handler App App ()
checkUsernameHandler = do
params <- S.getParams
uname <-
maybe
(snapError 400 "username parameter is required")
(either (const $ snapError 400 "username must be valid UTF-8") (pure . UserName) . decodeUtf8')
(listToMaybe =<< M.lookup "username" params)
found <- snapEval (runMaybeT $ findUserByName uname)
case found of
Nothing -> pure ()
Just _ -> snapError 400 "username is already taken"
payoutsHandler :: S.Handler App App FractionalPayouts
payoutsHandler = do
uid <- requireUserId
pid <- requireProjectId
project <-
fromMaybeT
(snapError 400 $ "Project not found for id " <> show pid)
(mapMaybeT snapEval $ findUserProject uid pid)
widx <- snapEval $ readWorkIndex pid uid
ptime <- liftIO $ C.getCurrentTime
pure $ payouts (toDepF $ project ^. depf) ptime widx
payoutsJSON :: FractionalPayouts -> Value
payoutsJSON (Payouts m) =
v1 $
let payoutsRec :: (CreditTo, Rational) -> Value
payoutsRec (c, r) =
object ["creditTo" .= creditToJSON c,
"payoutRatio" .= r,
"payoutPercentage" .= (fromRational @Double r * 100)]
in obj $ ["payouts" .= fmap payoutsRec (MS.assocs m)]