Check passwords in /login
TL;DR: - Since POST /login is more rigorous, our accounts.csv needs to contain validly hashed passwords; you can use tests/create-accounts.sh to create dummy accounts I still need to test the login flow and support: - Tracking failed attempts (three maximum) - Verifying accounts by sending emails to the users
This commit is contained in:
parent
90a521c78f
commit
f051b0be0b
5 changed files with 45 additions and 18 deletions
|
@ -1,3 +1,3 @@
|
|||
mimi,testing,miriamwright@google.com,user,
|
||||
bill,testing,wpcarro@gmail.com,manager,
|
||||
wpcarro,testing,wpcarro@google.com,admin,
|
||||
mimi,$2b$12$LynoGCNbe2RA1WWSiBEMVudJKs5dxnssY16rYmUyiwlSBIhHBOLbu,miriamwright@google.com,user,
|
||||
bill,$2b$12$wzh1OyNsvrrGt4hI52Wkt.QDX0IdPKn5uuNSgO/9CWucxipt5wlMi,wpcarro@gmail.com,manager,
|
||||
wpcarro,$2b$12$3wbi4xfQmksLsu6GOKTbj.5WHywESATnXB4R8FJ55RSRLy6X9xA7u,wpcarro@google.com,admin,
|
|
|
@ -41,4 +41,4 @@ type API =
|
|||
-- Miscellaneous
|
||||
:<|> "login"
|
||||
:> ReqBody '[JSON] T.AccountCredentials
|
||||
:> Post '[JSON] (Maybe T.Session)
|
||||
:> Post '[JSON] NoContent
|
||||
|
|
29
src/App.hs
29
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
|
||||
|
|
|
@ -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
|
||||
|
|
21
tests/create-accounts.sh
Executable file
21
tests/create-accounts.sh
Executable file
|
@ -0,0 +1,21 @@
|
|||
#!/usr/bin/env sh
|
||||
|
||||
# This script populates the Accounts table over HTTP.
|
||||
|
||||
http POST :3000/accounts \
|
||||
username=mimi \
|
||||
password=testing \
|
||||
email=miriamwright@google.com \
|
||||
role=user
|
||||
|
||||
http POST :3000/accounts \
|
||||
username=bill \
|
||||
password=testing \
|
||||
email=wpcarro@gmail.com \
|
||||
role=manager
|
||||
|
||||
http POST :3000/accounts \
|
||||
username=wpcarro \
|
||||
password=testing \
|
||||
email=wpcarro@google.com \
|
||||
role=admin
|
Loading…
Reference in a new issue