{-# LANGUAGE 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.AuthDomainBasic
    ( 

-- * Exported types
    AuthDomainBasic(..)                     ,
    IsAuthDomainBasic                       ,
    toAuthDomainBasic                       ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [accepts]("GI.Soup.Objects.AuthDomain#g:method:accepts"), [addPath]("GI.Soup.Objects.AuthDomain#g:method:addPath"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [challenge]("GI.Soup.Objects.AuthDomain#g:method:challenge"), [checkPassword]("GI.Soup.Objects.AuthDomain#g:method:checkPassword"), [covers]("GI.Soup.Objects.AuthDomain#g:method:covers"), [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"), [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"), [removePath]("GI.Soup.Objects.AuthDomain#g:method:removePath"), [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"), [tryGenericAuthCallback]("GI.Soup.Objects.AuthDomain#g:method:tryGenericAuthCallback"), [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"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRealm]("GI.Soup.Objects.AuthDomain#g:method:getRealm").
-- 
-- ==== Setters
-- [setAuthCallback]("GI.Soup.Objects.AuthDomainBasic#g:method:setAuthCallback"), [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setFilter]("GI.Soup.Objects.AuthDomain#g:method:setFilter"), [setGenericAuthCallback]("GI.Soup.Objects.AuthDomain#g:method:setGenericAuthCallback"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty").

#if defined(ENABLE_OVERLOADING)
    ResolveAuthDomainBasicMethod            ,
#endif

-- ** setAuthCallback #method:setAuthCallback#

#if defined(ENABLE_OVERLOADING)
    AuthDomainBasicSetAuthCallbackMethodInfo,
#endif
    authDomainBasicSetAuthCallback          ,




 -- * Properties


-- ** authCallback #attr:authCallback#
-- | The t'GI.Soup.Callbacks.AuthDomainBasicAuthCallback'

#if defined(ENABLE_OVERLOADING)
    AuthDomainBasicAuthCallbackPropertyInfo ,
#endif
#if defined(ENABLE_OVERLOADING)
    authDomainBasicAuthCallback             ,
#endif
    clearAuthDomainBasicAuthCallback        ,
    constructAuthDomainBasicAuthCallback    ,
    getAuthDomainBasicAuthCallback          ,
    setAuthDomainBasicAuthCallback          ,


-- ** authData #attr:authData#
-- | The data to pass to the t'GI.Soup.Callbacks.AuthDomainBasicAuthCallback'

#if defined(ENABLE_OVERLOADING)
    AuthDomainBasicAuthDataPropertyInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    authDomainBasicAuthData                 ,
#endif
    constructAuthDomainBasicAuthData        ,
    getAuthDomainBasicAuthData              ,
    setAuthDomainBasicAuthData              ,




    ) 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.GHashTable as B.GHT
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.GLib.Callbacks as GLib.Callbacks
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Soup.Callbacks as Soup.Callbacks
import {-# SOURCE #-} qualified GI.Soup.Objects.AuthDomain as Soup.AuthDomain

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

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

foreign import ccall "soup_auth_domain_basic_get_type"
    c_soup_auth_domain_basic_get_type :: IO B.Types.GType

instance B.Types.TypedObject AuthDomainBasic where
    glibType :: IO GType
glibType = IO GType
c_soup_auth_domain_basic_get_type

instance B.Types.GObject AuthDomainBasic

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

instance O.HasParentTypes AuthDomainBasic
type instance O.ParentTypes AuthDomainBasic = '[Soup.AuthDomain.AuthDomain, GObject.Object.Object]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveAuthDomainBasicMethod (t :: Symbol) (o :: *) :: * where
    ResolveAuthDomainBasicMethod "accepts" o = Soup.AuthDomain.AuthDomainAcceptsMethodInfo
    ResolveAuthDomainBasicMethod "addPath" o = Soup.AuthDomain.AuthDomainAddPathMethodInfo
    ResolveAuthDomainBasicMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAuthDomainBasicMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAuthDomainBasicMethod "challenge" o = Soup.AuthDomain.AuthDomainChallengeMethodInfo
    ResolveAuthDomainBasicMethod "checkPassword" o = Soup.AuthDomain.AuthDomainCheckPasswordMethodInfo
    ResolveAuthDomainBasicMethod "covers" o = Soup.AuthDomain.AuthDomainCoversMethodInfo
    ResolveAuthDomainBasicMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAuthDomainBasicMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAuthDomainBasicMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAuthDomainBasicMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAuthDomainBasicMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAuthDomainBasicMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAuthDomainBasicMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAuthDomainBasicMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAuthDomainBasicMethod "removePath" o = Soup.AuthDomain.AuthDomainRemovePathMethodInfo
    ResolveAuthDomainBasicMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAuthDomainBasicMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAuthDomainBasicMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAuthDomainBasicMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAuthDomainBasicMethod "tryGenericAuthCallback" o = Soup.AuthDomain.AuthDomainTryGenericAuthCallbackMethodInfo
    ResolveAuthDomainBasicMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAuthDomainBasicMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAuthDomainBasicMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAuthDomainBasicMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAuthDomainBasicMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAuthDomainBasicMethod "getRealm" o = Soup.AuthDomain.AuthDomainGetRealmMethodInfo
    ResolveAuthDomainBasicMethod "setAuthCallback" o = AuthDomainBasicSetAuthCallbackMethodInfo
    ResolveAuthDomainBasicMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAuthDomainBasicMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAuthDomainBasicMethod "setFilter" o = Soup.AuthDomain.AuthDomainSetFilterMethodInfo
    ResolveAuthDomainBasicMethod "setGenericAuthCallback" o = Soup.AuthDomain.AuthDomainSetGenericAuthCallbackMethodInfo
    ResolveAuthDomainBasicMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAuthDomainBasicMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "auth-callback"
   -- Type: TInterface (Name {namespace = "Soup", name = "AuthDomainBasicAuthCallback"})
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@auth-callback@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' authDomainBasic #authCallback
-- @
getAuthDomainBasicAuthCallback :: (MonadIO m, IsAuthDomainBasic o) => o -> m (Maybe Soup.Callbacks.AuthDomainBasicAuthCallback_WithClosures)
getAuthDomainBasicAuthCallback :: forall (m :: * -> *) o.
(MonadIO m, IsAuthDomainBasic o) =>
o -> m (Maybe AuthDomainBasicAuthCallback_WithClosures)
getAuthDomainBasicAuthCallback o
obj = IO (Maybe AuthDomainBasicAuthCallback_WithClosures)
-> m (Maybe AuthDomainBasicAuthCallback_WithClosures)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe AuthDomainBasicAuthCallback_WithClosures)
 -> m (Maybe AuthDomainBasicAuthCallback_WithClosures))
-> IO (Maybe AuthDomainBasicAuthCallback_WithClosures)
-> m (Maybe AuthDomainBasicAuthCallback_WithClosures)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (FunPtr C_AuthDomainBasicAuthCallback
    -> AuthDomainBasicAuthCallback_WithClosures)
-> IO (Maybe AuthDomainBasicAuthCallback_WithClosures)
forall a b c.
GObject a =>
a -> String -> (FunPtr b -> c) -> IO (Maybe c)
B.Properties.getObjectPropertyCallback o
obj String
"auth-callback" FunPtr C_AuthDomainBasicAuthCallback
-> AuthDomainBasicAuthCallback_WithClosures
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAuthDomainBasic a, IsMessage b) =>
FunPtr C_AuthDomainBasicAuthCallback
-> a -> b -> Text -> Text -> Ptr () -> m Bool
Soup.Callbacks.dynamic_AuthDomainBasicAuthCallback

-- | Set the value of the “@auth-callback@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' authDomainBasic [ #authCallback 'Data.GI.Base.Attributes.:=' value ]
-- @
setAuthDomainBasicAuthCallback :: (MonadIO m, IsAuthDomainBasic o) => o -> FunPtr Soup.Callbacks.C_AuthDomainBasicAuthCallback -> m ()
setAuthDomainBasicAuthCallback :: forall (m :: * -> *) o.
(MonadIO m, IsAuthDomainBasic o) =>
o -> FunPtr C_AuthDomainBasicAuthCallback -> m ()
setAuthDomainBasicAuthCallback o
obj FunPtr C_AuthDomainBasicAuthCallback
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> FunPtr C_AuthDomainBasicAuthCallback -> IO ()
forall a b. GObject a => a -> String -> FunPtr b -> IO ()
B.Properties.setObjectPropertyCallback o
obj String
"auth-callback" FunPtr C_AuthDomainBasicAuthCallback
val

-- | Construct a `GValueConstruct` with valid value for the “@auth-callback@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAuthDomainBasicAuthCallback :: (IsAuthDomainBasic o, MIO.MonadIO m) => FunPtr Soup.Callbacks.C_AuthDomainBasicAuthCallback -> m (GValueConstruct o)
constructAuthDomainBasicAuthCallback :: forall o (m :: * -> *).
(IsAuthDomainBasic o, MonadIO m) =>
FunPtr C_AuthDomainBasicAuthCallback -> m (GValueConstruct o)
constructAuthDomainBasicAuthCallback FunPtr C_AuthDomainBasicAuthCallback
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String
-> FunPtr C_AuthDomainBasicAuthCallback -> IO (GValueConstruct o)
forall b o. String -> FunPtr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyCallback String
"auth-callback" FunPtr C_AuthDomainBasicAuthCallback
val

-- | Set the value of the “@auth-callback@” property to `Nothing`.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.clear' #authCallback
-- @
clearAuthDomainBasicAuthCallback :: (MonadIO m, IsAuthDomainBasic o) => o -> m ()
clearAuthDomainBasicAuthCallback :: forall (m :: * -> *) o.
(MonadIO m, IsAuthDomainBasic o) =>
o -> m ()
clearAuthDomainBasicAuthCallback o
obj = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ o -> String -> FunPtr Any -> IO ()
forall a b. GObject a => a -> String -> FunPtr b -> IO ()
B.Properties.setObjectPropertyCallback o
obj String
"auth-callback" FunPtr Any
forall a. FunPtr a
FP.nullFunPtr

#if defined(ENABLE_OVERLOADING)
data AuthDomainBasicAuthCallbackPropertyInfo
instance AttrInfo AuthDomainBasicAuthCallbackPropertyInfo where
    type AttrAllowedOps AuthDomainBasicAuthCallbackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AuthDomainBasicAuthCallbackPropertyInfo = IsAuthDomainBasic
    type AttrSetTypeConstraint AuthDomainBasicAuthCallbackPropertyInfo = (~) (FunPtr Soup.Callbacks.C_AuthDomainBasicAuthCallback)
    type AttrTransferTypeConstraint AuthDomainBasicAuthCallbackPropertyInfo = (~) Soup.Callbacks.AuthDomainBasicAuthCallback_WithClosures
    type AttrTransferType AuthDomainBasicAuthCallbackPropertyInfo = FunPtr Soup.Callbacks.C_AuthDomainBasicAuthCallback
    type AttrGetType AuthDomainBasicAuthCallbackPropertyInfo = (Maybe Soup.Callbacks.AuthDomainBasicAuthCallback_WithClosures)
    type AttrLabel AuthDomainBasicAuthCallbackPropertyInfo = "auth-callback"
    type AttrOrigin AuthDomainBasicAuthCallbackPropertyInfo = AuthDomainBasic
    attrGet = getAuthDomainBasicAuthCallback
    attrSet = setAuthDomainBasicAuthCallback
    attrTransfer _ v = do
        Soup.Callbacks.mk_AuthDomainBasicAuthCallback (Soup.Callbacks.wrap_AuthDomainBasicAuthCallback Nothing v)
    attrConstruct = constructAuthDomainBasicAuthCallback
    attrClear = clearAuthDomainBasicAuthCallback
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.AuthDomainBasic.authCallback"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-AuthDomainBasic.html#g:attr:authCallback"
        })
