--
-- HTTP client for use with io-streams
--
-- Copyright © 2012-2018 Operational Dynamics Consulting, Pty Ltd
--           © 2020      Herbert Valerio Riedel
--
-- 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 BSD licence.
--

{-# LANGUAGE DoAndIfThenElse    #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# OPTIONS_HADDOCK hide, not-home #-}

module Network.Http.Connection (
    Connection(..),
        -- constructors only for testing
    makeConnection,
    withConnection,
    openConnection,
    openConnectionSSL,
    openConnectionSSL',
    openConnectionUnix,
    closeConnection,
    getHostname,
    getRequestHeaders,
    getHeadersFull,
    sendRequest,
    receiveResponse,
    receiveResponseRaw,
    unsafeReceiveResponse,
    unsafeReceiveResponseRaw,
    UnexpectedCompression,
    receiveUpgradeResponse,
    receiveConnectResponse,
    unsafeWithRawStreams,
    emptyBody,
    fileBody,
    bytestringBody,
    lazyBytestringBody,
    utf8TextBody,
    utf8LazyTextBody,
    inputStreamBody,
    inputStreamBodyChunked,
    debugHandler,
    concatHandler
) where

import Blaze.ByteString.Builder (Builder)
import qualified Blaze.ByteString.Builder as Builder (flush, fromByteString, toByteString, fromLazyByteString)
import qualified Blaze.ByteString.Builder.Char.Utf8 as Builder (fromText, fromLazyText)
import qualified Blaze.ByteString.Builder.HTTP as Builder (chunkedTransferEncoding, chunkedTransferTerminator)
import Control.Exception (bracket)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Lazy as BL
import qualified Data.ByteString.Char8 as S
import Data.Text (Text)
import qualified Data.Text.Lazy as TL (Text)
import Network.Socket
import OpenSSL (withOpenSSL)
import OpenSSL.Session (SSL, SSLContext)
import qualified OpenSSL.Session as SSL
import System.IO.Streams (InputStream, OutputStream, stdout)
import qualified System.IO.Streams as Streams
import qualified System.IO.Streams.SSL as Streams hiding (connect)
import qualified Data.Monoid as Mon

import Network.Http.Internal
import Network.Http.ResponseParser

--
-- | A connection to a web server.
--
data Connection
    = Connection {
        Connection -> ByteString
cHost  :: !ByteString,
            -- ^ will be used as the Host: header in the HTTP request.
        Connection -> IO ()
cClose :: IO (),
            -- ^ called when the connection should be closed.
        Connection -> OutputStream Builder
cOut   :: OutputStream Builder,
        Connection -> InputStream ByteString
cIn    :: InputStream ByteString
    }

instance Show Connection where
    show :: Connection -> String
show Connection
c =    {-# SCC "Connection.show" #-}
        [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
           [String
"Host: ",
             ByteString -> String
S.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString
cHost Connection
c,
             String
"\n"]


-- | Create a raw 'Connection' object from the given parts. This is
-- primarily of use when testing (or when HTTP is spoken wrapped
-- inside another transport-layer), for example:
--
-- > fakeConnection :: IO Connection
-- > fakeConnection = do
-- >     o  <- Streams.nullOutput
-- >     i  <- Streams.nullInput
-- >     return (makeConnection "www.example.com" (return()) o i)
--
-- is an idiom we use frequently in testing and benchmarking, usually
-- replacing the InputStream with something like:
--
-- >     x' <- S.readFile "properly-formatted-response.txt"
-- >     i  <- Streams.fromByteString x'
--
-- If you're going to do that, keep in mind that you /must/ have CR-LF
-- pairs after each header line and between the header and body to
-- be compliant with the HTTP protocol; otherwise, parsers will
-- reject your message.
--
-- @since 0.1.3.0
makeConnection
    :: ByteString
    -- ^ will be used as the default @Host:@ header value in HTTP requests unless overridden by 'setHostname'.
    -> IO ()
    -- ^ an action to be called when the connection is terminated (via e.g. 'closeConnection').
    -> OutputStream Builder
    -- ^ write end of the HTTP client-server connection.
    -> InputStream ByteString
    -- ^ read end of the HTTP client-server connection.
    -> Connection
makeConnection :: ByteString
-> IO ()
-> OutputStream Builder
-> InputStream ByteString
-> Connection
makeConnection = ByteString
-> IO ()
-> OutputStream Builder
-> InputStream ByteString
-> Connection
Connection


--
-- | Given an @IO@ action producing a 'Connection', and a computation
-- that needs one, runs the computation, cleaning up the
-- @Connection@ afterwards.
--
-- >     x <- withConnection (openConnection "s3.example.com" 80) $ (\c -> do
-- >         let q = buildRequest1 $ do
-- >             http GET "/bucket42/object/149"
-- >         sendRequest c q emptyBody
-- >         ...
-- >         return "blah")
--
-- which can make the code making an HTTP request a lot more
-- straight-forward.
--
-- Wraps @Control.Exception@'s 'Control.Exception.bracket'.
--
withConnection :: IO Connection -> (Connection -> IO γ) -> IO γ
withConnection :: forall γ. IO Connection -> (Connection -> IO γ) -> IO γ
withConnection IO Connection
mkC =
    IO Connection
-> (Connection -> IO ()) -> (Connection -> IO γ) -> IO γ
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Connection
mkC Connection -> IO ()
closeConnection


--
-- | In order to make a request you first establish the TCP
-- connection to the server over which to send it.
--
-- Ordinarily you would supply the host part of the URL here and it will
-- be used as the value of the HTTP 1.1 @Host:@ field. However, you can
-- specify any server name or IP addresss and set the @Host:@ value
-- later with 'Network.Http.Client.setHostname' when building the
-- request.
--
-- Usage is as follows:
--
-- >     c <- openConnection "localhost" 80
-- >     ...
-- >     closeConnection c
--
-- More likely, you'll use 'withConnection' to wrap the call in order
-- to ensure finalization.
--
-- HTTP pipelining is supported; you can reuse the connection to a
-- web server, but it's up to you to ensure you match the number of
-- requests sent to the number of responses read, and to process those
-- responses in order. This is all assuming that the /server/ supports
-- pipelining; be warned that not all do. Web browsers go to
-- extraordinary lengths to probe this; you probably only want to do
-- pipelining under controlled conditions. Otherwise just open a new
-- connection for subsequent requests.
--
openConnection :: Hostname -> Port -> IO Connection
openConnection :: ByteString -> Port -> IO Connection
openConnection ByteString
h1' Port
p = do
    is <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
getAddrInfo (AddrInfo -> Maybe AddrInfo
forall a. a -> Maybe a
Just AddrInfo
hints) (String -> Maybe String
forall a. a -> Maybe a
Just String
h1) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Port -> String
forall a. Show a => a -> String
show Port
p)
    let addr = [AddrInfo] -> AddrInfo
forall a. HasCallStack => [a] -> a
head [AddrInfo]
is
    let a = AddrInfo -> SockAddr
addrAddress AddrInfo
addr
    s <- socket (addrFamily addr) Stream defaultProtocol

    connect s a
    (i,o1) <- Streams.socketToStreams s

    o2 <- Streams.builderStream o1

    return Connection {
        cHost  = h2',
        cClose = close s,
        cOut   = o2,
        cIn    = i
    }
  where
    hints :: AddrInfo
hints = AddrInfo
defaultHints {
        addrFlags = [AI_ADDRCONFIG, AI_NUMERICSERV],
        addrSocketType = Stream
    }
    h2' :: ByteString
h2' = if Port
p Port -> Port -> Bool
forall a. Eq a => a -> a -> Bool
== Port
80
        then ByteString
h1'
        else [ByteString] -> ByteString
S.concat [ ByteString
h1', ByteString
":", String -> ByteString
S.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Port -> String
forall a. Show a => a -> String
show Port
p ]
    h1 :: String
h1  = ByteString -> String
S.unpack ByteString
h1'

--
-- | Open a secure connection to a web server.
--
-- > import OpenSSL (withOpenSSL)
-- >
-- > main :: IO ()
-- > main = do
-- >     ctx <- baselineContextSSL
-- >     c <- openConnectionSSL ctx "api.github.com" 443
-- >     ...
-- >     closeConnection c
--
-- If you want to tune the parameters used in making SSL connections,
-- manually specify certificates, etc, then setup your own context:
--
-- > import OpenSSL.Session (SSLContext)
-- > import qualified OpenSSL.Session as SSL
-- >
-- >     ...
-- >     ctx <- SSL.context
-- >     ...
--
-- See "OpenSSL.Session".
--
-- Crypto is as provided by the system @openssl@ library, as wrapped
-- by the @HsOpenSSL@ package and @openssl-streams@.
--
-- NB: /There is no longer a need to call 'OpenSSL.withOpenSSL' explicitly; the initialization is invoked once per process for you/
--
openConnectionSSL :: SSLContext -> Hostname -> Port -> IO Connection
openConnectionSSL :: SSLContext -> ByteString -> Port -> IO Connection
openConnectionSSL SSLContext
ctx ByteString
h1' = (SSL -> IO ()) -> SSLContext -> ByteString -> Port -> IO Connection
openConnectionSSL' SSL -> IO ()
modssl SSLContext
ctx ByteString
h1'
  where
    modssl :: SSL -> IO ()
modssl SSL
ssl = SSL -> String -> IO ()
SSL.setTlsextHostName SSL
ssl String
h1
    h1 :: String
h1         = ByteString -> String
S.unpack ByteString
h1'

-- | Variant of 'openConnectionSSL' which allows to customize the
-- 'SSL' connection /before/ a client SSL handshake is
-- attempted. This is useful if you want to have more control over
-- the use of TLS extensions such as
-- <https://en.wikipedia.org/wiki/Server_Name_Indication SNI> or
-- enable features such as
-- <https://www.openssl.org/docs/manmaster/man3/X509_check_host.html hostname validation>.
--
-- For reference, the 'openConnectionSSL' function can be defined in
-- terms of 'openConnectionSSL'' like so
--
-- > openConnectionSSL :: SSLContext -> Hostname -> Port -> IO Connection
-- > openConnectionSSL ctx h1' = openConnectionSSL' modssl ctx h1'
-- >   where
-- >     modssl ssl = SSL.setTlsextHostName ssl h1
-- >     h1         = S.unpack h1'
--
-- @since 0.1.6.0
openConnectionSSL' :: (SSL -> IO ()) -> SSLContext -> Hostname -> Port -> IO Connection
openConnectionSSL' :: (SSL -> IO ()) -> SSLContext -> ByteString -> Port -> IO Connection
openConnectionSSL' SSL -> IO ()
modssl SSLContext
ctx ByteString
h1' Port
p = IO Connection -> IO Connection
forall a. IO a -> IO a
withOpenSSL (IO Connection -> IO Connection) -> IO Connection -> IO Connection
forall a b. (a -> b) -> a -> b
$ do
    is <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
forall (t :: * -> *).
GetAddrInfo t =>
Maybe AddrInfo -> Maybe String -> Maybe String -> IO (t AddrInfo)
getAddrInfo Maybe AddrInfo
forall a. Maybe a
Nothing (String -> Maybe String
forall a. a -> Maybe a
Just String
h1) (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ Port -> String
forall a. Show a => a -> String
show Port
p)

    let a = AddrInfo -> SockAddr
addrAddress (AddrInfo -> SockAddr) -> AddrInfo -> SockAddr
forall a b. (a -> b) -> a -> b
$ [AddrInfo] -> AddrInfo
forall a. HasCallStack => [a] -> a
head [AddrInfo]
is
        f = AddrInfo -> Family
addrFamily (AddrInfo -> Family) -> AddrInfo -> Family
forall a b. (a -> b) -> a -> b
$ [AddrInfo] -> AddrInfo
forall a. HasCallStack => [a] -> a
head [AddrInfo]
is
    s <- socket f Stream defaultProtocol

    connect s a

    ssl <- SSL.connection ctx s
    modssl ssl
    SSL.connect ssl

    (i,o1) <- Streams.sslToStreams ssl

    o2 <- Streams.builderStream o1

    return Connection {
        cHost  = h2',
        cClose = closeSSL s ssl,
        cOut   = o2,
        cIn    = i
    }
  where
    h2' :: ByteString
    h2' :: ByteString
h2' = if Port
p Port -> Port -> Bool
forall a. Eq a => a -> a -> Bool
== Port
443
        then ByteString
h1'
        else [ByteString] -> ByteString
S.concat [ ByteString
h1', ByteString
":", String -> ByteString
S.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Port -> String
forall a. Show a => a -> String
show Port
p ]
    h1 :: String
h1  = ByteString -> String
S.unpack ByteString
h1'

closeSSL :: Socket -> SSL -> IO ()
closeSSL :: Socket -> SSL -> IO ()
closeSSL Socket
s SSL
ssl = do
    SSL -> ShutdownType -> IO ()
SSL.shutdown SSL
ssl ShutdownType
SSL.Unidirectional
    Socket -> IO ()
close Socket
s

--
-- | Open a connection to a Unix domain socket.
--
-- > main :: IO ()
-- > main = do
-- >     c <- openConnectionUnix "/var/run/docker.sock"
-- >     ...
-- >     closeConnection c
--
openConnectionUnix :: FilePath -> IO Connection
openConnectionUnix :: String -> IO Connection
openConnectionUnix String
path = do
    let a :: SockAddr
a = String -> SockAddr
SockAddrUnix String
path
    s <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_UNIX SocketType
Stream ProtocolNumber
defaultProtocol

    connect s a
    (i,o1) <- Streams.socketToStreams s

    o2 <- Streams.builderStream o1

    return Connection {
        cHost  = S.pack path,
        cClose = close s,
        cOut   = o2,
        cIn    = i
    }

--
-- | Having composed a 'Request' object with the headers and metadata for
-- this connection, you can now send the request to the server, along
-- with the entity body, if there is one. For the rather common case of
-- HTTP requests like 'GET' that don't send data, use 'emptyBody' as the
-- output stream:
--
-- >     sendRequest c q emptyBody
--
-- For 'PUT' and 'POST' requests, you can use 'fileBody' or
-- 'inputStreamBody' to send content to the server, or you can work with
-- the @io-streams@ API directly:
--
-- >     sendRequest c q (\o ->
-- >         Streams.write (Just (Builder.fromString "Hello World\n")) o)
--
{-
    I would like to enforce the constraints on the Empty and Static
    cases shown here, but those functions take OutputStream ByteString,
    and we are of course working in OutputStream Builder by that point.
-}
sendRequest :: Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
sendRequest :: forall α.
Connection -> Request -> (OutputStream Builder -> IO α) -> IO α
sendRequest Connection
c Request
q OutputStream Builder -> IO α
handler = do
    -- write the headers

    Maybe Builder -> OutputStream Builder -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (Builder -> Maybe Builder
forall a. a -> Maybe a
Just Builder
msg) OutputStream Builder
o2

    -- deal with the expect-continue mess

    e2 <- case ExpectMode
t of
        ExpectMode
Normal -> do
            EntityBody -> IO EntityBody
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EntityBody
e

        ExpectMode
Continue -> do
            Maybe Builder -> OutputStream Builder -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (Builder -> Maybe Builder
forall a. a -> Maybe a
Just Builder
Builder.flush) OutputStream Builder
o2

            p  <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i

            case getStatusCode p of
                Int
100 -> do
                        -- ok to send
                        EntityBody -> IO EntityBody
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EntityBody
e
                Int
_   -> do
                        -- put the response back
                        ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
Streams.unRead (Response -> ByteString
rsp Response
p) InputStream ByteString
i
                        EntityBody -> IO EntityBody
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EntityBody
Empty

    -- write the body, if there is one

    x <- case e2 of
        EntityBody
Empty -> do
            o3 <- IO (OutputStream Builder)
forall a. IO (OutputStream a)
Streams.nullOutput
            y <- handler o3
            return y

        EntityBody
Chunking    -> do
            o3 <- (Builder -> Builder)
-> OutputStream Builder -> IO (OutputStream Builder)
forall a b. (a -> b) -> OutputStream b -> IO (OutputStream a)
Streams.contramap Builder -> Builder
Builder.chunkedTransferEncoding OutputStream Builder
o2
            y  <- handler o3
            Streams.write (Just Builder.chunkedTransferTerminator) o2
            return y

        (Static Int64
_) -> do
--          o3 <- Streams.giveBytes (fromIntegral n :: Int64) o2
            y  <- OutputStream Builder -> IO α
handler OutputStream Builder
o2
            return y


    -- push the stream out by flushing the output buffers

    Streams.write (Just Builder.flush) o2

    return x

  where
    o2 :: OutputStream Builder
o2 = Connection -> OutputStream Builder
cOut Connection
c
    e :: EntityBody
e = Request -> EntityBody
qBody Request
q
    t :: ExpectMode
t = Request -> ExpectMode
qExpect Request
q
    msg :: Builder
msg = Request -> ByteString -> Builder
composeRequestBytes Request
q ByteString
h'
    h' :: ByteString
h' = Connection -> ByteString
cHost Connection
c
    i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c
    rsp :: Response -> ByteString
rsp Response
p = Builder -> ByteString
Builder.toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Response -> Builder
composeResponseBytes Response
p


--
-- | Get the virtual hostname that will be used as the @Host:@ header in
-- the HTTP 1.1 request. Per RFC 2616 § 14.23, this will be of the form
-- @hostname:port@ if the port number is other than the default, ie 80
-- for HTTP.
--
getHostname :: Connection -> Request -> ByteString
getHostname :: Connection -> Request -> ByteString
getHostname Connection
c Request
q =
    case Request -> Maybe ByteString
qHost Request
q of
        Just ByteString
h' -> ByteString
h'
        Maybe ByteString
Nothing -> Connection -> ByteString
cHost Connection
c


{-# DEPRECATED getRequestHeaders "use retrieveHeaders . getHeadersFull instead" #-}
getRequestHeaders :: Connection -> Request -> [(ByteString, ByteString)]
getRequestHeaders :: Connection -> Request -> [(ByteString, ByteString)]
getRequestHeaders Connection
c Request
q =
    (ByteString
"Host", Connection -> Request -> ByteString
getHostname Connection
c Request
q) (ByteString, ByteString)
-> [(ByteString, ByteString)] -> [(ByteString, ByteString)]
forall a. a -> [a] -> [a]
: [(ByteString, ByteString)]
kvs
  where
    h :: Headers
h = Request -> Headers
qHeaders Request
q
    kvs :: [(ByteString, ByteString)]
kvs = Headers -> [(ByteString, ByteString)]
retrieveHeaders Headers
h

--
-- | Get the headers that will be sent with this request. You likely won't
-- need this but there are some corner cases where people need to make
-- calculations based on all the headers before they go out over the wire.
--
-- If you'd like the request headers as an association list, import the header
-- functions:
--
-- > import Network.Http.Types
--
-- then use 'Network.Http.Types.retreiveHeaders' as follows:
--
-- >>> let kvs = retreiveHeaders $ getHeadersFull c q
-- >>> :t kvs
-- :: [(ByteString, ByteString)]
--
getHeadersFull :: Connection -> Request -> Headers
getHeadersFull :: Connection -> Request -> Headers
getHeadersFull Connection
c Request
q =
    Headers
h'
  where
    h :: Headers
h  = Request -> Headers
qHeaders Request
q
    h' :: Headers
h' = Headers -> ByteString -> ByteString -> Headers
updateHeader Headers
h ByteString
"Host" (Connection -> Request -> ByteString
getHostname Connection
c Request
q)

--
-- | Handle the response coming back from the server. This function
-- hands control to a handler function you supply, passing you the
-- 'Response' object with the response headers and an 'InputStream'
-- containing the entity body.
--
-- For example, if you just wanted to print the first chunk of the
-- content from the server:
--
-- >     receiveResponse c (\p i -> do
-- >         m <- Streams.read i
-- >         case m of
-- >             Just bytes -> putStr bytes
-- >             Nothing    -> return ())
--
-- Obviously, you can do more sophisticated things with the
-- 'InputStream', which is the whole point of having an @io-streams@
-- based HTTP client library.
--
-- The final value from the handler function is the return value of
-- @receiveResponse@, if you need it.
--
-- Throws 'UnexpectedCompression' if it doesn't know how to handle the
-- compression format used in the response.
--
{-
    The reponse body coming from the server MUST be fully read, even
    if (especially if) the users's handler doesn't consume it all.
    This is necessary to maintain the HTTP protocol invariants;
    otherwise pipelining would not work. It's not entirely clear
    *which* InputStream is being drained here; the underlying
    InputStream ByteString in Connection remains unconsumed beyond the
    threshold of the current response, which is exactly what we need.
-}
receiveResponse :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
receiveResponse :: forall β.
Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
receiveResponse Connection
c Response -> InputStream ByteString -> IO β
handler = do
    p  <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
    i' <- readResponseBody p i

    x  <- handler p i'

    Streams.skipToEof i'

    return x
  where
    i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c

--
-- | This is a specialized variant of 'receiveResponse' that /explicitly/ does
-- not handle the content encoding of the response body stream (it will not
-- decompress anything). Unless you really want the raw gzipped content coming
-- down from the server, use @receiveResponse@.
--
{-
    See notes at receiveResponse.
-}
receiveResponseRaw :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
receiveResponseRaw :: forall β.
Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
receiveResponseRaw Connection
c Response -> InputStream ByteString -> IO β
handler = do
    p  <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
    let p' = Response
p {
        pContentEncoding = Identity
    }

    i' <- readResponseBody p' i

    x  <- handler p i'

    Streams.skipToEof i'

    return x
  where
    i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c

--
-- | Handle the response coming back from the server. This function
-- is the same as receiveResponse, but it does not consume the body for
-- you after the handler is done.  This means that it can only be safely used
-- if the handler will fully consume the body, there is no body, or when
-- the connection is not being reused (no pipelining).
--
-- @since 0.1.2.0
unsafeReceiveResponse :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
unsafeReceiveResponse :: forall β.
Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
unsafeReceiveResponse Connection
c Response -> InputStream ByteString -> IO β
handler = do
    p  <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
    i' <- readResponseBody p i

    handler p i'
  where
    i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c


-- | Variant of 'unsafeReceiveResponse' in the spirit of 'receiveResponseRaw'
--
-- @since 0.1.2.0
unsafeReceiveResponseRaw :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
unsafeReceiveResponseRaw :: forall β.
Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
unsafeReceiveResponseRaw Connection
c Response -> InputStream ByteString -> IO β
handler = do
    p  <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
    i' <- readResponseBody p { pContentEncoding = Identity } i

    handler p i'
  where
    i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c

-- | Provide access to the full-duplex transport level 'InputStream' and 'OutputStream'.
--
-- This can be used for implementing e.g. @CONNECT@ method invocations or when the HTTP
-- connection is upgraded to a different protocol (e.g. Websockets) via the HTTP/1.1 upgrade mechanism
-- (see  <https://tools.ietf.org/html/rfc7230#section-6.7 RFC 7230 section 6.7>).
--
-- See also 'receiveUpgradeResponse' and 'receiveConnectResponse'.
--
-- @since 0.1.3.0
unsafeWithRawStreams :: Connection -> (InputStream ByteString -> OutputStream Builder -> IO a) -> IO a
unsafeWithRawStreams :: forall a.
Connection
-> (InputStream ByteString -> OutputStream Builder -> IO a) -> IO a
unsafeWithRawStreams Connection
conn InputStream ByteString -> OutputStream Builder -> IO a
act = InputStream ByteString -> OutputStream Builder -> IO a
act (Connection -> InputStream ByteString
cIn Connection
conn) (Connection -> OutputStream Builder
cOut Connection
conn)

-- | Variant of 'receiveResponse' which expects either a HTTP @HTTP/1.1 101 Switching Protocols@ upgrade response (see  <https://tools.ietf.org/html/rfc7230#section-6.7 RFC 7230 section 6.7>) or falls back to the normal 'receiveResponse' semantics.
--
-- Usually, after having upgraded a HTTP connection it is not possible
-- to go back and resume speaking the HTTP protocol and so typically the
-- 'Connection' should be closed after having completed interaction
-- via the upgraded protocol (via e.g. 'withConnection' or
-- 'closeConnection').
--
-- See also 'unsafeWithRawStreams'.
--
-- @since 0.1.3.0
receiveUpgradeResponse :: Connection
                       -> (Response -> InputStream ByteString                         -> IO a) -- ^ Non-code @101@ response handler
                       -> (Response -> InputStream ByteString -> OutputStream Builder -> IO a) -- ^ Code @101@ response handler
                       -> IO a
receiveUpgradeResponse :: forall a.
Connection
-> (Response -> InputStream ByteString -> IO a)
-> (Response
    -> InputStream ByteString -> OutputStream Builder -> IO a)
-> IO a
receiveUpgradeResponse Connection
c Response -> InputStream ByteString -> IO a
handler Response -> InputStream ByteString -> OutputStream Builder -> IO a
handler2 = do
    p <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
    case pStatusCode p of
      Int
101 -> Response -> InputStream ByteString -> OutputStream Builder -> IO a
handler2 Response
p InputStream ByteString
i (Connection -> OutputStream Builder
cOut Connection
c)
      Int
_ -> do
        i' <- Response -> InputStream ByteString -> IO (InputStream ByteString)
readResponseBody Response
p InputStream ByteString
i
        x  <- handler p i'
        Streams.skipToEof i'
        return x
  where
    i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c

-- | Variant of 'receiveResponse' which expects either a succesful @2xx@ response to a previously sent @CONNECT@-style request (see  <https://tools.ietf.org/html/rfc7231#section-4.3.6 RFC 7231 section 4.3.6>) or falls back to the normal 'receiveResponse' semantics.
--
-- Usually, after having established a tunneled HTTP connection it is not possible
-- to go back and resume speaking the HTTP protocol and so typically the
-- 'Connection' should be closed after having completed interaction
-- via the tunnel (by use of e.g. 'withConnection' or 'closeConnection').
--
-- See also 'unsafeWithRawStreams'.
--
-- @since 0.1.3.0
receiveConnectResponse :: Connection
                       -> (Response -> InputStream ByteString                         -> IO a) -- ^ Non-code @2xx@ response handler
                       -> (Response -> InputStream ByteString -> OutputStream Builder -> IO a) -- ^ Code @2xx@ response handler
                       -> IO a
receiveConnectResponse :: forall a.
Connection
-> (Response -> InputStream ByteString -> IO a)
-> (Response
    -> InputStream ByteString -> OutputStream Builder -> IO a)
-> IO a
receiveConnectResponse Connection
c Response -> InputStream ByteString -> IO a
handler Response -> InputStream ByteString -> OutputStream Builder -> IO a
handler2 = do
    p <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
    case pStatusCode p of
      Int
code | Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
200, Int
code Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
300 -> Response -> InputStream ByteString -> OutputStream Builder -> IO a
handler2 Response
p InputStream ByteString
i (Connection -> OutputStream Builder
cOut Connection
c)
      Int
_ -> do
        i' <- Response -> InputStream ByteString -> IO (InputStream ByteString)
readResponseBody Response
p InputStream ByteString
i
        x  <- handler p i'
        Streams.skipToEof i'
        return x
  where
    i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c


--
-- | Use this for the common case of the HTTP methods that only send
-- headers and which have no entity body, i.e. 'GET' requests.
--
emptyBody :: OutputStream Builder -> IO ()
emptyBody :: OutputStream Builder -> IO ()
emptyBody OutputStream Builder
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Convenience function for sending a strict 'ByteString' as the body of the request.
--
-- >     sendRequest c q (bytestringBody "PING")
--
-- @since 0.1.1.0
bytestringBody :: ByteString -> OutputStream Builder -> IO ()
bytestringBody :: ByteString -> OutputStream Builder -> IO ()
bytestringBody ByteString
bs = Maybe Builder -> OutputStream Builder -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$! ByteString -> Builder
Builder.fromByteString ByteString
bs)

-- | Convenience function for sending a lazy 'BL.ByteString' as the body of the request.
--
-- >     sendRequest c q (lazyBytestringBody "PING")
--
-- @since 0.1.1.0
lazyBytestringBody :: BL.ByteString -> OutputStream Builder -> IO ()
lazyBytestringBody :: ByteString -> OutputStream Builder -> IO ()
lazyBytestringBody ByteString
bs = Maybe Builder -> OutputStream Builder -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
Builder.fromLazyByteString ByteString
bs)

-- | Convenience function for sending a 'Text' value as the (UTF-8 encoded) body of the request.
--
-- >     sendRequest c q (utf8TextBody "PING")
--
-- @since 0.1.1.0
utf8TextBody :: Text -> OutputStream Builder -> IO ()
utf8TextBody :: Text -> OutputStream Builder -> IO ()
utf8TextBody Text
t = Maybe Builder -> OutputStream Builder -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$! Text -> Builder
Builder.fromText Text
t)

-- | Convenience function for sending a lazy 'TL.Text' value as the (UTF-8 encoded) body of the request.
--
-- >     sendRequest c q (utf8LazyTextBody "PING")
--
-- @since 0.1.1.0
utf8LazyTextBody :: TL.Text -> OutputStream Builder -> IO ()
utf8LazyTextBody :: Text -> OutputStream Builder -> IO ()
utf8LazyTextBody Text
t = Maybe Builder -> OutputStream Builder -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$ Text -> Builder
Builder.fromLazyText Text
t)

--
-- | Specify a local file to be sent to the server as the body of the
-- request.
--
-- You use this partially applied:
--
-- >     sendRequest c q (fileBody "/etc/passwd")
--
-- Note that the type of @(fileBody \"\/path\/to\/file\")@ is just what
-- you need for the third argument to 'sendRequest', namely
--
-- >>> :t filePath "hello.txt"
-- :: OutputStream Builder -> IO ()
--
{-
    Relies on Streams.withFileAsInput generating (very) large chunks [which it
    does]. A more efficient way to do this would be interesting.
-}
fileBody :: FilePath -> OutputStream Builder -> IO ()
fileBody :: String -> OutputStream Builder -> IO ()
fileBody String
p OutputStream Builder
o = do
    String -> (InputStream ByteString -> IO ()) -> IO ()
forall a. String -> (InputStream ByteString -> IO a) -> IO a
Streams.withFileAsInput String
p (\InputStream ByteString
i -> InputStream ByteString -> OutputStream Builder -> IO ()
inputStreamBody InputStream ByteString
i OutputStream Builder
o)


--
-- | Read from a pre-existing 'InputStream' and pipe that through to the
-- connection to the server. This is useful in the general case where
-- something else has handed you stream to read from and you want to use
-- it as the entity body for the request.
--
-- You use this partially applied:
--
-- >     i <- getStreamFromVault                    -- magic, clearly
-- >     sendRequest c q (inputStreamBody i)
--
-- This function maps "Builder.fromByteString" over the input, which will
-- be efficient if the ByteString chunks are large.
--
-- See also 'inputStreamBodyChunked'.
{-
    Note that this has to be 'supply' and not 'connect' as we do not
    want the end of stream to prematurely terminate the chunked encoding
    pipeline!
-}
inputStreamBody :: InputStream ByteString -> OutputStream Builder -> IO ()
inputStreamBody :: InputStream ByteString -> OutputStream Builder -> IO ()
inputStreamBody InputStream ByteString
i1 OutputStream Builder
o = do
    i2 <- (ByteString -> Builder)
-> InputStream ByteString -> IO (InputStream Builder)
forall a b. (a -> b) -> InputStream a -> IO (InputStream b)
Streams.map ByteString -> Builder
Builder.fromByteString InputStream ByteString
i1
    Streams.supply i2 o

-- | Variant of 'inputStreamBody' which enforces a maximum chunk-size.
--
-- This is useful to deal with some HTTP server implementation which
-- impose maximum chunk-size for @chunked-transfer@ encoded request
-- bodies.
--
-- When called with a negative or @0@ chunk-size argument this
-- function is equivalent to 'inputStreamBody', i.e. over sized chunks
-- from the 'InputStream' are not broken up.
--
-- @since 0.1.4.0
inputStreamBodyChunked :: Int -> InputStream ByteString -> OutputStream Builder -> IO ()
inputStreamBodyChunked :: Int -> InputStream ByteString -> OutputStream Builder -> IO ()
inputStreamBodyChunked Int
maxChunkSize InputStream ByteString
i OutputStream Builder
o
  | Int
maxChunkSize Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 = IO ()
go
  | Bool
otherwise        = InputStream ByteString -> OutputStream Builder -> IO ()
inputStreamBody InputStream ByteString
i OutputStream Builder
o
  where
    go :: IO ()
go = do
      mchunk <- InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream ByteString
i
      case mchunk of
        Maybe ByteString
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- don't pass on EOF signal
        Just ByteString
chunk
          | Int
chunkLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxChunkSize -> do
             Maybe Builder -> OutputStream Builder -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$! ByteString -> Builder
Builder.fromByteString ByteString
chunk) OutputStream Builder
o
             IO ()
go
          | Bool
otherwise -> do
             let (ByteString
chunk1,ByteString
rest) | Int
chunkLen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2Int -> Int -> Int
forall a. Num a => a -> a -> a
*Int
maxChunkSize = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (Int
chunkLen Int -> Int -> Int
forall a. Integral a => a -> a -> a
`quot` Int
2) ByteString
chunk
                               | Bool
otherwise                 = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
maxChunkSize ByteString
chunk
             ByteString -> InputStream ByteString -> IO ()
forall a. a -> InputStream a -> IO ()
Streams.unRead ByteString
rest InputStream ByteString
i
             Maybe Builder -> OutputStream Builder -> IO ()
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (Builder -> Maybe Builder
forall a. a -> Maybe a
Just (Builder -> Maybe Builder) -> Builder -> Maybe Builder
forall a b. (a -> b) -> a -> b
$! ByteString -> Builder
Builder.fromByteString ByteString
chunk1) OutputStream Builder
o
             IO ()
go
          where
            chunkLen :: Int
chunkLen = ByteString -> Int
S.length ByteString
chunk

--
-- | Print the response headers and response body to @stdout@. You can
-- use this with 'receiveResponse' or one of the convenience functions
-- when testing. For example, doing:
--
-- >     c <- openConnection "kernel.operationaldynamics.com" 58080
-- >
-- >     let q = buildRequest1 $ do
-- >                 http GET "/time"
-- >
-- >     sendRequest c q emptyBody
-- >
-- >     receiveResponse c debugHandler
--
-- would print out:
--
-- > HTTP/1.1 200 OK
-- > Transfer-Encoding: chunked
-- > Content-Type: text/plain
-- > Vary: Accept-Encoding
-- > Server: Snap/0.9.2.4
-- > Content-Encoding: gzip
-- > Date: Mon, 21 Jan 2013 06:13:37 GMT
-- >
-- > Mon 21 Jan 13, 06:13:37.303Z
--
-- or thereabouts.
--
debugHandler :: Response -> InputStream ByteString -> IO ()
debugHandler :: Response -> InputStream ByteString -> IO ()
debugHandler Response
p InputStream ByteString
i = do
    ByteString -> IO ()
S.putStr (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
S.filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\r') (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Response -> Builder
composeResponseBytes Response
p
    InputStream ByteString -> OutputStream ByteString -> IO ()
forall a. InputStream a -> OutputStream a -> IO ()
Streams.connect InputStream ByteString
i OutputStream ByteString
stdout


--
-- | Sometimes you just want the entire response body as a single blob.
-- This function concatonates all the bytes from the response into a
-- ByteString. If using the main @http-io-streams@ API, you would use it
-- as follows:
--
-- >    ...
-- >    x' <- receiveResponse c concatHandler
-- >    ...
--
-- The methods in the convenience API all take a function to handle the
-- response; this function is passed directly to the 'receiveResponse'
-- call underlying the request. Thus this utility function can be used
-- for 'get' as well:
--
-- >    x' <- get "http://www.example.com/document.txt" concatHandler
--
-- Either way, the usual caveats about allocating a
-- single object from streaming I/O apply: do not use this if you are
-- not absolutely certain that the response body will fit in a
-- reasonable amount of memory.
--
-- Note that this function makes no discrimination based on the
-- response's HTTP status code. You're almost certainly better off
-- writing your own handler function.
--
{-
    I'd welcome a better name for this function.
-}
concatHandler :: Response -> InputStream ByteString -> IO ByteString
concatHandler :: Response -> InputStream ByteString -> IO ByteString
concatHandler Response
_ InputStream ByteString
i1 = do
    i2 <- (ByteString -> Builder)
-> InputStream ByteString -> IO (InputStream Builder)
forall a b. (a -> b) -> InputStream a -> IO (InputStream b)
Streams.map ByteString -> Builder
Builder.fromByteString InputStream ByteString
i1
    x <- Streams.fold Mon.mappend Mon.mempty i2
    return $ Builder.toByteString x


-- | Shutdown the connection. You need to call this release the
-- underlying socket file descriptor and related network resources. To
-- do so reliably, use this in conjunction with 'openConnection' in a
-- call to 'Control.Exception.bracket':
--
-- > --
-- > -- Make connection, cleaning up afterward
-- > --
-- >
-- > foo :: IO ByteString
-- > foo = bracket
-- >    (openConnection "localhost" 80)
-- >    (closeConnection)
-- >    (doStuff)
-- >
-- > --
-- > -- Actually use Connection to send Request and receive Response
-- > --
-- >
-- > doStuff :: Connection -> IO ByteString
--
-- or, just use 'withConnection'.
--
-- While returning a ByteString is probably the most common use case,
-- you could conceivably do more processing of the response in 'doStuff'
-- and have it and 'foo' return a different type.
--
closeConnection :: Connection -> IO ()
closeConnection :: Connection -> IO ()
closeConnection Connection
c = Connection -> IO ()
cClose Connection
c