return empty user data

This commit is contained in:
David Mosbach 2024-01-10 17:47:39 +01:00
parent 4c2ba00801
commit c7989034b4

View File

@ -239,11 +239,10 @@ mkToken state = do
type Users = "users" type Users = "users"
type HeaderR = Header' [Strict, Required] type HeaderR = Header' [Strict, Required]
type Me user userData = BasicAuth "login" user --TODO basic auth should not be necessary type Me userData = Users
:> Users :> "me"
:> "me" :> HeaderR "Authorization" Text
:> HeaderR "Authorization" Text :> Get '[JSON] userData
:> Get '[JSON] userData
type UserList userData = Users type UserList userData = Users
:> "query" :> "query"
@ -251,11 +250,11 @@ type UserList userData = Users
:> Get '[JSON] [userData] -- TODO support query params :> Get '[JSON] [userData] -- TODO support query params
userEndpoint :: forall user userData . UserData user userData => AuthServer (Me user userData) userEndpoint :: forall user userData . UserData user userData => AuthServer (Me userData)
userEndpoint = handleUserData userEndpoint = handleUserData
where where
handleUserData :: user -> Text -> AuthHandler userData handleUserData :: Text -> AuthHandler userData
handleUserData u jwtw = do handleUserData jwtw = do
let mToken = stripPrefix "Bearer " jwtw let mToken = stripPrefix "Bearer " jwtw
unless (isJust mToken) . throwError $ err500 { errBody = "Invalid token format"} unless (isJust mToken) . throwError $ err500 { errBody = "Invalid token format"}
token <- asks (decodeToken (fromJust mToken)) >>= liftIO token <- asks (decodeToken (fromJust mToken)) >>= liftIO
@ -265,7 +264,7 @@ userEndpoint = handleUserData
Right (Jwe (header, body)) -> do Right (Jwe (header, body)) -> do
let jwt = fromJust . decode @JWT $ fromStrict body let jwt = fromJust . decode @JWT $ fromStrict body
-- TODO check if token grants access, then read logged in user from cookie -- TODO check if token grants access, then read logged in user from cookie
return $ userScope @user @userData u (readScope @user @userData "Profile") return mempty
-- let -- let
-- scopes' = map (readScope @user @userData) $ words scopes -- scopes' = map (readScope @user @userData) $ words scopes
-- uData = mconcat $ map (userScope @user @userData u) scopes' -- uData = mconcat $ map (userScope @user @userData u) scopes'
@ -291,7 +290,7 @@ userListEndpoint = handleUserData
type Routing user userData = Auth user userData type Routing user userData = Auth user userData
:<|> Token :<|> Token
:<|> Me user userData :<|> Me userData
:<|> UserList userData :<|> UserList userData
routing :: forall user userData . UserData user userData => AuthServer (Routing user userData) routing :: forall user userData . UserData user userData => AuthServer (Routing user userData)