#endif

-- VVV Prop "auth-data"
   -- Type: TBasicType TPtr
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@auth-data@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' authDomainBasic #authData
-- @
getAuthDomainBasicAuthData :: (MonadIO m, IsAuthDomainBasic o) => o -> m (Ptr ())
getAuthDomainBasicAuthData :: forall (m :: * -> *) o.
(MonadIO m, IsAuthDomainBasic o) =>
o -> m (Ptr ())
getAuthDomainBasicAuthData o
obj = IO (Ptr ()) -> m (Ptr ())
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Ptr ()) -> m (Ptr ())) -> IO (Ptr ()) -> m (Ptr ())
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Ptr ())
forall a b. GObject a => a -> String -> IO (Ptr b)
B.Properties.getObjectPropertyPtr o
obj String
"auth-data"

-- | Set the value of the “@auth-data@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' authDomainBasic [ #authData 'Data.GI.Base.Attributes.:=' value ]
-- @
setAuthDomainBasicAuthData :: (MonadIO m, IsAuthDomainBasic o) => o -> Ptr () -> m ()
setAuthDomainBasicAuthData :: forall (m :: * -> *) o.
(MonadIO m, IsAuthDomainBasic o) =>
o -> Ptr () -> m ()
setAuthDomainBasicAuthData o
obj Ptr ()
val = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    o -> String -> Ptr () -> IO ()
forall a b. GObject a => a -> String -> Ptr b -> IO ()
B.Properties.setObjectPropertyPtr o
obj String
"auth-data" Ptr ()
val

