mdebray/tvl-depot
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Return a JSON Session on a successful POST /login

Browse source 
This will make the UX on a the client-side smoother.
This commit is contained in:
William Carroll 2020-07-31 18:28:41 +01:00
parent c8ed6e51fe
commit 35b218c543
3 changed files with 12 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
src/API.hs
View file

@ -58,7 +58,7 @@ type API =
-- Miscellaneous
:<|> "login"
:> ReqBody '[JSON] T.AccountCredentials
:> Post '[JSON] (Headers '[Header "Set-Cookie" SetCookie] NoContent)
:> Post '[JSON] (Headers '[Header "Set-Cookie" SetCookie] T.Session)
:<|> "logout"
:> SessionCookie
:> Get '[JSON] (Headers '[Header "Set-Cookie" SetCookie] NoContent)

12
src/App.hs
View file

@ -153,7 +153,7 @@ server config@T.Config{..} = createAccount
_ -> liftIO $ Trips.list dbFile accountUsername
login :: T.AccountCredentials
-> Handler (Headers '[Header "Set-Cookie" SetCookie] NoContent)
-> Handler (Headers '[Header "Set-Cookie" SetCookie] T.Session)
login (T.AccountCredentials username password) = do
mAccount <- liftIO $ Accounts.lookup dbFile username
case mAccount of
@ -163,7 +163,10 @@ server config@T.Config{..} = createAccount
Nothing ->
if T.passwordsMatch password accountPassword then do
uuid <- liftIO $ Sessions.findOrCreate dbFile account
pure $ addHeader (Auth.mkCookie uuid) NoContent
pure $ addHeader (Auth.mkCookie uuid)
T.Session{ sessionUsername = accountUsername
, sessionRole = accountRole
}
else do
liftIO $ LoginAttempts.increment dbFile username
throwError err401 { errBody = "Your credentials are invalid" }
@ -172,7 +175,10 @@ server config@T.Config{..} = createAccount
throwError err429
else if T.passwordsMatch password accountPassword then do
uuid <- liftIO $ Sessions.findOrCreate dbFile account
pure $ addHeader (Auth.mkCookie uuid) NoContent
pure $ addHeader (Auth.mkCookie uuid)
T.Session{ sessionUsername = accountUsername
, sessionRole = accountRole
}
else do
liftIO $ LoginAttempts.increment dbFile username
throwError err401 { errBody = "Your credentials are invalid" }

4
src/Types.hs
View file

@ -174,8 +174,8 @@ instance FromRow Account where
pure Account{..}
data Session = Session
{ username :: Username
, role :: Role
{ sessionUsername :: Username
, sessionRole :: Role
} deriving (Eq, Show)
instance ToJSON Session where