Add captcha check to register route.

[?]

Sep 14, 2020, 3:05 AM

U256ZALIPTVWLNACYPIMWLNEYDQWP7CHF4Y4CGMILQTONJHMGQVQC

Dependencies

[2] O2BZOX7M Add signup form, captcha check.
[3] GMYPBCWE Make docker-compose work.
[4] SEWTRB6S Implement payment request creation functions.
[5] 7KZP4RHZ Switch from Data.Time to Data.Thyme
[6] J6S23MDG Use server timestamps for interval start and end.
[7] NTPC7KJE Trivial changes, feature scratchpad.
[8] 6L5BK5EH Use generic SMTP rather than Sendmail-specific mail client.
[9] EFSXYZPO Autoformat everything with brittany.
[10] NEDDHXUK Reformat via stylish-haskell
[11] Y35QCWYW Minor improvement in WorkIndex type to eliminate duplicated information.
[12] 5XFJNUAZ Start of addition of project infrastructure.
[13] TNR3TEHK Switch to Postgres + snaplet arch compiles.
[14] 7DBNV3GV Initial, stack-based impl of time log event reduction.
[15] LD4GLVSF More database stuff.
[16] 4U7F3CPI THE GREAT RENAMING OF THINGS!
[17] 2XQD6KKK Add invitation logic and clean up DBProg error handling.
[18] RN7EI6IN Update database layer to use CreditTo
[19] 4FDQGIXN Make payment request retrieval key an opaque 32-bit hash.
[20] LTSVBVA2 Update to a recent haskoin-core. Fix Stack build.
[21] GCVQD44V Create amends endpoint, switch to UUID primary keys
[22] HMDM3B55 Implement core of payments/billing infrastructure.
[23] KEP5WUFJ Convert project to stack-based build.
[24] BROSTG5K Beginning of modularization of server.
[25] MB5SHULB Add route for accepting an invitation with an existing account
[26] ASF3UPJL Add auction creation and bid handlers
[27] Q5X5RYQL stylish-haskell reformatting
[28] NJNMO72S Add zcash.com submodule and update client to modern halogen.
[29] B6HWAPDP Modularize & update to recent haskoin.
[30] QMRKFEPG Refactor QDB to use a free monad algebra instead.
[31] IPG33FAW Add billing daemon
[32] BXGLKYRX Added primitive user registration handler.
[33] IZEVQF62 Work in progress replacing sqlite with postgres.
[34] 4R7XIYK3 Switch from ClassyPrelude to Relude
[35] AWWC6P5Z Add migration to include payment network with addresses.
[36] RFYEVKZQ Add nix-shell based build environment.
[37] 64C6AWH6 Rename Ananke -> Quixotic, project reboot.
[38] WFZDMVUX Rename ADB -> QDB
[39] O722AOKE Add route to allow crediting of events to users/projects.
[40] 73NDXDEZ Begin implementation of billing event persistence.
[41] SLL7262C Make depreciation functions more flexible.
[42] UWMGUJOW Autoformat sources.
[43] PBD7LZYQ Postgres & auth are beginning to function.
[44] 4QX5E5AC Initial compilation of payouts function succeeds.
[45] HALRDT2F Added initial auction create route.
[46] TLQ72DSJ Lenses, sqlite-simple
[47] PT4276XC Add logout functionality.
[48] I2KHGVD4 Require project permissions for access to most data.
[49] DFOBMSAO Initial work on payments API
[50] JFOEOFGA stylish-haskell formatting.
[*] NVOCQVAS Initial failing tests.
[*] 2WOOGXDH Use dbmigrations to manage database state.
[*] V2VDN77H Enable postgres configuration via environment variable for Heroku.
[*] MJ6R42RC Utility methods for reading key & cert data.
[*] ADMKQQGC Initial empty Snap project.

Change contents

replacement in DEVELOPMENT.md at line 51

[3.1543]→[3.1543:1630](∅→∅)

