{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.WebKit2WebExtension.Objects.URIResponse
    ( 

-- * Exported types
    URIResponse(..)                         ,
    IsURIResponse                           ,
    toURIResponse                           ,
    noURIResponse                           ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveURIResponseMethod                ,
#endif


-- ** getContentLength #method:getContentLength#

#if defined(ENABLE_OVERLOADING)
    URIResponseGetContentLengthMethodInfo   ,
#endif
    uRIResponseGetContentLength             ,


-- ** getHttpHeaders #method:getHttpHeaders#

#if defined(ENABLE_OVERLOADING)
    URIResponseGetHttpHeadersMethodInfo     ,
#endif
    uRIResponseGetHttpHeaders               ,


-- ** getMimeType #method:getMimeType#

#if defined(ENABLE_OVERLOADING)
    URIResponseGetMimeTypeMethodInfo        ,
#endif
    uRIResponseGetMimeType                  ,


-- ** getStatusCode #method:getStatusCode#

#if defined(ENABLE_OVERLOADING)
    URIResponseGetStatusCodeMethodInfo      ,
#endif
    uRIResponseGetStatusCode                ,


-- ** getSuggestedFilename #method:getSuggestedFilename#

#if defined(ENABLE_OVERLOADING)
    URIResponseGetSuggestedFilenameMethodInfo,
#endif
    uRIResponseGetSuggestedFilename         ,


-- ** getUri #method:getUri#

#if defined(ENABLE_OVERLOADING)
    URIResponseGetUriMethodInfo             ,
#endif
    uRIResponseGetUri                       ,




 -- * Properties
-- ** contentLength #attr:contentLength#
-- | The expected content length of the response.

#if defined(ENABLE_OVERLOADING)
    URIResponseContentLengthPropertyInfo    ,
#endif
    getURIResponseContentLength             ,
#if defined(ENABLE_OVERLOADING)
    uRIResponseContentLength                ,
#endif


-- ** httpHeaders #attr:httpHeaders#
-- | The HTTP headers of the response, or 'P.Nothing' if the response is not an HTTP response.
-- 
-- /Since: 2.6/

#if defined(ENABLE_OVERLOADING)
    URIResponseHttpHeadersPropertyInfo      ,
#endif
    getURIResponseHttpHeaders               ,
#if defined(ENABLE_OVERLOADING)
    uRIResponseHttpHeaders                  ,
#endif


-- ** mimeType #attr:mimeType#
-- | The MIME type of the response.

#if defined(ENABLE_OVERLOADING)
    URIResponseMimeTypePropertyInfo         ,
#endif
    getURIResponseMimeType                  ,
#if defined(ENABLE_OVERLOADING)
    uRIResponseMimeType                     ,
#endif


-- ** statusCode #attr:statusCode#
-- | The status code of the response as returned by the server.

#if defined(ENABLE_OVERLOADING)
    URIResponseStatusCodePropertyInfo       ,
#endif
    getURIResponseStatusCode                ,
#if defined(ENABLE_OVERLOADING)
    uRIResponseStatusCode                   ,
#endif


-- ** suggestedFilename #attr:suggestedFilename#
-- | The suggested filename for the URI response.

#if defined(ENABLE_OVERLOADING)
    URIResponseSuggestedFilenamePropertyInfo,
#endif
    getURIResponseSuggestedFilename         ,
#if defined(ENABLE_OVERLOADING)
    uRIResponseSuggestedFilename            ,
#endif


-- ** uri #attr:uri#
-- | The URI for which the response was made.

#if defined(ENABLE_OVERLOADING)
    URIResponseUriPropertyInfo              ,
#endif
    getURIResponseUri                       ,
#if defined(ENABLE_OVERLOADING)
    uRIResponseUri                          ,
#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.Soup.Structs.MessageHeaders as Soup.MessageHeaders

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

instance GObject URIResponse where
    gobjectType :: IO GType
gobjectType = IO GType
c_webkit_uri_response_get_type
    

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

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

instance O.HasParentTypes URIResponse
type instance O.ParentTypes URIResponse = '[GObject.Object.Object]

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

-- | A convenience alias for `Nothing` :: `Maybe` `URIResponse`.
noURIResponse :: Maybe URIResponse
noURIResponse :: Maybe URIResponse
noURIResponse = Maybe URIResponse
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveURIResponseMethod (t :: Symbol) (o :: *) :: * where
    ResolveURIResponseMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveURIResponseMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveURIResponseMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveURIResponseMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveURIResponseMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveURIResponseMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveURIResponseMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveURIResponseMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveURIResponseMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveURIResponseMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveURIResponseMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveURIResponseMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveURIResponseMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveURIResponseMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveURIResponseMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveURIResponseMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveURIResponseMethod "getContentLength" o = URIResponseGetContentLengthMethodInfo
    ResolveURIResponseMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveURIResponseMethod "getHttpHeaders" o = URIResponseGetHttpHeadersMethodInfo
    ResolveURIResponseMethod "getMimeType" o = URIResponseGetMimeTypeMethodInfo
    ResolveURIResponseMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveURIResponseMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveURIResponseMethod "getStatusCode" o = URIResponseGetStatusCodeMethodInfo
    ResolveURIResponseMethod "getSuggestedFilename" o = URIResponseGetSuggestedFilenameMethodInfo
    ResolveURIResponseMethod "getUri" o = URIResponseGetUriMethodInfo
    ResolveURIResponseMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveURIResponseMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveURIResponseMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveURIResponseMethod l o = O.MethodResolutionFailed l o

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

#endif

-- VVV Prop "content-length"
   -- Type: TBasicType TUInt64
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@content-length@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRIResponse #contentLength
-- @
getURIResponseContentLength :: (MonadIO m, IsURIResponse o) => o -> m Word64
getURIResponseContentLength :: o -> m Word64
getURIResponseContentLength obj :: o
obj = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word64
forall a. GObject a => a -> String -> IO Word64
B.Properties.getObjectPropertyUInt64 o
obj "content-length"

#if defined(ENABLE_OVERLOADING)
data URIResponseContentLengthPropertyInfo
instance AttrInfo URIResponseContentLengthPropertyInfo where
    type AttrAllowedOps URIResponseContentLengthPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint URIResponseContentLengthPropertyInfo = IsURIResponse
    type AttrSetTypeConstraint URIResponseContentLengthPropertyInfo = (~) ()
    type AttrTransferTypeConstraint URIResponseContentLengthPropertyInfo = (~) ()
    type AttrTransferType URIResponseContentLengthPropertyInfo = ()
    type AttrGetType URIResponseContentLengthPropertyInfo = Word64
    type AttrLabel URIResponseContentLengthPropertyInfo = "content-length"
    type AttrOrigin URIResponseContentLengthPropertyInfo = URIResponse
    attrGet = getURIResponseContentLength
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "http-headers"
   -- Type: TInterface (Name {namespace = "Soup", name = "MessageHeaders"})
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data URIResponseHttpHeadersPropertyInfo
instance AttrInfo URIResponseHttpHeadersPropertyInfo where
    type AttrAllowedOps URIResponseHttpHeadersPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint URIResponseHttpHeadersPropertyInfo = IsURIResponse
    type AttrSetTypeConstraint URIResponseHttpHeadersPropertyInfo = (~) ()
    type AttrTransferTypeConstraint URIResponseHttpHeadersPropertyInfo = (~) ()
    type AttrTransferType URIResponseHttpHeadersPropertyInfo = ()
    type AttrGetType URIResponseHttpHeadersPropertyInfo = Soup.MessageHeaders.MessageHeaders
    type AttrLabel URIResponseHttpHeadersPropertyInfo = "http-headers"
    type AttrOrigin URIResponseHttpHeadersPropertyInfo = URIResponse
    attrGet = getURIResponseHttpHeaders
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "mime-type"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@mime-type@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRIResponse #mimeType
-- @
getURIResponseMimeType :: (MonadIO m, IsURIResponse o) => o -> m T.Text
getURIResponseMimeType :: o -> m Text
getURIResponseMimeType obj :: o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getURIResponseMimeType" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "mime-type"

#if defined(ENABLE_OVERLOADING)
data URIResponseMimeTypePropertyInfo
instance AttrInfo URIResponseMimeTypePropertyInfo where
    type AttrAllowedOps URIResponseMimeTypePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint URIResponseMimeTypePropertyInfo = IsURIResponse
    type AttrSetTypeConstraint URIResponseMimeTypePropertyInfo = (~) ()
    type AttrTransferTypeConstraint URIResponseMimeTypePropertyInfo = (~) ()
    type AttrTransferType URIResponseMimeTypePropertyInfo = ()
    type AttrGetType URIResponseMimeTypePropertyInfo = T.Text
    type AttrLabel URIResponseMimeTypePropertyInfo = "mime-type"
    type AttrOrigin URIResponseMimeTypePropertyInfo = URIResponse
    attrGet = getURIResponseMimeType
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "status-code"
   -- Type: TBasicType TUInt
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@status-code@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRIResponse #statusCode
-- @
getURIResponseStatusCode :: (MonadIO m, IsURIResponse o) => o -> m Word32
getURIResponseStatusCode :: o -> m Word32
getURIResponseStatusCode obj :: o
obj = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ o -> String -> IO Word32
forall a. GObject a => a -> String -> IO Word32
B.Properties.getObjectPropertyUInt32 o
obj "status-code"

#if defined(ENABLE_OVERLOADING)
data URIResponseStatusCodePropertyInfo
instance AttrInfo URIResponseStatusCodePropertyInfo where
    type AttrAllowedOps URIResponseStatusCodePropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint URIResponseStatusCodePropertyInfo = IsURIResponse
    type AttrSetTypeConstraint URIResponseStatusCodePropertyInfo = (~) ()
    type AttrTransferTypeConstraint URIResponseStatusCodePropertyInfo = (~) ()
    type AttrTransferType URIResponseStatusCodePropertyInfo = ()
    type AttrGetType URIResponseStatusCodePropertyInfo = Word32
    type AttrLabel URIResponseStatusCodePropertyInfo = "status-code"
    type AttrOrigin URIResponseStatusCodePropertyInfo = URIResponse
    attrGet = getURIResponseStatusCode
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "suggested-filename"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@suggested-filename@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' uRIResponse #suggestedFilename
-- @
getURIResponseSuggestedFilename :: (MonadIO m, IsURIResponse o) => o -> m T.Text
getURIResponseSuggestedFilename :: o -> m Text
getURIResponseSuggestedFilename obj :: o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getURIResponseSuggestedFilename" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "suggested-filename"

#if defined(ENABLE_OVERLOADING)
data URIResponseSuggestedFilenamePropertyInfo
instance AttrInfo URIResponseSuggestedFilenamePropertyInfo where
    type AttrAllowedOps URIResponseSuggestedFilenamePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint URIResponseSuggestedFilenamePropertyInfo = IsURIResponse
    type AttrSetTypeConstraint URIResponseSuggestedFilenamePropertyInfo = (~) ()
    type AttrTransferTypeConstraint URIResponseSuggestedFilenamePropertyInfo = (~) ()
    type AttrTransferType URIResponseSuggestedFilenamePropertyInfo = ()
    type AttrGetType URIResponseSuggestedFilenamePropertyInfo = T.Text
    type AttrLabel URIResponseSuggestedFilenamePropertyInfo = "suggested-filename"
    type AttrOrigin URIResponseSuggestedFilenamePropertyInfo = URIResponse
    attrGet = getURIResponseSuggestedFilename
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

-- VVV Prop "uri"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- 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' uRIResponse #uri
-- @
getURIResponseUri :: (MonadIO m, IsURIResponse o) => o -> m T.Text
getURIResponseUri :: o -> m Text
getURIResponseUri obj :: o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getURIResponseUri" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "uri"

#if defined(ENABLE_OVERLOADING)
data URIResponseUriPropertyInfo
instance AttrInfo URIResponseUriPropertyInfo where
    type AttrAllowedOps URIResponseUriPropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint URIResponseUriPropertyInfo = IsURIResponse
    type AttrSetTypeConstraint URIResponseUriPropertyInfo = (~) ()
    type AttrTransferTypeConstraint URIResponseUriPropertyInfo = (~) ()
    type AttrTransferType URIResponseUriPropertyInfo = ()
    type AttrGetType URIResponseUriPropertyInfo = T.Text
    type AttrLabel URIResponseUriPropertyInfo = "uri"
    type AttrOrigin URIResponseUriPropertyInfo = URIResponse
    attrGet = getURIResponseUri
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList URIResponse
type instance O.AttributeList URIResponse = URIResponseAttributeList
type URIResponseAttributeList = ('[ '("contentLength", URIResponseContentLengthPropertyInfo), '("httpHeaders", URIResponseHttpHeadersPropertyInfo), '("mimeType", URIResponseMimeTypePropertyInfo), '("statusCode", URIResponseStatusCodePropertyInfo), '("suggestedFilename", URIResponseSuggestedFilenamePropertyInfo), '("uri", URIResponseUriPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
uRIResponseContentLength :: AttrLabelProxy "contentLength"
uRIResponseContentLength = AttrLabelProxy

uRIResponseHttpHeaders :: AttrLabelProxy "httpHeaders"
uRIResponseHttpHeaders = AttrLabelProxy

uRIResponseMimeType :: AttrLabelProxy "mimeType"
uRIResponseMimeType = AttrLabelProxy

uRIResponseStatusCode :: AttrLabelProxy "statusCode"
uRIResponseStatusCode = AttrLabelProxy

uRIResponseSuggestedFilename :: AttrLabelProxy "suggestedFilename"
uRIResponseSuggestedFilename = AttrLabelProxy

uRIResponseUri :: AttrLabelProxy "uri"
uRIResponseUri = AttrLabelProxy

#endif

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

#endif

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

foreign import ccall "webkit_uri_response_get_content_length" webkit_uri_response_get_content_length :: 
    Ptr URIResponse ->                      -- response : TInterface (Name {namespace = "WebKit2WebExtension", name = "URIResponse"})
    IO Word64

-- | Get the expected content length of the t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse'. It can
-- be 0 if the server provided an incorrect or missing Content-Length.
uRIResponseGetContentLength ::
    (B.CallStack.HasCallStack, MonadIO m, IsURIResponse a) =>
    a
    -- ^ /@response@/: a t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse'
    -> m Word64
    -- ^ __Returns:__ the expected content length of /@response@/.
uRIResponseGetContentLength :: a -> m Word64
uRIResponseGetContentLength response :: a
response = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr URIResponse
response' <- a -> IO (Ptr URIResponse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
response
    Word64
result <- Ptr URIResponse -> IO Word64
webkit_uri_response_get_content_length Ptr URIResponse
response'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
response
    Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
result

#if defined(ENABLE_OVERLOADING)
data URIResponseGetContentLengthMethodInfo
instance (signature ~ (m Word64), MonadIO m, IsURIResponse a) => O.MethodInfo URIResponseGetContentLengthMethodInfo a signature where
    overloadedMethod = uRIResponseGetContentLength

#endif

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

foreign import ccall "webkit_uri_response_get_http_headers" webkit_uri_response_get_http_headers :: 
    Ptr URIResponse ->                      -- response : TInterface (Name {namespace = "WebKit2WebExtension", name = "URIResponse"})
    IO (Ptr Soup.MessageHeaders.MessageHeaders)

-- | Get the HTTP headers of a t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse' as a t'GI.Soup.Structs.MessageHeaders.MessageHeaders'.
-- 
-- /Since: 2.6/
uRIResponseGetHttpHeaders ::
    (B.CallStack.HasCallStack, MonadIO m, IsURIResponse a) =>
    a
    -- ^ /@response@/: a t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse'
    -> m Soup.MessageHeaders.MessageHeaders
    -- ^ __Returns:__ a t'GI.Soup.Structs.MessageHeaders.MessageHeaders' with the HTTP headers of /@response@/
    --    or 'P.Nothing' if /@response@/ is not an HTTP response.
uRIResponseGetHttpHeaders :: a -> m MessageHeaders
uRIResponseGetHttpHeaders response :: a
response = IO MessageHeaders -> m MessageHeaders
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO MessageHeaders -> m MessageHeaders)
-> IO MessageHeaders -> m MessageHeaders
forall a b. (a -> b) -> a -> b
$ do
    Ptr URIResponse
response' <- a -> IO (Ptr URIResponse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
response
    Ptr MessageHeaders
result <- Ptr URIResponse -> IO (Ptr MessageHeaders)
webkit_uri_response_get_http_headers Ptr URIResponse
response'
    Text -> Ptr MessageHeaders -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "uRIResponseGetHttpHeaders" Ptr MessageHeaders
result
    MessageHeaders
result' <- ((ManagedPtr MessageHeaders -> MessageHeaders)
-> Ptr MessageHeaders -> IO MessageHeaders
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr MessageHeaders -> MessageHeaders
Soup.MessageHeaders.MessageHeaders) Ptr MessageHeaders
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
response
    MessageHeaders -> IO MessageHeaders
forall (m :: * -> *) a. Monad m => a -> m a
return MessageHeaders
result'

#if defined(ENABLE_OVERLOADING)
data URIResponseGetHttpHeadersMethodInfo
instance (signature ~ (m Soup.MessageHeaders.MessageHeaders), MonadIO m, IsURIResponse a) => O.MethodInfo URIResponseGetHttpHeadersMethodInfo a signature where
    overloadedMethod = uRIResponseGetHttpHeaders

#endif

-- method URIResponse::get_mime_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "response"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "URIResponse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitURIResponse"
--                 , 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 "webkit_uri_response_get_mime_type" webkit_uri_response_get_mime_type :: 
    Ptr URIResponse ->                      -- response : TInterface (Name {namespace = "WebKit2WebExtension", name = "URIResponse"})
    IO CString

-- | /No description available in the introspection data./
uRIResponseGetMimeType ::
    (B.CallStack.HasCallStack, MonadIO m, IsURIResponse a) =>
    a
    -- ^ /@response@/: a t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse'
    -> m T.Text
    -- ^ __Returns:__ the MIME type of the t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse'
uRIResponseGetMimeType :: a -> m Text
uRIResponseGetMimeType response :: a
response = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URIResponse
response' <- a -> IO (Ptr URIResponse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
response
    CString
result <- Ptr URIResponse -> IO CString
webkit_uri_response_get_mime_type Ptr URIResponse
response'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "uRIResponseGetMimeType" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
response
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data URIResponseGetMimeTypeMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsURIResponse a) => O.MethodInfo URIResponseGetMimeTypeMethodInfo a signature where
    overloadedMethod = uRIResponseGetMimeType

