{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Network.HTTP.Semantics.FillBuf (
    -- * Filling a buffer
    Next (..),
    DynaNext,
    BytesFilled,
    StreamingChunk (..),
    fillBuilderBodyGetNext,
    fillFileBodyGetNext,
    fillStreamBodyGetNext,
) where

import Control.Monad
import qualified Data.ByteString as BS
import Data.ByteString.Builder (Builder)
import qualified Data.ByteString.Builder.Extra as B
import Data.ByteString.Internal
import Data.Int (Int64)
import Foreign.Ptr (plusPtr)
import Network.ByteOrder
import Network.HTTP.Semantics.Client

----------------------------------------------------------------

-- type DynaNext = Buffer -> BufferSize -> WindowSize -> IO Next
type DynaNext = Buffer -> BufferSize -> Int -> IO Next

type BytesFilled = Int

data Next
    = Next
        BytesFilled -- payload length
        Bool -- require flushing
        (Maybe DynaNext)

----------------------------------------------------------------

data Leftover
    = LZero
    | LOne B.BufferWriter
    | LTwo ByteString B.BufferWriter

----------------------------------------------------------------

data StreamingChunk
    = StreamingFinished (IO ())
    | StreamingFlush
    | StreamingBuilder Builder

----------------------------------------------------------------

fillBuilderBodyGetNext :: Builder -> DynaNext
fillBuilderBodyGetNext :: Builder -> DynaNext
fillBuilderBodyGetNext Builder
bb Buffer
buf Int
siz Int
lim = do
    let room :: Int
room = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
siz Int
lim
    (Int
len, Next
signal) <- Builder -> BufferWriter
B.runBuilder Builder
bb Buffer
buf Int
room
    Next -> IO Next
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> IO Next) -> Next -> IO Next
forall a b. (a -> b) -> a -> b
$ Int -> Next -> Next
nextForBuilder Int
len Next
signal

fillFileBodyGetNext
    :: PositionRead -> FileOffset -> ByteCount -> IO () -> DynaNext
fillFileBodyGetNext :: PositionRead -> Int64 -> Int64 -> IO () -> DynaNext
fillFileBodyGetNext PositionRead
pread Int64
start Int64
bytecount IO ()
refresh Buffer
buf Int
siz Int
lim = do
    let room :: Int
room = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
siz Int
lim
    Int64
len <- PositionRead
pread Int64
start (Int -> Int64 -> Int64
mini Int
room Int64
bytecount) Buffer
buf
    let len' :: Int
len' = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len
    Next -> IO Next
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> IO Next) -> Next -> IO Next
forall a b. (a -> b) -> a -> b
$ Int -> PositionRead -> Int64 -> Int64 -> IO () -> Next
nextForFile Int
len' PositionRead
pread (Int64
start Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
len) (Int64
bytecount Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
len) IO ()
refresh

fillStreamBodyGetNext :: IO (Maybe StreamingChunk) -> DynaNext
fillStreamBodyGetNext :: IO (Maybe StreamingChunk) -> DynaNext
fillStreamBodyGetNext IO (Maybe StreamingChunk)
takeQ Buffer
buf Int
siz Int
lim = do
    let room :: Int
room = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
siz Int
lim
    (Bool
cont, Int
len, Bool
reqflush, Leftover
leftover) <- Buffer
-> Int
-> IO (Maybe StreamingChunk)
-> IO (Bool, Int, Bool, Leftover)
runStreamBuilder Buffer
buf Int
room IO (Maybe StreamingChunk)
takeQ
    Next -> IO Next
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> IO Next) -> Next -> IO Next
forall a b. (a -> b) -> a -> b
$ Bool
-> Int -> Bool -> Leftover -> IO (Maybe StreamingChunk) -> Next
nextForStream Bool
cont Int
len Bool
reqflush Leftover
leftover IO (Maybe StreamingChunk)
takeQ

----------------------------------------------------------------

fillBufBuilder :: Leftover -> DynaNext
fillBufBuilder :: Leftover -> DynaNext
fillBufBuilder Leftover
leftover Buffer
buf0 Int
siz0 Int
lim = do
    let room :: Int
room = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
siz0 Int
lim
    case Leftover
leftover of
        Leftover
