From af251d82c96a578cdf2a26d29292a63ee4453350 Mon Sep 17 00:00:00 2001
From: David Mosbach <david.mosbach@live.de>
Date: Sat, 23 Dec 2023 01:09:38 +0100
Subject: [PATCH] separate scopes by `%20` instead of `,`

---
 app/Main.hs   | 2 +-
 src/Server.hs | 6 +++---
 src/User.hs   | 8 ++++----
 3 files changed, 8 insertions(+), 8 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 2b73882..12096b7 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -3,4 +3,4 @@ module Main (main) where
 import Server
 
 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
diff --git a/src/Server.hs b/src/Server.hs
index ef238af..4cb312f 100644
--- a/src/Server.hs
+++ b/src/Server.hs
@@ -15,7 +15,7 @@ import Control.Monad.IO.Class
 
 import Data.Aeson
 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 qualified Data.Map.Strict as Map
@@ -81,11 +81,11 @@ authServer = handleAuth
       unless (pack client `elem` trustedClients) . -- TODO fetch trusted clients from db
         throwError $ err404 { errBody = "Not a trusted client."}
       let
-        scopes' = readScopes @user @userData scopes
+        scopes' = map (readScope @user @userData) $ words scopes
         uData = mconcat $ map (userScope @user @userData u) scopes'
         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
 
 exampleAuthServer :: Server (Auth User (Map.Map Text Text))
diff --git a/src/User.hs b/src/User.hs
index 292223b..15b0a37 100644
--- a/src/User.hs
+++ b/src/User.hs
@@ -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
   data Scope u
-  readScopes :: String -> [Scope u]
-  showScopes :: [Scope u] -> String
+  readScope :: String -> Scope u
+  showScope :: Scope u -> String
   userScope  :: u -> Scope u -> a
 
 
@@ -29,7 +29,7 @@ data User = User
 
 instance UserData User (Map Text Text) where
   data Scope User = ID | Profile deriving (Show, Read, Eq)
-  readScopes = read
-  showScopes = show
+  readScope = read
+  showScope = show
   userScope User{..} ID = singleton "id" uID
   userScope User{..} Profile = fromList [("name", name), ("email", email)]
\ No newline at end of file