fraport/fradrive
3
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

chore(avs): alternatves for servant specification

Browse Source
This commit is contained in:
Steffen Jost 2022-06-24 16:32:02 +02:00
parent b7e8c89777
commit 548a85ead6
2 changed files with 36 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/Handler/Utils.hs
View File

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

44
src/Handler/Utils/Servant/AVS.hs
View File

@ -8,6 +8,8 @@ module Handler.Utils.Servant.AVS where
import Import
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
@ -39,19 +41,43 @@ deriveJSON defaultOptions ''AvsStatusQuery
type AvsPersonResponse = Value
type AvsStatusResponse = Value
type AVS = BasicAuth "avs_fradrive" String :> "FraVSMService" :> "v1" :> "PersonSearch" :> ReqBody '[JSON] AvsPersonQuery :> Post '[JSON] AvsPersonResponse
type AVSAuth = BasicAuth "avs_fradrive" String
--type AVS = BasicAuth "avs_fradrive" String :> "FraVSMService" :> "v1" :> "PersonSearch" :> ReqBody '[JSON] AvsPersonQuery :> Post '[JSON] AvsPersonResponse
-- :<|> ("PersonStatus" :> ReqBody '[JSON] AvsStatusQuery :> Post '[JSON] AvsStatusResponse))
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
{-
-- Option 1:
type AVS = AVSRoute (AVSPersonSearch :<|> AVSPersonStatus)
avsPersonSearch :: AvsPersonQuery -> ClientM AvsPersonResponse
avsPersonStatus :: AvsStatusQuery -> ClientM AvsStatusResponse
(avsPersonSearch :<|> avsPersonStatus) = client avsApi (BasicAuthData "foo" "bar")
-}
{-
-- Option 2: works, but requires yet another package: servant-flatten
type AVS = AVSRoute (AVSPersonSearch :<|> AVSPersonStatus)
avsPersonSearch :: BasicAuthData -> AvsPersonQuery -> ClientM AvsPersonResponse
avsPersonStatus :: BasicAuthData -> AvsStatusQuery -> ClientM AvsStatusResponse
(avsPersonSearch :<|> avsPersonStatus) = client $ flatten avsApi
-}
-- Option 3:
type AVS = AVSRoute AVSPersonSearch :<|> AVSRoute AVSPersonStatus
avsPersonSearch :: BasicAuthData -> AvsPersonQuery -> ClientM AvsPersonResponse
avsPersonStatus :: BasicAuthData -> AvsStatusQuery -> ClientM AvsStatusResponse
(avsPersonSearch :<|> avsPersonStatus) = client avsApi
avsApi :: Proxy AVS
avsApi = Proxy
avsPersonSearch :: BasicAuthData -> AvsPersonQuery -> ClientM AvsPersonResponse
-- avsPersonStatus :: BasicAuthData -> AvsStatusQuery -> ClientM AvsStatusResponse
--(avsPersonSearch :<|> avsPersonStatus) = client avsApi
avsPersonSearch = client avsApi
avsServer :: BaseUrl
avsServer = BaseUrl
{ baseUrlScheme = Https
@ -64,7 +90,7 @@ avsServer = BaseUrl
run :: IO ()
run = do
manager' <- HTTP.newManager HTTP.defaultManagerSettings
let query = avsPersonSearch (BasicAuthData "foo" "bar") $ def { avsPersonQueryFirstName = Just "Steffen" }
let query = avsPersonSearch (BasicAuthData "foo" "bar") $ def { avsPersonQueryFirstName = Just "Steffen" }
res <- runClientM query (mkClientEnv manager' avsServer)
case res of
Left err -> putStrLn $ "Error: " ++ tshow err