subtree(users/wpcarro): docking briefcase at '24f5a642'

git-subtree-dir: users/wpcarro
git-subtree-mainline: 464bbcb15c
git-subtree-split: 24f5a642af
Change-Id: I6105b3762b79126b3488359c95978cadb3efa789

users/wpcarro/assessments/tt/src/.ghci

@@ -0,0 +1,2 @@
+:set prompt "> "
+:set -Wall

users/wpcarro/assessments/tt/src/API.hs

@@ -0,0 +1,75 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE TypeOperators #-}
+--------------------------------------------------------------------------------
+module API where
+--------------------------------------------------------------------------------
+import Data.Text
+import Servant.API
+import Web.Cookie
+
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+-- | Once authenticated, users receive a SessionCookie.
+type SessionCookie = Header' '[Required] "Cookie" T.SessionCookie
+
+type API =
+      -- accounts: Create
+           "accounts"
+           :> Header "Cookie" T.SessionCookie
+           :> ReqBody '[JSON] T.CreateAccountRequest
+           :> Post '[JSON] NoContent
+      :<|> "verify"
+           :> ReqBody '[JSON] T.VerifyAccountRequest
+           :> Post '[JSON] NoContent
+      -- accounts: Read
+      -- accounts: Update
+      -- accounts: Delete
+      :<|> "accounts"
+           :> SessionCookie
+           :> QueryParam' '[Required] "username" Text
+           :> Delete '[JSON] NoContent
+      -- accounts: List
+      :<|> "accounts"
+           :> SessionCookie
+           :> Get '[JSON] [T.User]
+
+      -- trips: Create
+      :<|> "trips"
+           :> SessionCookie
+           :> ReqBody '[JSON] T.Trip
+           :> Post '[JSON] NoContent
+      -- trips: Read
+      -- trips: Update
+      :<|> "trips"
+           :> SessionCookie
+           :> ReqBody '[JSON] T.UpdateTripRequest
+           :> Put '[JSON] NoContent
+      -- trips: Delete
+      :<|> "trips"
+           :> SessionCookie
+           :> ReqBody '[JSON] T.TripPK
+           :> Delete '[JSON] NoContent
+      -- trips: List
+      :<|> "trips"
+           :> SessionCookie
+           :> Get '[JSON] [T.Trip]
+
+      -- Miscellaneous
+      :<|> "login"
+           :> ReqBody '[JSON] T.AccountCredentials
+           :> Post '[JSON] (Headers '[Header "Set-Cookie" SetCookie] T.Session)
+      :<|> "logout"
+           :> SessionCookie
+           :> Get '[JSON] (Headers '[Header "Set-Cookie" SetCookie] NoContent)
+      :<|> "unfreeze"
+           :> SessionCookie
+           :> ReqBody '[JSON] T.UnfreezeAccountRequest
+           :> Post '[JSON] NoContent
+      :<|> "invite"
+           :> SessionCookie
+           :> ReqBody '[JSON] T.InviteUserRequest
+           :> Post '[JSON] NoContent
+      :<|> "accept-invitation"
+           :> ReqBody '[JSON] T.AcceptInvitationRequest
+           :> Post '[JSON] NoContent

users/wpcarro/assessments/tt/src/Accounts.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE OverloadedStrings #-}
+--------------------------------------------------------------------------------
+module Accounts where
+--------------------------------------------------------------------------------
+import Database.SQLite.Simple
+
+import qualified PendingAccounts
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+-- | Delete the account in PendingAccounts and create on in Accounts.
+transferFromPending :: FilePath -> T.PendingAccount -> IO ()
+transferFromPending dbFile T.PendingAccount{..} = withConnection dbFile $
+  \conn -> withTransaction conn $ do
+    PendingAccounts.delete dbFile pendingAccountUsername
+    execute conn "INSERT INTO Accounts (username,password,email,role) VALUES (?,?,?,?)"
+      ( pendingAccountUsername
+      , pendingAccountPassword
+      , pendingAccountEmail
+      , pendingAccountRole
+      )
+
+-- | Create a new account in the Accounts table.
+create :: FilePath -> T.Username -> T.ClearTextPassword -> T.Email -> T.Role -> IO ()
+create dbFile username password email role = withConnection dbFile $ \conn -> do
+  hashed <- T.hashPassword password
+  execute conn "INSERT INTO Accounts (username,password,email,role) VALUES (?,?,?,?)"
+    (username, hashed, email, role)
+
+-- | Delete `username` from `dbFile`.
+delete :: FilePath -> T.Username -> IO ()
+delete dbFile username = withConnection dbFile $ \conn -> do
+  execute conn "DELETE FROM Accounts WHERE username = ?"
+    (Only username)
+
+-- | Attempt to find `username` in the Account table of `dbFile`.
+lookup :: FilePath -> T.Username -> IO (Maybe T.Account)
+lookup dbFile username = withConnection dbFile $ \conn -> do
+  res <- query conn "SELECT username,password,email,role,profilePicture FROM Accounts WHERE username = ?" (Only username)
+  case res of
+    [x] -> pure (Just x)
+    _ -> pure Nothing
+
+-- | Return a list of accounts with the sensitive data removed.
+list :: FilePath -> IO [T.User]
+list dbFile = withConnection dbFile $ \conn -> do
+  accounts <- query_ conn "SELECT username,password,email,role,profilePicture FROM Accounts"
+  pure $ T.userFromAccount <$> accounts

users/wpcarro/assessments/tt/src/App.hs

