git.iko.soy/servant
on 0802221 help sign in
servant/src/Servant/Utils/Client.hs
48 lines 1.6 kB history raw
1module Servant.Utils.Client where
3import Control.Applicative
4import Control.Exception
5import Control.Monad
6import Control.Monad.IO.Class
7import Control.Monad.Trans.Either
8import Data.Aeson
9import Data.String.Conversions
10import Network.HTTP.Types
11import Network.URI
12import Servant.Client
14import qualified Network.HTTP.Client as Client
16performRequest :: FromJSON result =>
17 Method -> Req -> Int -> URIAuth -> EitherT String IO result
18performRequest method req wantedStatus host = do
19 partialRequest <- liftIO $ reqToRequest req host
21 let request = partialRequest { Client.method = method
22 }
24 eResponse <- liftIO $ __withGlobalManager $ \ manager ->
25 catchStatusCodeException $
26 Client.httpLbs request manager
27 case eResponse of
28 Left status ->
29 left (requestString ++ " failed with status: " ++ showStatus status)
31 Right response -> do
32 let status = Client.responseStatus response
33 when (statusCode status /= wantedStatus) $
34 left (requestString ++ " failed with status: " ++ showStatus status)
35 result <- maybe (left (requestString ++ " returned invalid json")) return $
36 decode' (Client.responseBody response)
37 return result
38 where
39 requestString = "HTTP " ++ cs method ++ " request"
40 showStatus (Status code message) =
41 show code ++ " - " ++ cs message
43catchStatusCodeException :: IO a -> IO (Either Status a)
44catchStatusCodeException action = catch (Right <$> action) $
45 \ e -> case e of
46 Client.StatusCodeException status _ _ ->
47 return $ Left status
48 e -> throwIO e