about summary refs log tree commit diff
diff options
context:
space:
mode:
authorWilliam Carroll <wpcarro@gmail.com>2021-01-22T11·13+0000
committerWilliam Carroll <wpcarro@gmail.com>2021-01-22T11·13+0000
commit42ba9cce79852f992302df92cb7ab61a08a53fb3 (patch)
treea1903f7f74985c23b35622920cf3866da1a1f7c0
parente326b0da45a948668f523d5f715660981a9874c2 (diff)
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...
-rw-r--r--assessments/tt/src/API.hs5
-rw-r--r--assessments/tt/src/App.hs12
-rw-r--r--assessments/tt/src/Types.hs13
3 files changed, 20 insertions, 10 deletions
diff --git a/assessments/tt/src/API.hs b/assessments/tt/src/API.hs
index 4c67896e2448..471fa761e0f4 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 6a7de73a822f..742bc962dc55 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 00fa09ccc140..6b06a39694fc 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