load test users from file

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
+    firstName       Text
-    email Text
+    surname         Text
-    deriving Eq Show
+    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
+instance FromJSON User
-testUsers =
-  [ User "Fallback User" "foo@bar.com"
-  , User "Tina Tester" "tester@campus.lmu.de"
-  , User "Max Muster" "m@m.mm" ]
 
-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
+initDB = do
-  runMigration migrateAll
+  Just testUserFile <- lookupEnv "OAUTH2_TEST_USERS"
-  forM_ testUsers $ void . insert
+  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."
+

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

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
+tmpdir=${XDG_RUNTIME_DIR}/.oauth2-db
-export OAUTH2_DB_PORT=9444
-
-tmpdir=./database
 
 if [ ! -d "${tmpdir}" ]; then
   mkdir ${tmpdir}

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

package.yaml

@@ -75,6 +75,7 @@ executables:
     - monad-logger
     - conduit
     - mtl
+    - yaml
 
 tests:
   oauth2-mock-server-test: