{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- /No description available in the introspection data./

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

module GI.WebKit2.Structs.Credential
    ( 

-- * Exported types
    Credential(..)                          ,
    noCredential                            ,


 -- * Methods
-- ** Overloaded methods #method:Overloaded methods#

#if defined(ENABLE_OVERLOADING)
    ResolveCredentialMethod                 ,
#endif


-- ** copy #method:copy#

#if defined(ENABLE_OVERLOADING)
    CredentialCopyMethodInfo                ,
#endif
    credentialCopy                          ,


-- ** free #method:free#

#if defined(ENABLE_OVERLOADING)
    CredentialFreeMethodInfo                ,
#endif
    credentialFree                          ,


-- ** getPassword #method:getPassword#

#if defined(ENABLE_OVERLOADING)
    CredentialGetPasswordMethodInfo         ,
#endif
    credentialGetPassword                   ,


-- ** getPersistence #method:getPersistence#

#if defined(ENABLE_OVERLOADING)
    CredentialGetPersistenceMethodInfo      ,
#endif
    credentialGetPersistence                ,


-- ** getUsername #method:getUsername#

#if defined(ENABLE_OVERLOADING)
    CredentialGetUsernameMethodInfo         ,
#endif
    credentialGetUsername                   ,


-- ** hasPassword #method:hasPassword#

#if defined(ENABLE_OVERLOADING)
    CredentialHasPasswordMethodInfo         ,
#endif
    credentialHasPassword                   ,


-- ** new #method:new#

    credentialNew                           ,




    ) 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.ManagedPtr as B.ManagedPtr
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 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 {-# SOURCE #-} qualified GI.WebKit2.Enums as WebKit2.Enums

-- | Memory-managed wrapper type.
newtype Credential = Credential (ManagedPtr Credential)
    deriving (Credential -> Credential -> Bool
(Credential -> Credential -> Bool)
-> (Credential -> Credential -> Bool) -> Eq Credential
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Credential -> Credential -> Bool
$c/= :: Credential -> Credential -> Bool
== :: Credential -> Credential -> Bool
$c== :: Credential -> Credential -> Bool
Eq)
foreign import ccall "webkit_credential_get_type" c_webkit_credential_get_type :: 
    IO GType

instance BoxedObject Credential where
    boxedType :: Credential -> IO GType
boxedType _ = IO GType
c_webkit_credential_get_type

-- | Convert 'Credential' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue Credential where
    toGValue :: Credential -> IO GValue
toGValue o :: Credential
o = do
        GType
gtype <- IO GType
c_webkit_credential_get_type
        Credential -> (Ptr Credential -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr Credential
o (GType
-> (GValue -> Ptr Credential -> IO ())
-> Ptr Credential
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr Credential -> IO ()
forall a. GValue -> Ptr a -> IO ()
B.GValue.set_boxed)
        
    fromGValue :: GValue -> IO Credential
fromGValue gv :: GValue
gv = do
        Ptr Credential
ptr <- GValue -> IO (Ptr Credential)
forall b. GValue -> IO (Ptr b)
B.GValue.get_boxed GValue
gv :: IO (Ptr Credential)
        (ManagedPtr Credential -> Credential)
-> Ptr Credential -> IO Credential
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
B.ManagedPtr.newBoxed ManagedPtr Credential -> Credential
Credential Ptr Credential
ptr
        
    

-- | A convenience alias for `Nothing` :: `Maybe` `Credential`.
noCredential :: Maybe Credential
noCredential :: Maybe Credential
noCredential = Maybe Credential
forall a. Maybe a
Nothing


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

-- method Credential::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "username"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The username for the new credential"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "password"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The password for the new credential"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "persistence"
--           , argType =
--               TInterface
--                 Name { namespace = "WebKit2" , name = "CredentialPersistence" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The #WebKitCredentialPersistence of the new credential"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "Credential" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_credential_new" webkit_credential_new :: 
    CString ->                              -- username : TBasicType TUTF8
    CString ->                              -- password : TBasicType TUTF8
    CUInt ->                                -- persistence : TInterface (Name {namespace = "WebKit2", name = "CredentialPersistence"})
    IO (Ptr Credential)

-- | Create a new credential from the provided username, password and persistence mode.
-- 
-- /Since: 2.2/
credentialNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@username@/: The username for the new credential
    -> T.Text
    -- ^ /@password@/: The password for the new credential
    -> WebKit2.Enums.CredentialPersistence
    -- ^ /@persistence@/: The t'GI.WebKit2.Enums.CredentialPersistence' of the new credential
    -> m Credential
    -- ^ __Returns:__ A t'GI.WebKit2.Structs.Credential.Credential'.
credentialNew :: Text -> Text -> CredentialPersistence -> m Credential
credentialNew username :: Text
username password :: Text
password persistence :: CredentialPersistence
persistence = IO Credential -> m Credential
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Credential -> m Credential) -> IO Credential -> m Credential
forall a b. (a -> b) -> a -> b
$ do
    CString
username' <- Text -> IO CString
textToCString Text
username
    CString
password' <- Text -> IO CString
textToCString Text
password
    let persistence' :: CUInt
persistence' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (CredentialPersistence -> Int) -> CredentialPersistence -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CredentialPersistence -> Int
forall a. Enum a => a -> Int
fromEnum) CredentialPersistence
persistence
    Ptr Credential
result <- CString -> CString -> CUInt -> IO (Ptr Credential)
webkit_credential_new CString
username' CString
password' CUInt
persistence'
    Text -> Ptr Credential -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "credentialNew" Ptr Credential
result
    Credential
result' <- ((ManagedPtr Credential -> Credential)
-> Ptr Credential -> IO Credential
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Credential -> Credential
Credential) Ptr Credential
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
username'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
password'
    Credential -> IO Credential
forall (m :: * -> *) a. Monad m => a -> m a
return Credential
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Credential::copy
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "credential"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Credential" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitCredential"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface Name { namespace = "WebKit2" , name = "Credential" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_credential_copy" webkit_credential_copy :: 
    Ptr Credential ->                       -- credential : TInterface (Name {namespace = "WebKit2", name = "Credential"})
    IO (Ptr Credential)

-- | Make a copy of the t'GI.WebKit2.Structs.Credential.Credential'.
-- 
-- /Since: 2.2/
credentialCopy ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Credential
    -- ^ /@credential@/: a t'GI.WebKit2.Structs.Credential.Credential'
    -> m Credential
    -- ^ __Returns:__ A copy of passed in t'GI.WebKit2.Structs.Credential.Credential'
credentialCopy :: Credential -> m Credential
credentialCopy credential :: Credential
credential = IO Credential -> m Credential
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Credential -> m Credential) -> IO Credential -> m Credential
forall a b. (a -> b) -> a -> b
$ do
    Ptr Credential
credential' <- Credential -> IO (Ptr Credential)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Credential
credential
    Ptr Credential
result <- Ptr Credential -> IO (Ptr Credential)
webkit_credential_copy Ptr Credential
credential'
    Text -> Ptr Credential -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "credentialCopy" Ptr Credential
result
    Credential
result' <- ((ManagedPtr Credential -> Credential)
-> Ptr Credential -> IO Credential
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Credential -> Credential
Credential) Ptr Credential
result
    Credential -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Credential
