http-dispatch 0.4.0.0 → 0.5.0.0
raw patch · 6 files changed
+131/−131 lines, 6 filesdep +base64-bytestringdep ~base
Dependencies added: base64-bytestring
Dependency ranges changed: base
Files
- http-dispatch.cabal +4/−4
- src/Network/HTTP/Dispatch/Core.hs +37/−9
- src/Network/HTTP/Dispatch/Extra.hs +0/−18
- src/Network/HTTP/Dispatch/Internal/Request.hs +72/−0
- src/Network/HTTP/Dispatch/Request.hs +0/−83
- src/Network/HTTP/Dispatch/Types.hs +18/−17
http-dispatch.cabal view
@@ -1,5 +1,5 @@ name: http-dispatch-version: 0.4.0.0+version: 0.5.0.0 synopsis: High level HTTP client for Haskell description: Please see README.md homepage: http://github.com/owainlewis/http-dispatch#readme@@ -16,13 +16,13 @@ hs-source-dirs: src exposed-modules: Network.HTTP.Dispatch.Core , Network.HTTP.Dispatch.Types- , Network.HTTP.Dispatch.Request- , Network.HTTP.Dispatch.Extra- build-depends: base >= 4.7 && < 5+ , Network.HTTP.Dispatch.Internal.Request+ build-depends: base >= 4.5 && < 5 , http-client , http-client-tls , http-types , bytestring+ , base64-bytestring , case-insensitive default-language: Haskell2010
src/Network/HTTP/Dispatch/Core.hs view
@@ -3,6 +3,7 @@ ( HTTPRequest(..) , HTTPResponse(..) , HTTPRequestMethod(..)+ -- Core request helpers , runRequest , get , getWithHeaders@@ -14,29 +15,42 @@ , patchWithHeaders , delete , deleteWithHeaders+ -- Extra+ , withQueryParams ) where -import qualified Data.ByteString.Lazy as LBS-import Network.HTTP.Dispatch.Request+import qualified Data.ByteString as S+import Data.Monoid (mconcat)+import Network.HTTP.Dispatch.Internal.Request import Network.HTTP.Dispatch.Types --------------------------------------------------------------------------------------- Request API--------------------------------------------------------------------------------------type Url = String-type Headers = [Header]-type Body = LBS.ByteString+import Data.List (intersperse) +-- | Make a simple HTTP GET request+--+-- @+-- get "http://google.com" =>+-- HTTPRequest {reqMethod = GET, reqUrl = "http://google.com", reqHeaders = [], reqBody = Nothing}+-- @ get :: Url -> HTTPRequest get url = HTTPRequest GET url [] Nothing +-- | Make a simple HTTP GET request with headers+--+-- @+-- getWithHeaders "http://google.com" [header "Content-Type" "application/json"]+-- HTTPRequest {reqMethod = GET, reqUrl = "http://google.com", reqHeaders = [("Content-Type","application/json")], reqBody = Nothing}+-- @ getWithHeaders :: String -> [Header] -> HTTPRequest getWithHeaders url headers = HTTPRequest GET url headers Nothing +-- | Make a simple HTTP POST request+-- post :: Url -> Body -> HTTPRequest post url body = postWithHeaders url [] body +-- | Make a HTTP POST request with headers+-- postWithHeaders :: Url -> Headers -> Body -> HTTPRequest postWithHeaders url headers body = HTTPRequest POST url headers (Just body) @@ -57,3 +71,17 @@ deleteWithHeaders :: Url -> Headers -> HTTPRequest deleteWithHeaders url headers = HTTPRequest DELETE url headers Nothing++-- | Add query params to a request URL+--+-- @+-- withQueryParams (get "http://google.com") [("foo", "bar")] =>+-- HTTPRequest {reqMethod = GET, reqUrl = "http://google.com?foo=bar", reqHeaders = [], reqBody = Nothing}+-- @+withQueryParams :: HTTPRequest -> [(String, String)] -> HTTPRequest+withQueryParams req params = req { reqUrl = u ++ p }+ where u = reqUrl req+ p = compileParams params+ compileParams params = "?" ++ kweryParams :: String+ where parts = map (\(k,v) -> mconcat [k, "=", v]) params+ kweryParams = mconcat (intersperse "&" parts)
− src/Network/HTTP/Dispatch/Extra.hs
@@ -1,18 +0,0 @@-{-# LANGUAGE FlexibleInstances #-}-module Network.HTTP.Dispatch.Extra- ( fromString- ) where--import qualified Data.ByteString.Lazy as LBS-import qualified Data.ByteString.Lazy.Char8 as LBSC---------------------------------------------------------------------------------------- Extra methods for friendly API (experimental)---------------------------------------------------------------------------------------- Can be used to generate a HTTP request without needing to prepare Lazy ByteStrings.------ Example:--- HTTPRequest POST "http://api.mysite.com" [("Content-Type", "application/json")] (fromString "HELLO WORLD")-fromString :: String -> LBS.ByteString-fromString = LBSC.pack
+ src/Network/HTTP/Dispatch/Internal/Request.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE OverloadedStrings #-}+module Network.HTTP.Dispatch.Internal.Request+ ( toRequest+ , runRequest+ ) where++import Control.Applicative ((<$>))+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 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) -> (CI.mk k, 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 = RequestBodyBS lbs }+ Nothing ->+ return req++-- | Get the correct Manager depending on the URL (i.e https vs http)+--+getManagerForUrl :: String -> IO Manager+getManagerForUrl url =+ if ("https" `isPrefixOf` url) then newManager tlsManagerSettings+ else newManager defaultManagerSettings++-- | Transforms an http-client respones into a Dispatch Response+--+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 = CI.original k+ in+ (hk, v)) 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++instance Runnable HTTPRequest where+ runRequest httpRequest = do+ manager <- getManagerForUrl (reqUrl httpRequest)+ request <- toRequest httpRequest+ toResponse <$> httpLbs request manager++ runRequestWithSettings httpRequest settings = do+ manager <- newManager settings+ request <- toRequest httpRequest+ httpLbs request manager >>= return . toResponse
− src/Network/HTTP/Dispatch/Request.hs
@@ -1,83 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Dispatch.Request- ( toRequest- , runRequest- , compileParams- , withQueryParams- ) where--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.List (intersperse)-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--compileParams :: [(String, String)] -> String-compileParams params = "?" ++ kweryParams- where parts = map (\(k,v) -> mconcat [k, "=", v]) params- kweryParams = mconcat $ Data.List.intersperse "&" parts--withQueryParams :: HTTPRequest -> [(String, String)] -> HTTPRequest-withQueryParams req params = req { reqUrl =- let x = reqUrl req- y = compileParams params- in x ++ y- }--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--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
src/Network/HTTP/Dispatch/Types.hs view
@@ -1,10 +1,18 @@ {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-} module Network.HTTP.Dispatch.Types where -import qualified Data.ByteString.Lazy as LBS-import qualified Data.ByteString.Lazy.Char8 as LBSC+import qualified Data.ByteString as S+import qualified Data.ByteString.Char8 as SC+import qualified Data.ByteString.Lazy as LBS +type Url = String++type Headers = [Header]++type Body = S.ByteString+ data HTTPRequestMethod = GET | PUT@@ -12,13 +20,7 @@ | PATCH | DELETE deriving ( Eq, Show ) -type Header = (String, String)--class Packable a where- pack :: a -> LBS.ByteString--instance Packable String where- pack = LBSC.pack+type Header = (S.ByteString, S.ByteString) data HTTPRequest = HTTPRequest { -- A HTTP request method e.g GET POST etc@@ -28,7 +30,7 @@ -- Optional HTTP headers , reqHeaders :: [Header] -- An optional request body- , reqBody :: Maybe LBS.ByteString+ , reqBody :: Maybe S.ByteString } deriving ( Eq, Show ) data HTTPResponse = HTTPResponse {@@ -40,8 +42,9 @@ , respBody :: LBS.ByteString } deriving ( Eq, Show ) --- Update requests (additive)----------------------------------------------------------------------------------------------+-- | Helper function that contstructs HTTP headers from string values+header :: String -> String -> Header+header k v = (SC.pack k , SC.pack v) withHeader :: HTTPRequest -> Header -> HTTPRequest withHeader req header = req { reqHeaders = header : (reqHeaders req) }@@ -49,15 +52,13 @@ withHeaders :: HTTPRequest -> [Header] -> HTTPRequest withHeaders req headers = req { reqHeaders = headers } -withBody :: HTTPRequest -> LBS.ByteString -> HTTPRequest-withBody req body = req { reqBody = pure body }+withBody :: HTTPRequest -> S.ByteString -> HTTPRequest+withBody req body = req { reqBody = Just body } withMethod :: HTTPRequest -> HTTPRequestMethod -> HTTPRequest withMethod req method = req { reqMethod = method } ------------------------------------------------------------------------------------------------dropHeaderWithKey :: HTTPRequest -> String -> HTTPRequest+dropHeaderWithKey :: HTTPRequest -> S.ByteString -> HTTPRequest dropHeaderWithKey req@(HTTPRequest _ _ hdrs _) headerKey = let filteredHeaders = filter (\(k,v) -> k /= headerKey) hdrs in withHeaders req filteredHeaders