{-# 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.WebKit2.Objects.AuthenticationRequest
    ( 

-- * Exported types
    AuthenticationRequest(..)               ,
    IsAuthenticationRequest                 ,
    toAuthenticationRequest                 ,
    noAuthenticationRequest                 ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveAuthenticationRequestMethod      ,
#endif


-- ** authenticate #method:authenticate#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestAuthenticateMethodInfo,
#endif
    authenticationRequestAuthenticate       ,


-- ** canSaveCredentials #method:canSaveCredentials#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestCanSaveCredentialsMethodInfo,
#endif
    authenticationRequestCanSaveCredentials ,


-- ** cancel #method:cancel#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestCancelMethodInfo   ,
#endif
    authenticationRequestCancel             ,


-- ** getHost #method:getHost#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestGetHostMethodInfo  ,
#endif
    authenticationRequestGetHost            ,


-- ** getPort #method:getPort#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestGetPortMethodInfo  ,
#endif
    authenticationRequestGetPort            ,


-- ** getProposedCredential #method:getProposedCredential#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestGetProposedCredentialMethodInfo,
#endif
    authenticationRequestGetProposedCredential,


-- ** getRealm #method:getRealm#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestGetRealmMethodInfo ,
#endif
    authenticationRequestGetRealm           ,


-- ** getScheme #method:getScheme#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestGetSchemeMethodInfo,
#endif
    authenticationRequestGetScheme          ,


-- ** isForProxy #method:isForProxy#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestIsForProxyMethodInfo,
#endif
    authenticationRequestIsForProxy         ,


-- ** isRetry #method:isRetry#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestIsRetryMethodInfo  ,
#endif
    authenticationRequestIsRetry            ,




 -- * Signals
-- ** cancelled #signal:cancelled#

    AuthenticationRequestCancelledCallback  ,
#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestCancelledSignalInfo,
#endif
    C_AuthenticationRequestCancelledCallback,
    afterAuthenticationRequestCancelled     ,
    genClosure_AuthenticationRequestCancelled,
    mk_AuthenticationRequestCancelledCallback,
    noAuthenticationRequestCancelledCallback,
    onAuthenticationRequestCancelled        ,
    wrap_AuthenticationRequestCancelledCallback,




    ) 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 {-# SOURCE #-} qualified GI.WebKit2.Enums as WebKit2.Enums
import {-# SOURCE #-} qualified GI.WebKit2.Structs.Credential as WebKit2.Credential

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

instance GObject AuthenticationRequest where
    gobjectType :: IO GType
gobjectType = IO GType
c_webkit_authentication_request_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `AuthenticationRequest`.
noAuthenticationRequest :: Maybe AuthenticationRequest
noAuthenticationRequest :: Maybe AuthenticationRequest
noAuthenticationRequest = Maybe AuthenticationRequest
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveAuthenticationRequestMethod (t :: Symbol) (o :: *) :: * where
    ResolveAuthenticationRequestMethod "authenticate" o = AuthenticationRequestAuthenticateMethodInfo
    ResolveAuthenticationRequestMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAuthenticationRequestMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAuthenticationRequestMethod "canSaveCredentials" o = AuthenticationRequestCanSaveCredentialsMethodInfo
    ResolveAuthenticationRequestMethod "cancel" o = AuthenticationRequestCancelMethodInfo
    ResolveAuthenticationRequestMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAuthenticationRequestMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAuthenticationRequestMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAuthenticationRequestMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAuthenticationRequestMethod "isForProxy" o = AuthenticationRequestIsForProxyMethodInfo
    ResolveAuthenticationRequestMethod "isRetry" o = AuthenticationRequestIsRetryMethodInfo
    ResolveAuthenticationRequestMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAuthenticationRequestMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAuthenticationRequestMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAuthenticationRequestMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAuthenticationRequestMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAuthenticationRequestMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAuthenticationRequestMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAuthenticationRequestMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAuthenticationRequestMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAuthenticationRequestMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAuthenticationRequestMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAuthenticationRequestMethod "getHost" o = AuthenticationRequestGetHostMethodInfo
    ResolveAuthenticationRequestMethod "getPort" o = AuthenticationRequestGetPortMethodInfo
    ResolveAuthenticationRequestMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAuthenticationRequestMethod "getProposedCredential" o = AuthenticationRequestGetProposedCredentialMethodInfo
    ResolveAuthenticationRequestMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAuthenticationRequestMethod "getRealm" o = AuthenticationRequestGetRealmMethodInfo
    ResolveAuthenticationRequestMethod "getScheme" o = AuthenticationRequestGetSchemeMethodInfo
    ResolveAuthenticationRequestMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAuthenticationRequestMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAuthenticationRequestMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAuthenticationRequestMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal AuthenticationRequest::cancelled
-- | This signal is emitted when the user authentication request is
-- cancelled. It allows the application to dismiss its authentication
-- dialog in case of page load failure for example.
-- 
-- /Since: 2.2/
type AuthenticationRequestCancelledCallback =
    IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `AuthenticationRequestCancelledCallback`@.
noAuthenticationRequestCancelledCallback :: Maybe AuthenticationRequestCancelledCallback
noAuthenticationRequestCancelledCallback :: Maybe (IO ())
noAuthenticationRequestCancelledCallback = Maybe (IO ())
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_AuthenticationRequestCancelledCallback =
    Ptr () ->                               -- object
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_AuthenticationRequestCancelledCallback`.
foreign import ccall "wrapper"
    mk_AuthenticationRequestCancelledCallback :: C_AuthenticationRequestCancelledCallback -> IO (FunPtr C_AuthenticationRequestCancelledCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_AuthenticationRequestCancelled :: MonadIO m => AuthenticationRequestCancelledCallback -> m (GClosure C_AuthenticationRequestCancelledCallback)
genClosure_AuthenticationRequestCancelled :: IO () -> m (GClosure C_AuthenticationRequestCancelledCallback)
genClosure_AuthenticationRequestCancelled cb :: IO ()
cb = IO (GClosure C_AuthenticationRequestCancelledCallback)
-> m (GClosure C_AuthenticationRequestCancelledCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_AuthenticationRequestCancelledCallback)
 -> m (GClosure C_AuthenticationRequestCancelledCallback))
-> IO (GClosure C_AuthenticationRequestCancelledCallback)
-> m (GClosure C_AuthenticationRequestCancelledCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_AuthenticationRequestCancelledCallback
cb' = IO () -> C_AuthenticationRequestCancelledCallback
wrap_AuthenticationRequestCancelledCallback IO ()
cb
    C_AuthenticationRequestCancelledCallback
-> IO (FunPtr C_AuthenticationRequestCancelledCallback)
mk_AuthenticationRequestCancelledCallback C_AuthenticationRequestCancelledCallback
cb' IO (FunPtr C_AuthenticationRequestCancelledCallback)
-> (FunPtr C_AuthenticationRequestCancelledCallback
    -> IO (GClosure C_AuthenticationRequestCancelledCallback))
-> IO (GClosure C_AuthenticationRequestCancelledCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_AuthenticationRequestCancelledCallback
-> IO (GClosure C_AuthenticationRequestCancelledCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `AuthenticationRequestCancelledCallback` into a `C_AuthenticationRequestCancelledCallback`.
wrap_AuthenticationRequestCancelledCallback ::
    AuthenticationRequestCancelledCallback ->
    C_AuthenticationRequestCancelledCallback
wrap_AuthenticationRequestCancelledCallback :: IO () -> C_AuthenticationRequestCancelledCallback
wrap_AuthenticationRequestCancelledCallback _cb :: IO ()
_cb _ _ = do
    IO ()
_cb 


-- | Connect a signal handler for the [cancelled](#signal:cancelled) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' authenticationRequest #cancelled callback
-- @
-- 
-- 
onAuthenticationRequestCancelled :: (IsAuthenticationRequest a, MonadIO m) => a -> AuthenticationRequestCancelledCallback -> m SignalHandlerId
onAuthenticationRequestCancelled :: a -> IO () -> m SignalHandlerId
onAuthenticationRequestCancelled obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_AuthenticationRequestCancelledCallback
cb' = IO () -> C_AuthenticationRequestCancelledCallback
wrap_AuthenticationRequestCancelledCallback IO ()
cb
    FunPtr C_AuthenticationRequestCancelledCallback
cb'' <- C_AuthenticationRequestCancelledCallback
-> IO (FunPtr C_AuthenticationRequestCancelledCallback)
mk_AuthenticationRequestCancelledCallback C_AuthenticationRequestCancelledCallback
cb'
    a
-> Text
-> FunPtr C_AuthenticationRequestCancelledCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "cancelled" FunPtr C_AuthenticationRequestCancelledCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [cancelled](#signal:cancelled) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' authenticationRequest #cancelled callback
-- @
-- 
-- 
afterAuthenticationRequestCancelled :: (IsAuthenticationRequest a, MonadIO m) => a -> AuthenticationRequestCancelledCallback -> m SignalHandlerId
afterAuthenticationRequestCancelled :: a -> IO () -> m SignalHandlerId
afterAuthenticationRequestCancelled obj :: a
obj cb :: IO ()
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_AuthenticationRequestCancelledCallback
cb' = IO () -> C_AuthenticationRequestCancelledCallback
wrap_AuthenticationRequestCancelledCallback IO ()
cb
    FunPtr C_AuthenticationRequestCancelledCallback
cb'' <- C_AuthenticationRequestCancelledCallback
-> IO (FunPtr C_AuthenticationRequestCancelledCallback)
mk_AuthenticationRequestCancelledCallback C_AuthenticationRequestCancelledCallback
cb'
    a
-> Text
-> FunPtr C_AuthenticationRequestCancelledCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "cancelled" FunPtr C_AuthenticationRequestCancelledCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestCancelledSignalInfo
instance SignalInfo AuthenticationRequestCancelledSignalInfo where
    type HaskellCallbackType AuthenticationRequestCancelledSignalInfo = AuthenticationRequestCancelledCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AuthenticationRequestCancelledCallback cb
        cb'' <- mk_AuthenticationRequestCancelledCallback cb'
        connectSignalFunPtr obj "cancelled" cb'' connectMode detail

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method AuthenticationRequest::authenticate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "request"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "AuthenticationRequest" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitAuthenticationRequest"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "credential"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Credential" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitCredential, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_authentication_request_authenticate" webkit_authentication_request_authenticate :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    Ptr WebKit2.Credential.Credential ->    -- credential : TInterface (Name {namespace = "WebKit2", name = "Credential"})
    IO ()

-- | Authenticate the t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest' using the t'GI.WebKit2.Structs.Credential.Credential'
-- supplied. To continue without credentials, pass 'P.Nothing' as /@credential@/.
-- 
-- /Since: 2.2/
authenticationRequestAuthenticate ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> Maybe (WebKit2.Credential.Credential)
    -- ^ /@credential@/: A t'GI.WebKit2.Structs.Credential.Credential', or 'P.Nothing'
    -> m ()
authenticationRequestAuthenticate :: a -> Maybe Credential -> m ()
authenticationRequestAuthenticate request :: a
request credential :: Maybe Credential
credential = 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 AuthenticationRequest
request' <- a -> IO (Ptr AuthenticationRequest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    Ptr Credential
maybeCredential <- case Maybe Credential
credential of
        Nothing -> Ptr Credential -> IO (Ptr Credential)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Credential
forall a. Ptr a
nullPtr
        Just jCredential :: Credential
jCredential -> do
            Ptr Credential
jCredential' <- Credential -> IO (Ptr Credential)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Credential
jCredential
            Ptr Credential -> IO (Ptr Credential)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Credential
jCredential'
    Ptr AuthenticationRequest -> Ptr Credential -> IO ()
webkit_authentication_request_authenticate Ptr AuthenticationRequest
request' Ptr Credential
maybeCredential
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Maybe Credential -> (Credential -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Credential
credential Credential -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestAuthenticateMethodInfo
instance (signature ~ (Maybe (WebKit2.Credential.Credential) -> m ()), MonadIO m, IsAuthenticationRequest a) => O.MethodInfo AuthenticationRequestAuthenticateMethodInfo a signature where
    overloadedMethod = authenticationRequestAuthenticate

#endif

-- method AuthenticationRequest::can_save_credentials
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "request"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "AuthenticationRequest" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitAuthenticationRequest"
--                 , 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 "webkit_authentication_request_can_save_credentials" webkit_authentication_request_can_save_credentials :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    IO CInt

-- | Determine whether the authentication method associated with this
-- t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest' should allow the storage of credentials.
-- This will return 'P.False' if WebKit doesn\'t support credential storing
-- or if private browsing is enabled.
-- 
-- /Since: 2.2/
authenticationRequestCanSaveCredentials ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if WebKit can store credentials or 'P.False' otherwise.
authenticationRequestCanSaveCredentials :: a -> m Bool
authenticationRequestCanSaveCredentials request :: a
request = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AuthenticationRequest
request' <- a -> IO (Ptr AuthenticationRequest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    CInt
result <- Ptr AuthenticationRequest -> IO CInt
webkit_authentication_request_can_save_credentials Ptr AuthenticationRequest
request'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestCanSaveCredentialsMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAuthenticationRequest a) => O.MethodInfo AuthenticationRequestCanSaveCredentialsMethodInfo a signature where
    overloadedMethod = authenticationRequestCanSaveCredentials

#endif

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

foreign import ccall "webkit_authentication_request_cancel" webkit_authentication_request_cancel :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    IO ()

-- | Cancel the authentication challenge. This will also cancel the page loading and result in a
-- [loadFailed]("GI.WebKit2.Objects.WebView#signal:loadFailed") signal with a t'GI.WebKit2.Enums.NetworkError' of type 'GI.WebKit2.Enums.NetworkErrorCancelled' being emitted.
-- 
-- /Since: 2.2/
authenticationRequestCancel ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> m ()
authenticationRequestCancel :: a -> m ()
authenticationRequestCancel request :: a
request = 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 AuthenticationRequest
request' <- a -> IO (Ptr AuthenticationRequest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    Ptr AuthenticationRequest -> IO ()
webkit_authentication_request_cancel Ptr AuthenticationRequest
request'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestCancelMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAuthenticationRequest a) => O.MethodInfo AuthenticationRequestCancelMethodInfo a signature where
    overloadedMethod = authenticationRequestCancel

#endif

-- method AuthenticationRequest::get_host
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "request"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "AuthenticationRequest" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitAuthenticationRequest"
--                 , 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_authentication_request_get_host" webkit_authentication_request_get_host :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    IO CString

-- | Get the host that this authentication challenge is applicable to.
-- 
-- /Since: 2.2/
authenticationRequestGetHost ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> m T.Text
    -- ^ __Returns:__ The host of /@request@/.
authenticationRequestGetHost :: a -> m Text
authenticationRequestGetHost request :: a
request = 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 AuthenticationRequest
request' <- a -> IO (Ptr AuthenticationRequest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    CString
result <- Ptr AuthenticationRequest -> IO CString
webkit_authentication_request_get_host Ptr AuthenticationRequest
request'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "authenticationRequestGetHost" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestGetHostMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAuthenticationRequest a) => O.MethodInfo AuthenticationRequestGetHostMethodInfo a signature where
    overloadedMethod = authenticationRequestGetHost

#endif

-- method AuthenticationRequest::get_port
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "request"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "AuthenticationRequest" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitAuthenticationRequest"
--                 , 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_authentication_request_get_port" webkit_authentication_request_get_port :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    IO Word32

-- | Get the port that this authentication challenge is applicable to.
-- 
-- /Since: 2.2/
authenticationRequestGetPort ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> m Word32
    -- ^ __Returns:__ The port of /@request@/.
authenticationRequestGetPort :: a -> m Word32
authenticationRequestGetPort request :: a
request = 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 AuthenticationRequest
request' <- a -> IO (Ptr AuthenticationRequest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    Word32
result <- Ptr AuthenticationRequest -> IO Word32
webkit_authentication_request_get_port Ptr AuthenticationRequest
request'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestGetPortMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsAuthenticationRequest a) => O.MethodInfo AuthenticationRequestGetPortMethodInfo a signature where
    overloadedMethod = authenticationRequestGetPort

#endif

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

foreign import ccall "webkit_authentication_request_get_proposed_credential" webkit_authentication_request_get_proposed_credential :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    IO (Ptr WebKit2.Credential.Credential)

-- | Get the t'GI.WebKit2.Structs.Credential.Credential' of the proposed authentication challenge that was
-- stored from a previous session. The client can use this directly for
-- authentication or construct their own t'GI.WebKit2.Structs.Credential.Credential'.
-- 
-- /Since: 2.2/
authenticationRequestGetProposedCredential ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> m WebKit2.Credential.Credential
    -- ^ __Returns:__ A t'GI.WebKit2.Structs.Credential.Credential' encapsulating credential details
    -- or 'P.Nothing' if there is no stored credential.
authenticationRequestGetProposedCredential :: a -> m Credential
authenticationRequestGetProposedCredential request :: a
request = IO Credential -> m Credential
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Credential -> m Credential) -> IO Credential -> m Credential
forall a b. (a -> b) -> a -> b
$ do
    Ptr AuthenticationRequest
request' <- a -> IO (Ptr AuthenticationRequest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    Ptr Credential
result <- Ptr AuthenticationRequest -> IO (Ptr Credential)
webkit_authentication_request_get_proposed_credential Ptr AuthenticationRequest
request'
    Text -> Ptr Credential -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "authenticationRequestGetProposedCredential" Ptr Credential
result
    Credential
result' <- ((ManagedPtr Credential -> Credential)
-> Ptr Credential -> IO Credential
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Credential -> Credential
WebKit2.Credential.Credential) Ptr Credential
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Credential -> IO Credential
forall (m :: * -> *) a. Monad m => a -> m a
return Credential
result'

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestGetProposedCredentialMethodInfo
instance (signature ~ (m WebKit2.Credential.Credential), MonadIO m, IsAuthenticationRequest a) => O.MethodInfo AuthenticationRequestGetProposedCredentialMethodInfo a signature where
    overloadedMethod = authenticationRequestGetProposedCredential

#endif

-- method AuthenticationRequest::get_realm
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "request"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "AuthenticationRequest" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitAuthenticationRequest"
--                 , 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_authentication_request_get_realm" webkit_authentication_request_get_realm :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    IO CString

-- | Get the realm that this authentication challenge is applicable to.
-- 
-- /Since: 2.2/
authenticationRequestGetRealm ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> m T.Text
    -- ^ __Returns:__ The realm of /@request@/.
authenticationRequestGetRealm :: a -> m Text
authenticationRequestGetRealm request :: a
request = 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 AuthenticationRequest
request' <- a -> IO (Ptr AuthenticationRequest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    CString
result <- Ptr AuthenticationRequest -> IO CString
webkit_authentication_request_get_realm Ptr AuthenticationRequest
request'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "authenticationRequestGetRealm" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestGetRealmMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAuthenticationRequest a) => O.MethodInfo AuthenticationRequestGetRealmMethodInfo a signature where
    overloadedMethod = authenticationRequestGetRealm

#endif

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

foreign import ccall "webkit_authentication_request_get_scheme" webkit_authentication_request_get_scheme :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    IO CUInt

-- | Get the authentication scheme of the authentication challenge.
-- 
-- /Since: 2.2/
authenticationRequestGetScheme ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> m WebKit2.Enums.AuthenticationScheme
    -- ^ __Returns:__ The t'GI.WebKit2.Enums.AuthenticationScheme' of /@request@/.
authenticationRequestGetScheme :: a -> m AuthenticationScheme
authenticationRequestGetScheme request :: a
request = IO AuthenticationScheme -> m AuthenticationScheme
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO AuthenticationScheme -> m AuthenticationScheme)
-> IO AuthenticationScheme -> m AuthenticationScheme
forall a b. (a -> b) -> a -> b
$ do
    Ptr AuthenticationRequest
request' <- a -> IO (Ptr AuthenticationRequest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    CUInt
result <- Ptr AuthenticationRequest -> IO CUInt
webkit_authentication_request_get_scheme Ptr AuthenticationRequest
request'
    let result' :: AuthenticationScheme
result' = (Int -> AuthenticationScheme
forall a. Enum a => Int -> a
toEnum (Int -> AuthenticationScheme)
-> (CUInt -> Int) -> CUInt -> AuthenticationScheme
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    AuthenticationScheme -> IO AuthenticationScheme
forall (m :: * -> *) a. Monad m => a -> m a
return AuthenticationScheme
result'

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestGetSchemeMethodInfo
instance (signature ~ (m WebKit2.Enums.AuthenticationScheme), MonadIO m, IsAuthenticationRequest a) => O.MethodInfo AuthenticationRequestGetSchemeMethodInfo a signature where
    overloadedMethod = authenticationRequestGetScheme

#endif

-- method AuthenticationRequest::is_for_proxy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "request"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "AuthenticationRequest" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitAuthenticationRequest"
--                 , 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 "webkit_authentication_request_is_for_proxy" webkit_authentication_request_is_for_proxy :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    IO CInt

-- | Determine whether the authentication challenge is associated with a proxy server rather than an \"origin\" server.
-- 
-- /Since: 2.2/
authenticationRequestIsForProxy ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if authentication is for a proxy or 'P.False' otherwise.
authenticationRequestIsForProxy :: a -> m Bool
authenticationRequestIsForProxy request :: a
request = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AuthenticationRequest
request' <- a -> IO (Ptr AuthenticationRequest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    CInt
result <- Ptr AuthenticationRequest -> IO CInt
webkit_authentication_request_is_for_proxy Ptr AuthenticationRequest
request'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestIsForProxyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAuthenticationRequest a) => O.MethodInfo AuthenticationRequestIsForProxyMethodInfo a signature where
    overloadedMethod = authenticationRequestIsForProxy

#endif

-- method AuthenticationRequest::is_retry
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "request"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "AuthenticationRequest" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitAuthenticationRequest"
--                 , 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 "webkit_authentication_request_is_retry" webkit_authentication_request_is_retry :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    IO CInt

-- | Determine whether this this is a first attempt or a retry for this authentication challenge.
-- 
-- /Since: 2.2/
authenticationRequestIsRetry ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if authentication attempt is a retry or 'P.False' otherwise.
authenticationRequestIsRetry :: a -> m Bool
authenticationRequestIsRetry request :: a
request = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr AuthenticationRequest
request' <- a -> IO (Ptr AuthenticationRequest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
request
    CInt
result <- Ptr AuthenticationRequest -> IO CInt
webkit_authentication_request_is_retry Ptr AuthenticationRequest
request'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestIsRetryMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAuthenticationRequest a) => O.MethodInfo AuthenticationRequestIsRetryMethodInfo a signature where
    overloadedMethod = authenticationRequestIsRetry

#endif