{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Soup.Structs.MessageBody.MessageBody' represents the request or response body of a
-- [class/@message@/].
-- 
-- 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 [method/@messageBody@/.flatten] is called. For client-side
-- messages, this automatically happens for the response body after it
-- has been fully read. 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
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appendBytes]("GI.Soup.Structs.MessageBody#g:method:appendBytes"), [append]("GI.Soup.Structs.MessageBody#g:method:append"), [complete]("GI.Soup.Structs.MessageBody#g:method:complete"), [flatten]("GI.Soup.Structs.MessageBody#g:method:flatten"), [gotChunk]("GI.Soup.Structs.MessageBody#g:method:gotChunk"), [ref]("GI.Soup.Structs.MessageBody#g:method:ref"), [truncate]("GI.Soup.Structs.MessageBody#g:method:truncate"), [unref]("GI.Soup.Structs.MessageBody#g:method:unref"), [wroteChunk]("GI.Soup.Structs.MessageBody#g:method:wroteChunk").
-- 
-- ==== Getters
-- [getAccumulate]("GI.Soup.Structs.MessageBody#g:method:getAccumulate"), [getChunk]("GI.Soup.Structs.MessageBody#g:method:getChunk").
-- 
-- ==== Setters
-- [setAccumulate]("GI.Soup.Structs.MessageBody#g:method:setAccumulate").

#if defined(ENABLE_OVERLOADING)
    ResolveMessageBodyMethod                ,
#endif

-- ** append #method:append#

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


-- ** appendBytes #method:appendBytes#

#if defined(ENABLE_OVERLOADING)
    MessageBodyAppendBytesMethodInfo        ,
#endif
    messageBodyAppendBytes                  ,


-- ** complete #method:complete#

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


-- ** flatten #method:flatten#

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


-- ** 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                          ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    MessageBodyRefMethodInfo                ,
#endif
    messageBodyRef                          ,


-- ** setAccumulate #method:setAccumulate#

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


-- ** truncate #method:truncate#

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


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    MessageBodyUnrefMethodInfo              ,
#endif
    messageBodyUnref                        ,


-- ** wroteChunk #method:wroteChunk#

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




 -- * Properties


-- ** 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.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
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.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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 qualified GHC.Records as R
import qualified Data.Word as DW
import qualified Data.Int as DI
import qualified System.Posix.Types as SPT
import qualified Foreign.C.Types as FCT

-- Workaround for https://gitlab.haskell.org/ghc/ghc/-/issues/23392
#if MIN_VERSION_base(4,18,0)
import qualified GI.GLib.Structs.Bytes as GLib.Bytes

#else
import qualified GI.GLib.Structs.Bytes as GLib.Bytes

#endif

-- | 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
$c== :: MessageBody -> MessageBody -> Bool
== :: MessageBody -> MessageBody -> Bool
$c/= :: MessageBody -> MessageBody -> Bool
/= :: 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'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe MessageBody) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_soup_message_body_get_type
    gvalueSet_ :: Ptr GValue -> Maybe MessageBody -> IO ()
gvalueSet_ Ptr GValue
gv Maybe MessageBody
P.Nothing = Ptr GValue -> Ptr MessageBody -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr MessageBody
forall a. Ptr a
FP.nullPtr :: FP.Ptr MessageBody)
    gvalueSet_ Ptr GValue
gv (P.Just MessageBody
obj) = MessageBody -> (Ptr MessageBody -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr MessageBody
obj (Ptr GValue -> Ptr MessageBody -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe MessageBody)
gvalueGet_ Ptr GValue
gv = do
        Ptr MessageBody
ptr <- Ptr GValue -> IO (Ptr MessageBody)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr MessageBody)
        if Ptr MessageBody
ptr Ptr MessageBody -> Ptr MessageBody -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr MessageBody
forall a. Ptr a
FP.nullPtr
        then MessageBody -> Maybe MessageBody
forall a. a -> Maybe a
P.Just (MessageBody -> Maybe MessageBody)
-> IO MessageBody -> IO (Maybe MessageBody)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
        else Maybe MessageBody -> IO (Maybe MessageBody)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe MessageBody
forall a. Maybe a
P.Nothing
        
    

