Verify users' email addresses when they attempt to sign-up

Lots of changes here:
- Add the GET /verify endpoint
- Email users a secret using MailGun
- Create a PendingAccounts table and record type
- Prefer do-notation for FromRow instances (and in general) instead of the <*>
  or a liftA2 style. Using instances using `<*>` makes the instances depend on
  the order in which the record's fields were defined. When combined with a
  "SELECT *", which returns the columns in whichever order the schema defines
  them (or depending on the DB implementation), produces runtime parse errors
  at best and silent errors at worst.
- Delete bill from accounts.csv to free up the wpcarro@gmail.com when testing
  the /verify route.

1 files changed, 49 insertions, 6 deletions

diff --git a/src/App.hs b/src/App.hs
index 7536e3c771e1..9a4c3ae2066f 100644
--- a/src/App.hs
+++ b/src/App.hs
@@ -17,6 +17,8 @@ import API
 import Utils
 import Web.Cookie
 
+import qualified System.Random as Random
+import qualified Email as Email
 import qualified Crypto.KDF.BCrypt as BC
 import qualified Data.Text.Encoding as TE
 import qualified Data.UUID as UUID
@@ -27,6 +29,7 @@ import qualified Auth as Auth
 import qualified Trips as Trips
 import qualified Sessions as Sessions
 import qualified LoginAttempts as LoginAttempts
+import qualified PendingAccounts as PendingAccounts
 --------------------------------------------------------------------------------
 
 err429 :: ServerError
@@ -37,8 +40,25 @@ err429 = ServerError
   , errHeaders = []
   }
 
+-- | Send an email to recipient, `to`, with a secret code.
+sendVerifyEmail :: Text
+             -> T.Username
+             -> T.Email
+             -> T.RegistrationSecret
+             -> IO (Either Email.SendError Email.SendSuccess)
+sendVerifyEmail apiKey (T.Username username) email@(T.Email to) (T.RegistrationSecret secretUUID) = do
+  Email.send apiKey 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
+        "http://localhost:3000/verify?username=" ++ cs username ++ "&secret=" ++ secret
+
 server :: T.Config -> Server API
 server T.Config{..} = createAccount
+                 :<|> verifyAccount
                  :<|> deleteAccount
                  :<|> listAccounts
                  :<|> createTrip
@@ -54,14 +74,37 @@ server T.Config{..} = createAccount
 
     -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
     createAccount :: T.CreateAccountRequest -> Handler NoContent
-    createAccount request = do
-      liftIO $ Accounts.create dbFile
-        (T.createAccountRequestUsername request)
-        (T.createAccountRequestPassword request)
-        (T.createAccountRequestEmail request)
-        (T.createAccountRequestRole request)
+    createAccount T.CreateAccountRequest{..} = do
+      secretUUID <- liftIO $ T.RegistrationSecret <$> Random.randomIO
+      liftIO $ PendingAccounts.create dbFile
+        secretUUID
+        createAccountRequestUsername
+        createAccountRequestPassword
+        createAccountRequestRole
+        createAccountRequestEmail
+      liftIO $ sendVerifyEmail mailgunAPIKey
+        createAccountRequestUsername
+        createAccountRequestEmail
+        secretUUID
       pure NoContent
 
+    verifyAccount :: Text -> Text -> Handler NoContent
+    verifyAccount username secret = do
+      let mSecretUUID = T.RegistrationSecret <$> UUID.fromText secret in do
+        case mSecretUUID of
+          Nothing -> throwError err401 { errBody = "Invalid secret format" }
+          Just secretUUID -> do
+            mPendingAccount <- liftIO $ PendingAccounts.get dbFile (T.Username username)
+            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
+                  liftIO $ Accounts.transferFromPending dbFile pendingAccount
+                  pure NoContent
+                else
+                  throwError err401 { errBody = "The secret you provided is invalid" }
+
     deleteAccount :: T.SessionCookie -> Text -> Handler NoContent
     deleteAccount cookie username = adminsOnly cookie $ do
       liftIO $ Accounts.delete dbFile (T.Username username)