chore(avs): add avs query form

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:"

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

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 

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)

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)

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

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"

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

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 =

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")  

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
 
 

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)
 

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"

templates/avs.hamlet

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