{-# 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" #-}
[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"]
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 =
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
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 (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
addr = [AddrInfo] -> AddrInfo
forall a. HasCallStack => [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
Connection -> IO Connection
forall a. a -> IO a
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 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'
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 = 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
[AddrInfo]
is <- Maybe AddrInfo -> Maybe String -> Maybe String -> IO [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 :: SockAddr
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 :: Family
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
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
Connection -> IO Connection
forall a. a -> IO a
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 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
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
Connection -> IO Connection
forall a. a -> IO a
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
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
EntityBody
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
Response
p <- InputStream ByteString -> IO Response
readResponseHeader InputStream ByteString
i
case Response -> Int
getStatusCode Response
p of
Int
100 -> do
EntityBody -> IO EntityBody
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return EntityBody
e
Int
_ -> do
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
α
x <- case EntityBody
e2 of
EntityBody
Empty -> do
OutputStream Builder
o3 <- IO (OutputStream Builder)
forall a. IO (OutputStream a)
Streams.nullOutput
α
y <- OutputStream Builder -> IO α
handler OutputStream Builder
o3
α -> IO α
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return α
y
EntityBody
Chunking -> do
OutputStream Builder
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 <- OutputStream Builder -> IO α
handler OutputStream Builder
o3
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.chunkedTransferTerminator) OutputStream Builder
o2
α -> IO α
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return α
y
(Static Int64
_) -> do
α
y <- OutputStream Builder -> IO α
handler OutputStream Builder
o2
α -> IO α
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return α
y
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
α -> IO α
forall a. a -> IO a
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 (Builder -> ByteString) -> Builder -> ByteString
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) (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
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'
InputStream ByteString -> IO ()
forall a. InputStream a -> IO ()
Streams.skipToEof InputStream ByteString
i'
β -> IO β
forall a. a -> IO a
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'
InputStream ByteString -> IO ()
forall a. InputStream a -> IO ()
Streams.skipToEof InputStream ByteString
i'
β -> IO β
forall a. a -> IO a
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'
InputStream ByteString -> IO ()
forall a. InputStream a -> IO ()
Streams.skipToEof InputStream ByteString
i'
a -> IO a
forall a. a -> IO a
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 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
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'
InputStream ByteString -> IO ()
forall a. InputStream a -> IO ()
Streams.skipToEof InputStream ByteString
i'
a -> IO a
forall a. a -> IO a
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
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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)
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)
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)
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)
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)
inputStreamBody :: InputStream ByteString -> OutputStream Builder -> IO ()
inputStreamBody :: InputStream ByteString -> OutputStream Builder -> IO ()
inputStreamBody InputStream ByteString
i1 OutputStream Builder
o = do
InputStream Builder
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
InputStream Builder -> OutputStream Builder -> IO ()
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 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
Maybe ByteString
mchunk <- InputStream ByteString -> IO (Maybe ByteString)
forall a. InputStream a -> IO (Maybe a)
Streams.read InputStream ByteString
i
case Maybe ByteString
mchunk of
Maybe ByteString
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
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
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
concatHandler :: Response -> InputStream ByteString -> IO ByteString
concatHandler :: Response -> InputStream ByteString -> IO ByteString
concatHandler Response
_ InputStream ByteString
i1 = do
InputStream Builder
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
Builder
x <- (Builder -> Builder -> Builder)
-> Builder -> InputStream Builder -> IO Builder
forall s a. (s -> a -> s) -> s -> InputStream a -> IO s
Streams.fold Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
Mon.mappend Builder
forall a. Monoid a => a
Mon.mempty InputStream Builder
i2
ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
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