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

chore(sap): show SAP ids in tooltip; also refactor canonical

Browse Source
This commit is contained in:
Steffen Jost 2022-11-24 18:19:14 +01:00
parent c30a6003c5
commit 1b4911b300
9 changed files with 64 additions and 36 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
messages/uniworx/categories/qualification/en-eu.msg
View File

@ -14,9 +14,9 @@ TableQualificationCountActive: Active
TableQualificationCountActiveTooltip: Number of currently valid qualification holders
TableQualificationCountTotal: Total
TableQualificationIsAvsLicence: AVS Driving License
TableQualificationIsAvsLicenceTooltip: Is this Qualification synchronized with AVS? Only applies to qualification holders having an AVS PersonID.
TableQualificationIsAvsLicenceTooltip: Under which name is this qualification synchronized with AVS, if any? Only applies to qualification holders having an AVS PersonID.
TableQualificationSapExport: Sent to SAP
TableQualificationSapExportTooltip: Is this Qualification transmitted to SAP? Only applies to qualification holder having a Fraport Personnelnumber.
TableQualificationSapExportTooltip: Is this qualification transmitted to SAP? Only applies to qualification holder having a Fraport AG personnel number.
LmsQualificationValidUntil: Valid until
TableQualificationLastRefresh: Last renewed
TableQualificationFirstHeld: First held

2
messages/uniworx/categories/user/de-de-formal.msg
View File

@ -13,7 +13,7 @@ AdminUserAuth: Authentifizierung
AdminUserMatriculation: Matrikelnummer
AdminUserSex: Geschlecht
AdminUserTelephone: Telefonnummer
AdminUserMobile: Mobiltelefonmummer
AdminUserMobile: Mobiltelefonnummer
AdminUserFPersonalNumber: Personalnummer (nur Fraport AG)
AdminUserFDepartment: Abteilung
AdminUserPostAddress: Postalische Anschrift

2
routes
View File

@ -285,7 +285,7 @@
/qualification/#SchoolId/#QualificationShorthand QualificationR GET -- TODO repurpose
-- SAP export
/qualifications/sap/direct QualificationSAPDirectR GET !system-sap
/qualifications/sap/direct QualificationSAPDirectR GET !token
-- OSIS CSV Export Demo
/lms LmsAllR GET POST !free -- TODO verify that this is ok
/lms/#SchoolId LmsSchoolR GET !free -- TODO verify that this is ok

15
src/Handler/LMS.hs
View File

@ -83,8 +83,9 @@ postLmsAllR = do
FormMissing -> return ()
_other -> addMessage Warning "Kein korrekter LMS Knopf erkannt"
isAdmin <- hasReadAccessTo AdminR
lmsTable <- runDB $ do
view _2 <$> mkLmsAllTable
view _2 <$> mkLmsAllTable isAdmin
siteLayoutMsg MsgMenuQualifications $ do
setTitleI MsgMenuQualifications
$(widgetFile "lms-all")
@ -100,9 +101,10 @@ resultAllQualificationTotal :: Lens' AllQualificationTableData Word64
resultAllQualificationTotal = _dbrOutput . _3 . _unValue
mkLmsAllTable :: DB (Any, Widget)
mkLmsAllTable = do
mkLmsAllTable :: Bool -> DB (Any, Widget)
mkLmsAllTable isAdmin = do
now <- liftIO getCurrentTime
let
resultDBTable = DBTable{..}
where
@ -139,7 +141,12 @@ mkLmsAllTable = do
, sortable Nothing (i18nCell MsgTableQualificationIsAvsLicence & cellTooltip MsgTableQualificationIsAvsLicenceTooltip)
$ \(view (resultAllQualification . _qualificationAvsLicence) -> licence) -> maybeCell licence $ textCell . T.singleton . licence2char
, sortable Nothing (i18nCell MsgTableQualificationSapExport & cellTooltip MsgTableQualificationSapExportTooltip)
$ \(view (resultAllQualification . _qualificationSapId) -> sapid) -> tickmarkCell $ isJust sapid
$ \(view (resultAllQualification . _qualificationSapId) -> mbSapId) ->
let icn = IconOK -- change icon here, if desired
in case mbSapId of
Nothing -> mempty
Just sapId | isAdmin -> cellTooltipIcon (Just icn) (text2message sapId) mempty
Just _ -> iconCell icn
, sortable Nothing (i18nCell MsgTableQualificationCountActive & cellTooltip MsgTableQualificationCountActiveTooltip)
$ \(view resultAllQualificationActive -> n) -> wgtCell $ word2widget n
, sortable Nothing (i18nCell MsgTableQualificationCountTotal) $ wgtCell . word2widget . view resultAllQualificationTotal

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

