refactor(avs): account for 404 response instead of empty search results, more quickcheck tests

messages/uniworx/categories/avs/de-de-formal.msg

@@ -4,4 +4,4 @@ AvsLastName: Nachname
 AvsInternalPersonalNo: Personalnummer (nur Fraport AG)
 AvsVersionNo: Versionsnummer
 AvsQueryEmpty: Bitte mindestens ein Anfragefeld ausfüllen!
-AvsStatusQueryInvalid t@Text: Nur numerische IDs eingeben, durch Komma! #{show t}
+AvsQueryStatusInvalid t@Text: Nur numerische IDs eingeben, durch Komma! #{show t}

messages/uniworx/categories/avs/en-eu.msg

@@ -4,4 +4,4 @@ AvsLastName: Last name
 AvsInternalPersonalNo: Personnel number (Fraport AG only)
 AvsVersionNo: Version number 
 AvsQueryEmpty: At least one query field must be filled!
-AvsStatusQueryInvalid t: Numeric IDs only, comma seperated! #{show t}
+AvsQueryStatusInvalid t: Numeric IDs only, comma seperated! #{show t}

messages/uniworx/utils/navigation/menu/de-de-formal.msg

@@ -132,8 +132,8 @@ MenuLmsResult: Melden Ergebnisse E-Lernen
 MenuLmsUpload: Hochladen
 MenuLmsDirect: Direkter Upload 
 
-MenuAvs: Schnitstelle AVS
+MenuAvs: Schnittstelle AVS
-MenuApc: Schnitstelle Druckerei
+MenuApc: Schnittstelle Druckerei
 
 MenuApiDocs: API-Dokumentation (Englisch)
 MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger)

src/Application.hs

@@ -364,7 +364,7 @@ makeFoundation appSettings''@AppSettings{..} = do
                           { basicAuthUsername = avsUser avsConf
                           , basicAuthPassword = avsPass avsConf
                           }
-          return . Just $ mkAvsQuery avsAuth avsEnv
+          return . Just $ mkAvsQuery avsServer avsAuth avsEnv
 
       $logDebugS "Runtime configuration" $ tshow appSettings'
 

src/Handler/Admin/Apc.hs

@@ -27,18 +27,18 @@ data MetaPinRenewal = MetaPinRenewal
 
 -}      
 {-
-makePrintForm :: Maybe AvsPersonQuery -> Form AvsPersonQuery
+makePrintForm :: Maybe AvsQueryPerson -> Form AvsQueryPerson
-makeAvsPersonForm tmpl = identifyForm FIDAvsPersonQuery . validateForm validateAvsPersonQuery $ \html -> 
+makeAvsPersonForm tmpl = identifyForm FIDAvsQueryPerson . validateForm validateAvsQueryPerson $ \html -> 
-  flip (renderAForm FormStandard) html $ AvsPersonQuery 
+  flip (renderAForm FormStandard) html $ AvsQueryPerson 
     <$> aopt textField (fslI MsgAvsCardNo)             (avsPersonQueryCardNo              <$> tmpl)
     <*> aopt textField (fslI MsgAvsFirstName)          (avsPersonQueryFirstName           <$> tmpl)
     <*> aopt textField (fslI MsgAvsLastName)           (avsPersonQueryLastName            <$> tmpl)
     <*> aopt textField (fslI MsgAvsInternalPersonalNo) (avsPersonQueryInternalPersonalNo  <$> tmpl)
     <*> aopt textField (fslI MsgAvsVersionNo)          (avsPersonQueryVersionNo           <$> tmpl)
 
-validateAvsPersonQuery :: FormValidator AvsPersonQuery Handler ()
+validateAvsQueryPerson :: FormValidator AvsQueryPerson Handler ()
-validateAvsPersonQuery = do 
+validateAvsQueryPerson = do 
-  AvsPersonQuery{..} <- State.get
+  AvsQueryPerson{..} <- State.get
   guardValidation MsgAvsQueryEmpty $
     is _Just avsPersonQueryCardNo             ||
     is _Just avsPersonQueryFirstName          ||
@@ -46,23 +46,23 @@ validateAvsPersonQuery = do
     is _Just avsPersonQueryInternalPersonalNo ||
     is _Just avsPersonQueryVersionNo
 
-makeAvsStatusForm :: Maybe AvsStatusQuery -> Form AvsStatusQuery
+makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus
-makeAvsStatusForm tmpl = identifyForm FIDAvsStatusQuery . validateForm validateAvsStatusQuery $ \html -> 
+makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html -> 
   flip (renderAForm FormStandard) html $
      parseAvsIds <$> areq textField (fslI MsgAvsCardNo) (unparseAvsIds <$> tmpl)
   where 
-    parseAvsIds :: Text -> AvsStatusQuery
+    parseAvsIds :: Text -> AvsQueryStatus
-    parseAvsIds txt = AvsStatusQuery $ Set.fromList ids
+    parseAvsIds txt = AvsQueryStatus $ Set.fromList ids
       where 
         nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt 
         ids = catMaybes $ readMay <$> nonemptys
-    unparseAvsIds :: AvsStatusQuery -> Text 
+    unparseAvsIds :: AvsQueryStatus -> Text 
-    unparseAvsIds (AvsStatusQuery ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids 
+    unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids 
 
-validateAvsStatusQuery :: FormValidator AvsStatusQuery Handler ()
+validateAvsQueryStatus :: FormValidator AvsQueryStatus Handler ()
-validateAvsStatusQuery = do 
+validateAvsQueryStatus = do 
-  AvsStatusQuery ids <- State.get
+  AvsQueryStatus ids <- State.get
-  guardValidation (MsgAvsStatusQueryInvalid $ tshow ids) $ not (null ids)
+  guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids)
 -}
 getAdminApcR, postAdminApcR :: Handler Html
 getAdminApcR = postAdminApcR

