{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The abstract base class for handling authentication. Specific HTTP
-- Authentication mechanisms are implemented by its subclasses, but
-- applications never need to be aware of the specific subclasses
-- being used.

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

module GI.Soup.Objects.Auth
    ( 

-- * Exported types
    Auth(..)                                ,
    IsAuth                                  ,
    toAuth                                  ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [authenticate]("GI.Soup.Objects.Auth#g:method:authenticate"), [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [canAuthenticate]("GI.Soup.Objects.Auth#g:method:canAuthenticate"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [hasSavedPassword]("GI.Soup.Objects.Auth#g:method:hasSavedPassword"), [isAuthenticated]("GI.Soup.Objects.Auth#g:method:isAuthenticated"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isForProxy]("GI.Soup.Objects.Auth#g:method:isForProxy"), [isReady]("GI.Soup.Objects.Auth#g:method:isReady"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [runDispose]("GI.GObject.Objects.Object#g:method:runDispose"), [savePassword]("GI.Soup.Objects.Auth#g:method:savePassword"), [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"), [update]("GI.Soup.Objects.Auth#g:method:update"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getAuthorization]("GI.Soup.Objects.Auth#g:method:getAuthorization"), [getData]("GI.GObject.Objects.Object#g:method:getData"), [getHost]("GI.Soup.Objects.Auth#g:method:getHost"), [getInfo]("GI.Soup.Objects.Auth#g:method:getInfo"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getProtectionSpace]("GI.Soup.Objects.Auth#g:method:getProtectionSpace"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getRealm]("GI.Soup.Objects.Auth#g:method:getRealm"), [getSavedPassword]("GI.Soup.Objects.Auth#g:method:getSavedPassword"), [getSavedUsers]("GI.Soup.Objects.Auth#g:method:getSavedUsers"), [getSchemeName]("GI.Soup.Objects.Auth#g:method:getSchemeName").
-- 
-- ==== 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)
    ResolveAuthMethod                       ,
#endif

-- ** authenticate #method:authenticate#

#if defined(ENABLE_OVERLOADING)
    AuthAuthenticateMethodInfo              ,
#endif
    authAuthenticate                        ,


-- ** canAuthenticate #method:canAuthenticate#

#if defined(ENABLE_OVERLOADING)
    AuthCanAuthenticateMethodInfo           ,
#endif
    authCanAuthenticate                     ,


-- ** getAuthorization #method:getAuthorization#

#if defined(ENABLE_OVERLOADING)
    AuthGetAuthorizationMethodInfo          ,
#endif
    authGetAuthorization                    ,


-- ** getHost #method:getHost#

#if defined(ENABLE_OVERLOADING)
    AuthGetHostMethodInfo                   ,
#endif
    authGetHost                             ,


-- ** getInfo #method:getInfo#

#if defined(ENABLE_OVERLOADING)
    AuthGetInfoMethodInfo                   ,
#endif
    authGetInfo                             ,


-- ** getProtectionSpace #method:getProtectionSpace#

#if defined(ENABLE_OVERLOADING)
    AuthGetProtectionSpaceMethodInfo        ,
#endif
    authGetProtectionSpace                  ,


-- ** getRealm #method:getRealm#

#if defined(ENABLE_OVERLOADING)
    AuthGetRealmMethodInfo                  ,
#endif
    authGetRealm                            ,


-- ** getSavedPassword #method:getSavedPassword#

#if defined(ENABLE_OVERLOADING)
    AuthGetSavedPasswordMethodInfo          ,
#endif
    authGetSavedPassword                    ,


-- ** getSavedUsers #method:getSavedUsers#

#if defined(ENABLE_OVERLOADING)
    AuthGetSavedUsersMethodInfo             ,
#endif
    authGetSavedUsers                       ,


-- ** getSchemeName #method:getSchemeName#

#if defined(ENABLE_OVERLOADING)
    AuthGetSchemeNameMethodInfo             ,
#endif
    authGetSchemeName                       ,


-- ** hasSavedPassword #method:hasSavedPassword#

#if defined(ENABLE_OVERLOADING)
    AuthHasSavedPasswordMethodInfo          ,
#endif
    authHasSavedPassword                    ,


-- ** isAuthenticated #method:isAuthenticated#

#if defined(ENABLE_OVERLOADING)
    AuthIsAuthenticatedMethodInfo           ,
#endif
    authIsAuthenticated                     ,


-- ** isForProxy #method:isForProxy#

#if defined(ENABLE_OVERLOADING)
    AuthIsForProxyMethodInfo                ,
#endif
    authIsForProxy                          ,


-- ** isReady #method:isReady#

#if defined(ENABLE_OVERLOADING)
    AuthIsReadyMethodInfo                   ,
#endif
    authIsReady                             ,


-- ** new #method:new#

    authNew                                 ,


-- ** savePassword #method:savePassword#

#if defined(ENABLE_OVERLOADING)
    AuthSavePasswordMethodInfo              ,
#endif
    authSavePassword                        ,


-- ** update #method:update#

#if defined(ENABLE_OVERLOADING)
    AuthUpdateMethodInfo                    ,
#endif
    authUpdate                              ,




 -- * Properties


-- ** host #attr:host#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AuthHostPropertyInfo                    ,
#endif
#if defined(ENABLE_OVERLOADING)
    authHost                                ,
#endif
    clearAuthHost                           ,
    constructAuthHost                       ,
    getAuthHost                             ,
    setAuthHost                             ,


-- ** isAuthenticated #attr:isAuthenticated#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AuthIsAuthenticatedPropertyInfo         ,
#endif
    getAuthIsAuthenticated                  ,


-- ** isForProxy #attr:isForProxy#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AuthIsForProxyPropertyInfo              ,
#endif
    constructAuthIsForProxy                 ,
    getAuthIsForProxy                       ,
    setAuthIsForProxy                       ,


-- ** realm #attr:realm#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AuthRealmPropertyInfo                   ,
#endif
#if defined(ENABLE_OVERLOADING)
    authRealm                               ,
#endif
    clearAuthRealm                          ,
    constructAuthRealm                      ,
    getAuthRealm                            ,
    setAuthRealm                            ,


-- ** schemeName #attr:schemeName#
-- | /No description available in the introspection data./

#if defined(ENABLE_OVERLOADING)
    AuthSchemeNamePropertyInfo              ,
#endif
#if defined(ENABLE_OVERLOADING)
    authSchemeName                          ,
#endif
    getAuthSchemeName                       ,




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

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

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

foreign import ccall "soup_auth_get_type"
    c_soup_auth_get_type :: IO B.Types.GType

instance B.Types.TypedObject Auth where
    glibType :: IO GType
glibType = IO GType
c_soup_auth_get_type

instance B.Types.GObject Auth

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveAuthMethod (t :: Symbol) (o :: *) :: * where
    ResolveAuthMethod "authenticate" o = AuthAuthenticateMethodInfo
    ResolveAuthMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveAuthMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveAuthMethod "canAuthenticate" o = AuthCanAuthenticateMethodInfo
    ResolveAuthMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveAuthMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveAuthMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveAuthMethod "hasSavedPassword" o = AuthHasSavedPasswordMethodInfo
    ResolveAuthMethod "isAuthenticated" o = AuthIsAuthenticatedMethodInfo
    ResolveAuthMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveAuthMethod "isForProxy" o = AuthIsForProxyMethodInfo
    ResolveAuthMethod "isReady" o = AuthIsReadyMethodInfo
    ResolveAuthMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveAuthMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveAuthMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveAuthMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveAuthMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveAuthMethod "savePassword" o = AuthSavePasswordMethodInfo
    ResolveAuthMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveAuthMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveAuthMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveAuthMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveAuthMethod "update" o = AuthUpdateMethodInfo
    ResolveAuthMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveAuthMethod "getAuthorization" o = AuthGetAuthorizationMethodInfo
    ResolveAuthMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveAuthMethod "getHost" o = AuthGetHostMethodInfo
    ResolveAuthMethod "getInfo" o = AuthGetInfoMethodInfo
    ResolveAuthMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveAuthMethod "getProtectionSpace" o = AuthGetProtectionSpaceMethodInfo
    ResolveAuthMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveAuthMethod "getRealm" o = AuthGetRealmMethodInfo
    ResolveAuthMethod "getSavedPassword" o = AuthGetSavedPasswordMethodInfo
    ResolveAuthMethod "getSavedUsers" o = AuthGetSavedUsersMethodInfo
    ResolveAuthMethod "getSchemeName" o = AuthGetSchemeNameMethodInfo
    ResolveAuthMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveAuthMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveAuthMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveAuthMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

-- VVV Prop "host"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@host@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' auth #host
-- @
getAuthHost :: (MonadIO m, IsAuth o) => o -> m T.Text
getAuthHost :: forall (m :: * -> *) o. (MonadIO m, IsAuth o) => o -> m Text
getAuthHost o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getAuthHost" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"host"

-- | Set the value of the “@host@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' auth [ #host 'Data.GI.Base.Attributes.:=' value ]
-- @
setAuthHost :: (MonadIO m, IsAuth o) => o -> T.Text -> m ()
setAuthHost :: forall (m :: * -> *) o. (MonadIO m, IsAuth o) => o -> Text -> m ()
setAuthHost o
obj Text
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 -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"host" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@host@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAuthHost :: (IsAuth o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructAuthHost :: forall o (m :: * -> *).
(IsAuth o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructAuthHost Text
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 -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"host" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@host@” 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' #host
-- @
clearAuthHost :: (MonadIO m, IsAuth o) => o -> m ()
clearAuthHost :: forall (m :: * -> *) o. (MonadIO m, IsAuth o) => o -> m ()
clearAuthHost 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 -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"host" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data AuthHostPropertyInfo
instance AttrInfo AuthHostPropertyInfo where
    type AttrAllowedOps AuthHostPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AuthHostPropertyInfo = IsAuth
    type AttrSetTypeConstraint AuthHostPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint AuthHostPropertyInfo = (~) T.Text
    type AttrTransferType AuthHostPropertyInfo = T.Text
    type AttrGetType AuthHostPropertyInfo = T.Text
    type AttrLabel AuthHostPropertyInfo = "host"
    type AttrOrigin AuthHostPropertyInfo = Auth
    attrGet = getAuthHost
    attrSet = setAuthHost
    attrTransfer _ v = do
        return v
    attrConstruct = constructAuthHost
    attrClear = clearAuthHost
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Auth.host"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Auth.html#g:attr:host"
        })
#endif

-- VVV Prop "is-authenticated"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable]
   -- Nullable: (Nothing,Nothing)

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

#if defined(ENABLE_OVERLOADING)
data AuthIsAuthenticatedPropertyInfo
instance AttrInfo AuthIsAuthenticatedPropertyInfo where
    type AttrAllowedOps AuthIsAuthenticatedPropertyInfo = '[ 'AttrGet]
    type AttrBaseTypeConstraint AuthIsAuthenticatedPropertyInfo = IsAuth
    type AttrSetTypeConstraint AuthIsAuthenticatedPropertyInfo = (~) ()
    type AttrTransferTypeConstraint AuthIsAuthenticatedPropertyInfo = (~) ()
    type AttrTransferType AuthIsAuthenticatedPropertyInfo = ()
    type AttrGetType AuthIsAuthenticatedPropertyInfo = Bool
    type AttrLabel AuthIsAuthenticatedPropertyInfo = "is-authenticated"
    type AttrOrigin AuthIsAuthenticatedPropertyInfo = Auth
    attrGet = getAuthIsAuthenticated
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Auth.isAuthenticated"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Auth.html#g:attr:isAuthenticated"
        })
#endif

-- VVV Prop "is-for-proxy"
   -- Type: TBasicType TBoolean
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Nothing,Nothing)

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

