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
|
||||
:> Post '[JSON] NoContent
|
||||
:<|> "verify"
|
||||
:> QueryParam' '[Required] "username" Text
|
||||
:> QueryParam' '[Required] "secret" T.RegistrationSecret
|
||||
:> Get '[JSON] NoContent
|
||||
:> ReqBody '[JSON] T.VerifyAccountRequest
|
||||
:> Post '[JSON] NoContent
|
||||
-- accounts: Read
|
||||
-- accounts: Update
|
||||
-- accounts: Delete
|
||||
|
|
|
@ -48,11 +48,9 @@ sendVerifyEmail T.Config{..} (T.Username username) email (T.RegistrationSecret s
|
|||
Email.send mailgunAPIKey subject (cs body) email
|
||||
where
|
||||
subject = "Please confirm your account"
|
||||
-- TODO(wpcarro): Use a URL encoder
|
||||
-- TODO(wpcarro): Use a dynamic domain and port number
|
||||
body =
|
||||
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.
|
||||
sendInviteEmail :: T.Config
|
||||
|
@ -119,14 +117,14 @@ server config@T.Config{..} = createAccount
|
|||
Left _ -> undefined
|
||||
Right _ -> pure NoContent
|
||||
|
||||
verifyAccount :: Text -> T.RegistrationSecret -> Handler NoContent
|
||||
verifyAccount username secretUUID = do
|
||||
mPendingAccount <- liftIO $ PendingAccounts.get dbFile (T.Username username)
|
||||
verifyAccount :: T.VerifyAccountRequest -> Handler NoContent
|
||||
verifyAccount T.VerifyAccountRequest{..} = do
|
||||
mPendingAccount <- liftIO $ PendingAccounts.get dbFile verifyAccountRequestUsername
|
||||
case mPendingAccount of
|
||||
Nothing ->
|
||||
throwError err401 { errBody = "Either your secret or your username (or both) is invalid" }
|
||||
Just pendingAccount@T.PendingAccount{..} ->
|
||||
if pendingAccountSecret == secretUUID then do
|
||||
if pendingAccountSecret == verifyAccountRequestSecret then do
|
||||
liftIO $ Accounts.transferFromPending dbFile pendingAccount
|
||||
pure NoContent
|
||||
else
|
||||
|
|
|
@ -420,6 +420,19 @@ instance ToField RegistrationSecret where
|
|||
toField (RegistrationSecret secretUUID) =
|
||||
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
|
||||
{ pendingAccountSecret :: RegistrationSecret
|
||||
, pendingAccountUsername :: Username
|
||||
|
|
Loading…
Reference in a new issue