uniworx/oauth2-mock-server
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

return user data at user endpoint

Browse Source
This commit is contained in:
David Mosbach 2024-01-10 17:39:25 +01:00
parent 6e26ff0403
commit 4c2ba00801
1 changed files with 18 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/Server.hs
View File

@ -176,6 +176,9 @@ data JWT = JWT
instance ToJSON JWT where
toJSON (JWT i e) = object ["iss" .= i, "exp" .= e]
instance FromJSON JWT where
parseJSON (Object o) = JWT <$> o .: "iss" <*> o .: "exp"
data JWTWrapper = JWTW
{ token :: String
, expiresIn :: NominalDiffTime
@ -236,10 +239,11 @@ mkToken state = do
type Users = "users"
type HeaderR = Header' [Strict, Required]
type Me userData = Users
:> "me"
:> HeaderR "Authorization" Text
:> Get '[JSON] userData
type Me user userData = BasicAuth "login" user --TODO basic auth should not be necessary
:> Users
:> "me"
:> HeaderR "Authorization" Text
:> Get '[JSON] userData
type UserList userData = Users
:> "query"
@ -247,16 +251,21 @@ type UserList userData = Users
:> Get '[JSON] [userData] -- TODO support query params
userEndpoint :: forall user userData . UserData user userData => AuthServer (Me userData)
userEndpoint :: forall user userData . UserData user userData => AuthServer (Me user userData)
userEndpoint = handleUserData
where
handleUserData :: Text -> AuthHandler userData
handleUserData jwtw = do
handleUserData :: user -> Text -> AuthHandler userData
handleUserData u jwtw = do
let mToken = stripPrefix "Bearer " jwtw
unless (isJust mToken) . throwError $ err500 { errBody = "Invalid token format"}
token <- asks (decodeToken (fromJust mToken)) >>= liftIO
liftIO $ putStrLn "decoded token:" >> print token
undefined
case token of
Left e -> throwError $ err500 { errBody = fromString $ show e }
Right (Jwe (header, body)) -> do
let jwt = fromJust . decode @JWT $ fromStrict body
-- TODO check if token grants access, then read logged in user from cookie
return $ userScope @user @userData u (readScope @user @userData "Profile")
-- let
-- scopes' = map (readScope @user @userData) $ words scopes
-- uData = mconcat $ map (userScope @user @userData u) scopes'
@ -282,7 +291,7 @@ userListEndpoint = handleUserData
type Routing user userData = Auth user userData
:<|> Token
:<|> Me userData
:<|> Me user userData
:<|> UserList userData
routing :: forall user userData . UserData user userData => AuthServer (Routing user userData)