diff options
| -rw-r--r-- | src/App.hs | 33 | ||||
| -rw-r--r-- | src/LoginAttempts.hs | 29 | ||||
| -rw-r--r-- | src/Types.hs | 8 | ||||
| -rw-r--r-- | src/init.sql | 8 |
4 files changed, 70 insertions, 8 deletions
diff --git a/src/App.hs b/src/App.hs index 786820f097a3..209e2f209231 100644 --- a/src/App.hs +++ b/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" } diff --git a/src/LoginAttempts.hs b/src/LoginAttempts.hs new file mode 100644 index 000000000000..a7e950da7412 --- /dev/null +++ b/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) diff --git a/src/Types.hs b/src/Types.hs index 25f7d8996a36..d33ea6870f13 100644 --- a/src/Types.hs +++ b/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 diff --git a/src/init.sql b/src/init.sql index 1439bd338835..117a3bd06f90 100644 --- a/src/init.sql +++ b/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; |