diff --git a/app/UniWorX.hs b/app/UniWorX.hs index e0a5f93..f373ef5 100644 --- a/app/UniWorX.hs +++ b/app/UniWorX.hs @@ -10,7 +10,6 @@ TemplateHaskell, TypeFamilies, TypeApplications, - DeriveGeneric, DerivingStrategies, StandaloneDeriving, UndecidableInstances, @@ -34,7 +33,7 @@ import Conduit (ResourceT) import Data.Map (Map(..)) import Data.String (IsString(..)) import Data.Text (Text(..)) -import Data.Yaml (decodeFileThrow, FromJSON(..), Value(..), (.:)) +import Data.Yaml (decodeFileThrow, FromJSON(..), Value(..), (.:), (.:?)) import qualified Data.Map as M import qualified Data.Text as T @@ -42,8 +41,6 @@ import Database.Persist import Database.Persist.TH import Database.Persist.Postgresql -import GHC.Generics - import System.Environment (lookupEnv) @@ -61,14 +58,28 @@ share [mkPersist sqlSettings, mkMigrate "migrateAll"] [persistLowerCase| compPersNumber Text Maybe compDepartment Text Maybe postAddress Text Maybe - deriving Eq Show Generic + deriving Eq Show |] -instance FromJSON User +instance FromJSON User where + parseJSON (Object o) = User + <$> o .: "userFirstName" + <*> o .: "userSurname" + <*> o .: "userEmail" + <*> o .:? "userMatrikelnummer" + <*> o .:? "userTitle" + <*> o .:? "userSex" + <*> o .:? "userBirthday" + <*> o .:? "userTelephone" + <*> o .:? "userMobile" + <*> o .:? "userCompanyPersonalNumber" + <*> o .:? "userCompanyDepartment" + <*> o .:? "userPostAddress" + parseJSON _ = error "Oauth2 Mock Server: invalid test user format" data TestUserSpec = TestUsers - { specialUsers :: [User] - , randomUsers :: Map Text [Text] + { specialUsers :: [Map Text User] + , randomUsers :: Map Text [Maybe Text] } deriving (Show) instance FromJSON TestUserSpec where @@ -91,7 +102,8 @@ initDB = do runMigration migrateAll testUsers <- decodeFileThrow @DB @TestUserSpec testUserFile liftIO . putStrLn $ "the test users:\n" ++ show testUsers - forM_ (specialUsers testUsers) $ void . insert + let users = M.elems . mconcat $ specialUsers testUsers + forM_ users $ void . insert instance UserData (Entity User) (Map Text Text) where