LZero -> [Char] -> IO Next
forall a. HasCallStack => [Char] -> a
error [Char]
"fillBufBuilder: LZero"
        LOne BufferWriter
writer -> do
            (Int
len, Next
signal) <- BufferWriter
writer Buffer
buf0 Int
room
            Int -> Next -> IO Next
forall {m :: * -> *}. Monad m => Int -> Next -> m Next
getNext Int
len Next
signal
        LTwo ByteString
bs BufferWriter
writer
            | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
room -> do
                Buffer
buf1 <- Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs
                let len1 :: Int
len1 = ByteString -> Int
BS.length ByteString
bs
                (Int
len2, Next
signal) <- BufferWriter
writer Buffer
buf1 (Int
room Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len1)
                Int -> Next -> IO Next
forall {m :: * -> *}. Monad m => Int -> Next -> m Next
getNext (Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len2) Next
signal
            | Bool
otherwise -> do
                let (ByteString
bs1, ByteString
bs2) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
room ByteString
bs
                IO Buffer -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Buffer -> IO ()) -> IO Buffer -> IO ()
forall a b. (a -> b) -> a -> b
$ Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs1
                Int -> Next -> IO Next
forall {m :: * -> *}. Monad m => Int -> Next -> m Next
getNext Int
room (ByteString -> BufferWriter -> Next
B.Chunk ByteString
bs2 BufferWriter
writer)
  where
    getNext :: Int -> Next -> m Next
getNext Int
l Next
s = Next -> m Next
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> m Next) -> Next -> m Next
forall a b. (a -> b) -> a -> b
$ Int -> Next -> Next
nextForBuilder Int
l Next
s

nextForBuilder :: BytesFilled -> B.Next -> Next
nextForBuilder :: Int -> Next -> Next
nextForBuilder Int
len Next
B.Done =
    Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
True Maybe DynaNext
forall a. Maybe a
Nothing -- let's flush
nextForBuilder Int
len (B.More Int
_ BufferWriter
writer) =
    Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
False (Maybe DynaNext -> Next) -> Maybe DynaNext -> Next
forall a b. (a -> b) -> a -> b
$ DynaNext -> Maybe DynaNext
forall a. a -> Maybe a
Just (Leftover -> DynaNext
fillBufBuilder (BufferWriter -> Leftover
LOne BufferWriter
writer))
nextForBuilder Int
len (B.Chunk ByteString
bs BufferWriter
writer) =
    Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
False (Maybe DynaNext -> Next) -> Maybe DynaNext -> Next
forall a b. (a -> b) -> a -> b
$ DynaNext -> Maybe DynaNext
forall a. a -> Maybe a
Just (Leftover -> DynaNext
fillBufBuilder (ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs BufferWriter
writer))

----------------------------------------------------------------

runStreamBuilder
    :: Buffer
    -> BufferSize
    -> IO (Maybe StreamingChunk)
    -> IO
        ( Bool -- continue
        , BytesFilled
        , Bool -- require flusing
        , Leftover
        )
runStreamBuilder :: Buffer
-> Int
-> IO (Maybe StreamingChunk)
-> IO (Bool, Int, Bool, Leftover)
runStreamBuilder Buffer
buf0 Int
room0 IO (Maybe StreamingChunk)
takeQ = Buffer -> Int -> Int -> IO (Bool, Int, Bool, Leftover)
loop Buffer
buf0 Int
room0 Int
0
  where
    loop :: Buffer -> Int -> Int -> IO (Bool, Int, Bool, Leftover)
loop Buffer
buf Int
room Int
total = do
        Maybe StreamingChunk
mbuilder <- IO (Maybe StreamingChunk)
takeQ
        case Maybe StreamingChunk
mbuilder of
            Maybe StreamingChunk
Nothing -> (Bool, Int, Bool, Leftover) -> IO (Bool, Int, Bool, Leftover)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Int
total, Bool
False, Leftover
LZero)
            Just (StreamingBuilder Builder
builder) -> do
                (Int
len, Next
signal) <- Builder -> BufferWriter
B.runBuilder Builder
builder Buffer
buf Int
room
                let total' :: Int
total' = Int
total Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
                case Next
signal of
                    Next
