{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a multipart HTTP message body, parsed according to the
-- syntax of RFC 2046. Of particular interest to HTTP are
-- \<literal>multipart\/byte-ranges\<\/literal> and
-- \<literal>multipart\/form-data\<\/literal>.
-- 
-- Although the headers of a t'GI.Soup.Structs.Multipart.Multipart' body part will contain the
-- full headers from that body part, libsoup does not interpret them
-- according to MIME rules. For example, each body part is assumed to
-- have \"binary\" Content-Transfer-Encoding, even if its headers
-- explicitly state otherwise. In other words, don\'t try to use
-- t'GI.Soup.Structs.Multipart.Multipart' for handling real MIME multiparts.
-- 
-- /Since: 2.26/

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

module GI.Soup.Structs.Multipart
    ( 

-- * Exported types
    Multipart(..)                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [appendFormFile]("GI.Soup.Structs.Multipart#g:method:appendFormFile"), [appendFormString]("GI.Soup.Structs.Multipart#g:method:appendFormString"), [appendPart]("GI.Soup.Structs.Multipart#g:method:appendPart"), [free]("GI.Soup.Structs.Multipart#g:method:free"), [toMessage]("GI.Soup.Structs.Multipart#g:method:toMessage").
-- 
-- ==== Getters
-- [getLength]("GI.Soup.Structs.Multipart#g:method:getLength"), [getPart]("GI.Soup.Structs.Multipart#g:method:getPart").
-- 
-- ==== Setters
-- /None/.

#if defined(ENABLE_OVERLOADING)
    ResolveMultipartMethod                  ,
#endif

-- ** appendFormFile #method:appendFormFile#

#if defined(ENABLE_OVERLOADING)
    MultipartAppendFormFileMethodInfo       ,
#endif
    multipartAppendFormFile                 ,


-- ** appendFormString #method:appendFormString#

#if defined(ENABLE_OVERLOADING)
    MultipartAppendFormStringMethodInfo     ,
#endif
    multipartAppendFormString               ,


-- ** appendPart #method:appendPart#

#if defined(ENABLE_OVERLOADING)
    MultipartAppendPartMethodInfo           ,
#endif
    multipartAppendPart                     ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    MultipartFreeMethodInfo                 ,
#endif
    multipartFree                           ,


-- ** getLength #method:getLength#

#if defined(ENABLE_OVERLOADING)
    MultipartGetLengthMethodInfo            ,
#endif
    multipartGetLength                      ,


-- ** getPart #method:getPart#

#if defined(ENABLE_OVERLOADING)
    MultipartGetPartMethodInfo              ,
#endif
    multipartGetPart                        ,


-- ** new #method:new#

    multipartNew                            ,


-- ** newFromMessage #method:newFromMessage#

    multipartNewFromMessage                 ,


-- ** toMessage #method:toMessage#

#if defined(ENABLE_OVERLOADING)
    MultipartToMessageMethodInfo            ,
#endif
    multipartToMessage                      ,




    ) 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.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 qualified GHC.Records as R

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

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

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

foreign import ccall "soup_multipart_get_type" c_soup_multipart_get_type :: 
    IO GType

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

instance B.Types.TypedObject Multipart where
    glibType :: IO GType
glibType = IO GType
c_soup_multipart_get_type

instance B.Types.GBoxed Multipart

-- | Convert 'Multipart' 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 Multipart) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_soup_multipart_get_type
    gvalueSet_ :: Ptr GValue -> Maybe Multipart -> IO ()
gvalueSet_ Ptr GValue
gv Maybe Multipart
P.Nothing = Ptr GValue -> Ptr Multipart -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv (Ptr Multipart
forall a. Ptr a
FP.nullPtr :: FP.Ptr Multipart)
    gvalueSet_ Ptr GValue
