fraport/fradrive-old
Archived
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Steffen Jost 2022-11-17 12:55:58 +01:00
parent df559fead1
commit 734eb8927e
2 changed files with 53 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

29
src/Handler/Utils/Avs.hs
View File

@ -32,13 +32,13 @@ import Handler.Users.Add
-------------------- --------------------
data AvsException data AvsException
= AvsInterfaceUnavailable -- Interface to AVS was not configured at startup or does not respond = AvsInterfaceUnavailable -- Interface to AVS was not configured at startup or does not respond
| AvsUserUnassociated UserId -- Manipulating AVS Data for a user that is not linked to AVS yet | AvsUserUnassociated UserId -- Manipulating AVS Data for a user that is not linked to AVS yet
| AvsUserUnknownByAvs AvsPersonId -- AvsPersionId not (or no longer) found in AVS DB | AvsUserUnknownByAvs AvsPersonId -- AvsPersionId not (or no longer) found in AVS DB
| AvsUserAmbiguous -- Multiple matching existing users found in our DB | AvsUserAmbiguous -- Multiple matching existing users found in our DB
| AvsPersonSearchEmpty -- AvsPersonSearch returned empty result | AvsPersonSearchEmpty -- AvsPersonSearch returned empty result
| AvsPersonSearchAmbiguous -- AvsPersonSearch returned more than one result | AvsPersonSearchAmbiguous -- AvsPersonSearch returned more than one result
| AvsSetLicencesFailed Text -- AvsSetLicence total failure
deriving (Show, Generic, Typeable) deriving (Show, Generic, Typeable)
instance Exception AvsException instance Exception AvsException
@ -92,11 +92,16 @@ setLicencesAvs :: (MonadHandler m, MonadThrow m, HandlerSite m ~ UniWorX) =>
Set AvsPersonLicence -> m () Set AvsPersonLicence -> m ()
setLicencesAvs pls = do setLicencesAvs pls = do
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
AvsResponseSetLicences responses <- throwLeftM $ avsQuerySetLicences $ AvsQuerySetLicences pls response <- throwLeftM . avsQuerySetLicences $ AvsQuerySetLicences pls
forM_ responses $ \AvsLicenceResponse{..} -> case response of
unless (sloppyBool avsResponseSuccess) $ AvsResponseSetLicencesError{..} -> do
-- TODO: create an Admin Problems overview page $logErrorS "AVS" $ "Set licence failed completely: " <> avsResponseSetLicencesStatus <> ". Details: " <> avsResponseSetLicencesMessage
$logErrorS "AVS" $ "Set licence failed for " <> tshow avsResponsePersonID <> " due to " <> cropText avsResponseMessage throwM $ AvsSetLicencesFailed avsResponseSetLicencesStatus
AvsResponseSetLicences responses ->
forM_ responses $ \AvsLicenceResponse{..} ->
unless (sloppyBool avsResponseSuccess) $ do
-- TODO: create an Admin Problems overview page
$logErrorS "AVS" $ "Set licence failed for " <> tshow avsResponsePersonID <> " due to " <> cropText avsResponseMessage
-- | Retrieve all currently valid driving licences and check against our database -- | Retrieve all currently valid driving licences and check against our database

14
src/Model/Types/Avs.hs
View File

@ -331,17 +331,12 @@ data AvsLicenceResponse = AvsLicenceResponse
, avsResponseSuccess :: SloppyBool , avsResponseSuccess :: SloppyBool
, avsResponseMessage :: Text , avsResponseMessage :: Text
} }
| AvsErrorResponse
{ avsResponseStatus :: Text
, avsResponseMessage :: Text
}
deriving (Eq, Ord, Show, Generic, Typeable) deriving (Eq, Ord, Show, Generic, Typeable)
deriveJSON defaultOptions deriveJSON defaultOptions
{ fieldLabelModifier = dropCamel 2 { fieldLabelModifier = dropCamel 2
, omitNothingFields = True , omitNothingFields = True
, tagSingleConstructors = False , tagSingleConstructors = False
, rejectUnknownFields = False , rejectUnknownFields = False
, sumEncoding = UntaggedValue
} ''AvsLicenceResponse } ''AvsLicenceResponse
@ -376,13 +371,18 @@ deriveJSON defaultOptions
, rejectUnknownFields = False , rejectUnknownFields = False
} ''AvsResponseGetLicences } ''AvsResponseGetLicences
newtype AvsResponseSetLicences = AvsResponseSetLicences (Set AvsLicenceResponse) data AvsResponseSetLicences = AvsResponseSetLicences (Set AvsLicenceResponse)
| AvsResponseSetLicencesError
{ avsResponseSetLicencesStatus :: Text
, avsResponseSetLicencesMessage :: Text
}
deriving (Eq, Ord, Show, Generic, Typeable) deriving (Eq, Ord, Show, Generic, Typeable)
deriveJSON defaultOptions deriveJSON defaultOptions
{ fieldLabelModifier = dropCamel 2 { fieldLabelModifier = dropCamel 4
, omitNothingFields = True , omitNothingFields = True
, tagSingleConstructors = False , tagSingleConstructors = False
, rejectUnknownFields = False , rejectUnknownFields = False
, sumEncoding = UntaggedValue
} ''AvsResponseSetLicences } ''AvsResponseSetLicences