quiver-http (empty) → 0.0.0.1

raw patch · 5 files changed

+233/−0 lines, 5 filesdep +basedep +bytestringdep +http-clientsetup-changed

Dependencies added: base, bytestring, http-client, http-client-tls, quiver

Files

• CHANGELOG +1/−0
• LICENCE +30/−0
• Setup.hs +2/−0
• quiver-http.cabal +41/−0
• src/Control/Quiver/HTTP.hs +159/−0

@@ -0,0 +1,1 @@+0.0.0.1: Initial release

@@ -0,0 +1,30 @@+Copyright © 2015 Insurance Group Australia+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++    1. Redistributions of source code must retain the above copyright+       notice, this list of conditions and the following disclaimer.++    2. Redistributions in binary form must reproduce the above+       copyright notice, this list of conditions and the following+       disclaimer in the documentation and/or other materials provided+       with the distribution.+      +    3. Neither the name of the project nor the names of its contributors+       may be used to endorse or promote products derived from this +       software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

@@ -0,0 +1,41 @@+name:           quiver-http+version:        0.0.0.1+synopsis:       Adapter to stream over HTTP(s) with quiver+homepage:       https://github.com/christian-marie/quiver-http/+category:       Utility+stability:      alpha++author:         Christian Marie <christian@ponies.io>+maintainer:     Christian Marie <christian@ponies.io>+copyright:      Copyright (c) 2015 Insurance Group Australia++cabal-version:  >= 1.18+build-type:     Simple+license:        BSD3+license-file:   LICENCE+extra-source-files: CHANGELOG++tested-with:    GHC == 7.10.2+stability:      experimental++description:+  A simple wrapper around http-client to facilitate HTTP streaming. Very+  similar to pipes-http.++source-repository    head+  type:              git+  location:          git@github.com:christian-marie/quiver-http.git++library+  hs-source-dirs:   src+  default-language: Haskell2010+  ghc-options:      -Wall++  exposed-modules: Control.Quiver.HTTP++  build-depends:+        base             >= 4        && < 5,+        quiver           >= 0.0.0.11 && < 0.1,+        bytestring       >= 0.9.2.1  && < 0.11,+        http-client      >= 0.2      && < 0.5,+        http-client-tls                 < 0.3

@@ -0,0 +1,159 @@+--+-- Copyright © 2015 Insurance Group Australia+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--++{-# LANGUAGE RankNTypes #-}++-- | Adapter code to interface with the http-client and http-client-tls+-- packages.+--+-- With this module you can streaming the request, response, or both.+--+-- To stream the request, simply replace your 'Request' 'requestBody' with one+-- created via either 'makeChunkedRequestBody' or 'makeFixedRequestBody'. You+-- have the option of either chunked encoding or a fixed size streaming+-- request. You probably want chunked encoding if that is supported.+--+-- To stream the response, use streamHTTP and provide a continuation that+-- returns a 'Consumer'. Your function will be passed the response, which it is+-- free to ignore.+--+-- To stream the request and response, simply do both.+--+-- Below is an example of a streaming response, with a streaming request.+--+-- > {-# LANGUAGE RankNTypes #-}+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > module Main where+-- >+-- > import Control.Quiver.HTTP+-- > import Control.Quiver+-- > import Control.Quiver.SP+-- > import Control.Monad+-- > import Data.ByteString (ByteString)+-- > import qualified Data.ByteString.Char8 as BS+-- > main :: IO ()+-- > main = do+-- >     req <- parseUrl "http://httpbin.org/post"+-- >     let req' = req { method = "POST", requestBody = makeChunkedRequestBody input}+-- >+-- >     manager <- newManager defaultManagerSettings+-- >     streamHTTP req' manager out+-- >   where+-- >     out :: Response () -> Consumer () ByteString IO ()+-- >     out _ = loop+-- >       where+-- >         loop = do+-- >             x <- fetch ()+-- >             case x of+-- >                 Just bs -> do+-- >                     qlift $ BS.putStrLn bs+-- >                     loop+-- >                 Nothing -> return ()+-- >+-- >     input :: Producer ByteString () IO ()+-- >     input = void $ decouple ("chunk1" >:> "chunk2" >:> deliver SPComplete)++module Control.Quiver.HTTP+(+  module Network.HTTP.Client,+  module Network.HTTP.Client.TLS,++  -- * Response streaming+  streamHTTP,++  -- * Request streaming+  makeChunkedRequestBody,+  makeFixedRequestBody+) where++import           Control.Monad           (unless)+import           Control.Quiver+import           Control.Quiver.Internal+import           Data.ByteString         (ByteString)+import qualified Data.ByteString         as B+import           Data.Int                (Int64)+import           Data.IORef              (newIORef, readIORef, writeIORef)+import           Network.HTTP.Client+import           Network.HTTP.Client.TLS++-- | Make a HTTP 'Request' and stream the response.+streamHTTP+    :: Request+    -- ^ The http-client 'Request', this need not be streaming.+    -> Manager+    -- ^ The http-client 'Manager', make sure you use the tls manager if you+    -- need SSL.+    -> (Response () -> Consumer x ByteString IO a)+    -- ^ Your quiver 'Consumer' continuation. Feel free to ignore the Response.+    -> IO a+streamHTTP request manager k =+    withResponse request manager handleBody+  where+    handleBody response = do+        let br = responseBody response+        let scrubbed_resp = response { responseBody = () }+        runEffect (loop br >->> k scrubbed_resp >&> snd)++    loop br = do+        bs <- qlift (brRead br)+        unless (B.null bs) $ do+            emit_ bs+            loop br+        deliver ()++-- | Build a 'RequestBody' by chunked transfer encoding a 'Producer'.+--+-- Each 'ByteString' produced will be sent as a seperate chunk.+makeChunkedRequestBody :: Producer ByteString () IO () -> RequestBody+makeChunkedRequestBody p = RequestBodyStreamChunked (givePopper p)++-- | Build a 'RequestBody' by sending a Content-Length header and then+-- streaming a 'Producer'.+--+-- You should probably use 'makeChunkedRequestBody' if it is supported by the+-- server.+makeFixedRequestBody :: Int64 -> Producer ByteString () IO () -> RequestBody+makeFixedRequestBody len p = RequestBodyStream len (givePopper p)++-- | http-client is weird, it wants us to make poppers and give them to it.+--+-- In summary, we take a Producer and turn it into a function which: given a+-- continuation which takes an IO action that -- when called, will produce+-- successive chunks -- returns an IO () and does some super strange things.+--+-- Gabriel worked this out in pipes-http, and this works. Thanks Gabriel.+givePopper+    :: Producer ByteString () IO ()+    -> (IO ByteString -> IO ())+    -> IO ()+givePopper producer k = do+    ref <- newIORef producer+    k (doRead ref)+  where+    doRead ref = do+        current_producer <- readIORef ref+        x <- qnext current_producer ()+        case x of+            Left () -> do+                writeIORef ref (return ())+                return B.empty+            Right (bs, next_producer) -> do+                writeIORef ref next_producer+                return bs++    -- | This is not a part of quiver because it only behaves how you might+    -- expect if you know that p is a Producer. There doesn't seem to be a good+    -- way of encoding this invariant in the types without nasty extensions.+    qnext p b' = loop p+      where+        loop (Consume _ _ q)  = loop q+        loop (Produce b k' _) = return (Right (b, k' b'))+        loop (Deliver r)      = return (Left r)+        loop (Enclose f)      = f >>= loop