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.
This commit is contained in:
William Carroll 2020-07-28 21:33:58 +01:00
parent f051b0be0b
commit cf6c8799ab
4 changed files with 70 additions and 8 deletions

View file

@ -1,6 +1,7 @@
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeApplications #-}
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
module App where module App where
@ -20,6 +21,7 @@ import qualified Types as T
import qualified Accounts as Accounts import qualified Accounts as Accounts
import qualified Trips as Trips import qualified Trips as Trips
import qualified Sessions as Sessions import qualified Sessions as Sessions
import qualified LoginAttempts as LoginAttempts
-------------------------------------------------------------------------------- --------------------------------------------------------------------------------
server :: FilePath -> Server API server :: FilePath -> Server API
@ -76,14 +78,29 @@ server dbFile = createAccountH
login (T.AccountCredentials username password) = do login (T.AccountCredentials username password) = do
mAccount <- Accounts.lookup dbFile username mAccount <- Accounts.lookup dbFile username
case mAccount of case mAccount of
Just account -> Just account@T.Account{..} -> do
if T.passwordsMatch password (T.accountPassword account) then do mAttempts <- LoginAttempts.forUsername dbFile accountUsername
session <- Sessions.findOrCreate dbFile account case mAttempts of
-- set cookie Nothing ->
pure NoContent if T.passwordsMatch password accountPassword then do
else session <- Sessions.findOrCreate dbFile account
-- TODO(wpcarro): Catch and return errors over HTTP -- set cookie
throwIO $ err401 { errBody = "Your credentials are invalid" } 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. -- In this branch, the user didn't supply a known username.
Nothing -> throwIO $ err401 { errBody = "Your credentials are invalid" } Nothing -> throwIO $ err401 { errBody = "Your credentials are invalid" }

29
src/LoginAttempts.hs Normal file
View file

@ -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)

View file

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

View file

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