-- | Set the value of the “@is-for-proxy@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' auth [ #isForProxy 'Data.GI.Base.Attributes.:=' value ]
-- @
setAuthIsForProxy :: (MonadIO m, IsAuth o) => o -> Bool -> m ()
setAuthIsForProxy :: forall (m :: * -> *) o. (MonadIO m, IsAuth o) => o -> Bool -> m ()
setAuthIsForProxy o
obj Bool
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 -> Bool -> IO ()
forall a. GObject a => a -> String -> Bool -> IO ()
B.Properties.setObjectPropertyBool o
obj String
"is-for-proxy" Bool
val

-- | Construct a `GValueConstruct` with valid value for the “@is-for-proxy@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAuthIsForProxy :: (IsAuth o, MIO.MonadIO m) => Bool -> m (GValueConstruct o)
constructAuthIsForProxy :: forall o (m :: * -> *).
(IsAuth o, MonadIO m) =>
Bool -> m (GValueConstruct o)
constructAuthIsForProxy Bool
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 -> Bool -> IO (GValueConstruct o)
forall o. String -> Bool -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyBool String
"is-for-proxy" Bool
val

#if defined(ENABLE_OVERLOADING)
data AuthIsForProxyPropertyInfo
instance AttrInfo AuthIsForProxyPropertyInfo where
    type AttrAllowedOps AuthIsForProxyPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet]
    type AttrBaseTypeConstraint AuthIsForProxyPropertyInfo = IsAuth
    type AttrSetTypeConstraint AuthIsForProxyPropertyInfo = (~) Bool
    type AttrTransferTypeConstraint AuthIsForProxyPropertyInfo = (~) Bool
    type AttrTransferType AuthIsForProxyPropertyInfo = Bool
    type AttrGetType AuthIsForProxyPropertyInfo = Bool
    type AttrLabel AuthIsForProxyPropertyInfo = "is-for-proxy"
    type AttrOrigin AuthIsForProxyPropertyInfo = Auth
    attrGet = getAuthIsForProxy
    attrSet = setAuthIsForProxy
    attrTransfer _ v = do
        return v
    attrConstruct = constructAuthIsForProxy
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Auth.isForProxy"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Auth.html#g:attr:isForProxy"
        })