Once all the containers are up, you'll need to run the database migrations
as follows:

[3.1543]

[3.1630]

Database Configuration
----------------------

All database DDL state is handled using the Haskell dbmigrations tool.

Once all the containers are up, you'll need to run the existing database
migrations as follows:
edit in DEVELOPMENT.md at line 63

[3.1759]

New migrations can be created with:

~~~bash
moo-postgresql new --config-file ./local/conf/server/aftok-migrations.cfg kebab-case-descriptive-name
~~~
edit in aftok.cabal at line 35

[3.237]

[3.238]

Aftok.Currency.ZCash
edit in aftok.cabal at line 159

[3.14]

[3.1]

, from-sum
replacement in client/src/Aftok/Api/Account.purs at line 107

[2.2985]→[2.2985:3001](∅→∅)

pure SignupOK

[2.2985]

[2.3001]

let signupJSON =
{ username: req.username
, password: req.password
, recoveryType: case req.recoverBy of
RecoverByEmail _ => "email"
RecoverByZAddr _ => "zaddr"
, email: case req.recoverBy of
RecoverByEmail email -> Just email
RecoverByZAddr _ -> Nothing
, zaddr: case req.recoverBy of
RecoverByEmail _ -> Nothing
RecoverByZAddr zaddr -> Just zaddr
}
file addition: ZCash.hs (----------)

[3.4250]