credential
    Credential -> IO Credential
forall (m :: * -> *) a. Monad m => a -> m a
return Credential
result'

#if defined(ENABLE_OVERLOADING)
data CredentialCopyMethodInfo
instance (signature ~ (m Credential), MonadIO m) => O.MethodInfo CredentialCopyMethodInfo Credential signature where
    overloadedMethod = credentialCopy

#endif

-- method Credential::free
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "credential"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Credential" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #WebKitCredential"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "webkit_credential_free" webkit_credential_free :: 
    Ptr Credential ->                       -- credential : TInterface (Name {namespace = "WebKit2", name = "Credential"})
    IO ()

-- | Free the t'GI.WebKit2.Structs.Credential.Credential'.
-- 
-- /Since: 2.2/
credentialFree ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Credential
    -- ^ /@credential@/: A t'GI.WebKit2.Structs.Credential.Credential'
    -> m ()
credentialFree :: Credential -> m ()
credentialFree credential :: Credential
credential = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Credential
credential' <- Credential -> IO (Ptr Credential)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Credential
credential
    Ptr Credential -> IO ()
webkit_credential_free Ptr Credential
credential'
    Credential -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Credential
credential
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CredentialFreeMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo CredentialFreeMethodInfo Credential signature where
    overloadedMethod = credentialFree

#endif

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

foreign import ccall "webkit_credential_get_password" webkit_credential_get_password :: 
    Ptr Credential ->                       -- credential : TInterface (Name {namespace = "WebKit2", name = "Credential"})
    IO CString

-- | Get the password currently held by this t'GI.WebKit2.Structs.Credential.Credential'.
-- 
-- /Since: 2.2/
credentialGetPassword ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Credential
    -- ^ /@credential@/: a t'GI.WebKit2.Structs.Credential.Credential'
    -> m T.Text
    -- ^ __Returns:__ The password stored in the t'GI.WebKit2.Structs.Credential.Credential'.
credentialGetPassword :: Credential -> m Text
credentialGetPassword credential :: Credential
credential = 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 Credential
credential' <- Credential -> IO (Ptr Credential)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Credential
credential
    CString
result <- Ptr Credential -> IO CString
webkit_credential_get_password Ptr Credential
credential'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "credentialGetPassword" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Credential -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Credential
credential
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CredentialGetPasswordMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo CredentialGetPasswordMethodInfo Credential signature where
    overloadedMethod = credentialGetPassword

#endif

