diff --git a/messages/uniworx/categories/avs/de-de-formal.msg b/messages/uniworx/categories/avs/de-de-formal.msg
index 64049e1e4..f6c64fd08 100644
--- a/messages/uniworx/categories/avs/de-de-formal.msg
+++ b/messages/uniworx/categories/avs/de-de-formal.msg
@@ -2,4 +2,5 @@ AvsCardNo: Ausweiskartennummer
AvsFirstName: Vorname
AvsLastName: Nachname
AvsInternalPersonalNo: Personalnummer (nur Fraport AG)
-AvsVersionNo: Versionsnummer
\ No newline at end of file
+AvsVersionNo: Versionsnummer
+AvsQueryEmpty: Bitte mindestens ein Anfragefeld ausfüllen!
\ No newline at end of file
diff --git a/messages/uniworx/categories/avs/en-eu.msg b/messages/uniworx/categories/avs/en-eu.msg
index 263aa4778..1c9860fd1 100644
--- a/messages/uniworx/categories/avs/en-eu.msg
+++ b/messages/uniworx/categories/avs/en-eu.msg
@@ -2,4 +2,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
+AvsVersionNo: Version number
+AvsQueryEmpty: At least one query field must be filled!
\ No newline at end of file
diff --git a/src/Handler/Admin/Avs.hs b/src/Handler/Admin/Avs.hs
index a8ce57bca..5099d1d4d 100644
--- a/src/Handler/Admin/Avs.hs
+++ b/src/Handler/Admin/Avs.hs
@@ -4,13 +4,16 @@ module Handler.Admin.Avs
) where
import Import
+import qualified Control.Monad.State.Class as State
+-- import Data.Aeson (encode)
import Handler.Utils
import Handler.Utils.Servant.Avs
-makeAvsForm :: Maybe AvsPersonQuery -> Form AvsPersonQuery
--- makeAvsForm tmpl = identifyForm FIDavsPersonQuery $ \html ->
-makeAvsForm tmpl html =
+
+
+makeAvsPersonForm :: Maybe AvsPersonQuery -> Form AvsPersonQuery
+makeAvsPersonForm tmpl = identifyForm FIDAvsPersonQuery . validateForm validateAvsPersonQuery $ \html ->
flip (renderAForm FormStandard) html $ AvsPersonQuery
<$> aopt textField (fslI MsgAvsCardNo) (avsPersonQueryCardNo <$> tmpl)
<*> aopt textField (fslI MsgAvsFirstName) (avsPersonQueryFirstName <$> tmpl)
@@ -18,20 +21,55 @@ makeAvsForm tmpl html =
<*> aopt textField (fslI MsgAvsInternalPersonalNo) (avsPersonQueryInternalPersonalNo <$> tmpl)
<*> aopt textField (fslI MsgAvsVersionNo) (avsPersonQueryVersionNo <$> tmpl)
+validateAvsPersonQuery :: FormValidator AvsPersonQuery Handler ()
+validateAvsPersonQuery = do
+ AvsPersonQuery{..} <- State.get
+ guardValidation MsgAvsQueryEmpty $
+ is _Just avsPersonQueryCardNo ||
+ is _Just avsPersonQueryFirstName ||
+ is _Just avsPersonQueryLastName ||
+ is _Just avsPersonQueryInternalPersonalNo ||
+ is _Just avsPersonQueryVersionNo
+
+{-
+
+makeAvsForm :: Maybe AvsStatusQuery -> Form AvsStatusQuery
+makeAvsForm tmpl = identifyForm FIDAvsStatusQuery . validateForm validateAvsStatusQuery $ \html ->
+ flip (renderAForm FormStandard) html $ AvsStatusQuery
+ <$> 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)
+
+validateAvsPersonQuery :: FormValidator AvsPersonQuery Handler ()
+validateAvsPersonQuery = do
+ AvsPersonQuery{..} <- State.get
+ guardValidation MsgAvsQueryEmpty $
+ is _Just avsPersonQueryCardNo ||
+ is _Just avsPersonQueryFirstName ||
+ is _Just avsPersonQueryLastName ||
+ is _Just avsPersonQueryInternalPersonalNo ||
+ is _Just avsPersonQueryVersionNo
+-}
+
+
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)
+ ((result,widget), enctype) <- runFormPost $ makeAvsPersonForm Nothing
+ let procForm fr = do
+ res <- runAvsPersonSearch fr
+ case res of
+ Left err -> return $ Just err
+ Right jsn -> return $ Just $ tshow jsn
mbAnswer <- formResultMaybe result procForm
+ actionUrl <- fromMaybe AdminAvsR <$> getCurrentRoute
siteLayoutMsg MsgMenuAvs $ do
setTitleI MsgMenuAvs
let formWidget = wrapForm widget def
- { formAction = Just $ SomeRoute AdminAvsR
+ { formAction = Just $ SomeRoute actionUrl
, formEncoding = enctype
}
-- TODO: use i18nWidgetFile instead if this is to become permanent
diff --git a/src/Handler/Utils/Servant/Avs.hs b/src/Handler/Utils/Servant/Avs.hs
index b88dd204d..78d59ca34 100644
--- a/src/Handler/Utils/Servant/Avs.hs
+++ b/src/Handler/Utils/Servant/Avs.hs
@@ -6,12 +6,14 @@
module Handler.Utils.Servant.Avs where
import Import
-import Servant
+import Servant
import Servant.Client
-- import Servant.API.Flatten -- requires package servant-flatten
import qualified Network.HTTP.Client as HTTP (newManager, defaultManagerSettings)
-
+
+
+
data AvsPersonQuery = AvsPersonQuery
{ avsPersonQueryCardNo :: Maybe Text
, avsPersonQueryFirstName :: Maybe Text
@@ -52,6 +54,9 @@ type AVSRoute a = AVSAuth :> "FraVSMService" :> "v1" :> a
type AVSPersonSearch = "PersonSearch" :> ReqBody '[JSON] AvsPersonQuery :> Post '[JSON] AvsPersonResponse
type AVSPersonStatus = "PersonStatus" :> ReqBody '[JSON] AvsStatusQuery :> Post '[JSON] AvsStatusResponse
+avsApi :: Proxy AVS
+avsApi = Proxy
+
{-
-- Option 1:
type AVS = AVSRoute (AVSPersonSearch :<|> AVSPersonStatus)
@@ -75,18 +80,30 @@ avsPersonStatus :: BasicAuthData -> AvsStatusQuery -> ClientM AvsStatusResponse
(avsPersonSearch :<|> avsPersonStatus) = client avsApi
-avsApi :: Proxy AVS
-avsApi = Proxy
-
-avsServer :: BaseUrl
-avsServer = BaseUrl
- { baseUrlScheme = Https
- , baseUrlHost = "skytest.fra.fraport.de"
- , baseUrlPort = 80
- , baseUrlPath = ""
- }
+runAvsPersonSearch :: AvsPersonQuery -> Import.Handler (Either Text AvsPersonResponse)
+runAvsPersonSearch qry = do
+ manager <- getsYesod $ view _appHttpManager
+ mbAvsConf <- getsYesod $ view _appAvsConf
+ case mbAvsConf of
+ Nothing -> return $ Left "appAvsConfig is empty, i.e. invalid AVS configuration settings."
+ Just avsConf -> do
+ -- TODO: consider using Servant.Client.Core.parseBaseUrl within Settings already at Startup!
+ let avsServer = BaseUrl
+ { baseUrlScheme = Https
+ , baseUrlHost = avsHost avsConf
+ , baseUrlPort = avsPort avsConf
+ , baseUrlPath = ""
+ }
+ avsAuth = BasicAuthData
+ { basicAuthUsername = avsUser avsConf
+ , basicAuthPassword = avsPass avsConf
+ }
+ avsClient = mkClientEnv manager avsServer
+ fullQuery = avsPersonSearch avsAuth qry
+ liftIO $ over _Left tshow <$> runClientM fullQuery avsClient
+-- DEMO to check that it types
run :: IO ()
run = do
manager' <- HTTP.newManager HTTP.defaultManagerSettings
@@ -95,4 +112,12 @@ run = do
case res of
Left err -> putStrLn $ "Error: " ++ tshow err
Right resp -> do
- print resp
\ No newline at end of file
+ print resp
+ where
+ avsServer :: BaseUrl
+ avsServer = BaseUrl
+ { baseUrlScheme = Https
+ , baseUrlHost = "skytest.fra.fraport.de"
+ , baseUrlPort = 80
+ , baseUrlPath = ""
+ }
diff --git a/src/Utils.hs b/src/Utils.hs
index 36087b0cb..d7f9badf4 100644
--- a/src/Utils.hs
+++ b/src/Utils.hs
@@ -868,6 +868,11 @@ whenIsRight (Left _) _ = return ()
throwLeft :: (MonadThrow m, Exception exc) => Either exc a -> m a
throwLeft = either throwM return
+{- Just a reminder for Steffen:
+mapLeft :: (a -> c) -> Either a b -> Either c b
+mapLeft = over _Left
+-}
+
---------------
-- Exception --
---------------
diff --git a/src/Utils/Form.hs b/src/Utils/Form.hs
index c13ab1fa6..5528d88eb 100644
--- a/src/Utils/Form.hs
+++ b/src/Utils/Form.hs
@@ -295,6 +295,8 @@ data FormIdentifier
| FIDTestDownload
| FIDAllocationRegister
| FIDAllocationNotification
+ | FIDAvsPersonQuery
+ | FIDAvsStatusQuery
deriving (Eq, Ord, Read, Show)
instance PathPiece FormIdentifier where
diff --git a/templates/avs.hamlet b/templates/avs.hamlet
index a6646bc72..dd87cc7a3 100644
--- a/templates/avs.hamlet
+++ b/templates/avs.hamlet
@@ -3,5 +3,6 @@
Abfrage:
^{formWidget}
$maybe answer <- mbAnswer
- Unverarbeitete Antwort:
+
+ Unverarbeitete Antwort: #
#{answer}