B.Done -> Buffer -> Int -> Int -> IO (Bool, Int, Bool, Leftover)
loop (Buffer
buf Buffer -> Int -> Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len) (Int
room Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Int
total'
                    B.More Int
_ BufferWriter
writer -> (Bool, Int, Bool, Leftover) -> IO (Bool, Int, Bool, Leftover)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Int
total', Bool
False, BufferWriter -> Leftover
LOne BufferWriter
writer)
                    B.Chunk ByteString
bs BufferWriter
writer -> (Bool, Int, Bool, Leftover) -> IO (Bool, Int, Bool, Leftover)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Int
total', Bool
False, ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs BufferWriter
writer)
            Just StreamingChunk
StreamingFlush -> (Bool, Int, Bool, Leftover) -> IO (Bool, Int, Bool, Leftover)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
True, Int
total, Bool
True, Leftover
LZero)
            Just (StreamingFinished IO ()
dec) -> do
                IO ()
dec
                (Bool, Int, Bool, Leftover) -> IO (Bool, Int, Bool, Leftover)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
False, Int
total, Bool
True, Leftover
LZero)

fillBufStream :: Leftover -> IO (Maybe StreamingChunk) -> DynaNext
fillBufStream :: Leftover -> IO (Maybe StreamingChunk) -> DynaNext
fillBufStream Leftover
leftover0 IO (Maybe StreamingChunk)
takeQ Buffer
buf0 Int
siz0 Int
lim0 = do
    let room0 :: Int
room0 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
siz0 Int
lim0
    case Leftover
leftover0 of
        Leftover
LZero -> do
            (Bool
cont, Int
len, Bool
reqflush, Leftover
leftover) <- Buffer
-> Int
-> IO (Maybe StreamingChunk)
-> IO (Bool, Int, Bool, Leftover)
runStreamBuilder Buffer
buf0 Int
room0 IO (Maybe StreamingChunk)
takeQ
            Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
cont Int
len Bool
reqflush Leftover
leftover
        LOne BufferWriter
writer -> BufferWriter -> DynaNext
write BufferWriter
writer Buffer
buf0 Int
room0 Int
0
        LTwo ByteString
bs BufferWriter
writer
            | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
room0 -> do
                Buffer
buf1 <- Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs
                let len :: Int
len = ByteString -> Int
BS.length ByteString
bs
                BufferWriter -> DynaNext
write BufferWriter
writer Buffer
buf1 (Int
room0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) Int
len
            | Bool
otherwise -> do
                let (ByteString
bs1, ByteString
bs2) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
room0 ByteString
bs
                IO Buffer -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Buffer -> IO ()) -> IO Buffer -> IO ()
forall a b. (a -> b) -> a -> b
$ Buffer -> ByteString -> IO Buffer
copy Buffer
buf0 ByteString
bs1
                Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
True Int
room0 Bool
False (Leftover -> IO Next) -> Leftover -> IO Next
forall a b. (a -> b) -> a -> b
$ ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs2 BufferWriter
writer
  where
    getNext :: Bool -> BytesFilled -> Bool -> Leftover -> IO Next
    getNext :: Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
cont Int
len Bool
reqflush Leftover
l = Next -> IO Next
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> IO Next) -> Next -> IO Next
forall a b. (a -> b) -> a -> b
$ Bool
-> Int -> Bool -> Leftover -> IO (Maybe StreamingChunk) -> Next
nextForStream Bool
cont Int
len Bool
reqflush Leftover
l IO (Maybe StreamingChunk)
takeQ

    write
        :: (Buffer -> BufferSize -> IO (Int, B.Next))
        -> Buffer
        -> BufferSize
        -> Int
        -> IO Next
    write :: BufferWriter -> DynaNext
write BufferWriter
writer1 Buffer
buf Int
room Int
sofar = do
        (Int
len, Next
signal) <- BufferWriter
writer1 Buffer
buf Int
room
        case Next
signal of
            Next
B.Done -> do
                (Bool
cont, Int
extra, Bool
reqflush, Leftover
leftover) <-
                    Buffer
-> Int
-> IO (Maybe StreamingChunk)
-> IO (Bool, Int, Bool, Leftover)
runStreamBuilder (Buffer
buf Buffer -> Int -> Buffer
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
len) (Int
room Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
len) IO (Maybe StreamingChunk)
takeQ
                let total :: Int
total = Int
sofar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
extra
                Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
cont Int
total Bool
reqflush Leftover
leftover
            B.More Int