src/Handler/Admin/Avs.hs

@@ -14,18 +14,18 @@ import Handler.Utils
 import Utils.Avs
 
 
-makeAvsPersonForm :: Maybe AvsPersonQuery -> Form AvsPersonQuery
+makeAvsPersonForm :: Maybe AvsQueryPerson -> Form AvsQueryPerson
-makeAvsPersonForm tmpl = identifyForm FIDAvsPersonQuery . validateForm validateAvsPersonQuery $ \html -> 
+makeAvsPersonForm tmpl = identifyForm FIDAvsQueryPerson . validateForm validateAvsQueryPerson $ \html -> 
-  flip (renderAForm FormStandard) html $ AvsPersonQuery 
+  flip (renderAForm FormStandard) html $ AvsQueryPerson 
     <$> aopt textField (fslI MsgAvsCardNo)             (avsPersonQueryCardNo              <$> tmpl)
     <*> aopt textField (fslI MsgAvsFirstName)          (avsPersonQueryFirstName           <$> tmpl)
     <*> aopt textField (fslI MsgAvsLastName)           (avsPersonQueryLastName            <$> tmpl)
     <*> aopt textField (fslI MsgAvsInternalPersonalNo) (avsPersonQueryInternalPersonalNo  <$> tmpl)
     <*> aopt textField (fslI MsgAvsVersionNo)          (avsPersonQueryVersionNo           <$> tmpl)
 
-validateAvsPersonQuery :: FormValidator AvsPersonQuery Handler ()
+validateAvsQueryPerson :: FormValidator AvsQueryPerson Handler ()
-validateAvsPersonQuery = do 
+validateAvsQueryPerson = do 
-  AvsPersonQuery{..} <- State.get
+  AvsQueryPerson{..} <- State.get
   guardValidation MsgAvsQueryEmpty $
     is _Just avsPersonQueryCardNo             ||
     is _Just avsPersonQueryFirstName          ||
@@ -33,23 +33,23 @@ validateAvsPersonQuery = do
     is _Just avsPersonQueryInternalPersonalNo ||
     is _Just avsPersonQueryVersionNo
 
-makeAvsStatusForm :: Maybe AvsStatusQuery -> Form AvsStatusQuery
+makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus
-makeAvsStatusForm tmpl = identifyForm FIDAvsStatusQuery . validateForm validateAvsStatusQuery $ \html -> 
+makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html -> 
   flip (renderAForm FormStandard) html $
      parseAvsIds <$> areq textField (fslI MsgAvsCardNo) (unparseAvsIds <$> tmpl)
   where 
-    parseAvsIds :: Text -> AvsStatusQuery
+    parseAvsIds :: Text -> AvsQueryStatus
-    parseAvsIds txt = AvsStatusQuery $ Set.fromList ids
+    parseAvsIds txt = AvsQueryStatus $ Set.fromList ids
       where         
         nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt 
         ids = catMaybes $ readMay <$> nonemptys
