{-# 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 :: forall a.
Request -> Manager -> (Response (ByteString IO ()) -> IO a) -> IO a
withHTTP Request
r Manager
m Response (ByteString IO ()) -> IO a
k = Request -> Manager -> (Response BodyReader -> IO a) -> IO a
forall a.
Request -> Manager -> (Response BodyReader -> IO a) -> IO a
withResponse Request
r Manager
m Response BodyReader -> IO a
k'
  where
    k' :: Response BodyReader -> IO a
k' Response BodyReader
resp = do
        let p :: ByteString IO ()
p = (BodyReader -> ByteString IO ()
forall {m :: * -> *}. Monad m => m ByteString -> ByteStream m ()
from (BodyReader -> ByteString IO ())
-> (Response BodyReader -> BodyReader)
-> Response BodyReader
-> ByteString IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BodyReader -> BodyReader
brRead (BodyReader -> BodyReader)
-> (Response BodyReader -> BodyReader)
-> Response BodyReader
-> BodyReader
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> BodyReader
forall body. Response body -> body
responseBody) Response BodyReader
resp
        Response (ByteString IO ()) -> IO a
k (Response BodyReader
resp { responseBody = p})
{-# INLINABLE withHTTP #-}

-- | Create a 'RequestBody' from a content length and an effectful 'ByteString'
streamN :: Int64 -> ByteString IO () -> RequestBody
streamN :: Int64 -> ByteString IO () -> RequestBody
streamN Int64
n ByteString IO ()
p = Int64 -> GivesPopper () -> RequestBody
RequestBodyStream Int64
n (ByteString IO () -> GivesPopper ()
to ByteString IO ()
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 :: ByteString IO () -> RequestBody
stream ByteString IO ()
p = GivesPopper () -> RequestBody
RequestBodyStreamChunked (ByteString IO () -> GivesPopper ()
to ByteString IO ()
p)
{-# INLINABLE stream #-}

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

-- from :: IO B.ByteString -> ByteString IO ()
from :: m ByteString -> ByteStream m ()
from m ByteString
io = ByteStream m ()
go
  where
    go :: ByteStream m ()
go = do
        ByteString
bs <- m ByteString -> ByteStream m ByteString
forall (m :: * -> *) a. Monad m => m a -> ByteStream m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift m ByteString
io
        Bool -> ByteStream m () -> ByteStream m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (ByteStream m () -> ByteStream m ())
-> ByteStream m () -> ByteStream m ()
forall a b. (a -> b) -> a -> b
$ do
            ByteString -> ByteStream m ()
forall (m :: * -> *). ByteString -> ByteStream m ()
chunk ByteString
bs
            ByteStream m ()
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 :: forall (m :: * -> *). MonadResource m => String -> ByteString m ()
simpleHTTP String
url = do
    Manager
man <- IO Manager -> ByteStream m Manager
forall a. IO a -> ByteStream m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (ManagerSettings -> IO Manager
newManager ManagerSettings
tlsManagerSettings)
    Request
req <- IO Request -> ByteStream m Request
forall a. IO a -> ByteStream m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO Request
forall (m :: * -> *). MonadThrow m => String -> m Request
parseUrlThrow String
url)
    IO (Response BodyReader)
-> (Response BodyReader -> IO ())
-> (Response BodyReader -> ByteString m ())
-> ByteString m ()
forall (m :: * -> *) a b.
MonadResource m =>
IO a -> (a -> IO ()) -> (a -> ByteStream m b) -> ByteStream m b
bracketByteString 
       (Request -> Manager -> IO (Response BodyReader)
responseOpen Request
req Manager
man) 
       Response BodyReader -> IO ()
forall a. Response a -> IO ()
responseClose 
       ( m ByteString -> ByteString m ()
forall {m :: * -> *}. Monad m => m ByteString -> ByteStream m ()
from (m ByteString -> ByteString m ())
-> (Response BodyReader -> m ByteString)
-> Response BodyReader
-> ByteString m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BodyReader -> m ByteString
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (BodyReader -> m ByteString)
-> (Response BodyReader -> BodyReader)
-> Response BodyReader
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Response BodyReader -> BodyReader
forall body. Response body -> body
responseBody)


http :: MonadResource m
      => Request
      -> Manager
      -> m (Response (ByteString m ()))
http :: forall (m :: * -> *).
MonadResource m =>
Request -> Manager -> m (Response (ByteString m ()))
http Request
req Manager
man = do
     (ReleaseKey
key, Response BodyReader
res) <- IO (Response BodyReader)
-> (Response BodyReader -> IO ())
-> m (ReleaseKey, Response BodyReader)
forall (m :: * -> *) a.
MonadResource m =>
IO a -> (a -> IO ()) -> m (ReleaseKey, a)
allocate (Request -> Manager -> IO (Response BodyReader)
responseOpen Request
req Manager
man) Response BodyReader -> IO ()
forall a. Response a -> IO ()
responseClose
     Response (ByteString m ()) -> m (Response (ByteString m ()))
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return Response BodyReader
res {responseBody = from (liftIO (responseBody res))}