{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A t'GI.Soup.Objects.Message.Message' request or response body.
-- 
-- Note that while /@length@/ always reflects the full length of the
-- message body, /@data@/ is normally 'P.Nothing', and will only be filled in
-- after 'GI.Soup.Structs.MessageBody.messageBodyFlatten' is called. For client-side
-- messages, this automatically happens for the response body after it
-- has been fully read, unless you set the
-- 'GI.Soup.Flags.MessageFlagsOverwriteChunks' flags. Likewise, for server-side
-- messages, the request body is automatically filled in after being
-- read.
-- 
-- As an added bonus, when /@data@/ is filled in, it is always terminated
-- with a \'\\0\' byte (which is not reflected in /@length@/).

#if (MIN_VERSION_haskell_gi_overloading(1,0,0) && !defined(__HADDOCK_VERSION__))
#define ENABLE_OVERLOADING
#endif

module GI.Soup.Structs.MessageBody
    ( 

-- * Exported types
    MessageBody(..)                         ,
    newZeroMessageBody                      ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveMessageBodyMethod                ,
#endif


-- ** append #method:append#

#if defined(ENABLE_OVERLOADING)
    MessageBodyAppendMethodInfo             ,
#endif
    messageBodyAppend                       ,


-- ** appendBuffer #method:appendBuffer#

#if defined(ENABLE_OVERLOADING)
    MessageBodyAppendBufferMethodInfo       ,
#endif
    messageBodyAppendBuffer                 ,


-- ** complete #method:complete#

#if defined(ENABLE_OVERLOADING)
    MessageBodyCompleteMethodInfo           ,
#endif
    messageBodyComplete                     ,


-- ** flatten #method:flatten#

#if defined(ENABLE_OVERLOADING)
    MessageBodyFlattenMethodInfo            ,
#endif
    messageBodyFlatten                      ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    MessageBodyFreeMethodInfo               ,
#endif
    messageBodyFree                         ,


-- ** getAccumulate #method:getAccumulate#

#if defined(ENABLE_OVERLOADING)
    MessageBodyGetAccumulateMethodInfo      ,
#endif
    messageBodyGetAccumulate                ,


-- ** getChunk #method:getChunk#

#if defined(ENABLE_OVERLOADING)
    MessageBodyGetChunkMethodInfo           ,
#endif
    messageBodyGetChunk                     ,


-- ** gotChunk #method:gotChunk#

#if defined(ENABLE_OVERLOADING)
    MessageBodyGotChunkMethodInfo           ,
#endif
    messageBodyGotChunk                     ,


-- ** new #method:new#

    messageBodyNew                          ,


-- ** setAccumulate #method:setAccumulate#

#if defined(ENABLE_OVERLOADING)
    MessageBodySetAccumulateMethodInfo      ,
#endif
    messageBodySetAccumulate                ,


-- ** truncate #method:truncate#

#if defined(ENABLE_OVERLOADING)
    MessageBodyTruncateMethodInfo           ,
#endif
    messageBodyTruncate                     ,


-- ** wroteChunk #method:wroteChunk#

#if defined(ENABLE_OVERLOADING)
    MessageBodyWroteChunkMethodInfo         ,
#endif
    messageBodyWroteChunk                   ,




 -- * Properties
-- ** data #attr:data#
-- | the data

    clearMessageBodyData                    ,
    getMessageBodyData                      ,
#if defined(ENABLE_OVERLOADING)
    messageBody_data                        ,
#endif
    setMessageBodyData                      ,


-- ** length #attr:length#
-- | length of /@data@/

    getMessageBodyLength                    ,
#if defined(ENABLE_OVERLOADING)
    messageBody_length                      ,
#endif
    setMessageBodyLength                    ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL

import {-# SOURCE #-} qualified GI.Soup.Structs.Buffer as Soup.Buffer

-- | Memory-managed wrapper type.
newtype MessageBody = MessageBody (SP.ManagedPtr MessageBody)
    deriving (MessageBody -> MessageBody -> Bool
(MessageBody -> MessageBody -> Bool)
-> (MessageBody -> MessageBody -> Bool) -> Eq MessageBody
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MessageBody -> MessageBody -> Bool
$c/= :: MessageBody -> MessageBody -> Bool
== :: MessageBody -> MessageBody -> Bool
$c== :: MessageBody -> MessageBody -> Bool
Eq)

instance SP.ManagedPtrNewtype MessageBody where
    toManagedPtr :: MessageBody -> ManagedPtr MessageBody
toManagedPtr (MessageBody ManagedPtr MessageBody
p) = ManagedPtr MessageBody
p

foreign import ccall "soup_message_body_get_type" c_soup_message_body_get_type :: 
    IO GType

type instance O.ParentTypes MessageBody = '[]
instance O.HasParentTypes MessageBody

instance B.Types.TypedObject MessageBody where
    glibType :: IO GType
glibType = IO GType
c_soup_message_body_get_type

instance B.Types.GBoxed MessageBody

-- | Convert 'MessageBody' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue MessageBody where
    toGValue :: MessageBody -> IO GValue
toGValue MessageBody
o = do
        GType
gtype <- IO GType
c_soup_message_body_get_type
        MessageBody -> (Ptr MessageBody -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr MessageBody
o (GType
-> (GValue -> Ptr MessageBody -> IO ())
-> Ptr MessageBody
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr MessageBody -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO MessageBody
fromGValue GValue
gv = do
        Ptr MessageBody
ptr <- GValue -> IO (Ptr MessageBody)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr MessageBody)
        (ManagedPtr MessageBody -> MessageBody)
-> Ptr MessageBody -> IO MessageBody
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr MessageBody -> MessageBody
MessageBody Ptr MessageBody
ptr
        
    

-- | Construct a `MessageBody` struct initialized to zero.
newZeroMessageBody :: MonadIO m => m MessageBody
newZeroMessageBody :: m MessageBody
newZeroMessageBody = IO MessageBody -> m MessageBody
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MessageBody -> m MessageBody)
-> IO MessageBody -> m MessageBody
forall a b. (a -> b) -> a -> b
$ Int -> IO (Ptr MessageBody)
forall a. GBoxed a => Int -> IO (Ptr a)
callocBoxedBytes Int
16 IO (Ptr MessageBody)
-> (Ptr MessageBody -> IO MessageBody) -> IO MessageBody
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (ManagedPtr MessageBody -> MessageBody)
-> Ptr MessageBody -> IO MessageBody
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr MessageBody -> MessageBody
MessageBody

instance tag ~ 'AttrSet => Constructible MessageBody tag where
    new :: (ManagedPtr MessageBody -> MessageBody)
-> [AttrOp MessageBody tag] -> m MessageBody
new ManagedPtr MessageBody -> MessageBody
_ [AttrOp MessageBody tag]
attrs = do
        MessageBody
o <- m MessageBody
forall (m :: * -> *). MonadIO m => m MessageBody
newZeroMessageBody
        MessageBody -> [AttrOp MessageBody 'AttrSet] -> m ()
forall o (m :: * -> *).
MonadIO m =>
o -> [AttrOp o 'AttrSet] -> m ()
GI.Attributes.set MessageBody
o [AttrOp MessageBody tag]
[AttrOp MessageBody 'AttrSet]
attrs
        MessageBody -> m MessageBody
forall (m :: * -> *) a. Monad m => a -> m a
return MessageBody
o


-- | Get the value of the “@data@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' messageBody #data
-- @
getMessageBodyData :: MonadIO m => MessageBody -> m (Maybe T.Text)
getMessageBodyData :: MessageBody -> m (Maybe Text)
getMessageBodyData MessageBody
s = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ MessageBody
-> (Ptr MessageBody -> IO (Maybe Text)) -> IO (Maybe Text)
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MessageBody
s ((Ptr MessageBody -> IO (Maybe Text)) -> IO (Maybe Text))
-> (Ptr MessageBody -> IO (Maybe Text)) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \Ptr MessageBody
ptr -> do
    CString
val <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek (Ptr MessageBody
ptr Ptr MessageBody -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) :: IO CString
    Maybe Text
result <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
SP.convertIfNonNull CString
val ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \CString
val' -> do
        Text
val'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
val'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
val''
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
result

-- | Set the value of the “@data@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' messageBody [ #data 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageBodyData :: MonadIO m => MessageBody -> CString -> m ()
setMessageBodyData :: MessageBody -> CString -> m ()
setMessageBodyData MessageBody
s CString
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MessageBody -> (Ptr MessageBody -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MessageBody
s ((Ptr MessageBody -> IO ()) -> IO ())
-> (Ptr MessageBody -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageBody
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MessageBody
ptr Ptr MessageBody -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
val :: CString)

-- | Set the value of the “@data@” field to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #data
-- @
clearMessageBodyData :: MonadIO m => MessageBody -> m ()
clearMessageBodyData :: MessageBody -> m ()
clearMessageBodyData MessageBody
s = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MessageBody -> (Ptr MessageBody -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MessageBody
s ((Ptr MessageBody -> IO ()) -> IO ())
-> (Ptr MessageBody -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageBody
ptr -> do
    Ptr CString -> CString -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MessageBody
ptr Ptr MessageBody -> Int -> Ptr CString
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
0) (CString
forall a. Ptr a
FP.nullPtr :: CString)

#if defined(ENABLE_OVERLOADING)
data MessageBodyDataFieldInfo
instance AttrInfo MessageBodyDataFieldInfo where
    type AttrBaseTypeConstraint MessageBodyDataFieldInfo = (~) MessageBody
    type AttrAllowedOps MessageBodyDataFieldInfo = '[ 'AttrSet, 'AttrGet, 'AttrClear]
    type AttrSetTypeConstraint MessageBodyDataFieldInfo = (~) CString
    type AttrTransferTypeConstraint MessageBodyDataFieldInfo = (~)CString
    type AttrTransferType MessageBodyDataFieldInfo = CString
    type AttrGetType MessageBodyDataFieldInfo = Maybe T.Text
    type AttrLabel MessageBodyDataFieldInfo = "data"
    type AttrOrigin MessageBodyDataFieldInfo = MessageBody
    attrGet = getMessageBodyData
    attrSet = setMessageBodyData
    attrConstruct = undefined
    attrClear = clearMessageBodyData
    attrTransfer _ v = do
        return v

messageBody_data :: AttrLabelProxy "data"
messageBody_data = AttrLabelProxy

#endif


-- | Get the value of the “@length@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' messageBody #length
-- @
getMessageBodyLength :: MonadIO m => MessageBody -> m Int64
getMessageBodyLength :: MessageBody -> m Int64
getMessageBodyLength MessageBody
s = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ MessageBody -> (Ptr MessageBody -> IO Int64) -> IO Int64
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MessageBody
s ((Ptr MessageBody -> IO Int64) -> IO Int64)
-> (Ptr MessageBody -> IO Int64) -> IO Int64
forall a b. (a -> b) -> a -> b
$ \Ptr MessageBody
ptr -> do
    Int64
val <- Ptr Int64 -> IO Int64
forall a. Storable a => Ptr a -> IO a
peek (Ptr MessageBody
ptr Ptr MessageBody -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) :: IO Int64
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
val

-- | Set the value of the “@length@” field.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' messageBody [ #length 'Data.GI.Base.Attributes.:=' value ]
-- @
setMessageBodyLength :: MonadIO m => MessageBody -> Int64 -> m ()
setMessageBodyLength :: MessageBody -> Int64 -> m ()
setMessageBodyLength MessageBody
s Int64
val = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ MessageBody -> (Ptr MessageBody -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
withManagedPtr MessageBody
s ((Ptr MessageBody -> IO ()) -> IO ())
-> (Ptr MessageBody -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MessageBody
ptr -> do
    Ptr Int64 -> Int64 -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke (Ptr MessageBody
ptr Ptr MessageBody -> Int -> Ptr Int64
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
8) (Int64
val :: Int64)

#if defined(ENABLE_OVERLOADING)
data MessageBodyLengthFieldInfo
instance AttrInfo MessageBodyLengthFieldInfo where
    type AttrBaseTypeConstraint MessageBodyLengthFieldInfo = (~) MessageBody
    type AttrAllowedOps MessageBodyLengthFieldInfo = '[ 'AttrSet, 'AttrGet]
    type AttrSetTypeConstraint MessageBodyLengthFieldInfo = (~) Int64
    type AttrTransferTypeConstraint MessageBodyLengthFieldInfo = (~)Int64
    type AttrTransferType MessageBodyLengthFieldInfo = Int64
    type AttrGetType MessageBodyLengthFieldInfo = Int64
    type AttrLabel MessageBodyLengthFieldInfo = "length"
    type AttrOrigin MessageBodyLengthFieldInfo = MessageBody
    attrGet = getMessageBodyLength
    attrSet = setMessageBodyLength
    attrConstruct = undefined
    attrClear = undefined
    attrTransfer _ v = do
        return v

messageBody_length :: AttrLabelProxy "length"
messageBody_length = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MessageBody
type instance O.AttributeList MessageBody = MessageBodyAttributeList
type MessageBodyAttributeList = ('[ '("data", MessageBodyDataFieldInfo), '("length", MessageBodyLengthFieldInfo)] :: [(Symbol, *)])
#endif

-- method MessageBody::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Soup" , name = "MessageBody" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_new" soup_message_body_new :: 
    IO (Ptr MessageBody)

-- | Creates a new t'GI.Soup.Structs.MessageBody.MessageBody'. t'GI.Soup.Objects.Message.Message' uses this internally; you
-- will not normally need to call it yourself.
messageBodyNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m MessageBody
    -- ^ __Returns:__ a new t'GI.Soup.Structs.MessageBody.MessageBody'.
messageBodyNew :: m MessageBody
messageBodyNew  = IO MessageBody -> m MessageBody
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MessageBody -> m MessageBody)
-> IO MessageBody -> m MessageBody
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
result <- IO (Ptr MessageBody)
soup_message_body_new
    Text -> Ptr MessageBody -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"messageBodyNew" Ptr MessageBody
result
    MessageBody
result' <- ((ManagedPtr MessageBody -> MessageBody)
-> Ptr MessageBody -> IO MessageBody
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr MessageBody -> MessageBody
MessageBody) Ptr MessageBody
result
    MessageBody -> IO MessageBody
forall (m :: * -> *) a. Monad m => a -> m a
return MessageBody
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method MessageBody::append_buffer
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupBuffer" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_append_buffer" soup_message_body_append_buffer :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    Ptr Soup.Buffer.Buffer ->               -- buffer : TInterface (Name {namespace = "Soup", name = "Buffer"})
    IO ()

-- | Appends the data from /@buffer@/ to /@body@/. (t'GI.Soup.Structs.MessageBody.MessageBody' uses
-- @/SoupBuffers/@ internally, so this is normally a constant-time
-- operation that doesn\'t actually require copying the data in
-- /@buffer@/.)
messageBodyAppendBuffer ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> Soup.Buffer.Buffer
    -- ^ /@buffer@/: a t'GI.Soup.Structs.Buffer.Buffer'
    -> m ()
messageBodyAppendBuffer :: MessageBody -> Buffer -> m ()
messageBodyAppendBuffer MessageBody
body Buffer
buffer = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr Buffer
buffer' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
buffer
    Ptr MessageBody -> Ptr Buffer -> IO ()
soup_message_body_append_buffer Ptr MessageBody
body' Ptr Buffer
buffer'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
buffer
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyAppendBufferMethodInfo
instance (signature ~ (Soup.Buffer.Buffer -> m ()), MonadIO m) => O.MethodInfo MessageBodyAppendBufferMethodInfo MessageBody signature where
    overloadedMethod = messageBodyAppendBuffer

#endif

-- method MessageBody::append
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TCArray False (-1) 2 (TBasicType TUInt8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to append" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of @data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of @data" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_append_take" soup_message_body_append_take :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    Ptr Word8 ->                            -- data : TCArray False (-1) 2 (TBasicType TUInt8)
    Word64 ->                               -- length : TBasicType TUInt64
    IO ()

-- | Appends /@length@/ bytes from /@data@/ to /@body@/.
-- 
-- This function is exactly equivalent to @/soup_message_body_append()/@
-- with 'GI.Soup.Enums.MemoryUseTake' as second argument; it exists mainly for
-- convenience and simplifying language bindings.
-- 
-- /Since: 2.32/
messageBodyAppend ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> ByteString
    -- ^ /@data@/: data to append
    -> m ()
messageBodyAppend :: MessageBody -> ByteString -> m ()
messageBodyAppend MessageBody
body ByteString
data_ = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    let length_ :: Word64
length_ = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
B.length ByteString
data_
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr Word8
data_' <- ByteString -> IO (Ptr Word8)
packByteString ByteString
data_
    Ptr MessageBody -> Ptr Word8 -> Word64 -> IO ()
soup_message_body_append_take Ptr MessageBody
body' Ptr Word8
data_' Word64
length_
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyAppendMethodInfo
instance (signature ~ (ByteString -> m ()), MonadIO m) => O.MethodInfo MessageBodyAppendMethodInfo MessageBody signature where
    overloadedMethod = messageBodyAppend

#endif

-- method MessageBody::complete
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_complete" soup_message_body_complete :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    IO ()

-- | Tags /@body@/ as being complete; Call this when using chunked encoding
-- after you have appended the last chunk.
messageBodyComplete ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> m ()
messageBodyComplete :: MessageBody -> m ()
messageBodyComplete MessageBody
body = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr MessageBody -> IO ()
soup_message_body_complete Ptr MessageBody
body'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyCompleteMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo MessageBodyCompleteMethodInfo MessageBody signature where
    overloadedMethod = messageBodyComplete

#endif

-- method MessageBody::flatten
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_flatten" soup_message_body_flatten :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    IO (Ptr Soup.Buffer.Buffer)

-- | Fills in /@body@/\'s data field with a buffer containing all of the
-- data in /@body@/ (plus an additional \'\\0\' byte not counted by /@body@/\'s
-- length field).
messageBodyFlatten ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> m Soup.Buffer.Buffer
    -- ^ __Returns:__ a t'GI.Soup.Structs.Buffer.Buffer' containing the same data as /@body@/.
    -- (You must free this buffer if you do not want it.)
messageBodyFlatten :: MessageBody -> m Buffer
messageBodyFlatten MessageBody
body = IO Buffer -> m Buffer
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Buffer -> m Buffer) -> IO Buffer -> m Buffer
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr Buffer
result <- Ptr MessageBody -> IO (Ptr Buffer)
soup_message_body_flatten Ptr MessageBody
body'
    Text -> Ptr Buffer -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"messageBodyFlatten" Ptr Buffer
result
    Buffer
result' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Soup.Buffer.Buffer) Ptr Buffer
result
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result'

#if defined(ENABLE_OVERLOADING)
data MessageBodyFlattenMethodInfo
instance (signature ~ (m Soup.Buffer.Buffer), MonadIO m) => O.MethodInfo MessageBodyFlattenMethodInfo MessageBody signature where
    overloadedMethod = messageBodyFlatten

#endif

-- method MessageBody::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_free" soup_message_body_free :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    IO ()

-- | Frees /@body@/. You will not normally need to use this, as
-- t'GI.Soup.Objects.Message.Message' frees its associated message bodies automatically.
messageBodyFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> m ()
messageBodyFree :: MessageBody -> m ()
messageBodyFree MessageBody
body = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr MessageBody -> IO ()
soup_message_body_free Ptr MessageBody
body'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo MessageBodyFreeMethodInfo MessageBody signature where
    overloadedMethod = messageBodyFree

#endif

-- method MessageBody::get_accumulate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_get_accumulate" soup_message_body_get_accumulate :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    IO CInt

-- | Gets the accumulate flag on /@body@/; see
-- 'GI.Soup.Structs.MessageBody.messageBodySetAccumulate' for details.
-- 
-- /Since: 2.24/
messageBodyGetAccumulate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> m Bool
    -- ^ __Returns:__ the accumulate flag for /@body@/.
messageBodyGetAccumulate :: MessageBody -> m Bool
messageBodyGetAccumulate MessageBody
body = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    CInt
result <- Ptr MessageBody -> IO CInt
soup_message_body_get_accumulate Ptr MessageBody
body'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data MessageBodyGetAccumulateMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo MessageBodyGetAccumulateMethodInfo MessageBody signature where
    overloadedMethod = messageBodyGetAccumulate

#endif

-- method MessageBody::get_chunk
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "offset"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an offset" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Buffer" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_get_chunk" soup_message_body_get_chunk :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    Int64 ->                                -- offset : TBasicType TInt64
    IO (Ptr Soup.Buffer.Buffer)

-- | Gets a t'GI.Soup.Structs.Buffer.Buffer' containing data from /@body@/ starting at /@offset@/.
-- The size of the returned chunk is unspecified. You can iterate
-- through the entire body by first calling
-- 'GI.Soup.Structs.MessageBody.messageBodyGetChunk' with an offset of 0, and then on each
-- successive call, increment the offset by the length of the
-- previously-returned chunk.
-- 
-- If /@offset@/ is greater than or equal to the total length of /@body@/,
-- then the return value depends on whether or not
-- 'GI.Soup.Structs.MessageBody.messageBodyComplete' has been called or not; if it has,
-- then 'GI.Soup.Structs.MessageBody.messageBodyGetChunk' will return a 0-length chunk
-- (indicating the end of /@body@/). If it has not, then
-- 'GI.Soup.Structs.MessageBody.messageBodyGetChunk' will return 'P.Nothing' (indicating that
-- /@body@/ may still potentially have more data, but that data is not
-- currently available).
messageBodyGetChunk ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> Int64
    -- ^ /@offset@/: an offset
    -> m (Maybe Soup.Buffer.Buffer)
    -- ^ __Returns:__ a t'GI.Soup.Structs.Buffer.Buffer', or 'P.Nothing'.
messageBodyGetChunk :: MessageBody -> Int64 -> m (Maybe Buffer)
messageBodyGetChunk MessageBody
body Int64
offset = IO (Maybe Buffer) -> m (Maybe Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Buffer) -> m (Maybe Buffer))
-> IO (Maybe Buffer) -> m (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr Buffer
result <- Ptr MessageBody -> Int64 -> IO (Ptr Buffer)
soup_message_body_get_chunk Ptr MessageBody
body' Int64
offset
    Maybe Buffer
maybeResult <- Ptr Buffer -> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Buffer
result ((Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer))
-> (Ptr Buffer -> IO Buffer) -> IO (Maybe Buffer)
forall a b. (a -> b) -> a -> b
$ \Ptr Buffer
result' -> do
        Buffer
result'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Buffer -> Buffer
Soup.Buffer.Buffer) Ptr Buffer
result'
        Buffer -> IO Buffer
forall (m :: * -> *) a. Monad m => a -> m a
return Buffer
result''
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Maybe Buffer -> IO (Maybe Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Buffer
maybeResult

#if defined(ENABLE_OVERLOADING)
data MessageBodyGetChunkMethodInfo
instance (signature ~ (Int64 -> m (Maybe Soup.Buffer.Buffer)), MonadIO m) => O.MethodInfo MessageBodyGetChunkMethodInfo MessageBody signature where
    overloadedMethod = messageBodyGetChunk

#endif

-- method MessageBody::got_chunk
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chunk"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupBuffer received from the network"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_got_chunk" soup_message_body_got_chunk :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    Ptr Soup.Buffer.Buffer ->               -- chunk : TInterface (Name {namespace = "Soup", name = "Buffer"})
    IO ()

-- | Handles the t'GI.Soup.Structs.MessageBody.MessageBody' part of receiving a chunk of data from
-- the network. Normally this means appending /@chunk@/ to /@body@/, exactly
-- as with 'GI.Soup.Structs.MessageBody.messageBodyAppendBuffer', but if you have set
-- /@body@/\'s accumulate flag to 'P.False', then that will not happen.
-- 
-- This is a low-level method which you should not normally need to
-- use.
-- 
-- /Since: 2.24/
messageBodyGotChunk ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> Soup.Buffer.Buffer
    -- ^ /@chunk@/: a t'GI.Soup.Structs.Buffer.Buffer' received from the network
    -> m ()
messageBodyGotChunk :: MessageBody -> Buffer -> m ()
messageBodyGotChunk MessageBody
body Buffer
chunk = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr Buffer
chunk' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
chunk
    Ptr MessageBody -> Ptr Buffer -> IO ()
soup_message_body_got_chunk Ptr MessageBody
body' Ptr Buffer
chunk'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
chunk
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyGotChunkMethodInfo
instance (signature ~ (Soup.Buffer.Buffer -> m ()), MonadIO m) => O.MethodInfo MessageBodyGotChunkMethodInfo MessageBody signature where
    overloadedMethod = messageBodyGotChunk

#endif

-- method MessageBody::set_accumulate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "accumulate"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "whether or not to accumulate body chunks in @body"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_set_accumulate" soup_message_body_set_accumulate :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    CInt ->                                 -- accumulate : TBasicType TBoolean
    IO ()

-- | Sets or clears the accumulate flag on /@body@/. (The default value is
-- 'P.True'.) If set to 'P.False', /@body@/\'s @/data/@ field will not be filled in
-- after the body is fully sent\/received, and the chunks that make up
-- /@body@/ may be discarded when they are no longer needed.
-- 
-- In particular, if you set this flag to 'P.False' on an \"incoming\"
-- message body (that is, the t'GI.Soup.Objects.Message.Message':@/response_body/@ of a
-- client-side message, or t'GI.Soup.Objects.Message.Message':@/request_body/@ of a server-side
-- message), this will cause each chunk of the body to be discarded
-- after its corresponding t'GI.Soup.Objects.Message.Message'::@/got_chunk/@ signal is emitted.
-- (This is equivalent to setting the deprecated
-- 'GI.Soup.Flags.MessageFlagsOverwriteChunks' flag on the message.)
-- 
-- If you set this flag to 'P.False' on the t'GI.Soup.Objects.Message.Message':@/response_body/@ of
-- a server-side message, it will cause each chunk of the body to be
-- discarded after its corresponding t'GI.Soup.Objects.Message.Message'::@/wrote_chunk/@ signal
-- is emitted.
-- 
-- If you set the flag to 'P.False' on the t'GI.Soup.Objects.Message.Message':@/request_body/@ of a
-- client-side message, it will block the accumulation of chunks into
-- /@body@/\'s @/data/@ field, but it will not normally cause the chunks to
-- be discarded after being written like in the server-side
-- t'GI.Soup.Objects.Message.Message':@/response_body/@ case, because the request body needs to
-- be kept around in case the request needs to be sent a second time
-- due to redirection or authentication. However, if you set the
-- 'GI.Soup.Flags.MessageFlagsCanRebuild' flag on the message, then the chunks will
-- be discarded, and you will be responsible for recreating the
-- request body after the [restarted]("GI.Soup.Objects.Message#g:signal:restarted") signal is emitted.
-- 
-- /Since: 2.24/
messageBodySetAccumulate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> Bool
    -- ^ /@accumulate@/: whether or not to accumulate body chunks in /@body@/
    -> m ()
messageBodySetAccumulate :: MessageBody -> Bool -> m ()
messageBodySetAccumulate MessageBody
body Bool
accumulate = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    let accumulate' :: CInt
accumulate' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
accumulate
    Ptr MessageBody -> CInt -> IO ()
soup_message_body_set_accumulate Ptr MessageBody
body' CInt
accumulate'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodySetAccumulateMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m) => O.MethodInfo MessageBodySetAccumulateMethodInfo MessageBody signature where
    overloadedMethod = messageBodySetAccumulate

#endif

-- method MessageBody::truncate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_truncate" soup_message_body_truncate :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    IO ()

-- | Deletes all of the data in /@body@/.
messageBodyTruncate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> m ()
messageBodyTruncate :: MessageBody -> m ()
messageBodyTruncate MessageBody
body = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr MessageBody -> IO ()
soup_message_body_truncate Ptr MessageBody
body'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyTruncateMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo MessageBodyTruncateMethodInfo MessageBody signature where
    overloadedMethod = messageBodyTruncate

#endif

-- method MessageBody::wrote_chunk
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessageBody" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chunk"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #SoupBuffer returned from soup_message_body_get_chunk()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_message_body_wrote_chunk" soup_message_body_wrote_chunk :: 
    Ptr MessageBody ->                      -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    Ptr Soup.Buffer.Buffer ->               -- chunk : TInterface (Name {namespace = "Soup", name = "Buffer"})
    IO ()

-- | Handles the t'GI.Soup.Structs.MessageBody.MessageBody' part of writing a chunk of data to the
-- network. Normally this is a no-op, but if you have set /@body@/\'s
-- accumulate flag to 'P.False', then this will cause /@chunk@/ to be
-- discarded to free up memory.
-- 
-- This is a low-level method which you should not need to use, and
-- there are further restrictions on its proper use which are not
-- documented here.
-- 
-- /Since: 2.24/
messageBodyWroteChunk ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> Soup.Buffer.Buffer
    -- ^ /@chunk@/: a t'GI.Soup.Structs.Buffer.Buffer' returned from 'GI.Soup.Structs.MessageBody.messageBodyGetChunk'
    -> m ()
messageBodyWroteChunk :: MessageBody -> Buffer -> m ()
messageBodyWroteChunk MessageBody
body Buffer
chunk = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr Buffer
chunk' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
chunk
    Ptr MessageBody -> Ptr Buffer -> IO ()
soup_message_body_wrote_chunk Ptr MessageBody
body' Ptr Buffer
chunk'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
chunk
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyWroteChunkMethodInfo
instance (signature ~ (Soup.Buffer.Buffer -> m ()), MonadIO m) => O.MethodInfo MessageBodyWroteChunkMethodInfo MessageBody signature where
    overloadedMethod = messageBodyWroteChunk

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMessageBodyMethod (t :: Symbol) (o :: *) :: * where
    ResolveMessageBodyMethod "appendBuffer" o = MessageBodyAppendBufferMethodInfo
    ResolveMessageBodyMethod "append" o = MessageBodyAppendMethodInfo
    ResolveMessageBodyMethod "complete" o = MessageBodyCompleteMethodInfo
    ResolveMessageBodyMethod "flatten" o = MessageBodyFlattenMethodInfo
    ResolveMessageBodyMethod "free" o = MessageBodyFreeMethodInfo
    ResolveMessageBodyMethod "gotChunk" o = MessageBodyGotChunkMethodInfo
    ResolveMessageBodyMethod "truncate" o = MessageBodyTruncateMethodInfo
    ResolveMessageBodyMethod "wroteChunk" o = MessageBodyWroteChunkMethodInfo
    ResolveMessageBodyMethod "getAccumulate" o = MessageBodyGetAccumulateMethodInfo
    ResolveMessageBodyMethod "getChunk" o = MessageBodyGetChunkMethodInfo
    ResolveMessageBodyMethod "setAccumulate" o = MessageBodySetAccumulateMethodInfo
    ResolveMessageBodyMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMessageBodyMethod t MessageBody, O.MethodInfo info MessageBody p) => OL.IsLabel t (MessageBody -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif