apiary-http-client (empty) → 0.1.0.0
raw patch · 5 files changed
+252/−0 lines, 5 filesdep +apiarydep +basedep +bytestringsetup-changed
Dependencies added: apiary, base, bytestring, data-default-class, http-client, http-types, text, transformers, types-compat, wai
Files
- LICENSE +20/−0
- README.md +28/−0
- Setup.hs +2/−0
- Web/Apiary/HTTP/Client.hs +168/−0
- apiary-http-client.cabal +34/−0
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2016 winterland++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,28 @@+Apiary HTTP Client+==================++A HTTP Client for [Apiary](http://hackage.haskell.org/package/apiary), using `Apiary`'s extension api, suitable for proxying HTTP request to backend API, with flexible APIs and streamming proxying abilities.++This module also reexport `Network.HTTP.Client`. Example:++```haskell+main :: IO ()+main = runApiaryWith (run serverPort) (HTTP.initHTTPClient HTTP.defaultManagerSettings) def $ do++ [capture|/query|] . action $ do+ + -- make a new Network.HTTP.Client.Request from current ActionT's Network.Wai.Request+ -- it's recommended to use resetHeaders to remove following headers:+ -- Transfer-Encoding, Content-Length, Content-Encoding and Accept-Encoding.+ req <- HTTP.fromRequest id resetHeaders++ -- set proxying host and port+ -- use function from Network.HTTP.Client to modify more+ let req' = HTTP.setHost influxDB_API_HOST . HTTP.setPort 80 $ req++ -- send request and proxy respond in streamming fashion.+ HTTP.proxyTo req'+```+++More document are W.I.P.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ Web/Apiary/HTTP/Client.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE NamedFieldPuns #-}+{-# LANGUAGE DataKinds #-}++module Web.Apiary.HTTP.Client+ ( HTTPClient+ , initHTTPClient+ , getManager+ , withHTTPClient+ -- ** helpers to make new Request+ , fromWaiRequest+ , fromRequest+ , resetHeaders+ , setPort+ , setHost+ , setHostName+ , setHostHeader+ -- ** send request and get respond+ , sendRequset+ , openRequset+ -- ** send request for side effect+ , sendRequsetNoBody+ -- ** send request and proxy respond+ , proxyTo+ , proxyWith+ , module Network.HTTP.Client+ ) where++import Control.Monad.IO.Class+import Network.HTTP.Client+import qualified Network.Wai as W+import Network.HTTP.Types.Header+import Data.Apiary.Extension+import qualified Data.Proxy.Compat as P (Proxy(..))+import Unsafe.Coerce (unsafeCoerce)+import Data.Default.Class+import qualified Data.ByteString as B+import qualified Data.ByteString.Lazy as LB+import qualified Data.ByteString.Builder as B+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import qualified Control.Monad.Apiary.Action as A++newtype HTTPClient = HTTPClient Manager++instance Extension HTTPClient++-- |Initialize a @MonadExts@ with @Network.HTTP.Client.ManagerSettings@.+initHTTPClient :: MonadIO m+ => ManagerSettings -> Initializer m exts (HTTPClient ': exts)+initHTTPClient ms = initializer' . liftIO $ newManager ms >>= return . HTTPClient++-- |Get @Network.HTTP.Client.Manage@ from Apiary's @MonadExts@ context.+getManager :: (Has HTTPClient es, MonadExts es m, MonadIO m) => m Manager+getManager = do+ (HTTPClient manager) <- getExt (P.Proxy :: P.Proxy HTTPClient)+ return manager++-- |lift operations with initial manager.+withHTTPClient :: (Has HTTPClient es, MonadExts es m, MonadIO m)+ => (Request -> Manager -> IO a) -> Request -> m a+withHTTPClient f r = do+ manager <- getManager+ liftIO $ f r manager++-- |Copy path, headers, body and queryString from @Network.Wai.Request@+fromWaiRequest+ :: ([T.Text] -> [T.Text]) -- ^ Function to modify request path+ -> ([Header] -> [Header]) -- ^ Function to modify request headers+ -> W.Request -> Request -- ^ From @Network.Wai.Request@ To @Network.HTTP.Client.Request@+fromWaiRequest pm hm req =+ let+ needsPopper = \ r -> r (W.requestBody req)+ path = pm (W.pathInfo req)+ headers = hm (W.requestHeaders req)+ requestBody' = case W.requestBodyLength req of+ W.ChunkedBody -> RequestBodyStreamChunked needsPopper+ W.KnownLength len -> RequestBodyStream (unsafeCoerce len) needsPopper+ in+ def {+ queryString = W.rawQueryString req+ , path = T.encodeUtf8 (T.intercalate "/" path)+ , requestHeaders = headers+ , requestBody = requestBody'+ }++-- |Remove following headers:+-- Transfer-Encoding, Content-Length, Content-Encoding and Accept-Encoding.+-- It's very likely you want to do this.+resetHeaders :: [Header] -> [Header]+resetHeaders = filter (\ (name, _) -> name `notElem` [hTransferEncoding, hContentLength, hContentEncoding, hAcceptEncoding])++-- |Copy path, headers, body and queryString from current @ActionT@'s context.+fromRequest+ :: (Has HTTPClient exts, MonadIO m)+ => ([T.Text] -> [T.Text]) -- ^ Function to modify request path+ -> ([Header] -> [Header]) -- ^ Function to modify request headers+ -> A.ActionT exts prms m Request+fromRequest pm hm= A.getRequest >>= return . fromWaiRequest pm hm++setPort :: Int -> Request -> Request+setPort port req = req{ port = port }++setHostName :: B.ByteString -> Request -> Request+setHostName host req = req{ host = host }++setHostHeader :: B.ByteString -> Request -> Request+setHostHeader host req = req{ requestHeaders = headers }+ where+ oHeaders = requestHeaders req+ headers = (hHost, host) : filter (\ (name, _) -> name /= hHost ) oHeaders++setHost :: B.ByteString -> Request -> Request+setHost host = setHostHeader host . setHostName host++-- |send requset and get @Response@ @ByteString@+-- For large response consider using @openRequset@ and @responseClose@ instead.+sendRequset :: (Has HTTPClient exts, MonadIO m)+ => Request -> A.ActionT exts prms m (Response LB.ByteString)+sendRequset req = withHTTPClient httpLbs req++-- |send request without receive any body.+sendRequsetNoBody :: (Has HTTPClient exts, MonadIO m)+ => Request -> A.ActionT exts prms m (Response ())+sendRequsetNoBody req = withHTTPClient httpNoBody req++-- |send request and get @Response@ @BodyReader@+openRequset :: (Has HTTPClient exts, MonadIO m)+ => Request -> A.ActionT exts prms m (Response BodyReader)+openRequset req = withHTTPClient responseOpen req++-- |streamming response directly from proxy target.+proxyTo :: (Has HTTPClient exts, MonadIO m)+ => Request -> A.ActionT exts prms m ()+proxyTo req = do+ res <- openRequset req+ A.rawResponse $ \ _ _ ->+ W.responseStream+ (responseStatus res)+ (resetHeaders $ responseHeaders res)+ $ \ sendBuilder flush ->+ let+ bodyReader = responseBody res+ loop = do+ bs <- bodyReader+ if B.null bs then responseClose res >> flush+ else sendBuilder (B.byteString bs) >> loop+ in loop++-- |Modify response from proxy target then send.+-- You should consider remove following headers:+-- Transfer-Encoding, Content-Length, Content-Encoding and Accept-Encoding.+proxyWith+ :: (Has HTTPClient exts, MonadIO m)+ => Request+ -> (Response LB.ByteString -> Response LB.ByteString) -- ^ Function to modify response.+ -> A.ActionT exts prms m ()+proxyWith req modifier = do+ resLbs <- sendRequset req+ let resLbs' = modifier resLbs+ A.status (responseStatus resLbs')+ A.setHeaders (responseHeaders resLbs')+ A.lazyBytes (responseBody resLbs')
+ apiary-http-client.cabal view
@@ -0,0 +1,34 @@+-- Initial apiary-http-client.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++name: apiary-http-client+version: 0.1.0.0+synopsis: A http client for Apiary.+-- synopsis: +-- description: +homepage: https://github.com/winterland1989/apiary-http-client+license: MIT+license-file: LICENSE+author: winterland+maintainer: winterland1989@gmail.com+-- copyright: +category: Web+build-type: Simple+extra-source-files: README.md+cabal-version: >=1.10++library+ exposed-modules: Web.Apiary.HTTP.Client+ -- other-modules: + build-depends: base >=4.8 && <4.9+ , transformers+ , types-compat >=0.1 && <0.2+ , http-client >=0.4.26+ , http-types >=0.8+ , apiary >=1.0.0+ , wai+ , data-default-class+ , bytestring+ , text+ -- hs-source-dirs: + default-language: Haskell2010