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…
	
	Add table
		Add a link
		
	
		Reference in a new issue