chore(avs): adjust to newly refined VSM specifications (WIP)

src/Model/Types/Avs.hs

@@ -137,10 +137,14 @@ instance ToJSON AvsLicence where
     toJSON AvsLicenceRollfeld = Number 2
 
 instance FromJSON AvsLicence where
-  parseJSON (Number n)  | n == 0 = pure AvsNoLicence
+  parseJSON (Number n)  | n == 1 = pure AvsLicenceVorfeld   -- ordered by occurrence, n==1 is most common case
-                        | n == 1 = pure AvsLicenceVorfeld
                         | n == 2 = pure AvsLicenceRollfeld
+                        | n == 0 = pure AvsNoLicence        -- n==0 never received from AVS, only sent to AVS
+#ifdef DEVELOPMENT
   parseJSON invalid = prependFailure "parsing AvsLicence failed, " $ fail $ "expected Int value being 0, 1 or 2. Found " ++ show invalid
+#else
+  parseJSON _ = pure AvsNoLicence     -- we simply ignore all other values
+#endif
 
 -- | Ought to be identical to QualificationShortname!
 licence2char :: AvsLicence -> Char
@@ -312,8 +316,7 @@ deriveJSON defaultOptions
 
 data AvsPersonLicence = AvsPersonLicence
       { avsLicencePersonID     :: AvsPersonId
-      , avsLicenceRampLicence  :: AvsLicence    -- Schnittstelle unklar: RampDrivingLicence oder RampLicence
+      , avsLicenceRampLicence  :: AvsLicence      
-      --, avsLicenceRampDrivingLicence  :: AvsLicence
       }
   deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions
@@ -324,16 +327,21 @@ deriveJSON defaultOptions
   } ''AvsPersonLicence
 
 data AvsLicenceResponse = AvsLicenceResponse
-      { avsResponsePersonID :: AvsPersonId
+        { avsResponsePersonID :: AvsPersonId
-      , avsResponseSuccess  :: SloppyBool
+        , avsResponseSuccess  :: SloppyBool
-      , avsResponseMessage  :: Text
+        , avsResponseMessage  :: Text
-      }
+        }
+      | AvsErrorResponse
+        { avsResponseStatus   :: Text
+        , avsResponseMessage  :: Text
+        }
     deriving (Eq, Ord, Show, Generic, Typeable)
 deriveJSON defaultOptions
   { fieldLabelModifier = dropCamel 2
   , omitNothingFields = True
   , tagSingleConstructors = False
   , rejectUnknownFields = False
+  , sumEncoding = UntaggedValue
   } ''AvsLicenceResponse
 
 

src/Utils/Avs.hs

@@ -43,7 +43,7 @@ data AvsQuery where
 
 data AvsQuery = AvsQuery
   { avsQueryPerson         :: forall m. MonadIO m => AvsQueryPerson      -> m (Either ClientError AvsResponsePerson)
-  , avsQueryStatus         :: forall m. MonadIO m => AvsQueryStatus      -> m (Either ClientError AvsResponseStatus)  
+  , avsQueryStatus         :: forall m. MonadIO m => AvsQueryStatus      -> m (Either ClientError AvsResponseStatus)
   , avsQuerySetLicences    :: forall m. MonadIO m => AvsQuerySetLicences -> m (Either ClientError AvsResponseSetLicences)
   , avsQueryGetLicences    :: forall m. MonadIO m => AvsQueryGetLicences -> m (Either ClientError AvsResponseGetLicences)
   , avsQueryGetAllLicences :: forall m. MonadIO m =>                        m (Either ClientError AvsResponseGetLicences)
@@ -59,7 +59,7 @@ avsQueryAllLicences = AvsQueryGetLicences $ Set.singleton $ AvsObjPersonId $ Avs
 mkAvsQuery :: BaseUrl -> BasicAuthData -> ClientEnv -> AvsQuery
 mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
     { avsQueryPerson      = \q -> liftIO $ catch404toEmpty <$> runClientM (rawQueryPerson      q)  cliEnv
-    , avsQueryStatus      = \q -> liftIO $                     runClientM (rawQueryStatus      q)  cliEnv        
+    , avsQueryStatus      = \q -> liftIO $                     runClientM (rawQueryStatus      q)  cliEnv
     , avsQuerySetLicences = \q -> liftIO $                     runClientM (rawQuerySetLicences q)  cliEnv
     , avsQueryGetLicences = \q -> liftIO $                     runClientM (rawQueryGetLicences q)  cliEnv
     , avsQueryGetAllLicences =    liftIO $                     runClientM (rawQueryGetLicences avsQueryAllLicences) cliEnv
@@ -71,7 +71,7 @@ mkAvsQuery baseUrl basicAuth cliEnv = AvsQuery
       | baseUrl == base = Right $ AvsResponsePerson mempty -- WORKAROUND: AVS server erroneously returns 404 if no matching person could be found in its database!
     catch404toEmpty other = other
 
-    
+
 -----------------------
 -- Utility Functions --
 -----------------------
@@ -140,7 +140,7 @@ bestAddress :: AvsDataPersonCard -> AvsDataPersonCard -> Ordering
 -- Merges several answers by AvsPersonId, preserving all AvsPersonCards
 mergeByPersonId :: Set AvsDataPerson -> Map AvsPersonId AvsDataPerson -> Map AvsPersonId AvsDataPerson
 mergeByPersonId = flip $ Set.foldr aux
-  where 
+  where
     aux :: AvsDataPerson -> Map AvsPersonId AvsDataPerson -> Map AvsPersonId AvsDataPerson
     aux adp = mergeAvsDataPerson $ catalogueAvsDataPerson adp
 
@@ -148,13 +148,13 @@ catalogueAvsDataPerson :: AvsDataPerson -> Map AvsPersonId AvsDataPerson
 catalogueAvsDataPerson adp = Map.singleton (avsPersonPersonID adp) adp
 
 mergeAvsDataPerson :: Map AvsPersonId AvsDataPerson -> Map AvsPersonId AvsDataPerson -> Map AvsPersonId AvsDataPerson
-mergeAvsDataPerson = Map.unionWithKey merger 
+mergeAvsDataPerson = Map.unionWithKey merger
-  where 
+  where
     merger :: AvsPersonId -> AvsDataPerson -> AvsDataPerson -> AvsDataPerson
-    merger api pa pb = 
+    merger api pa pb =
       let pickBy' :: Ord b => (a -> b) -> (AvsDataPerson -> a) -> a
           pickBy' f p = pickBy f (p pa) (p pb) -- pickBy f `on` p pa pb
-      in AvsDataPerson 
+      in AvsDataPerson
         { avsPersonFirstName          = pickBy' Text.length avsPersonFirstName
         , avsPersonLastName           = pickBy' Text.length avsPersonLastName
         , avsPersonInternalPersonalNo = pickBy' (Text.length . fromMaybe mempty) avsPersonInternalPersonalNo
@@ -163,8 +163,8 @@ mergeAvsDataPerson = Map.unionWithKey merger
         , avsPersonPersonCards        = (Set.union `on` avsPersonPersonCards) pa pb
         }
 
-    pickBy :: Ord b => (a -> b) -> a -> a -> a 
+    pickBy :: Ord b => (a -> b) -> a -> a -> a
-    pickBy f x y  | f x >= f y = x 
+    pickBy f x y  | f x >= f y = x
                   | otherwise  = y