gv (P.Just Multipart
obj) = Multipart -> (Ptr Multipart -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Multipart
obj (Ptr GValue -> Ptr Multipart -> IO ()
forall a. Ptr GValue -> Ptr a -> IO ()
B.GValue.set_boxed Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe Multipart)
gvalueGet_ Ptr GValue
gv = do
        Ptr Multipart
ptr <- Ptr GValue -> IO (Ptr Multipart)
forall b. Ptr GValue -> IO (Ptr b)
B.GValue.get_boxed Ptr GValue
gv :: IO (Ptr Multipart)
        if Ptr Multipart
ptr Ptr Multipart -> Ptr Multipart -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Multipart
forall a. Ptr a
FP.nullPtr
        then Multipart -> Maybe Multipart
forall a. a -> Maybe a
P.Just (Multipart -> Maybe Multipart)
-> IO Multipart -> IO (Maybe Multipart)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ManagedPtr Multipart -> Multipart)
-> Ptr Multipart -> IO Multipart
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Multipart -> Multipart
Multipart Ptr Multipart
ptr
        else Maybe Multipart -> IO (Maybe Multipart)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Multipart
forall a. Maybe a
P.Nothing
        
    


#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Multipart
type instance O.AttributeList Multipart = MultipartAttributeList
type MultipartAttributeList = ('[ ] :: [(Symbol, *)])
#endif

-- method Multipart::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "mime_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the MIME type of the multipart to create."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Multipart" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_multipart_new" soup_multipart_new :: 
    CString ->                              -- mime_type : TBasicType TUTF8
    IO (Ptr Multipart)

-- | Creates a new empty t'GI.Soup.Structs.Multipart.Multipart' with a randomly-generated
-- boundary string. Note that /@mimeType@/ must be the full MIME type,
-- including \"multipart\/\".
-- 
-- /Since: 2.26/
multipartNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@mimeType@/: the MIME type of the multipart to create.
    -> m Multipart
    -- ^ __Returns:__ a new empty t'GI.Soup.Structs.Multipart.Multipart' of the given /@mimeType@/
multipartNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m Multipart
multipartNew Text
mimeType = IO Multipart -> m Multipart
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Multipart -> m Multipart) -> IO Multipart -> m Multipart
forall a b. (a -> b) -> a -> b
$ do
    CString
mimeType' <- Text -> IO CString
textToCString Text
mimeType
    Ptr Multipart
result <- CString -> IO (Ptr Multipart)
soup_multipart_new CString
mimeType'
    Text -> Ptr Multipart -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"multipartNew" Ptr Multipart
result
    Multipart
result' <- ((ManagedPtr Multipart -> Multipart)
-> Ptr Multipart -> IO Multipart
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Multipart -> Multipart
Multipart) Ptr Multipart
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mimeType'
    Multipart -> IO Multipart
forall (m :: * -> *) a. Monad m => a -> m a
return Multipart
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Multipart::new_from_message
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "headers"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageHeaders" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the headers of the HTTP message to parse"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the body of the HTTP message to parse"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Multipart" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_multipart_new_from_message" soup_multipart_new_from_message :: 
    Ptr Soup.MessageHeaders.MessageHeaders -> -- headers : TInterface (Name {namespace = "Soup", name = "MessageHeaders"})
    Ptr Soup.MessageBody.MessageBody ->     -- body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    IO (Ptr Multipart)

-- | Parses /@headers@/ and /@body@/ to form a new t'GI.Soup.Structs.Multipart.Multipart'
-- 
-- /Since: 2.26/
multipartNewFromMessage ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Soup.MessageHeaders.MessageHeaders
    -- ^ /@headers@/: the headers of the HTTP message to parse
    -> Soup.MessageBody.MessageBody
    -- ^ /@body@/: the body of the HTTP message to parse
    -> m (Maybe Multipart)
    -- ^ __Returns:__ a new t'GI.Soup.Structs.Multipart.Multipart' (or 'P.Nothing' if the
    -- message couldn\'t be parsed or wasn\'t multipart).
multipartNewFromMessage :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
MessageHeaders -> MessageBody -> m (Maybe Multipart)
multipartNewFromMessage MessageHeaders
headers MessageBody
body = IO (Maybe Multipart) -> m (Maybe Multipart)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Multipart) -> m (Maybe Multipart))
-> IO (Maybe Multipart) -> m (Maybe Multipart)
forall a b. (a -> b) -> a -> b
$ do
    Ptr MessageHeaders
