nuttycom/aftok - Change O2BZOX7MS4JCDS3C6EJQXAWUEQV6HVDCIF2FIN2BCJNRLIU6ZVKAC

Add signup form, captcha check.

Created by Kris Nuttycombe on September 9, 2020

O2BZOX7MS4JCDS3C6EJQXAWUEQV6HVDCIF2FIN2BCJNRLIU6ZVKAC

Dependencies

In channels

main

Change contents

Insertion in aftok.cabal at line 164 [5.1]
[4.214]
[4.214]
```
    , http-client-tls
```
Insertion in aftok.cabal at line 166 [5.1]
[4.240]
[6.41]
```
    , http-types
```

Insertion in client/dev/index.html at line 8 [7.2486]

[3.155]

[7.2649]


    <script src="https://www.google.com/recaptcha/api.js" async defer></script>

Insertion in client/spago.dhall at line 12 [7.294942]
[8.389]
[8.389]
```
    , "validation"
```

File addition: Account.purs (----------)

[9.1]

module Aftok.Api.Account where
import Prelude
import Control.Monad.Trans.Class (lift)
import Data.Argonaut.Encode (encodeJson)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..))
import Effect.Aff (Aff)
import Effect.Class.Console (log)
import Affjax (post, get, printError)
import Affjax.StatusCode (StatusCode(..))
import Affjax.RequestBody as RB
import Affjax.ResponseFormat as RF
import Halogen as H
import Halogen.HTML.Core (ClassName(..))
import Halogen.HTML as HH
import Halogen.HTML.CSS as CSS
import Halogen.HTML.Events as E
import Web.Event.Event as WE
import Halogen.HTML.Properties as P
import CSS (backgroundImage, url)
import Landkit.Card as Card
import Aftok.Types (System)
type LoginRequest = { username :: String, password :: String }
data LoginResponse
  = LoginOK
  | LoginForbidden
  | LoginError { status :: Maybe StatusCode, message :: String }
-- | Post credentials to the login service and interpret the response
login :: String -> String -> Aff LoginResponse
login user pass = do
  log "Sending login request to /api/login ..."
  result <- post RF.ignore "/api/login" (Just <<< RB.Json <<< encodeJson $ { username: user, password : pass })
  case result of
       Left err -> log ("Login failed: " <> printError err)
       Right r  -> log ("Login status: " <> show r.status)
  pure $ case result of
    Left err -> LoginError { status: Nothing, message: printError err }
    Right r -> case r.status of
      StatusCode 403 -> LoginForbidden
      StatusCode 200 -> LoginOK
      other -> LoginError { status: Just other, message: r.statusText }
checkLogin :: Aff LoginResponse
checkLogin = do
  result <- get RF.ignore "/api/login/check"
  case result of
    Left err -> do
      pure $ LoginError { status: Nothing, message: printError err }
    Right r -> do
      pure $ case r.status of
        StatusCode 200 -> LoginOK
        StatusCode _   -> LoginForbidden
logout :: Aff Unit
logout = void $ get RF.ignore "/api/logout"
data RecoverBy
  = RecoverByEmail String
  | RecoverByZAddr String 
type SignupRequest =
  { username :: String
  , password :: String
  , recoverBy :: RecoverBy
  , captchaToken :: String
  }
signupRequest :: String -> String -> RecoverBy -> String -> SignupRequest
signupRequest username password recoverBy captchaToken = 
  { username, password, recoverBy, captchaToken }
data SignupResponse
  = SignupOK
  | CaptchaInvalid
  | ZAddrInvalid
  | UsernameTaken
data UsernameCheckResponse
  = UsernameCheckOK
  | UsernameCheckTaken
data ZAddrCheckResponse
  = ZAddrCheckOK
  | ZAddrCheckInvalid
checkUsername :: String -> Aff UsernameCheckResponse
checkUsername uname = do
  pure UsernameCheckOK
checkZAddr :: String -> Aff ZAddrCheckResponse
checkZAddr zaddr = do
  pure ZAddrCheckOK
