Update email invitation workflow.

[?]

Jan 9, 2021, 6:13 AM

UD5T5B7ACLIM7CPSRYGXSQ3EFNS6DTPABPXJE4HQCBI7JYLE5K3QC

Dependencies

[2] MU6WOCCJ Update auctions to permit zcash as a funding currency.
[3] HMDM3B55 Implement core of payments/billing infrastructure.
[4] M3KUPGZK Add invitation email template.
[5] NLZ3JXLO Fix formatting with stylish-haskell.
[6] U256ZALI Add captcha check to register route.
[7] 5IDB3IWS Integrate zcashd-based zaddr validation.
[8] NEDDHXUK Reformat via stylish-haskell
[9] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[10] ENNZIQJG Use live signup API for client.
[11] EFSXYZPO Autoformat everything with brittany.
[12] MB5SHULB Add route for accepting an invitation with an existing account
[13] X3ES7NUA Fine. I'll use ormolu. At least it doesn't break the code.
[14] O2BZOX7M Add signup form, captcha check.
[15] SQ7UMLN5 Get z-addr checks working.
[16] BROSTG5K Beginning of modularization of server.
[17] BXGLKYRX Added primitive user registration handler.
[18] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[19] Z7KS5XHH Very WIP. Wow.
[20] M4PWY5RU Preliminary work to add support for Zcash payments.
[21] F4ONFXF4 Fix signup database issues.
[*] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[*] JUFBTX45 Add project auction queries.

Change contents

edit in lib/Aftok/Database.hs at line 104

[3.7075]

[3.28769]

data InvitationError
= InvitationExpired
| InvitationAlreadyAccepted
| InvitationNotFound
deriving (Eq, Show)
replacement in lib/Aftok/Database.hs at line 114

[3.28877]→[3.28877:28929](∅→∅)

| InvitationExpired
| InvitationAlreadyAccepted

[3.28877]

[3.28929]

| InvitationError InvitationError
replacement in lib/Aftok/Database.hs at line 222

[3.5801]→[3.8053:8172](∅→∅)

findInvitation :: (MonadDB m) => InvitationCode -> m (Maybe Invitation)
findInvitation ic = liftdb $ FindInvitation ic

[3.5801]

[3.5906]

findCurrentInvitation :: (MonadDB m) => C.UTCTime -> InvitationCode -> m (Either InvitationError Invitation)
findCurrentInvitation t ic =
maybe (Left InvitationNotFound) checkInvitation <$> liftdb (FindInvitation ic)
where
checkInvitation i
| t .-. (i ^. invitationTime) > fromSeconds (60 * 60 * 72 :: Int) = Left InvitationExpired
| isJust (i ^. acceptanceTime) = Left InvitationAlreadyAccepted
| otherwise = Right i
replacement in lib/Aftok/Database.hs at line 233

[3.444]→[3.6009:6036](∅→∅),[3.6009]→[3.6009:6036](∅→∅)

inv <- findInvitation ic

[3.444]

[3.6036]

inv <- findCurrentInvitation t ic
replacement in lib/Aftok/Database.hs at line 236

[3.6088]→[3.28852:28892](∅→∅),[3.28892]→[3.29309:29556](∅→∅),[3.29556]→[3.28893:28968](∅→∅),[3.8393]→[3.28893:28968](∅→∅)

Nothing -> raiseSubjectNotFound act
Just i
| t .-. (i ^. invitationTime) > fromSeconds (60 * 60 * 72 :: Int) ->
raiseOpForbidden uid InvitationExpired act
Just i
| isJust (i ^. acceptanceTime) ->
raiseOpForbidden uid InvitationAlreadyAccepted act
Just i -> withProjectAuth (i ^. P.projectId) (i ^. P.invitingUser) act

[3.6088]

[3.1389]

