HTTP.hs

{-# LANGUAGE OverloadedStrings #-}
-- | This module replicates `pipes-http` as closely as will type-check, adding a
--   conduit-like @http@ in @ResourceT@ and a primitive @simpleHTTP@ that emits
--   a streaming bytestring rather than a lazy one. 
--
--  
--   Here is an example GET request that streams the response body to standard output:
--
-- > import qualified Data.ByteString.Streaming as Q
-- > import Data.ByteString.Streaming.HTTP
-- >
-- > main = do
-- >   req <- parseRequest "https://www.example.com"
-- >   m <- newManager tlsManagerSettings 
-- >   withHTTP req m $ \resp -> Q.stdout (responseBody resp) 
-- > 
--
--   Here is an example POST request that also streams the request body from
--   standard input:
--
-- > {-#LANGUAGE OverloadedStrings #-}
-- > import qualified Data.ByteString.Streaming as Q
-- > import Data.ByteString.Streaming.HTTP
-- > 
-- > main = do
-- >    req <- parseRequest "https://httpbin.org/post"
-- >    let req' = req
-- >            { method = "POST"
-- >            , requestBody = stream Q.stdin
-- >            }
-- >    m <- newManager tlsManagerSettings
-- >    withHTTP req' m $ \resp -> Q.stdout (responseBody resp)
--
-- Here is the GET request modified to use @http@ and write to a file. @runResourceT@
-- manages the file handle and the interaction.
--
-- > import qualified Data.ByteString.Streaming as Q
-- > import Data.ByteString.Streaming.HTTP
-- >
-- > main = do
-- >   req <- parseUrlThrow "https://www.example.com"
-- >   m <- newManager tlsManagerSettings 
-- >   runResourceT $ do
-- >      resp <- http request manager 
-- >      Q.writeFile "example.html" (responseBody resp) 
--
-- 
--   @simpleHTTP@ can be used in @ghci@ like so:
--
--  > ghci> runResourceT $ Q.stdout $ Q.take 137 $ simpleHTTP "http://lpaste.net/raw/13"
--  > -- Adaptation and extension of a parser for data definitions given in
--  > -- appendix of G. Huttons's paper - Monadic Parser Combinators.
--  > --

-- For non-streaming request bodies, study the 'RequestBody' type, which also
-- accepts strict \/ lazy bytestrings or builders.


module Data.ByteString.Streaming.HTTP (

    -- * Streaming Interface
    withHTTP
    , http
    , streamN
    , stream
    
    -- * ghci testing
    , simpleHTTP

    -- * re-exports
    , module Network.HTTP.Client
    , module Network.HTTP.Client.TLS
    , ResourceT (..)
    , MonadResource (..)
    , runResourceT
    ) where

import Control.Monad (unless)
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
import Data.ByteString.Streaming
import Data.ByteString.Streaming.Internal
import Control.Monad.Trans
import Control.Monad.Trans.Resource
import qualified Data.ByteString.Streaming.Char8 as Q
{- $httpclient
    This module is a thin @streaming-bytestring@ wrapper around the @http-client@ and
    @http-client-tls@ libraries.

    Read the documentation in the "Network.HTTP.Client" module of the
    @http-client@ library to learn about how to:

    * manage connections using connection pooling,

    * use more advanced request\/response features,

    * handle exceptions, and:
    
    * manage cookies.

    @http-client-tls@ provides support for TLS connections (i.e. HTTPS).
-}

-- | Send an HTTP 'Request' and wait for an HTTP 'Response'
withHTTP
    :: Request
    -- ^
    -> Manager
    -- ^
    -> (Response (ByteString IO ()) -> IO a)
    -- ^ Handler for response
    -> IO a
withHTTP r m k = withResponse r m k'
  where
    k' resp = do
        let p = (from . brRead . responseBody) resp
        k (resp { responseBody = p})
{-# INLINABLE withHTTP #-}

-- | Create a 'RequestBody' from a content length and an effectful 'ByteString'
streamN :: Int64 -> ByteString IO () -> RequestBody
streamN n p = RequestBodyStream n (to p)
{-# INLINABLE streamN #-}

{-| Create a 'RequestBody' from an effectful 'ByteString'

    'stream' is more flexible than 'streamN', but requires the server to support
    chunked transfer encoding.
-}
stream :: ByteString IO () -> RequestBody
stream p = RequestBodyStreamChunked (to p)
{-# INLINABLE stream #-}

to :: ByteString IO () -> (IO B.ByteString -> IO ()) -> IO ()
to p0 k = do
    ioref <- newIORef p0
    let readAction :: IO B.ByteString
        readAction = do
            p <- readIORef ioref
            case p of
                Empty   ()      -> do
                    writeIORef ioref (return ())
                    return B.empty
                Go m -> do 
                  p' <- m
                  writeIORef ioref p'
                  readAction
                Chunk bs p' -> do
                    writeIORef ioref p'
                    return bs
    k readAction 

-- from :: IO B.ByteString -> ByteString IO ()
from io = go
  where
    go = do
        bs <- lift io
        unless (B.null bs) $ do
            chunk bs
            go 
            
{-| This is a quick method - oleg would call it \'unprofessional\' - to bring a web page in view.
    It sparks its own internal manager and closes itself. Thus something like this makes sense

>>> runResourceT $ Q.putStrLn $ simpleHttp "http://lpaste.net/raw/12"
chunk _ [] = []
chunk n xs = let h = take n xs in h : (chunk n (drop n xs))
            
    but if you try something like

>>> rest <- runResourceT $ Q.putStrLn $ Q.splitAt 40 $ simpleHTTP "http://lpaste.net/raw/146532"
import Data.ByteString.Streaming.HTTP 

    it will just be good luck if with 
            
>>> runResourceT $ Q.putStrLn rest
            
    you get the rest of the file: 
            
> import qualified Data.ByteString.Streaming.Char8 as Q
> main = runResourceT $ Q.putStrLn $ simpleHTTP "http://lpaste.net/raw/146532"
 
    rather than 
            
> *** Exception: <socket: 13>: hGetBuf: illegal operation (handle is closed)
            
    Since, of course, the handle was already closed by the first use of @runResourceT@.
    The same applies of course to the more hygienic 'withHTTP' above, 
    which permits one to extract an @IO (ByteString IO r)@, by using @splitAt@ or
    the like. 
            
    The reaction of some streaming-io libraries was simply to forbid
    operations like @splitAt@. That this paternalism was not viewed
    as simply outrageous is a consequence of the opacity of the
    older iteratee-io libraries. It is /obvious/ that I can no more run an
    effectful bytestring after I have made its effects impossible by
    using @runResourceT@ (which basically means @closeEverythingDown@). 
    I might as well try to run it after tossing my machine into the flames. 
    Similarly, it is obvious that I cannot read from a handle after I have 
    applied @hClose@; there is simply no difference between the two cases.
-}
simpleHTTP :: MonadResource m => String -> ByteString m ()
simpleHTTP url = do
    man <- liftIO (newManager tlsManagerSettings)
    req <- liftIO (parseUrlThrow url)
    bracketByteString 
       (responseOpen req man) 
       responseClose 
       ( from . liftIO . responseBody)


http :: MonadResource m
      => Request
      -> Manager
      -> m (Response (ByteString m ()))
http req man = do
     (key, res) <- allocate (responseOpen req man) responseClose
     return res {responseBody = from (liftIO (responseBody res))}