{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A request to retrieve a particular URI.
-- 
-- /Since: 2.42/

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

module GI.Soup.Objects.Request
    ( 

-- * Exported types
    Request(..)                             ,
    IsRequest                               ,
    toRequest                               ,
    noRequest                               ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveRequestMethod                    ,
#endif


-- ** getContentLength #method:getContentLength#

#if defined(ENABLE_OVERLOADING)
    RequestGetContentLengthMethodInfo       ,
#endif
    requestGetContentLength                 ,


-- ** getContentType #method:getContentType#

#if defined(ENABLE_OVERLOADING)
    RequestGetContentTypeMethodInfo         ,
#endif
    requestGetContentType                   ,


-- ** getSession #method:getSession#

#if defined(ENABLE_OVERLOADING)
    RequestGetSessionMethodInfo             ,
#endif
    requestGetSession                       ,


-- ** getUri #method:getUri#

#if defined(ENABLE_OVERLOADING)
    RequestGetUriMethodInfo                 ,
#endif
    requestGetUri                           ,


-- ** send #method:send#

#if defined(ENABLE_OVERLOADING)
    RequestSendMethodInfo                   ,
#endif
    requestSend                             ,


-- ** sendAsync #method:sendAsync#

#if defined(ENABLE_OVERLOADING)
    RequestSendAsyncMethodInfo              ,
#endif
    requestSendAsync                        ,


-- ** sendFinish #method:sendFinish#

#if defined(ENABLE_OVERLOADING)
    RequestSendFinishMethodInfo             ,
#endif
    requestSendFinish                       ,




 -- * Properties
-- ** session #attr:session#
-- | The request\'s t'GI.Soup.Objects.Session.Session'.
-- 
-- /Since: 2.42/

#if defined(ENABLE_OVERLOADING)
    RequestSessionPropertyInfo              ,
#endif
    constructRequestSession                 ,
    getRequestSession                       ,
#if defined(ENABLE_OVERLOADING)
    requestSession                          ,
#endif


-- ** uri #attr:uri#
-- | The request URI.
-- 
-- /Since: 2.42/

#if defined(ENABLE_OVERLOADING)
    RequestUriPropertyInfo                  ,
#endif
    constructRequestUri                     ,
    getRequestUri                           ,
#if defined(ENABLE_OVERLOADING)
    requestUri                              ,
#endif




    ) 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.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified 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 GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import {-# SOURCE #-} qualified GI.Soup.Objects.Session as Soup.Session
import {-# SOURCE #-} qualified GI.Soup.Structs.URI as Soup.URI

-- | Memory-managed wrapper type.
newtype Request = Request (ManagedPtr Request)
    deriving (Request -> Request -> Bool
(Request -> Request -> Bool)
-> (Request -> Request -> Bool) -> Eq Request
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Request -> Request -> Bool
$c/= :: Request -> Request -> Bool
== :: Request -> Request -> Bool
$c== :: Request -> Request -> Bool
Eq)
foreign import ccall "soup_request_get_type"
    c_soup_request_get_type :: IO GType

instance GObject Request where
    gobjectType :: IO GType
gobjectType = IO GType
c_soup_request_get_type
    

-- | Convert 'Request' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Request where
    toGValue :: Request -> IO GValue
toGValue o :: Request
o = do
        GType
gtype <- IO GType
c_soup_request_get_type
        Request -> (Ptr Request -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Request
o (GType
-> (GValue -> Ptr Request -> IO ()) -> Ptr Request -> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Request -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO Request
fromGValue gv :: GValue
gv = do
        Ptr Request
ptr <- GValue -> IO (Ptr Request)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr Request)
        (ManagedPtr Request -> Request) -> Ptr Request -> IO Request
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr Request -> Request
Request Ptr Request
ptr
        
    

-- | Type class for types which can be safely cast to `Request`, for instance with `toRequest`.
class (GObject o, O.IsDescendantOf Request o) => IsRequest o
instance (GObject o, O.IsDescendantOf Request o) => IsRequest o

instance O.HasParentTypes Request
type instance O.ParentTypes Request = '[GObject.Object.Object, Gio.Initable.Initable]

-- | Cast to `Request`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toRequest :: (MonadIO m, IsRequest o) => o -> m Request
toRequest :: o -> m Request
toRequest = IO Request -> m Request
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Request -> m Request) -> (o -> IO Request) -> o -> m Request
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr Request -> Request) -> o -> IO Request
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr Request -> Request
Request

-- | A convenience alias for `Nothing` :: `Maybe` `Request`.
noRequest :: Maybe Request
noRequest :: Maybe Request
noRequest = Maybe Request
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveRequestMethod (t :: Symbol) (o :: *) :: * where
    ResolveRequestMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRequestMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRequestMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRequestMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRequestMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRequestMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveRequestMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRequestMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRequestMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRequestMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRequestMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRequestMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRequestMethod "send" o = RequestSendMethodInfo
    ResolveRequestMethod "sendAsync" o = RequestSendAsyncMethodInfo
    ResolveRequestMethod "sendFinish" o = RequestSendFinishMethodInfo
    ResolveRequestMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRequestMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRequestMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRequestMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRequestMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRequestMethod "getContentLength" o = RequestGetContentLengthMethodInfo
    ResolveRequestMethod "getContentType" o = RequestGetContentTypeMethodInfo
    ResolveRequestMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRequestMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRequestMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRequestMethod "getSession" o = RequestGetSessionMethodInfo
    ResolveRequestMethod "getUri" o = RequestGetUriMethodInfo
    ResolveRequestMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRequestMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRequestMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRequestMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "session"
   -- Type: TInterface (Name {namespace = "Soup", name = "Session"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@session@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' request #session
-- @
getRequestSession :: (MonadIO m, IsRequest o) => o -> m Soup.Session.Session
getRequestSession :: o -> m Session
getRequestSession obj :: o
obj = IO Session -> m Session
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Session -> m Session) -> IO Session -> m Session
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Session) -> IO Session
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getRequestSession" (IO (Maybe Session) -> IO Session)
-> IO (Maybe Session) -> IO Session
forall a b. (a -> b) -> a -> b
$ o
-> String -> (ManagedPtr Session -> Session) -> IO (Maybe Session)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "session" ManagedPtr Session -> Session
Soup.Session.Session

-- | Construct a `GValueConstruct` with valid value for the “@session@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRequestSession :: (IsRequest o, Soup.Session.IsSession a) => a -> IO (GValueConstruct o)
constructRequestSession :: a -> IO (GValueConstruct o)
constructRequestSession val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "session" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

#if defined(ENABLE_OVERLOADING)
data RequestSessionPropertyInfo
instance AttrInfo RequestSessionPropertyInfo where
    type AttrAllowedOps RequestSessionPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint RequestSessionPropertyInfo = IsRequest
    type AttrSetTypeConstraint RequestSessionPropertyInfo = Soup.Session.IsSession
    type AttrTransferTypeConstraint RequestSessionPropertyInfo = Soup.Session.IsSession
    type AttrTransferType RequestSessionPropertyInfo = Soup.Session.Session
    type AttrGetType RequestSessionPropertyInfo = Soup.Session.Session
    type AttrLabel RequestSessionPropertyInfo = "session"
    type AttrOrigin RequestSessionPropertyInfo = Request
    attrGet = getRequestSession
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Soup.Session.Session v
    attrConstruct = constructRequestSession
    attrClear = undefined
#endif

-- VVV Prop "uri"
   -- Type: TInterface (Name {namespace = "Soup", name = "URI"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@uri@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' request #uri
-- @
getRequestUri :: (MonadIO m, IsRequest o) => o -> m Soup.URI.URI
getRequestUri :: o -> m URI
getRequestUri obj :: o
obj = IO URI -> m URI
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe URI) -> IO URI
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getRequestUri" (IO (Maybe URI) -> IO URI) -> IO (Maybe URI) -> IO URI
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr URI -> URI) -> IO (Maybe URI)
forall a b.
(GObject a, BoxedObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyBoxed o
obj "uri" ManagedPtr URI -> URI
Soup.URI.URI

-- | Construct a `GValueConstruct` with valid value for the “@uri@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRequestUri :: (IsRequest o) => Soup.URI.URI -> IO (GValueConstruct o)
constructRequestUri :: URI -> IO (GValueConstruct o)
constructRequestUri val :: URI
val = String -> Maybe URI -> IO (GValueConstruct o)
forall a o.
BoxedObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBoxed "uri" (URI -> Maybe URI
forall a. a -> Maybe a
Just URI
val)

#if defined(ENABLE_OVERLOADING)
data RequestUriPropertyInfo
instance AttrInfo RequestUriPropertyInfo where
    type AttrAllowedOps RequestUriPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint RequestUriPropertyInfo = IsRequest
    type AttrSetTypeConstraint RequestUriPropertyInfo = (~) Soup.URI.URI
    type AttrTransferTypeConstraint RequestUriPropertyInfo = (~) Soup.URI.URI
    type AttrTransferType RequestUriPropertyInfo = Soup.URI.URI
    type AttrGetType RequestUriPropertyInfo = Soup.URI.URI
    type AttrLabel RequestUriPropertyInfo = "uri"
    type AttrOrigin RequestUriPropertyInfo = Request
    attrGet = getRequestUri
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructRequestUri
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Request
type instance O.AttributeList Request = RequestAttributeList
type RequestAttributeList = ('[ '("session", RequestSessionPropertyInfo), '("uri", RequestUriPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
requestSession :: AttrLabelProxy "session"
requestSession = AttrLabelProxy

requestUri :: AttrLabelProxy "uri"
requestUri = AttrLabelProxy

#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Request = RequestSignalList
type RequestSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, *)])

#endif

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

foreign import ccall "soup_request_get_content_length" soup_request_get_content_length :: 
    Ptr Request ->                          -- request : TInterface (Name {namespace = "Soup", name = "Request"})
    IO Int64

-- | Gets the length of the data represented by /@request@/. For most
-- request types, this will not be known until after you call
-- 'GI.Soup.Objects.Request.requestSend' or 'GI.Soup.Objects.Request.requestSendFinish'.
-- 
-- /Since: 2.42/
requestGetContentLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsRequest a) =>
    a
    -- ^ /@request@/: a t'GI.Soup.Objects.Request.Request'
    -> m Int64
    -- ^ __Returns:__ the length of the data represented by /@request@/,
    --   or -1 if not known.
