http-dispatch 0.5.0.2 → 0.6.0.0
raw patch · 7 files changed
+238/−217 lines, 7 files
Files
- http-dispatch.cabal +4/−4
- src/Network/HTTP/Dispatch/Core.hs +0/−115
- src/Network/HTTP/Dispatch/Dispatch.hs +80/−0
- src/Network/HTTP/Dispatch/Headers.hs +13/−19
- src/Network/HTTP/Dispatch/Internal/Request.hs +0/−72
- src/Network/HTTP/Dispatch/Request.hs +117/−0
- src/Network/HTTP/Dispatch/Types.hs +24/−7
http-dispatch.cabal view
@@ -1,5 +1,5 @@ name: http-dispatch-version: 0.5.0.2+version: 0.6.0.0 synopsis: High level HTTP client for Haskell description: Please see README.md homepage: http://github.com/owainlewis/http-dispatch#readme@@ -14,10 +14,10 @@ library hs-source-dirs: src- exposed-modules: Network.HTTP.Dispatch.Core- , Network.HTTP.Dispatch.Types+ exposed-modules: Network.HTTP.Dispatch.Dispatch , Network.HTTP.Dispatch.Headers- , Network.HTTP.Dispatch.Internal.Request+ , Network.HTTP.Dispatch.Request+ , Network.HTTP.Dispatch.Types build-depends: base >= 4.5 && < 5 , http-client , http-client-tls
− src/Network/HTTP/Dispatch/Core.hs
@@ -1,115 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Dispatch.Core- ( HTTPRequest(..)- , HTTPResponse(..)- , HTTPRequestMethod(..)- -- Core request helpers- , runRequest- , get- , getWithHeaders- , post- , postWithHeaders- , put- , putWithHeaders- , patch- , patchWithHeaders- , delete- , deleteWithHeaders- -- Extra- , withQueryParams- ) where--import qualified Data.ByteString as S-import Data.Monoid (mconcat)-import Network.HTTP.Dispatch.Internal.Request-import Network.HTTP.Dispatch.Types--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)---- | Make a HTTP PUT request----put :: Url -> Body -> HTTPRequest-put url body = putWithHeaders url [] body---- | Make a HTTP PUT request with headers----putWithHeaders :: Url -> Headers -> Body -> HTTPRequest-putWithHeaders url headers body = HTTPRequest PUT url headers (Just body)---- | Make a HTTP PATCH request----patch :: Url -> Body -> HTTPRequest-patch url body = patchWithHeaders url [] body---- | Make a HTTP PATCH request with headers----patchWithHeaders :: Url -> Headers -> Body -> HTTPRequest-patchWithHeaders url headers body = HTTPRequest PATCH url headers (Just body)---- | Make a HTTP DELETE request----delete :: Url -> HTTPRequest-delete url = deleteWithHeaders url []---- | Make a HTTP DELETE request with headers----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 = "?" ++ qParams :: String- where parts = map (\(k,v) -> mconcat [k, "=", v]) params- qParams = mconcat (intersperse "&" parts)
+ src/Network/HTTP/Dispatch/Dispatch.hs view
@@ -0,0 +1,80 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Network.HTTP.Dispatch.Dispatch+-- Copyright : (c) 2016 Owain Lewis+--+-- License : BSD-style+-- Maintainer : owain@owainlewis.com+-- Stability : experimental+-- Portability : GHC+--+-- A simple Haskell HTTP library+--+-- This module contains the primary user facing DSL for making requests+--+module Network.HTTP.Dispatch.Dispatch+ ( raw+ , get+ , post+ , put+ , patch+ , delete+ ) where++import qualified Data.ByteString as S+import qualified Network.HTTP.Dispatch.Request as Dispatch+import Network.HTTP.Dispatch.Internal.Request (runRequest)+import Network.HTTP.Dispatch.Types++-- | Constructs a HTTP request from raw components and returns a HTTP response+--+raw+ :: HTTPRequestMethod -- A HTTP request method+ -> String -- A URL+ -> [(String, String)] -- A list of HTTP headers+ -> Maybe S.ByteString -- An optional HTTP request body+ -> IO HTTPResponse+raw method url headers body =+ let byteStringHeaders = transformHeaders headers in+ runRequest $ Dispatch.rawRequest method url byteStringHeaders body++get+ :: String+ -> [(String, String)]+ -> IO HTTPResponse+get url headers = raw GET url headers Nothing++-- | Send a HTTP POST request+--+post+ :: String+ -> [(String, String)]+ -> Maybe S.ByteString+ -> IO HTTPResponse+post url headers body = raw POST url headers body++-- Send a HTTP POST request+--+put+ :: String+ -> [(String, String)]+ -> Maybe S.ByteString+ -> IO HTTPResponse+put url headers body = raw PUT url headers body++-- | Send a HTTP PATCH request+--+patch+ :: String+ -> [(String, String)]+ -> Maybe S.ByteString+ -> IO HTTPResponse+patch url headers body = raw PATCH url headers body++-- Send a HTTP DELETE request+--+delete+ :: String+ -> [(String, String)]+ -> IO HTTPResponse+delete url headers = raw DELETE url headers Nothing
src/Network/HTTP/Dispatch/Headers.hs view
@@ -1,27 +1,21 @@ {-# LANGUAGE OverloadedStrings #-}-module Network.HTTP.Dispatch.Headers- ( contentType- , contentJSON- , contentXML- , basicAuth- ) where+-- |+-- Module : Network.HTTP.Dispatch.Headers+-- Copyright : (c) 2016 Owain Lewis+--+-- License : BSD-style+-- Maintainer : owain@owainlewis.com+-- Stability : experimental+-- Portability : GHC+--+-- HTTP header utils+--+module Network.HTTP.Dispatch.Headers ( basicAuth ) where import qualified Data.ByteString as S import qualified Data.ByteString.Base64 as B64 import Data.Monoid ((<>))-import Network.HTTP.Dispatch.Types---- | Create a new content type header-contentType :: String -> Header-contentType = header "Content-Type"---- | Return a JSON content type header-contentJSON :: Header-contentJSON = contentType "application/json"---- | Return an XML content type header-contentXML :: Header-contentXML = contentType "application/xml"+import Network.HTTP.Dispatch.Types(Header) -- | Helper to generate Basic authentication basicAuth :: S.ByteString -> S.ByteString -> Header
− src/Network/HTTP/Dispatch/Internal/Request.hs
@@ -1,72 +0,0 @@-{-# 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- toResponse <$> httpLbs request manager
+ src/Network/HTTP/Dispatch/Request.hs view
@@ -0,0 +1,117 @@+{-# LANGUAGE OverloadedStrings #-}+-- |+-- Module : Network.HTTP.Dispatch.Request+-- Copyright : (c) 2016 Owain Lewis+--+-- License : BSD-style+-- Maintainer : owain@owainlewis.com+-- Stability : experimental+-- Portability : GHC+--+-- HTTP request generation DSL+--+module Network.HTTP.Dispatch.Request+ ( HTTPRequest(..)+ , HTTPResponse(..)+ , HTTPRequestMethod(..)+ , runRequest+ , rawRequest+ , getRequest+ , postRequest+ , putRequest+ , patchRequest+ , deleteRequest+ , headRequest+ , optionsRequest+ , withQueryParams+ ) where++import qualified Data.ByteString as S+import Data.Monoid (mconcat)+import Network.HTTP.Dispatch.Internal.Request+import Network.HTTP.Dispatch.Types+import Prelude hiding (head)++import Data.List (intersperse)++-- | Given an HTTP request type, run the request and return the response+--+run :: HTTPRequest -> IO HTTPResponse+run req = runRequest req++-- | Make a raw HTTP request+--+-- @+-- raw GET "http://google.com" [header "Content-Type" "application/json"] Nothing+--+-- HTTPRequest { reqMethod = GET+-- , reqUrl = "http://google.com"+-- , reqHeaders = [("Content-Type","application/json")]+-- , reqBody = Nothing+-- }+-- @+rawRequest :: HTTPRequestMethod -> String -> [Header] -> Maybe S.ByteString -> HTTPRequest+rawRequest method url headers body = HTTPRequest method url headers body++-- | Make a simple HTTP GET request with headers+--+-- @+-- getRequest "http://google.com" [header "Content-Type" "application/json"]+--+-- HTTPRequest { reqMethod = GET+-- , reqUrl = "http://google.com"+-- , reqHeaders = [("Content-Type","application/json")]+-- , reqBody = Nothing+-- }+-- @+getRequest :: String -> [Header] -> HTTPRequest+getRequest url headers = rawRequest GET url headers Nothing++-- | Make a HTTP POST request with headers+--+postRequest :: Url -> Headers -> Maybe S.ByteString -> HTTPRequest+postRequest url headers body = rawRequest POST url headers body++-- | Make a HTTP PUT request with headers+--+putRequest :: Url -> Headers -> Maybe S.ByteString -> HTTPRequest+putRequest url headers body = rawRequest PUT url headers body++-- | Make a HTTP PATCH request with headers+--+patchRequest :: Url -> Headers -> Maybe S.ByteString -> HTTPRequest+patchRequest url headers body = HTTPRequest PATCH url headers body++-- | Make a HTTP DELETE request with headers+--+deleteRequest :: Url -> Headers -> HTTPRequest+deleteRequest url headers = rawRequest DELETE url headers Nothing++-- | Make a HTTP OPTIONS request+--+optionsRequest :: Url -> [Header] -> HTTPRequest+optionsRequest url headers = rawRequest OPTIONS url headers Nothing++-- | Make a HTTP HEAD request+--+headRequest :: Url -> [Header] -> HTTPRequest+headRequest url headers = rawRequest HEAD 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 = "?" ++ qParams :: String+ where parts = map (\(k,v) -> mconcat [k, "=", v]) params+ qParams = mconcat (intersperse "&" parts)
src/Network/HTTP/Dispatch/Types.hs view
@@ -1,26 +1,40 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeSynonymInstances #-}+-- |+-- Module : Network.HTTP.Dispatch.Headers+-- Copyright : (c) 2016 Owain Lewis+--+-- License : BSD-style+-- Maintainer : owain@owainlewis.com+-- Stability : experimental+-- Portability : GHC+--+-- HTTP Types+-- module Network.HTTP.Dispatch.Types where import qualified Data.ByteString as S import qualified Data.ByteString.Char8 as SC-import qualified Data.ByteString.Lazy as LBS type Url = String +type Header = (S.ByteString, S.ByteString)+ type Headers = [Header] type Body = S.ByteString data HTTPRequestMethod =- GET- | PUT+ HEAD+ | GET | POST+ | PUT | PATCH- | DELETE deriving ( Eq, Show )--type Header = (S.ByteString, S.ByteString)+ | DELETE+ | TRACE+ | OPTIONS+ | CONNECT deriving ( Eq, Show ) data HTTPRequest = HTTPRequest { -- A HTTP request method e.g GET POST etc@@ -39,11 +53,14 @@ -- The response headers , respHeaders :: [Header] -- The response body- , respBody :: LBS.ByteString+ , respBody :: S.ByteString } deriving ( Eq, Show ) header :: String -> String -> Header header k v = (SC.pack k , SC.pack v)++transformHeaders :: [(String, String)] -> [Header]+transformHeaders = map (\(k,v) -> header k v) withHeader :: HTTPRequest -> Header -> HTTPRequest withHeader req header = req { reqHeaders = header : (reqHeaders req) }