{-# LANGUAGE RankNTypes, CPP #-}
-- | Backend for Common Gateway Interface. Almost all users should use the
-- 'run' function.
module Network.Wai.Handler.CGI
    ( run
    , runSendfile
    , runGeneric
    , requestBodyFunc
    ) where

import Network.Wai
import Network.Wai.Internal
import Network.Socket (getAddrInfo, addrAddress)
import Data.IORef
import Data.Maybe (fromMaybe)
import qualified Data.ByteString.Char8 as B
import qualified Data.ByteString.Lazy as L
import Control.Arrow ((***))
import Data.Char (toLower)
import qualified System.IO
import qualified Data.String as String
import Data.ByteString.Builder (byteString, toLazyByteString, char7, string8)
import Data.ByteString.Builder.Extra (flush)
import Data.ByteString.Lazy.Internal (defaultChunkSize)
import System.IO (Handle)
import Network.HTTP.Types (Status (..), hRange, hContentType, hContentLength)
import qualified Network.HTTP.Types as H
import qualified Data.CaseInsensitive as CI
#if __GLASGOW_HASKELL__ < 710
import Data.Monoid (mconcat, mempty, mappend)
#endif

import qualified Data.Streaming.ByteString.Builder as Builder
import Data.Function (fix)
import Control.Monad (unless, void)

#if WINDOWS
import System.Environment (getEnvironment)
#else
import qualified System.Posix.Env.ByteString as Env

getEnvironment :: IO [(String, String)]
getEnvironment :: IO [(String, String)]
getEnvironment = ((ByteString, ByteString) -> (String, String))
-> [(ByteString, ByteString)] -> [(String, String)]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> String
B.unpack (ByteString -> String)
-> (ByteString -> String)
-> (ByteString, ByteString)
-> (String, String)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** ByteString -> String
B.unpack) ([(ByteString, ByteString)] -> [(String, String)])
-> IO [(ByteString, ByteString)] -> IO [(String, String)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` IO [(ByteString, ByteString)]
Env.getEnvironment
#endif

safeRead :: Read a => a -> String -> a
safeRead :: a -> String -> a
safeRead a
d String
s =
  case ReadS a
forall a. Read a => ReadS a
reads String
s of
    ((a
x, String
_):[(a, String)]
_) -> a
x
    [] -> a
d

lookup' :: String -> [(String, String)] -> String
lookup' :: String -> [(String, String)] -> String
lookup' String
key [(String, String)]
pairs = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String) -> Maybe String -> String
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
key [(String, String)]
pairs

-- | Run an application using CGI.
run :: Application -> IO ()
run :: Application -> IO ()
run Application
app = do
    [(String, String)]
vars <- IO [(String, String)]
getEnvironment
    let input :: Int -> IO (IO ByteString)
input = Handle -> Int -> IO (IO ByteString)
requestBodyHandle Handle
System.IO.stdin
        output :: ByteString -> IO ()
output = Handle -> ByteString -> IO ()
B.hPut Handle
System.IO.stdout
    [(String, String)]
-> (Int -> IO (IO ByteString))
-> (ByteString -> IO ())
-> Maybe ByteString
-> Application
-> IO ()
runGeneric [(String, String)]
vars Int -> IO (IO ByteString)
input ByteString -> IO ()
output Maybe ByteString
forall a. Maybe a
Nothing Application
app

-- | Some web servers provide an optimization for sending files via a sendfile
-- system call via a special header. To use this feature, provide that header
-- name here.
runSendfile :: B.ByteString -- ^ sendfile header
            -> Application -> IO ()
runSendfile :: ByteString -> Application -> IO ()
runSendfile ByteString
sf Application
app = do
    [(String, String)]
vars <- IO [(String, String)]
getEnvironment
    let input :: Int -> IO (IO ByteString)
input = Handle -> Int -> IO (IO ByteString)
requestBodyHandle Handle
System.IO.stdin
        output :: ByteString -> IO ()
output = Handle -> ByteString -> IO ()
B.hPut Handle
System.IO.stdout
    [(String, String)]
-> (Int -> IO (IO ByteString))
-> (ByteString -> IO ())
-> Maybe ByteString
-> Application
-> IO ()
runGeneric [(String, String)]
vars Int -> IO (IO ByteString)
input ByteString -> IO ()
output (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
sf) Application
app

-- | A generic CGI helper, which allows other backends (FastCGI and SCGI) to
-- use the same code as CGI. Most users will not need this function, and can
-- stick with 'run' or 'runSendfile'.
runGeneric
     :: [(String, String)] -- ^ all variables
     -> (Int -> IO (IO B.ByteString)) -- ^ responseBody of input
     -> (B.ByteString -> IO ()) -- ^ destination for output
     -> Maybe B.ByteString -- ^ does the server support the X-Sendfile header?
     -> Application
     -> IO ()
runGeneric :: [(String, String)]
-> (Int -> IO (IO ByteString))
-> (ByteString -> IO ())
-> Maybe ByteString
-> Application
-> IO ()
runGeneric [(String, String)]
vars Int -> IO (IO ByteString)
inputH ByteString -> IO ()
outputH Maybe ByteString
xsendfile Application
app = do
    let rmethod :: ByteString
rmethod = String -> ByteString
B.pack (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> String
lookup' String
"REQUEST_METHOD" [(String, String)]
vars
        pinfo :: String
pinfo = String -> [(String, String)] -> String
lookup' String
"PATH_INFO" [(String, String)]
vars
        qstring :: String
qstring = String -> [(String, String)] -> String
lookup' String
"QUERY_STRING" [(String, String)]
vars
        contentLength :: Int
contentLength = Int -> String -> Int
forall a. Read a => a -> String -> a
safeRead Int
0 (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> String
lookup' String
"CONTENT_LENGTH" [(String, String)]
vars
        remoteHost' :: String
remoteHost' =
            case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"REMOTE_ADDR" [(String, String)]
vars of
                Just String
x -> String
x
                Maybe String
Nothing ->
                    case String -> [(String, String)] -> Maybe String
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
"REMOTE_HOST" [(String, String)]
vars of
                        Just String
x -> String
x
                        Maybe String
Nothing -> String
""
        isSecure' :: Bool
isSecure' =
            case (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> [(String, String)] -> String
lookup' String
"SERVER_PROTOCOL" [(String, String)]
vars of
                String
"https" -> Bool
True
                String
_ -> Bool
False
    [AddrInfo]
addrs <- 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
remoteHost') Maybe String
forall a. Maybe a
Nothing
    IO ByteString
requestBody' <- Int -> IO (IO ByteString)
inputH Int
contentLength
    let addr :: SockAddr
addr =
            case [AddrInfo]
addrs of
                AddrInfo
a:[AddrInfo]
_ -> AddrInfo -> SockAddr
addrAddress AddrInfo
a
                [] -> String -> SockAddr
forall a. HasCallStack => String -> a
error (String -> SockAddr) -> String -> SockAddr
forall a b. (a -> b) -> a -> b
$ String
"Invalid REMOTE_ADDR or REMOTE_HOST: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
remoteHost'
        reqHeaders :: [(CI ByteString, ByteString)]
reqHeaders = ((String, String) -> (CI ByteString, ByteString))
-> [(String, String)] -> [(CI ByteString, ByteString)]
forall a b. (a -> b) -> [a] -> [b]
map (String -> CI ByteString
cleanupVarName (String -> CI ByteString)
-> (String -> ByteString)
-> (String, String)
-> (CI ByteString, ByteString)
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** String -> ByteString
B.pack) [(String, String)]
vars
        env :: Request
env = Request :: ByteString
-> HttpVersion
-> ByteString
-> ByteString
-> [(CI ByteString, ByteString)]
-> Bool
-> SockAddr
-> [Text]
-> Query
-> IO ByteString
-> Vault
-> RequestBodyLength
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Maybe ByteString
-> Request
Request
            { requestMethod :: ByteString
requestMethod = ByteString
rmethod
            , rawPathInfo :: ByteString
rawPathInfo = String -> ByteString
B.pack String
pinfo
            , pathInfo :: [Text]
pathInfo = ByteString -> [Text]
H.decodePathSegments (ByteString -> [Text]) -> ByteString -> [Text]
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack String
pinfo
            , rawQueryString :: ByteString
rawQueryString = String -> ByteString
B.pack String
qstring
            , queryString :: Query
queryString = ByteString -> Query
H.parseQuery (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ String -> ByteString
B.pack String
qstring
            , requestHeaders :: [(CI ByteString, ByteString)]
requestHeaders = [(CI ByteString, ByteString)]
reqHeaders
            , isSecure :: Bool
isSecure = Bool
isSecure'
            , remoteHost :: SockAddr
remoteHost = SockAddr
addr
            , httpVersion :: HttpVersion
httpVersion = HttpVersion
H.http11 -- FIXME
            , requestBody :: IO ByteString
requestBody = IO ByteString
requestBody'
            , vault :: Vault
vault = Vault
forall a. Monoid a => a
mempty
            , requestBodyLength :: RequestBodyLength
requestBodyLength = Word64 -> RequestBodyLength
KnownLength (Word64 -> RequestBodyLength) -> Word64 -> RequestBodyLength
forall a b. (a -> b) -> a -> b
$ Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
contentLength
            , requestHeaderHost :: Maybe ByteString
requestHeaderHost = CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"host" [(CI ByteString, ByteString)]
reqHeaders
            , requestHeaderRange :: Maybe ByteString
requestHeaderRange = CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
hRange [(CI ByteString, ByteString)]
reqHeaders
#if MIN_VERSION_wai(3,2,0)
            , requestHeaderReferer :: Maybe ByteString
requestHeaderReferer = CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"referer" [(CI ByteString, ByteString)]
reqHeaders
            , requestHeaderUserAgent :: Maybe ByteString
requestHeaderUserAgent = CI ByteString -> [(CI ByteString, ByteString)] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
"user-agent" [(CI ByteString, ByteString)]
reqHeaders
#endif
            }
    IO ResponseReceived -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ResponseReceived -> IO ()) -> IO ResponseReceived -> IO ()
forall a b. (a -> b) -> a -> b
$ Application
app Request
env ((Response -> IO ResponseReceived) -> IO ResponseReceived)
-> (Response -> IO ResponseReceived) -> IO ResponseReceived
forall a b. (a -> b) -> a -> b
$ \Response
res ->
        case (Maybe ByteString
xsendfile, Response
res) of
            (Just ByteString
sf, ResponseFile Status
s [(CI ByteString, ByteString)]
hs String
fp Maybe FilePart
Nothing) -> do
                (ByteString -> IO ()) -> [ByteString] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ByteString -> IO ()
outputH ([ByteString] -> IO ()) -> [ByteString] -> IO ()
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString]
L.toChunks (ByteString -> [ByteString]) -> ByteString -> [ByteString]
forall a b. (a -> b) -> a -> b
$ Builder -> ByteString
toLazyByteString (Builder -> ByteString) -> Builder -> ByteString
forall a b. (a -> b) -> a -> b
$ Status
-> [(CI ByteString, ByteString)] -> ByteString -> String -> Builder
sfBuilder Status
s [(CI ByteString, ByteString)]
hs ByteString
sf String
fp
                ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseReceived
ResponseReceived
            (Maybe ByteString, Response)
_ -> do
                let (Status
s, [(CI ByteString, ByteString)]
hs, (StreamingBody -> IO a) -> IO a
wb) = Response
-> (Status, [(CI ByteString, ByteString)],
    (StreamingBody -> IO a) -> IO a)
forall a.
Response
-> (Status, [(CI ByteString, ByteString)],
    (StreamingBody -> IO a) -> IO a)
responseToStream Response
res
                (BuilderRecv
blazeRecv, BuilderFinish
blazeFinish) <- BufferAllocStrategy -> IO (BuilderRecv, BuilderFinish)
Builder.newBuilderRecv BufferAllocStrategy
Builder.defaultStrategy
                (StreamingBody -> IO ()) -> IO ()
forall a. (StreamingBody -> IO a) -> IO a
wb ((StreamingBody -> IO ()) -> IO ())
-> (StreamingBody -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \StreamingBody
b -> do
                    let sendBuilder :: Builder -> IO ()
sendBuilder Builder
builder = do
                            IO ByteString
popper <- BuilderRecv
blazeRecv Builder
builder
                            (IO () -> IO ()) -> IO ()
forall a. (a -> a) -> a
fix ((IO () -> IO ()) -> IO ()) -> (IO () -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \IO ()
loop -> do
                                ByteString
bs <- IO ByteString
popper
                                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Bool
B.null ByteString
bs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                                    ByteString -> IO ()
outputH ByteString
bs
                                    IO ()
loop
                    Builder -> IO ()
sendBuilder (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ Status -> [(CI ByteString, ByteString)] -> Builder
headers Status
s [(CI ByteString, ByteString)]
hs Builder -> Builder -> Builder
forall a. Monoid a => a -> a -> a
`mappend` Char -> Builder
char7 Char
'\n'
                    StreamingBody
b Builder -> IO ()
sendBuilder (Builder -> IO ()
sendBuilder Builder
flush)
                BuilderFinish
blazeFinish BuilderFinish -> (Maybe ByteString -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= IO () -> (ByteString -> IO ()) -> Maybe ByteString -> IO ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()) ByteString -> IO ()
outputH
                ResponseReceived -> IO ResponseReceived
forall (m :: * -> *) a. Monad m => a -> m a
return ResponseReceived
ResponseReceived
  where
    headers :: Status -> [(CI ByteString, ByteString)] -> Builder
headers Status
s [(CI ByteString, ByteString)]
hs = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat (((Builder, Builder) -> Builder)
-> [(Builder, Builder)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Builder, Builder) -> Builder
header ([(Builder, Builder)] -> [Builder])
-> [(Builder, Builder)] -> [Builder]
forall a b. (a -> b) -> a -> b
$ Status -> (Builder, Builder)
status Status
s (Builder, Builder) -> [(Builder, Builder)] -> [(Builder, Builder)]
forall a. a -> [a] -> [a]
: ((CI ByteString, ByteString) -> (Builder, Builder))
-> [(CI ByteString, ByteString)] -> [(Builder, Builder)]
forall a b. (a -> b) -> [a] -> [b]
map (CI ByteString, ByteString) -> (Builder, Builder)
header' ([(CI ByteString, ByteString)] -> [(CI ByteString, ByteString)]
forall b.
IsString b =>
[(CI ByteString, b)] -> [(CI ByteString, b)]
fixHeaders [(CI ByteString, ByteString)]
hs))
    status :: Status -> (Builder, Builder)
status (Status Int
i ByteString
m) = (ByteString -> Builder
byteString ByteString
"Status", [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ String -> Builder
string8 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> String
forall a. Show a => a -> String
show Int
i
        , Char -> Builder
char7 Char
' '
        , ByteString -> Builder
byteString ByteString
m
        ])
    header' :: (CI ByteString, ByteString) -> (Builder, Builder)
header' (CI ByteString
x, ByteString
y) = (ByteString -> Builder
byteString (ByteString -> Builder) -> ByteString -> Builder
forall a b. (a -> b) -> a -> b
$ CI ByteString -> ByteString
forall s. CI s -> s
CI.original CI ByteString
x, ByteString -> Builder
byteString ByteString
y)
    header :: (Builder, Builder) -> Builder
header (Builder
x, Builder
y) = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Builder
x
        , ByteString -> Builder
byteString ByteString
": "
        , Builder
y
        , Char -> Builder
char7 Char
'\n'
        ]
    sfBuilder :: Status
-> [(CI ByteString, ByteString)] -> ByteString -> String -> Builder
sfBuilder Status
s [(CI ByteString, ByteString)]
hs ByteString
sf String
fp = [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
        [ Status -> [(CI ByteString, ByteString)] -> Builder
headers Status
s [(CI ByteString, ByteString)]
hs
        , (Builder, Builder) -> Builder
header ((Builder, Builder) -> Builder) -> (Builder, Builder) -> Builder
forall a b. (a -> b) -> a -> b
$ (ByteString -> Builder
byteString ByteString
sf, String -> Builder
string8 String
fp)
        , Char -> Builder
char7 Char
'\n'
        , ByteString -> Builder
byteString ByteString
sf
        , ByteString -> Builder
byteString ByteString
" not supported"
        ]
    fixHeaders :: [(CI ByteString, b)] -> [(CI ByteString, b)]
fixHeaders [(CI ByteString, b)]
h =
        case CI ByteString -> [(CI ByteString, b)] -> Maybe b
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup CI ByteString
hContentType [(CI ByteString, b)]
h of
            Maybe b
Nothing -> (CI ByteString
hContentType, b
"text/html; charset=utf-8") (CI ByteString, b) -> [(CI ByteString, b)] -> [(CI ByteString, b)]
forall a. a -> [a] -> [a]
: [(CI ByteString, b)]
h
            Just b
_ -> [(CI ByteString, b)]
h

cleanupVarName :: String -> CI.CI B.ByteString
cleanupVarName :: String -> CI ByteString
cleanupVarName String
"CONTENT_TYPE" = CI ByteString
hContentType
cleanupVarName String
"CONTENT_LENGTH" = CI ByteString
hContentLength
cleanupVarName String
"SCRIPT_NAME" = CI ByteString
"CGI-Script-Name"
cleanupVarName String
s =
    case String
s of
        Char
'H':Char
'T':Char
'T':Char
'P':Char
'_':Char
a:String
as -> String -> CI ByteString
forall a. IsString a => String -> a
String.fromString (String -> CI ByteString) -> String -> CI ByteString
forall a b. (a -> b) -> a -> b
$ Char
a Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
helper' String
as
        String
_ -> String -> CI ByteString
forall a. IsString a => String -> a
String.fromString String
s -- FIXME remove?
  where
    helper' :: String -> String
helper' (Char
'_':Char
x:String
rest) = Char
'-' Char -> String -> String
forall a. a -> [a] -> [a]
: Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
helper' String
rest
    helper' (Char
x:String
rest) = Char -> Char
toLower Char
x Char -> String -> String
forall a. a -> [a] -> [a]
: String -> String
helper' String
rest
    helper' [] = []

requestBodyHandle :: Handle -> Int -> IO (IO B.ByteString)
requestBodyHandle :: Handle -> Int -> IO (IO ByteString)
requestBodyHandle Handle
h = (Int -> BuilderFinish) -> Int -> IO (IO ByteString)
requestBodyFunc ((Int -> BuilderFinish) -> Int -> IO (IO ByteString))
-> (Int -> BuilderFinish) -> Int -> IO (IO ByteString)
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
    ByteString
bs <- Handle -> Int -> IO ByteString
B.hGet Handle
h Int
i
    Maybe ByteString -> BuilderFinish
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> BuilderFinish)
-> Maybe ByteString -> BuilderFinish
forall a b. (a -> b) -> a -> b
$ if ByteString -> Bool
B.null ByteString
bs then Maybe ByteString
forall a. Maybe a
Nothing else ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
bs

requestBodyFunc :: (Int -> IO (Maybe B.ByteString)) -> Int -> IO (IO B.ByteString)
requestBodyFunc :: (Int -> BuilderFinish) -> Int -> IO (IO ByteString)
requestBodyFunc Int -> BuilderFinish
get Int
count0 = do
    IORef Int
ref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef Int
count0
    IO ByteString -> IO (IO ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (IO ByteString -> IO (IO ByteString))
-> IO ByteString -> IO (IO ByteString)
forall a b. (a -> b) -> a -> b
$ do
        Int
count <- IORef Int -> IO Int
forall a. IORef a -> IO a
readIORef IORef Int
ref
        if Int
count Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
            then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
            else do
                Maybe ByteString
mbs <- Int -> BuilderFinish
get (Int -> BuilderFinish) -> Int -> BuilderFinish
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
count Int
defaultChunkSize
                IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
ref (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int -> (ByteString -> Int) -> Maybe ByteString -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
0 ByteString -> Int
B.length Maybe ByteString
mbs
                ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
B.empty Maybe ByteString
mbs