#endif

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

foreign import ccall "webkit_uri_response_get_status_code" webkit_uri_response_get_status_code :: 
    Ptr URIResponse ->                      -- response : TInterface (Name {namespace = "WebKit2WebExtension", name = "URIResponse"})
    IO Word32

-- | Get the status code of the t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse' as returned by
-- the server. It will normally be a t'GI.Soup.Enums.KnownStatusCode', for
-- example 'GI.Soup.Enums.StatusOk', though the server can respond with any
-- unsigned integer.
uRIResponseGetStatusCode ::
    (B.CallStack.HasCallStack, MonadIO m, IsURIResponse a) =>
    a
    -- ^ /@response@/: a t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse'
    -> m Word32
    -- ^ __Returns:__ the status code of /@response@/
uRIResponseGetStatusCode :: a -> m Word32
uRIResponseGetStatusCode response :: a
response = IO Word32 -> m Word32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr URIResponse
response' <- a -> IO (Ptr URIResponse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
response
    Word32
result <- Ptr URIResponse -> IO Word32
webkit_uri_response_get_status_code Ptr URIResponse
response'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
response
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data URIResponseGetStatusCodeMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsURIResponse a) => O.MethodInfo URIResponseGetStatusCodeMethodInfo a signature where
    overloadedMethod = uRIResponseGetStatusCode

