diff --git a/app/Main.hs b/app/Main.hs index ef8bfe5..38f23cc 100644 --- a/app/Main.hs +++ b/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 diff --git a/oauth2-mock-server.cabal b/oauth2-mock-server.cabal index 1324f22..605444e 100644 --- a/oauth2-mock-server.cabal +++ b/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 diff --git a/package.yaml b/package.yaml index 96682cd..06a20b5 100644 --- a/package.yaml +++ b/package.yaml @@ -26,6 +26,7 @@ dependencies: - warp - aeson - text +- containers ghc-options: - -Wall diff --git a/src/Server.hs b/src/Server.hs index fd516c7..64269af 100644 --- a/src/Server.hs +++ b/src/Server.hs @@ -8,33 +8,42 @@ import User import Control.Monad.IO.Class -import Data.Aeson -import Data.List -import Data.Maybe -import Data.Text hiding (find) +import Data.List (find) +import Data.Text hiding (find, head, map) + +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 Insert = "insert" :> Post '[JSON] User +type Auth = "auth" :> QueryParam "scopes" String :> Get '[JSON] (Maybe (Map.Map Text Text)) +type Token = "token" :> Post '[JSON] Text -- TODO post jwt token +-- type Insert = "insert" :> Post '[JSON] User -queryServer :: Server Query -queryServer = handleQuery +authServer :: Server Auth +authServer = handleAuth where - handleQuery :: Maybe Text -> Handler (Maybe User) - handleQuery 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 :: Maybe String -> Handler (Maybe (Map.Map Text Text)) + handleAuth Nothing = liftIO (putStrLn "no query param given") >> return Nothing + 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 -queryAPI = Proxy +authAPI :: Proxy Auth +authAPI = Proxy insecureOAuthMock :: Application -insecureOAuthMock = queryAPI `serve` queryServer +insecureOAuthMock = authAPI `serve` authServer + +tokenEndpoint :: Server Token +tokenEndpoint = undefined \ No newline at end of file diff --git a/src/User.hs b/src/User.hs index ed91672..853e6ea 100644 --- a/src/User.hs +++ b/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)] \ No newline at end of file