53 lines
1.5 KiB
Haskell
53 lines
1.5 KiB
Haskell
{-# LANGUAGE DataKinds, TypeOperators, OverloadedStrings, ScopedTypeVariables, TypeApplications #-}
|
|
|
|
module Server
|
|
( insecureOAuthMock
|
|
) where
|
|
|
|
import User
|
|
|
|
import Control.Monad.IO.Class
|
|
|
|
import Data.Aeson
|
|
import Data.List (find)
|
|
import Data.Text hiding (find, head, map)
|
|
|
|
import qualified Data.Map.Strict as Map
|
|
|
|
|
|
import Servant
|
|
-- import Servant.API
|
|
|
|
testUsers :: [User]
|
|
testUsers =
|
|
[ User {name = "TestName", email = "foo@bar.com", uID = "1"}]
|
|
|
|
|
|
type Auth userData = "auth" :> QueryParam "scopes" String :> Get '[JSON] (Maybe userData) -- TODO also parametrise "auth" to (auth :: Symbol)
|
|
type Token = "token" :> Post '[JSON] Text -- TODO post jwt token
|
|
-- type Insert = "insert" :> Post '[JSON] User
|
|
|
|
authServer :: forall user userData . UserData user userData => [user] -> Server (Auth userData)
|
|
authServer testUsers = handleAuth
|
|
where
|
|
handleAuth :: Maybe String -> Handler (Maybe userData)
|
|
handleAuth Nothing = liftIO (putStrLn "no query param given") >> return Nothing
|
|
handleAuth (Just x) = do
|
|
let
|
|
scopes = readScopes @user @userData x
|
|
ud = mconcat $ map (userScope @user @userData $ head testUsers) scopes
|
|
liftIO (putStrLn $ "query param: " ++ showScopes @user @userData scopes)
|
|
return $ Just ud
|
|
|
|
exampleAuthServer :: Server (Auth (Map.Map Text Text))
|
|
exampleAuthServer = authServer testUsers
|
|
|
|
authAPI :: Proxy (Auth (Map.Map Text Text))
|
|
authAPI = Proxy
|
|
|
|
insecureOAuthMock :: Application
|
|
insecureOAuthMock = authAPI `serve` exampleAuthServer
|
|
|
|
tokenEndpoint :: Server Token
|
|
tokenEndpoint = undefined
|
|
|