From 42ba9cce79852f992302df92cb7ab61a08a53fb3 Mon Sep 17 00:00:00 2001 From: William Carroll Date: Fri, 22 Jan 2021 11:13:50 +0000 Subject: [PATCH] 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... --- assessments/tt/src/API.hs | 5 ++--- assessments/tt/src/App.hs | 12 +++++------- assessments/tt/src/Types.hs | 13 +++++++++++++ 3 files changed, 20 insertions(+), 10 deletions(-) diff --git a/assessments/tt/src/API.hs b/assessments/tt/src/API.hs index 4c67896e2..471fa761e 100644 --- a/assessments/tt/src/API.hs +++ b/assessments/tt/src/API.hs @@ -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 diff --git a/assessments/tt/src/App.hs b/assessments/tt/src/App.hs index 6a7de73a8..742bc962d 100644 --- a/assessments/tt/src/App.hs +++ b/assessments/tt/src/App.hs @@ -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 diff --git a/assessments/tt/src/Types.hs b/assessments/tt/src/Types.hs index 00fa09ccc..6b06a3969 100644 --- a/assessments/tt/src/Types.hs +++ b/assessments/tt/src/Types.hs @@ -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