Restrict users from multiple failed login attempts

I'm not resetting the failed LoginAttempt count, which is a low priority for
now, but necessary eventually.

src/App.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TypeApplications #-}
 --------------------------------------------------------------------------------
 module App where
@@ -20,6 +21,7 @@ import qualified Types as T
 import qualified Accounts as Accounts
 import qualified Trips as Trips
 import qualified Sessions as Sessions
+import qualified LoginAttempts as LoginAttempts
 --------------------------------------------------------------------------------
 
 server :: FilePath -> Server API
@@ -76,14 +78,29 @@ server dbFile = createAccountH
     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" }
+        Just account@T.Account{..} -> do
+          mAttempts <- LoginAttempts.forUsername dbFile accountUsername
+          case mAttempts of
+            Nothing ->
+              if T.passwordsMatch password accountPassword then do
+                session <- Sessions.findOrCreate dbFile account
+                -- set cookie
+                pure NoContent
+              else do
+                LoginAttempts.increment dbFile username
+                throwIO $ err401 { errBody = "Your credentials are invalid" }
+            Just attempts ->
+              if attempts > 3 then
+                -- TODO(wpcarro): Prefer 429 error code
+                throwIO $ err401 { errBody = "Too many failed login attempts" }
+              else if T.passwordsMatch password accountPassword then do
+                session <- Sessions.findOrCreate dbFile account
+                -- set cookie
+                pure NoContent
+              else do
+                LoginAttempts.increment dbFile username
+                -- 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.
         Nothing -> throwIO $ err401 { errBody = "Your credentials are invalid" }

src/LoginAttempts.hs

@@ -0,0 +1,29 @@
+{-# 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 (numAttempts) FROM LoginAttempts WHERE username = ?"
+    (Only username)
+  case res of
+    [T.LoginAttempt{..}] -> pure (Just loginAttemptNumAttempts)
+    _  -> pure Nothing
+
+increment :: FilePath -> T.Username -> IO ()
+increment dbFile username = withConnection dbFile $ \conn ->
+  execute conn "UPDATE LoginAttempts SET numAttempts = numAttempts + 1 WHERE username = ?"
+    (Only username)

src/Types.hs

@@ -374,3 +374,11 @@ instance FromRow StoredSession where
   fromRow = StoredSession <$> field
                           <*> field
                           <*> field
+
+data LoginAttempt = LoginAttempt
+  { loginAttemptUsername :: Username
+  , loginAttemptNumAttempts :: Integer
+  } deriving (Eq, Show)
+
+instance FromRow LoginAttempt where
+  fromRow = LoginAttempt <$> field <*> field

src/init.sql

@@ -9,6 +9,7 @@ BEGIN TRANSACTION;
 DROP TABLE IF EXISTS Accounts;
 DROP TABLE IF EXISTS Trips;
 DROP TABLE IF EXISTS Sessions;
+DROP TABLE IF EXISTS LoginAttempts;
 
 CREATE TABLE Accounts (
 -- TODO(wpcarro): Add CHECK(..) constraint
@@ -38,4 +39,11 @@ CREATE TABLE Sessions (
   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
+);
+
 COMMIT;