-    unparseAvsIds :: AvsStatusQuery -> Text 
+    unparseAvsIds :: AvsQueryStatus -> Text 
-    unparseAvsIds (AvsStatusQuery ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids 
+    unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids 
 
-validateAvsStatusQuery :: FormValidator AvsStatusQuery Handler ()
+validateAvsQueryStatus :: FormValidator AvsQueryStatus Handler ()
-validateAvsStatusQuery = do 
+validateAvsQueryStatus = do 
-  AvsStatusQuery ids <- State.get
+  AvsQueryStatus ids <- State.get
-  guardValidation (MsgAvsStatusQueryInvalid $ tshow ids) $ not (null ids)
+  guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids)
 
 getAdminAvsR, postAdminAvsR :: Handler Html
 getAdminAvsR = postAdminAvsR

src/Utils/Avs.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE GADTs #-} 
-
 module Utils.Avs where
 
 import Import.NoModel hiding ((.=))
@@ -14,15 +12,14 @@ import Data.Aeson.Types
 
 import Servant
 import Servant.Client
-
+import Servant.Client.Core (requestPath)
--- import qualified Network.HTTP.Client as HTTP (newManager, defaultManagerSettings) -- just to speed up type checking
 
 
 
 -- | Like (.:) but attempts parsing with case-insensitve keys as fallback.
---   Note that the type also works for optional Field
+--   Note that the type also works for an optional field
 --   Taken from Data.Aeson.Filthy, which could somehow not be added as a dependency.
-(.:~) :: FromJSON a => Object -> Text -> Parser a     
+(.:~) :: FromJSON a => Object -> Text -> Parser a
 o .:~ key = o .: key <|> maybe empty parseJSON go
     where go = lookup (Text.toLower key) [(Text.toLower k, v) | (k,v) <- HM.toList o]
 
@@ -41,10 +38,16 @@ instance ToJSON SloppyBool where
     toJSON _                 = "false"
 
 instance FromJSON SloppyBool where
-    parseJSON (Bool b)          = pure $ SloppyBool b
+    parseJSON (Bool b)  = pure $ SloppyBool b
     parseJSON (String t)
-     | Text.toLower t == "true" = pure $ SloppyBool True    
+        | lowb == "true"  = true
-    parseJSON _                 = pure $ SloppyBool False
+        | lowb == "t"     = true
+        | lowb == "f"     = false
+        | lowb == "false" = false
+      where lowb    = Text.toLower $ Text.strip t
+            true  = pure $ SloppyBool True
+            false = pure $ SloppyBool False
+    parseJSON invalid   = prependFailure "parsing SloppyBool failed, " $ fail $ "expected Bool or String encoding boolean. Found " ++ show invalid
 
 type AvsPersonId = Int
 
@@ -58,24 +61,24 @@ instance ToJSON AvsDataCardColor where
   toJSON AvsCardColorGelb = "Gelb"
   toJSON (AvsCardColorMisc t) = String t
 
-instance FromJSON AvsDataCardColor where 
+instance FromJSON AvsDataCardColor where
-  parseJSON (String t) = case Text.toLower t of 
+  parseJSON (String t) = case Text.toLower t of
-    "grün" -> pure AvsCardColorGrün 
+    "grün" -> pure AvsCardColorGrün
     "blau" -> pure AvsCardColorBlau
-    "rot"  -> pure AvsCardColorRot 
+    "rot"  -> pure AvsCardColorRot
     "gelb" -> pure AvsCardColorGelb
     _      -> pure $ AvsCardColorMisc t
   parseJSON invalid = prependFailure "parsing AvsDataCardColor failed, " (typeMismatch "String" invalid)
 