headers' <- MessageHeaders -> IO (Ptr MessageHeaders)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageHeaders
headers
    Ptr MessageBody
body' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
body
    Ptr Multipart
result <- Ptr MessageHeaders -> Ptr MessageBody -> IO (Ptr Multipart)
soup_multipart_new_from_message Ptr MessageHeaders
headers' Ptr MessageBody
body'
    Maybe Multipart
maybeResult <- Ptr Multipart
-> (Ptr Multipart -> IO Multipart) -> IO (Maybe Multipart)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Multipart
result ((Ptr Multipart -> IO Multipart) -> IO (Maybe Multipart))
-> (Ptr Multipart -> IO Multipart) -> IO (Maybe Multipart)
forall a b. (a -> b) -> a -> b
$ \Ptr Multipart
result' -> do
        Multipart
result'' <- ((ManagedPtr Multipart -> Multipart)
-> Ptr Multipart -> IO Multipart
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Multipart -> Multipart
Multipart) Ptr Multipart
result'
        Multipart -> IO Multipart
forall (m :: * -> *) a. Monad m => a -> m a
return Multipart
result''
    MessageHeaders -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageHeaders
headers
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
body
    Maybe Multipart -> IO (Maybe Multipart)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Multipart
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Multipart::append_form_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "multipart"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Multipart" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a multipart (presumably of type \"multipart/form-data\")"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "control_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the name of the control associated with this file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "filename"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the file, or %NULL if not known"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the MIME type of the file, or %NULL if not known"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the file data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_multipart_append_form_file" soup_multipart_append_form_file :: 
    Ptr Multipart ->                        -- multipart : TInterface (Name {namespace = "Soup", name = "Multipart"})
    CString ->                              -- control_name : TBasicType TUTF8
    CString ->                              -- filename : TBasicType TUTF8
    CString ->                              -- content_type : TBasicType TUTF8
    Ptr Soup.Buffer.Buffer ->               -- body : TInterface (Name {namespace = "Soup", name = "Buffer"})
    IO ()

-- | Adds a new MIME part containing /@body@/ to /@multipart@/, using
-- \"Content-Disposition: form-data\", as per the HTML forms
-- specification. See 'GI.Soup.Functions.formRequestNewFromMultipart' for more
-- details.
-- 
-- /Since: 2.26/
multipartAppendFormFile ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Multipart
    -- ^ /@multipart@/: a multipart (presumably of type \"multipart\/form-data\")
    -> T.Text
    -- ^ /@controlName@/: the name of the control associated with this file
    -> T.Text
    -- ^ /@filename@/: the name of the file, or 'P.Nothing' if not known
    -> T.Text
    -- ^ /@contentType@/: the MIME type of the file, or 'P.Nothing' if not known
    -> Soup.Buffer.Buffer
    -- ^ /@body@/: the file data
    -> m ()
multipartAppendFormFile :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Multipart -> Text -> Text -> Text -> Buffer -> m ()
multipartAppendFormFile Multipart
multipart Text
controlName Text
filename Text
contentType Buffer
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 Multipart
multipart' <- Multipart -> IO (Ptr Multipart)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Multipart
multipart
    CString
controlName' <- Text -> IO CString
textToCString Text
controlName
    CString
filename' <- Text -> IO CString
textToCString Text
filename
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    Ptr Buffer
body' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
body
    Ptr Multipart
-> CString -> CString -> CString -> Ptr Buffer -> IO ()
soup_multipart_append_form_file Ptr Multipart
multipart' CString
controlName' CString
filename' CString
contentType' Ptr Buffer
body'
    Multipart -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Multipart
multipart
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
body
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
controlName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
filename'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MultipartAppendFormFileMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> Soup.Buffer.Buffer -> m ()), MonadIO m) => O.OverloadedMethod MultipartAppendFormFileMethodInfo Multipart signature where
    overloadedMethod = multipartAppendFormFile

instance O.OverloadedMethodInfo MultipartAppendFormFileMethodInfo Multipart where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Multipart.multipartAppendFormFile",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Multipart.html#v:multipartAppendFormFile"
        }