requestGetContentLength :: a -> m Int64
requestGetContentLength request :: a
request = IO Int64 -> m Int64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int64 -> m Int64) -> IO Int64 -> m Int64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Request
request' <- a -> IO (Ptr Request)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    Int64
result <- Ptr Request -> IO Int64
soup_request_get_content_length Ptr Request
request'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Int64 -> IO Int64
forall (m :: * -> *) a. Monad m => a -> m a
return Int64
result

#if defined(ENABLE_OVERLOADING)
data RequestGetContentLengthMethodInfo
instance (signature ~ (m Int64), MonadIO m, IsRequest a) => O.MethodInfo RequestGetContentLengthMethodInfo a signature where
    overloadedMethod = requestGetContentLength

#endif

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

foreign import ccall "soup_request_get_content_type" soup_request_get_content_type :: 
    Ptr Request ->                          -- request : TInterface (Name {namespace = "Soup", name = "Request"})
    IO CString

-- | Gets the type of the data represented by /@request@/. For most request
-- types, this will not be known until after you call
-- 'GI.Soup.Objects.Request.requestSend' or 'GI.Soup.Objects.Request.requestSendFinish'.
-- 
-- As in the HTTP Content-Type header, this may include parameters
-- after the MIME type.
-- 
-- /Since: 2.42/
requestGetContentType ::
    (B.CallStack.HasCallStack, MonadIO m, IsRequest a) =>
    a
    -- ^ /@request@/: a t'GI.Soup.Objects.Request.Request'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the type of the data represented by
    --   /@request@/, or 'P.Nothing' if not known.