#endif

-- VVV Prop "realm"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@realm@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' auth #realm
-- @
getAuthRealm :: (MonadIO m, IsAuth o) => o -> m T.Text
getAuthRealm :: forall (m :: * -> *) o. (MonadIO m, IsAuth o) => o -> m Text
getAuthRealm o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getAuthRealm" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"realm"

-- | Set the value of the “@realm@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.set' auth [ #realm 'Data.GI.Base.Attributes.:=' value ]
-- @
setAuthRealm :: (MonadIO m, IsAuth o) => o -> T.Text -> m ()
setAuthRealm :: forall (m :: * -> *) o. (MonadIO m, IsAuth o) => o -> Text -> m ()
setAuthRealm o
obj Text
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 -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"realm" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

-- | Construct a `GValueConstruct` with valid value for the “@realm@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructAuthRealm :: (IsAuth o, MIO.MonadIO m) => T.Text -> m (GValueConstruct o)
constructAuthRealm :: forall o (m :: * -> *).
(IsAuth o, MonadIO m) =>
Text -> m (GValueConstruct o)
constructAuthRealm Text
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 -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString String
"realm" (Text -> Maybe Text
forall a. a -> Maybe a
P.Just Text
val)

-- | Set the value of the “@realm@” 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' #realm
-- @
clearAuthRealm :: (MonadIO m, IsAuth o) => o -> m ()
clearAuthRealm :: forall (m :: * -> *) o. (MonadIO m, IsAuth o) => o -> m ()
clearAuthRealm 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 -> Maybe Text -> IO ()
forall a. GObject a => a -> String -> Maybe Text -> IO ()
B.Properties.setObjectPropertyString o
obj String
"realm" (Maybe Text
forall a. Maybe a
Nothing :: Maybe T.Text)

