chore(avs): alternatves for servant specification

src/Handler/Utils.hs

@@ -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
 

src/Handler/Utils/Servant/AVS.hs

@@ -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