signup :: SignupRequest -> Aff SignupResponse
signup req = do
  pure SignupOK

File addition: Recaptcha.js (----------)

[9.1]

"use strict";
exports.getRecaptchaResponseInternal = useElemId => elemId => () => {
  if (useElemId) {
    return grecaptcha.getResponse(elemId);
  } else {
    return grecaptcha.getResponse();
  }
}

File addition: Recaptcha.purs (----------)

[9.1]

module Aftok.Api.Recaptcha 
  ( getRecaptchaResponse
  ) where
import Prelude (bind, (==), ($), pure)
import Data.Maybe (Maybe(..))
import Effect (Effect)
getRecaptchaResponse :: Maybe String -> Effect (Maybe String)
getRecaptchaResponse elemId = do
  resp <- case elemId of
    Just eid -> getRecaptchaResponseInternal true eid
    Nothing  -> getRecaptchaResponseInternal false ""
  pure $ if resp == "" then Nothing else Just resp
foreign import getRecaptchaResponseInternal :: Boolean -> String -> Effect String

Deletion in client/src/Aftok/Login.purs at line 7 [10.20]
B:BD[10.97] → [7.295301:295342]
∅:D[7.295342] → [11.586:618]
B:BD[10.97] → [11.586:618]
```
import Data.Argonaut.Encode (encodeJson)
import Data.Either (Either(..))
```
Deletion in client/src/Aftok/Login.purs at line 10 [10.20]
B:BD[7.295408] → [12.21:55]
∅:D[12.55] → [13.86:124]
B:BD[14.30] → [13.86:124]
∅:D[13.124] → [7.295460:295534]
B:BD[7.295460] → [7.295460:295534]
B:BD[7.295534] → [13.125:160]
```
import Effect.Class.Console (log)
import Affjax (post, get, printError)
import Affjax.StatusCode (StatusCode(..))
import Affjax.RequestBody as RB
import Affjax.ResponseFormat as RF
```
Replacement in client/src/Aftok/Login.purs at line 24 [10.20]
∅:D[12.85] → [15.157:158]
B:BD[7.295631] → [15.157:158]
∅:D[15.192] → [7.295631:295695]
B:BD[7.295631] → [7.295631:295695]
```
type LoginRequest = { username :: String, password :: String }
```
[12.85]
[10.459]
```
import Aftok.Api.Account (LoginResponse(..), login, checkLogin, logout)
```

Replacement in client/src/Aftok/Login.purs at line 26 [10.20]

B:BD[10.460] → [7.295696:295796]

data LoginResponse
  = OK
  | Forbidden
  | Error { status :: Maybe StatusCode, message :: String }

[10.460]

[16.268]

data LoginError
  = Forbidden 
  | ServerError

Replacement in client/src/Aftok/Login.purs at line 33 [10.20]
∅:D[7.295839] → [16.335:376]
B:BD[16.335] → [16.335:376]
```
  , loginResponse :: Maybe LoginResponse
```
[7.295839]
[16.376]
```
  , loginError :: Maybe LoginError
```

Replacement in client/src/Aftok/Login.purs at line 65 [10.20]

B:BD[7.296368] → [7.296368:296444]

    initialState _ = { username: "", password: "", loginResponse: Nothing }

[7.296368]

[7.296444]

    initialState _ = { username: "", password: "", loginError: Nothing }

Replacement in client/src/Aftok/Login.purs at line 128 [10.20]
B:BD[7.299058] → [7.299058:299101]
```
                , case st.loginResponse of
```
[7.299058]
[7.299101]
```
                , case st.loginError of
```

Replacement in client/src/Aftok/Login.purs at line 131 [10.20]

B:BD[7.299165] → [7.299165:299842]

                    Just OK ->
                      HH.div
                      [ P.classes (ClassName <$> ["alert alert-warning"]) ]
                      [ HH.text "Login ok, but you should have been redirected. Why are you still here?" ]
                    Just Forbidden ->
                      HH.div
                      [ P.classes (ClassName <$> ["alert alert-danger"]) ]
                      [ HH.text "Login failed. Check your username and password." ]
                    Just (Error e) ->
                      HH.div
                      [ P.classes (ClassName <$> ["alert alert-danger"]) ]
                      [ HH.text ("Login failed: " <> e.message) ]