#endif

-- method Multipart::append_form_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "multipart"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Multipart" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a multipart (presumably of type \"multipart/form-data\")"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "control_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the name of the control associated with @data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the body data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_multipart_append_form_string" soup_multipart_append_form_string :: 
    Ptr Multipart ->                        -- multipart : TInterface (Name {namespace = "Soup", name = "Multipart"})
    CString ->                              -- control_name : TBasicType TUTF8
    CString ->                              -- data : TBasicType TUTF8
    IO ()

-- | Adds a new MIME part containing /@data@/ to /@multipart@/, using
-- \"Content-Disposition: form-data\", as per the HTML forms
-- specification. See 'GI.Soup.Functions.formRequestNewFromMultipart' for more
-- details.
-- 
-- /Since: 2.26/
multipartAppendFormString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Multipart
    -- ^ /@multipart@/: a multipart (presumably of type \"multipart\/form-data\")
    -> T.Text
    -- ^ /@controlName@/: the name of the control associated with /@data@/
    -> T.Text
    -- ^ /@data@/: the body data
    -> m ()
multipartAppendFormString :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Multipart -> Text -> Text -> m ()
multipartAppendFormString Multipart
multipart Text
controlName Text
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
    Ptr Multipart
multipart' <- Multipart -> IO (Ptr Multipart)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Multipart
multipart
    CString
controlName' <- Text -> IO CString
textToCString Text
controlName
    CString
data_' <- Text -> IO CString
textToCString Text
data_
    Ptr Multipart -> CString -> CString -> IO ()
soup_multipart_append_form_string Ptr Multipart
multipart' CString
controlName' CString
data_'
    Multipart -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Multipart
multipart
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
controlName'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
data_'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MultipartAppendFormStringMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m) => O.OverloadedMethod MultipartAppendFormStringMethodInfo Multipart signature where
    overloadedMethod = multipartAppendFormString

instance O.OverloadedMethodInfo MultipartAppendFormStringMethodInfo Multipart where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Multipart.multipartAppendFormString",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Multipart.html#v:multipartAppendFormString"
        }


#endif

-- method Multipart::append_part
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "multipart"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Multipart" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMultipart" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "headers"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageHeaders" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the MIME part headers"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Buffer" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the MIME part 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_multipart_append_part" soup_multipart_append_part :: 
    Ptr Multipart ->                        -- multipart : TInterface (Name {namespace = "Soup", name = "Multipart"})
    Ptr Soup.MessageHeaders.MessageHeaders -> -- headers : TInterface (Name {namespace = "Soup", name = "MessageHeaders"})
    Ptr Soup.Buffer.Buffer ->               -- body : TInterface (Name {namespace = "Soup", name = "Buffer"})
    IO ()

-- | Adds a new MIME part to /@multipart@/ with the given headers and body.
-- (The multipart will make its own copies of /@headers@/ and /@body@/, so
-- you should free your copies if you are not using them for anything
-- else.)
-- 
-- /Since: 2.26/
multipartAppendPart ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Multipart
    -- ^ /@multipart@/: a t'GI.Soup.Structs.Multipart.Multipart'
    -> Soup.MessageHeaders.MessageHeaders
    -- ^ /@headers@/: the MIME part headers
    -> Soup.Buffer.Buffer
    -- ^ /@body@/: the MIME part body
    -> m ()
