fix build

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 ->
 -}

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