[7.299165]

[7.299842]

                    Just err -> 
                      let message = case err of
                            Forbidden -> "Login failed. Check your username and password."
                            ServerError -> "Login failed due to an internal error. Please contact support."
                       in HH.div
                            [ P.classes (ClassName <$> ["alert alert-danger"]) ]
                            [ HH.text message ]

Replacement in client/src/Aftok/Login.purs at line 140 [10.20]

B:BD[7.299871] → [7.299871:299973]

                  [ P.classes (ClassName <$> ["btn", "btn-block", "btn-primary"])
                  ]

[7.299871]

[7.299973]

                  [ P.classes (ClassName <$> ["btn", "btn-block", "btn-primary"]) ]

Deletion in client/src/Aftok/Login.purs at line 163 [10.20]
B:BD[7.300426] → [7.300426:300482]
```
        H.modify_ (_ { loginResponse = Just response })
```

Replacement in client/src/Aftok/Login.purs at line 164 [10.20]

B:BD[7.300507] → [8.471:530]

∅:D[8.530] → [7.300546:300572]

B:BD[7.300546] → [7.300546:300572]

∅:D[7.300572] → [10.2466:2467]

B:BD[10.2466] → [10.2466:2467]

B:BD[10.2565] → [10.2565:2635]

B:BD[10.2635] → [7.300573:300620]

∅:D[7.300620] → [10.2715:2736]

B:BD[10.2715] → [10.2715:2736]

B:BD[10.2736] → [15.272:320]

B:BD[15.320] → [13.217:329]

∅:D[13.329] → [15.321:338]

B:BD[7.300846] → [15.321:338]

B:BD[15.338] → [13.330:449]

∅:D[15.434] → [7.300846:301097]

∅:D[13.449] → [7.300846:301097]

B:BD[7.300846] → [7.300846:301097]

B:BD[7.301097] → [13.450:902]

          OK -> H.raise (LoginComplete { username: user })
          _  -> pure unit
-- | Post credentials to the login service and interpret the response
login :: String -> String -> Aff LoginResponse
login user pass = do
  log "Sending login request to /api/login ..."
  result <- post RF.ignore "/api/login" (Just <<< RB.Json <<< encodeJson $ { username: user, password : pass })
  case result of
       Left err -> log ("Login failed: " <> printError err)
       Right r  -> log ("Login status: " <> show r.status)
  pure $ case result of
    Left err -> Error { status: Nothing, message: printError err }
    Right r -> case r.status of
      StatusCode 403 -> Forbidden
      StatusCode 200 -> OK
      other -> Error { status: Just other, message: r.statusText }
checkLogin :: Aff LoginResponse
checkLogin = do
  log "Sending login check to /api/login/check ..."
  result <- get RF.ignore "/api/login/check"
  case result of
    Left err -> do
      log ("Login failed: " <> printError err)
      pure $ Error { status: Nothing, message: printError err }
    Right r -> do
      log ("Login status: " <> show r.status)
      pure $ case r.status of
        StatusCode 200 -> OK
        StatusCode _   -> Forbidden

[7.300507]

[10.3162]

          LoginOK        -> H.raise (LoginComplete { username: user })
          LoginForbidden -> H.modify_ (_ { loginError = Just Forbidden })
          LoginError _   -> H.modify_ (_ { loginError = Just ServerError })

Deletion in client/src/Aftok/Login.purs at line 168 [10.20]

B:BD[10.3163] → [13.903:1159]

logout :: Aff Unit
logout = do
  log "Logging out on server with  /api/logout ..."
  result <- get RF.ignore "/api/logout"
  case result of
    Left err -> log ("Logout failed: " <> printError err)
    Right r ->  log ("Logout status: " <> show r.status)

Replacement in client/src/Aftok/Login.purs at line 173 [10.20]

