diff --git a/config/settings.yml b/config/settings.yml index d801bbca2..3593e7890 100644 --- a/config/settings.yml +++ b/config/settings.yml @@ -129,7 +129,7 @@ avs: host: "_env:AVSHOST:skytest.fra.fraport.de" port: "_env:AVSPORT:80" user: "_env:AVSUSER:fradrive" - pass: "_env:AVSPASS:123" + pass: "_env:AVSPASS:" smtp: host: "_env:SMTPHOST:" diff --git a/messages/uniworx/categories/avs/de-de-formal.msg b/messages/uniworx/categories/avs/de-de-formal.msg new file mode 100644 index 000000000..64049e1e4 --- /dev/null +++ b/messages/uniworx/categories/avs/de-de-formal.msg @@ -0,0 +1,5 @@ +AvsCardNo: Ausweiskartennummer +AvsFirstName: Vorname +AvsLastName: Nachname +AvsInternalPersonalNo: Personalnummer (nur Fraport AG) +AvsVersionNo: Versionsnummer \ No newline at end of file diff --git a/messages/uniworx/categories/avs/en-eu.msg b/messages/uniworx/categories/avs/en-eu.msg new file mode 100644 index 000000000..263aa4778 --- /dev/null +++ b/messages/uniworx/categories/avs/en-eu.msg @@ -0,0 +1,5 @@ +AvsCardNo: Card number +AvsFirstName: First name +AvsLastName: Last name +AvsInternalPersonalNo: Personnel number (Fraport AG only) +AvsVersionNo: Version number \ No newline at end of file diff --git a/messages/uniworx/utils/navigation/menu/de-de-formal.msg b/messages/uniworx/utils/navigation/menu/de-de-formal.msg index 481330989..6192f9f1a 100644 --- a/messages/uniworx/utils/navigation/menu/de-de-formal.msg +++ b/messages/uniworx/utils/navigation/menu/de-de-formal.msg @@ -132,5 +132,7 @@ MenuLmsResult: Melden Ergebnisse E-Lernen MenuLmsUpload: Hochladen MenuLmsDirect: Direkter Upload +MenuAvs: Schnitstelle AVS + MenuApiDocs: API-Dokumentation (Englisch) MenuSwagger !ident-ok: OpenAPI 2.0 (Swagger) \ No newline at end of file diff --git a/messages/uniworx/utils/navigation/menu/en-eu.msg b/messages/uniworx/utils/navigation/menu/en-eu.msg index 4a5c4b5f8..b9297cb40 100644 --- a/messages/uniworx/utils/navigation/menu/en-eu.msg +++ b/messages/uniworx/utils/navigation/menu/en-eu.msg @@ -133,5 +133,7 @@ MenuLmsResult: Upload E-Learning Results MenuLmsUpload: Upload MenuLmsDirect: Direct Upload +MenuAvs: AVS Interface + MenuApiDocs: API documentation MenuSwagger: OpenAPI 2.0 (Swagger) diff --git a/routes b/routes index 3ee36007f..4417ddf6e 100644 --- a/routes +++ b/routes @@ -59,6 +59,7 @@ /admin/errMsg AdminErrMsgR GET POST /admin/tokens AdminTokensR GET POST /admin/crontab AdminCrontabR GET +/admin/avs AdminAvsR GET POST /health HealthR GET !free /instance InstanceR GET !free diff --git a/src/Foundation/I18n.hs b/src/Foundation/I18n.hs index bff47bc43..ad8ca332d 100644 --- a/src/Foundation/I18n.hs +++ b/src/Foundation/I18n.hs @@ -15,6 +15,7 @@ module Foundation.I18n , UniWorXTermMessage(..), UniWorXSendMessage(..), UniWorXSiteLayoutMessage(..), UniWorXErrorMessage(..) , UniWorXI18nMessage(..),UniWorXJobsHandlerMessage(..), UniWorXModelTypesMessage(..), UniWorXYesodMiddlewareMessage(..) , UniWorXQualificationMessage(..) + , UniWorXAvsMessage(..) , UniWorXAuthorshipStatementMessage(..) , ShortTermIdentifier(..) , 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 "User" "messages/uniworx/categories/user" "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 "Form" "messages/uniworx/utils/handler_form" "de-de-formal" mkMessageAddition ''UniWorX "TableColumn" "messages/uniworx/utils/table_column" "de-de-formal" diff --git a/src/Foundation/Navigation.hs b/src/Foundation/Navigation.hs index fefd51814..27234cd01 100644 --- a/src/Foundation/Navigation.hs +++ b/src/Foundation/Navigation.hs @@ -104,6 +104,7 @@ breadcrumb AdminTestPdfR = i18nCrumb MsgMenuAdminTest $ Just AdminTest breadcrumb AdminErrMsgR = i18nCrumb MsgMenuAdminErrMsg $ Just AdminR breadcrumb AdminTokensR = i18nCrumb MsgMenuAdminTokens $ Just AdminR breadcrumb AdminCrontabR = i18nCrumb MsgBreadcrumbAdminCrontab $ Just AdminR +breadcrumb AdminAvsR = i18nCrumb MsgMenuAvs $ Just AdminR breadcrumb SchoolListR = i18nCrumb MsgMenuSchoolList $ Just AdminR breadcrumb (SchoolR ssh sRoute) = case sRoute of @@ -794,6 +795,15 @@ defaultLinks = fmap catMaybes . mapM runMaybeT $ -- Define the menu items of the , navQuick' = mempty , navForceActive = False } + , NavLink + { navLabel = MsgMenuAvs + , navRoute = AdminAvsR + , navAccess' = NavAccessTrue + , navType = NavTypeLink { navModal = False } + , navQuick' = mempty + , navForceActive = False + } + ] } , return NavHeaderContainer diff --git a/src/Handler/Admin.hs b/src/Handler/Admin.hs index 9752d878b..262223ac4 100644 --- a/src/Handler/Admin.hs +++ b/src/Handler/Admin.hs @@ -8,7 +8,7 @@ import Handler.Admin.Test as Handler.Admin import Handler.Admin.ErrorMessage as Handler.Admin import Handler.Admin.Tokens as Handler.Admin import Handler.Admin.Crontab as Handler.Admin - +import Handler.Admin.Avs as Handler.Admin getAdminR :: Handler Html getAdminR = diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs new file mode 100644 index 000000000..a8ce57bca --- /dev/null +++ b/src/Handler/Admin/Avs.hs @@ -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") diff --git a/src/Handler/Utils.hs b/src/Handler/Utils.hs index e8eff78b6..5d635e60e 100644 --- a/src/Handler/Utils.hs +++ b/src/Handler/Utils.hs @@ -29,8 +29,6 @@ import Handler.Utils.AuthorshipStatement 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 diff --git a/src/Handler/Utils/Servant/AVS.hs b/src/Handler/Utils/Servant/Avs.hs similarity index 89% rename from src/Handler/Utils/Servant/AVS.hs rename to src/Handler/Utils/Servant/Avs.hs index 51b7406e0..b88dd204d 100644 --- a/src/Handler/Utils/Servant/AVS.hs +++ b/src/Handler/Utils/Servant/Avs.hs @@ -3,7 +3,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeOperators #-} -module Handler.Utils.Servant.AVS where +module Handler.Utils.Servant.Avs where import Import import Servant @@ -13,11 +13,11 @@ import Servant.Client import qualified Network.HTTP.Client as HTTP (newManager, defaultManagerSettings) data AvsPersonQuery = AvsPersonQuery - { avsPersonQueryCardNo :: Maybe String - , avsPersonQueryFirstName :: Maybe String - , avsPersonQueryLastName :: Maybe String - , avsPersonQueryInternalPersonalNo :: Maybe String - , avsPersonQueryVersionNo :: Maybe String + { avsPersonQueryCardNo :: Maybe Text + , avsPersonQueryFirstName :: Maybe Text + , avsPersonQueryLastName :: Maybe Text + , avsPersonQueryInternalPersonalNo :: Maybe Text + , avsPersonQueryVersionNo :: Maybe Text } deriving (Eq, Ord, Read, Show, Generic, Typeable) diff --git a/src/Settings.hs b/src/Settings.hs index 8daf8dabf..2ce4292b7 100644 --- a/src/Settings.hs +++ b/src/Settings.hs @@ -72,7 +72,7 @@ import Text.Show (showParen, showString) import qualified Data.List.PointedList as P import qualified Network.Minio as Minio - + import Data.Conduit.Algorithms.FastCDC import Utils.Lens.TH @@ -120,13 +120,13 @@ data AppSettings = AppSettings , appSessionTokenClockLeniencyStart, appSessionTokenClockLeniencyEnd , appBearerTokenClockLeniencyStart, appBearerTokenClockLeniencyEnd , appUploadTokenClockLeniencyStart, appUploadTokenClockLeniencyEnd :: Maybe NominalDiffTime - + , appMailObjectDomain :: Text , appMailVerp :: VerpMode , appMailRetainSent :: Maybe NominalDiffTime - , appMailEnvelopeFrom :: Text + , appMailEnvelopeFrom :: Text , appMailFrom - , appMailSender + , appMailSender , appMailSupport :: Address , appMailUseReplyToInstead :: Bool , appJobWorkers :: Natural @@ -145,7 +145,7 @@ data AppSettings = AppSettings , appHealthCheckInterval :: HealthCheck -> Maybe NominalDiffTime , appHealthCheckDelayNotify :: Bool , appHealthCheckHTTP :: Bool - + , appHealthCheckActiveJobExecutorsTimeout :: NominalDiffTime , appHealthCheckActiveWidgetMemcachedTimeout :: NominalDiffTime , appHealthCheckSMTPConnectTimeout :: NominalDiffTime @@ -160,7 +160,7 @@ data AppSettings = AppSettings , appSessionFilesExpire :: NominalDiffTime , appKeepUnreferencedFiles :: NominalDiffTime - + , appPruneUnreferencedFilesWithin :: Maybe NominalDiffTime , appPruneUnreferencedFilesInterval :: NominalDiffTime @@ -302,8 +302,8 @@ data LdapConf = LdapConf data AvsConf = AvsConf { avsHost :: String , avsPort :: Int - , avsUser :: ByteString - , avsPass :: ByteString + , avsUser :: ByteString + , avsPass :: ByteString } deriving (Show) data SmtpConf = SmtpConf @@ -318,7 +318,7 @@ data WidgetMemcachedConf = WidgetMemcachedConf { widgetMemcachedConf :: MemcachedConf , widgetMemcachedBaseUrl :: Text } deriving (Show) - + data MemcachedConf = MemcachedConf { memcachedConnectInfo :: Memcached.ConnectInfo , memcachedExpiry :: Maybe NominalDiffTime @@ -416,7 +416,7 @@ deriveJSON defaultOptions deriveJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 } ''ARCConf - + deriveJSON defaultOptions { fieldLabelModifier = camelToPathPiece' 1 } ''PrewarmCacheConf @@ -439,7 +439,7 @@ instance FromJSON LdapConf where | spec == "insecure" -> return $ Just Ldap.insecureTlsSettings | spec == "default" -> return $ Just Ldap.defaultTlsSettings | spec == "none" -> return Nothing - | spec == "notls" -> return Nothing + | spec == "notls" -> return Nothing | null spec -> return Nothing Nothing -> return Nothing _otherwise -> fail "Could not parse LDAP TLSSettings" @@ -472,12 +472,12 @@ deriveFromJSON } ''HaskellNet.AuthType -instance FromJSON AvsConf where +instance FromJSON AvsConf where parseJSON = withObject "AvsConf" $ \o -> do avsHost <- o .: "host" avsPort <- o .: "port" avsUser <- o .: "user" - avsPass <- o .: "pass" + avsPass <- o .:? "pass" .!= "" return AvsConf{..} instance FromJSON SmtpConf where @@ -527,7 +527,7 @@ instance FromJSON Minio.ConnectInfo where connectAutoDiscoverRegion <- o .:? "auto-discover-region" .!= True connectDisableTLSCertValidation <- o .:? "disable-cert-validation" .!= False return Minio.ConnectInfo{..} - + instance FromJSON ServerSessionSettings where parseJSON = withObject "ServerSession.State" $ \o -> do @@ -588,7 +588,7 @@ instance FromJSON AppSettings where appMailSender <- o .:? "mail-sender" .!= appMailFrom appMailObjectDomain <- o .: "mail-object-domain" appMailUseReplyToInstead <- o .: "mail-use-replyto-instead-sender" .!= True - + appMailVerp <- fromMaybe VerpNone . join <$> (o .:? "mail-verp" <|> pure Nothing) appMailRetainSent <- o .: "mail-retain-sent" appMailSupport <- o .: "mail-support" diff --git a/templates/avs.hamlet b/templates/avs.hamlet new file mode 100644 index 000000000..a6646bc72 --- /dev/null +++ b/templates/avs.hamlet @@ -0,0 +1,7 @@ +
+

+ Abfrage: + ^{formWidget} + $maybe answer <- mbAnswer +

Unverarbeitete Antwort: + #{answer}