Check passwords in /login

TL;DR:
- Since POST /login is more rigorous, our accounts.csv needs to contain validly
  hashed passwords; you can use tests/create-accounts.sh to create dummy
  accounts

I still need to test the login flow and support:
- Tracking failed attempts (three maximum)
- Verifying accounts by sending emails to the users

data/accounts.csv

@@ -1,3 +1,3 @@
-mimi,testing,miriamwright@google.com,user,
+mimi,$2b$12$LynoGCNbe2RA1WWSiBEMVudJKs5dxnssY16rYmUyiwlSBIhHBOLbu,miriamwright@google.com,user,
-bill,testing,wpcarro@gmail.com,manager,
+bill,$2b$12$wzh1OyNsvrrGt4hI52Wkt.QDX0IdPKn5uuNSgO/9CWucxipt5wlMi,wpcarro@gmail.com,manager,
-wpcarro,testing,wpcarro@google.com,admin,
+wpcarro,$2b$12$3wbi4xfQmksLsu6GOKTbj.5WHywESATnXB4R8FJ55RSRLy6X9xA7u,wpcarro@google.com,admin,

src/API.hs

@@ -41,4 +41,4 @@ type API =
       -- Miscellaneous
       :<|> "login"
            :> ReqBody '[JSON] T.AccountCredentials
-           :> Post '[JSON] (Maybe T.Session)
+           :> Post '[JSON] NoContent

src/App.hs

@@ -19,6 +19,7 @@ import qualified Data.Text.Encoding as TE
 import qualified Types as T
 import qualified Accounts as Accounts
 import qualified Trips as Trips
+import qualified Sessions as Sessions
 --------------------------------------------------------------------------------
 
 server :: FilePath -> Server API
@@ -71,21 +72,21 @@ server dbFile = createAccountH
       pure NoContent
 
     -- TODO(wpcarro): Create and store a session token
-    login :: T.AccountCredentials -> IO (Maybe T.Session)
+    login :: T.AccountCredentials -> IO NoContent
-    login (T.AccountCredentials username password) =
+    login (T.AccountCredentials username password) = do
-      withConnection dbFile $ \conn -> do
+      mAccount <- Accounts.lookup dbFile username
-        res <- query conn "SELECT * FROM Accounts WHERE username = ?"
+      case mAccount of
-          (Only username)
+        Just account ->
-        case res of
+          if T.passwordsMatch password (T.accountPassword account) then do
-          [T.Account{T.accountUsername,T.accountPassword,T.accountRole}] ->
+            session <- Sessions.findOrCreate dbFile account
-            if T.passwordsMatch password accountPassword then
+            -- set cookie
-              pure $ Just (T.Session accountUsername accountRole)
+            pure NoContent
-            else
+          else
-              -- TODO(wpcarro): Catch and return errors over HTTP
+            -- TODO(wpcarro): Catch and return errors over HTTP
-              throwIO $ err401 { errBody = "Your credentials are invalid" }
+            throwIO $ err401 { errBody = "Your credentials are invalid" }
 
-          -- In this branch, the user didn't supply a known username.
+        -- In this branch, the user didn't supply a known username.
-          _ -> throwIO $ err401 { errBody = "Your credentials are invalid" }
+        Nothing -> throwIO $ err401 { errBody = "Your credentials are invalid" }
 
 mkApp :: FilePath -> IO Application
 mkApp dbFile = do

src/Types.hs

@@ -320,6 +320,11 @@ 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

tests/create-accounts.sh

@@ -0,0 +1,21 @@
+#!/usr/bin/env sh
+
+# This script populates the Accounts table over HTTP.
+
+http POST :3000/accounts \
+  username=mimi \
+  password=testing \
+  email=miriamwright@google.com \
+  role=user
+
+http POST :3000/accounts \
+  username=bill \
+  password=testing \
+  email=wpcarro@gmail.com \
+  role=manager
+
+http POST :3000/accounts \
+  username=wpcarro \
+  password=testing \
+  email=wpcarro@google.com \
+  role=admin