Left InvitationNotFound -> raiseSubjectNotFound act
Left InvitationExpired -> raiseOpForbidden uid (InvitationError InvitationExpired) act
Left InvitationAlreadyAccepted -> raiseOpForbidden uid (InvitationError InvitationAlreadyAccepted) act
Right i -> withProjectAuth (i ^. P.projectId) (i ^. P.invitingUser) act
edit in migrations/2021-01-03_16-15-52_auction-descriptions.txt at line 8

[2.6903]

ALTER TABLE bids ADD COLUMN currency currency_t NOT NULL;
replacement in server/Aftok/Snaplet/Users.hs at line 18

[3.103472]→[3.66085:66138](∅→∅),[3.66085]→[3.66085:66138](∅→∅)

import Aftok.Database (acceptInvitation, createUser)

[3.103472]

[3.66138]

import Aftok.Database (acceptInvitation, createUser, findCurrentInvitation)
replacement in server/Aftok/Snaplet/Users.hs at line 39

[3.66562]→[3.66562:66615](∅→∅)

import Data.Text as T
import Data.Text.Encoding as T

[3.66562]

[3.66615]

import qualified Data.Text as T
import qualified Data.Text.Encoding as T
replacement in server/Aftok/Snaplet/Users.hs at line 76

[3.67423]→[3.67423:67454](∅→∅)

_captchaToken :: Text,

[3.67423]

[3.67454]

_captchaToken :: Maybe Text,
replacement in server/Aftok/Snaplet/Users.hs at line 94

[3.5708]→[3.5708:5740](∅→∅),[3.5740]→[3.193:269](∅→∅)

<*> (v .: "captchaToken")
<*> (parseInvitationCodes . maybeToList =<< v .:? "invitation_codes")

[3.5708]

[3.6020]

<*> (v .:? "captchaToken")
<*> (parseInvitationCodes . join . maybeToList =<< v .:? "invitation_codes")
replacement in server/Aftok/Snaplet/Users.hs at line 141

[3.5009]→[3.6412:6484](∅→∅),[3.6412]→[3.6412:6484](∅→∅),[3.6484]→[3.6270:6445](∅→∅)

captchaResult <- liftIO $ checkCaptcha cfg (userData ^. captchaToken)
case captchaResult of
Left err ->
let cmsg = "Captcha check failed, please try again."
in snapErrorJS 400 cmsg (RegCaptchaError err)
Right _ -> pure ()

[3.6412]

[3.6062]

now <- liftIO C.getCurrentTime
(_, invs) <- partitionEithers <$> snapEval (traverse (findCurrentInvitation now) (userData ^. invitationCodes))
if null invs
then checkCaptcha' (userData ^. captchaToken)
else pure () -- skip the captcha check with a valid invitation code
edit in server/Aftok/Snaplet/Users.hs at line 158

[3.6466]→[3.6466:6499](∅→∅)

now <- liftIO C.getCurrentTime
edit in server/Aftok/Snaplet/Users.hs at line 166

[3.9285]

[3.6676]

where
checkCaptcha' = \case
Just ct -> do
captchaResult <- liftIO $ checkCaptcha cfg ct
case captchaResult of
Left err ->
let cmsg = "Captcha check failed, please try again."
in snapErrorJS 400 cmsg (RegCaptchaError err)
Right _ -> pure ()
Nothing ->
let cmsg = "Captcha token or invitation code required."
in snapErrorJS 400 cmsg ()
replacement in server/templates/invitation_email.st at line 29

[3.1716]→[3.1716:1915](∅→∅)

curl -k -v -H 'Content-Type: application/json' -d '{"username":"USER", "password":"PASS", "email":"$to_email$", "btcAddr":"BTC_ADDR", "invitation_codes":["$inv_code$"]}' 'https://aftok.com/register'

[3.1716]

[3.2445]

curl --header 'Content-Type: application/json' \\
--data '{"username":"USER", "password":"PASS", "recoveryType": "email", "recoveryEmail":"$to_email$", "invitation_codes":["$inv_code$"]}' \\
'https://aftok.com/api/register'