@ -4,7 +4,7 @@
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-} -- TODO: remove this line, once the module is completed
module Handler.Utils.Avs
( upsertAvsUser, upsertAvsUserById, upsertAvsUserByCard
@ -118,7 +118,7 @@ setLicencesAvs pls = do
-- Only react to changes as compared to last seen status in avs.model
-- TODO: turn into a job, once the interface is actually available
checkLicences :: Handler ()
checkLicences = do
checkLicences = do
{-
AvsQuery{..} <- maybeThrowM AvsInterfaceUnavailable $ getsYesod $ view _appAvsQuery
AvsResponseGetLicences licences <- throwLeftM avsQueryGetAllLicences
@ -146,7 +146,15 @@ checkLicences = do
`E.innerJoin` E.table @UserAvs
`E.on` (\(_ E.:& qualUser E.:& usrAvs) -> qualUser E.^. QualificationUserUser E.==. usrAvs E.^. UserAvsUser)
E.where_ $ E.isJust (quali E.^. QualificationAvsLicence)
E.&&. (usrAvs E.^. QualificationAvsLicence `E.notIn` E.valList
E.&&. (usrAvs E.^. QualificationAvsLicence `E.notIn` E.valList idsRollfeld)
SELECT *
FROM sometable
FULL OUTER JOIN
(VALUES {{1,2,3},{4,5,6}}) AS t(x,y,z)
ON sometable.x = t.x
WHERE either IS NULL -- Use ERaw
-- WAS WILL ICH HIER WIRKLICH:
-- Liefere alle avsIds, welche die falsche Qualifikation zugewiesen bekommen haben?
@ -164,7 +172,7 @@ checkLicences = do
upsertAvsUser :: Text -> Handler (Maybe UserId)
upsertAvsUser (discernAvsCardPersonalNo -> Just someid) = upsertAvsUserByCard someid -- Note: Right case is a number, it could be AvsPersonId or AvsInternalPersonalNumber; we cannot know, but the latter is much more likely and useful to users!
upsertAvsUser (discernAvsCardPersonalNo -> Just someid) = upsertAvsUserByCard someid -- Note: Right case is a number, it could be AvsCardNumber or AvsInternalPersonalNumber; we cannot know, but the latter is much more likely and useful to users!
upsertAvsUser _other = return Nothing -- TODO: attempt LDAP lookup to find by eMail; merely for convenience, not necessary right now
{- maybe this code helps?
upsRes :: Either CampusUserConversionException (Entity User)

11
src/Handler/Utils/Table/Pagination.hs
View File

@ -48,7 +48,7 @@ module Handler.Utils.Table.Pagination
, linkEitherCell, linkEitherCellM, linkEitherCellM'
, maybeAnchorCellM, maybeAnchorCellM', maybeLinkEitherCellM'
, anchorCellC, anchorCellCM, anchorCellCM', linkEitherCellCM', maybeLinkEitherCellCM'
, cellTooltip
, cellTooltip, cellTooltipIcon
, listCell, listCell', listCellOf, listCellOf'
, ilistCell, ilistCell', ilistCellOf, ilistCellOf'
, formCell, DBFormResult(..), getDBFormResult
@ -1691,10 +1691,13 @@ i18nCell msg = cell $ do
toWidget $ mr msg
cellTooltip :: (RenderMessage UniWorX msg, IsDBTable m a) => msg -> DBCell m a -> DBCell m a
cellTooltip msg = cellContents.mapped %~ (<> tipWdgt)
cellTooltip = cellTooltipIcon Nothing
cellTooltipIcon :: (RenderMessage UniWorX msg, IsDBTable m a) => Maybe Icon -> msg -> DBCell m a -> DBCell m a
cellTooltipIcon icn msg = cellContents.mapped %~ (<> tipWdgt)
where
tipWdgt = iconTooltip (msg2widget msg) Nothing True
tipWdgt = iconTooltip (msg2widget msg) icn True
-- | Always display widget; maybe a link if user is Authorized.
-- Also see variant `linkEmptyCell`
anchorCell :: (HasRoute UniWorX url, ToWidget UniWorX wgt, IsDBTable m a) => url -> wgt -> DBCell m a

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

@ -45,7 +45,7 @@ o .:?~ key = o .: key <|> maybe empty parseJSON go
-- Like (.:?) but maps Just null to Nothing, ie. Nothing instead of Just ""
(.:?!) :: (MonoFoldable a, FromJSON a) => Object -> Text -> Parser (Maybe a)
(.:?!) o k = null2nothing <$> (o .:? k)
(.:?!) o k = canonical <$> (o .:? k)
-- | `SloppyBool` successfully parses different variations of true/false
@ -256,18 +256,18 @@ instance Ord AvsDataPersonCard where
makeLenses_ ''AvsDataPersonCard
{-
instance Canonical AvsDataPersonCard where
canonical proto = proto { avsDataStreet = null2nothing $ avsDataStreet proto
, avsDataPostalCode = null2nothing $ avsDataPostalCode proto
, avsDataCity = null2nothing $ avsDataCity proto
, avsDataFirm = null2nothing $ avsDataFirm proto
canonical proto = proto { avsDataStreet = canonical $ avsDataStreet proto
, avsDataPostalCode = canonical $ avsDataPostalCode proto
, avsDataCity = canonical $ avsDataCity proto
, avsDataFirm = canonical $ avsDataFirm proto
}
-}
instance Canonical AvsDataPersonCard where
canonical proto =
proto & _avsDataStreet %~ null2nothing
& _avsDataPostalCode %~ null2nothing
& _avsDataCity %~ null2nothing
& _avsDataFirm %~ null2nothing
proto & _avsDataStreet %~ canonical
& _avsDataPostalCode %~ canonical
& _avsDataCity %~ canonical
& _avsDataFirm %~ canonical
-- TODO: use canonical in FromJSON/ToJSON instances for consistency
instance FromJSON AvsDataPersonCard where
@ -289,10 +289,10 @@ instance ToJSON AvsDataPersonCard where
catMaybes
[ ("ValidTo" .=) <$> avsDataValidTo
, ("IssueDate" .=) <$> avsDataIssueDate
, ("Street" .=) <$> (avsDataStreet & null2nothing)
, ("PostalCode" .=) <$> (avsDataPostalCode & null2nothing)
, ("City" .=) <$> (avsDataCity & null2nothing)
, ("Firm" .=) <$> (avsDataFirm & null2nothing)
, ("Street" .=) <$> (avsDataStreet & canonical)
, ("PostalCode" .=) <$> (avsDataPostalCode & canonical)
, ("City" .=) <$> (avsDataCity & canonical)
, ("Firm" .=) <$> (avsDataFirm & canonical)
]
<>
[ "Valid" .= show avsDataValid
@ -332,7 +332,7 @@ data AvsDataPerson = AvsDataPerson
makeLenses_ ''AvsDataPerson
instance Canonical AvsDataPerson where
canonical = over _avsPersonInternalPersonalNo null2nothing
canonical = over _avsPersonInternalPersonalNo canonical
. over _avsPersonPersonCards canonical
@ -347,7 +347,7 @@ instance FromJSON AvsDataPerson where
instance ToJSON AvsDataPerson where
toJSON AvsDataPerson{..} = object $
catMaybes [ ("InternalPersonalNo" .=) <$> (avsPersonInternalPersonalNo & null2nothing) ]
catMaybes [ ("InternalPersonalNo" .=) <$> (avsPersonInternalPersonalNo & canonical) ]
<>
[ "FirstName" .= avsPersonFirstName
, "LastName" .= avsPersonLastName

18
src/Utils.hs
View File

@ -816,10 +816,10 @@ toNothing = const Nothing
toNothingS :: String -> Maybe b
toNothingS = const Nothing
-- a more general formulation probably possible
null2nothing :: MonoFoldable a => Maybe a -> Maybe a
null2nothing (Just x) | null x = Nothing
null2nothing other = other
-- replaced by a more general formulation, see canonical
-- null2nothing :: MonoFoldable a => Maybe a -> Maybe a
-- null2nothing (Just x) | null x = Nothing
-- null2nothing other = other
-- | Swap 'Nothing' for 'Just' and vice versa
-- This belongs into Module 'Utils' but we have a weird cyclic
@ -1872,5 +1872,15 @@ makePrisms ''ExitCase
class Canonical a where
canonical :: a -> a
instance MonoFoldable mono => Canonical (Maybe mono) where
canonical (Just t) | null t = Nothing
canonical other = other
-- instance (Canonical mono, MonoFoldable mono) => Canonical (Maybe mono) where
-- canonical (Just t) | null t = Nothing
-- canonical (Just t) = Just $ canonical t
-- canonical other = other
-- this instance is more of a convenient abuse of the class (expand to Foldable)
instance (Ord a, Canonical a) => Canonical (Set a) where
canonical = Set.map canonical

2
test/Utils/TypesSpec.hs
View File

@ -55,7 +55,7 @@ instance Arbitrary AvsLicenceResponse where
shrink = genericShrink
instance Arbitrary AvsResponsePerson where
arbitrary = genericArbitrary
arbitrary = resize 5 genericArbitrary
shrink = genericShrink
instance Arbitrary AvsResponseStatus where