diff options
| -rw-r--r-- | src/API.hs | 2 | ||||
| -rw-r--r-- | src/App.hs | 12 | ||||
| -rw-r--r-- | src/Types.hs | 4 |
3 files changed, 12 insertions, 6 deletions
diff --git a/src/API.hs b/src/API.hs index 8bdb6bdfbb73..7b6ed9eae50f 100644 --- a/src/API.hs +++ b/src/API.hs @@ -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) diff --git a/src/App.hs b/src/App.hs index ff292ff2cd16..e5b8de7e7e7f 100644 --- a/src/App.hs +++ b/src/App.hs @@ -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" } diff --git a/src/Types.hs b/src/Types.hs index f47e1419757a..5026b97383e6 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -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 |