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