3 files changed, 21 insertions, 15 deletions
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