{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DoAndIfThenElse #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK hide, not-home #-}
module Network.Http.Connection (
Connection(..),
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
data Connection
= Connection {
Connection -> ByteString
cHost :: !ByteString,
Connection -> IO ()
cClose :: IO (),
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" #-}
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[String
"Host: ",
ByteString -> String
S.unpack forall a b. (a -> b) -> a -> b
$ Connection -> ByteString
cHost Connection
c,
String
"\n"]
makeConnection
:: ByteString
-> IO ()
-> OutputStream Builder
-> InputStream ByteString
-> Connection
makeConnection :: ByteString
-> IO ()
-> OutputStream Builder
-> InputStream ByteString
-> Connection
makeConnection = ByteString
-> IO ()
-> OutputStream Builder
-> InputStream ByteString
-> Connection
Connection
withConnection :: IO Connection -> (Connection -> IO γ) -> IO γ
withConnection :: forall γ. IO Connection -> (Connection -> IO γ) -> IO γ
withConnection IO Connection
mkC =
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO Connection
mkC Connection -> IO ()
closeConnection
openConnection :: Hostname -> Port -> IO Connection
openConnection :: ByteString -> Port -> IO Connection
openConnection ByteString
h1' Port
p = do
[AddrInfo]
is <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo (forall a. a -> Maybe a
Just AddrInfo
hints) (forall a. a -> Maybe a
Just String
h1) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Port
p)
let addr :: AddrInfo
addr = forall a. [a] -> a
head [AddrInfo]
is
let a :: SockAddr
a = AddrInfo -> SockAddr
addrAddress AddrInfo
addr
Socket
s <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket (AddrInfo -> Family
addrFamily AddrInfo
addr) SocketType
Stream ProtocolNumber
defaultProtocol
Socket -> SockAddr -> IO ()
connect Socket
s SockAddr
a
(InputStream ByteString
i,OutputStream ByteString
o1) <- Socket -> IO (InputStream ByteString, OutputStream ByteString)
Streams.socketToStreams Socket
s
OutputStream Builder
o2 <- OutputStream ByteString -> IO (OutputStream Builder)
Streams.builderStream OutputStream ByteString
o1
forall (m :: * -> *) a. Monad m => a -> m a
return Connection {
cHost :: ByteString
cHost = ByteString
h2',
cClose :: IO ()
cClose = Socket -> IO ()
close Socket
s,
cOut :: OutputStream Builder
cOut = OutputStream Builder
o2,
cIn :: InputStream ByteString
cIn = InputStream ByteString
i
}
where
hints :: AddrInfo
hints = AddrInfo
defaultHints {
addrFlags :: [AddrInfoFlag]
addrFlags = [AddrInfoFlag
AI_ADDRCONFIG, AddrInfoFlag
AI_NUMERICSERV],
addrSocketType :: SocketType
addrSocketType = SocketType
Stream
}
h2' :: ByteString
h2' = if Port
p forall a. Eq a => a -> a -> Bool
== Port
80
then ByteString
h1'
else [ByteString] -> ByteString
S.concat [ ByteString
h1', ByteString
":", String -> ByteString
S.pack forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Port
p ]
h1 :: String
h1 = ByteString -> String
S.unpack ByteString
h1'
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'
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 = forall a. IO a -> IO a
withOpenSSL forall a b. (a -> b) -> a -> b
$ do
[AddrInfo]
is <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [AddrInfo]
getAddrInfo forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just String
h1) (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Port
p)
let a :: SockAddr
a = AddrInfo -> SockAddr
addrAddress forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [AddrInfo]
is
f :: Family
f = AddrInfo -> Family
addrFamily forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [AddrInfo]
is
Socket
s <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
f SocketType
Stream ProtocolNumber
defaultProtocol
Socket -> SockAddr -> IO ()
connect Socket
s SockAddr
a
SSL
ssl <- SSLContext -> Socket -> IO SSL
SSL.connection SSLContext
ctx Socket
s
SSL -> IO ()
modssl SSL
ssl
SSL -> IO ()
SSL.connect SSL
ssl
(InputStream ByteString
i,OutputStream ByteString
o1) <- SSL -> IO (InputStream ByteString, OutputStream ByteString)
Streams.sslToStreams SSL
ssl
OutputStream Builder
o2 <- OutputStream ByteString -> IO (OutputStream Builder)
Streams.builderStream OutputStream ByteString
o1
forall (m :: * -> *) a. Monad m => a -> m a
return Connection {
cHost :: ByteString
cHost = ByteString
h2',
cClose :: IO ()
cClose = Socket -> SSL -> IO ()
closeSSL Socket
s SSL
ssl,
cOut :: OutputStream Builder
cOut = OutputStream Builder
o2,
cIn :: InputStream ByteString
cIn = InputStream ByteString
i
}
where
h2' :: ByteString
h2' :: ByteString
h2' = if Port
p forall a. Eq a => a -> a -> Bool
== Port
443
then ByteString
h1'
else [ByteString] -> ByteString
S.concat [ ByteString
h1', ByteString
":", String -> ByteString
S.pack forall a b. (a -> b) -> a -> b
$ 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
openConnectionUnix :: FilePath -> IO Connection
openConnectionUnix :: String -> IO Connection
openConnectionUnix String
path = do
let a :: SockAddr
a = String -> SockAddr
SockAddrUnix String
path
Socket
s <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_UNIX SocketType
Stream ProtocolNumber
defaultProtocol
Socket -> SockAddr -> IO ()
connect Socket
s SockAddr
a
(InputStream ByteString
i,OutputStream ByteString
o1) <- Socket -> IO (InputStream ByteString, OutputStream ByteString)
Streams.socketToStreams Socket
s
OutputStream Builder
o2 <- OutputStream ByteString -> IO (OutputStream Builder)
Streams.builderStream OutputStream ByteString
o1
forall (m :: * -> *) a. Monad m => a -> m a
return Connection {
cHost :: ByteString
cHost = String -> ByteString
S.pack String
path,
cClose :: IO ()
cClose = Socket -> IO ()
close Socket
s,
cOut :: OutputStream Builder
cOut = OutputStream Builder
o2,
cIn :: InputStream ByteString
cIn = InputStream ByteString
i
}
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
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just Builder
msg) OutputStream Builder
o2
EntityBody
e2 <- case ExpectMode
t of
ExpectMode
Normal -> do
forall (m :: * -> *) a. Monad m => a -> m a
return EntityBody
e
ExpectMode
Continue -> do
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just Builder
Builder.flush) OutputStream Builder
o2
Response
p <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
case Response -> Int
getStatusCode Response
p of
Int
100 -> do
forall (m :: * -> *) a. Monad m => a -> m a
return EntityBody
e
Int
_ -> do
forall a. a -> InputStream a -> IO ()
Streams.unRead (Response -> ByteString
rsp Response
p) InputStream ByteString
i
forall (m :: * -> *) a. Monad m => a -> m a
return EntityBody
Empty
α
x <- case EntityBody
e2 of
EntityBody
Empty -> do
OutputStream Builder
o3 <- forall a. IO (OutputStream a)
Streams.nullOutput
α
y <- OutputStream Builder -> IO α
handler OutputStream Builder
o3
forall (m :: * -> *) a. Monad m => a -> m a
return α
y
EntityBody
Chunking -> do
OutputStream Builder
o3 <- forall a b. (a -> b) -> OutputStream b -> IO (OutputStream a)
Streams.contramap Builder -> Builder
Builder.chunkedTransferEncoding OutputStream Builder
o2
α
y <- OutputStream Builder -> IO α
handler OutputStream Builder
o3
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just Builder
Builder.chunkedTransferTerminator) OutputStream Builder
o2
forall (m :: * -> *) a. Monad m => a -> m a
return α
y
(Static Int64
_) -> do
α
y <- OutputStream Builder -> IO α
handler OutputStream Builder
o2
forall (m :: * -> *) a. Monad m => a -> m a
return α
y
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just Builder
Builder.flush) OutputStream Builder
o2
forall (m :: * -> *) a. Monad m => a -> m a
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 forall a b. (a -> b) -> a -> b
$ Response -> Builder
composeResponseBytes Response
p
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)]
Connection
c Request
q =
(ByteString
"Host", Connection -> Request -> ByteString
getHostname Connection
c Request
q) 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
getHeadersFull :: Connection -> Request -> Headers
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)
receiveResponse :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
receiveResponse :: forall β.
Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
receiveResponse Connection
c Response -> InputStream ByteString -> IO β
handler = do
Response
p <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
InputStream ByteString
i' <- Response -> InputStream ByteString -> IO (InputStream ByteString)
readResponseBody Response
p InputStream ByteString
i
β
x <- Response -> InputStream ByteString -> IO β
handler Response
p InputStream ByteString
i'
forall a. InputStream a -> IO ()
Streams.skipToEof InputStream ByteString
i'
forall (m :: * -> *) a. Monad m => a -> m a
return β
x
where
i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c
receiveResponseRaw :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
receiveResponseRaw :: forall β.
Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
receiveResponseRaw Connection
c Response -> InputStream ByteString -> IO β
handler = do
Response
p <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
let p' :: Response
p' = Response
p {
pContentEncoding :: ContentEncoding
pContentEncoding = ContentEncoding
Identity
}
InputStream ByteString
i' <- Response -> InputStream ByteString -> IO (InputStream ByteString)
readResponseBody Response
p' InputStream ByteString
i
β
x <- Response -> InputStream ByteString -> IO β
handler Response
p InputStream ByteString
i'
forall a. InputStream a -> IO ()
Streams.skipToEof InputStream ByteString
i'
forall (m :: * -> *) a. Monad m => a -> m a
return β
x
where
i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c
unsafeReceiveResponse :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
unsafeReceiveResponse :: forall β.
Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
unsafeReceiveResponse Connection
c Response -> InputStream ByteString -> IO β
handler = do
Response
p <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
InputStream ByteString
i' <- Response -> InputStream ByteString -> IO (InputStream ByteString)
readResponseBody Response
p InputStream ByteString
i
Response -> InputStream ByteString -> IO β
handler Response
p InputStream ByteString
i'
where
i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c
unsafeReceiveResponseRaw :: Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
unsafeReceiveResponseRaw :: forall β.
Connection -> (Response -> InputStream ByteString -> IO β) -> IO β
unsafeReceiveResponseRaw Connection
c Response -> InputStream ByteString -> IO β
handler = do
Response
p <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
InputStream ByteString
i' <- Response -> InputStream ByteString -> IO (InputStream ByteString)
readResponseBody Response
p { pContentEncoding :: ContentEncoding
pContentEncoding = ContentEncoding
Identity } InputStream ByteString
i
Response -> InputStream ByteString -> IO β
handler Response
p InputStream ByteString
i'
where
i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c
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)
receiveUpgradeResponse :: Connection
-> (Response -> InputStream ByteString -> IO a)
-> (Response -> InputStream ByteString -> OutputStream Builder -> IO a)
-> 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
Response
p <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
case Response -> Int
pStatusCode Response
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
InputStream ByteString
i' <- Response -> InputStream ByteString -> IO (InputStream ByteString)
readResponseBody Response
p InputStream ByteString
i
a
x <- Response -> InputStream ByteString -> IO a
handler Response
p InputStream ByteString
i'
forall a. InputStream a -> IO ()
Streams.skipToEof InputStream ByteString
i'
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
where
i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c
receiveConnectResponse :: Connection
-> (Response -> InputStream ByteString -> IO a)
-> (Response -> InputStream ByteString -> OutputStream Builder -> IO a)
-> 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
Response
p <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
case Response -> Int
pStatusCode Response
p of
Int
code | Int
code forall a. Ord a => a -> a -> Bool
>= Int
200, Int
code 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
InputStream ByteString
i' <- Response -> InputStream ByteString -> IO (InputStream ByteString)
readResponseBody Response
p InputStream ByteString
i
a
x <- Response -> InputStream ByteString -> IO a
handler Response
p InputStream ByteString
i'
forall a. InputStream a -> IO ()
Streams.skipToEof InputStream ByteString
i'
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
where
i :: InputStream ByteString
i = Connection -> InputStream ByteString
cIn Connection
c
emptyBody :: OutputStream Builder -> IO ()
emptyBody :: OutputStream Builder -> IO ()
emptyBody OutputStream Builder
_ = forall (m :: * -> *) a. Monad m => a -> m a
return ()
bytestringBody :: ByteString -> OutputStream Builder -> IO ()
bytestringBody :: ByteString -> OutputStream Builder -> IO ()
bytestringBody ByteString
bs = forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! ByteString -> Builder
Builder.fromByteString ByteString
bs)
lazyBytestringBody :: BL.ByteString -> OutputStream Builder -> IO ()
lazyBytestringBody :: ByteString -> OutputStream Builder -> IO ()
lazyBytestringBody ByteString
bs = forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ ByteString -> Builder
Builder.fromLazyByteString ByteString
bs)
utf8TextBody :: Text -> OutputStream Builder -> IO ()
utf8TextBody :: Text -> OutputStream Builder -> IO ()
utf8TextBody Text
t = forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Text -> Builder
Builder.fromText Text
t)
utf8LazyTextBody :: TL.Text -> OutputStream Builder -> IO ()
utf8LazyTextBody :: Text -> OutputStream Builder -> IO ()
utf8LazyTextBody Text
t = forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Builder
Builder.fromLazyText Text
t)
fileBody :: FilePath -> OutputStream Builder -> IO ()
fileBody :: String -> OutputStream Builder -> IO ()
fileBody String
p OutputStream Builder
o = do
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)
inputStreamBody :: InputStream ByteString -> OutputStream Builder -> IO ()
inputStreamBody :: InputStream ByteString -> OutputStream Builder -> IO ()
inputStreamBody InputStream ByteString
i1 OutputStream Builder
o = do
InputStream Builder
i2 <- forall a b. (a -> b) -> InputStream a -> IO (InputStream b)
Streams.map ByteString -> Builder
Builder.fromByteString InputStream ByteString
i1
forall a. InputStream a -> OutputStream a -> IO ()
Streams.supply InputStream Builder
i2 OutputStream Builder
o
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 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
Maybe ByteString
mchunk <- forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream ByteString
i
case Maybe ByteString
mchunk of
Maybe ByteString
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just ByteString
chunk
| Int
chunkLen forall a. Ord a => a -> a -> Bool
<= Int
maxChunkSize -> do
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just 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 forall a. Ord a => a -> a -> Bool
< Int
2forall a. Num a => a -> a -> a
*Int
maxChunkSize = Int -> ByteString -> (ByteString, ByteString)
S.splitAt (Int
chunkLen forall a. Integral a => a -> a -> a
`quot` Int
2) ByteString
chunk
| Bool
otherwise = Int -> ByteString -> (ByteString, ByteString)
S.splitAt Int
maxChunkSize ByteString
chunk
forall a. a -> InputStream a -> IO ()
Streams.unRead ByteString
rest InputStream ByteString
i
forall a. Maybe a -> OutputStream a -> IO ()
Streams.write (forall a. a -> Maybe a
Just 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
debugHandler :: Response -> InputStream ByteString -> IO ()
debugHandler :: Response -> InputStream ByteString -> IO ()
debugHandler Response
p InputStream ByteString
i = do
ByteString -> IO ()
S.putStr forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ByteString -> ByteString
S.filter (forall a. Eq a => a -> a -> Bool
/= Char
'\r') forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toByteString forall a b. (a -> b) -> a -> b
$ Response -> Builder
composeResponseBytes Response
p
forall a. InputStream a -> OutputStream a -> IO ()
Streams.connect InputStream ByteString
i OutputStream ByteString
stdout
concatHandler :: Response -> InputStream ByteString -> IO ByteString
concatHandler :: Response -> InputStream ByteString -> IO ByteString
concatHandler Response
_ InputStream ByteString
i1 = do
InputStream Builder
i2 <- forall a b. (a -> b) -> InputStream a -> IO (InputStream b)
Streams.map ByteString -> Builder
Builder.fromByteString InputStream ByteString
i1
Builder
x <- forall s a. (s -> a -> s) -> s -> InputStream a -> IO s
Streams.fold forall a. Monoid a => a -> a -> a
Mon.mappend forall a. Monoid a => a
Mon.mempty InputStream Builder
i2
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
Builder.toByteString Builder
x
closeConnection :: Connection -> IO ()
closeConnection :: Connection -> IO ()
closeConnection Connection
c = Connection -> IO ()
cClose Connection
c