chore(avs): add avs query form

This commit is contained in:
Steffen Jost 2022-06-24 18:36:50 +02:00
parent caa96ce184
commit 27b4529c17
14 changed files with 95 additions and 25 deletions

View File

@ -129,7 +129,7 @@ avs:
host: "_env:AVSHOST:skytest.fra.fraport.de" host: "_env:AVSHOST:skytest.fra.fraport.de"
port: "_env:AVSPORT:80" port: "_env:AVSPORT:80"
user: "_env:AVSUSER:fradrive" user: "_env:AVSUSER:fradrive"
pass: "_env:AVSPASS:123" pass: "_env:AVSPASS:"
smtp: smtp:
host: "_env:SMTPHOST:" host: "_env:SMTPHOST:"

View File

@ -0,0 +1,5 @@
AvsCardNo: Ausweiskartennummer
AvsFirstName: Vorname
AvsLastName: Nachname
AvsInternalPersonalNo: Personalnummer (nur Fraport AG)
AvsVersionNo: Versionsnummer

View File

@ -0,0 +1,5 @@
AvsCardNo: Card number
AvsFirstName: First name
AvsLastName: Last name
AvsInternalPersonalNo: Personnel number (Fraport AG only)
AvsVersionNo: Version number

View File

@ -132,5 +132,7 @@ MenuLmsResult: Melden Ergebnisse E-Lernen
MenuLmsUpload: Hochladen MenuLmsUpload: Hochladen
MenuLmsDirect: Direkter Upload MenuLmsDirect: Direkter Upload
MenuAvs: Schnitstelle AVS
MenuApiDocs: API-Dokumentation (Englisch) MenuApiDocs: API-Dokumentation (Englisch)
MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger) MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger)

View File

@ -133,5 +133,7 @@ MenuLmsResult: Upload E-Learning Results
MenuLmsUpload: Upload MenuLmsUpload: Upload
MenuLmsDirect: Direct Upload MenuLmsDirect: Direct Upload
MenuAvs: AVS Interface
MenuApiDocs: API documentation MenuApiDocs: API documentation
MenuSwagger: OpenAPI 2.0 (Swagger) MenuSwagger: OpenAPI 2.0 (Swagger)

1
routes
View File

@ -59,6 +59,7 @@
/admin/errMsg AdminErrMsgR GET POST /admin/errMsg AdminErrMsgR GET POST
/admin/tokens AdminTokensR GET POST /admin/tokens AdminTokensR GET POST
/admin/crontab AdminCrontabR GET /admin/crontab AdminCrontabR GET
/admin/avs AdminAvsR GET POST
/health HealthR GET !free /health HealthR GET !free
/instance InstanceR GET !free /instance InstanceR GET !free

View File

@ -15,6 +15,7 @@ module Foundation.I18n
, UniWorXTermMessage(..), UniWorXSendMessage(..), UniWorXSiteLayoutMessage(..), UniWorXErrorMessage(..) , UniWorXTermMessage(..), UniWorXSendMessage(..), UniWorXSiteLayoutMessage(..), UniWorXErrorMessage(..)
, UniWorXI18nMessage(..),UniWorXJobsHandlerMessage(..), UniWorXModelTypesMessage(..), UniWorXYesodMiddlewareMessage(..) , UniWorXI18nMessage(..),UniWorXJobsHandlerMessage(..), UniWorXModelTypesMessage(..), UniWorXYesodMiddlewareMessage(..)
, UniWorXQualificationMessage(..) , UniWorXQualificationMessage(..)
, UniWorXAvsMessage(..)
, UniWorXAuthorshipStatementMessage(..) , UniWorXAuthorshipStatementMessage(..)
, ShortTermIdentifier(..) , ShortTermIdentifier(..)
, MsgLanguage(..) , MsgLanguage(..)
@ -208,6 +209,7 @@ mkMessageAddition ''UniWorX "Send" "messages/uniworx/categories/send" "de-de-for
mkMessageAddition ''UniWorX "YesodMiddleware" "messages/uniworx/categories/yesod_middleware" "de-de-formal" mkMessageAddition ''UniWorX "YesodMiddleware" "messages/uniworx/categories/yesod_middleware" "de-de-formal"
mkMessageAddition ''UniWorX "User" "messages/uniworx/categories/user" "de-de-formal" mkMessageAddition ''UniWorX "User" "messages/uniworx/categories/user" "de-de-formal"
mkMessageAddition ''UniWorX "Qualification" "messages/uniworx/categories/qualification" "de-de-formal" mkMessageAddition ''UniWorX "Qualification" "messages/uniworx/categories/qualification" "de-de-formal"
mkMessageAddition ''UniWorX "Avs" "messages/uniworx/categories/avs" "de-de-formal"
mkMessageAddition ''UniWorX "Button" "messages/uniworx/utils/buttons" "de-de-formal" mkMessageAddition ''UniWorX "Button" "messages/uniworx/utils/buttons" "de-de-formal"
mkMessageAddition ''UniWorX "Form" "messages/uniworx/utils/handler_form" "de-de-formal" mkMessageAddition ''UniWorX "Form" "messages/uniworx/utils/handler_form" "de-de-formal"
mkMessageAddition ''UniWorX "TableColumn" "messages/uniworx/utils/table_column" "de-de-formal" mkMessageAddition ''UniWorX "TableColumn" "messages/uniworx/utils/table_column" "de-de-formal"