-data AvsDataPersonCard = AvsDataPersonCard 
+data AvsDataPersonCard = AvsDataPersonCard
       { avsDataCardAreas :: Set Char -- logically a set of upper-case letters
       , avsDataCardColor :: AvsDataCardColor
-      , avsDataCardNo    :: Text  -- always 8 digits 
+      , avsDataCardNo    :: Text  -- always 8 digits
       , avsDataVersionNo :: Text
       , avsDataValid     :: Bool    -- unfortunately, AVS encodes Booleans as JSON String "true" and "false" and not as JSON Booleans
       -- only the above are contained in AvsResponseStatus
-      , avsDataValidTo   :: Maybe Day 
+      , avsDataValidTo   :: Maybe Day
-      , avsDataIssueDate :: Maybe Day 
+      , avsDataIssueDate :: Maybe Day
       , avsDataFirm      :: Maybe Text
       , avsDataCity      :: Maybe Text
       , avsDataStreet    :: Maybe Text
@@ -84,12 +87,12 @@ data AvsDataPersonCard = AvsDataPersonCard
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
 {- Instead of programming entirely by hand, why not dump splices and adjust? -}
-instance FromJSON AvsDataPersonCard where 
+instance FromJSON AvsDataPersonCard where
   parseJSON = withObject "AvsDataPersonCard" $ \v -> AvsDataPersonCard
     <$> ((v .: "CardAreas") <&> charSet)
     <*> v .: "CardColor"
-    <*> v .: "CardNo"    
+    <*> v .: "CardNo"
-    <*> v .: "VersionNo"     
+    <*> v .: "VersionNo"
     <*> ((v .: "Valid") <&> sloppyBool)
     <*> v .:? "ValidTo"
     <*> v .:? "IssueDate"
@@ -100,7 +103,7 @@ instance FromJSON AvsDataPersonCard where
 
 
 instance ToJSON AvsDataPersonCard where
-  toJSON AvsDataPersonCard{..} = object 
+  toJSON AvsDataPersonCard{..} = object
     [ "CardAreas"   .= Set.foldl Text.snoc Text.empty avsDataCardAreas
     , "CardColor"   .= avsDataCardColor
     , "CardNo"      .= avsDataCardNo
@@ -125,14 +128,14 @@ deriveJSON defaultOptions
   { fieldLabelModifier = \case { "avsStatusPersonCardStatus" -> "personCardStatus"; others -> dropCamel 2 others }
   , omitNothingFields = True
   , tagSingleConstructors = False
-  , rejectUnknownFields = False 
+  , rejectUnknownFields = False
   } ''AvsStatusPerson
 
 data AvsDataPerson = AvsDataPerson
-      { avsPersonFirstName          :: Text 
+      { avsPersonFirstName          :: Text
-      , avsPersonLastName           :: Text 
+      , avsPersonLastName           :: Text
       , avsPersonInternalPersonalNo :: Maybe Text   -- Fraport Personalnummer
-      , avsPersonPersonNo           :: AvsPersonId  -- AVS Personennummer 
+      , avsPersonPersonNo           :: AvsPersonId  -- AVS Personennummer
       , avsPersonPersonID           :: AvsPersonId  -- Eindeutige PersonenID, wichtig für die Schnittstelle!
       , avsPersonPersonCards        :: Set AvsDataPersonCard
       }
@@ -142,7 +145,7 @@ deriveJSON defaultOptions
   { fieldLabelModifier = \case { "avsPersonPersonCards" -> "personCards"; others -> dropCamel 2 others }
   , omitNothingFields = True
   , tagSingleConstructors = False
-  , rejectUnknownFields = False 
+  , rejectUnknownFields = False
   } ''AvsDataPerson
 
 
@@ -157,16 +160,16 @@ deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
   , tagSingleConstructors = False
-  , rejectUnknownFields = False 
+  , rejectUnknownFields = False
   } ''AvsResponseStatus
 
 newtype AvsResponsePerson = AvsResponsePerson (Set AvsDataPerson)
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
-deriveJSON defaultOptions 
+deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
   , tagSingleConstructors = False
-  , rejectUnknownFields = False 
+  , rejectUnknownFields = False
   } ''AvsResponsePerson
 
 
@@ -174,7 +177,7 @@ deriveJSON defaultOptions
 -------------
 -- Queries --
 -------------
-data AvsPersonQuery = AvsPersonQuery
+data AvsQueryPerson = AvsQueryPerson
         { avsPersonQueryCardNo             :: Maybe Text
         , avsPersonQueryFirstName          :: Maybe Text
         , avsPersonQueryLastName           :: Maybe Text
@@ -183,18 +186,19 @@ data AvsPersonQuery = AvsPersonQuery
         }
   deriving (Eq, Ord, Read, Show, Generic, Typeable)
 
-instance Default AvsPersonQuery where 
+instance Default AvsQueryPerson where
-  def = AvsPersonQuery Nothing Nothing Nothing Nothing Nothing
+  def = AvsQueryPerson Nothing Nothing Nothing Nothing Nothing
 
-deriveJSON defaultOptions 
+deriveJSON defaultOptions
   { fieldLabelModifier    = dropCamel 3
   , omitNothingFields     = True
   , tagSingleConstructors = False
-  , rejectUnknownFields   = False 
+  , rejectUnknownFields   = False
-  } ''AvsPersonQuery
+  } ''AvsQueryPerson
 