requestGetContentType :: a -> m (Maybe Text)
requestGetContentType request :: a
request = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Request
request' <- a -> IO (Ptr Request)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    CString
result <- Ptr Request -> IO CString
soup_request_get_content_type Ptr Request
request'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data RequestGetContentTypeMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsRequest a) => O.MethodInfo RequestGetContentTypeMethodInfo a signature where
    overloadedMethod = requestGetContentType

#endif

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

foreign import ccall "soup_request_get_session" soup_request_get_session :: 
    Ptr Request ->                          -- request : TInterface (Name {namespace = "Soup", name = "Request"})
    IO (Ptr Soup.Session.Session)

-- | Gets /@request@/\'s t'GI.Soup.Objects.Session.Session'
-- 
-- /Since: 2.42/
requestGetSession ::
    (B.CallStack.HasCallStack, MonadIO m, IsRequest a) =>
    a
    -- ^ /@request@/: a t'GI.Soup.Objects.Request.Request'
    -> m Soup.Session.Session
    -- ^ __Returns:__ /@request@/\'s t'GI.Soup.Objects.Session.Session'
requestGetSession :: a -> m Session
requestGetSession request :: a
request = IO Session -> m Session
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Session -> m Session) -> IO Session -> m Session
forall a b. (a -> b) -> a -> b
$ do
    Ptr Request