-- method Credential::get_persistence
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "credential"
--           , argType =
--               TInterface Name { namespace = "WebKit2" , name = "Credential" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #WebKitCredential"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "WebKit2" , name = "CredentialPersistence" })
-- throws : False
-- Skip return : False

foreign import ccall "webkit_credential_get_persistence" webkit_credential_get_persistence :: 
    Ptr Credential ->                       -- credential : TInterface (Name {namespace = "WebKit2", name = "Credential"})
    IO CUInt

-- | Get the persistence mode currently held by this t'GI.WebKit2.Structs.Credential.Credential'.
-- 
-- /Since: 2.2/
credentialGetPersistence ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Credential
    -- ^ /@credential@/: a t'GI.WebKit2.Structs.Credential.Credential'
    -> m WebKit2.Enums.CredentialPersistence
    -- ^ __Returns:__ The t'GI.WebKit2.Enums.CredentialPersistence' stored in the t'GI.WebKit2.Structs.Credential.Credential'.
credentialGetPersistence :: Credential -> m CredentialPersistence
credentialGetPersistence credential :: Credential
credential = IO CredentialPersistence -> m CredentialPersistence
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CredentialPersistence -> m CredentialPersistence)
-> IO CredentialPersistence -> m CredentialPersistence
forall a b. (a -> b) -> a -> b
$ do
    Ptr Credential
credential' <- Credential -> IO (Ptr Credential)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Credential
credential
    CUInt
result <- Ptr Credential -> IO CUInt
webkit_credential_get_persistence Ptr Credential
credential'
    let result' :: CredentialPersistence
result' = (Int -> CredentialPersistence
forall a. Enum a => Int -> a
toEnum (Int -> CredentialPersistence)
-> (CUInt -> Int) -> CUInt -> CredentialPersistence
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    Credential -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Credential
credential
    CredentialPersistence -> IO CredentialPersistence
forall (m :: * -> *) a. Monad m => a -> m a
return CredentialPersistence
result'

#if defined(ENABLE_OVERLOADING)
data CredentialGetPersistenceMethodInfo
instance (signature ~ (m WebKit2.Enums.CredentialPersistence), MonadIO m) => O.MethodInfo CredentialGetPersistenceMethodInfo Credential signature where
    overloadedMethod = credentialGetPersistence

#endif

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

foreign import ccall "webkit_credential_get_username" webkit_credential_get_username :: 
    Ptr Credential ->                       -- credential : TInterface (Name {namespace = "WebKit2", name = "Credential"})
    IO CString

-- | Get the username currently held by this t'GI.WebKit2.Structs.Credential.Credential'.
-- 
-- /Since: 2.2/
credentialGetUsername ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Credential
    -- ^ /@credential@/: a t'GI.WebKit2.Structs.Credential.Credential'
    -> m T.Text
    -- ^ __Returns:__ The username stored in the t'GI.WebKit2.Structs.Credential.Credential'.
credentialGetUsername :: Credential -> m Text
credentialGetUsername credential :: Credential
credential = 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 Credential
credential' <- Credential -> IO (Ptr Credential)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Credential
credential
    CString
result <- Ptr Credential -> IO CString
webkit_credential_get_username Ptr Credential
credential'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "credentialGetUsername" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Credential -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Credential
credential
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CredentialGetUsernameMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo CredentialGetUsernameMethodInfo Credential signature where
    overloadedMethod = credentialGetUsername

#endif

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

foreign import ccall "webkit_credential_has_password" webkit_credential_has_password :: 
    Ptr Credential ->                       -- credential : TInterface (Name {namespace = "WebKit2", name = "Credential"})
    IO CInt

-- | Determine whether this credential has a password stored.
-- 
-- /Since: 2.2/
credentialHasPassword ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Credential
    -- ^ /@credential@/: a t'GI.WebKit2.Structs.Credential.Credential'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if the credential has a password or 'P.False' otherwise.
credentialHasPassword :: Credential -> m Bool
credentialHasPassword credential :: Credential
credential = 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 Credential
credential' <- Credential -> IO (Ptr Credential)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Credential
credential
    CInt
result <- Ptr Credential -> IO CInt
webkit_credential_has_password Ptr Credential
credential'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Credential -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Credential
credential
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data CredentialHasPasswordMethodInfo
instance (signature ~ (m Bool), MonadIO m) => O.MethodInfo CredentialHasPasswordMethodInfo Credential signature where
    overloadedMethod = credentialHasPassword

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveCredentialMethod (t :: Symbol) (o :: *) :: * where
    ResolveCredentialMethod "copy" o = CredentialCopyMethodInfo
    ResolveCredentialMethod "free" o = CredentialFreeMethodInfo
    ResolveCredentialMethod "hasPassword" o = CredentialHasPasswordMethodInfo
    ResolveCredentialMethod "getPassword" o = CredentialGetPasswordMethodInfo
    ResolveCredentialMethod "getPersistence" o = CredentialGetPersistenceMethodInfo
    ResolveCredentialMethod "getUsername" o = CredentialGetUsernameMethodInfo
    ResolveCredentialMethod l o = O.MethodResolutionFailed l o

instance (info ~ ResolveCredentialMethod t Credential, O.MethodInfo info Credential p) => OL.IsLabel t (Credential -> p) where
#if MIN_VERSION_base(4,10,0)
    fromLabel = O.overloadedMethod @info
#else
    fromLabel _ = O.overloadedMethod @info
#endif

#endif