-newtype AvsStatusQuery = AvsStatusQuery (Set AvsPersonId)
+newtype AvsQueryStatus = AvsQueryStatus (Set AvsPersonId)
-deriveJSON defaultOptions ''AvsStatusQuery 
+  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+deriveJSON defaultOptions ''AvsQueryStatus
 
 
 
@@ -202,58 +206,45 @@ deriveJSON defaultOptions ''AvsStatusQuery
 -- AVS API --
 -------------
 type AVS = BasicAuth "avs_fradrive" String :> "FraVSMService" :> "v1" :> (AVSPersonSearch :<|> AVSPersonStatus)
-type AVSPersonSearch = "PersonSearch" :> ReqBody '[JSON] AvsPersonQuery :> Post '[JSON] AvsResponsePerson
+type AVSPersonSearch = "PersonSearch" :> ReqBody '[JSON] AvsQueryPerson :> Post '[JSON] AvsResponsePerson
-type AVSPersonStatus = "PersonStatus" :> ReqBody '[JSON] AvsStatusQuery :> Post '[JSON] AvsResponseStatus
+type AVSPersonStatus = "PersonStatus" :> ReqBody '[JSON] AvsQueryStatus :> Post '[JSON] AvsResponseStatus
 
 avsApi :: Proxy AVS
 avsApi = Proxy
 