-- | Construct a `GValueConstruct` with valid value for the “@auth-data@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAuthDomainBasicAuthData :: (IsAuthDomainBasic o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructAuthDomainBasicAuthData :: forall o (m :: * -> *).
(IsAuthDomainBasic o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructAuthDomainBasicAuthData Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> m (GValueConstruct o))
-> IO (GValueConstruct o) -> m (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ do
    IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (GValueConstruct o) -> IO (GValueConstruct o))
-> IO (GValueConstruct o) -> IO (GValueConstruct o)
forall a b. (a -> b) -> a -> b
$ String -> Ptr () -> IO (GValueConstruct o)
forall b o. String -> Ptr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyPtr String
"auth-data" Ptr ()
val

#if defined(ENABLE_OVERLOADING)
data AuthDomainBasicAuthDataPropertyInfo
instance AttrInfo AuthDomainBasicAuthDataPropertyInfo where
    type AttrAllowedOps AuthDomainBasicAuthDataPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AuthDomainBasicAuthDataPropertyInfo = IsAuthDomainBasic
    type AttrSetTypeConstraint AuthDomainBasicAuthDataPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint AuthDomainBasicAuthDataPropertyInfo = (~) (Ptr ())
    type AttrTransferType AuthDomainBasicAuthDataPropertyInfo = Ptr ()
    type AttrGetType AuthDomainBasicAuthDataPropertyInfo = (Ptr ())
    type AttrLabel AuthDomainBasicAuthDataPropertyInfo = "auth-data"
    type AttrOrigin AuthDomainBasicAuthDataPropertyInfo = AuthDomainBasic
    attrGet = getAuthDomainBasicAuthData
    attrSet = setAuthDomainBasicAuthData
    attrTransfer _ v = do
        return v
    attrConstruct = constructAuthDomainBasicAuthData
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.AuthDomainBasic.authData"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.26/docs/GI-Soup-Objects-AuthDomainBasic.html#g:attr:authData"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AuthDomainBasic
type instance O.AttributeList AuthDomainBasic = AuthDomainBasicAttributeList
type AuthDomainBasicAttributeList = ('[ '("addPath", Soup.AuthDomain.AuthDomainAddPathPropertyInfo), '("authCallback", AuthDomainBasicAuthCallbackPropertyInfo), '("authData", AuthDomainBasicAuthDataPropertyInfo), '("filter", Soup.AuthDomain.AuthDomainFilterPropertyInfo), '("filterData", Soup.AuthDomain.AuthDomainFilterDataPropertyInfo), '("genericAuthCallback", Soup.AuthDomain.AuthDomainGenericAuthCallbackPropertyInfo), '("genericAuthData", Soup.AuthDomain.AuthDomainGenericAuthDataPropertyInfo), '("proxy", Soup.AuthDomain.AuthDomainProxyPropertyInfo), '("realm", Soup.AuthDomain.AuthDomainRealmPropertyInfo), '("removePath", Soup.AuthDomain.AuthDomainRemovePathPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
authDomainBasicAuthCallback :: AttrLabelProxy "authCallback"
authDomainBasicAuthCallback = AttrLabelProxy

authDomainBasicAuthData :: AttrLabelProxy "authData"
authDomainBasicAuthData = AttrLabelProxy

#endif

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

#endif

-- method AuthDomainBasic::set_auth_callback
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "domain"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "AuthDomainBasic" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the domain" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface
--                 Name { namespace = "Soup" , name = "AuthDomainBasicAuthCallback" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeNotified
--           , argClosure = 2
--           , argDestroy = 3
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @auth_callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dnotify"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "destroy notifier to free @user_data when @domain\nis destroyed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "soup_auth_domain_basic_set_auth_callback" soup_auth_domain_basic_set_auth_callback :: 
    Ptr AuthDomainBasic ->                  -- domain : TInterface (Name {namespace = "Soup", name = "AuthDomainBasic"})
    FunPtr Soup.Callbacks.C_AuthDomainBasicAuthCallback -> -- callback : TInterface (Name {namespace = "Soup", name = "AuthDomainBasicAuthCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- dnotify : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO ()

-- | Sets the callback that /@domain@/ will use to authenticate incoming
-- requests. For each request containing authorization, /@domain@/ will
-- invoke the callback, and then either accept or reject the request
-- based on /@callback@/\'s return value.
-- 
-- You can also set the auth callback by setting the
-- 'GI.Soup.Constants.AUTH_DOMAIN_BASIC_AUTH_CALLBACK' and
-- 'GI.Soup.Constants.AUTH_DOMAIN_BASIC_AUTH_DATA' properties, which can also be
-- used to set the callback at construct time.
authDomainBasicSetAuthCallback ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthDomainBasic a) =>
    a
    -- ^ /@domain@/: the domain
    -> Soup.Callbacks.AuthDomainBasicAuthCallback
    -- ^ /@callback@/: the callback
    -> m ()
authDomainBasicSetAuthCallback :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthDomainBasic a) =>
a -> AuthDomainBasicAuthCallback -> m ()
authDomainBasicSetAuthCallback a
domain AuthDomainBasicAuthCallback
callback = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr AuthDomainBasic
domain' <- a -> IO (Ptr AuthDomainBasic)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
domain
    FunPtr C_AuthDomainBasicAuthCallback
callback' <- C_AuthDomainBasicAuthCallback
-> IO (FunPtr C_AuthDomainBasicAuthCallback)
Soup.Callbacks.mk_AuthDomainBasicAuthCallback (Maybe (Ptr (FunPtr C_AuthDomainBasicAuthCallback))
-> AuthDomainBasicAuthCallback_WithClosures
-> C_AuthDomainBasicAuthCallback
Soup.Callbacks.wrap_AuthDomainBasicAuthCallback Maybe (Ptr (FunPtr C_AuthDomainBasicAuthCallback))
forall a. Maybe a
Nothing (AuthDomainBasicAuthCallback
-> AuthDomainBasicAuthCallback_WithClosures
Soup.Callbacks.drop_closures_AuthDomainBasicAuthCallback AuthDomainBasicAuthCallback
callback))
    let userData :: Ptr ()
userData = FunPtr C_AuthDomainBasicAuthCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_AuthDomainBasicAuthCallback
callback'
    let dnotify :: FunPtr (Ptr a -> IO ())
dnotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr AuthDomainBasic
-> FunPtr C_AuthDomainBasicAuthCallback
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO ()
soup_auth_domain_basic_set_auth_callback Ptr AuthDomainBasic
domain' FunPtr C_AuthDomainBasicAuthCallback
callback' Ptr ()
userData FunPtr (Ptr () -> IO ())
forall a. FunPtr (Ptr a -> IO ())
dnotify
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
domain
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AuthDomainBasicSetAuthCallbackMethodInfo
instance (signature ~ (Soup.Callbacks.AuthDomainBasicAuthCallback -> m ()), MonadIO m, IsAuthDomainBasic a) => O.OverloadedMethod AuthDomainBasicSetAuthCallbackMethodInfo a signature where
    overloadedMethod = authDomainBasicSetAuthCallback

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


#endif