{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- t'GI.Soup.Objects.AuthDomainDigest.AuthDomainDigest' handles the server side of HTTP \"Digest\"
-- authentication.

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

module GI.Soup.Objects.AuthDomainDigest
    ( 

-- * Exported types
    AuthDomainDigest(..)                    ,
    IsAuthDomainDigest                      ,
    toAuthDomainDigest                      ,


 -- * 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.AuthDomainDigest#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)
    ResolveAuthDomainDigestMethod           ,
#endif

-- ** encodePassword #method:encodePassword#

    authDomainDigestEncodePassword          ,


-- ** setAuthCallback #method:setAuthCallback#

#if defined(ENABLE_OVERLOADING)
    AuthDomainDigestSetAuthCallbackMethodInfo,
#endif
    authDomainDigestSetAuthCallback         ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    AuthDomainDigestAuthCallbackPropertyInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    authDomainDigestAuthCallback            ,
#endif
    clearAuthDomainDigestAuthCallback       ,
    constructAuthDomainDigestAuthCallback   ,
    getAuthDomainDigestAuthCallback         ,
    setAuthDomainDigestAuthCallback         ,


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

#if defined(ENABLE_OVERLOADING)
    AuthDomainDigestAuthDataPropertyInfo    ,
#endif
#if defined(ENABLE_OVERLOADING)
    authDomainDigestAuthData                ,
#endif
    constructAuthDomainDigestAuthData       ,
    getAuthDomainDigestAuthData             ,
    setAuthDomainDigestAuthData             ,




    ) 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.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 AuthDomainDigest = AuthDomainDigest (SP.ManagedPtr AuthDomainDigest)
    deriving (AuthDomainDigest -> AuthDomainDigest -> Bool
(AuthDomainDigest -> AuthDomainDigest -> Bool)
-> (AuthDomainDigest -> AuthDomainDigest -> Bool)
-> Eq AuthDomainDigest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AuthDomainDigest -> AuthDomainDigest -> Bool
$c/= :: AuthDomainDigest -> AuthDomainDigest -> Bool
== :: AuthDomainDigest -> AuthDomainDigest -> Bool
$c== :: AuthDomainDigest -> AuthDomainDigest -> Bool
Eq)

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

foreign import ccall "soup_auth_domain_digest_get_type"
    c_soup_auth_domain_digest_get_type :: IO B.Types.GType

instance B.Types.TypedObject AuthDomainDigest where
    glibType :: IO GType
glibType = IO GType
c_soup_auth_domain_digest_get_type

instance B.Types.GObject AuthDomainDigest

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

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

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

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

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

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

#endif

instance (info ~ ResolveAuthDomainDigestMethod t AuthDomainDigest, O.OverloadedMethodInfo info AuthDomainDigest) => OL.IsLabel t (O.MethodProxy info AuthDomainDigest) 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 = "AuthDomainDigestAuthCallback"})
   -- 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' authDomainDigest #authCallback
-- @
getAuthDomainDigestAuthCallback :: (MonadIO m, IsAuthDomainDigest o) => o -> m (Maybe Soup.Callbacks.AuthDomainDigestAuthCallback_WithClosures)
getAuthDomainDigestAuthCallback :: forall (m :: * -> *) o.
(MonadIO m, IsAuthDomainDigest o) =>
o -> m (Maybe AuthDomainDigestAuthCallback_WithClosures)
getAuthDomainDigestAuthCallback o
obj = IO (Maybe AuthDomainDigestAuthCallback_WithClosures)
-> m (Maybe AuthDomainDigestAuthCallback_WithClosures)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO (Maybe AuthDomainDigestAuthCallback_WithClosures)
 -> m (Maybe AuthDomainDigestAuthCallback_WithClosures))
-> IO (Maybe AuthDomainDigestAuthCallback_WithClosures)
-> m (Maybe AuthDomainDigestAuthCallback_WithClosures)
forall a b. (a -> b) -> a -> b
$ o
-> String
-> (FunPtr C_AuthDomainDigestAuthCallback
    -> AuthDomainDigestAuthCallback_WithClosures)
-> IO (Maybe AuthDomainDigestAuthCallback_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_AuthDomainDigestAuthCallback
-> AuthDomainDigestAuthCallback_WithClosures
forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAuthDomainDigest a, IsMessage b) =>
FunPtr C_AuthDomainDigestAuthCallback
-> a -> b -> Text -> Ptr () -> m (Maybe Text)
Soup.Callbacks.dynamic_AuthDomainDigestAuthCallback