{-# LANGUAGE TemplateHaskell #-}

module Aftok.Currency.ZCash where

import Control.Lens ( makePrisms
)

newtype ZAddr = ZAddr { zaddrText :: Text }
deriving (Eq, Ord, Show)
makePrisms ''ZAddr
edit in lib/Aftok/Database/PostgreSQL.hs at line 44

[3.6775]

[3.1614]

import Aftok.Currency.ZCash (ZAddr(..), _ZAddr)
edit in lib/Aftok/Database/PostgreSQL.hs at line 79

[3.7285]→[3.7285:7309](∅→∅),[3.7309]→[3.15657:15670](∅→∅)

null :: RowParser Null
null = field
replacement in lib/Aftok/Database/PostgreSQL.hs at line 95

[3.7631]→[3.7631:7718](∅→∅)

addressParser :: NetworkMode -> RowParser (NetworkId, Address)
addressParser mode = do

[3.7631]

[3.7718]

btcAddressParser :: NetworkMode -> RowParser (NetworkId, Address)
btcAddressParser mode = do
replacement in lib/Aftok/Database/PostgreSQL.hs at line 154

[3.1421]→[3.1421:1495](∅→∅)

CreditToCurrency <$> (addressParser mode <* nullField <* nullField)

[3.1421]

[3.1495]

CreditToCurrency <$> (btcAddressParser mode <* nullField <* nullField)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 188

[3.2829]→[3.9208:9273](∅→∅)

userParser :: NetworkMode -> RowParser BTCUser
userParser mode =

[3.2829]

[3.17521]

userParser :: RowParser User
userParser =
replacement in lib/Aftok/Database/PostgreSQL.hs at line 192

[3.17557]→[3.17557:17659](∅→∅)

<*> ((null *> null *> pure Nothing) <|> fmap Just (addressParser mode))
<*> (Email <$> field)

[3.17557]

[3.3061]

<*> (
(maybe empty pure =<< fmap (RecoverByEmail . Email) <$> field)
<|>
(maybe empty pure =<< fmap (RecoverByZAddr . ZAddr) <$> field)
)
edit in lib/Aftok/Database/PostgreSQL.hs at line 526

[3.13814]→[3.13814:14019](∅→∅),[3.14019]→[3.58432:58467](∅→∅)

mode <- askNetworkMode
let nidMay = fst <$> _userAddress user'
addrMay :: Maybe Text
addrMay = do
network <- toNetwork mode <$> nidMay
address <- snd <$> _userAddress user'
addrToText network address
replacement in lib/Aftok/Database/PostgreSQL.hs at line 528

[3.22347]→[3.1233:1324](∅→∅)

[sql| INSERT INTO users (handle, default_payment_network, default_payment_addr, email)

[3.22347]

[3.14139]

[sql| INSERT INTO users (handle, recovery_email, recovery_zaddr)
replacement in lib/Aftok/Database/PostgreSQL.hs at line 531

[3.22386]→[3.14186:14219](∅→∅),[3.9464]→[3.14186:14219](∅→∅),[3.14219]→[3.9464:9478](∅→∅),[3.9464]→[3.9464:9478](∅→∅),[3.9478]→[3.22387:22421](∅→∅)

, renderNetworkId <$> nidMay
, addrMay
, user' ^. userEmail . _Email

[3.22386]

[3.9510]

, user' ^? userAccountRecovery . _RecoverByEmail . _Email
, user' ^? userAccountRecovery . _RecoverByZAddr . _ZAddr
edit in lib/Aftok/Database/PostgreSQL.hs at line 536

[3.14256]→[3.14256:14281](∅→∅)

mode <- askNetworkMode
replacement in lib/Aftok/Database/PostgreSQL.hs at line 537

[3.22443]→[3.22443:22465](∅→∅),[3.22465]→[3.1325:1430](∅→∅)

(userParser mode)
[sql| SELECT handle, default_payment_network, default_payment_addr, email FROM users WHERE id = ? |]

[3.22443]

[3.9648]

userParser
[sql| SELECT handle, recovery_email, recovery_zaddr FROM users WHERE id = ? |]
edit in lib/Aftok/Database/PostgreSQL.hs at line 542

[3.14363]

[3.14363]

headMay <$> pquery
((,) <$> idParser UserId <*> userParser)
[sql| SELECT id, handle, recovery_email, recovery_zaddr FROM users WHERE handle = ? |]
(Only h)

pgEval (FindUserPaymentAddress (UserId uid)) = do
replacement in lib/Aftok/Database/PostgreSQL.hs at line 550

[3.22487]→[3.22487:22537](∅→∅),[3.22537]→[3.1431:1544](∅→∅),[3.1544]→[3.9812:9825](∅→∅),[3.18549]→[3.9812:9825](∅→∅),[3.9812]→[3.9812:9825](∅→∅)

((,) <$> idParser UserId <*> userParser mode)
[sql| SELECT id, handle, default_payment_network, default_payment_addr, email FROM users WHERE handle = ? |]
(Only h)

[3.22487]

[3.9825]

(btcAddressParser mode)
[sql| SELECT default_payment_network, default_payment_addr FROM users WHERE id = ? |]
(Only uid)
edit in lib/Aftok/Database.hs at line 39

[3.19137]→[3.19137:19164](∅→∅)

type BTCUser = User BTCNet
replacement in lib/Aftok/Database.hs at line 41

[3.6156]→[3.1798:1961](∅→∅)

CreateUser :: BTCUser -> DBOp UserId
FindUser :: UserId -> DBOp (Maybe BTCUser)
FindUserByName :: UserName -> DBOp (Maybe (UserId, BTCUser))

[3.6156]

[3.6305]

CreateUser :: User -> DBOp UserId
FindUser :: UserId -> DBOp (Maybe User)
FindUserByName :: UserName -> DBOp (Maybe (UserId, User))
FindUserPaymentAddress :: UserId -> DBOp (Maybe (BTCNet))
replacement in lib/Aftok/Database.hs at line 116

[3.7400]→[3.19691:19740](∅→∅)

createUser :: (MonadDB m) => BTCUser -> m UserId

[3.7400]

[3.7103]

createUser :: (MonadDB m) => User -> m UserId
replacement in lib/Aftok/Database.hs at line 119

[3.7466]→[3.19741:19795](∅→∅)

findUser :: (MonadDB m) => UserId -> MaybeT m BTCUser

[3.7466]

[3.24861]

findUser :: (MonadDB m) => UserId -> MaybeT m User
replacement in lib/Aftok/Database.hs at line 122

[3.5045]→[3.19796:19868](∅→∅)

findUserByName :: (MonadDB m) => UserName -> MaybeT m (UserId, BTCUser)

[3.5045]

[3.24969]

findUserByName :: (MonadDB m) => UserName -> MaybeT m (UserId, User)
edit in lib/Aftok/Database.hs at line 124

[3.25019]

[3.7626]

findUserPaymentAddress :: (MonadDB m) => UserId -> MaybeT m (BTCNet)
findUserPaymentAddress = MaybeT . liftdb . FindUserPaymentAddress
replacement in lib/Aftok/Payments/Types.hs at line 75

[3.3782]→[3.41048:41145](∅→∅)

-- using error here is reasonable since it would indicate
-- a serialization problem

[3.3782]

[3.41145]

-- using error here is reasonable since it would indicate
-- a serialization problem
edit in lib/Aftok/Payments.hs at line 49

[3.6682]→[3.6682:6744](∅→∅)

, userAddress
replacement in lib/Aftok/Payments.hs at line 275

[3.30397]→[3.30397:30420](∅→∅),[3.30420]→[3.29098:29155](∅→∅)

user <- findUser uid
addr <- MaybeT . pure . fmap snd $ user ^. userAddress

[3.30397]

[3.29155]

(_, addr) <- findUserPaymentAddress uid
replacement in lib/Aftok/TimeLog.hs at line 160

[3.1582]→[3.12413:12496](∅→∅)

workIndex
:: forall a f . (Ord a, Foldable f) => f (LogEntry a) -> (WorkIndex a)

[3.1582]

[3.4957]

workIndex :: forall a f . (Ord a, Foldable f) => f (LogEntry a) -> (WorkIndex a)
edit in lib/Aftok/Types.hs at line 9

[3.42864]→[3.42864:42922](∅→∅)

import Data.Maybe ( Maybe )
edit in lib/Aftok/Types.hs at line 16

[3.43324]

[3.32939]

import Aftok.Currency.ZCash ( ZAddr )
replacement in lib/Aftok/Types.hs at line 28

[3.33159]→[3.33159:33266](∅→∅)

data User a = User
{ _username :: !UserName
, _userAddress :: !(Maybe a)
, _userEmail :: !Email

[3.33159]

[3.33266]

data AccountRecovery
= RecoverByEmail Email
| RecoverByZAddr ZAddr
makePrisms ''AccountRecovery

data User = User
{ _username :: !UserName
, _userAccountRecovery :: !AccountRecovery
file addition: 2020-09-14_23-27-54_users-account-recovery.txt (----------)

[53.1]

Description: (Describe migration here.)
Created: 2020-09-14 23:27:57.342707094 UTC
Depends: 2020-06-06_03-53-54_add-payment-networks
Apply: |
ALTER TABLE users RENAME COLUMN email TO recovery_email;
ALTER TABLE users ALTER COLUMN recovery_email DROP NOT NULL;
ALTER TABLE users ADD COLUMN recovery_zaddr text;

Revert: |
ALTER TABLE users RENAME COLUMN recovery_email TO email;
ALTER TABLE users ALTER COLUMN email SET NOT NULL;
ALTER TABLE users DROP COLUMN recovery_zaddr;
edit in server/Aftok/QConfig.hs at line 25

[3.32643]

[55.216]

import Aftok.Snaplet.Users (CaptchaConfig(..))
replacement in server/Aftok/QConfig.hs at line 37

[3.4377]→[2.9583:9618](∅→∅)

, _recaptchaSecret :: Maybe Text

[3.4377]

[3.534]

, _recaptchaSecret :: CaptchaConfig
replacement in server/Aftok/QConfig.hs at line 66

[3.45251]→[2.9619:9658](∅→∅)

<*> C.lookup cfg "recaptchaSecret"

[3.45251]

[3.7968]

<*> (CaptchaConfig <$> C.require cfg "recaptchaSecret")
replacement in server/Aftok/Snaplet/Projects.hs at line 66

[3.9021]→[2.9661:9718](∅→∅)

uid <- requireUserId
pid <- requireProjectId

[3.9021]

[3.9070]

uid <- requireUserId
pid <- requireProjectId
replacement in server/Aftok/Snaplet/Projects.hs at line 69

[3.9145]→[2.9719:9756](∅→∅),[2.9756]→[3.54007:54038](∅→∅),[3.54007]→[3.54007:54038](∅→∅)

t <- liftIO C.getCurrentTime
(Just u, Just p, invCode) <-

[3.9145]

[3.54038]

t <- liftIO C.getCurrentTime
(Just p, invCode) <-
replacement in server/Aftok/Snaplet/Projects.hs at line 72

[3.54051]→[3.54051:54145](∅→∅)

$ (,,)
<$> (runMaybeT $ findUser uid)
<*> (runMaybeT $ findUserProject uid pid)

[3.54051]

[3.54145]

$ (,)
<$> (runMaybeT $ findUserProject uid pid)
replacement in server/Aftok/Snaplet/Projects.hs at line 77

[3.54279]→[3.54279:54330](∅→∅)

(u ^. userEmail)

[3.54279]

[3.54330]

(Email "noreply@aftok.com")
edit in server/Aftok/Snaplet/Users.hs at line 17

[3.8667]

[2.9857]

import Control.FromSum ( fromMaybeM )
replacement in server/Aftok/Snaplet/Users.hs at line 19

[2.9909]→[2.9909:9970](∅→∅)

import Data.Aeson ((.:), (.:?))

[2.9909]

[3.55500]

import Data.Aeson ( (.:)
, (.:?)
)
replacement in server/Aftok/Snaplet/Users.hs at line 27

[3.34767]→[3.14939:15002](∅→∅),[3.15002]→[2.10024:10127](∅→∅)

import Haskoin.Address ( textToAddr )
import Network.HTTP.Client ( parseRequest, responseBody, responseStatus, httpLbs)

[3.34767]

[2.10127]

import Network.HTTP.Client ( parseRequest
, responseBody
, responseStatus
, httpLbs
)
replacement in server/Aftok/Snaplet/Users.hs at line 33

[2.10193]→[2.10193:10271](∅→∅)

import Network.HTTP.Client.MultipartFormData (formDataBody, partBS)

[2.10193]

[2.10271]

import Network.HTTP.Client.MultipartFormData
( formDataBody
, partBS
)
replacement in server/Aftok/Snaplet/Users.hs at line 39

[3.10432]→[3.34824:34853](∅→∅),[3.34853]→[3.55723:55897](∅→∅)

import Aftok.Types
import Aftok.Currency.Bitcoin ( NetworkId(..)
, toNetwork
)

[3.10432]

[3.8814]

import Aftok.Currency.ZCash ( ZAddr(..) )
edit in server/Aftok/Snaplet/Users.hs at line 42

[3.4087]

[3.8846]

import Aftok.Types
replacement in server/Aftok/Snaplet/Users.hs at line 47

[3.3651]→[2.10335:10439](∅→∅)

import qualified Snap.Core as S
import qualified Snap.Snaplet as S

[3.3651]

[3.55950]

import qualified Snap.Core as S
import qualified Snap.Snaplet as S
replacement in server/Aftok/Snaplet/Users.hs at line 51

[3.269]→[3.12420:12436](∅→∅),[3.12436]→[3.34921:34955](∅→∅)

data CUser = CU
{ _cuser :: User Text

[3.269]

[3.9043]

data RegisterRequest = RegisterRequest
{ _cuser :: User
edit in server/Aftok/Snaplet/Users.hs at line 54

[3.9078]

[3.10433]

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

[3.349]→[3.12437:12456](∅→∅)

makeLenses ''CUser

[3.349]

[3.4305]

makeLenses ''RegisterRequest
replacement in server/Aftok/Snaplet/Users.hs at line 59

[3.4306]→[2.10440:10499](∅→∅),[2.10499]→[3.56004:56168](∅→∅),[3.9104]→[3.56004:56168](∅→∅)

instance A.FromJSON CUser where
parseJSON (A.Object v) =
let parseUser =
User
<$> (UserName <$> v .: "username")
<*> (v .: "btcAddr")
<*> (Email <$> v .: "email")

[3.4306]

[3.10651]

instance A.FromJSON RegisterRequest where
parseJSON (A.Object v) = do
recoveryType <- v .: "recoveryType"
recovery <- case (recoveryType :: Text) of
"email" -> RecoverByEmail . Email <$> v .: "email"
"zaddr" -> RecoverByZAddr . ZAddr <$> v .: "zaddr"
_ -> Prelude.empty
user <- User <$> (UserName <$> v .: "username")
<*> pure recovery
replacement in server/Aftok/Snaplet/Users.hs at line 69

[3.10652]→[3.9105:9234](∅→∅),[3.9234]→[3.10784:10820](∅→∅),[3.10784]→[3.10784:10820](∅→∅),[3.10820]→[3.56169:56251](∅→∅)

parseInvitationCodes c = either
(\e -> fail $ "Invitation code was rejected as invalid: " <> e)
pure
(traverse parseInvCode c)
in CU
<$> parseUser
<*> (fromString <$> v .: "password")

[3.10652]

[3.56251]

RegisterRequest user
<$> (fromString <$> v .: "password")
<*> (v .: "captchaToken")
edit in server/Aftok/Snaplet/Users.hs at line 74

[3.10821]

[3.634]

where
parseInvitationCodes c = either
(\e -> fail $ "Invitation code was rejected as invalid: " <> e)
pure
(traverse parseInvCode c)
replacement in server/Aftok/Snaplet/Users.hs at line 81

[3.4425]→[3.18267:18311](∅→∅),[3.11004]→[3.657:678](∅→∅),[3.18311]→[3.657:678](∅→∅),[3.4886]→[3.657:678](∅→∅),[3.678]→[2.10500:10534](∅→∅),[2.10534]→[3.11005:11064](∅→∅),[3.3592]→[3.11005:11064](∅→∅),[3.11064]→[3.56317:56389](∅→∅),[3.56389]→[2.10535:10556](∅→∅),[2.10556]→[3.56416:56451](∅→∅),[3.56416]→[3.56416:56451](∅→∅),[3.56451]→[3.35003:35029](∅→∅),[3.11096]→[3.35003:35029](∅→∅),[3.35029]→[3.56452:56465](∅→∅),[3.56465]→[3.59698:59777](∅→∅)

registerHandler :: S.Handler App App UserId
registerHandler = do
rbody <- S.readRequestBody 4096
-- allow any number of 'invitationCode' query parameters
userData <- maybe (snapError 400 "Could not parse user data") pure
$ A.decode rbody
t <- liftIO C.getCurrentTime
nmode <- getNetworkMode
let addr =
textToAddr (toNetwork nmode BTC) =<< (userData ^. cuser . userAddress)

[3.4425]

[3.56546]

registerHandler :: CaptchaConfig -> S.Handler App App UserId
registerHandler cfg = do
rbody <- S.readRequestBody 4096
userData <- fromMaybeM (snapError 400 "Could not parse user data") (A.decode rbody)
captchaResult <- liftIO $ checkCaptcha cfg (userData ^. captchaToken)
void . either (const . throwDenied $ AU.AuthError "Captcha check failed, please try again.") pure $ captchaResult

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

[3.56716]→[3.56716:56909](∅→∅)

userId <- createUser
((userData ^. cuser) & userAddress .~ ((BTC, ) <$> addr))
void $ traverse (acceptInvitation userId t) (userData ^. invitationCodes)
return userId

[3.56716]

[2.10557]

userId <- createUser (userData ^. cuser)
void $ traverse (acceptInvitation userId now) (userData ^. invitationCodes)
pure userId
replacement in server/Aftok/Snaplet/Users.hs at line 102

[3.56938]→[3.56938:56976](∅→∅)

t <- liftIO C.getCurrentTime

[3.56938]

[2.10596]

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

[3.57278]→[3.983:1051](∅→∅),[3.983]→[3.983:1051](∅→∅)

(\cx -> void . snapEval $ traverse (acceptInvitation uid t) cx)

[3.57278]

[3.1051]

(\cx -> void . snapEval $ traverse (acceptInvitation uid now) cx)
replacement in server/Aftok/Snaplet/Users.hs at line 136

[2.11167]→[2.11167:11771](∅→∅)

CaptchaResponse <$> v .: "success"
<*> (fmap toError . join . toList <$> v .:? "error-codes")
where
toError = \case
"missing-input-secret" -> MissingInputSecret
"invalid-input-secret" -> InvalidInputSecret
"missing-input-response" -> MissingInputResponse
"invalid-input-response" -> InvalidInputResponse
"bad-request" -> BadRequest
"timeout-or-duplicate" -> TimeoutOrDuplicate
other -> CaptchaError $ "Unexpected error code: " <> other
parseJSON _ =
fail "Captcha response body was not a valid JSON object."

[2.11167]

[3.9321]

CaptchaResponse
<$> v
.: "success"
<*> (fmap toError . join . toList <$> v .:? "error-codes")
where
toError = \case
"missing-input-secret" -> MissingInputSecret
"invalid-input-secret" -> InvalidInputSecret
"missing-input-response" -> MissingInputResponse
"invalid-input-response" -> InvalidInputResponse
"bad-request" -> BadRequest
"timeout-or-duplicate" -> TimeoutOrDuplicate
other -> CaptchaError $ "Unexpected error code: " <> other
parseJSON _ = fail "Captcha response body was not a valid JSON object."
replacement in server/Aftok/Snaplet/Users.hs at line 153

[2.11863]→[2.11863:12093](∅→∅)

request <- parseRequest "https://www.google.com/recaptcha/api/siteverify"
reqWithBody <- formDataBody [partBS "secret" (T.encodeUtf8 $ secretKey cfg), partBS "response" (T.encodeUtf8 token)] request
manager <- newTlsManager

[2.11863]

[2.12093]

request <- parseRequest "https://www.google.com/recaptcha/api/siteverify"
reqWithBody <- formDataBody
[ partBS "secret" (T.encodeUtf8 $ secretKey cfg)
, partBS "response" (T.encodeUtf8 token)
]
request
manager <- newTlsManager
replacement in server/Aftok/Snaplet/Users.hs at line 162

[2.12189]→[2.12189:12418](∅→∅)

200 ->
case A.eitherDecode (responseBody response) of
Left err -> Left [CaptchaError $ "Failed to decode JSON response: " <> T.pack err]
Right cr -> if success cr then Right () else Left (errorCodes cr)

[2.12189]

[2.12418]

200 -> case A.eitherDecode (responseBody response) of
Left err ->
Left [CaptchaError $ "Failed to decode JSON response: " <> T.pack err]
Right cr -> if success cr then Right () else Left (errorCodes cr)
replacement in server/Aftok/Snaplet/Users.hs at line 167

[2.12433]→[2.12433:12515](∅→∅)

Left $ [CaptchaError $ "Unexpected status code: " <> T.pack (show errCode)]

[2.12433]

Left
$ [CaptchaError $ "Unexpected status code: " <> T.pack (show errCode)]
replacement in server/Main.hs at line 67

[3.12971]→[2.12517:12576](∅→∅)

registerRoute = void $ method POST registerHandler

[3.12971]

[3.63100]

registerRoute = void $ method POST (registerHandler $ cfg ^. recaptchaSecret)