-{- Somehow the GADT-style declaration is not flexible enough to compile at the location of the function call
+{-
-data AvsQuery where 
+-- Somehow the GADT-style declaration is not flexible enough to compile at the location of the function call
-  AvsQuery :: { avsQueryPerson :: MonadIO m => AvsPersonQuery -> m (Either ClientError AvsResponsePerson)
+data AvsQuery where
-              , avsQueryStatus :: MonadIO m => AvsStatusQuery -> m (Either ClientError AvsResponseStatus)
+  AvsQuery :: { avsQueryPerson :: MonadIO m => AvsQueryPerson -> m (Either ClientError AvsResponsePerson)
-              } 
+              , avsQueryStatus :: MonadIO m => AvsQueryStatus -> m (Either ClientError AvsResponseStatus)
+              }
       -> AvsQuery
 -}
 
 data AvsQuery = AvsQuery
-  { avsQueryPerson :: forall m. MonadIO m => AvsPersonQuery -> m (Either ClientError AvsResponsePerson)
+  { avsQueryPerson :: forall m. MonadIO m => AvsQueryPerson -> m (Either ClientError AvsResponsePerson)
-  , avsQueryStatus :: forall m. MonadIO m => AvsStatusQuery -> m (Either ClientError AvsResponseStatus)
+  , avsQueryStatus :: forall m. MonadIO m => AvsQueryStatus -> m (Either ClientError AvsResponseStatus)
   }
 
 
 makeLenses_ ''AvsQuery
 
-mkAvsQuery :: BasicAuthData -> ClientEnv -> AvsQuery
+mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
-mkAvsQuery basicAuth cliEnv = AvsQuery
+mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
-    { avsQueryPerson = \q -> liftIO $ runClientM (rawQueryPerson q) cliEnv
+    { avsQueryPerson = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson q) cliEnv
-    , avsQueryStatus = \q -> liftIO $ runClientM (rawQueryStatus q) cliEnv
+    , avsQueryStatus = \q -> liftIO $                     runClientM (rawQueryStatus q) cliEnv
     }
-  where 
+  where
-    (rawQueryPerson :<|> rawQueryStatus) = client avsApi basicAuth        
+    (rawQueryPerson :<|> rawQueryStatus) = client avsApi basicAuth
+    catch404toEmpty :: Either ClientError AvsResponsePerson -> Either ClientError AvsResponsePerson
+    catch404toEmpty (Left (FailureResponse (requestPath -> (base, _path)) (statusCode . responseStatusCode -> 404)))
+      | baseUrl == base = Right $ AvsResponsePerson mempty -- WORKAROUND: AVS server erroneously returns 404 if no matching person could be found in its database!
+    catch404toEmpty other = other 
 
-
+{- 
-{-
+  TODOs    
--- DEMO to check that it types here instead of waiting for Application to be compiled
+    Connect AVS query to LDAP queries for automatic synchronisation:
-run :: IO ()
+    - add query to Auth.LDAP.campusUserMatr
-run = do
+    - add query to Auth.LDAP.campusLogin 
-  let (_avsPersonSearch :<|> avsPersonStatus) = client avsApi avsAuth
+    - jobs.Handler.dispatchJobSynchroniseLdap
-  manager' <- HTTP.newManager HTTP.defaultManagerSettings
-  let query = avsPersonStatus $ AvsStatusQuery $ Set.singleton 123
-  res <- runClientM query (mkClientEnv manager' avsServer)
-  case res of
-    Left err -> putStrLn $ "Error: " ++ tshow err
-    --Right resp -> do
-    Right (AvsResponseStatus resp) -> do
-      print resp
-  where 
-    avsServer :: BaseUrl
-    avsServer = BaseUrl
-      { baseUrlScheme = Https
-      , baseUrlHost   = "skytest.fra.fraport.de"
-      , baseUrlPort   = 80
-      , baseUrlPath   = ""
-      }
-
-    avsAuth = BasicAuthData "foo" "bar"
 -}

src/Utils/Form.hs

@@ -295,8 +295,8 @@ data FormIdentifier
   | FIDTestDownload
   | FIDAllocationRegister
   | FIDAllocationNotification
-  | FIDAvsPersonQuery
+  | FIDAvsQueryPerson
-  | FIDAvsStatusQuery
+  | FIDAvsQueryStatus
   deriving (Eq, Ord, Read, Show)
 
 instance PathPiece FormIdentifier where

test/Model/TypesSpec.hs

@@ -401,24 +401,6 @@ instance Arbitrary SheetAuthorshipStatementMode where
 instance Arbitrary LmsStatus where
   arbitrary = genericArbitrary
 
-instance Arbitrary AvsDataCardColor where 
-  arbitrary = genericArbitrary
-
-instance Arbitrary AvsDataPersonCard where
-  arbitrary = genericArbitrary
-
-instance Arbitrary AvsStatusPerson where
-  arbitrary = genericArbitrary
-
-instance Arbitrary AvsDataPerson where
-  arbitrary = genericArbitrary
-
-instance Arbitrary AvsResponsePerson where
-  arbitrary = genericArbitrary
-
-instance Arbitrary AvsResponseStatus where
-  arbitrary = genericArbitrary
-
 
 spec :: Spec
 spec = do
@@ -533,10 +515,6 @@ spec = do
       [ eqLaws, ordLaws, showLaws, showReadLaws, boundedEnumLaws, finiteLaws, pathPieceLaws, jsonLaws, jsonKeyLaws, persistFieldLaws, binaryLaws, httpApiDataLaws ]
     lawsCheckHspec (Proxy @LmsStatus)
       [ eqLaws, ordLaws, showLaws, showReadLaws, jsonLaws ]
-    lawsCheckHspec (Proxy @AvsResponsePerson)
-      [ eqLaws, showLaws, showReadLaws, jsonLaws]
-    lawsCheckHspec (Proxy @AvsResponseStatus)
-      [ eqLaws, showLaws, showReadLaws, jsonLaws]
 
   describe "TermIdentifier" $ do
     it "has compatible encoding/decoding to/from Text" . property $

test/Utils/TypesSpec.hs

@@ -0,0 +1,51 @@
+module Utils.TypesSpec where
+
+import TestImport
+
+import Utils.Avs
+
+
+instance Arbitrary AvsDataCardColor where 
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance Arbitrary AvsDataPersonCard where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance Arbitrary AvsStatusPerson where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance Arbitrary AvsDataPerson where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance Arbitrary AvsResponsePerson where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance Arbitrary AvsResponseStatus where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance Arbitrary AvsQueryStatus where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+instance Arbitrary AvsQueryPerson where
+  arbitrary = genericArbitrary
+  shrink = genericShrink
+
+
+spec :: Spec
+spec = do
+  parallel $ do
+    lawsCheckHspec (Proxy @AvsResponsePerson)
+      [ eqLaws, showLaws, showReadLaws, jsonLaws]
+    lawsCheckHspec (Proxy @AvsResponseStatus)
+      [ eqLaws, showLaws, showReadLaws, jsonLaws]
+    lawsCheckHspec (Proxy @AvsQueryPerson)
+      [ eqLaws, showLaws, showReadLaws, jsonLaws]
+    lawsCheckHspec (Proxy @AvsQueryStatus)
+      [ eqLaws, showLaws, showReadLaws, jsonLaws]