-- | 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' authDomainDigest [ #authCallback 'Data.GI.Base.Attributes.:=' value ]
-- @
setAuthDomainDigestAuthCallback :: (MonadIO m, IsAuthDomainDigest o) => o -> FunPtr Soup.Callbacks.C_AuthDomainDigestAuthCallback -> m ()
setAuthDomainDigestAuthCallback :: forall (m :: * -> *) o.
(MonadIO m, IsAuthDomainDigest o) =>
o -> FunPtr C_AuthDomainDigestAuthCallback -> m ()
setAuthDomainDigestAuthCallback o
obj FunPtr C_AuthDomainDigestAuthCallback
val = IO () -> m ()
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_AuthDomainDigestAuthCallback -> IO ()
forall a b. GObject a => a -> String -> FunPtr b -> IO ()
B.Properties.setObjectPropertyCallback o
obj String
"auth-callback" FunPtr C_AuthDomainDigestAuthCallback
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`.
constructAuthDomainDigestAuthCallback :: (IsAuthDomainDigest o, MIO.MonadIO m) => FunPtr Soup.Callbacks.C_AuthDomainDigestAuthCallback -> m (GValueConstruct o)
constructAuthDomainDigestAuthCallback :: forall o (m :: * -> *).
(IsAuthDomainDigest o, MonadIO m) =>
FunPtr C_AuthDomainDigestAuthCallback -> m (GValueConstruct o)
constructAuthDomainDigestAuthCallback FunPtr C_AuthDomainDigestAuthCallback
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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_AuthDomainDigestAuthCallback -> IO (GValueConstruct o)
forall b o. String -> FunPtr b -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyCallback String
"auth-callback" FunPtr C_AuthDomainDigestAuthCallback
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
-- @
clearAuthDomainDigestAuthCallback :: (MonadIO m, IsAuthDomainDigest o) => o -> m ()
clearAuthDomainDigestAuthCallback :: forall (m :: * -> *) o.
(MonadIO m, IsAuthDomainDigest o) =>
o -> m ()
clearAuthDomainDigestAuthCallback o
obj = IO () -> m ()
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 AuthDomainDigestAuthCallbackPropertyInfo
instance AttrInfo AuthDomainDigestAuthCallbackPropertyInfo where
    type AttrAllowedOps AuthDomainDigestAuthCallbackPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AuthDomainDigestAuthCallbackPropertyInfo = IsAuthDomainDigest
    type AttrSetTypeConstraint AuthDomainDigestAuthCallbackPropertyInfo = (~) (FunPtr Soup.Callbacks.C_AuthDomainDigestAuthCallback)
    type AttrTransferTypeConstraint AuthDomainDigestAuthCallbackPropertyInfo = (~) Soup.Callbacks.AuthDomainDigestAuthCallback_WithClosures
    type AttrTransferType AuthDomainDigestAuthCallbackPropertyInfo = FunPtr Soup.Callbacks.C_AuthDomainDigestAuthCallback
    type AttrGetType AuthDomainDigestAuthCallbackPropertyInfo = (Maybe Soup.Callbacks.AuthDomainDigestAuthCallback_WithClosures)
    type AttrLabel AuthDomainDigestAuthCallbackPropertyInfo = "auth-callback"
    type AttrOrigin AuthDomainDigestAuthCallbackPropertyInfo = AuthDomainDigest
    attrGet = getAuthDomainDigestAuthCallback
    attrSet = setAuthDomainDigestAuthCallback
    attrTransfer _ v = do
        Soup.Callbacks.mk_AuthDomainDigestAuthCallback (Soup.Callbacks.wrap_AuthDomainDigestAuthCallback Nothing v)
    attrConstruct = constructAuthDomainDigestAuthCallback
    attrClear = clearAuthDomainDigestAuthCallback
#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' authDomainDigest #authData
-- @
getAuthDomainDigestAuthData :: (MonadIO m, IsAuthDomainDigest o) => o -> m (Ptr ())
getAuthDomainDigestAuthData :: forall (m :: * -> *) o.
(MonadIO m, IsAuthDomainDigest o) =>
o -> m (Ptr ())
getAuthDomainDigestAuthData o
obj = IO (Ptr ()) -> m (Ptr ())
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' authDomainDigest [ #authData 'Data.GI.Base.Attributes.:=' value ]
-- @
setAuthDomainDigestAuthData :: (MonadIO m, IsAuthDomainDigest o) => o -> Ptr () -> m ()
setAuthDomainDigestAuthData :: forall (m :: * -> *) o.
(MonadIO m, IsAuthDomainDigest o) =>
o -> Ptr () -> m ()
setAuthDomainDigestAuthData o
obj Ptr ()
val = IO () -> m ()
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`.
constructAuthDomainDigestAuthData :: (IsAuthDomainDigest o, MIO.MonadIO m) => Ptr () -> m (GValueConstruct o)
constructAuthDomainDigestAuthData :: forall o (m :: * -> *).
(IsAuthDomainDigest o, MonadIO m) =>
Ptr () -> m (GValueConstruct o)
constructAuthDomainDigestAuthData Ptr ()
val = IO (GValueConstruct o) -> m (GValueConstruct o)
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 (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 AuthDomainDigestAuthDataPropertyInfo
instance AttrInfo AuthDomainDigestAuthDataPropertyInfo where
    type AttrAllowedOps AuthDomainDigestAuthDataPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AuthDomainDigestAuthDataPropertyInfo = IsAuthDomainDigest
    type AttrSetTypeConstraint AuthDomainDigestAuthDataPropertyInfo = (~) (Ptr ())
    type AttrTransferTypeConstraint AuthDomainDigestAuthDataPropertyInfo = (~) (Ptr ())
    type AttrTransferType AuthDomainDigestAuthDataPropertyInfo = Ptr ()
    type AttrGetType AuthDomainDigestAuthDataPropertyInfo = (Ptr ())
    type AttrLabel AuthDomainDigestAuthDataPropertyInfo = "auth-data"
    type AttrOrigin AuthDomainDigestAuthDataPropertyInfo = AuthDomainDigest
    attrGet = getAuthDomainDigestAuthData
    attrSet = setAuthDomainDigestAuthData
    attrTransfer _ v = do
        return v
    attrConstruct = constructAuthDomainDigestAuthData
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList AuthDomainDigest
type instance O.AttributeList AuthDomainDigest = AuthDomainDigestAttributeList
type AuthDomainDigestAttributeList = ('[ '("addPath", Soup.AuthDomain.AuthDomainAddPathPropertyInfo), '("authCallback", AuthDomainDigestAuthCallbackPropertyInfo), '("authData", AuthDomainDigestAuthDataPropertyInfo), '("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)
authDomainDigestAuthCallback :: AttrLabelProxy "authCallback"
authDomainDigestAuthCallback = AttrLabelProxy

authDomainDigestAuthData :: AttrLabelProxy "authData"
authDomainDigestAuthData = AttrLabelProxy

#endif

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

#endif

-- method AuthDomainDigest::set_auth_callback
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "domain"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "AuthDomainDigest" }
--           , 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 = "AuthDomainDigestAuthCallback" }
--           , 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_digest_set_auth_callback" soup_auth_domain_digest_set_auth_callback :: 
    Ptr AuthDomainDigest ->                 -- domain : TInterface (Name {namespace = "Soup", name = "AuthDomainDigest"})
    FunPtr Soup.Callbacks.C_AuthDomainDigestAuthCallback -> -- callback : TInterface (Name {namespace = "Soup", name = "AuthDomainDigestAuthCallback"})
    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_DIGEST_AUTH_CALLBACK' and