multipartAppendPart :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Multipart -> MessageHeaders -> Buffer -> m ()
multipartAppendPart Multipart
multipart MessageHeaders
headers Buffer
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 Multipart
multipart' <- Multipart -> IO (Ptr Multipart)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Multipart
multipart
    Ptr MessageHeaders
headers' <- MessageHeaders -> IO (Ptr MessageHeaders)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageHeaders
headers
    Ptr Buffer
body' <- Buffer -> IO (Ptr Buffer)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Buffer
body
    Ptr Multipart -> Ptr MessageHeaders -> Ptr Buffer -> IO ()
soup_multipart_append_part Ptr Multipart
multipart' Ptr MessageHeaders
headers' Ptr Buffer
body'
    Multipart -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Multipart
multipart
    MessageHeaders -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageHeaders
headers
    Buffer -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Buffer
body
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MultipartAppendPartMethodInfo
instance (signature ~ (Soup.MessageHeaders.MessageHeaders -> Soup.Buffer.Buffer -> m ()), MonadIO m) => O.OverloadedMethod MultipartAppendPartMethodInfo Multipart signature where
    overloadedMethod = multipartAppendPart

instance O.OverloadedMethodInfo MultipartAppendPartMethodInfo Multipart where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Multipart.multipartAppendPart",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Multipart.html#v:multipartAppendPart"
        }


#endif

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

foreign import ccall "soup_multipart_free" soup_multipart_free :: 
    Ptr Multipart ->                        -- multipart : TInterface (Name {namespace = "Soup", name = "Multipart"})
    IO ()

-- | Frees /@multipart@/
-- 
-- /Since: 2.26/
multipartFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Multipart
    -- ^ /@multipart@/: a t'GI.Soup.Structs.Multipart.Multipart'
    -> m ()
multipartFree :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Multipart -> m ()
multipartFree Multipart
multipart = 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 Multipart
multipart' <- Multipart -> IO (Ptr Multipart)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Multipart
multipart
    Ptr Multipart -> IO ()
soup_multipart_free Ptr Multipart
multipart'
    Multipart -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Multipart
multipart
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MultipartFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.OverloadedMethod MultipartFreeMethodInfo Multipart signature where
    overloadedMethod = multipartFree

instance O.OverloadedMethodInfo MultipartFreeMethodInfo Multipart where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Multipart.multipartFree",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Multipart.html#v:multipartFree"
        }


#endif

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

foreign import ccall "soup_multipart_get_length" soup_multipart_get_length :: 
    Ptr Multipart ->                        -- multipart : TInterface (Name {namespace = "Soup", name = "Multipart"})
    IO Int32

-- | Gets the number of body parts in /@multipart@/
-- 
-- /Since: 2.26/
multipartGetLength ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Multipart
    -- ^ /@multipart@/: a t'GI.Soup.Structs.Multipart.Multipart'
    -> m Int32
    -- ^ __Returns:__ the number of body parts in /@multipart@/
multipartGetLength :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Multipart -> m Int32
multipartGetLength Multipart
multipart = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Multipart
multipart' <- Multipart -> IO (Ptr Multipart)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Multipart
multipart
    Int32
result <- Ptr Multipart -> IO Int32
soup_multipart_get_length Ptr Multipart
multipart'
    Multipart -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Multipart
multipart
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data MultipartGetLengthMethodInfo
instance (signature ~ (m Int32), MonadIO m) => O.OverloadedMethod MultipartGetLengthMethodInfo Multipart signature where
    overloadedMethod = multipartGetLength

instance O.OverloadedMethodInfo MultipartGetLengthMethodInfo Multipart where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Multipart.multipartGetLength",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Multipart.html#v:multipartGetLength"
        }


#endif

