chore(avs): fix parsing for avs admin status query interface

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

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

src/Handler/Admin/Avs.hs

@@ -39,7 +39,7 @@ makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus
 makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html -> 
   flip (renderAForm FormStandard) html $
      parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl)
-  where 
+  where
     parseAvsIds :: Text -> AvsQueryStatus
     parseAvsIds txt = AvsQueryStatus $ Set.fromList ids
       where         

src/Jobs/Handler/LMS.hs

@@ -52,7 +52,7 @@ dispatchJobLmsEnqueue qid = JobHandlerAtomic act
     act = do
       quali <- getJust qid -- may throw an error, aborting the job
       let qshort = CI.original $ qualificationShorthand quali
-      $logInfoS "lms" $ "Notifying about exipiring qualification " <> qshort
+      $logInfoS "LMS" $ "Notifying about exipiring qualification " <> qshort
       now <- liftIO getCurrentTime
       case qualificationRefreshWithin quali of
         Nothing -> return () -- no automatic scheduling for this qid
@@ -129,7 +129,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
     act = do
       quali <- getJust qid -- may throw an error, aborting the job
       let qshort = CI.original $ qualificationShorthand quali
-      $logInfoS "lms" $ "Processing e-learning results for qualification " <> qshort
+      $logInfoS "LMS" $ "Processing e-learning results for qualification " <> qshort
       now <- liftIO getCurrentTime
       -- TODO: notify expired used 
           -- let nowaday = utctDay now
@@ -143,7 +143,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
         Nothing -> return () -- no automatic removal
         (Just auditDuration) -> do
           let auditCutoff = addDiffDaysRollOver (fromMonths $ negate auditDuration) now
-          $logInfoS "lms" $ "Audit Cuttoff at " <> tshow auditCutoff <> " for Audit Duration " <> tshow auditDuration
+          $logInfoS "LMS" $ "Audit Cuttoff at " <> tshow auditCutoff <> " for Audit Duration " <> tshow auditDuration
           delusersVals <- E.select $ do
             luser <- E.from $ E.table @LmsUser
             E.where_ $  luser E.^. LmsUserQualification E.==. E.val qid
@@ -159,7 +159,7 @@ dispatchJobLmsDequeue qid = JobHandlerAtomic act
           let delusers = E.unValue <$> delusersVals
               numdel = length delusers              
           when (numdel > 0) $ do
-            $logInfoS "lms" $ "Deleting " <> tshow numdel <> " LmsIdents due to audit duration expiry for qualification " <> qshort
+            $logInfoS "LMS" $ "Deleting " <> tshow numdel <> " LmsIdents due to audit duration expiry for qualification " <> qshort
             deleteWhere [LmsUserQualification     ==. qid, LmsUserIdent     <-. delusers]
             deleteWhere [LmsUserlistQualification ==. qid, LmsUserlistIdent <-. delusers]
             deleteWhere [LmsResultQualification   ==. qid, LmsResultIdent   <-. delusers]

src/Model/Types/Avs.hs

@@ -72,20 +72,12 @@ instance FromJSON SloppyBool where
     parseJSON invalid   = prependFailure "parsing SloppyBool failed, " $ fail $ "expected Bool or String encoding boolean. Found " ++ show invalid
 
 
--- AVS Datatypes
+-------------------
-newtype AvsPersonId = AvsPersonId { avsPersonId :: Int }
+-- AVS Datatypes --
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+-------------------
-  deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField)
-instance E.SqlString AvsPersonId
--- AvsPersonId is an untagged Int with respect to FromJSON/ToJSON, as needed by AVS API
-instance FromJSON AvsPersonId where
-  parseJSON x = AvsPersonId <$> parseJSON x
-instance ToJSON AvsPersonId where
-  toJSON (AvsPersonId pid) = toJSON pid
-
 
 newtype AvsCardNo = AvsCardNo { avsCardNo :: Text }  -- always 8 digits
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
   deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField)
 instance E.SqlString AvsCardNo
 -- AvsCardNo is an untagged Text with respect to FromJSON/ToJSON, as needed by AVS API
@@ -94,6 +86,34 @@ instance FromJSON AvsCardNo where
 instance ToJSON AvsCardNo where
   toJSON (AvsCardNo cno) = toJSON cno
 
+-- The AVS API requires PersonIds sometimes as as mere numbers `AvsPersonId` and sometimes as tagged objects `AvsObjPersonId`
+newtype AvsPersonId = AvsPersonId { avsPersonId :: Int } -- untagged Int
+  deriving (Eq, Ord, Generic, Typeable)
+  deriving newtype (NFData, PathPiece, PersistField, PersistFieldSql, Csv.ToField, Csv.FromField)
+instance E.SqlString AvsPersonId
+-- As opposed to AvsObjPersonId, AvsPersonId is an untagged Int with respect to FromJSON/ToJSON, as needed by AVS API; 
+instance FromJSON AvsPersonId where
+  parseJSON x = AvsPersonId <$> parseJSON x
+instance ToJSON AvsPersonId where
+  toJSON (AvsPersonId pid) = toJSON pid
+-- Cannot tell difference between AvsPersonId and Int through Show and Read. A good or a bad idea?
+instance Show AvsPersonId where
+  show = show . avsPersonId
+instance Read AvsPersonId where
+  readPrec = fmap AvsPersonId readPrec  
+
+
+newtype AvsObjPersonId = AvsObjPersonId -- tagged object
+      { avsObjPersonID :: AvsPersonId
+      }
+  deriving (Eq, Ord, Show, Generic, Typeable)
+deriveJSON defaultOptions
+  { fieldLabelModifier = dropCamel 2
+  , omitNothingFields = True
+  , tagSingleConstructors = False
+  , rejectUnknownFields = False
+  } ''AvsObjPersonId
+
 
 data AvsLicence = AvsNoLicence | AvsLicenceVorfeld | AvsLicenceRollfeld
   deriving (Bounded, Enum, Eq, Ord, Read, Show, Generic, Typeable)