request' <- a -> IO (Ptr Request)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    Ptr Session
result <- Ptr Request -> IO (Ptr Session)
soup_request_get_session Ptr Request
request'
    Text -> Ptr Session -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "requestGetSession" Ptr Session
result
    Session
result' <- ((ManagedPtr Session -> Session) -> Ptr Session -> IO Session
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Session -> Session
Soup.Session.Session) Ptr Session
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Session -> IO Session
forall (m :: * -> *) a. Monad m => a -> m a
return Session
result'

#if defined(ENABLE_OVERLOADING)
data RequestGetSessionMethodInfo
instance (signature ~ (m Soup.Session.Session), MonadIO m, IsRequest a) => O.MethodInfo RequestGetSessionMethodInfo a signature where
    overloadedMethod = requestGetSession

#endif

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

foreign import ccall "soup_request_get_uri" soup_request_get_uri :: 
    Ptr Request ->                          -- request : TInterface (Name {namespace = "Soup", name = "Request"})
    IO (Ptr Soup.URI.URI)

-- | Gets /@request@/\'s URI
-- 
-- /Since: 2.42/
requestGetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsRequest a) =>
    a
    -- ^ /@request@/: a t'GI.Soup.Objects.Request.Request'
    -> m Soup.URI.URI
    -- ^ __Returns:__ /@request@/\'s URI
requestGetUri :: a -> m URI
requestGetUri request :: a
request = IO URI -> m URI
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO URI -> m URI) -> IO URI -> m URI
forall a b. (a -> b) -> a -> b
$ do
    Ptr Request
request' <- a -> IO (Ptr Request)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    Ptr URI
result <- Ptr Request -> IO (Ptr URI)
soup_request_get_uri Ptr Request
request'
    Text -> Ptr URI -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "requestGetUri" Ptr URI
result
    URI
result' <- ((ManagedPtr URI -> URI) -> Ptr URI -> IO URI
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr URI -> URI
Soup.URI.URI) Ptr URI
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    URI -> IO URI
forall (m :: * -> *) a. Monad m => a -> m a
return URI
result'

#if defined(ENABLE_OVERLOADING)
data RequestGetUriMethodInfo
instance (signature ~ (m Soup.URI.URI), MonadIO m, IsRequest a) => O.MethodInfo RequestGetUriMethodInfo a signature where
    overloadedMethod = requestGetUri

#endif

-- method Request::send
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "request"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Request" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupRequest" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "InputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "soup_request_send" soup_request_send :: 
    Ptr Request ->                          -- request : TInterface (Name {namespace = "Soup", name = "Request"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.InputStream.InputStream)

-- | Synchronously requests the URI pointed to by /@request@/, and returns
-- a t'GI.Gio.Objects.InputStream.InputStream' that can be used to read its contents.
-- 
-- Note that you cannot use this method with @/SoupRequests/@ attached to
-- a t'GI.Soup.Objects.SessionAsync.SessionAsync'.
-- 
-- /Since: 2.42/
requestSend ::
    (B.CallStack.HasCallStack, MonadIO m, IsRequest a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@request@/: a t'GI.Soup.Objects.Request.Request'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'
    -> m Gio.InputStream.InputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.InputStream.InputStream' that can be used to
    --   read from the URI pointed to by /@request@/. /(Can throw 'Data.GI.Base.GError.GError')/
requestSend :: a -> Maybe b -> m InputStream
requestSend request :: a
request cancellable :: Maybe b
cancellable = IO InputStream -> m InputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputStream -> m InputStream)
-> IO InputStream -> m InputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr Request
request' <- a -> IO (Ptr Request)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO InputStream -> IO () -> IO InputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr InputStream
result <- (Ptr (Ptr GError) -> IO (Ptr InputStream)) -> IO (Ptr InputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr InputStream))
 -> IO (Ptr InputStream))
