{-# 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                 ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [authenticate]("GI.WebKit2.Objects.AuthenticationRequest#g:method:authenticate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [canSaveCredentials]("GI.WebKit2.Objects.AuthenticationRequest#g:method:canSaveCredentials"), [cancel]("GI.WebKit2.Objects.AuthenticationRequest#g:method:cancel"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isForProxy]("GI.WebKit2.Objects.AuthenticationRequest#g:method:isForProxy"), [isRetry]("GI.WebKit2.Objects.AuthenticationRequest#g:method:isRetry"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getHost]("GI.WebKit2.Objects.AuthenticationRequest#g:method:getHost"), [getPort]("GI.WebKit2.Objects.AuthenticationRequest#g:method:getPort"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getProposedCredential]("GI.WebKit2.Objects.AuthenticationRequest#g:method:getProposedCredential"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRealm]("GI.WebKit2.Objects.AuthenticationRequest#g:method:getRealm"), [getScheme]("GI.WebKit2.Objects.AuthenticationRequest#g:method:getScheme"), [getSecurityOrigin]("GI.WebKit2.Objects.AuthenticationRequest#g:method:getSecurityOrigin").
-- 
-- ==== Setters
-- [setCanSaveCredentials]("GI.WebKit2.Objects.AuthenticationRequest#g:method:setCanSaveCredentials"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setProposedCredential]("GI.WebKit2.Objects.AuthenticationRequest#g:method:setProposedCredential").

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


-- ** getSecurityOrigin #method:getSecurityOrigin#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestGetSecurityOriginMethodInfo,
#endif
    authenticationRequestGetSecurityOrigin  ,


-- ** isForProxy #method:isForProxy#

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


-- ** isRetry #method:isRetry#

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


-- ** setCanSaveCredentials #method:setCanSaveCredentials#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestSetCanSaveCredentialsMethodInfo,
#endif
    authenticationRequestSetCanSaveCredentials,


-- ** setProposedCredential #method:setProposedCredential#

#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestSetProposedCredentialMethodInfo,
#endif
    authenticationRequestSetProposedCredential,




 -- * Signals


-- ** authenticated #signal:authenticated#

    AuthenticationRequestAuthenticatedCallback,
#if defined(ENABLE_OVERLOADING)
    AuthenticationRequestAuthenticatedSignalInfo,
#endif
    C_AuthenticationRequestAuthenticatedCallback,
    afterAuthenticationRequestAuthenticated ,
    genClosure_AuthenticationRequestAuthenticated,
    mk_AuthenticationRequestAuthenticatedCallback,
    noAuthenticationRequestAuthenticatedCallback,
    onAuthenticationRequestAuthenticated    ,
    wrap_AuthenticationRequestAuthenticatedCallback,


-- ** 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.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Text as T
import qualified Data.ByteString.Char8 as B
import qualified Data.Map as Map
import qualified Foreign.Ptr as FP
import qualified GHC.OverloadedLabels as OL
import qualified GHC.Records as R

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

-- | Memory-managed wrapper type.
newtype AuthenticationRequest = AuthenticationRequest (SP.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)

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

foreign import ccall "webkit_authentication_request_get_type"
    c_webkit_authentication_request_get_type :: IO B.Types.GType

instance B.Types.TypedObject AuthenticationRequest where
    glibType :: IO GType
glibType = IO GType
c_webkit_authentication_request_get_type

instance B.Types.GObject AuthenticationRequest

-- | Type class for types which can be safely cast to `AuthenticationRequest`, for instance with `toAuthenticationRequest`.
class (SP.GObject o, O.IsDescendantOf AuthenticationRequest o) => IsAuthenticationRequest o
instance (SP.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 :: (MIO.MonadIO m, IsAuthenticationRequest o) => o -> m AuthenticationRequest
toAuthenticationRequest :: forall (m :: * -> *) o.
(MonadIO m, IsAuthenticationRequest o) =>
o -> m AuthenticationRequest
toAuthenticationRequest = IO AuthenticationRequest -> m AuthenticationRequest
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.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, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr AuthenticationRequest -> AuthenticationRequest
AuthenticationRequest

-- | Convert 'AuthenticationRequest' to and from 'Data.GI.Base.GValue.GValue'. See 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue (Maybe AuthenticationRequest) where
    gvalueGType_ :: IO GType
gvalueGType_ = IO GType
c_webkit_authentication_request_get_type
    gvalueSet_ :: Ptr GValue -> Maybe AuthenticationRequest -> IO ()
gvalueSet_ Ptr GValue
gv Maybe AuthenticationRequest
P.Nothing = Ptr GValue -> Ptr AuthenticationRequest -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv (Ptr AuthenticationRequest
forall a. Ptr a
FP.nullPtr :: FP.Ptr AuthenticationRequest)
    gvalueSet_ Ptr GValue
gv (P.Just AuthenticationRequest
obj) = AuthenticationRequest
-> (Ptr AuthenticationRequest -> IO ()) -> IO ()
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr AuthenticationRequest
obj (Ptr GValue -> Ptr AuthenticationRequest -> IO ()
forall a. GObject a => Ptr GValue -> Ptr a -> IO ()
B.GValue.set_object Ptr GValue
gv)
    gvalueGet_ :: Ptr GValue -> IO (Maybe AuthenticationRequest)
gvalueGet_ Ptr GValue
gv = do
        Ptr AuthenticationRequest
ptr <- Ptr GValue -> IO (Ptr AuthenticationRequest)
forall a. GObject a => Ptr GValue -> IO (Ptr a)
B.GValue.get_object Ptr GValue
gv :: IO (FP.Ptr AuthenticationRequest)
        if Ptr AuthenticationRequest
ptr Ptr AuthenticationRequest -> Ptr AuthenticationRequest -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr AuthenticationRequest
forall a. Ptr a
FP.nullPtr
        then AuthenticationRequest -> Maybe AuthenticationRequest
forall a. a -> Maybe a
P.Just (AuthenticationRequest -> Maybe AuthenticationRequest)
-> IO AuthenticationRequest -> IO (Maybe AuthenticationRequest)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (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
        else Maybe AuthenticationRequest -> IO (Maybe AuthenticationRequest)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe AuthenticationRequest
forall a. Maybe a
P.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 "getSecurityOrigin" o = AuthenticationRequestGetSecurityOriginMethodInfo
    ResolveAuthenticationRequestMethod "setCanSaveCredentials" o = AuthenticationRequestSetCanSaveCredentialsMethodInfo
    ResolveAuthenticationRequestMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAuthenticationRequestMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAuthenticationRequestMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAuthenticationRequestMethod "setProposedCredential" o = AuthenticationRequestSetProposedCredentialMethodInfo
    ResolveAuthenticationRequestMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveAuthenticationRequestMethod t AuthenticationRequest, O.OverloadedMethod 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

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

#endif

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

#endif

-- signal AuthenticationRequest::authenticated
-- | This signal is emitted when the user authentication request succeeded.
-- Applications handling their own credential storage should connect to
-- this signal to save the credentials.
-- 
-- /Since: 2.30/
type AuthenticationRequestAuthenticatedCallback =
    WebKit2.Credential.Credential
    -- ^ /@credential@/: the t'GI.WebKit2.Structs.Credential.Credential' accepted
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `AuthenticationRequestAuthenticatedCallback`@.
noAuthenticationRequestAuthenticatedCallback :: Maybe AuthenticationRequestAuthenticatedCallback
noAuthenticationRequestAuthenticatedCallback :: Maybe AuthenticationRequestAuthenticatedCallback
noAuthenticationRequestAuthenticatedCallback = Maybe AuthenticationRequestAuthenticatedCallback
forall a. Maybe a
Nothing

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

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

-- | Wrap the callback into a `GClosure`.
genClosure_AuthenticationRequestAuthenticated :: MonadIO m => AuthenticationRequestAuthenticatedCallback -> m (GClosure C_AuthenticationRequestAuthenticatedCallback)
genClosure_AuthenticationRequestAuthenticated :: forall (m :: * -> *).
MonadIO m =>
AuthenticationRequestAuthenticatedCallback
-> m (GClosure C_AuthenticationRequestAuthenticatedCallback)
genClosure_AuthenticationRequestAuthenticated AuthenticationRequestAuthenticatedCallback
cb = IO (GClosure C_AuthenticationRequestAuthenticatedCallback)
-> m (GClosure C_AuthenticationRequestAuthenticatedCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_AuthenticationRequestAuthenticatedCallback)
 -> m (GClosure C_AuthenticationRequestAuthenticatedCallback))
-> IO (GClosure C_AuthenticationRequestAuthenticatedCallback)
-> m (GClosure C_AuthenticationRequestAuthenticatedCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_AuthenticationRequestAuthenticatedCallback
cb' = AuthenticationRequestAuthenticatedCallback
-> C_AuthenticationRequestAuthenticatedCallback
wrap_AuthenticationRequestAuthenticatedCallback AuthenticationRequestAuthenticatedCallback
cb
    C_AuthenticationRequestAuthenticatedCallback
-> IO (FunPtr C_AuthenticationRequestAuthenticatedCallback)
mk_AuthenticationRequestAuthenticatedCallback C_AuthenticationRequestAuthenticatedCallback
cb' IO (FunPtr C_AuthenticationRequestAuthenticatedCallback)
-> (FunPtr C_AuthenticationRequestAuthenticatedCallback
    -> IO (GClosure C_AuthenticationRequestAuthenticatedCallback))
-> IO (GClosure C_AuthenticationRequestAuthenticatedCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_AuthenticationRequestAuthenticatedCallback
-> IO (GClosure C_AuthenticationRequestAuthenticatedCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `AuthenticationRequestAuthenticatedCallback` into a `C_AuthenticationRequestAuthenticatedCallback`.
wrap_AuthenticationRequestAuthenticatedCallback ::
    AuthenticationRequestAuthenticatedCallback ->
    C_AuthenticationRequestAuthenticatedCallback
wrap_AuthenticationRequestAuthenticatedCallback :: AuthenticationRequestAuthenticatedCallback
-> C_AuthenticationRequestAuthenticatedCallback
wrap_AuthenticationRequestAuthenticatedCallback AuthenticationRequestAuthenticatedCallback
_cb Ptr ()
_ Ptr Credential
credential Ptr ()
_ = do
    (ManagedPtr Credential -> Credential)
-> Ptr Credential
-> AuthenticationRequestAuthenticatedCallback
-> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
(ManagedPtr a -> a) -> Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient ManagedPtr Credential -> Credential
WebKit2.Credential.Credential Ptr Credential
credential (AuthenticationRequestAuthenticatedCallback -> IO ())
-> AuthenticationRequestAuthenticatedCallback -> IO ()
forall a b. (a -> b) -> a -> b
$ \Credential
credential' -> do
        AuthenticationRequestAuthenticatedCallback
_cb  Credential
credential'


-- | Connect a signal handler for the [authenticated](#signal:authenticated) 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 #authenticated callback
-- @
-- 
-- 
onAuthenticationRequestAuthenticated :: (IsAuthenticationRequest a, MonadIO m) => a -> AuthenticationRequestAuthenticatedCallback -> m SignalHandlerId
onAuthenticationRequestAuthenticated :: forall a (m :: * -> *).
(IsAuthenticationRequest a, MonadIO m) =>
a
-> AuthenticationRequestAuthenticatedCallback -> m SignalHandlerId
onAuthenticationRequestAuthenticated a
obj AuthenticationRequestAuthenticatedCallback
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_AuthenticationRequestAuthenticatedCallback
cb' = AuthenticationRequestAuthenticatedCallback
-> C_AuthenticationRequestAuthenticatedCallback
wrap_AuthenticationRequestAuthenticatedCallback AuthenticationRequestAuthenticatedCallback
cb
    FunPtr C_AuthenticationRequestAuthenticatedCallback
cb'' <- C_AuthenticationRequestAuthenticatedCallback
-> IO (FunPtr C_AuthenticationRequestAuthenticatedCallback)
mk_AuthenticationRequestAuthenticatedCallback C_AuthenticationRequestAuthenticatedCallback
cb'
    a
-> Text
-> FunPtr C_AuthenticationRequestAuthenticatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"authenticated" FunPtr C_AuthenticationRequestAuthenticatedCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [authenticated](#signal:authenticated) 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 #authenticated callback
-- @
-- 
-- 
afterAuthenticationRequestAuthenticated :: (IsAuthenticationRequest a, MonadIO m) => a -> AuthenticationRequestAuthenticatedCallback -> m SignalHandlerId
afterAuthenticationRequestAuthenticated :: forall a (m :: * -> *).
(IsAuthenticationRequest a, MonadIO m) =>
a
-> AuthenticationRequestAuthenticatedCallback -> m SignalHandlerId
afterAuthenticationRequestAuthenticated a
obj AuthenticationRequestAuthenticatedCallback
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_AuthenticationRequestAuthenticatedCallback
cb' = AuthenticationRequestAuthenticatedCallback
-> C_AuthenticationRequestAuthenticatedCallback
wrap_AuthenticationRequestAuthenticatedCallback AuthenticationRequestAuthenticatedCallback
cb
    FunPtr C_AuthenticationRequestAuthenticatedCallback
cb'' <- C_AuthenticationRequestAuthenticatedCallback
-> IO (FunPtr C_AuthenticationRequestAuthenticatedCallback)
mk_AuthenticationRequestAuthenticatedCallback C_AuthenticationRequestAuthenticatedCallback
cb'
    a
-> Text
-> FunPtr C_AuthenticationRequestAuthenticatedCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"authenticated" FunPtr C_AuthenticationRequestAuthenticatedCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestAuthenticatedSignalInfo
instance SignalInfo AuthenticationRequestAuthenticatedSignalInfo where
    type HaskellCallbackType AuthenticationRequestAuthenticatedSignalInfo = AuthenticationRequestAuthenticatedCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AuthenticationRequestAuthenticatedCallback cb
        cb'' <- mk_AuthenticationRequestAuthenticatedCallback cb'
        connectSignalFunPtr obj "authenticated" cb'' connectMode detail

#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 :: forall (m :: * -> *).
MonadIO m =>
IO () -> m (GClosure C_AuthenticationRequestCancelledCallback)
genClosure_AuthenticationRequestCancelled 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 IO ()
_cb Ptr ()
_ Ptr ()
_ = 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 :: forall a (m :: * -> *).
(IsAuthenticationRequest a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
onAuthenticationRequestCancelled a
obj 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 Text
"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 :: forall a (m :: * -> *).
(IsAuthenticationRequest a, MonadIO m) =>
a -> IO () -> m SignalHandlerId
afterAuthenticationRequestCancelled a
obj 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 Text
"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 = ('[ '("authenticated", AuthenticationRequestAuthenticatedSignalInfo), '("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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> Maybe Credential -> m ()
authenticationRequestAuthenticate a
request 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
        Maybe Credential
Nothing -> Ptr Credential -> IO (Ptr Credential)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Credential
forall a. Ptr a
nullPtr
        Just 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
-> AuthenticationRequestAuthenticatedCallback -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe Credential
credential AuthenticationRequestAuthenticatedCallback
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.OverloadedMethod AuthenticationRequestAuthenticateMethodInfo a signature where
    overloadedMethod = authenticationRequestAuthenticate

instance O.OverloadedMethodInfo AuthenticationRequestAuthenticateMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestAuthenticate",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v: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,
-- if private browsing is enabled, or if persistent credential storage has been
-- disabled in t'GI.WebKit2.Objects.WebsiteDataManager.WebsiteDataManager', unless credentials saving has been
-- explicitly enabled with 'GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestSetCanSaveCredentials'.
-- 
-- /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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> m Bool
authenticationRequestCanSaveCredentials 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
/= CInt
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.OverloadedMethod AuthenticationRequestCanSaveCredentialsMethodInfo a signature where
    overloadedMethod = authenticationRequestCanSaveCredentials

instance O.OverloadedMethodInfo AuthenticationRequestCanSaveCredentialsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestCanSaveCredentials",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v: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#g: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> m ()
authenticationRequestCancel 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.OverloadedMethod AuthenticationRequestCancelMethodInfo a signature where
    overloadedMethod = authenticationRequestCancel

instance O.OverloadedMethodInfo AuthenticationRequestCancelMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestCancel",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> m Text
authenticationRequestGetHost 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 Text
"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.OverloadedMethod AuthenticationRequestGetHostMethodInfo a signature where
    overloadedMethod = authenticationRequestGetHost

instance O.OverloadedMethodInfo AuthenticationRequestGetHostMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestGetHost",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> m Word32
authenticationRequestGetPort 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.OverloadedMethod AuthenticationRequestGetPortMethodInfo a signature where
    overloadedMethod = authenticationRequestGetPort

instance O.OverloadedMethodInfo AuthenticationRequestGetPortMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestGetPort",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> m Credential
authenticationRequestGetProposedCredential 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 Text
"authenticationRequestGetProposedCredential" Ptr Credential
result
    Credential
result' <- ((ManagedPtr Credential -> Credential)
-> Ptr Credential -> IO Credential
forall a.
(HasCallStack, GBoxed 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.OverloadedMethod AuthenticationRequestGetProposedCredentialMethodInfo a signature where
    overloadedMethod = authenticationRequestGetProposedCredential

instance O.OverloadedMethodInfo AuthenticationRequestGetProposedCredentialMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestGetProposedCredential",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> m Text
authenticationRequestGetRealm 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 Text
"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.OverloadedMethod AuthenticationRequestGetRealmMethodInfo a signature where
    overloadedMethod = authenticationRequestGetRealm

instance O.OverloadedMethodInfo AuthenticationRequestGetRealmMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestGetRealm",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> m AuthenticationScheme
authenticationRequestGetScheme 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.OverloadedMethod AuthenticationRequestGetSchemeMethodInfo a signature where
    overloadedMethod = authenticationRequestGetScheme

instance O.OverloadedMethodInfo AuthenticationRequestGetSchemeMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestGetScheme",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v:authenticationRequestGetScheme"
        }


#endif

-- method AuthenticationRequest::get_security_origin
-- 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 = "SecurityOrigin" })
-- throws : False
-- Skip return : False

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

-- | Get the t'GI.WebKit2.Structs.SecurityOrigin.SecurityOrigin' that this authentication challenge is applicable to.
-- 
-- /Since: 2.30/
authenticationRequestGetSecurityOrigin ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> m WebKit2.SecurityOrigin.SecurityOrigin
    -- ^ __Returns:__ a newly created t'GI.WebKit2.Structs.SecurityOrigin.SecurityOrigin'.
authenticationRequestGetSecurityOrigin :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> m SecurityOrigin
authenticationRequestGetSecurityOrigin a
request = IO SecurityOrigin -> m SecurityOrigin
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SecurityOrigin -> m SecurityOrigin)
-> IO SecurityOrigin -> m SecurityOrigin
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 SecurityOrigin
result <- Ptr AuthenticationRequest -> IO (Ptr SecurityOrigin)
webkit_authentication_request_get_security_origin Ptr AuthenticationRequest
request'
    Text -> Ptr SecurityOrigin -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"authenticationRequestGetSecurityOrigin" Ptr SecurityOrigin
result
    SecurityOrigin
result' <- ((ManagedPtr SecurityOrigin -> SecurityOrigin)
-> Ptr SecurityOrigin -> IO SecurityOrigin
forall a.
(HasCallStack, GBoxed a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr SecurityOrigin -> SecurityOrigin
WebKit2.SecurityOrigin.SecurityOrigin) Ptr SecurityOrigin
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    SecurityOrigin -> IO SecurityOrigin
forall (m :: * -> *) a. Monad m => a -> m a
return SecurityOrigin
result'

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestGetSecurityOriginMethodInfo
instance (signature ~ (m WebKit2.SecurityOrigin.SecurityOrigin), MonadIO m, IsAuthenticationRequest a) => O.OverloadedMethod AuthenticationRequestGetSecurityOriginMethodInfo a signature where
    overloadedMethod = authenticationRequestGetSecurityOrigin

instance O.OverloadedMethodInfo AuthenticationRequestGetSecurityOriginMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestGetSecurityOrigin",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v:authenticationRequestGetSecurityOrigin"
        }


#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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> m Bool
authenticationRequestIsForProxy 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
/= CInt
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.OverloadedMethod AuthenticationRequestIsForProxyMethodInfo a signature where
    overloadedMethod = authenticationRequestIsForProxy

instance O.OverloadedMethodInfo AuthenticationRequestIsForProxyMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestIsForProxy",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v: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 :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> m Bool
authenticationRequestIsRetry 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
/= CInt
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.OverloadedMethod AuthenticationRequestIsRetryMethodInfo a signature where
    overloadedMethod = authenticationRequestIsRetry

instance O.OverloadedMethodInfo AuthenticationRequestIsRetryMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestIsRetry",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v:authenticationRequestIsRetry"
        }


#endif

-- method AuthenticationRequest::set_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
--           }
--       , Arg
--           { argCName = "enabled"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to set" , 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_set_can_save_credentials" webkit_authentication_request_set_can_save_credentials :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    CInt ->                                 -- enabled : TBasicType TBoolean
    IO ()

-- | Set whether the authentication method associated with /@request@/
-- should allow the storage of credentials.
-- This should be used by applications handling their own credentials
-- storage to indicate that it should be supported even when internal
-- credential storage is disabled or unsupported.
-- Note that storing of credentials will not be allowed on ephemeral
-- sessions in any case.
-- 
-- /Since: 2.30/
authenticationRequestSetCanSaveCredentials ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> Bool
    -- ^ /@enabled@/: value to set
    -> m ()
authenticationRequestSetCanSaveCredentials :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> Bool -> m ()
authenticationRequestSetCanSaveCredentials a
request Bool
enabled = 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
    let enabled' :: CInt
enabled' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
enabled
    Ptr AuthenticationRequest -> CInt -> IO ()
webkit_authentication_request_set_can_save_credentials Ptr AuthenticationRequest
request' CInt
enabled'
    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 AuthenticationRequestSetCanSaveCredentialsMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsAuthenticationRequest a) => O.OverloadedMethod AuthenticationRequestSetCanSaveCredentialsMethodInfo a signature where
    overloadedMethod = authenticationRequestSetCanSaveCredentials

instance O.OverloadedMethodInfo AuthenticationRequestSetCanSaveCredentialsMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestSetCanSaveCredentials",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v:authenticationRequestSetCanSaveCredentials"
        }


#endif

-- method AuthenticationRequest::set_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
--           }
--       , Arg
--           { argCName = "credential"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Credential" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , 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_set_proposed_credential" webkit_authentication_request_set_proposed_credential :: 
    Ptr AuthenticationRequest ->            -- request : TInterface (Name {namespace = "WebKit2", name = "AuthenticationRequest"})
    Ptr WebKit2.Credential.Credential ->    -- credential : TInterface (Name {namespace = "WebKit2", name = "Credential"})
    IO ()

-- | Set the t'GI.WebKit2.Structs.Credential.Credential' of the proposed authentication challenge that was
-- stored from a previous session. This should only be used by applications handling
-- their own credential storage. (When using the default WebKit credential storage,
-- 'GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestGetProposedCredential' already contains previously-stored
-- credentials.)
-- Passing a 'P.Nothing' /@credential@/ will clear the proposed credential.
-- 
-- /Since: 2.30/
authenticationRequestSetProposedCredential ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
    a
    -- ^ /@request@/: a t'GI.WebKit2.Objects.AuthenticationRequest.AuthenticationRequest'
    -> WebKit2.Credential.Credential
    -- ^ /@credential@/: a t'GI.WebKit2.Structs.Credential.Credential', or 'P.Nothing'
    -> m ()
authenticationRequestSetProposedCredential :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthenticationRequest a) =>
a -> Credential -> m ()
authenticationRequestSetProposedCredential a
request 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
credential' <- Credential -> IO (Ptr Credential)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Credential
credential
    Ptr AuthenticationRequest -> Ptr Credential -> IO ()
webkit_authentication_request_set_proposed_credential Ptr AuthenticationRequest
request' Ptr Credential
credential'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
request
    AuthenticationRequestAuthenticatedCallback
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Credential
credential
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AuthenticationRequestSetProposedCredentialMethodInfo
instance (signature ~ (WebKit2.Credential.Credential -> m ()), MonadIO m, IsAuthenticationRequest a) => O.OverloadedMethod AuthenticationRequestSetProposedCredentialMethodInfo a signature where
    overloadedMethod = authenticationRequestSetProposedCredential

instance O.OverloadedMethodInfo AuthenticationRequestSetProposedCredentialMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.WebKit2.Objects.AuthenticationRequest.authenticationRequestSetProposedCredential",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-webkit2-4.0.27/docs/GI-WebKit2-Objects-AuthenticationRequest.html#v:authenticationRequestSetProposedCredential"
        }


#endif