#if defined(ENABLE_OVERLOADING)
data AuthRealmPropertyInfo
instance AttrInfo AuthRealmPropertyInfo where
    type AttrAllowedOps AuthRealmPropertyInfo = '[ 'AttrSet, 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AuthRealmPropertyInfo = IsAuth
    type AttrSetTypeConstraint AuthRealmPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint AuthRealmPropertyInfo = (~) T.Text
    type AttrTransferType AuthRealmPropertyInfo = T.Text
    type AttrGetType AuthRealmPropertyInfo = T.Text
    type AttrLabel AuthRealmPropertyInfo = "realm"
    type AttrOrigin AuthRealmPropertyInfo = Auth
    attrGet = getAuthRealm
    attrSet = setAuthRealm
    attrTransfer _ v = do
        return v
    attrConstruct = constructAuthRealm
    attrClear = clearAuthRealm
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Auth.realm"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Auth.html#g:attr:realm"
        })
#endif

-- VVV Prop "scheme-name"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@scheme-name@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' auth #schemeName
-- @
getAuthSchemeName :: (MonadIO m, IsAuth o) => o -> m T.Text
getAuthSchemeName :: forall (m :: * -> *) o. (MonadIO m, IsAuth o) => o -> m Text
getAuthSchemeName o
obj = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
MIO.liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe Text) -> IO Text
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing Text
"getAuthSchemeName" (IO (Maybe Text) -> IO Text) -> IO (Maybe Text) -> IO Text
forall a b. (a -> b) -> a -> b
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj String
"scheme-name"

#if defined(ENABLE_OVERLOADING)
data AuthSchemeNamePropertyInfo
instance AttrInfo AuthSchemeNamePropertyInfo where
    type AttrAllowedOps AuthSchemeNamePropertyInfo = '[ 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint AuthSchemeNamePropertyInfo = IsAuth
    type AttrSetTypeConstraint AuthSchemeNamePropertyInfo = (~) ()
    type AttrTransferTypeConstraint AuthSchemeNamePropertyInfo = (~) ()
    type AttrTransferType AuthSchemeNamePropertyInfo = ()
    type AttrGetType AuthSchemeNamePropertyInfo = T.Text
    type AttrLabel AuthSchemeNamePropertyInfo = "scheme-name"
    type AttrOrigin AuthSchemeNamePropertyInfo = Auth
    attrGet = getAuthSchemeName
    attrSet = undefined
    attrTransfer _ = undefined
    attrConstruct = undefined
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Soup.Objects.Auth.schemeName"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-soup-2.4.25/docs/GI-Soup-Objects-Auth.html#g:attr:schemeName"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Auth
type instance O.AttributeList Auth = AuthAttributeList
type AuthAttributeList = ('[ '("host", AuthHostPropertyInfo), '("isAuthenticated", AuthIsAuthenticatedPropertyInfo), '("isForProxy", AuthIsForProxyPropertyInfo), '("realm", AuthRealmPropertyInfo), '("schemeName", AuthSchemeNamePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
authHost :: AttrLabelProxy "host"
authHost = AttrLabelProxy

authRealm :: AttrLabelProxy "realm"
authRealm = AttrLabelProxy

authSchemeName :: AttrLabelProxy "schemeName"
authSchemeName = AttrLabelProxy

#endif

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

#endif

-- method Auth::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "type"
--           , argType = TBasicType TGType
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the type of auth to create (a subtype of #SoupAuth)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the #SoupMessage the auth is being created for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "auth_header"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the WWW-Authenticate/Proxy-Authenticate header"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Soup" , name = "Auth" })
-- throws : False
-- Skip return : False

foreign import ccall "soup_auth_new" soup_auth_new :: 
    CGType ->                               -- type : TBasicType TGType
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    CString ->                              -- auth_header : TBasicType TUTF8
    IO (Ptr Auth)

-- | Creates a new t'GI.Soup.Objects.Auth.Auth' of type /@type@/ with the information from
-- /@msg@/ and /@authHeader@/.
-- 
-- This is called by t'GI.Soup.Objects.Session.Session'; you will normally not create auths
-- yourself.
authNew ::
    (B.CallStack.HasCallStack, MonadIO m, Soup.Message.IsMessage a) =>
    GType
    -- ^ /@type@/: the type of auth to create (a subtype of t'GI.Soup.Objects.Auth.Auth')
    -> a
    -- ^ /@msg@/: the t'GI.Soup.Objects.Message.Message' the auth is being created for
    -> T.Text
    -- ^ /@authHeader@/: the WWW-Authenticate\/Proxy-Authenticate header
    -> m (Maybe Auth)
    -- ^ __Returns:__ the new t'GI.Soup.Objects.Auth.Auth', or 'P.Nothing' if it could
    -- not be created
authNew :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsMessage a) =>
GType -> a -> Text -> m (Maybe Auth)
authNew GType
type_ a
msg Text
authHeader = IO (Maybe Auth) -> m (Maybe Auth)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Auth) -> m (Maybe Auth))
-> IO (Maybe Auth) -> m (Maybe Auth)
forall a b. (a -> b) -> a -> b
$ do
    let type_' :: CGType
