http-dispatch 0.1.0.0 → 0.2.0.0

raw patch · 2 files changed

+73/−2 lines, 2 files

Files

• http-dispatch.cabal +3/−2
• src/Network/HTTP/Dispatch/Request.hs +70/−0

@@ -1,5 +1,5 @@ name:                http-dispatch-version:             0.1.0.0+version:             0.2.0.0 synopsis:            High level HTTP client for Haskell description:         Please see README.md homepage:            http://github.com/owainlewis/http-dispatch#readme@@ -8,7 +8,7 @@ author:              Owain Lewis maintainer:          owain@owainlewis.com copyright:           2016 Owain Lewis-category:            Web+category:            Network build-type:          Simple cabal-version:       >=1.10 @@ -17,6 +17,7 @@   exposed-modules:     Network.HTTP.Dispatch.Core                      , Network.HTTP.Dispatch.Headers                      , Network.HTTP.Dispatch.Types+                     , Network.HTTP.Dispatch.Request   build-depends:       base >= 4.7 && < 5                      , http-client                      , http-client-tls

@@ -0,0 +1,70 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.HTTP.Dispatch.Request+  ( toRequest+  , runRequest+  ) where++import qualified Control.Exception           as E+import qualified Data.ByteString.Char8       as C+import qualified Data.ByteString.Lazy        as LBS+import qualified Data.CaseInsensitive        as CI+import           Data.List                   (isPrefixOf)+import           Data.String                 (fromString)+import           Network.HTTP.Client         as Client+import           Network.HTTP.Client.TLS+import           Network.HTTP.Dispatch.Types (HTTPRequest (..),+                                              HTTPRequestMethod (..),+                                              HTTPResponse (..), Header (..))+import           Network.HTTP.Types          (RequestHeaders, Status (..))++-- Transforms a dispatch request into a low level http-client request+--+toRequest :: HTTPRequest -> IO Client.Request+toRequest (HTTPRequest method url headers body) = do+    initReq <- parseUrl url+    let hdrs = map (\(k, v) -> (fromString k, fromString v)) headers+        req = initReq+              { method = C.pack . show $ method+              , requestHeaders = hdrs+                -- Make sure no exceptions are thrown so that we can handle non 200 codes+              , checkStatus = \_ _ _ -> Nothing+              }+    case body of+      Just lbs -> return $ req { requestBody = RequestBodyLBS lbs }+      Nothing -> return $ req++getManagerForUrl :: String -> IO Manager+getManagerForUrl url =+    if ("https" `isPrefixOf` url) then newManager tlsManagerSettings+                                  else newManager defaultManagerSettings++toResponse :: Client.Response LBS.ByteString -> HTTPResponse+toResponse resp =+    let rStatus = statusCode . responseStatus $ resp+        rHdrs = responseHeaders resp+        rBody = responseBody resp+    in+    HTTPResponse rStatus (map (\(k,v) ->+                                let hk = C.unpack . CI.original $ k+                                    hv = C.unpack v in+                                (hk, hv)) rHdrs) rBody++class Runnable a where+  -- Run a HTTP request and return the response+    runRequest :: a -> IO HTTPResponse+    -- Run a HTTP request with custom settings (proxy, https etc) and return the response+    runRequestWithSettings :: a -> ManagerSettings -> IO HTTPResponse++handleMyException :: HttpException -> IO HTTPResponse+handleMyException (StatusCodeException s hdrs cj) = return $ HTTPResponse (statusCode s) [] ""++instance Runnable HTTPRequest where+    runRequest httpRequest = do+        manager <- getManagerForUrl (reqUrl httpRequest)+        request <- toRequest httpRequest+        httpLbs request manager >>= return . toResponse++    runRequestWithSettings httpRequest settings = do+        manager <- newManager settings+        request <- toRequest httpRequest+        httpLbs request manager >>= return . toResponse