-- | Construct a `MessageBody` struct initialized to zero.
newZeroMessageBody :: MonadIO m => m MessageBody
newZeroMessageBody :: forall (m :: * -> *). MonadIO m => m MessageBody
newZeroMessageBody = IO MessageBody -> m MessageBody
forall a. IO a -> m a
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 a b. IO a -> (a -> IO b) -> IO b
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 :: forall (m :: * -> *).
MonadIO m =>
(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 a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return MessageBody
o


-- XXX Skipped attribute for "MessageBody:data"
-- Not implemented: Don't know how to unpack C array of type TCArray False (-1) 1 (TBasicType TUInt8)
-- | 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 :: forall (m :: * -> *). MonadIO m => MessageBody -> m Int64
getMessageBodyLength MessageBody
s = IO Int64 -> m Int64
forall a. IO a -> m a
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 a. a -> IO a
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 :: forall (m :: * -> *). MonadIO m => MessageBody -> Int64 -> m ()
setMessageBodyLength MessageBody
s Int64
val = IO () -> m ()
forall a. IO a -> m a
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
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.length"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#g:attr:length"
        })

messageBody_length :: AttrLabelProxy "length"
messageBody_length = AttrLabelProxy

#endif



#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList MessageBody
type instance O.AttributeList MessageBody = MessageBodyAttributeList
type MessageBodyAttributeList = ('[ '("length", MessageBodyLengthFieldInfo)] :: [(Symbol, DK.Type)])
#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'.
-- 
-- [class/@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 :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m MessageBody
messageBodyNew  = IO MessageBody -> m MessageBody
forall a. IO a -> m a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MessageBody
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method MessageBody::append_bytes
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "buffer"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GBytes" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Appends the data from /@buffer@/ to /@body@/.
messageBodyAppendBytes ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> GLib.Bytes.Bytes
    -- ^ /@buffer@/: a t'GI.GLib.Structs.Bytes.Bytes'
    -> m ()
messageBodyAppendBytes :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> Bytes -> m ()
messageBodyAppendBytes MessageBody
body Bytes
buffer = IO () -> m ()
forall a. IO a -> m a
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 Bytes
buffer' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
buffer
    Ptr MessageBody -> Ptr Bytes -> IO ()
soup_message_body_append_bytes Ptr MessageBody
body' Ptr Bytes
buffer'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
buffer
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyAppendBytesMethodInfo
instance (signature ~ (GLib.Bytes.Bytes -> m ()), MonadIO m) => O.OverloadedMethod MessageBodyAppendBytesMethodInfo MessageBody signature where
    overloadedMethod = messageBodyAppendBytes

instance O.OverloadedMethodInfo MessageBodyAppendBytesMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyAppendBytes",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v:messageBodyAppendBytes"
        })


#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
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TSize
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "length of @data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TSize
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "length of @data" , sinceVersion = Nothing }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , argCallbackUserData = 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)
    FCT.CSize ->                            -- length : TBasicType TSize
    IO ()

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

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

instance O.OverloadedMethodInfo MessageBodyAppendMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyAppend",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v: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
--           , argCallbackUserData = 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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> m ()
messageBodyComplete MessageBody
body = IO () -> m ()
forall a. IO a -> m a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo MessageBodyCompleteMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyComplete",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v: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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- 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 GLib.Bytes.Bytes)

-- | Fills in /@body@/\'s data field with a buffer containing all of the
-- data in /@body@/.
-- 
-- Adds 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 GLib.Bytes.Bytes
    -- ^ __Returns:__ a t'GI.GLib.Structs.Bytes.Bytes' containing the same data as /@body@/.
    --   (You must 'GI.GLib.Structs.Bytes.bytesUnref' this if you do not want it.)
messageBodyFlatten :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> m Bytes
messageBodyFlatten MessageBody
body = IO Bytes -> m Bytes
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bytes -> m Bytes) -> IO Bytes -> m Bytes
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 Bytes
result <- Ptr MessageBody -> IO (Ptr Bytes)
soup_message_body_flatten Ptr MessageBody
body'
    Text -> Ptr Bytes -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"messageBodyFlatten" Ptr Bytes
result
    Bytes
result' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
result
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Bytes -> IO Bytes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
result'

#if defined(ENABLE_OVERLOADING)
data MessageBodyFlattenMethodInfo
instance (signature ~ (m GLib.Bytes.Bytes), MonadIO m) => O.OverloadedMethod MessageBodyFlattenMethodInfo MessageBody signature where
    overloadedMethod = messageBodyFlatten

instance O.OverloadedMethodInfo MessageBodyFlattenMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyFlatten",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v:messageBodyFlatten"
        })