-> (Ptr (Ptr GError) -> IO (Ptr InputStream))
-> IO (Ptr InputStream)
forall a b. (a -> b) -> a -> b
$ Ptr Request
-> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr InputStream)
soup_request_send Ptr Request
request' Ptr Cancellable
maybeCancellable
        Text -> Ptr InputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "requestSend" Ptr InputStream
result
        InputStream
result' <- ((ManagedPtr InputStream -> InputStream)
-> Ptr InputStream -> IO InputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream) Ptr InputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        InputStream -> IO InputStream
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data RequestSendMethodInfo
instance (signature ~ (Maybe (b) -> m Gio.InputStream.InputStream), MonadIO m, IsRequest a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RequestSendMethodInfo a signature where
    overloadedMethod = requestSend

#endif

-- method Request::send_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "request"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Request" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupRequest" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncReadyCallback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 3
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "user data passed to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_request_send_async" soup_request_send_async :: 
    Ptr Request ->                          -- request : TInterface (Name {namespace = "Soup", name = "Request"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Begins an asynchronously request for the URI pointed to by
-- /@request@/.
-- 
-- Note that you cannot use this method with @/SoupRequests/@ attached to
-- a t'GI.Soup.Objects.SessionSync.SessionSync'.
-- 
-- /Since: 2.42/
requestSendAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsRequest a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@request@/: a t'GI.Soup.Objects.Request.Request'
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable' or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: a t'GI.Gio.Callbacks.AsyncReadyCallback'
    -> m ()
requestSendAsync :: a -> Maybe b -> Maybe AsyncReadyCallback -> m ()
requestSendAsync request :: a
request cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Request
request' <- a -> IO (Ptr Request)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Request
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
soup_request_send_async Ptr Request
request' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RequestSendAsyncMethodInfo
instance (signature ~ (Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsRequest a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RequestSendAsyncMethodInfo a signature where
    overloadedMethod = requestSendAsync

#endif

-- method Request::send_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "request"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Request" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupRequest" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "InputStream" })
-- throws : True
-- Skip return : False

foreign import ccall "soup_request_send_finish" soup_request_send_finish :: 
    Ptr Request ->                          -- request : TInterface (Name {namespace = "Soup", name = "Request"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Gio.InputStream.InputStream)

-- | Gets the result of a 'GI.Soup.Objects.Request.requestSendAsync'.
-- 
-- /Since: 2.42/
requestSendFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsRequest a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@request@/: a t'GI.Soup.Objects.Request.Request'
    -> b
    -- ^ /@result@/: the t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m Gio.InputStream.InputStream
    -- ^ __Returns:__ a t'GI.Gio.Objects.InputStream.InputStream' that can be used to
    --   read from the URI pointed to by /@request@/. /(Can throw 'Data.GI.Base.GError.GError')/
requestSendFinish :: a -> b -> m InputStream
requestSendFinish request :: a
request result_ :: b
result_ = IO InputStream -> m InputStream
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO InputStream -> m InputStream)
-> IO InputStream -> m InputStream
forall a b. (a -> b) -> a -> b
$ do
    Ptr Request
request' <- a -> IO (Ptr Request)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO InputStream -> IO () -> IO InputStream
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr InputStream
result <- (Ptr (Ptr GError) -> IO (Ptr InputStream)) -> IO (Ptr InputStream)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr InputStream))
 -> IO (Ptr InputStream))
-> (Ptr (Ptr GError) -> IO (Ptr InputStream))
-> IO (Ptr InputStream)
forall a b. (a -> b) -> a -> b
$ Ptr Request
-> Ptr AsyncResult -> Ptr (Ptr GError) -> IO (Ptr InputStream)
soup_request_send_finish Ptr Request
request' Ptr AsyncResult
result_'
        Text -> Ptr InputStream -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "requestSendFinish" Ptr InputStream
result
        InputStream
result' <- ((ManagedPtr InputStream -> InputStream)
-> Ptr InputStream -> IO InputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream) Ptr InputStream
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        InputStream -> IO InputStream
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream
result'
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data RequestSendFinishMethodInfo
instance (signature ~ (b -> m Gio.InputStream.InputStream), MonadIO m, IsRequest a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo RequestSendFinishMethodInfo a signature where
    overloadedMethod = requestSendFinish

#endif