type_' = GType -> CGType
gtypeToCGType GType
type_
    Ptr Message
msg' <- a -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
msg
    CString
authHeader' <- Text -> IO CString
textToCString Text
authHeader
    Ptr Auth
result <- CGType -> Ptr Message -> CString -> IO (Ptr Auth)
soup_auth_new CGType
type_' Ptr Message
msg' CString
authHeader'
    Maybe Auth
maybeResult <- Ptr Auth -> (Ptr Auth -> IO Auth) -> IO (Maybe Auth)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr Auth
result ((Ptr Auth -> IO Auth) -> IO (Maybe Auth))
-> (Ptr Auth -> IO Auth) -> IO (Maybe Auth)
forall a b. (a -> b) -> a -> b
$ \Ptr Auth
result' -> do
        Auth
result'' <- ((ManagedPtr Auth -> Auth) -> Ptr Auth -> IO Auth
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Auth -> Auth
Auth) Ptr Auth
result'
        Auth -> IO Auth
forall (m :: * -> *) a. Monad m => a -> m a
return Auth
result''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
authHeader'
    Maybe Auth -> IO (Maybe Auth)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Auth
maybeResult

#if defined(ENABLE_OVERLOADING)
#endif

-- method Auth::authenticate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "username"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the username provided by the user or client"
--                 , 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 provided by the user or client"
--                 , 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_authenticate" soup_auth_authenticate :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    CString ->                              -- username : TBasicType TUTF8
    CString ->                              -- password : TBasicType TUTF8
    IO ()

-- | Call this on an auth to authenticate it; normally this will cause
-- the auth\'s message to be requeued with the new authentication info.
authAuthenticate ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> T.Text
    -- ^ /@username@/: the username provided by the user or client
    -> T.Text
    -- ^ /@password@/: the password provided by the user or client
    -> m ()
authAuthenticate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> Text -> Text -> m ()
authAuthenticate a
auth Text
username Text
password = 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 Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CString
username' <- Text -> IO CString
textToCString Text
username
    CString
password' <- Text -> IO CString
textToCString Text
password
    Ptr Auth -> CString -> CString -> IO ()
soup_auth_authenticate Ptr Auth
auth' CString
username' CString
password'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
username'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
password'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AuthAuthenticateMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsAuth a) => O.OverloadedMethod AuthAuthenticateMethodInfo a signature where
    overloadedMethod = authAuthenticate

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


#endif

-- method Auth::can_authenticate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_auth_can_authenticate" soup_auth_can_authenticate :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    IO CInt

-- | Tests if /@auth@/ is able to authenticate by providing credentials to the
-- 'GI.Soup.Objects.Auth.authAuthenticate'.
-- 
-- /Since: 2.54/
authCanAuthenticate ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@auth@/ is able to accept credentials.
authCanAuthenticate :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> m Bool
authCanAuthenticate a
auth = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CInt
result <- Ptr Auth -> IO CInt
soup_auth_can_authenticate Ptr Auth
auth'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AuthCanAuthenticateMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAuth a) => O.OverloadedMethod AuthCanAuthenticateMethodInfo a signature where
    overloadedMethod = authCanAuthenticate

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


#endif

-- method Auth::get_authorization
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupMessage to be authorized"
--                 , 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_get_authorization" soup_auth_get_authorization :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO CString

-- | Generates an appropriate \"Authorization\" header for /@msg@/. (The
-- session will only call this if 'GI.Soup.Objects.Auth.authIsAuthenticated'
-- returned 'P.True'.)
authGetAuthorization ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a, Soup.Message.IsMessage b) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> b
    -- ^ /@msg@/: the t'GI.Soup.Objects.Message.Message' to be authorized
    -> m T.Text
    -- ^ __Returns:__ the \"Authorization\" header, which must be freed.
