diff --git a/app/UniWorX.hs b/app/UniWorX.hs index aeabd28..e0a5f93 100644 --- a/app/UniWorX.hs +++ b/app/UniWorX.hs @@ -10,6 +10,7 @@ TemplateHaskell, TypeFamilies, TypeApplications, + DeriveGeneric, DerivingStrategies, StandaloneDeriving, UndecidableInstances, @@ -18,7 +19,7 @@ MultiParamTypeClasses, RecordWildCards #-} -module UniWorX (User(..), initDB, testUsers) where +module UniWorX (User(..), initDB) where import User @@ -33,6 +34,7 @@ import Conduit (ResourceT) import Data.Map (Map(..)) import Data.String (IsString(..)) import Data.Text (Text(..)) +import Data.Yaml (decodeFileThrow, FromJSON(..), Value(..), (.:)) import qualified Data.Map as M import qualified Data.Text as T @@ -40,23 +42,42 @@ import Database.Persist import Database.Persist.TH import Database.Persist.Postgresql +import GHC.Generics + import System.Environment (lookupEnv) share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| User - name Text - email Text - deriving Eq Show + firstName Text + surname Text + email Text + matricNumber Text Maybe + title Text Maybe + sex Text Maybe + birthday Text Maybe + telephone Text Maybe + mobile Text Maybe + compPersNumber Text Maybe + compDepartment Text Maybe + postAddress Text Maybe + deriving Eq Show Generic |] -testUsers :: [User] -- TODO move to db -testUsers = - [ User "Fallback User" "foo@bar.com" - , User "Tina Tester" "tester@campus.lmu.de" - , User "Max Muster" "m@m.mm" ] +instance FromJSON User -runDB :: ReaderT SqlBackend (NoLoggingT (ResourceT IO)) a -> IO a +data TestUserSpec = TestUsers + { specialUsers :: [User] + , randomUsers :: Map Text [Text] + } deriving (Show) + +instance FromJSON TestUserSpec where + parseJSON (Object o) = TestUsers <$> o .: "special-users" <*> o .: "random-users" + parseJSON _ = error "Oauth2 Mock Server: invalid test user format" + +type DB = ReaderT SqlBackend (NoLoggingT (ResourceT IO)) + +runDB :: DB a -> IO a runDB action = do Just port <- lookupEnv "OAUTH2_DB_PORT" -- >>= \p -> return $ p <|> Just "9444" Just host <- lookupEnv "OAUTH2_PGHOST" @@ -64,19 +85,38 @@ runDB action = do runStderrLoggingT $ withPostgresqlPool connStr 10 $ \pool -> liftIO $ flip runSqlPersistMPool pool action initDB :: IO () -initDB = runDB $ do - runMigration migrateAll - forM_ testUsers $ void . insert +initDB = do + Just testUserFile <- lookupEnv "OAUTH2_TEST_USERS" + runDB $ do + runMigration migrateAll + testUsers <- decodeFileThrow @DB @TestUserSpec testUserFile + liftIO . putStrLn $ "the test users:\n" ++ show testUsers + forM_ (specialUsers testUsers) $ void . insert + instance UserData (Entity User) (Map Text Text) where data Scope (Entity User) = ID | Profile deriving (Show, Read, Eq) readScope = read showScope = show userScope (Entity _ User{..}) ID = M.singleton "id" userEmail - userScope (Entity _ User{..}) Profile = M.fromList [("name", userName), ("email", userEmail)] + userScope (Entity _ User{..}) Profile = M.fromList [(key, val) | (key, Just val) <- + [ ("firstName", Just userFirstName) + , ("surname", Just userSurname) + , ("email", Just userEmail) + , ("matriculationNumber", userMatricNumber) + , ("title", userTitle) + , ("sex", userSex) + , ("birthday", userBirthday) + , ("telephone", userTelephone) + , ("mobile", userMobile) + , ("companyPersonalNumber", userCompPersNumber) + , ("companyDepartment", userCompDepartment) + , ("postAddress", userPostAddress) + ]] lookupUser email _ = runDB $ do user <- selectList [UserEmail ==. email] [] case user of [entity] -> return $ Just entity [] -> return Nothing - _ -> error "Ambiguous User." + _ -> error "Oauth2 Mock Server: Ambiguous User." + diff --git a/flake.nix b/flake.nix index 5115f03..4e81d4e 100644 --- a/flake.nix +++ b/flake.nix @@ -70,6 +70,9 @@ LD_LIBRARY_PATH = libPath; OAUTH2_HBA = ./hba_file; OAUTH2_DB_SCHEMA = ./schema.sql; + OAUTH2_TEST_USERS = ./users.yaml; + OAUTH2_SERVER_PORT = 9443; + OAUTH2_DB_PORT = 9444; shellHook = '' ${mkDB} zsh diff --git a/mkDB.sh b/mkDB.sh index 0a44419..ab4c4f7 100755 --- a/mkDB.sh +++ b/mkDB.sh @@ -5,10 +5,7 @@ [[ -z "${OAUTH2_HBA}" || -z "${OAUTH2_DB_SCHEMA}" ]] && echo "oauth2: missing env vars for hba and/or schema" && exit 1 -export OAUTH2_SERVER_PORT=9443 -export OAUTH2_DB_PORT=9444 - -tmpdir=./database +tmpdir=${XDG_RUNTIME_DIR}/.oauth2-db if [ ! -d "${tmpdir}" ]; then mkdir ${tmpdir} diff --git a/oauth2-mock-server.cabal b/oauth2-mock-server.cabal index edafa50..37004ba 100644 --- a/oauth2-mock-server.cabal +++ b/oauth2-mock-server.cabal @@ -91,6 +91,7 @@ executable oauth2-mock-server-exe , transformers , uuid , warp + , yaml default-language: Haskell2010 test-suite oauth2-mock-server-test diff --git a/package.yaml b/package.yaml index 3056d93..158730d 100644 --- a/package.yaml +++ b/package.yaml @@ -75,6 +75,7 @@ executables: - monad-logger - conduit - mtl + - yaml tests: oauth2-mock-server-test: diff --git a/users.yaml b/users.yaml new file mode 100644 index 0000000..e69de29