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

5 files changed, 45 insertions, 18 deletions

diff --git a/data/accounts.csv b/data/accounts.csv
index 51af23eec65e..1f8b01582c17 100644
--- a/data/accounts.csv
+++ b/data/accounts.csv
@@ -1,3 +1,3 @@
-mimi,testing,miriamwright@google.com,user,
-bill,testing,wpcarro@gmail.com,manager,
-wpcarro,testing,wpcarro@google.com,admin,
\ No newline at end of file
+mimi,$2b$12$LynoGCNbe2RA1WWSiBEMVudJKs5dxnssY16rYmUyiwlSBIhHBOLbu,miriamwright@google.com,user,
+bill,$2b$12$wzh1OyNsvrrGt4hI52Wkt.QDX0IdPKn5uuNSgO/9CWucxipt5wlMi,wpcarro@gmail.com,manager,
+wpcarro,$2b$12$3wbi4xfQmksLsu6GOKTbj.5WHywESATnXB4R8FJ55RSRLy6X9xA7u,wpcarro@google.com,admin,
\ No newline at end of file
diff --git a/src/API.hs b/src/API.hs
index 9ae618cd3029..c84da5aef917 100644
--- a/src/API.hs
+++ b/src/API.hs
@@ -41,4 +41,4 @@ type API =
       -- Miscellaneous
       :<|> "login"
            :> ReqBody '[JSON] T.AccountCredentials
-           :> Post '[JSON] (Maybe T.Session)
+           :> Post '[JSON] NoContent
diff --git a/src/App.hs b/src/App.hs
index 929d16520c34..786820f097a3 100644
--- a/src/App.hs
+++ b/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 username password) =
-      withConnection dbFile $ \conn -> do
-        res <- query conn "SELECT * FROM Accounts WHERE username = ?"
-          (Only username)
-        case res of
-          [T.Account{T.accountUsername,T.accountPassword,T.accountRole}] ->
-            if T.passwordsMatch password accountPassword then
-              pure $ Just (T.Session accountUsername accountRole)
-            else
-              -- TODO(wpcarro): Catch and return errors over HTTP
-              throwIO $ err401 { errBody = "Your credentials are invalid" }
+    login :: T.AccountCredentials -> IO NoContent
+    login (T.AccountCredentials username password) = do
+      mAccount <- Accounts.lookup dbFile username
+      case mAccount of
+        Just account ->
+          if T.passwordsMatch password (T.accountPassword account) then do
+            session <- Sessions.findOrCreate dbFile account
+            -- set cookie
+            pure NoContent
+          else
+            -- TODO(wpcarro): Catch and return errors over HTTP
+            throwIO $ err401 { errBody = "Your credentials are invalid" }
 
-          -- In this branch, the user didn't supply a known username.
-          _ -> throwIO $ err401 { errBody = "Your credentials are invalid" }
+        -- In this branch, the user didn't supply a known username.
+        Nothing -> throwIO $ err401 { errBody = "Your credentials are invalid" }
 
 mkApp :: FilePath -> IO Application
 mkApp dbFile = do
diff --git a/src/Types.hs b/src/Types.hs
index 96cfae2c28cf..25f7d8996a36 100644
--- a/src/Types.hs
+++ b/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
diff --git a/tests/create-accounts.sh b/tests/create-accounts.sh
new file mode 100755
index 000000000000..8c2a66bc8bd7
--- /dev/null
+++ b/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