-- method Multipart::get_part
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "multipart"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Multipart" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMultipart" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "part"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the part number to get (counting from 0)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "headers"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageHeaders" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the MIME part\nheaders"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Buffer" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "return location for the MIME part\nbody"
--                 , 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_multipart_get_part" soup_multipart_get_part :: 
    Ptr Multipart ->                        -- multipart : TInterface (Name {namespace = "Soup", name = "Multipart"})
    Int32 ->                                -- part : TBasicType TInt
    Ptr (Ptr Soup.MessageHeaders.MessageHeaders) -> -- headers : TInterface (Name {namespace = "Soup", name = "MessageHeaders"})
    Ptr (Ptr Soup.Buffer.Buffer) ->         -- body : TInterface (Name {namespace = "Soup", name = "Buffer"})
    IO CInt

-- | Gets the indicated body part from /@multipart@/.
-- 
-- /Since: 2.26/
multipartGetPart ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Multipart
    -- ^ /@multipart@/: a t'GI.Soup.Structs.Multipart.Multipart'
    -> Int32
    -- ^ /@part@/: the part number to get (counting from 0)
    -> m ((Bool, Soup.MessageHeaders.MessageHeaders, Soup.Buffer.Buffer))
    -- ^ __Returns:__ 'P.True' on success, 'P.False' if /@part@/ is out of range (in
    -- which case /@headers@/ and /@body@/ won\'t be set)
multipartGetPart :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Multipart -> Int32 -> m (Bool, MessageHeaders, Buffer)
multipartGetPart Multipart
multipart Int32
part = IO (Bool, MessageHeaders, Buffer)
-> m (Bool, MessageHeaders, Buffer)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, MessageHeaders, Buffer)
 -> m (Bool, MessageHeaders, Buffer))
-> IO (Bool, MessageHeaders, Buffer)
-> m (Bool, MessageHeaders, Buffer)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Multipart
multipart' <- Multipart -> IO (Ptr Multipart)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Multipart
multipart
    Ptr (Ptr MessageHeaders)
headers <- IO (Ptr (Ptr MessageHeaders))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Soup.MessageHeaders.MessageHeaders))
    Ptr (Ptr Buffer)
body <- IO (Ptr (Ptr Buffer))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (Ptr Soup.Buffer.Buffer))
    CInt
result <- Ptr Multipart
-> Int32 -> Ptr (Ptr MessageHeaders) -> Ptr (Ptr Buffer) -> IO CInt
soup_multipart_get_part Ptr Multipart
multipart' Int32
part Ptr (Ptr MessageHeaders)
headers Ptr (Ptr Buffer)
body
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    Ptr MessageHeaders
headers' <- Ptr (Ptr MessageHeaders) -> IO (Ptr MessageHeaders)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr MessageHeaders)
headers
    MessageHeaders
headers'' <- ((ManagedPtr MessageHeaders -> MessageHeaders)
-> Ptr MessageHeaders -> IO MessageHeaders
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr MessageHeaders -> MessageHeaders
Soup.MessageHeaders.MessageHeaders) Ptr MessageHeaders
headers'
    Ptr Buffer
body' <- Ptr (Ptr Buffer) -> IO (Ptr Buffer)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Buffer)
body
    Buffer
body'' <- ((ManagedPtr Buffer -> Buffer) -> Ptr Buffer -> IO Buffer
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr Buffer -> Buffer
Soup.Buffer.Buffer) Ptr Buffer
body'
    Multipart -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Multipart
multipart
    Ptr (Ptr MessageHeaders) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr MessageHeaders)
headers
    Ptr (Ptr Buffer) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Buffer)
body
    (Bool, MessageHeaders, Buffer) -> IO (Bool, MessageHeaders, Buffer)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', MessageHeaders
headers'', Buffer
body'')

#if defined(ENABLE_OVERLOADING)
data MultipartGetPartMethodInfo
instance (signature ~ (Int32 -> m ((Bool, Soup.MessageHeaders.MessageHeaders, Soup.Buffer.Buffer))), MonadIO m) => O.OverloadedMethod MultipartGetPartMethodInfo Multipart signature where
    overloadedMethod = multipartGetPart

instance O.OverloadedMethodInfo MultipartGetPartMethodInfo Multipart where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Multipart.multipartGetPart",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Multipart.html#v:multipartGetPart"
        }


