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

fix(build)

Browse Source
This commit is contained in:
Steffen Jost 2022-11-29 19:04:43 +01:00
parent 8d5836c457
commit 617706b895
1 changed files with 44 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
src/Handler/Admin/Avs.hs
View File

@ -4,7 +4,7 @@
module Handler.Admin.Avs module Handler.Admin.Avs
( getAdminAvsR ( getAdminAvsR
, postAdminAvsR , postAdminAvsR
) where ) where
import Import import Import
@ -28,7 +28,7 @@ nullaryPathPiece ''ButtonAvsTest camelToPathPiece
instance Button UniWorX ButtonAvsTest where instance Button UniWorX ButtonAvsTest where
btnLabel BtnCheckLicences = "Check all licences" -- could be msg btnLabel BtnCheckLicences = "Check all licences" -- could be msg
btnClasses BtnCheckLicences = [BCIsButton, BCPrimary] btnClasses BtnCheckLicences = [BCIsButton, BCPrimary]
-- END Button -- END Button
@ -36,16 +36,17 @@ avsCardNoField :: Monad m => RenderMessage (HandlerSite m) FormMessage => Field
avsCardNoField = convertField AvsCardNo avsCardNo textField avsCardNoField = convertField AvsCardNo avsCardNo textField
makeAvsPersonForm :: Maybe AvsQueryPerson -> Form AvsQueryPerson makeAvsPersonForm :: Maybe AvsQueryPerson -> Form AvsQueryPerson
makeAvsPersonForm tmpl = identifyForm FIDAvsQueryPerson . validateForm validateAvsQueryPerson $ \html -> makeAvsPersonForm tmpl = identifyForm FIDAvsQueryPerson . validateForm validateAvsQueryPerson $ \html ->
flip (renderAForm FormStandard) html $ AvsQueryPerson flip (renderAForm FormStandard) html $ AvsQueryPerson
<$> aopt avsCardNoField (fslI MsgAvsCardNo) (avsPersonQueryCardNo <$> tmpl) <$> aopt avsCardNoField (fslI MsgAvsCardNo) (avsPersonQueryCardNo <$> tmpl)
<*> aopt textField (fslI MsgAvsVersionNo) (avsPersonQueryVersionNo <$> tmpl)
<*> aopt textField (fslI MsgAvsFirstName) (avsPersonQueryFirstName <$> tmpl) <*> aopt textField (fslI MsgAvsFirstName) (avsPersonQueryFirstName <$> tmpl)
<*> aopt textField (fslI MsgAvsLastName) (avsPersonQueryLastName <$> tmpl) <*> aopt textField (fslI MsgAvsLastName) (avsPersonQueryLastName <$> tmpl)
<*> aopt textField (fslI MsgAvsInternalPersonalNo) (avsPersonQueryInternalPersonalNo <$> tmpl) <*> aopt textField (fslI MsgAvsInternalPersonalNo) (avsPersonQueryInternalPersonalNo <$> tmpl)
<*> aopt textField (fslI MsgAvsVersionNo) (avsPersonQueryVersionNo <$> tmpl)
validateAvsQueryPerson :: FormValidator AvsQueryPerson Handler () validateAvsQueryPerson :: FormValidator AvsQueryPerson Handler ()
validateAvsQueryPerson = do validateAvsQueryPerson = do
AvsQueryPerson{..} <- State.get AvsQueryPerson{..} <- State.get
guardValidation MsgAvsQueryEmpty $ guardValidation MsgAvsQueryEmpty $
is _Just avsPersonQueryCardNo || is _Just avsPersonQueryCardNo ||
@ -55,31 +56,31 @@ validateAvsQueryPerson = do
is _Just avsPersonQueryVersionNo is _Just avsPersonQueryVersionNo
makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus makeAvsStatusForm :: Maybe AvsQueryStatus -> Form AvsQueryStatus
makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html -> makeAvsStatusForm tmpl = identifyForm FIDAvsQueryStatus . validateForm validateAvsQueryStatus $ \html ->
flip (renderAForm FormStandard) html $ flip (renderAForm FormStandard) html $
parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl) parseAvsIds <$> areq textField (fslI MsgAvsPersonId) (unparseAvsIds <$> tmpl)
where where
parseAvsIds :: Text -> AvsQueryStatus parseAvsIds :: Text -> AvsQueryStatus
parseAvsIds txt = AvsQueryStatus $ Set.fromList ids parseAvsIds txt = AvsQueryStatus $ Set.fromList ids
where where
nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt nonemptys = filter (not . Text.null) $ Text.strip <$> Text.split (==',') txt
ids = catMaybes $ readMay <$> nonemptys ids = catMaybes $ readMay <$> nonemptys
unparseAvsIds :: AvsQueryStatus -> Text unparseAvsIds :: AvsQueryStatus -> Text
unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids unparseAvsIds (AvsQueryStatus ids) = Text.intercalate ", " $ tshow <$> Set.toAscList ids
validateAvsQueryStatus :: FormValidator AvsQueryStatus Handler () validateAvsQueryStatus :: FormValidator AvsQueryStatus Handler ()
validateAvsQueryStatus = do validateAvsQueryStatus = do
AvsQueryStatus ids <- State.get AvsQueryStatus ids <- State.get
guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids) guardValidation (MsgAvsQueryStatusInvalid $ tshow ids) $ not (null ids)
avsLicenceOptions :: OptionList AvsLicence avsLicenceOptions :: OptionList AvsLicence
avsLicenceOptions = mkOptionList avsLicenceOptions = mkOptionList
[ Option [ Option
{ optionDisplay = Text.singleton $ licence2char l { optionDisplay = Text.singleton $ licence2char l
, optionInternalValue = l , optionInternalValue = l
, optionExternalValue = toJsonText l , optionExternalValue = toJsonText l
} }
| l <- universeF | l <- universeF
] ]
@ -92,27 +93,30 @@ postAdminAvsR = do
Just AvsQuery{..} -> do Just AvsQuery{..} -> do
((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing ((presult, pwidget), penctype) <- runFormPost $ makeAvsPersonForm Nothing
let procFormPerson fr = do let procFormPerson fr = do
addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
res <- avsQueryPerson fr res <- avsQueryPerson fr
case res of case res of
Left err -> return . Just $ tshow err Left err -> return . Just $ tshow err
Right jsn -> return . Just $ tshow jsn Right jsn -> return . Just $ tshow jsn
mbPerson <- formResultMaybe presult procFormPerson mbPerson <- formResultMaybe presult procFormPerson
((sresult, swidget), senctype) <- runFormPost $ makeAvsStatusForm Nothing ((sresult, swidget), senctype) <- runFormPost $ makeAvsStatusForm Nothing
let procFormStatus fr = do let procFormStatus fr = do
addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
res <- avsQueryStatus fr res <- avsQueryStatus fr
case res of case res of
Left err -> return . Just $ tshow err Left err -> return . Just $ tshow err
Right jsn -> return . Just $ tshow jsn Right jsn -> return . Just $ tshow jsn
mbStatus <- formResultMaybe sresult procFormStatus mbStatus <- formResultMaybe sresult procFormStatus
((crUsrRes, crUsrWgt), crUsrEnctype) <- runFormPost $ identifyForm FIDAvsCreateUser $ \html -> ((crUsrRes, crUsrWgt), crUsrEnctype) <- runFormPost $ identifyForm FIDAvsCreateUser $ \html ->
flip (renderAForm FormStandard) html $ areq textField (fslI MsgAvsCardNo) Nothing flip (renderAForm FormStandard) html $ areq textField (fslI MsgAvsCardNo) Nothing
let procFormCrUsr fr = do let procFormCrUsr fr = do
addMessage Info $ text2Html $ "Query: " <> tshow (toJSON fr)
res <- try $ upsertAvsUser fr res <- try $ upsertAvsUser fr
case res of case res of
(Right (Just uid)) -> do (Right (Just uid)) -> do
uuid :: CryptoUUIDUser <- encrypt uid uuid :: CryptoUUIDUser <- encrypt uid
return $ Just [whamlet|<h2>Success:</h2> <a href=@{ForProfileR uuid}>User created or updated.|] return $ Just [whamlet|<h2>Success:</h2> <a href=@{ForProfileR uuid}>User created or updated.|]
(Right Nothing) -> (Right Nothing) ->
@ -122,12 +126,13 @@ postAdminAvsR = do
return $ Just [whamlet|<h2>Error:</h2> #{msg}|] return $ Just [whamlet|<h2>Error:</h2> #{msg}|]
mbCrUser <- formResultMaybe crUsrRes procFormCrUsr mbCrUser <- formResultMaybe crUsrRes procFormCrUsr
((getLicRes, getLicWgt), getLicEnctype) <- runFormPost $ identifyForm FIDAvsQueryLicence $ \html -> ((getLicRes, getLicWgt), getLicEnctype) <- runFormPost $ identifyForm FIDAvsQueryLicence $ \html ->
flip (renderAForm FormStandard) html $ areq intField (fslI MsgAvsPersonId) Nothing flip (renderAForm FormStandard) html $ areq intField (fslI MsgAvsPersonId) Nothing
let procFormGetLic fr = do let procFormGetLic fr = do
addMessage Info $ text2Html $ "Query: " <> tshow (toJSON (AvsPersonId fr))
res <- try $ getLicenceByAvsId $ AvsPersonId fr res <- try $ getLicenceByAvsId $ AvsPersonId fr
case res of case res of
(Right (Just lic)) -> (Right (Just lic)) ->
return $ Just [whamlet|<h2>Success:</h2> Licence #{tshow lic}|] return $ Just [whamlet|<h2>Success:</h2> Licence #{tshow lic}|]
(Right Nothing) -> (Right Nothing) ->
return $ Just [whamlet|<h2>Warning:</h2> User not found.|] return $ Just [whamlet|<h2>Warning:</h2> User not found.|]
@ -136,13 +141,13 @@ postAdminAvsR = do
return $ Just [whamlet|<h2>Error:</h2> #{msg}|] return $ Just [whamlet|<h2>Error:</h2> #{msg}|]
mbGetLic <- formResultMaybe getLicRes procFormGetLic mbGetLic <- formResultMaybe getLicRes procFormGetLic
((setLicRes, setLicWgt), setLicEnctype) <- runFormPost $ identifyForm FIDAvsSetLicence $ \html -> ((setLicRes, setLicWgt), setLicEnctype) <- runFormPost $ identifyForm FIDAvsSetLicence $ \html ->
flip (renderAForm FormStandard) html $ (,) <$> areq intField (fslI MsgAvsPersonId) Nothing flip (renderAForm FormStandard) html $ (,) <$> areq intField (fslI MsgAvsPersonId) Nothing
<*> areq (selectField $ return avsLicenceOptions) (fslI MsgAvsLicence) (Just AvsLicenceVorfeld) <*> areq (selectField $ return avsLicenceOptions) (fslI MsgAvsLicence) (Just AvsLicenceVorfeld)
let procFormSetLic (aid, lic) = do let procFormSetLic (aid, lic) = do
res <- try $ setLicenceAvs (AvsPersonId aid) lic res <- try $ setLicenceAvs (AvsPersonId aid) lic
case res of case res of
(Right True) -> (Right True) ->
return $ Just [whamlet|<h2>Success:</h2> Licence #{tshow (licence2char lic)} set for #{tshow aid}.|] return $ Just [whamlet|<h2>Success:</h2> Licence #{tshow (licence2char lic)} set for #{tshow aid}.|]
(Right False) -> (Right False) ->
return $ Just [whamlet|<h2>Error:</h2> Licence could not be set for #{tshow aid}.|] return $ Just [whamlet|<h2>Error:</h2> Licence could not be set for #{tshow aid}.|]
@ -153,10 +158,10 @@ postAdminAvsR = do
((qryLicRes, qryLicWgt), qryLicEnctype) <- runFormPost $ identifyForm FIDAvsQueryLicenceDiffs (buttonForm :: Form ButtonAvsTest) ((qryLicRes, qryLicWgt), qryLicEnctype) <- runFormPost $ identifyForm FIDAvsQueryLicenceDiffs (buttonForm :: Form ButtonAvsTest)
let procFormQryLic BtnCheckLicences = do let procFormQryLic BtnCheckLicences = do
res <- try checkLicences res <- try checkLicences
case res of case res of
(Right True) -> (Right True) ->
return $ Just [whamlet|<h2>Success:</h2> Licences sychronized.|] return $ Just [whamlet|<h2>Success:</h2> Licences sychronized.|]
(Right False) -> (Right False) ->
return $ Just [whamlet|<h2>Error:</h2> Licences could not be synchronized, see error log.|] return $ Just [whamlet|<h2>Error:</h2> Licences could not be synchronized, see error log.|]
@ -176,4 +181,4 @@ postAdminAvsR = do
setLicForm = wrapFormHere setLicWgt setLicEnctype setLicForm = wrapFormHere setLicWgt setLicEnctype
qryLicForm = wrapForm qryLicWgt def { formAction = Just $ SomeRoute actionUrl, formEncoding = qryLicEnctype, formSubmit = FormNoSubmit } qryLicForm = wrapForm qryLicWgt def { formAction = Just $ SomeRoute actionUrl, formEncoding = qryLicEnctype, formSubmit = FormNoSubmit }
-- TODO: use i18nWidgetFile instead if this is to become permanent -- TODO: use i18nWidgetFile instead if this is to become permanent
$(widgetFile "avs") $(widgetFile "avs")