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:
parent
f051b0be0b
commit
cf6c8799ab
4 changed files with 70 additions and 8 deletions
33
src/App.hs
33
src/App.hs
|
@ -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
29
src/LoginAttempts.hs
Normal 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)
|
|
@ -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
|
||||||
|
|
|
@ -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;
|
||||||
|
|
Loading…
Reference in a new issue