#endif

-- method Multipart::to_message
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "multipart"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Multipart" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMultipart" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_headers"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageHeaders" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the headers of the HTTP message to serialize @multipart to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dest_body"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "MessageBody" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the body of the HTTP message to serialize @multipart to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_multipart_to_message" soup_multipart_to_message :: 
    Ptr Multipart ->                        -- multipart : TInterface (Name {namespace = "Soup", name = "Multipart"})
    Ptr Soup.MessageHeaders.MessageHeaders -> -- dest_headers : TInterface (Name {namespace = "Soup", name = "MessageHeaders"})
    Ptr Soup.MessageBody.MessageBody ->     -- dest_body : TInterface (Name {namespace = "Soup", name = "MessageBody"})
    IO ()

-- | Serializes /@multipart@/ to /@destHeaders@/ and /@destBody@/.
-- 
-- /Since: 2.26/
multipartToMessage ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Multipart
    -- ^ /@multipart@/: a t'GI.Soup.Structs.Multipart.Multipart'
    -> Soup.MessageHeaders.MessageHeaders
    -- ^ /@destHeaders@/: the headers of the HTTP message to serialize /@multipart@/ to
    -> Soup.MessageBody.MessageBody
    -- ^ /@destBody@/: the body of the HTTP message to serialize /@multipart@/ to
    -> m ()
multipartToMessage :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Multipart -> MessageHeaders -> MessageBody -> m ()
multipartToMessage Multipart
multipart MessageHeaders
destHeaders MessageBody
destBody = 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 Multipart
multipart' <- Multipart -> IO (Ptr Multipart)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Multipart
multipart
    Ptr MessageHeaders
destHeaders' <- MessageHeaders -> IO (Ptr MessageHeaders)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageHeaders
destHeaders
    Ptr MessageBody
destBody' <- MessageBody -> IO (Ptr MessageBody)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr MessageBody
destBody
    Ptr Multipart -> Ptr MessageHeaders -> Ptr MessageBody -> IO ()
soup_multipart_to_message Ptr Multipart
multipart' Ptr MessageHeaders
destHeaders' Ptr MessageBody
destBody'
    Multipart -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Multipart
multipart
    MessageHeaders -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageHeaders
destHeaders
    MessageBody -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr MessageBody
destBody
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data MultipartToMessageMethodInfo
instance (signature ~ (Soup.MessageHeaders.MessageHeaders -> Soup.MessageBody.MessageBody -> m ()), MonadIO m) => O.OverloadedMethod MultipartToMessageMethodInfo Multipart signature where
    overloadedMethod = multipartToMessage

instance O.OverloadedMethodInfo MultipartToMessageMethodInfo Multipart where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Structs.Multipart.multipartToMessage",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Structs-Multipart.html#v:multipartToMessage"
        }


#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveMultipartMethod (t :: Symbol) (o :: *) :: * where
    ResolveMultipartMethod "appendFormFile" o = MultipartAppendFormFileMethodInfo
    ResolveMultipartMethod "appendFormString" o = MultipartAppendFormStringMethodInfo
    ResolveMultipartMethod "appendPart" o = MultipartAppendPartMethodInfo
    ResolveMultipartMethod "free" o = MultipartFreeMethodInfo
    ResolveMultipartMethod "toMessage" o = MultipartToMessageMethodInfo
    ResolveMultipartMethod "getLength" o = MultipartGetLengthMethodInfo
    ResolveMultipartMethod "getPart" o = MultipartGetPartMethodInfo
    ResolveMultipartMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveMultipartMethod t Multipart, O.OverloadedMethod info Multipart p) => OL.IsLabel t (Multipart -> 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 ~ ResolveMultipartMethod t Multipart, O.OverloadedMethod info Multipart p, R.HasField t Multipart p) => R.HasField t Multipart p where
    getField = O.overloadedMethod @info

#endif

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

#endif