Prefer POST /verify to GET /verify
To make things easier for testing, I setup the /verify endpoint as a GET, so that I could email myself clickable URLs. With POST /verify, my options are: - send email with an HTML button and form that POSTs to /verify - email myself the curl instruction I'm preferring the latter for now...
This commit is contained in:
parent
e326b0da45
commit
42ba9cce79
3 changed files with 20 additions and 10 deletions
|
@ -20,9 +20,8 @@ type API =
|
||||||
:> ReqBody '[JSON] T.CreateAccountRequest
|
:> ReqBody '[JSON] T.CreateAccountRequest
|
||||||
:> Post '[JSON] NoContent
|
:> Post '[JSON] NoContent
|
||||||
:<|> "verify"
|
:<|> "verify"
|
||||||
:> QueryParam' '[Required] "username" Text
|
:> ReqBody '[JSON] T.VerifyAccountRequest
|
||||||
:> QueryParam' '[Required] "secret" T.RegistrationSecret
|
:> Post '[JSON] NoContent
|
||||||
:> Get '[JSON] NoContent
|
|
||||||
-- accounts: Read
|
-- accounts: Read
|
||||||
-- accounts: Update
|
-- accounts: Update
|
||||||
-- accounts: Delete
|
-- accounts: Delete
|
||||||
|
|
|
@ -48,11 +48,9 @@ sendVerifyEmail T.Config{..} (T.Username username) email (T.RegistrationSecret s
|
||||||
Email.send mailgunAPIKey subject (cs body) email
|
Email.send mailgunAPIKey subject (cs body) email
|
||||||
where
|
where
|
||||||
subject = "Please confirm your account"
|
subject = "Please confirm your account"
|
||||||
-- TODO(wpcarro): Use a URL encoder
|
|
||||||
-- TODO(wpcarro): Use a dynamic domain and port number
|
|
||||||
body =
|
body =
|
||||||
let secret = secretUUID |> UUID.toString in
|
let secret = secretUUID |> UUID.toString in
|
||||||
cs configServer ++ "/verify?username=" ++ cs username ++ "&secret=" ++ secret
|
"To verify your account: POST /verify username=" ++ cs username ++ " secret=" ++ secret
|
||||||
|
|
||||||
-- | Send an invitation email to recipient, `to`, with a secret code.
|
-- | Send an invitation email to recipient, `to`, with a secret code.
|
||||||
sendInviteEmail :: T.Config
|
sendInviteEmail :: T.Config
|
||||||
|
@ -119,14 +117,14 @@ server config@T.Config{..} = createAccount
|
||||||
Left _ -> undefined
|
Left _ -> undefined
|
||||||
Right _ -> pure NoContent
|
Right _ -> pure NoContent
|
||||||
|
|
||||||
verifyAccount :: Text -> T.RegistrationSecret -> Handler NoContent
|
verifyAccount :: T.VerifyAccountRequest -> Handler NoContent
|
||||||
verifyAccount username secretUUID = do
|
verifyAccount T.VerifyAccountRequest{..} = do
|
||||||
mPendingAccount <- liftIO $ PendingAccounts.get dbFile (T.Username username)
|
mPendingAccount <- liftIO $ PendingAccounts.get dbFile verifyAccountRequestUsername
|
||||||
case mPendingAccount of
|
case mPendingAccount of
|
||||||
Nothing ->
|
Nothing ->
|
||||||
throwError err401 { errBody = "Either your secret or your username (or both) is invalid" }
|
throwError err401 { errBody = "Either your secret or your username (or both) is invalid" }
|
||||||
Just pendingAccount@T.PendingAccount{..} ->
|
Just pendingAccount@T.PendingAccount{..} ->
|
||||||
if pendingAccountSecret == secretUUID then do
|
if pendingAccountSecret == verifyAccountRequestSecret then do
|
||||||
liftIO $ Accounts.transferFromPending dbFile pendingAccount
|
liftIO $ Accounts.transferFromPending dbFile pendingAccount
|
||||||
pure NoContent
|
pure NoContent
|
||||||
else
|
else
|
||||||
|
|
|
@ -420,6 +420,19 @@ instance ToField RegistrationSecret where
|
||||||
toField (RegistrationSecret secretUUID) =
|
toField (RegistrationSecret secretUUID) =
|
||||||
secretUUID |> UUID.toText |> SQLText
|
secretUUID |> UUID.toText |> SQLText
|
||||||
|
|
||||||
|
instance FromJSON RegistrationSecret
|
||||||
|
|
||||||
|
data VerifyAccountRequest = VerifyAccountRequest
|
||||||
|
{ verifyAccountRequestUsername :: Username
|
||||||
|
, verifyAccountRequestSecret :: RegistrationSecret
|
||||||
|
} deriving (Eq, Show)
|
||||||
|
|
||||||
|
instance FromJSON VerifyAccountRequest where
|
||||||
|
parseJSON = withObject "VerifyAccountRequest" $ \x -> do
|
||||||
|
verifyAccountRequestUsername <- x .: "username"
|
||||||
|
verifyAccountRequestSecret <- x .: "secret"
|
||||||
|
pure VerifyAccountRequest{..}
|
||||||
|
|
||||||
data PendingAccount = PendingAccount
|
data PendingAccount = PendingAccount
|
||||||
{ pendingAccountSecret :: RegistrationSecret
|
{ pendingAccountSecret :: RegistrationSecret
|
||||||
, pendingAccountUsername :: Username
|
, pendingAccountUsername :: Username
|
||||||
|
|
Loading…
Reference in a new issue