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:
William Carroll 2021-01-22 11:13:50 +00:00
parent e326b0da45
commit 42ba9cce79
3 changed files with 20 additions and 10 deletions

View file

@ -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

View file

@ -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

View file

@ -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