added scopes

app/Main.hs

@@ -5,4 +5,4 @@ import Server
 import Network.Wai.Handler.Warp
 
 main :: IO ()
-main = putStrLn "Try: http://localhost:8080/query?userID=1" >> run 8080 insecureOAuthMock
+main = putStrLn "Try: http://localhost:8080/auth?scopes=[ID,Profile]" >> run 8080 insecureOAuthMock

oauth2-mock-server.cabal

@@ -31,6 +31,7 @@ library
   build-depends:
       aeson
     , base >=4.7 && <5
+    , containers
     , servant
     , servant-server
     , text
@@ -49,6 +50,7 @@ executable oauth2-mock-server-exe
   build-depends:
       aeson
     , base >=4.7 && <5
+    , containers
     , oauth2-mock-server
     , servant
     , servant-server
@@ -69,6 +71,7 @@ test-suite oauth2-mock-server-test
   build-depends:
       aeson
     , base >=4.7 && <5
+    , containers
     , oauth2-mock-server
     , servant
     , servant-server

package.yaml

@@ -26,6 +26,7 @@ dependencies:
 - warp
 - aeson
 - text
+- containers
 
 ghc-options:
 - -Wall

src/Server.hs

@@ -8,33 +8,42 @@ import User
 
 import Control.Monad.IO.Class
 
-import Data.Aeson
+import Data.List (find)
-import Data.List
+import Data.Text hiding (find, head, map)
-import Data.Maybe
+
-import Data.Text hiding (find)
+import qualified Data.Map.Strict as Map
 
 
 import Servant
-import Servant.API
+-- import Servant.API
 
 testUsers :: [User]
 testUsers =
   [ User {name = "TestName", email = "foo@bar.com", uID = "1"}]
 
 
-type Query  = "query" :> QueryParam "userID" Text :> Get '[JSON] (Maybe User)
+type Auth = "auth" :> QueryParam "scopes" String :> Get '[JSON] (Maybe (Map.Map Text Text))
-type Insert = "insert" :> Post '[JSON] User
+type Token = "token" :> Post '[JSON] Text -- TODO post jwt token
+-- type Insert = "insert" :> Post '[JSON] User
 
-queryServer :: Server Query
+authServer :: Server Auth
-queryServer = handleQuery
+authServer = handleAuth
   where
-    handleQuery :: Maybe Text -> Handler (Maybe User)
+    handleAuth :: Maybe String -> Handler (Maybe (Map.Map Text Text))
-    handleQuery Nothing = liftIO (putStrLn "no query param given") >> return Nothing
+    handleAuth Nothing = liftIO (putStrLn "no query param given") >> return Nothing
-    handleQuery (Just x) = liftIO (putStrLn $ "query param: " ++ show x) >> (return $ find (\u -> uID u == x) testUsers)
+    handleAuth (Just x) = do
+      let
+        scopes = read x :: [Scope]
+        userData = mconcat $ map (userScope $ head testUsers) scopes
+      liftIO (putStrLn $ "query param: " ++ show scopes)
+      return $ Just userData
 
-queryAPI :: Proxy Query
+authAPI :: Proxy Auth
-queryAPI = Proxy
+authAPI = Proxy
 
 insecureOAuthMock :: Application
-insecureOAuthMock = queryAPI `serve` queryServer
+insecureOAuthMock = authAPI `serve` authServer
+
+tokenEndpoint :: Server Token
+tokenEndpoint = undefined
       

src/User.hs

@@ -1,12 +1,15 @@
-{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveGeneric, OverloadedStrings, RecordWildCards #-}
 
 module User
 (
   User (..)
+, Scope (..)
+, userScope
 ) where
 
 import Data.Aeson
-import Data.Text
+import Data.Map.Strict
+import Data.Text hiding (singleton)
 
 import GHC.Generics
 
@@ -18,3 +21,9 @@ data User = User
   } deriving (Eq, Show, Generic)
 
 instance ToJSON User
+
+data Scope = ID | Profile deriving (Show, Read, Eq)
+
+userScope :: User -> Scope -> Map Text Text
+userScope User{..} ID = singleton "id" uID
+userScope User{..} Profile = fromList [("name", name), ("email", email)]