{-# LANGUAGE ImplicitParams, RankNTypes, TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- 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.Soup.Objects.AuthManager
    ( 

-- * Exported types
    AuthManager(..)                         ,
    IsAuthManager                           ,
    toAuthManager                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [addFeature]("GI.Soup.Interfaces.SessionFeature#g:method:addFeature"), [attach]("GI.Soup.Interfaces.SessionFeature#g:method:attach"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [clearCachedCredentials]("GI.Soup.Objects.AuthManager#g:method:clearCachedCredentials"), [detach]("GI.Soup.Interfaces.SessionFeature#g:method:detach"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasFeature]("GI.Soup.Interfaces.SessionFeature#g:method:hasFeature"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [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"), [removeFeature]("GI.Soup.Interfaces.SessionFeature#g:method:removeFeature"), [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"), [useAuth]("GI.Soup.Objects.AuthManager#g:method:useAuth"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveAuthManagerMethod                ,
#endif

-- ** clearCachedCredentials #method:clearCachedCredentials#

#if defined(ENABLE_OVERLOADING)
    AuthManagerClearCachedCredentialsMethodInfo,
#endif
    authManagerClearCachedCredentials       ,


-- ** useAuth #method:useAuth#

#if defined(ENABLE_OVERLOADING)
    AuthManagerUseAuthMethodInfo            ,
#endif
    authManagerUseAuth                      ,




 -- * Signals


-- ** authenticate #signal:authenticate#

    AuthManagerAuthenticateCallback         ,
#if defined(ENABLE_OVERLOADING)
    AuthManagerAuthenticateSignalInfo       ,
#endif
    afterAuthManagerAuthenticate            ,
    onAuthManagerAuthenticate               ,




    ) 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.Coerce as Coerce
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.Soup.Interfaces.SessionFeature as Soup.SessionFeature
import {-# SOURCE #-} qualified GI.Soup.Objects.Auth as Soup.Auth
import {-# SOURCE #-} qualified GI.Soup.Objects.Message as Soup.Message
import {-# SOURCE #-} qualified GI.Soup.Structs.URI as Soup.URI

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

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

foreign import ccall "soup_auth_manager_get_type"
    c_soup_auth_manager_get_type :: IO B.Types.GType

instance B.Types.TypedObject AuthManager where
    glibType :: IO GType
glibType = IO GType
c_soup_auth_manager_get_type

instance B.Types.GObject AuthManager

-- | Type class for types which can be safely cast to `AuthManager`, for instance with `toAuthManager`.
class (SP.GObject o, O.IsDescendantOf AuthManager o) => IsAuthManager o
instance (SP.GObject o, O.IsDescendantOf AuthManager o) => IsAuthManager o

instance O.HasParentTypes AuthManager
type instance O.ParentTypes AuthManager = '[GObject.Object.Object, Soup.SessionFeature.SessionFeature]

-- | Cast to `AuthManager`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toAuthManager :: (MIO.MonadIO m, IsAuthManager o) => o -> m AuthManager
toAuthManager :: forall (m :: * -> *) o.
(MonadIO m, IsAuthManager o) =>
o -> m AuthManager
toAuthManager = IO AuthManager -> m AuthManager
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO AuthManager -> m AuthManager)
-> (o -> IO AuthManager) -> o -> m AuthManager
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr AuthManager -> AuthManager) -> o -> IO AuthManager
forall o o'.
(HasCallStack, ManagedPtrNewtype o, TypedObject o,
 ManagedPtrNewtype o', TypedObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
B.ManagedPtr.unsafeCastTo ManagedPtr AuthManager -> AuthManager
AuthManager

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

#if defined(ENABLE_OVERLOADING)
type family ResolveAuthManagerMethod (t :: Symbol) (o :: *) :: * where
    ResolveAuthManagerMethod "addFeature" o = Soup.SessionFeature.SessionFeatureAddFeatureMethodInfo
    ResolveAuthManagerMethod "attach" o = Soup.SessionFeature.SessionFeatureAttachMethodInfo
    ResolveAuthManagerMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAuthManagerMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAuthManagerMethod "clearCachedCredentials" o = AuthManagerClearCachedCredentialsMethodInfo
    ResolveAuthManagerMethod "detach" o = Soup.SessionFeature.SessionFeatureDetachMethodInfo
    ResolveAuthManagerMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAuthManagerMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAuthManagerMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAuthManagerMethod "hasFeature" o = Soup.SessionFeature.SessionFeatureHasFeatureMethodInfo
    ResolveAuthManagerMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAuthManagerMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAuthManagerMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAuthManagerMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAuthManagerMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAuthManagerMethod "removeFeature" o = Soup.SessionFeature.SessionFeatureRemoveFeatureMethodInfo
    ResolveAuthManagerMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAuthManagerMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAuthManagerMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAuthManagerMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAuthManagerMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAuthManagerMethod "useAuth" o = AuthManagerUseAuthMethodInfo
    ResolveAuthManagerMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAuthManagerMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAuthManagerMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAuthManagerMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAuthManagerMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAuthManagerMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAuthManagerMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAuthManagerMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- signal AuthManager::authenticate
-- | Emitted when the manager requires the application to
-- provide authentication credentials.
-- 
-- t'GI.Soup.Objects.Session.Session' connects to this signal and emits its own
-- [authenticate]("GI.Soup.Objects.Session#g:signal:authenticate") signal when it is emitted, so
-- you shouldn\'t need to use this signal directly.
type AuthManagerAuthenticateCallback =
    Soup.Message.Message
    -- ^ /@msg@/: the t'GI.Soup.Objects.Message.Message' being sent
    -> Soup.Auth.Auth
    -- ^ /@auth@/: the t'GI.Soup.Objects.Auth.Auth' to authenticate
    -> Bool
    -- ^ /@retrying@/: 'P.True' if this is the second (or later) attempt
    -> IO ()

type C_AuthManagerAuthenticateCallback =
    Ptr AuthManager ->                      -- object
    Ptr Soup.Message.Message ->
    Ptr Soup.Auth.Auth ->
    CInt ->
    Ptr () ->                               -- user_data
    IO ()

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

wrap_AuthManagerAuthenticateCallback :: 
    GObject a => (a -> AuthManagerAuthenticateCallback) ->
    C_AuthManagerAuthenticateCallback
wrap_AuthManagerAuthenticateCallback :: forall a.
GObject a =>
(a -> AuthManagerAuthenticateCallback)
-> C_AuthManagerAuthenticateCallback
wrap_AuthManagerAuthenticateCallback a -> AuthManagerAuthenticateCallback
gi'cb Ptr AuthManager
gi'selfPtr Ptr Message
msg Ptr Auth
auth CInt
retrying Ptr ()
_ = do
    Message
msg' <- ((ManagedPtr Message -> Message) -> Ptr Message -> IO Message
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Message -> Message
Soup.Message.Message) Ptr Message
msg
    Auth
auth' <- ((ManagedPtr Auth -> Auth) -> Ptr Auth -> IO Auth
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Auth -> Auth
Soup.Auth.Auth) Ptr Auth
auth
    let retrying' :: Bool
retrying' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
retrying
    Ptr AuthManager -> (AuthManager -> IO ()) -> IO ()
forall a b.
(HasCallStack, ManagedPtrNewtype a) =>
Ptr a -> (a -> IO b) -> IO b
B.ManagedPtr.withTransient Ptr AuthManager
gi'selfPtr ((AuthManager -> IO ()) -> IO ())
-> (AuthManager -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AuthManager
gi'self -> a -> AuthManagerAuthenticateCallback
gi'cb (AuthManager -> a
Coerce.coerce AuthManager
gi'self)  Message
msg' Auth
auth' Bool
retrying'


-- | Connect a signal handler for the [authenticate](#signal:authenticate) 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' authManager #authenticate callback
-- @
-- 
-- 
onAuthManagerAuthenticate :: (IsAuthManager a, MonadIO m) => a -> ((?self :: a) => AuthManagerAuthenticateCallback) -> m SignalHandlerId
onAuthManagerAuthenticate :: forall a (m :: * -> *).
(IsAuthManager a, MonadIO m) =>
a
-> ((?self::a) => AuthManagerAuthenticateCallback)
-> m SignalHandlerId
onAuthManagerAuthenticate a
obj (?self::a) => AuthManagerAuthenticateCallback
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 wrapped :: a -> AuthManagerAuthenticateCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => AuthManagerAuthenticateCallback
AuthManagerAuthenticateCallback
cb
    let wrapped' :: C_AuthManagerAuthenticateCallback
wrapped' = (a -> AuthManagerAuthenticateCallback)
-> C_AuthManagerAuthenticateCallback
forall a.
GObject a =>
(a -> AuthManagerAuthenticateCallback)
-> C_AuthManagerAuthenticateCallback
wrap_AuthManagerAuthenticateCallback a -> AuthManagerAuthenticateCallback
wrapped
    FunPtr C_AuthManagerAuthenticateCallback
wrapped'' <- C_AuthManagerAuthenticateCallback
-> IO (FunPtr C_AuthManagerAuthenticateCallback)
mk_AuthManagerAuthenticateCallback C_AuthManagerAuthenticateCallback
wrapped'
    a
-> Text
-> FunPtr C_AuthManagerAuthenticateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"authenticate" FunPtr C_AuthManagerAuthenticateCallback
wrapped'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [authenticate](#signal:authenticate) 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' authManager #authenticate callback
-- @
-- 
-- 
-- 
-- By default the object invoking the signal is not passed to the callback.
-- If you need to access it, you can use the implit @?self@ parameter.
-- Note that this requires activating the @ImplicitParams@ GHC extension.
-- 
afterAuthManagerAuthenticate :: (IsAuthManager a, MonadIO m) => a -> ((?self :: a) => AuthManagerAuthenticateCallback) -> m SignalHandlerId
afterAuthManagerAuthenticate :: forall a (m :: * -> *).
(IsAuthManager a, MonadIO m) =>
a
-> ((?self::a) => AuthManagerAuthenticateCallback)
-> m SignalHandlerId
afterAuthManagerAuthenticate a
obj (?self::a) => AuthManagerAuthenticateCallback
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 wrapped :: a -> AuthManagerAuthenticateCallback
wrapped a
self = let ?self = a
?self::a
self in (?self::a) => AuthManagerAuthenticateCallback
AuthManagerAuthenticateCallback
cb
    let wrapped' :: C_AuthManagerAuthenticateCallback
wrapped' = (a -> AuthManagerAuthenticateCallback)
-> C_AuthManagerAuthenticateCallback
forall a.
GObject a =>
(a -> AuthManagerAuthenticateCallback)
-> C_AuthManagerAuthenticateCallback
wrap_AuthManagerAuthenticateCallback a -> AuthManagerAuthenticateCallback
wrapped
    FunPtr C_AuthManagerAuthenticateCallback
wrapped'' <- C_AuthManagerAuthenticateCallback
-> IO (FunPtr C_AuthManagerAuthenticateCallback)
mk_AuthManagerAuthenticateCallback C_AuthManagerAuthenticateCallback
wrapped'
    a
-> Text
-> FunPtr C_AuthManagerAuthenticateCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj Text
"authenticate" FunPtr C_AuthManagerAuthenticateCallback
wrapped'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data AuthManagerAuthenticateSignalInfo
instance SignalInfo AuthManagerAuthenticateSignalInfo where
    type HaskellCallbackType AuthManagerAuthenticateSignalInfo = AuthManagerAuthenticateCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_AuthManagerAuthenticateCallback cb
        cb'' <- mk_AuthManagerAuthenticateCallback cb'
        connectSignalFunPtr obj "authenticate" cb'' connectMode detail
    dbgSignalInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.AuthManager::authenticate"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-AuthManager.html#g:signal:authenticate"})

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

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

foreign import ccall "soup_auth_manager_clear_cached_credentials" soup_auth_manager_clear_cached_credentials :: 
    Ptr AuthManager ->                      -- manager : TInterface (Name {namespace = "Soup", name = "AuthManager"})
    IO ()

-- | Clear all credentials cached by /@manager@/
-- 
-- /Since: 2.58/
authManagerClearCachedCredentials ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthManager a) =>
    a
    -- ^ /@manager@/: a t'GI.Soup.Objects.AuthManager.AuthManager'
    -> m ()
authManagerClearCachedCredentials :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthManager a) =>
a -> m ()
authManagerClearCachedCredentials a
manager = 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 AuthManager
manager' <- a -> IO (Ptr AuthManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr AuthManager -> IO ()
soup_auth_manager_clear_cached_credentials Ptr AuthManager
manager'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AuthManagerClearCachedCredentialsMethodInfo
instance (signature ~ (m ()), MonadIO m, IsAuthManager a) => O.OverloadedMethod AuthManagerClearCachedCredentialsMethodInfo a signature where
    overloadedMethod = authManagerClearCachedCredentials

instance O.OverloadedMethodInfo AuthManagerClearCachedCredentialsMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.AuthManager.authManagerClearCachedCredentials",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-AuthManager.html#v:authManagerClearCachedCredentials"
        })


