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

separate scopes by %20 instead of ,

Browse Source
This commit is contained in:
David Mosbach 2023-12-23 01:09:38 +01:00
parent 35ab852882
commit af251d82c9
3 changed files with 8 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
app/Main.hs
View File

@ -3,4 +3,4 @@ module Main (main) where
import Server import Server
main :: IO () main :: IO ()
main = putStrLn "Try: http://localhost:8080/auth?scope=[ID,Profile]&client_id=42&response_type=code&redirect_uri=localhost" >> runMockServer 8080 main = putStrLn "Try: http://localhost:8080/auth?scope=ID%20Profile&client_id=42&response_type=code&redirect_uri=localhost" >> runMockServer 8080

6
src/Server.hs
View File

@ -15,7 +15,7 @@ import Control.Monad.IO.Class
import Data.Aeson import Data.Aeson
import Data.List (find) import Data.List (find)
import Data.Text hiding (elem, find, head, map) import Data.Text hiding (elem, find, head, map, words)
import Data.Text.Encoding (decodeUtf8) import Data.Text.Encoding (decodeUtf8)
import qualified Data.Map.Strict as Map import qualified Data.Map.Strict as Map
@ -81,11 +81,11 @@ authServer = handleAuth
unless (pack client `elem` trustedClients) . -- TODO fetch trusted clients from db unless (pack client `elem` trustedClients) . -- TODO fetch trusted clients from db
throwError $ err404 { errBody = "Not a trusted client."} throwError $ err404 { errBody = "Not a trusted client."}
let let
scopes' = readScopes @user @userData scopes scopes' = map (readScope @user @userData) $ words scopes
uData = mconcat $ map (userScope @user @userData u) scopes' uData = mconcat $ map (userScope @user @userData u) scopes'
responseType' = read @ResponseType responseType responseType' = read @ResponseType responseType
liftIO (putStrLn $ "user: " ++ show u ++ " | scopes: " ++ showScopes @user @userData scopes') liftIO (putStrLn $ "user: " ++ show u ++ " | scopes: " ++ show (map (showScope @user @userData) scopes'))
return uData return uData
exampleAuthServer :: Server (Auth User (Map.Map Text Text)) exampleAuthServer :: Server (Auth User (Map.Map Text Text))

8
src/User.hs
View File

@ -14,8 +14,8 @@ import GHC.Generics
class (Show u, ToJSON a, Monoid a) => UserData u a where -- TODO Show maybe not necessary, but currently needed for TypeApplications class (Show u, ToJSON a, Monoid a) => UserData u a where -- TODO Show maybe not necessary, but currently needed for TypeApplications
data Scope u data Scope u
readScopes :: String -> [Scope u] readScope :: String -> Scope u
showScopes :: [Scope u] -> String showScope :: Scope u -> String
userScope :: u -> Scope u -> a userScope :: u -> Scope u -> a
@ -29,7 +29,7 @@ data User = User
instance UserData User (Map Text Text) where instance UserData User (Map Text Text) where
data Scope User = ID | Profile deriving (Show, Read, Eq) data Scope User = ID | Profile deriving (Show, Read, Eq)
readScopes = read readScope = read
showScopes = show showScope = show
userScope User{..} ID = singleton "id" uID userScope User{..} ID = singleton "id" uID
userScope User{..} Profile = fromList [("name", name), ("email", email)] userScope User{..} Profile = fromList [("name", name), ("email", email)]