-- 'GI.Soup.Constants.AUTH_DOMAIN_DIGEST_AUTH_DATA' properties, which can also be
-- used to set the callback at construct time.
authDomainDigestSetAuthCallback ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuthDomainDigest a) =>
    a
    -- ^ /@domain@/: the domain
    -> Soup.Callbacks.AuthDomainDigestAuthCallback
    -- ^ /@callback@/: the callback
    -> m ()
authDomainDigestSetAuthCallback :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuthDomainDigest a) =>
a -> AuthDomainDigestAuthCallback -> m ()
authDomainDigestSetAuthCallback a
domain AuthDomainDigestAuthCallback
callback = 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 AuthDomainDigest
domain' <- a -> IO (Ptr AuthDomainDigest)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
domain
    FunPtr C_AuthDomainDigestAuthCallback
callback' <- C_AuthDomainDigestAuthCallback
-> IO (FunPtr C_AuthDomainDigestAuthCallback)
Soup.Callbacks.mk_AuthDomainDigestAuthCallback (Maybe (Ptr (FunPtr C_AuthDomainDigestAuthCallback))
-> AuthDomainDigestAuthCallback_WithClosures
-> C_AuthDomainDigestAuthCallback
Soup.Callbacks.wrap_AuthDomainDigestAuthCallback Maybe (Ptr (FunPtr C_AuthDomainDigestAuthCallback))
forall a. Maybe a
Nothing (AuthDomainDigestAuthCallback
-> AuthDomainDigestAuthCallback_WithClosures
Soup.Callbacks.drop_closures_AuthDomainDigestAuthCallback AuthDomainDigestAuthCallback
callback))
    let userData :: Ptr ()