#endif

-- method AuthManager::use_auth
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "manager"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "AuthManager" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuthManager" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uri"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupURI under which @auth is to be used"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupAuth to use"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_auth_manager_use_auth" soup_auth_manager_use_auth :: 
    Ptr AuthManager ->                      -- manager : TInterface (Name {namespace = "Soup", name = "AuthManager"})
    Ptr Soup.URI.URI ->                     -- uri : TInterface (Name {namespace = "Soup", name = "URI"})
    Ptr Soup.Auth.Auth ->                   -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    IO ()

-- | Records that /@auth@/ is to be used under /@uri@/, as though a
-- WWW-Authenticate header had been received at that URI. This can be
-- used to \"preload\" /@manager@/\'s auth cache, to avoid an extra HTTP
-- round trip in the case where you know ahead of time that a 401
-- response will be returned.
-- 
-- This is only useful for authentication types where the initial
-- Authorization header does not depend on any additional information
-- from the server. (Eg, Basic or NTLM, but not Digest.)
-- 
-- /Since: 2.42/
authManagerUseAuth ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthManager a, Soup.Auth.IsAuth b) =>
    a
    -- ^ /@manager@/: a t'GI.Soup.Objects.AuthManager.AuthManager'
    -> Soup.URI.URI
    -- ^ /@uri@/: the t'GI.Soup.Structs.URI.URI' under which /@auth@/ is to be used
    -> b
    -- ^ /@auth@/: the t'GI.Soup.Objects.Auth.Auth' to use
    -> m ()
authManagerUseAuth :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAuthManager a, IsAuth b) =>
a -> URI -> b -> m ()
authManagerUseAuth a
manager URI
uri b
auth = 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 AuthManager
manager' <- a -> IO (Ptr AuthManager)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
manager
    Ptr URI
uri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
uri
    Ptr Auth
auth' <- b -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
auth
    Ptr AuthManager -> Ptr URI -> Ptr Auth -> IO ()
soup_auth_manager_use_auth Ptr AuthManager
manager' Ptr URI
uri' Ptr Auth
auth'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
manager
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
uri
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
auth
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AuthManagerUseAuthMethodInfo
instance (signature ~ (Soup.URI.URI -> b -> m ()), MonadIO m, IsAuthManager a, Soup.Auth.IsAuth b) => O.OverloadedMethod AuthManagerUseAuthMethodInfo a signature where
    overloadedMethod = authManagerUseAuth

instance O.OverloadedMethodInfo AuthManagerUseAuthMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.AuthManager.authManagerUseAuth",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-AuthManager.html#v:authManagerUseAuth"
        })


#endif