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

changed header type for user endpoint

Browse Source
This commit is contained in:
David Mosbach 2024-01-10 17:07:22 +01:00
parent 3e2d07518c
commit c68bf943f3
1 changed files with 15 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/Server.hs
View File

@ -24,7 +24,7 @@ import Data.List (find, elemIndex)
import Data.Maybe (fromMaybe, fromJust, isJust, isNothing) import Data.Maybe (fromMaybe, fromJust, isJust, isNothing)
import Data.String (IsString (..)) import Data.String (IsString (..))
import Data.Text hiding (elem, find, head, length, map, null, splitAt, tail, words) import Data.Text hiding (elem, find, head, length, map, null, splitAt, tail, words)
import Data.Text.Encoding (decodeUtf8) import Data.Text.Encoding (decodeUtf8, encodeUtf8)
import Data.Time.Clock (NominalDiffTime (..), nominalDay, UTCTime(..), getCurrentTime, addUTCTime) import Data.Time.Clock (NominalDiffTime (..), nominalDay, UTCTime(..), getCurrentTime, addUTCTime)
import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Char8 as BS
@ -234,23 +234,28 @@ mkToken state = do
type Users = "users" type Users = "users"
type HeaderR = Header' [Strict, Required]
type Me userData = Users type Me userData = Users
:> "me" :> "me"
:> Header "Authorization" JWTWrapper :> HeaderR "Authorization" Text
:> Get '[JSON] userData :> Get '[JSON] userData
type UserList userData = Users type UserList userData = Users
:> "query" :> "query"
:> Header "Authorization" JWTWrapper :> HeaderR "Authorization" Text
:> Get '[JSON] [userData] -- TODO support query params :> 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 userData)
userEndpoint = handleUserData userEndpoint = handleUserData
where where
handleUserData :: Maybe JWTWrapper -> AuthHandler userData handleUserData :: Text -> AuthHandler userData
handleUserData jwtw = do handleUserData 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 undefined
-- let -- let
-- scopes' = map (readScope @user @userData) $ words scopes -- scopes' = map (readScope @user @userData) $ words scopes
@ -258,10 +263,15 @@ userEndpoint = handleUserData
-- liftIO . putStrLn $ "user: " ++ show u ++ " | scopes: " ++ show (map (showScope @user @userData) scopes') -- liftIO . putStrLn $ "user: " ++ show u ++ " | scopes: " ++ show (map (showScope @user @userData) scopes')
-- return uData -- return uData
decodeToken :: Text -> AuthState -> IO (Either JwtError JwtContent)
decodeToken token state = do
pubKey <- atomically $ readTVar state >>= return . publicKey
jwkDecode pubKey $ encodeUtf8 token
userListEndpoint :: forall user userData . UserData user userData => AuthServer (UserList userData) userListEndpoint :: forall user userData . UserData user userData => AuthServer (UserList userData)
userListEndpoint = handleUserData userListEndpoint = handleUserData
where where
handleUserData :: Maybe JWTWrapper -> AuthHandler [userData] handleUserData :: Text -> AuthHandler [userData]
handleUserData jwtw = do handleUserData jwtw = do
undefined undefined