#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
--           , argCallbackUserData = 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 [method/@messageBody@/.set_accumulate. for details.
messageBodyGetAccumulate ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> m Bool
    -- ^ __Returns:__ the accumulate flag for /@body@/.
messageBodyGetAccumulate :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> m Bool
messageBodyGetAccumulate MessageBody
body = IO Bool -> m Bool
forall a. IO a -> m a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

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

instance O.OverloadedMethodInfo MessageBodyGetAccumulateMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyGetAccumulate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v: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
--           , argCallbackUserData = 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "GLib" , name = "Bytes" })
-- 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 GLib.Bytes.Bytes)

-- | Gets a [struct/@gLib@/.Bytes] 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
-- [method/@messageBody@/.get_chunk] 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
-- [method/@messageBody@/.complete] has been called or not; if it has,
-- then [method/@messageBody@/.get_chunk] will return a 0-length chunk
-- (indicating the end of /@body@/). If it has not, then
-- [method/@messageBody@/.get_chunk] 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 GLib.Bytes.Bytes)
    -- ^ __Returns:__ a t'GI.GLib.Structs.Bytes.Bytes'
messageBodyGetChunk :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> Int64 -> m (Maybe Bytes)
messageBodyGetChunk MessageBody
body Int64
offset = IO (Maybe Bytes) -> m (Maybe Bytes)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Bytes) -> m (Maybe Bytes))
-> IO (Maybe Bytes) -> m (Maybe Bytes)
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 Bytes
result <- Ptr MessageBody -> Int64 -> IO (Ptr Bytes)
soup_message_body_get_chunk Ptr MessageBody
body' Int64
offset
    Maybe Bytes
maybeResult <- Ptr Bytes -> (Ptr Bytes -> IO Bytes) -> IO (Maybe Bytes)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Bytes
result ((Ptr Bytes -> IO Bytes) -> IO (Maybe Bytes))
-> (Ptr Bytes -> IO Bytes) -> IO (Maybe Bytes)
forall a b. (a -> b) -> a -> b
$ \Ptr Bytes
result' -> do
        Bytes
result'' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
result'
        Bytes -> IO Bytes
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bytes
result''
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Maybe Bytes -> IO (Maybe Bytes)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Bytes
maybeResult

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

instance O.OverloadedMethodInfo MessageBodyGetChunkMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyGetChunk",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v: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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chunk"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GBytes received from the network"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 GLib.Bytes.Bytes ->                 -- chunk : TInterface (Name {namespace = "GLib", name = "Bytes"})
    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
-- [method/@messageBody@/.append_bytes], 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.
messageBodyGotChunk ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> GLib.Bytes.Bytes
    -- ^ /@chunk@/: a t'GI.GLib.Structs.Bytes.Bytes' received from the network
    -> m ()
messageBodyGotChunk :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> Bytes -> m ()
messageBodyGotChunk MessageBody
body Bytes
chunk = IO () -> m ()
forall a. IO a -> m a
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 Bytes
chunk' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
chunk
    Ptr MessageBody -> Ptr Bytes -> IO ()
soup_message_body_got_chunk Ptr MessageBody
body' Ptr Bytes
chunk'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
chunk
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyGotChunkMethodInfo
instance (signature ~ (GLib.Bytes.Bytes -> m ()), MonadIO m) => O.OverloadedMethod MessageBodyGotChunkMethodInfo MessageBody signature where
    overloadedMethod = messageBodyGotChunk

instance O.OverloadedMethodInfo MessageBodyGotChunkMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyGotChunk",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v:messageBodyGotChunk"
        })


#endif

-- method MessageBody::ref
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "Soup" , name = "MessageBody" })
-- throws : False
-- Skip return : False

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

-- | Atomically increments the reference count of /@body@/ by one.
messageBodyRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> m MessageBody
    -- ^ __Returns:__ the passed in t'GI.Soup.Structs.MessageBody.MessageBody'
messageBodyRef :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> m MessageBody
messageBodyRef MessageBody
body = IO MessageBody -> m MessageBody
forall a. IO a -> m a
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
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr MessageBody
result <- Ptr MessageBody -> IO (Ptr MessageBody)
soup_message_body_ref Ptr MessageBody
body'
    Text -> Ptr MessageBody -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"messageBodyRef" 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 ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    MessageBody -> IO MessageBody
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return MessageBody
result'

#if defined(ENABLE_OVERLOADING)
data MessageBodyRefMethodInfo
instance (signature ~ (m MessageBody), MonadIO m) => O.OverloadedMethod MessageBodyRefMethodInfo MessageBody signature where
    overloadedMethod = messageBodyRef