B:BD[13.1225] → [13.1225:1277]

  { login: \_ _ -> pure OK 
  , checkLogin: pure OK

[13.1225]

[13.1277]

  { login: \_ _ -> pure LoginOK 
  , checkLogin: pure LoginOK

Replacement in client/src/Aftok/Signup.purs at line 5 [17.1]
B:BD[17.45] → [17.45:88]
```
-- import Control.Monad.Trans.Class (lift)
```
[17.45]
[17.88]
```
import Control.Monad.Trans.Class (lift)
```
Insertion in client/src/Aftok/Signup.purs at line 7 [17.1]
[17.89]
[17.89]
```
import Data.Foldable (any)
```

Insertion in client/src/Aftok/Signup.purs at line 9 [17.1]

[17.130]

import Data.Either (Either(..), note)
import Data.Validation.Semigroup (V(..), toEither, andThen, invalid)

Insertion in client/src/Aftok/Signup.purs at line 12 [17.1]
[17.131]
[17.131]
```
import Effect.Aff (Aff)
import Effect.Class (liftEffect)
```

Insertion in client/src/Aftok/Signup.purs at line 33 [17.1]

[17.619]

import Aftok.Api.Account as Acc
import Aftok.Api.Account (SignupRequest, SignupResponse, signupRequest)
import Aftok.Api.Recaptcha (getRecaptchaResponse)

Replacement in client/src/Aftok/Signup.purs at line 37 [17.1]

B:BD[17.620] → [17.620:707]

data SignupResponse
  = OK
  | Error { status :: Maybe StatusCode, message :: String }

[17.620]

[17.707]

data SignupError
  = UsernameRequired
  | UsernameTaken
  | PasswordRequired
  | ConfirmRequired
  | PasswordMismatch
  | EmailRequired
  | ZAddrRequired
  | ZAddrInvalid
  | CaptchaError
  | APIError { status :: Maybe StatusCode, message :: String }

Replacement in client/src/Aftok/Signup.purs at line 62 [17.1]
B:BD[17.1028] → [17.1028:1070]
```
  , loginResponse :: Maybe SignupResponse
```
[17.1028]
[17.1070]
```
  , signupErrors :: Array SignupError
```
Replacement in client/src/Aftok/Signup.purs at line 76 [17.1]
B:BD[17.1320] → [17.1320:1362]
```
  = SignupComplete { username :: String }
```
[17.1320]
[17.1378]
```
  = SignupComplete String 
  | SigninNav
```

Replacement in client/src/Aftok/Signup.purs at line 82 [17.1]

B:BD[17.1459] → [17.1459:1510]

  { signup :: String -> String -> m SignupResponse

[17.1459]

[17.1510]

  { checkUsername :: String -> m Acc.UsernameCheckResponse
  , checkZAddr :: String -> m Acc.ZAddrCheckResponse
  , signup :: SignupRequest -> m SignupResponse
  , getRecaptchaResponse :: Maybe String -> m (Maybe String)

Replacement in client/src/Aftok/Signup.purs at line 113 [17.1]
B:BD[17.2095] → [17.2095:2126]
```
      , loginResponse: Nothing
```
[17.2095]
[17.2126]
```
      , signupErrors: []
```

Replacement in client/src/Aftok/Signup.purs at line 136 [17.1]

B:BD[17.3157] → [17.3157:3212]

                [ P.classes (ClassName <$> ["mb-6"]) ]

[17.3157]

[17.3212]

                [ P.classes (ClassName <$> ["mb-6"]) 
                , E.onSubmit (Just <<< Signup)
                ]

Replacement in client/src/Aftok/Signup.purs at line 168 [17.1]

B:BD[17.4571] → [17.4571:4610]

                    , P.id_ "password"

[17.4571]

[17.4610]

                    , P.id_ "passwordConfirm"

Replacement in client/src/Aftok/Signup.purs at line 180 [17.1]

B:BD[17.5087] → [17.5087:5159]

                    [ P.classes (ClassName <$> ["form-group", "mb-3"])

[17.5087]

[17.5159]

                    [ P.classes (ClassName <$> ["g-recaptcha", "mx-auto"])

Replacement in client/src/Aftok/Signup.purs at line 202 [17.1]

B:BD[17.5929] → [17.5929:6059]

      SetUsername user -> H.modify_ (_ { username = Just user })
      SetPassword pass -> H.modify_ (_ { password = Just pass })

[17.5929]

[3.950]

      SetUsername user -> do
        ures <- lift $ caps.checkUsername user
        H.modify_ (_ { username = Just user })
        case ures of
          Acc.UsernameCheckOK    -> pure unit
          Acc.UsernameCheckTaken -> H.modify_ (_ { signupErrors = [UsernameTaken] })
      SetPassword pass -> do
        H.modify_ (_ { password = Just pass })
        confirm <- H.gets (_.passwordConfirm)
        when (any (notEq pass) confirm) (H.modify_ (_ { signupErrors = [PasswordMismatch] }))
           
      ConfirmPassword confirm -> do
        H.modify_ (_ { passwordConfirm = Just confirm })
        password <- H.gets (_.password)
        when (any (notEq confirm) password) (H.modify_ (_ { signupErrors = [PasswordMismatch] }))

Replacement in client/src/Aftok/Signup.purs at line 220 [17.1]

∅:D[3.1012] → [17.6059:6156]

B:BD[17.6059] → [17.6059:6156]

      ConfirmPassword pass -> H.modify_ (_ { passwordConfirm = Just pass })
      _ -> pure unit

[3.1012]

[17.6156]

      SetRecoveryEmail email -> H.modify_ (_ { recoveryEmail = Just email })
      SetRecoveryZAddr addr -> do
        zres <- lift $ caps.checkZAddr addr
        H.modify_ (_ { recoveryZAddr = Just addr })
        case zres of
          Acc.ZAddrCheckOK -> pure unit
          Acc.ZAddrCheckInvalid -> H.modify_ (_ { signupErrors = [ZAddrInvalid] })

Insertion in client/src/Aftok/Signup.purs at line 228 [17.1]

[17.6157]

      Signin ev -> do 
        lift $ system.preventDefault (ME.toEvent ev)
        H.raise SigninNav
      Signup ev -> do
        lift $ system.preventDefault ev
        recType <- H.gets (_.recoveryType)
        usernameV <- V <<< note [UsernameRequired] <$> H.gets (_.username)
        pwdFormV  <- V <<< note [PasswordRequired] <$> H.gets (_.password)
        pwdConfV  <- V <<< note [ConfirmRequired ] <$> H.gets (_.passwordConfirm)
        recoveryType <- H.gets (_.recoveryType)
        recoveryV <- case recoveryType of
          RecoveryEmail -> 
            V <<< note [EmailRequired] <<< map Acc.RecoverByEmail <$> H.gets (_.recoveryEmail)
          RecoveryZAddr -> 
            V <<< note [ZAddrRequired] <<< map Acc.RecoverByZAddr <$> H.gets (_.recoveryZAddr)
        recapV <- lift $ V <<< note [CaptchaError] <$> caps.getRecaptchaResponse Nothing
        let reqV :: V (Array SignupError) Acc.SignupRequest
            reqV = signupRequest <$> usernameV
                                 <*> ((eq <$> pwdFormV <*> pwdConfV) `andThen` 
                                      (if _ then pwdFormV else invalid [PasswordMismatch]))
                                 <*> recoveryV
                                 <*> recapV
        case toEither reqV of
          Left errors -> 
            H.modify_ (_ { signupErrors = errors })
          Right req -> do
            response <- lift (caps.signup req)
            case response of
              Acc.SignupOK -> H.raise (SignupComplete $ req.username)
              Acc.CaptchaInvalid -> H.modify_ (_ { signupErrors = [CaptchaError] })
              Acc.ZAddrInvalid -> H.modify_ (_ { signupErrors = [ZAddrInvalid] })
              Acc.UsernameTaken -> H.modify_ (_ { signupErrors = [UsernameTaken] })

Replacement in client/src/Aftok/Signup.purs at line 332 [17.1]
B:BD[17.8398] → [3.1343:1401]
```
mockCapability :: forall m. Applicative m => Capability m
```
[17.8398]
[3.1401]
```
mockCapability :: Capability Aff
```

Replacement in client/src/Aftok/Signup.purs at line 334 [17.1]

B:BD[3.1419] → [3.1419:1448]

  { signup: \_ _ -> pure OK

[3.1419]

[3.1448]

  { checkUsername: \_ -> pure Acc.UsernameCheckOK
  , checkZAddr: \_ -> pure Acc.ZAddrCheckOK
  , signup: \_ -> pure Acc.SignupOK
  , getRecaptchaResponse: liftEffect <<< getRecaptchaResponse

Insertion in client/src/Main.purs at line 24 [18.410]
[7.307714]
[3.1541]
```
import Aftok.Api.Account as Acc
```

Replacement in client/src/Main.purs at line 85 [18.410]

B:BD[7.308567] → [3.2072:2142]

    initialState _ = { view: VLoading, config: { recaptchaKey: "" } }

[7.308567]

[7.308598]

    initialState _ = 
      { view: VLoading
      , config: { recaptchaKey: "6LdiA78ZAAAAAGGvDId_JmDbhalduIDZSqbuikfq" } 
      }

Replacement in client/src/Main.purs at line 117 [18.410]

B:BD[3.2747] → [3.2747:2794]

                Login.Forbidden -> pure VLogin

[3.2747]

[3.2794]

                Acc.LoginForbidden -> pure VLogin
                Acc.LoginError _ -> pure VLogin

Insertion in client/src/Main.purs at line 128 [18.410]

[3.3055]

      SignupAction (Signup.SigninNav) ->
        H.modify_ (_ { view = VLogin })

Insertion in server/Aftok/QConfig.hs at line 36 [21.4500]
[19.4377]
[20.534]
```
  , _recaptchaSecret :: Maybe Text
```
Insertion in server/Aftok/QConfig.hs at line 65 [21.4500]
[22.45251]
[23.7968]
```
    <*> C.lookup cfg "recaptchaSecret"
```

Replacement in server/Aftok/Snaplet/Projects.hs at line 66 [24.2363]

B:BD[23.9021] → [22.53858:53951]

  uid                       <- requireUserId
  pid                       <- requireProjectId

[23.9021]

[23.9070]

  uid     <- requireUserId
  pid     <- requireProjectId

Replacement in server/Aftok/Snaplet/Projects.hs at line 69 [24.2363]
B:BD[23.9145] → [22.53952:54007]
```
  t                         <- liftIO C.getCurrentTime
```
[23.9145]
[22.54007]
```
  t       <- liftIO C.getCurrentTime
```
Insertion in server/Aftok/Snaplet/Users.hs at line 1 [25.3234]
[25.3234]
[26.3072]
```
{-# LANGUAGE OverloadedStrings   #-}
```
Insertion in server/Aftok/Snaplet/Users.hs at line 8 [25.3234]
[27.477]
[22.55437]
```
  , CaptchaConfig(..)
  , CaptchaError(..)
  , checkCaptcha
```

Replacement in server/Aftok/Snaplet/Users.hs at line 17 [25.3234]

B:BD[28.8667] → [22.55448:55500]

import           Data.Aeson                    as A

[28.8667]

[22.55500]

import qualified Data.Aeson                    as A
import           Data.Aeson                    ((.:), (.:?))

Insertion in server/Aftok/Snaplet/Users.hs at line 21 [25.3234]
[22.55604]
[22.55604]
```
import           Data.Text.Encoding            as T
```

Insertion in server/Aftok/Snaplet/Users.hs at line 25 [25.3234]

[2.15002]

[23.10431]

import           Network.HTTP.Client            ( parseRequest, responseBody, responseStatus, httpLbs)
import           Network.HTTP.Client.TLS        ( newTlsManager )
import           Network.HTTP.Client.MultipartFormData (formDataBody, partBS)
import           Network.HTTP.Types.Status      ( statusCode )

Replacement in server/Aftok/Snaplet/Users.hs at line 39 [25.3234]

B:BD[25.3651] → [28.8914:8941]

B:BD[28.8941] → [22.55898:55950]

import           Snap.Core
import           Snap.Snaplet                  as S

[25.3651]

[22.55950]

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

Replacement in server/Aftok/Snaplet/Users.hs at line 50 [25.3234]
B:BD[25.4306] → [29.12457:12487]
B:BD[29.12487] → [28.9079:9104]
```
instance FromJSON CUser where
  parseJSON (Object v) =
```
[25.4306]
[22.56004]
```
instance A.FromJSON CUser where
  parseJSON (A.Object v) =
```
Replacement in server/Aftok/Snaplet/Users.hs at line 71 [25.3234]
B:BD[30.716] → [24.3554:3592]
```
  requestBody <- readRequestBody 4096
```
[30.678]
[23.11005]
```
  rbody <- S.readRequestBody 4096
```
Replacement in server/Aftok/Snaplet/Users.hs at line 74 [25.3234]
B:BD[22.56389] → [22.56389:56416]
```
    $ A.decode requestBody
```
[22.56389]
[22.56416]
```
    $ A.decode rbody
```
Replacement in server/Aftok/Snaplet/Users.hs at line 87 [25.3234]
∅:D[23.11292] → [24.3764:3800]
∅:D[29.12605] → [24.3764:3800]
∅:D[22.56909] → [24.3764:3800]
B:BD[24.3764] → [24.3764:3800]
```
  authUser <- with auth createSUser
```
[22.56909]
[28.9235]
```
  authUser <- S.with auth createSUser
```
Replacement in server/Aftok/Snaplet/Users.hs at line 94 [25.3234]
B:BD[22.56976] → [22.56976:57000]
```
  params   <- getParams
```
[22.56976]
[22.57000]
```
  params   <- S.getParams
```

Replacement in server/Aftok/Snaplet/Users.hs at line 96 [25.3234]

B:BD[22.57068] → [22.57068:57134]

                    (pure . traverse (parseInvCode . decodeUtf8))

[22.57068]

[22.57134]

                    (pure . traverse (parseInvCode . T.decodeUtf8))

Insertion in server/Aftok/Snaplet/Users.hs at line 105 [25.3234]
[28.9320]
[28.9320]
```
type CaptchaCheckResult = Either [CaptchaError] ()
```

Insertion in server/Aftok/Snaplet/Users.hs at line 107 [25.3234]

[28.9321]

data CaptchaError
  = MissingInputSecret
  | InvalidInputSecret
  | MissingInputResponse
  | InvalidInputResponse
  | BadRequest
  | TimeoutOrDuplicate
  | CaptchaError Text
  deriving (Eq, Show)
data CaptchaConfig = CaptchaConfig
  { secretKey :: Text }
data CaptchaResponse = CaptchaResponse
  { success :: Bool
  , errorCodes :: [CaptchaError]
  }
instance A.FromJSON CaptchaResponse where
  parseJSON (A.Object v) =
    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."

Insertion in server/Aftok/Snaplet/Users.hs at line 141 [25.3234]

[28.9322]

checkCaptcha :: CaptchaConfig -> Text -> IO CaptchaCheckResult
checkCaptcha cfg token = do
  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
  response <- httpLbs reqWithBody manager
  pure $ case statusCode (responseStatus response) of
    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)
    errCode ->
      Left $ [CaptchaError $ "Unexpected status code: " <> T.pack (show errCode)]

Deletion in server/Main.hs at line 66 [31.5188]
∅:D[13.11732] → [22.63040:63099]
∅:D[7.311276] → [22.63040:63099]
B:BD[22.63040] → [22.63040:63099]
```
    registerRoute     = void $ method POST registerHandler
```
Insertion in server/Main.hs at line 67 [31.5188]
[23.12971]
[22.63100]
```
    registerRoute     = void $ method POST registerHandler
```

Add signup form, captcha check.

Dependencies

In channels

Change contents

Insertion in aftok.cabal at line 164 [5.1]

Insertion in aftok.cabal at line 166 [5.1]

Insertion in client/dev/index.html at line 8 [7.2486]

Insertion in client/spago.dhall at line 12 [7.294942]

File addition: Account.purs (----------)

File addition: Recaptcha.js (----------)

File addition: Recaptcha.purs (----------)

Deletion in client/src/Aftok/Login.purs at line 7 [10.20]

Deletion in client/src/Aftok/Login.purs at line 10 [10.20]

Replacement in client/src/Aftok/Login.purs at line 24 [10.20]

Replacement in client/src/Aftok/Login.purs at line 26 [10.20]

Replacement in client/src/Aftok/Login.purs at line 33 [10.20]

Replacement in client/src/Aftok/Login.purs at line 65 [10.20]

Replacement in client/src/Aftok/Login.purs at line 128 [10.20]

Replacement in client/src/Aftok/Login.purs at line 131 [10.20]

Replacement in client/src/Aftok/Login.purs at line 140 [10.20]

Deletion in client/src/Aftok/Login.purs at line 163 [10.20]

Replacement in client/src/Aftok/Login.purs at line 164 [10.20]

Deletion in client/src/Aftok/Login.purs at line 168 [10.20]

Replacement in client/src/Aftok/Login.purs at line 173 [10.20]

Replacement in client/src/Aftok/Signup.purs at line 5 [17.1]

Insertion in client/src/Aftok/Signup.purs at line 7 [17.1]

Insertion in client/src/Aftok/Signup.purs at line 9 [17.1]

Insertion in client/src/Aftok/Signup.purs at line 12 [17.1]

Insertion in client/src/Aftok/Signup.purs at line 33 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 37 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 62 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 76 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 82 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 113 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 136 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 168 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 180 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 202 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 220 [17.1]

Insertion in client/src/Aftok/Signup.purs at line 228 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 332 [17.1]

Replacement in client/src/Aftok/Signup.purs at line 334 [17.1]

Insertion in client/src/Main.purs at line 24 [18.410]

Replacement in client/src/Main.purs at line 85 [18.410]

Replacement in client/src/Main.purs at line 117 [18.410]

Insertion in client/src/Main.purs at line 128 [18.410]

Insertion in server/Aftok/QConfig.hs at line 36 [21.4500]

Insertion in server/Aftok/QConfig.hs at line 65 [21.4500]

Replacement in server/Aftok/Snaplet/Projects.hs at line 66 [24.2363]

Replacement in server/Aftok/Snaplet/Projects.hs at line 69 [24.2363]

Insertion in server/Aftok/Snaplet/Users.hs at line 1 [25.3234]

Insertion in server/Aftok/Snaplet/Users.hs at line 8 [25.3234]

Replacement in server/Aftok/Snaplet/Users.hs at line 17 [25.3234]

Insertion in server/Aftok/Snaplet/Users.hs at line 21 [25.3234]

Insertion in server/Aftok/Snaplet/Users.hs at line 25 [25.3234]

Replacement in server/Aftok/Snaplet/Users.hs at line 39 [25.3234]

Replacement in server/Aftok/Snaplet/Users.hs at line 50 [25.3234]

Replacement in server/Aftok/Snaplet/Users.hs at line 71 [25.3234]

Replacement in server/Aftok/Snaplet/Users.hs at line 74 [25.3234]

Replacement in server/Aftok/Snaplet/Users.hs at line 87 [25.3234]

Replacement in server/Aftok/Snaplet/Users.hs at line 94 [25.3234]

Replacement in server/Aftok/Snaplet/Users.hs at line 96 [25.3234]

Insertion in server/Aftok/Snaplet/Users.hs at line 105 [25.3234]

Insertion in server/Aftok/Snaplet/Users.hs at line 107 [25.3234]

Insertion in server/Aftok/Snaplet/Users.hs at line 141 [25.3234]

Deletion in server/Main.hs at line 66 [31.5188]

Insertion in server/Main.hs at line 67 [31.5188]