@@ -151,7 +171,7 @@ data AvsDataPersonCard = AvsDataPersonCard
       , avsDataCardNo    :: AvsCardNo   -- always 8 digits
       , avsDataVersionNo :: Text
       }
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
   deriving anyclass (NFData)
 
 {- Automatically derived Ord instance should prioritize avsDataValid and avsDataValidTo. Checked in test/Model.TypesSpec
@@ -214,30 +234,14 @@ instance ToJSON AvsDataPersonCard where
     , "CardNo"      .= avsDataCardNo
     , "VersionNo"   .= avsDataVersionNo
     ]
-
 derivePersistFieldJSON ''AvsDataPersonCard
 
 
-
--- The AVS API sometimes requests PersonIds as numbers and sometimes as objects.
-newtype AvsObjPersonId = AvsObjPersonId
-      { avsObjPersonID :: AvsPersonId
-      }
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
-
-deriveJSON defaultOptions
-  { fieldLabelModifier = dropCamel 2
-  , omitNothingFields = True
-  , tagSingleConstructors = False
-  , rejectUnknownFields = False
-  } ''AvsObjPersonId
-
-
 data AvsStatusPerson = AvsStatusPerson
       { avsStatusPersonID         :: AvsPersonId
       , avsStatusPersonCardStatus :: Set AvsDataPersonCard -- only delivers non-Maybe fields, all Maybe-fields are Nothing
       }
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
 
 deriveJSON defaultOptions
   { fieldLabelModifier = \case { "avsStatusPersonCardStatus" -> "personCardStatus"; others -> dropCamel 2 others }
@@ -254,7 +258,7 @@ data AvsDataPerson = AvsDataPerson
       , avsPersonPersonID           :: AvsPersonId  -- Eindeutige PersonenID, wichtig für die Schnittstelle!
       , avsPersonPersonCards        :: Set AvsDataPersonCard
       }
-    deriving (Eq, Ord, Read, Show, Generic, Typeable)
+    deriving (Eq, Ord, Show, Generic, Typeable)
 
 makeLenses_ ''AvsDataPerson
 
@@ -297,7 +301,7 @@ data AvsPersonLicence = AvsPersonLicence
       , avsLicenceRampLicence  :: AvsLicence    -- Schnittstelle unklar: RampDrivingLicence oder RampLicence
       --, avsLicenceRampDrivingLicence  :: AvsLicence
       }
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
@@ -310,7 +314,7 @@ data AvsLicenceResponse = AvsLicenceResponse
       , avsResponseSuccess  :: SloppyBool
       , avsResponseMessage  :: Text
       }
-    deriving (Eq, Ord, Read, Show, Generic, Typeable)
+    deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
@@ -324,7 +328,7 @@ deriveJSON defaultOptions
 ---------------
 
 newtype AvsResponseStatus = AvsResponseStatus (Set AvsStatusPerson)
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
@@ -333,7 +337,7 @@ deriveJSON defaultOptions
   } ''AvsResponseStatus
 
 newtype AvsResponsePerson = AvsResponsePerson (Set AvsDataPerson)
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
@@ -342,7 +346,7 @@ deriveJSON defaultOptions
   } ''AvsResponsePerson
 
 newtype AvsResponseGetLicences = AvsResponseGetLicences (Set AvsPersonLicence)
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
@@ -351,7 +355,7 @@ deriveJSON defaultOptions
   } ''AvsResponseGetLicences
 
 newtype AvsResponseSetLicences = AvsResponseSetLicences (Set AvsLicenceResponse)
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
@@ -370,7 +374,7 @@ data AvsQueryPerson = AvsQueryPerson
         , avsPersonQueryInternalPersonalNo :: Maybe Text
         , avsPersonQueryVersionNo          :: Maybe Text
         }
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
 
 instance Default AvsQueryPerson where
   def = AvsQueryPerson Nothing Nothing Nothing Nothing Nothing
@@ -383,13 +387,13 @@ deriveJSON defaultOptions
   } ''AvsQueryPerson
 
 newtype AvsQueryStatus = AvsQueryStatus (Set AvsPersonId)
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions ''AvsQueryStatus
 
 newtype AvsQueryGetLicences = AvsQueryGetLicences (Set AvsObjPersonId)
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions ''AvsQueryGetLicences
 
 newtype AvsQuerySetLicences = AvsQuerySetLicences (Set AvsPersonLicence)
-  deriving (Eq, Ord, Read, Show, Generic, Typeable)
+  deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions ''AvsQuerySetLicences