instance O.OverloadedMethodInfo MessageBodyRefMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyRef",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v:messageBodyRef"
        })


#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
--           , argCallbackUserData = 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
--           , argCallbackUserData = 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.
-- 
-- If you set the flag to 'P.False' on the [class/@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
-- [class/@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.
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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> Bool -> m ()
messageBodySetAccumulate MessageBody
body Bool
accumulate = IO () -> m ()
forall a. IO a -> m a
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
P.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
P.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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo MessageBodySetAccumulateMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodySetAccumulate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v: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
--           , argCallbackUserData = 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 :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> m ()
messageBodyTruncate MessageBody
body = IO () -> m ()
forall a. IO a -> m a
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance O.OverloadedMethodInfo MessageBodyTruncateMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyTruncate",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v:messageBodyTruncate"
        })


#endif

-- method MessageBody::unref
-- 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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

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

-- | Atomically decrements the reference count of /@body@/ by one.
-- 
-- When the reference count reaches zero, the resources allocated by
-- /@body@/ are freed
messageBodyUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> m ()
messageBodyUnref :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> m ()
messageBodyUnref MessageBody
body = IO () -> m ()
forall a. IO a -> m a
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_unref Ptr MessageBody
body'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod MessageBodyUnrefMethodInfo MessageBody signature where
    overloadedMethod = messageBodyUnref

instance O.OverloadedMethodInfo MessageBodyUnrefMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyUnref",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v:messageBodyUnref"
        })


#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
--           , argCallbackUserData = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "chunk"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GBytes returned from [method@MessageBody.get_chunk]"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , argCallbackUserData = 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 GLib.Bytes.Bytes ->                 -- chunk : TInterface (Name {namespace = "GLib", name = "Bytes"})
    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.
messageBodyWroteChunk ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    MessageBody
    -- ^ /@body@/: a t'GI.Soup.Structs.MessageBody.MessageBody'
    -> GLib.Bytes.Bytes
    -- ^ /@chunk@/: a t'GI.GLib.Structs.Bytes.Bytes' returned from [method/@messageBody@/.get_chunk]
    -> m ()
messageBodyWroteChunk :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageBody -> Bytes -> m ()
messageBodyWroteChunk MessageBody
body Bytes
chunk = IO () -> m ()
forall a. IO a -> m a
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 Bytes
chunk' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
chunk
    Ptr MessageBody -> Ptr Bytes -> IO ()
soup_message_body_wrote_chunk Ptr MessageBody
body' Ptr Bytes
chunk'
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
chunk
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MessageBodyWroteChunkMethodInfo
instance (signature ~ (GLib.Bytes.Bytes -> m ()), MonadIO m) => O.OverloadedMethod MessageBodyWroteChunkMethodInfo MessageBody signature where
    overloadedMethod = messageBodyWroteChunk

instance O.OverloadedMethodInfo MessageBodyWroteChunkMethodInfo MessageBody where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Structs.MessageBody.messageBodyWroteChunk",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-3.0.3/docs/GI-Soup-Structs-MessageBody.html#v:messageBodyWroteChunk"
        })


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMessageBodyMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveMessageBodyMethod "appendBytes" o = MessageBodyAppendBytesMethodInfo
    ResolveMessageBodyMethod "append" o = MessageBodyAppendMethodInfo
    ResolveMessageBodyMethod "complete" o = MessageBodyCompleteMethodInfo
    ResolveMessageBodyMethod "flatten" o = MessageBodyFlattenMethodInfo
    ResolveMessageBodyMethod "gotChunk" o = MessageBodyGotChunkMethodInfo
    ResolveMessageBodyMethod "ref" o = MessageBodyRefMethodInfo
    ResolveMessageBodyMethod "truncate" o = MessageBodyTruncateMethodInfo
    ResolveMessageBodyMethod "unref" o = MessageBodyUnrefMethodInfo
    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.OverloadedMethod 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

#if MIN_VERSION_base(4,13,0)
instance (info ~ ResolveMessageBodyMethod t MessageBody, O.OverloadedMethod info MessageBody p, R.HasField t MessageBody p) => R.HasField t MessageBody p where
    getField = O.overloadedMethod @info

#endif

instance (info ~ ResolveMessageBodyMethod t MessageBody, O.OverloadedMethodInfo info MessageBody) => OL.IsLabel t (O.MethodProxy info MessageBody) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.MethodProxy
#else
    fromLabel _ = O.MethodProxy
#endif

#endif