View File

@ -104,6 +104,7 @@ breadcrumb AdminTestPdfR = i18nCrumb MsgMenuAdminTest $ Just AdminTest
breadcrumb AdminErrMsgR = i18nCrumb MsgMenuAdminErrMsg $ Just AdminR breadcrumb AdminErrMsgR = i18nCrumb MsgMenuAdminErrMsg $ Just AdminR
breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just AdminR breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just AdminR
breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR
breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR
breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR
breadcrumb (SchoolR ssh sRoute) = case sRoute of breadcrumb (SchoolR ssh sRoute) = case sRoute of
@ -794,6 +795,15 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the
, navQuick' = mempty , navQuick' = mempty
, navForceActive = False , navForceActive = False
} }
, NavLink
{ navLabel = MsgMenuAvs
, navRoute = AdminAvsR
, navAccess' = NavAccessTrue
, navType = NavTypeLink { navModal = False }
, navQuick' = mempty
, navForceActive = False
}
] ]
} }
, return NavHeaderContainer , return NavHeaderContainer

View File

@ -8,7 +8,7 @@ import Handler.Admin.Test as Handler.Admin
import Handler.Admin.ErrorMessage as Handler.Admin import Handler.Admin.ErrorMessage as Handler.Admin
import Handler.Admin.Tokens as Handler.Admin import Handler.Admin.Tokens as Handler.Admin
import Handler.Admin.Crontab as Handler.Admin import Handler.Admin.Crontab as Handler.Admin
import Handler.Admin.Avs as Handler.Admin
getAdminR :: Handler Html getAdminR :: Handler Html
getAdminR = getAdminR =

38
src/Handler/Admin/Avs.hs Normal file
View File

@ -0,0 +1,38 @@
module Handler.Admin.Avs
( getAdminAvsR
, postAdminAvsR
) where
import Import
import Handler.Utils
import Handler.Utils.Servant.Avs
makeAvsForm :: Maybe AvsPersonQuery -> Form AvsPersonQuery
-- makeAvsForm tmpl = identifyForm FIDavsPersonQuery $ \html ->
makeAvsForm tmpl html =
flip (renderAForm FormStandard) html $ AvsPersonQuery
<$> aopt textField (fslI MsgAvsCardNo) (avsPersonQueryCardNo <$> 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)
getAdminAvsR, postAdminAvsR :: Handler Html
getAdminAvsR = postAdminAvsR
postAdminAvsR = do
((result,widget), enctype) <- runFormPost $ makeAvsForm Nothing
let procForm _fr = do
addMessage Success $ toHtml ("Form received but ignored for now. TODO."::Text)
-- TODO
return $ Just ("TODO"::Text)
mbAnswer <- formResultMaybe result procForm
siteLayoutMsg MsgMenuAvs $ do
setTitleI MsgMenuAvs
let formWidget = wrapForm widget def
{ formAction = Just $ SomeRoute AdminAvsR
, formEncoding = enctype
}
-- TODO: use i18nWidgetFile instead if this is to become permanent
$(widgetFile "avs")

View File

@ -29,8 +29,6 @@ import Handler.Utils.AuthorshipStatement as Handler.Utils
import Handler.Utils.Term as Handler.Utils import Handler.Utils.Term as Handler.Utils
import Handler.Utils.Servant.AVS as Handler.Utils -- TODO: remove me later!
import Control.Monad.Logger import Control.Monad.Logger

View File

@ -3,7 +3,7 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeOperators #-} {-# LANGUAGE TypeOperators #-}
module Handler.Utils.Servant.AVS where module Handler.Utils.Servant.Avs where
import Import import Import
import Servant import Servant
@ -13,11 +13,11 @@ import Servant.Client
import qualified Network.HTTP.Client as HTTP (newManager, defaultManagerSettings) import qualified Network.HTTP.Client as HTTP (newManager, defaultManagerSettings)
data AvsPersonQuery = AvsPersonQuery data AvsPersonQuery = AvsPersonQuery
{ avsPersonQueryCardNo :: Maybe String { avsPersonQueryCardNo :: Maybe Text
, avsPersonQueryFirstName :: Maybe String , avsPersonQueryFirstName :: Maybe Text
, avsPersonQueryLastName :: Maybe String , avsPersonQueryLastName :: Maybe Text
, avsPersonQueryInternalPersonalNo :: Maybe String , avsPersonQueryInternalPersonalNo :: Maybe Text
, avsPersonQueryVersionNo :: Maybe String , avsPersonQueryVersionNo :: Maybe Text
} }
deriving (Eq, Ord, Read, Show, Generic, Typeable) deriving (Eq, Ord, Read, Show, Generic, Typeable)

View File

@ -477,7 +477,7 @@ instance FromJSON AvsConf where
avsHost <- o .: "host" avsHost <- o .: "host"
avsPort <- o .: "port" avsPort <- o .: "port"
avsUser <- o .: "user" avsUser <- o .: "user"
avsPass <- o .: "pass" avsPass <- o .:? "pass" .!= ""
return AvsConf{..} return AvsConf{..}
instance FromJSON SmtpConf where instance FromJSON SmtpConf where

7
templates/avs.hamlet Normal file
View File

@ -0,0 +1,7 @@
<section>
<p>
Abfrage:
^{formWidget}
$maybe answer <- mbAnswer
<p>Unverarbeitete Antwort:
#{answer}