userData = FunPtr C_AuthDomainDigestAuthCallback -> Ptr ()
forall a b. FunPtr a -> Ptr b
castFunPtrToPtr FunPtr C_AuthDomainDigestAuthCallback
callback'
    let dnotify :: FunPtr (Ptr a -> IO ())
dnotify = FunPtr (Ptr a -> IO ())
forall a. FunPtr (Ptr a -> IO ())
SP.safeFreeFunPtrPtr
    Ptr AuthDomainDigest
-> FunPtr C_AuthDomainDigestAuthCallback
-> Ptr ()
-> FunPtr (Ptr () -> IO ())
-> IO ()
soup_auth_domain_digest_set_auth_callback Ptr AuthDomainDigest
domain' FunPtr C_AuthDomainDigestAuthCallback
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 (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AuthDomainDigestSetAuthCallbackMethodInfo
instance (signature ~ (Soup.Callbacks.AuthDomainDigestAuthCallback -> m ()), MonadIO m, IsAuthDomainDigest a) => O.OverloadedMethod AuthDomainDigestSetAuthCallbackMethodInfo a signature where
    overloadedMethod = authDomainDigestSetAuthCallback

instance O.OverloadedMethodInfo AuthDomainDigestSetAuthCallbackMethodInfo a where
    overloadedMethodInfo = O.MethodInfo {
        O.overloadedMethodName = "GI.Soup.Objects.AuthDomainDigest.authDomainDigestSetAuthCallback",
        O.overloadedMethodURL = "https://hackage.haskell.org/package/gi-soup-2.4.24/docs/GI-Soup-Objects-AuthDomainDigest.html#v:authDomainDigestSetAuthCallback"
        }


#endif

-- method AuthDomainDigest::encode_password
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "username"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a username" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "realm"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an auth realm name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "password"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the password for @username in @realm"
--                 , 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 "soup_auth_domain_digest_encode_password" soup_auth_domain_digest_encode_password :: 
    CString ->                              -- username : TBasicType TUTF8
    CString ->                              -- realm : TBasicType TUTF8
    CString ->                              -- password : TBasicType TUTF8
    IO CString

-- | Encodes the username\/realm\/password triplet for Digest
-- authentication. (That is, it returns a stringified MD5 hash of
-- /@username@/, /@realm@/, and /@password@/ concatenated together). This is
-- the form that is needed as the return value of
-- t'GI.Soup.Objects.AuthDomainDigest.AuthDomainDigest'\'s auth handler.
-- 
-- For security reasons, you should store the encoded hash, rather
-- than storing the cleartext password itself and calling this method
-- only when you need to verify it. This way, if your server is
-- compromised, the attackers will not gain access to cleartext
-- passwords which might also be usable at other sites. (Note also
-- that the encoded password returned by this method is identical to
-- the encoded password stored in an Apache .htdigest file.)
authDomainDigestEncodePassword ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@username@/: a username
    -> T.Text
    -- ^ /@realm@/: an auth realm name
    -> T.Text
    -- ^ /@password@/: the password for /@username@/ in /@realm@/
    -> m T.Text
    -- ^ __Returns:__ the encoded password
authDomainDigestEncodePassword :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> Text -> Text -> m Text
authDomainDigestEncodePassword Text
username Text
realm Text
password = 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
    CString
username' <- Text -> IO CString
textToCString Text
username
    CString
realm' <- Text -> IO CString
textToCString Text
realm
    CString
password' <- Text -> IO CString
textToCString Text
password
    CString
result <- CString -> CString -> CString -> IO CString
soup_auth_domain_digest_encode_password CString
username' CString
realm' CString
password'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"authDomainDigestEncodePassword" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
username'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
realm'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
password'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
#endif