#endif

-- method URIResponse::get_suggested_filename
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "response"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "URIResponse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitURIResponse"
--                 , 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 "webkit_uri_response_get_suggested_filename" webkit_uri_response_get_suggested_filename :: 
    Ptr URIResponse ->                      -- response : TInterface (Name {namespace = "WebKit2WebExtension", name = "URIResponse"})
    IO CString

-- | Get the suggested filename for /@response@/, as specified by
-- the \'Content-Disposition\' HTTP header, or 'P.Nothing' if it\'s not
-- present.
uRIResponseGetSuggestedFilename ::
    (B.CallStack.HasCallStack, MonadIO m, IsURIResponse a) =>
    a
    -- ^ /@response@/: a t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse'
    -> m T.Text
    -- ^ __Returns:__ the suggested filename or 'P.Nothing' if
    --    the \'Content-Disposition\' HTTP header is not present.
uRIResponseGetSuggestedFilename :: a -> m Text
uRIResponseGetSuggestedFilename response :: a
response = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URIResponse
response' <- a -> IO (Ptr URIResponse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
response
    CString
result <- Ptr URIResponse -> IO CString
webkit_uri_response_get_suggested_filename Ptr URIResponse
response'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "uRIResponseGetSuggestedFilename" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
response
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data URIResponseGetSuggestedFilenameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsURIResponse a) => O.MethodInfo URIResponseGetSuggestedFilenameMethodInfo a signature where
    overloadedMethod = uRIResponseGetSuggestedFilename

#endif

-- method URIResponse::get_uri
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "response"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2WebExtension" , name = "URIResponse" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitURIResponse"
--                 , 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 "webkit_uri_response_get_uri" webkit_uri_response_get_uri :: 
    Ptr URIResponse ->                      -- response : TInterface (Name {namespace = "WebKit2WebExtension", name = "URIResponse"})
    IO CString

-- | /No description available in the introspection data./
uRIResponseGetUri ::
    (B.CallStack.HasCallStack, MonadIO m, IsURIResponse a) =>
    a
    -- ^ /@response@/: a t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse'
    -> m T.Text
    -- ^ __Returns:__ the uri of the t'GI.WebKit2WebExtension.Objects.URIResponse.URIResponse'
uRIResponseGetUri :: a -> m Text
uRIResponseGetUri response :: a
response = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr URIResponse
response' <- a -> IO (Ptr URIResponse)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
response
    CString
result <- Ptr URIResponse -> IO CString
webkit_uri_response_get_uri Ptr URIResponse
response'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "uRIResponseGetUri" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
response
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data URIResponseGetUriMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsURIResponse a) => O.MethodInfo URIResponseGetUriMethodInfo a signature where
    overloadedMethod = uRIResponseGetUri

#endif