diff --git a/src/Handler/Utils/Avs.hs b/src/Handler/Utils/Avs.hs index 377e22514..e6c2edf10 100644 --- a/src/Handler/Utils/Avs.hs +++ b/src/Handler/Utils/Avs.hs @@ -1,4 +1,4 @@ -module Handler.Utils.Avs +module Handler.Utils.Avs ( -- upsertAvsUser --, checkLicences getLicence, getLicenceDB @@ -38,41 +38,42 @@ instance Exception AvsException -} - + -- Do we need this? -getLicence :: UserId -> Handler (Maybe AvsLicence) -getLicence uid = do +-- getLicence :: UserId -> Handler (Maybe AvsLicence) -- with runDB +getLicence :: ( MonadThrow m, MonadHandler m, HandlerSite m ~ UniWorX, WithRunDB SqlReadBackend (HandlerFor UniWorX) m ) => UserId -> m (Maybe AvsLicence) +getLicence uid = do AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery - Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnknown uid) $ runDB $ getBy $ UniqueUserAvsUser uid + Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnknown uid) $ useRunDB $ getBy $ UniqueUserAvsUser uid AvsResponseGetLicences licences <- throwLeftM $ avsQueryGetLicences $ AvsQueryGetLicences $ Set.singleton $ AvsObjPersonId userAvsPersonId let ulicence = Set.lookupMax $ Set.filter ((userAvsPersonId ==) . avsLicencePersonID) licences return (avsLicenceRampLicence <$> ulicence) getLicenceDB :: UserId -> DB (Maybe AvsLicence) -getLicenceDB uid = do +getLicenceDB uid = do AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ liftHandler $ getsYesod $ view _appAvsQuery - Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnknown uid) $ getBy $ UniqueUserAvsUser uid + Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnknown uid) $ getBy $ UniqueUserAvsUser uid AvsResponseGetLicences licences <- throwLeftM $ avsQueryGetLicences $ AvsQueryGetLicences $ Set.singleton $ AvsObjPersonId userAvsPersonId let ulicence = Set.lookupMax $ Set.filter ((userAvsPersonId ==) . avsLicencePersonID) licences return (avsLicenceRampLicence <$> ulicence) -setLicence :: UserId -> AvsLicence -> Handler () -setLicence uid lic = do - Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnknown uid) $ runDB $ getBy $ UniqueUserAvsUser uid - setLicenceAvs userAvsPersonId lic +setLicence :: UserId -> AvsLicence -> DB () +setLicence uid lic = do + Entity _ UserAvs{..} <- maybeThrowM (AvsUserUnknown uid) $ getBy $ UniqueUserAvsUser uid + setLicenceAvs userAvsPersonId lic -setLicenceAvs :: AvsPersonId -> AvsLicence -> Handler () -setLicenceAvs apid lic = do +setLicenceAvs :: AvsPersonId -> AvsLicence -> DB () +setLicenceAvs apid lic = do let req = Set.singleton $ AvsPersonLicence apid lic - setLicencesAvs req + setLicencesAvs req -setLicencesAvs :: Set AvsPersonLicence -> Handler () -setLicencesAvs pls = do +setLicencesAvs :: Set AvsPersonLicence -> DB () +setLicencesAvs pls = do AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsResponseSetLicences responses <- throwLeftM $ avsQuerySetLicences $ AvsQuerySetLicences pls forM_ responses $ \AvsLicenceResponse{} -> - error "CONTINUE HERE" -- TODO STUB + error "CONTINUE HERE" -- TODO STUB {- -- | Retrieve all currently valid driving licences and check against our database @@ -88,9 +89,9 @@ checkLicences = do -} {- -upsertAvsUser :: AvsStatusPerson -> +upsertAvsUser :: AvsStatusPerson -> -or +or -upsertAvsUser :: AvsPersonId -> +upsertAvsUser :: AvsPersonId -> -} \ No newline at end of file diff --git a/test/Utils/TypesSpec.hs b/test/Utils/TypesSpec.hs index 420169580..d4ff57d52 100644 --- a/test/Utils/TypesSpec.hs +++ b/test/Utils/TypesSpec.hs @@ -3,6 +3,14 @@ module Utils.TypesSpec where import TestImport +instance Arbitrary AvsPersonId where + arbitrary = AvsPersonId <$> arbitrary + shrink (AvsPersonId x) = AvsPersonId <$> shrink x + +instance Arbitrary AvsCardNo where + arbitrary = AvsCardNo <$> arbitrary + shrink (AvsCardNo x) = AvsCardNo <$> shrink x + instance Arbitrary AvsDataCardColor where arbitrary = genericArbitrary shrink = genericShrink