_ BufferWriter
writer -> do
                let total :: Int
total = Int
sofar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
                Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
True Int
total Bool
False (Leftover -> IO Next) -> Leftover -> IO Next
forall a b. (a -> b) -> a -> b
$ BufferWriter -> Leftover
LOne BufferWriter
writer
            B.Chunk ByteString
bs BufferWriter
writer -> do
                let total :: Int
total = Int
sofar Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
len
                Bool -> Int -> Bool -> Leftover -> IO Next
getNext Bool
True Int
total Bool
False (Leftover -> IO Next) -> Leftover -> IO Next
forall a b. (a -> b) -> a -> b
$ ByteString -> BufferWriter -> Leftover
LTwo ByteString
bs BufferWriter
writer

nextForStream
    :: Bool
    -> BytesFilled
    -> Bool
    -> Leftover
    -> IO (Maybe StreamingChunk)
    -> Next
nextForStream :: Bool
-> Int -> Bool -> Leftover -> IO (Maybe StreamingChunk) -> Next
nextForStream Bool
False Int
len Bool
reqflush Leftover
_ IO (Maybe StreamingChunk)
_ = Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
reqflush Maybe DynaNext
forall a. Maybe a
Nothing
nextForStream Bool
True Int
len Bool
reqflush Leftover
leftOrZero IO (Maybe StreamingChunk)
takeQ =
    Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
reqflush (Maybe DynaNext -> Next) -> Maybe DynaNext -> Next
forall a b. (a -> b) -> a -> b
$ DynaNext -> Maybe DynaNext
forall a. a -> Maybe a
Just (Leftover -> IO (Maybe StreamingChunk) -> DynaNext
fillBufStream Leftover
leftOrZero IO (Maybe StreamingChunk)
takeQ)

----------------------------------------------------------------

fillBufFile :: PositionRead -> FileOffset -> ByteCount -> IO () -> DynaNext
fillBufFile :: PositionRead -> Int64 -> Int64 -> IO () -> DynaNext
fillBufFile PositionRead
pread Int64
start Int64
bytes IO ()
refresh Buffer
buf Int
siz Int
lim = do
    let room :: Int
room = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
siz Int
lim
    Int64
len <- PositionRead
pread Int64
start (Int -> Int64 -> Int64
mini Int
room Int64
bytes) Buffer
buf
    IO ()
refresh
    let len' :: Int
len' = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
len
    Next -> IO Next
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Next -> IO Next) -> Next -> IO Next
forall a b. (a -> b) -> a -> b
$ Int -> PositionRead -> Int64 -> Int64 -> IO () -> Next
nextForFile Int
len' PositionRead
pread (Int64
start Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Int64
len) (Int64
bytes Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
- Int64
len) IO ()
refresh

nextForFile
    :: BytesFilled -> PositionRead -> FileOffset -> ByteCount -> IO () -> Next
nextForFile :: Int -> PositionRead -> Int64 -> Int64 -> IO () -> Next
nextForFile Int
0 PositionRead
_ Int64
_ Int64
_ IO ()
_ = Int -> Bool -> Maybe DynaNext -> Next
Next Int
0 Bool
True Maybe DynaNext
forall a. Maybe a
Nothing -- let's flush
nextForFile Int
len PositionRead
_ Int64
_ Int64
0 IO ()
_ = Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
False Maybe DynaNext
forall a. Maybe a
Nothing
nextForFile Int
len PositionRead
pread Int64
start Int64
bytes IO ()
refresh =
    Int -> Bool -> Maybe DynaNext -> Next
Next Int
len Bool
False (Maybe DynaNext -> Next) -> Maybe DynaNext -> Next
forall a b. (a -> b) -> a -> b
$ DynaNext -> Maybe DynaNext
forall a. a -> Maybe a
Just (DynaNext -> Maybe DynaNext) -> DynaNext -> Maybe DynaNext
forall a b. (a -> b) -> a -> b
$ PositionRead -> Int64 -> Int64 -> IO () -> DynaNext
fillBufFile PositionRead
pread Int64
start Int64
bytes IO ()
refresh

{-# INLINE mini #-}
mini :: Int -> Int64 -> Int64
mini :: Int -> Int64 -> Int64
mini Int
i Int64
n
    | Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
< Int64
n = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
i
    | Bool
otherwise = Int64
n