authGetAuthorization :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAuth a, IsMessage b) =>
a -> b -> m Text
authGetAuthorization a
auth b
msg = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CString
result <- Ptr Auth -> Ptr Message -> IO CString
soup_auth_get_authorization Ptr Auth
auth' Ptr Message
msg'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"authGetAuthorization" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AuthGetAuthorizationMethodInfo
instance (signature ~ (b -> m T.Text), MonadIO m, IsAuth a, Soup.Message.IsMessage b) => O.OverloadedMethod AuthGetAuthorizationMethodInfo a signature where
    overloadedMethod = authGetAuthorization

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


#endif

-- method Auth::get_host
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , 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_get_host" soup_auth_get_host :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    IO CString

-- | Returns the host that /@auth@/ is associated with.
authGetHost ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> m T.Text
    -- ^ __Returns:__ the hostname
authGetHost :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> m Text
authGetHost a
auth = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CString
result <- Ptr Auth -> IO CString
soup_auth_get_host Ptr Auth
auth'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"authGetHost" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AuthGetHostMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAuth a) => O.OverloadedMethod AuthGetHostMethodInfo a signature where
    overloadedMethod = authGetHost

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


#endif

-- method Auth::get_info
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , 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_get_info" soup_auth_get_info :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    IO CString

-- | Gets an opaque identifier for /@auth@/, for use as a hash key or the
-- like. t'GI.Soup.Objects.Auth.Auth' objects from the same server with the same
-- identifier refer to the same authentication domain (eg, the URLs
-- associated with them take the same usernames and passwords).
authGetInfo ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> m T.Text
    -- ^ __Returns:__ the identifier
authGetInfo :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> m Text
authGetInfo a
auth = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CString
result <- Ptr Auth -> IO CString
soup_auth_get_info Ptr Auth
auth'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"authGetInfo" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AuthGetInfoMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAuth a) => O.OverloadedMethod AuthGetInfoMethodInfo a signature where
    overloadedMethod = authGetInfo

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


#endif

-- method Auth::get_protection_space
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_uri"
--           , argType = TInterface Name { namespace = "Soup" , name = "URI" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "the URI of the request that @auth was generated in\nresponse to."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGSList (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "soup_auth_get_protection_space" soup_auth_get_protection_space :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    Ptr Soup.URI.URI ->                     -- source_uri : TInterface (Name {namespace = "Soup", name = "URI"})
    IO (Ptr (GSList CString))

-- | Returns a list of paths on the server which /@auth@/ extends over.
-- (All subdirectories of these paths are also assumed to be part
-- of /@auth@/\'s protection space, unless otherwise discovered not to
-- be.)
authGetProtectionSpace ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> Soup.URI.URI
    -- ^ /@sourceUri@/: the URI of the request that /@auth@/ was generated in
    -- response to.
    -> m [T.Text]
    -- ^ __Returns:__ the list of
    -- paths, which can be freed with @/soup_auth_free_protection_space()/@.
authGetProtectionSpace :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> URI -> m [Text]
authGetProtectionSpace a
auth URI
sourceUri = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    Ptr URI
sourceUri' <- URI -> IO (Ptr URI)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr URI
sourceUri
    Ptr (GSList CString)
result <- Ptr Auth -> Ptr URI -> IO (Ptr (GSList CString))
soup_auth_get_protection_space Ptr Auth
auth' Ptr URI
sourceUri'
    [CString]
result' <- Ptr (GSList CString) -> IO [CString]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    (CString -> IO ()) -> Ptr (GSList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GSList (Ptr a)) -> IO ()
mapGSList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GSList CString)
result
    Ptr (GSList CString) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList CString)
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    URI -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr URI
sourceUri
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

#if defined(ENABLE_OVERLOADING)
data AuthGetProtectionSpaceMethodInfo
instance (signature ~ (Soup.URI.URI -> m [T.Text]), MonadIO m, IsAuth a) => O.OverloadedMethod AuthGetProtectionSpaceMethodInfo a signature where
    overloadedMethod = authGetProtectionSpace

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


#endif

-- method Auth::get_realm
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , 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_get_realm" soup_auth_get_realm :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    IO CString

-- | Returns /@auth@/\'s realm. This is an identifier that distinguishes
-- separate authentication spaces on a given server, and may be some
-- string that is meaningful to the user. (Although it is probably not
-- localized.)
authGetRealm ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> m T.Text
    -- ^ __Returns:__ the realm name
authGetRealm :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> m Text
authGetRealm a
auth = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CString
result <- Ptr Auth -> IO CString
soup_auth_get_realm Ptr Auth
auth'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"authGetRealm" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AuthGetRealmMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAuth a) => O.OverloadedMethod AuthGetRealmMethodInfo a signature where
    overloadedMethod = authGetRealm

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


#endif

-- method Auth::get_saved_password
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_get_saved_password" soup_auth_get_saved_password :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    CString ->                              -- user : TBasicType TUTF8
    IO CString