@@ -0,0 +1,270 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TypeApplications #-}
+--------------------------------------------------------------------------------
+module App where
+--------------------------------------------------------------------------------
+import Control.Monad.IO.Class (liftIO)
+import Data.String.Conversions (cs)
+import Data.Text (Text)
+import Servant
+import API
+import Utils
+import Web.Cookie
+
+import qualified Network.Wai.Handler.Warp as Warp
+import qualified Network.Wai.Middleware.Cors as Cors
+import qualified System.Random as Random
+import qualified Email as Email
+import qualified Data.UUID as UUID
+import qualified Types as T
+import qualified Accounts as Accounts
+import qualified Auth as Auth
+import qualified Trips as Trips
+import qualified Sessions as Sessions
+import qualified Invitations as Invitations
+import qualified LoginAttempts as LoginAttempts
+import qualified PendingAccounts as PendingAccounts
+--------------------------------------------------------------------------------
+
+err429 :: ServerError
+err429 = ServerError
+  { errHTTPCode = 429
+  , errReasonPhrase = "Too many requests"
+  , errBody = ""
+  , errHeaders = []
+  }
+
+-- | Send an email to recipient, `to`, with a secret code.
+sendVerifyEmail :: T.Config
+                -> T.Username
+                -> T.Email
+                -> T.RegistrationSecret
+                -> IO (Either Email.SendError Email.SendSuccess)
+sendVerifyEmail T.Config{..} (T.Username username) email (T.RegistrationSecret secretUUID) = do
+  Email.send mailgunAPIKey subject (cs body) email
+  where
+    subject = "Please confirm your account"
+    body =
+      let secret = secretUUID |> UUID.toString in
+        "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
+                -> T.Email
+                -> T.InvitationSecret
+                -> IO (Either Email.SendError Email.SendSuccess)
+sendInviteEmail T.Config{..} email@(T.Email to) (T.InvitationSecret secretUUID) = do
+  Email.send mailgunAPIKey subject (cs body) email
+  where
+    subject = "You've been invited!"
+    body =
+      let secret = secretUUID |> UUID.toString in
+        "To accept the invitation: POST /accept-invitation username=<username> password=<password> email=" ++ cs to ++ " secret=" ++ secret
+
+server :: T.Config -> Server API
+server config@T.Config{..} = createAccount
+                        :<|> verifyAccount
+                        :<|> deleteAccount
+                        :<|> listAccounts
+                        :<|> createTrip
+                        :<|> updateTrip
+                        :<|> deleteTrip
+                        :<|> listTrips
+                        :<|> login
+                        :<|> logout
+                        :<|> unfreezeAccount
+                        :<|> inviteUser
+                        :<|> acceptInvitation
+  where
+    -- Admit Admins + whatever the predicate `p` passes.
+    adminsAnd cookie p = Auth.assert dbFile cookie (\acct@T.Account{..} -> accountRole == T.Admin || p acct)
+    -- Admit Admins only.
+    adminsOnly cookie = adminsAnd cookie (const True)
+
+    -- TODO(wpcarro): Handle failed CONSTRAINTs instead of sending 500s
+    createAccount :: Maybe T.SessionCookie
+                  -> T.CreateAccountRequest
+                  -> Handler NoContent
+    createAccount mCookie T.CreateAccountRequest{..} =
+      case (mCookie, createAccountRequestRole) of
+        (_, T.RegularUser) ->
+          doCreateAccount
+        (Nothing, T.Manager) ->
+          throwError err401 { errBody = "Only admins can create Manager accounts" }
+        (Nothing, T.Admin) ->
+          throwError err401 { errBody = "Only admins can create Admin accounts" }
+        (Just cookie, _) ->
+          adminsAnd cookie (\T.Account{..} -> accountRole == T.Manager) doCreateAccount
+      where
+        doCreateAccount :: Handler NoContent
+        doCreateAccount = do
+          secretUUID <- liftIO $ T.RegistrationSecret <$> Random.randomIO
+          liftIO $ PendingAccounts.create dbFile
+            secretUUID
+            createAccountRequestUsername
+            createAccountRequestPassword
+            createAccountRequestRole
+            createAccountRequestEmail
+          res <- liftIO $ sendVerifyEmail config
+            createAccountRequestUsername
+            createAccountRequestEmail
+            secretUUID
+          case res of
+            Left _ -> undefined
+            Right _ -> pure NoContent
+
+    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 == verifyAccountRequestSecret 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)
+      pure NoContent
+
+    listAccounts :: T.SessionCookie -> Handler [T.User]
+    listAccounts cookie = adminsOnly cookie $ do
+      liftIO $ Accounts.list dbFile
+
+    createTrip :: T.SessionCookie -> T.Trip -> Handler NoContent
+    createTrip cookie trip@T.Trip{..} =
+      adminsAnd cookie (\T.Account{..} -> accountUsername == tripUsername) $ do
+        liftIO $ Trips.create dbFile trip
+        pure NoContent
+
+    updateTrip :: T.SessionCookie -> T.UpdateTripRequest -> Handler NoContent
+    updateTrip cookie updates@T.UpdateTripRequest{..} =
+      adminsAnd cookie (\T.Account{..} -> accountUsername == T.tripPKUsername updateTripRequestTripPK) $ do
+        mTrip <- liftIO $ Trips.get dbFile updateTripRequestTripPK
+        case mTrip of
+          Nothing -> throwError err400 { errBody = "tripKey is invalid" }
+          Just trip@T.Trip{..} -> do
+            -- TODO(wpcarro): Prefer function in Trips module that does this in a
+            -- DB transaction.
+            liftIO $ Trips.delete dbFile updateTripRequestTripPK
+            liftIO $ Trips.create dbFile (T.updateTrip updates trip)
+            pure NoContent
+
+    deleteTrip :: T.SessionCookie -> T.TripPK -> Handler NoContent
+    deleteTrip cookie tripPK@T.TripPK{..} =
+      adminsAnd cookie (\T.Account{..} -> accountUsername == tripPKUsername) $ do
+      liftIO $ Trips.delete dbFile tripPK
+      pure NoContent
+
+    listTrips :: T.SessionCookie -> Handler [T.Trip]
+    listTrips cookie = do
+      mAccount <- liftIO $ Auth.accountFromCookie dbFile cookie
+      case mAccount of
+        Nothing -> throwError err401 { errBody = "Your session cookie is invalid. Try logging out and logging back in." }
+        Just T.Account{..} ->
+          case accountRole of
+            T.Admin -> liftIO $ Trips.listAll dbFile
+            _ -> liftIO $ Trips.list dbFile accountUsername
+
+    login :: T.AccountCredentials
+          -> Handler (Headers '[Header "Set-Cookie" SetCookie] T.Session)
+    login (T.AccountCredentials username password) = do
+      mAccount <- liftIO $ Accounts.lookup dbFile username
+      case mAccount of
+        Just account@T.Account{..} -> do
+          mAttempts <- liftIO $ LoginAttempts.forUsername dbFile accountUsername
+          case mAttempts of
+            Nothing ->
+              if T.passwordsMatch password accountPassword then do
+                uuid <- liftIO $ Sessions.findOrCreate dbFile account
+                pure $ addHeader (Auth.mkCookie uuid)
+                  T.Session{ sessionUsername = accountUsername
+                           , sessionRole = accountRole
+                           }
+              else do
+                liftIO $ LoginAttempts.increment dbFile username
+                throwError err401 { errBody = "Your credentials are invalid" }
+            Just attempts ->
+              if attempts >= 3 then
+                throwError err429
+              else if T.passwordsMatch password accountPassword then do
+                uuid <- liftIO $ Sessions.findOrCreate dbFile account
+                pure $ addHeader (Auth.mkCookie uuid)
+                  T.Session{ sessionUsername = accountUsername
+                           , sessionRole = accountRole
+                           }
+              else do
+                liftIO $ LoginAttempts.increment dbFile username
+                throwError err401 { errBody = "Your credentials are invalid" }
+
+        -- In this branch, the user didn't supply a known username.
+        Nothing -> throwError err401 { errBody = "Your credentials are invalid" }
+
+    logout :: T.SessionCookie
+           -> Handler (Headers '[Header "Set-Cookie" SetCookie] NoContent)
+    logout cookie = do
+      case Auth.uuidFromCookie cookie of
+        Nothing ->
+          pure $ addHeader Auth.emptyCookie NoContent
+        Just uuid -> do
+          liftIO $ Sessions.delete dbFile uuid
+          pure $ addHeader Auth.emptyCookie NoContent
+
+    unfreezeAccount :: T.SessionCookie
+                    -> T.UnfreezeAccountRequest
+                    -> Handler NoContent
+    unfreezeAccount cookie T.UnfreezeAccountRequest{..} =
+      adminsAnd cookie (\T.Account{..} -> accountRole == T.Manager) $ do
+        liftIO $ LoginAttempts.reset dbFile unfreezeAccountRequestUsername
+        pure NoContent
+
+    inviteUser :: T.SessionCookie
+               -> T.InviteUserRequest
+               -> Handler NoContent
+    inviteUser cookie T.InviteUserRequest{..} = adminsOnly cookie $ do
+      secretUUID <- liftIO $ T.InvitationSecret <$> Random.randomIO
+      liftIO $ Invitations.create dbFile
+        secretUUID
+        inviteUserRequestEmail
+        inviteUserRequestRole
+      res <- liftIO $ sendInviteEmail config inviteUserRequestEmail secretUUID
+      case res of
+        Left _ -> undefined
+        Right _ -> pure NoContent
+
+    acceptInvitation :: T.AcceptInvitationRequest -> Handler NoContent
+    acceptInvitation T.AcceptInvitationRequest{..} = do
+      mInvitation <- liftIO $ Invitations.get dbFile acceptInvitationRequestEmail
+      case mInvitation of
+        Nothing -> throwError err404 { errBody = "No invitation for email" }
+        Just T.Invitation{..} ->
+          if invitationSecret == acceptInvitationRequestSecret then do
+            liftIO $ Accounts.create dbFile
+              acceptInvitationRequestUsername
+              acceptInvitationRequestPassword
+              invitationEmail
+              invitationRole
+            pure NoContent
+          else
+            throwError err401 { errBody = "You are not providing a valid secret" }
+
+run :: T.Config -> IO ()
+run config@T.Config{..} =
+  Warp.run 3000 (enforceCors $ serve (Proxy @ API) $ server config)
+  where
+    enforceCors = Cors.cors (const $ Just corsPolicy)
+    corsPolicy :: Cors.CorsResourcePolicy
+    corsPolicy =
+      Cors.simpleCorsResourcePolicy
+        { Cors.corsOrigins = Just ([cs configClient], True)
+        , Cors.corsMethods = Cors.simpleMethods ++ ["PUT", "PATCH", "DELETE", "OPTIONS"]
+        , Cors.corsRequestHeaders = Cors.simpleHeaders ++ ["Content-Type", "Authorization"]
+        }

users/wpcarro/assessments/tt/src/Auth.hs

@@ -0,0 +1,64 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+--------------------------------------------------------------------------------
+module Auth where
+--------------------------------------------------------------------------------
+import Control.Monad.IO.Class (liftIO)
+import Web.Cookie
+import Servant
+
+import qualified Data.UUID as UUID
+import qualified Sessions as Sessions
+import qualified Accounts as Accounts
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+-- | Return the UUID from a Session cookie.
+uuidFromCookie :: T.SessionCookie -> Maybe T.SessionUUID
+uuidFromCookie (T.SessionCookie cookies) = do
+  auth <- lookup "auth" cookies
+  uuid <- UUID.fromASCIIBytes auth
+  pure $ T.SessionUUID uuid
+
+-- | Attempt to return the account associated with `cookie`.
+accountFromCookie :: FilePath -> T.SessionCookie -> IO (Maybe T.Account)
+accountFromCookie dbFile cookie =
+  case uuidFromCookie cookie of
+    Nothing -> pure Nothing
+    Just uuid -> do
+      mSession <- Sessions.get dbFile uuid
+      case mSession of
+        Nothing -> pure Nothing
+        Just T.StoredSession{..} -> do
+          mAccount <- Accounts.lookup dbFile storedSessionUsername
+          case mAccount of
+            Nothing -> pure Nothing
+            Just x -> pure (Just x)
+
+-- | Create a new session cookie.
+mkCookie :: T.SessionUUID -> SetCookie
+mkCookie (T.SessionUUID uuid) =
+  defaultSetCookie
+    { setCookieName = "auth"
+    , setCookieValue = UUID.toASCIIBytes uuid
+    }
+
+-- | Use this to clear out the session cookie.
+emptyCookie :: SetCookie
+emptyCookie =
+  defaultSetCookie
+    { setCookieName = "auth"
+    , setCookieValue = ""
+    }
+
+-- | Throw a 401 error if the `predicate` fails.
+assert :: FilePath -> T.SessionCookie -> (T.Account -> Bool) -> Handler a -> Handler a
+assert dbFile cookie predicate handler = do
+  mRole <- liftIO $ accountFromCookie dbFile cookie
+  case mRole of
+    Nothing -> throwError err401 { errBody = "Missing valid session cookie" }
+    Just account ->
+      if predicate account then
+        handler
+      else
+        throwError err401 { errBody = "You are not authorized to access this resource" }

users/wpcarro/assessments/tt/src/Email.hs

@@ -0,0 +1,46 @@
+{-# LANGUAGE OverloadedStrings #-}
+--------------------------------------------------------------------------------
+module Email where
+--------------------------------------------------------------------------------
+import Data.Text
+import Data.String.Conversions (cs)
+import Utils
+
+import qualified Mail.Hailgun as MG
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+newtype SendSuccess = SendSuccess MG.HailgunSendResponse
+
+data SendError
+  = MessageError MG.HailgunErrorMessage
+  | ResponseError MG.HailgunErrorResponse
+
+-- | Attempt to send an email with `subject` and with message, `body`.
+send :: Text
+     -> Text
+     -> Text
+     -> T.Email
+     -> IO (Either SendError SendSuccess)
+send apiKey subject body (T.Email to) = do
+  case mkMsg of
+    Left e -> pure $ Left (MessageError e)
+    Right x -> do
+      res <- MG.sendEmail ctx x
+      case res of
+        Left e -> pure $ Left (ResponseError e)
+        Right y -> pure $ Right (SendSuccess y)
+  where
+    ctx = MG.HailgunContext { MG.hailgunDomain = "sandboxda5038873f924b50af2f82a0f05cffdf.mailgun.org"
+                            , MG.hailgunApiKey = cs apiKey
+                            , MG.hailgunProxy = Nothing
+                            }
+    mkMsg = MG.hailgunMessage
+            subject
+            (body |> cs |> MG.TextOnly)
+            "mailgun@sandboxda5038873f924b50af2f82a0f05cffdf.mailgun.org"
+            (MG.MessageRecipients { MG.recipientsTo = [cs to]
+                                  , MG.recipientsCC = []
+                                  , MG.recipientsBCC = []
+                                  })
+            []

users/wpcarro/assessments/tt/src/Invitations.hs

@@ -0,0 +1,21 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+--------------------------------------------------------------------------------
+module Invitations where
+--------------------------------------------------------------------------------
+import Database.SQLite.Simple
+
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+create :: FilePath -> T.InvitationSecret -> T.Email -> T.Role -> IO ()
+create dbFile secret email role = withConnection dbFile $ \conn -> do
+  execute conn "INSERT INTO Invitations (email,role,secret) VALUES (?,?,?)"
+    (email, role, secret)
+
+get :: FilePath -> T.Email -> IO (Maybe T.Invitation)
+get dbFile email = withConnection dbFile $ \conn -> do
+  res <- query conn "SELECT email,role,secret FROM Invitations WHERE email = ?" (Only email)
+  case res of
+    [x] -> pure (Just x)
+    _ -> pure Nothing

users/wpcarro/assessments/tt/src/LoginAttempts.hs

@@ -0,0 +1,30 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+--------------------------------------------------------------------------------
+module LoginAttempts where
+--------------------------------------------------------------------------------
+import Database.SQLite.Simple
+
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+reset :: FilePath -> T.Username -> IO ()
+reset dbFile username = withConnection dbFile $ \conn ->
+  execute conn "UPDATE LoginAttempts SET numAttempts = 0 WHERE username = ?"
+    (Only username)
+
+-- | Attempt to return the number of failed login attempts for
+-- `username`. Returns a Maybe in case `username` doesn't exist.
+forUsername :: FilePath -> T.Username -> IO (Maybe Integer)
+forUsername dbFile username = withConnection dbFile $ \conn -> do
+  res <- query conn "SELECT username,numAttempts FROM LoginAttempts WHERE username = ?"
+    (Only username)
+  case res of
+    [T.LoginAttempt{..}] -> pure (Just loginAttemptNumAttempts)
+    _  -> pure Nothing
+
+-- | INSERT a failed login attempt for `username` or UPDATE an existing entry.
+increment :: FilePath -> T.Username -> IO ()
+increment dbFile username = withConnection dbFile $ \conn ->
+  execute conn "INSERT INTO LoginAttempts (username,numAttempts) VALUES (?,?) ON CONFLICT (username) DO UPDATE SET numAttempts = numAttempts + 1"
+    (username, 1 :: Integer)

users/wpcarro/assessments/tt/src/Main.hs

@@ -0,0 +1,13 @@
+--------------------------------------------------------------------------------
+module Main where
+--------------------------------------------------------------------------------
+import qualified App
+import qualified System.Envy as Envy
+--------------------------------------------------------------------------------
+
+main :: IO ()
+main = do
+  mEnv <- Envy.decodeEnv
+  case mEnv of
+    Left err -> putStrLn err
+    Right env -> App.run env

users/wpcarro/assessments/tt/src/PendingAccounts.hs

@@ -0,0 +1,32 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+--------------------------------------------------------------------------------
+module PendingAccounts where
+--------------------------------------------------------------------------------
+import Database.SQLite.Simple
+
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+create :: FilePath
+       -> T.RegistrationSecret
+       -> T.Username
+       -> T.ClearTextPassword
+       -> T.Role
+       -> T.Email
+       -> IO ()
+create dbFile secret username password role email = withConnection dbFile $ \conn -> do
+  hashed <- T.hashPassword password
+  execute conn "INSERT INTO PendingAccounts (secret,username,password,role,email) VALUES (?,?,?,?,?)"
+    (secret, username, hashed, role, email)
+
+get :: FilePath -> T.Username -> IO (Maybe T.PendingAccount)
+get dbFile username = withConnection dbFile $ \conn -> do
+  res <- query conn "SELECT secret,username,password,role,email FROM PendingAccounts WHERE username = ?" (Only username)
+  case res of
+    [x] -> pure (Just x)
+    _ -> pure Nothing
+
+delete :: FilePath -> T.Username -> IO ()
+delete dbFile username = withConnection dbFile $ \conn ->
+  execute conn "DELETE FROM PendingAccounts WHERE username = ?" (Only username)

users/wpcarro/assessments/tt/src/Sessions.hs

@@ -0,0 +1,74 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+--------------------------------------------------------------------------------
+module Sessions where
+--------------------------------------------------------------------------------
+import Database.SQLite.Simple
+
+import qualified Data.Time.Clock as Clock
+import qualified Types as T
+import qualified System.Random as Random
+--------------------------------------------------------------------------------
+
+-- | Return True if `session` was created at most three hours ago.
+isValid :: T.StoredSession -> IO Bool
+isValid session = do
+  t1 <- Clock.getCurrentTime
+  let t0 = T.storedSessionTsCreated session in
+    pure $ Clock.diffUTCTime t1 t0 <= 3 * 60 * 60
+
+-- | Lookup the session by UUID.
+get :: FilePath -> T.SessionUUID -> IO (Maybe T.StoredSession)
+get dbFile uuid = withConnection dbFile $ \conn -> do
+  res <- query conn "SELECT uuid,username,tsCreated FROM Sessions WHERE uuid = ?" (Only uuid)
+  case res of
+    [x] -> pure (Just x)
+    _ -> pure Nothing
+
+-- | Lookup the session stored under `username` in `dbFile`.
+find :: FilePath -> T.Username -> IO (Maybe T.StoredSession)
+find dbFile username = withConnection dbFile $ \conn -> do
+  res <- query conn "SELECT uuid,username,tsCreated FROM Sessions WHERE username = ?" (Only username)
+  case res of
+    [x] -> pure (Just x)
+    _ -> pure Nothing
+
+-- | Create a session under the `username` key in `dbFile`.
+create :: FilePath -> T.Username -> IO T.SessionUUID
+create dbFile username = withConnection dbFile $ \conn -> do
+  now <- Clock.getCurrentTime
+  uuid <- Random.randomIO
+  execute conn "INSERT INTO Sessions (uuid,username,tsCreated) VALUES (?,?,?)"
+    (T.SessionUUID uuid, username, now)
+  pure (T.SessionUUID uuid)
+
+-- | Reset the tsCreated field to the current time to ensure the token is valid.
+refresh :: FilePath -> T.SessionUUID -> IO ()
+refresh dbFile uuid = withConnection dbFile $ \conn -> do
+  now <- Clock.getCurrentTime
+  execute conn "UPDATE Sessions SET tsCreated = ? WHERE uuid = ?"
+    (now, uuid)
+  pure ()
+
+-- | Delete the session under `username` from `dbFile`.
+delete :: FilePath -> T.SessionUUID -> IO ()
+delete dbFile uuid = withConnection dbFile $ \conn ->
+  execute conn "DELETE FROM Sessions WHERE uuid = ?" (Only uuid)
+
+-- | Find or create a session in the Sessions table. If a session exists,
+-- refresh the token's validity.
+findOrCreate :: FilePath -> T.Account -> IO T.SessionUUID
+findOrCreate dbFile account =
+  let username = T.accountUsername account in do
+    mSession <- find dbFile username
+    case mSession of
+      Nothing -> create dbFile username
+      Just session ->
+        let uuid = T.storedSessionUUID session in do
+          refresh dbFile uuid
+          pure uuid
+
+-- | Return a list of all sessions in the Sessions table.
+list :: FilePath -> IO [T.StoredSession]
+list dbFile = withConnection dbFile $ \conn ->
+  query_ conn "SELECT uuid,username,tsCreated FROM Sessions"

users/wpcarro/assessments/tt/src/Trips.hs

@@ -0,0 +1,42 @@
+{-# LANGUAGE OverloadedStrings #-}
+--------------------------------------------------------------------------------
+module Trips where
+--------------------------------------------------------------------------------
+import Database.SQLite.Simple
+import Utils
+
+import qualified Types as T
+--------------------------------------------------------------------------------
+
+-- | Create a new `trip` in `dbFile`.
+create :: FilePath -> T.Trip -> IO ()
+create dbFile trip = withConnection dbFile $ \conn ->
+  execute conn "INSERT INTO Trips (username,destination,startDate,endDate,comment) VALUES (?,?,?,?,?)"
+    (trip |> T.tripFields)
+
+-- | Attempt to get the trip record from `dbFile` under `tripKey`.
+get :: FilePath -> T.TripPK -> IO (Maybe T.Trip)
+get dbFile tripKey = withConnection dbFile $ \conn -> do
+  res <- query conn "SELECT username,destination,startDate,endDate,comment FROM Trips WHERE username = ? AND destination = ? AND startDate = ? LIMIT 1"
+    (T.tripPKFields tripKey)
+  case res of
+    [x] -> pure (Just x)
+    _ -> pure Nothing
+
+-- | Delete a trip from `dbFile` using its `tripKey` Primary Key.
+delete :: FilePath -> T.TripPK -> IO ()
+delete dbFile tripKey =
+  withConnection dbFile $ \conn -> do
+    execute conn "DELETE FROM Trips WHERE username = ? AND destination = ? and startDate = ?"
+      (T.tripPKFields tripKey)
+
+-- | Return a list of all of the trips in `dbFile`.
+listAll :: FilePath -> IO [T.Trip]
+listAll dbFile = withConnection dbFile $ \conn ->
+  query_ conn "SELECT username,destination,startDate,endDate,comment FROM Trips ORDER BY date(startDate) ASC"
+
+-- | Return a list of all of the trips in `dbFile`.
+list :: FilePath -> T.Username -> IO [T.Trip]
+list dbFile username = withConnection dbFile $ \conn ->
+  query conn "SELECT username,destination,startDate,endDate,comment FROM Trips WHERE username = ? ORDER BY date(startDate) ASC"
+    (Only username)

users/wpcarro/assessments/tt/src/Types.hs

@@ -0,0 +1,544 @@
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE NamedFieldPuns #-}
+--------------------------------------------------------------------------------
+module Types where
+--------------------------------------------------------------------------------
+import Data.Aeson
+import Utils
+import Data.Text
+import Data.Typeable
+import Database.SQLite.Simple
+import Database.SQLite.Simple.Ok
+import Database.SQLite.Simple.FromField
+import Database.SQLite.Simple.ToField
+import GHC.Generics
+import Web.Cookie
+import Servant.API
+import System.Envy (FromEnv, fromEnv, env)
+import Crypto.Random.Types (MonadRandom)
+
+import qualified Data.Time.Calendar as Calendar
+import qualified Crypto.KDF.BCrypt as BC
+import qualified Data.Time.Clock as Clock
+import qualified Data.ByteString.Char8 as B
+import qualified Data.ByteString as BS
+import qualified Data.Text.Encoding as TE
+import qualified Data.Maybe as M
+import qualified Data.UUID as UUID
+--------------------------------------------------------------------------------
+
+-- | Top-level application configuration.
+data Config = Config
+  { mailgunAPIKey :: Text
+  , dbFile :: FilePath
+  , configClient :: Text
+  , configServer :: Text
+  } deriving (Eq, Show)
+
+instance FromEnv Config where
+  fromEnv _ = do
+    mailgunAPIKey <- env "MAILGUN_API_KEY"
+    dbFile <- env "DB_FILE"
+    configClient <- env "CLIENT"
+    configServer <- env "SERVER"
+    pure Config {..}
+
+-- TODO(wpcarro): Properly handle NULL for columns like profilePicture.
+forNewtype :: (Typeable b) => (Text -> b) -> FieldParser b
+forNewtype wrapper y =
+  case fieldData y of
+    (SQLText x) -> Ok (wrapper x)
+    x -> returnError ConversionFailed y ("We expected SQLText, but we received: " ++ show x)
+
+newtype Username = Username Text
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Username
+instance FromJSON Username
+
+instance ToField Username where
+  toField (Username x) = SQLText x
+
+instance FromField Username where
+  fromField = forNewtype Username
+
+newtype HashedPassword = HashedPassword BS.ByteString
+  deriving (Eq, Show, Generic)
+
+instance ToField HashedPassword where
+  toField (HashedPassword x) = SQLText (TE.decodeUtf8 x)
+
+instance FromField HashedPassword where
+  fromField y =
+    case fieldData y of
+      (SQLText x) -> x |> TE.encodeUtf8 |> HashedPassword |> Ok
+      x -> returnError ConversionFailed y ("We expected SQLText, but we received: " ++ show x)
+
+newtype ClearTextPassword = ClearTextPassword Text
+  deriving (Eq, Show, Generic)
+
+instance ToJSON ClearTextPassword
+instance FromJSON ClearTextPassword
+
+instance ToField ClearTextPassword where
+  toField (ClearTextPassword x) = SQLText x
+
+instance FromField ClearTextPassword where
+  fromField = forNewtype ClearTextPassword
+
+newtype Email = Email Text
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Email
+instance FromJSON Email
+
+instance ToField Email where
+  toField (Email x) = SQLText x
+
+instance FromField Email where
+  fromField = forNewtype Email
+
+data Role = RegularUser | Manager | Admin
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Role where
+  toJSON RegularUser = "user"
+  toJSON Manager = "manager"
+  toJSON Admin = "admin"
+
+instance FromJSON Role where
+  parseJSON = withText "Role" $ \x ->
+    case x of
+      "user" -> pure RegularUser
+      "manager" -> pure Manager
+      "admin" -> pure Admin
+      _ -> fail "Expected \"user\" or \"manager\" or \"admin\""
+
+instance ToField Role where
+  toField RegularUser = SQLText "user"
+  toField Manager = SQLText "manager"
+  toField Admin = SQLText "admin"
+
+instance FromField Role where
+  fromField y =
+    case fieldData y of
+      (SQLText "user") -> Ok RegularUser
+      (SQLText "manager") -> Ok Manager
+      (SQLText "admin") -> Ok Admin
+      x -> returnError ConversionFailed y ("We expected user, manager, admin, but we received: " ++ show x)
+
+-- TODO(wpcarro): Prefer Data.ByteString instead of Text
+newtype ProfilePicture = ProfilePicture Text
+  deriving (Eq, Show, Generic)
+
+instance ToJSON ProfilePicture
+instance FromJSON ProfilePicture
+
+instance ToField ProfilePicture where
+  toField (ProfilePicture x) = SQLText x
+
+instance FromField ProfilePicture where
+  fromField = forNewtype ProfilePicture
+
+data Account = Account
+  { accountUsername :: Username
+  , accountPassword :: HashedPassword
+  , accountEmail :: Email
+  , accountRole :: Role
+  , accountProfilePicture :: Maybe ProfilePicture
+  } deriving (Eq, Show, Generic)
+
+-- | Return a tuple with all of the fields for an Account record to use for SQL.
+accountFields :: Account -> (Username, HashedPassword, Email, Role, Maybe ProfilePicture)
+accountFields (Account {..})
+  = ( accountUsername
+    , accountPassword
+    , accountEmail
+    , accountRole
+    , accountProfilePicture
+    )
+
+instance FromRow Account where
+  fromRow = do
+    accountUsername <- field
+    accountPassword <- field
+    accountEmail <- field
+    accountRole <- field
+    accountProfilePicture <- field
+    pure Account{..}
+
+data Session = Session
+  { sessionUsername :: Username
+  , sessionRole :: Role
+  } deriving (Eq, Show)
+
+instance ToJSON Session where
+  toJSON (Session username role) =
+    object [ "username" .= username
+           , "role" .= role
+           ]
+
+newtype Comment = Comment Text
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Comment
+instance FromJSON Comment
+
+instance ToField Comment where
+  toField (Comment x) = SQLText x
+
+instance FromField Comment where
+  fromField = forNewtype Comment
+
+newtype Destination = Destination Text
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Destination
+instance FromJSON Destination
+
+instance ToField Destination where
+  toField (Destination x) = SQLText x
+
+instance FromField Destination where
+  fromField = forNewtype Destination
+
+newtype Year = Year Integer deriving (Eq, Show)
+newtype Month = Month Integer deriving (Eq, Show)
+newtype Day = Day Integer deriving (Eq, Show)
+data Date = Date
+  { dateYear :: Year
+  , dateMonth :: Month
+  , dateDay :: Day
+  } deriving (Eq, Show)
+
+data Trip = Trip
+  { tripUsername :: Username
+  , tripDestination :: Destination
+  , tripStartDate :: Calendar.Day
+  , tripEndDate :: Calendar.Day
+  , tripComment :: Comment
+  } deriving (Eq, Show, Generic)
+
+instance FromRow Trip where
+  fromRow = do
+    tripUsername <- field
+    tripDestination <- field
+    tripStartDate <- field
+    tripEndDate <- field
+    tripComment <- field
+    pure Trip{..}
+
+-- | The fields used as the Primary Key for a Trip entry.
+data TripPK = TripPK
+  { tripPKUsername :: Username
+  , tripPKDestination :: Destination
+  , tripPKStartDate :: Calendar.Day
+  } deriving (Eq, Show, Generic)
+
+tripPKFields :: TripPK -> (Username, Destination, Calendar.Day)
+tripPKFields (TripPK{..})
+  = (tripPKUsername, tripPKDestination, tripPKStartDate)
+
+instance FromJSON TripPK where
+  parseJSON = withObject "TripPK" $ \x -> do
+    tripPKUsername    <- x .: "username"
+    tripPKDestination <- x .: "destination"
+    tripPKStartDate   <- x .: "startDate"
+    pure TripPK{..}
+
+-- | Return the tuple representation of a Trip record for SQL.
+tripFields :: Trip
+           -> (Username, Destination, Calendar.Day, Calendar.Day, Comment)
+tripFields (Trip{..})
+  = ( tripUsername
+    , tripDestination
+    , tripStartDate
+    , tripEndDate
+    , tripComment
+    )
+
+instance ToJSON Trip where
+  toJSON (Trip username destination startDate endDate comment) =
+    object [ "username" .= username
+           , "destination" .= destination
+           , "startDate" .= startDate
+           , "endDate" .= endDate
+           , "comment" .= comment
+           ]
+
+instance FromJSON Trip where
+  parseJSON = withObject "Trip" $ \x -> do
+    tripUsername    <- x .: "username"
+    tripDestination <- x .: "destination"
+    tripStartDate   <- x .: "startDate"
+    tripEndDate     <- x .: "endDate"
+    tripComment     <- x .: "comment"
+    pure Trip{..}
+
+-- | Users and Accounts both refer to the same underlying entities; however,
+-- Users model the user-facing Account details, hiding sensitive details like
+-- passwords and emails.
+data User = User
+  { userUsername :: Username
+  , userProfilePicture :: Maybe ProfilePicture
+  , userRole :: Role
+  } deriving (Eq, Show, Generic)
+
+instance ToJSON User where
+  toJSON (User username profilePicture role) =
+    object [ "username" .= username
+           , "profilePicture" .= profilePicture
+           , "role" .= role
+           ]
+
+userFromAccount :: Account -> User
+userFromAccount account =
+  User { userUsername = accountUsername account
+       , userProfilePicture = accountProfilePicture account
+       , userRole = accountRole account
+       }
+
+-- | This is the data that a user needs to supply to authenticate with the
+-- application.
+data AccountCredentials = AccountCredentials
+  { accountCredentialsUsername :: Username
+  , accountCredentialsPassword :: ClearTextPassword
+  } deriving (Eq, Show, Generic)
+
+instance FromJSON AccountCredentials where
+  parseJSON = withObject "AccountCredentials" $ \x -> do
+    accountCredentialsUsername <- x.: "username"
+    accountCredentialsPassword <- x.: "password"
+    pure AccountCredentials{..}
+
+
+-- | Hash password `x`.
+hashPassword :: (MonadRandom m) => ClearTextPassword -> m HashedPassword
+hashPassword (ClearTextPassword x) = do
+  hashed <- BC.hashPassword 12 (x |> unpack |> B.pack)
+  pure $ HashedPassword hashed
+
+-- | Return True if the cleartext password matches the hashed password.
+passwordsMatch :: ClearTextPassword -> HashedPassword -> Bool
+passwordsMatch (ClearTextPassword clear) (HashedPassword hashed) =
+  BC.validatePassword (clear |> unpack |> B.pack) hashed
+
+data CreateAccountRequest = CreateAccountRequest
+  { createAccountRequestUsername :: Username
+  , createAccountRequestPassword :: ClearTextPassword
+  , createAccountRequestEmail :: Email
+  , createAccountRequestRole :: Role
+  } deriving (Eq, Show)
+
+instance FromJSON CreateAccountRequest where
+  parseJSON = withObject "CreateAccountRequest" $ \x -> do
+    createAccountRequestUsername <- x .: "username"
+    createAccountRequestPassword <- x .: "password"
+    createAccountRequestEmail <- x .: "email"
+    createAccountRequestRole <- x .: "role"
+    pure $ CreateAccountRequest{..}
+
+createAccountRequestFields :: CreateAccountRequest
+                           -> (Username, ClearTextPassword, Email, Role)
+createAccountRequestFields CreateAccountRequest{..} =
+  ( createAccountRequestUsername
+  , createAccountRequestPassword
+  , createAccountRequestEmail
+  , createAccountRequestRole
+  )
+
+newtype SessionUUID = SessionUUID UUID.UUID
+  deriving (Eq, Show, Generic)
+
+instance FromField SessionUUID where
+  fromField y =
+    case fieldData y of
+      (SQLText x) ->
+        case UUID.fromText x of
+          Nothing -> returnError ConversionFailed y ("Could not convert to UUID: " ++ show x)
+          Just uuid -> Ok $ SessionUUID uuid
+      _ -> returnError ConversionFailed y "Expected SQLText for SessionUUID, but we received"
+
+instance ToField SessionUUID where
+  toField (SessionUUID uuid) =
+    uuid |> UUID.toText |> SQLText
+
+data StoredSession = StoredSession
+  { storedSessionUUID :: SessionUUID
+  , storedSessionUsername :: Username
+  , storedSessionTsCreated :: Clock.UTCTime
+  } deriving (Eq, Show, Generic)
+
+instance FromRow StoredSession where
+  fromRow = do
+    storedSessionUUID <- field
+    storedSessionUsername <- field
+    storedSessionTsCreated <- field
+    pure StoredSession {..}
+
+data LoginAttempt = LoginAttempt
+  { loginAttemptUsername :: Username
+  , loginAttemptNumAttempts :: Integer
+  } deriving (Eq, Show)
+
+instance FromRow LoginAttempt where
+  fromRow = do
+    loginAttemptUsername <- field
+    loginAttemptNumAttempts <- field
+    pure LoginAttempt {..}
+
+newtype SessionCookie = SessionCookie Cookies
+
+instance FromHttpApiData SessionCookie where
+  parseHeader x =
+    x |> parseCookies |> SessionCookie |> pure
+  parseQueryParam x =
+    x |> TE.encodeUtf8 |> parseCookies |> SessionCookie |> pure
+
+newtype RegistrationSecret = RegistrationSecret UUID.UUID
+  deriving (Eq, Show, Generic)
+
+instance FromHttpApiData RegistrationSecret where
+  parseQueryParam x =
+    case UUID.fromText x of
+      Nothing -> Left x
+      Just uuid -> Right (RegistrationSecret uuid)
+
+instance FromField RegistrationSecret where
+  fromField y =
+    case fieldData y of
+      (SQLText x) ->
+        case UUID.fromText x of
+          Nothing -> returnError ConversionFailed y ("Could not convert text to UUID: " ++ show x)
+          Just uuid -> Ok $ RegistrationSecret uuid
+      _ -> returnError ConversionFailed y "Field data is not SQLText, which is what we expect"
+
+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
+  , pendingAccountPassword :: HashedPassword
+  , pendingAccountRole :: Role
+  , pendingAccountEmail :: Email
+  } deriving (Eq, Show)
+
+instance FromRow PendingAccount where
+  fromRow = do
+    pendingAccountSecret <- field
+    pendingAccountUsername <- field
+    pendingAccountPassword <- field
+    pendingAccountRole <- field
+    pendingAccountEmail <- field
+    pure PendingAccount {..}
+
+data UpdateTripRequest = UpdateTripRequest
+  { updateTripRequestTripPK :: TripPK
+  , updateTripRequestDestination :: Maybe Destination
+  , updateTripRequestStartDate :: Maybe Calendar.Day
+  , updateTripRequestEndDate :: Maybe Calendar.Day
+  , updateTripRequestComment :: Maybe Comment
+  } deriving (Eq, Show)
+
+instance FromJSON UpdateTripRequest where
+  parseJSON = withObject "UpdateTripRequest" $ \x -> do
+    updateTripRequestTripPK <- x .: "tripKey"
+    -- the following four fields might not be present
+    updateTripRequestDestination <- x .:? "destination"
+    updateTripRequestStartDate   <- x .:? "startDate"
+    updateTripRequestEndDate     <- x .:? "endDate"
+    updateTripRequestComment     <- x .:? "comment"
+    pure UpdateTripRequest{..}
+
+-- | Apply the updates in the UpdateTripRequest to Trip.
+updateTrip :: UpdateTripRequest -> Trip -> Trip
+updateTrip UpdateTripRequest{..} Trip{..} = Trip
+  { tripUsername    = tripUsername
+  , tripDestination = M.fromMaybe tripDestination updateTripRequestDestination
+  , tripStartDate   = M.fromMaybe tripStartDate updateTripRequestStartDate
+  , tripEndDate     = M.fromMaybe tripEndDate updateTripRequestEndDate
+  , tripComment     = M.fromMaybe tripComment updateTripRequestComment
+  }
+
+data UnfreezeAccountRequest = UnfreezeAccountRequest
+  { unfreezeAccountRequestUsername :: Username
+  } deriving (Eq, Show)
+
+instance FromJSON UnfreezeAccountRequest where
+  parseJSON = withObject "UnfreezeAccountRequest" $ \x -> do
+    unfreezeAccountRequestUsername <- x .: "username"
+    pure UnfreezeAccountRequest{..}
+
+data InviteUserRequest = InviteUserRequest
+  { inviteUserRequestEmail :: Email
+  , inviteUserRequestRole :: Role
+  } deriving (Eq, Show)
+
+instance FromJSON InviteUserRequest where
+  parseJSON = withObject "InviteUserRequest" $ \x -> do
+    inviteUserRequestEmail <- x .: "email"
+    inviteUserRequestRole <- x .: "role"
+    pure InviteUserRequest{..}
+
+newtype InvitationSecret = InvitationSecret UUID.UUID
+  deriving (Eq, Show, Generic)
+
+instance ToJSON InvitationSecret
+instance FromJSON InvitationSecret
+
+instance ToField InvitationSecret where
+  toField (InvitationSecret secretUUID) =
+    secretUUID |> UUID.toText |> SQLText
+
+instance FromField InvitationSecret where
+  fromField y =
+    case fieldData y of
+      (SQLText x) ->
+        case UUID.fromText x of
+          Nothing -> returnError ConversionFailed y ("Could not convert text to UUID: " ++ show x)
+          Just z -> Ok $ InvitationSecret z
+      _ -> returnError ConversionFailed y "Field data is not SQLText, which is what we expect"
+
+data Invitation = Invitation
+  { invitationEmail :: Email
+  , invitationRole :: Role
+  , invitationSecret :: InvitationSecret
+  } deriving (Eq, Show)
+
+instance FromRow Invitation where
+  fromRow = Invitation <$> field
+                       <*> field
+                       <*> field
+
+data AcceptInvitationRequest = AcceptInvitationRequest
+  { acceptInvitationRequestUsername :: Username
+  , acceptInvitationRequestPassword :: ClearTextPassword
+  , acceptInvitationRequestEmail :: Email
+  , acceptInvitationRequestSecret :: InvitationSecret
+  } deriving (Eq, Show)
+
+instance FromJSON AcceptInvitationRequest where
+  parseJSON = withObject "AcceptInvitationRequest" $ \x -> do
+    acceptInvitationRequestUsername <- x .: "username"
+    acceptInvitationRequestPassword <- x .: "password"
+    acceptInvitationRequestEmail <- x .: "email"
+    acceptInvitationRequestSecret <- x .: "secret"
+    pure AcceptInvitationRequest{..}

users/wpcarro/assessments/tt/src/Utils.hs

@@ -0,0 +1,9 @@
+--------------------------------------------------------------------------------
+module Utils where
+--------------------------------------------------------------------------------
+import Data.Function ((&))
+--------------------------------------------------------------------------------
+
+-- | Prefer this operator to the ampersand for stylistic reasons.
+(|>) :: a -> (a -> b) -> b
+(|>) = (&)

users/wpcarro/assessments/tt/src/init.sql

@@ -0,0 +1,67 @@
+-- Run `.read init.sql` from within a SQLite3 REPL to initialize the tables we
+-- need for this application. This will erase all current entries, so use with
+-- caution.
+-- Make sure to set `PRAGMA foreign_keys = on;` when transacting with the
+-- database.
+
+BEGIN TRANSACTION;
+
+DROP TABLE IF EXISTS Accounts;
+DROP TABLE IF EXISTS Trips;
+DROP TABLE IF EXISTS Sessions;
+DROP TABLE IF EXISTS LoginAttempts;
+DROP TABLE IF EXISTS PendingAccounts;
+DROP TABLE IF EXISTS Invitations;
+
+CREATE TABLE Accounts (
+  username TEXT CHECK(LENGTH(username) > 0) NOT NULL,
+  password TEXT CHECK(LENGTH(password) > 0) NOT NULL,
+  email TEXT CHECK(LENGTH(email) > 0) NOT NULL UNIQUE,
+  role TEXT CHECK(role IN ('user', 'manager', 'admin')) NOT NULL,
+  profilePicture BLOB,
+  PRIMARY KEY (username)
+);
+
+CREATE TABLE Trips (
+  username TEXT NOT NULL,
+  destination TEXT CHECK(LENGTH(destination) > 0) NOT NULL,
+  startDate TEXT CHECK(LENGTH(startDate) == 10) NOT NULL, -- 'YYYY-MM-DD'
+  endDate TEXT CHECK(LENGTH(endDate) == 10) NOT NULL, -- 'YYYY-MM-DD'
+  comment TEXT NOT NULL,
+  PRIMARY KEY (username, destination, startDate),
+  FOREIGN KEY (username) REFERENCES Accounts ON DELETE CASCADE
+);
+
+CREATE TABLE Sessions (
+  uuid TEXT CHECK(LENGTH(uuid) == 36) NOT NULL,
+  username TEXT NOT NULL UNIQUE,
+  -- TODO(wpcarro): Add a LENGTH CHECK here
+  tsCreated TEXT NOT NULL, -- 'YYYY-MM-DD HH:MM:SS'
+  PRIMARY KEY (uuid),
+  FOREIGN KEY (username) REFERENCES Accounts ON DELETE CASCADE
+);
+
+CREATE TABLE LoginAttempts (
+  username TEXT NOT NULL UNIQUE,
+  numAttempts INTEGER NOT NULL,
+  PRIMARY KEY (username),
+  FOREIGN KEY (username) REFERENCES Accounts ON DELETE CASCADE
+);
+
+CREATE TABLE PendingAccounts (
+  secret TEXT CHECK(LENGTH(secret) == 36) NOT NULL,
+  username TEXT CHECK(LENGTH(username) > 0) NOT NULL,
+  password TEXT CHECK(LENGTH(password) > 0) NOT NULL,
+  role TEXT CHECK(role IN ('user', 'manager', 'admin')) NOT NULL,
+  email TEXT CHECK(LENGTH(email) > 0) NOT NULL UNIQUE,
+  PRIMARY KEY (username)
+);
+
+CREATE TABLE Invitations (
+  email TEXT CHECK(LENGTH(email) > 0) NOT NULL UNIQUE,
+  role TEXT CHECK(role IN ('user', 'manager', 'admin')) NOT NULL,
+  secret TEXT CHECK(LENGTH(secret) == 36) NOT NULL,
+  PRIMARY KEY (email)
+);
+
+COMMIT;