Account.purs
module Aftok.Api.Account where
import Prelude
import Data.Argonaut.Core (stringify)
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
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
, invitationCodes :: Array String
}
signupRequest :: String -> String -> RecoverBy -> String -> Array String -> SignupRequest
signupRequest username password recoverBy captchaToken invitationCodes = { username, password, recoverBy, captchaToken, invitationCodes}
data SignupResponse
= SignupOK
| CaptchaInvalid
| ZAddrInvalid
| UsernameTaken
| ServiceError (Maybe StatusCode) String
instance srShow :: Show SignupResponse where
show r = case r of
SignupOK -> "SignupOK"
CaptchaInvalid -> "CaptchaInvalid"
ZAddrInvalid -> "ZAddrInvalid"
UsernameTaken -> "UsernameTaken"
ServiceError _ _ -> "ServiceError"
data UsernameCheckResponse
= UsernameCheckOK
| UsernameCheckTaken
data ZAddrCheckResponse
= ZAddrCheckValid
| ZAddrCheckInvalid
checkUsername :: String -> Aff UsernameCheckResponse
checkUsername uname = do
result <- get RF.ignore ("/api/validate_username?username=" <> uname)
pure
$ case result of
Left err -> UsernameCheckTaken
Right r
| r.status == StatusCode 200 -> UsernameCheckOK
Right r -> UsernameCheckTaken
checkZAddr :: String -> Aff ZAddrCheckResponse
checkZAddr zaddr = do
result <- get RF.ignore ("/api/validate_zaddr?zaddr=" <> zaddr)
pure
$ case result of
Left err -> ZAddrCheckInvalid
Right r
| r.status == StatusCode 200 -> ZAddrCheckValid
Right r -> ZAddrCheckInvalid
signup :: SignupRequest -> Aff SignupResponse
signup req = do
let
signupJSON =
encodeJson
$ { username: req.username
, password: req.password
, recoveryType:
case req.recoverBy of
RecoverByEmail _ -> "email"
RecoverByZAddr _ -> "zaddr"
, recoveryEmail:
case req.recoverBy of
RecoverByEmail email -> Just email
RecoverByZAddr _ -> Nothing
, recoveryZAddr:
case req.recoverBy of
RecoverByEmail _ -> Nothing
RecoverByZAddr zaddr -> Just zaddr
, captchaToken: req.captchaToken
, invitation_codes: req.invitationCodes
}
log ("Sending JSON request: " <> stringify signupJSON)
result <- post RF.ignore "/api/register" (Just <<< RB.Json $ signupJSON)
case result of
Left err -> do
log ("Registration failed: " <> printError err)
pure (ServiceError Nothing $ printError err)
Right r
| r.status == StatusCode 200 -> do
log "Registration succeeded!"
pure SignupOK
Right r
| r.status == StatusCode 403 -> do
log ("Registration failed: Capcha Invalid")
pure CaptchaInvalid
Right r
| r.status == StatusCode 400 -> do
log ("Registration failed: Z-Address Invalid")
pure ZAddrInvalid
Right r -> do
log ("Registration failed: " <> r.statusText)
pure $ ServiceError (Just r.status) r.statusText