-- | /No description available in the introspection data./
authGetSavedPassword ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -> T.Text
    -> m T.Text
authGetSavedPassword :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> Text -> m Text
authGetSavedPassword a
auth Text
user = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CString
user' <- Text -> IO CString
textToCString Text
user
    CString
result <- Ptr Auth -> CString -> IO CString
soup_auth_get_saved_password Ptr Auth
auth' CString
user'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"authGetSavedPassword" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
user'
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AuthGetSavedPasswordMethodInfo
instance (signature ~ (T.Text -> m T.Text), MonadIO m, IsAuth a) => O.OverloadedMethod AuthGetSavedPasswordMethodInfo a signature where
    overloadedMethod = authGetSavedPassword

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


#endif

-- method Auth::get_saved_users
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TGSList (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "soup_auth_get_saved_users" soup_auth_get_saved_users :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    IO (Ptr (GSList CString))

-- | /No description available in the introspection data./
authGetSavedUsers ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -> m [T.Text]
authGetSavedUsers :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> m [Text]
authGetSavedUsers a
auth = IO [Text] -> m [Text]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [Text] -> m [Text]) -> IO [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    Ptr (GSList CString)
result <- Ptr Auth -> IO (Ptr (GSList CString))
soup_auth_get_saved_users Ptr Auth
auth'
    [CString]
result' <- Ptr (GSList CString) -> IO [CString]
forall a. Ptr (GSList (Ptr a)) -> IO [Ptr a]
unpackGSList Ptr (GSList CString)
result
    [Text]
result'' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
result'
    (CString -> IO ()) -> Ptr (GSList CString) -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (GSList (Ptr a)) -> IO ()
mapGSList CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (GSList CString)
result
    Ptr (GSList CString) -> IO ()
forall a. Ptr (GSList a) -> IO ()
g_slist_free Ptr (GSList CString)
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result''

#if defined(ENABLE_OVERLOADING)
data AuthGetSavedUsersMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsAuth a) => O.OverloadedMethod AuthGetSavedUsersMethodInfo a signature where
    overloadedMethod = authGetSavedUsers

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


#endif

-- method Auth::get_scheme_name
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , 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_get_scheme_name" soup_auth_get_scheme_name :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    IO CString

-- | Returns /@auth@/\'s scheme name. (Eg, \"Basic\", \"Digest\", or \"NTLM\")
authGetSchemeName ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> m T.Text
    -- ^ __Returns:__ the scheme name
authGetSchemeName :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> m Text
authGetSchemeName a
auth = IO Text -> m Text
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Text -> m Text) -> IO Text -> m Text
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CString
result <- Ptr Auth -> IO CString
soup_auth_get_scheme_name Ptr Auth
auth'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"authGetSchemeName" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data AuthGetSchemeNameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsAuth a) => O.OverloadedMethod AuthGetSchemeNameMethodInfo a signature where
    overloadedMethod = authGetSchemeName

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


#endif

-- method Auth::has_saved_password
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "username"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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_has_saved_password" soup_auth_has_saved_password :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    CString ->                              -- username : TBasicType TUTF8
    CString ->                              -- password : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
authHasSavedPassword ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -> T.Text
    -> T.Text
    -> m ()
authHasSavedPassword :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> Text -> Text -> m ()
authHasSavedPassword a
auth Text
username Text
password = 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 Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CString
username' <- Text -> IO CString
textToCString Text
username
    CString
password' <- Text -> IO CString
textToCString Text
password
    Ptr Auth -> CString -> CString -> IO ()
soup_auth_has_saved_password Ptr Auth
auth' CString
username' CString
password'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
username'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
password'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AuthHasSavedPasswordMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsAuth a) => O.OverloadedMethod AuthHasSavedPasswordMethodInfo a signature where
    overloadedMethod = authHasSavedPassword

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


#endif

-- method Auth::is_authenticated
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_auth_is_authenticated" soup_auth_is_authenticated :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    IO CInt

-- | Tests if /@auth@/ has been given a username and password
authIsAuthenticated ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@auth@/ has been given a username and password
authIsAuthenticated :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> m Bool
authIsAuthenticated a
auth = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CInt
result <- Ptr Auth -> IO CInt
soup_auth_is_authenticated Ptr Auth
auth'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AuthIsAuthenticatedMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAuth a) => O.OverloadedMethod AuthIsAuthenticatedMethodInfo a signature where
    overloadedMethod = authIsAuthenticated

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


#endif

-- method Auth::is_for_proxy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_auth_is_for_proxy" soup_auth_is_for_proxy :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    IO CInt

-- | Tests whether or not /@auth@/ is associated with a proxy server rather
-- than an \"origin\" server.
authIsForProxy ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> m Bool
    -- ^ __Returns:__ 'P.True' or 'P.False'
authIsForProxy :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> m Bool
authIsForProxy a
auth = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CInt
result <- Ptr Auth -> IO CInt
soup_auth_is_for_proxy Ptr Auth
auth'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AuthIsForProxyMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsAuth a) => O.OverloadedMethod AuthIsForProxyMethodInfo a signature where
    overloadedMethod = authIsForProxy

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


#endif

-- method Auth::is_ready
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupMessage" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_auth_is_ready" soup_auth_is_ready :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    IO CInt

-- | Tests if /@auth@/ is ready to make a request for /@msg@/ with. For most
-- auths, this is equivalent to 'GI.Soup.Objects.Auth.authIsAuthenticated', but for
-- some auth types (eg, NTLM), the auth may be sendable (eg, as an
-- authentication request) even before it is authenticated.
-- 
-- /Since: 2.42/
authIsReady ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a, Soup.Message.IsMessage b) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> b
    -- ^ /@msg@/: a t'GI.Soup.Objects.Message.Message'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@auth@/ is ready to make a request with.
authIsReady :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAuth a, IsMessage b) =>
a -> b -> m Bool
authIsReady a
auth b
msg = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CInt
result <- Ptr Auth -> Ptr Message -> IO CInt
soup_auth_is_ready Ptr Auth
auth' Ptr Message
msg'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AuthIsReadyMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsAuth a, Soup.Message.IsMessage b) => O.OverloadedMethod AuthIsReadyMethodInfo a signature where
    overloadedMethod = authIsReady

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


#endif

-- method Auth::save_password
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "username"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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 = Nothing , 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_save_password" soup_auth_save_password :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    CString ->                              -- username : TBasicType TUTF8
    CString ->                              -- password : TBasicType TUTF8
    IO ()

-- | /No description available in the introspection data./
authSavePassword ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a) =>
    a
    -> T.Text
    -> T.Text
    -> m ()
authSavePassword :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsAuth a) =>
a -> Text -> Text -> m ()
authSavePassword a
auth Text
username Text
password = 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 Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    CString
username' <- Text -> IO CString
textToCString Text
username
    CString
password' <- Text -> IO CString
textToCString Text
password
    Ptr Auth -> CString -> CString -> IO ()
soup_auth_save_password Ptr Auth
auth' CString
username' CString
password'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
username'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
password'
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data AuthSavePasswordMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ()), MonadIO m, IsAuth a) => O.OverloadedMethod AuthSavePasswordMethodInfo a signature where
    overloadedMethod = authSavePassword

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


#endif

-- method Auth::update
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "auth"
--           , argType = TInterface Name { namespace = "Soup" , name = "Auth" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #SoupAuth" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "msg"
--           , argType =
--               TInterface Name { namespace = "Soup" , name = "Message" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the #SoupMessage @auth is being updated for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "auth_header"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "the WWW-Authenticate/Proxy-Authenticate header"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "soup_auth_update" soup_auth_update :: 
    Ptr Auth ->                             -- auth : TInterface (Name {namespace = "Soup", name = "Auth"})
    Ptr Soup.Message.Message ->             -- msg : TInterface (Name {namespace = "Soup", name = "Message"})
    CString ->                              -- auth_header : TBasicType TUTF8
    IO CInt

-- | Updates /@auth@/ with the information from /@msg@/ and /@authHeader@/,
-- possibly un-authenticating it. As with 'GI.Soup.Objects.Auth.authNew', this is
-- normally only used by t'GI.Soup.Objects.Session.Session'.
authUpdate ::
    (B.CallStack.HasCallStack, MonadIO m, IsAuth a, Soup.Message.IsMessage b) =>
    a
    -- ^ /@auth@/: a t'GI.Soup.Objects.Auth.Auth'
    -> b
    -- ^ /@msg@/: the t'GI.Soup.Objects.Message.Message' /@auth@/ is being updated for
    -> T.Text
    -- ^ /@authHeader@/: the WWW-Authenticate\/Proxy-Authenticate header
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@auth@/ is still a valid (but potentially
    -- unauthenticated) t'GI.Soup.Objects.Auth.Auth'. 'P.False' if something about /@authParams@/
    -- could not be parsed or incorporated into /@auth@/ at all.
authUpdate :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsAuth a, IsMessage b) =>
a -> b -> Text -> m Bool
authUpdate a
auth b
msg Text
authHeader = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Auth
auth' <- a -> IO (Ptr Auth)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
auth
    Ptr Message
msg' <- b -> IO (Ptr Message)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
msg
    CString
authHeader' <- Text -> IO CString
textToCString Text
authHeader
    CInt
result <- Ptr Auth -> Ptr Message -> CString -> IO CInt
soup_auth_update Ptr Auth
auth' Ptr Message
msg' CString
authHeader'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
auth
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
msg
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
authHeader'
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data AuthUpdateMethodInfo
instance (signature ~ (b -> T.Text -> m Bool), MonadIO m, IsAuth a, Soup.Message.IsMessage b) => O.OverloadedMethod AuthUpdateMethodInfo a signature where
    overloadedMethod = authUpdate

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


#endif