{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- The t'GI.Gio.Objects.Credentials.Credentials' type is a reference-counted wrapper for native
-- credentials. This information is typically used for identifying,
-- authenticating and authorizing other processes.
-- 
-- Some operating systems supports looking up the credentials of the
-- remote peer of a communication endpoint - see e.g.
-- 'GI.Gio.Objects.Socket.socketGetCredentials'.
-- 
-- Some operating systems supports securely sending and receiving
-- credentials over a Unix Domain Socket, see
-- t'GI.Gio.Objects.UnixCredentialsMessage.UnixCredentialsMessage', 'GI.Gio.Objects.UnixConnection.unixConnectionSendCredentials' and
-- 'GI.Gio.Objects.UnixConnection.unixConnectionReceiveCredentials' for details.
-- 
-- On Linux, the native credential type is a @struct ucred@ - see the
-- unix(7) man page for details. This corresponds to
-- 'GI.Gio.Enums.CredentialsTypeLinuxUcred'.
-- 
-- On Apple operating systems (including iOS, tvOS, and macOS),
-- the native credential type is a @struct xucred@.
-- This corresponds to 'GI.Gio.Enums.CredentialsTypeAppleXucred'.
-- 
-- On FreeBSD, Debian GNU\/kFreeBSD, and GNU\/Hurd, the native
-- credential type is a @struct cmsgcred@. This corresponds
-- to 'GI.Gio.Enums.CredentialsTypeFreebsdCmsgcred'.
-- 
-- On NetBSD, the native credential type is a @struct unpcbid@.
-- This corresponds to 'GI.Gio.Enums.CredentialsTypeNetbsdUnpcbid'.
-- 
-- On OpenBSD, the native credential type is a @struct sockpeercred@.
-- This corresponds to 'GI.Gio.Enums.CredentialsTypeOpenbsdSockpeercred'.
-- 
-- On Solaris (including OpenSolaris and its derivatives), the native
-- credential type is a @ucred_t@. This corresponds to
-- 'GI.Gio.Enums.CredentialsTypeSolarisUcred'.
-- 
-- Since GLib 2.72, on Windows, the native credentials may contain the PID of a
-- process. This corresponds to 'GI.Gio.Enums.CredentialsTypeWin32Pid'.
-- 
-- /Since: 2.26/

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

module GI.Gio.Objects.Credentials
    ( 

-- * Exported types
    Credentials(..)                         ,
    IsCredentials                           ,
    toCredentials                           ,


 -- * Methods
-- | 
-- 
--  === __Click to display all available methods, including inherited ones__
-- ==== Methods
-- [bindProperty]("GI.GObject.Objects.Object#g:method:bindProperty"), [bindPropertyFull]("GI.GObject.Objects.Object#g:method:bindPropertyFull"), [forceFloating]("GI.GObject.Objects.Object#g:method:forceFloating"), [freezeNotify]("GI.GObject.Objects.Object#g:method:freezeNotify"), [getv]("GI.GObject.Objects.Object#g:method:getv"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [isSameUser]("GI.Gio.Objects.Credentials#g:method:isSameUser"), [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"), [stealData]("GI.GObject.Objects.Object#g:method:stealData"), [stealQdata]("GI.GObject.Objects.Object#g:method:stealQdata"), [thawNotify]("GI.GObject.Objects.Object#g:method:thawNotify"), [toString]("GI.Gio.Objects.Credentials#g:method:toString"), [unref]("GI.GObject.Objects.Object#g:method:unref"), [watchClosure]("GI.GObject.Objects.Object#g:method:watchClosure").
-- 
-- ==== Getters
-- [getData]("GI.GObject.Objects.Object#g:method:getData"), [getProperty]("GI.GObject.Objects.Object#g:method:getProperty"), [getQdata]("GI.GObject.Objects.Object#g:method:getQdata"), [getUnixPid]("GI.Gio.Objects.Credentials#g:method:getUnixPid"), [getUnixUser]("GI.Gio.Objects.Credentials#g:method:getUnixUser").
-- 
-- ==== Setters
-- [setData]("GI.GObject.Objects.Object#g:method:setData"), [setDataFull]("GI.GObject.Objects.Object#g:method:setDataFull"), [setNative]("GI.Gio.Objects.Credentials#g:method:setNative"), [setProperty]("GI.GObject.Objects.Object#g:method:setProperty"), [setUnixUser]("GI.Gio.Objects.Credentials#g:method:setUnixUser").

#if defined(ENABLE_OVERLOADING)
    ResolveCredentialsMethod                ,
#endif

-- ** getUnixPid #method:getUnixPid#

#if defined(ENABLE_OVERLOADING)
    CredentialsGetUnixPidMethodInfo         ,
#endif
    credentialsGetUnixPid                   ,


-- ** getUnixUser #method:getUnixUser#

#if defined(ENABLE_OVERLOADING)
    CredentialsGetUnixUserMethodInfo        ,
#endif
    credentialsGetUnixUser                  ,


-- ** isSameUser #method:isSameUser#

#if defined(ENABLE_OVERLOADING)
    CredentialsIsSameUserMethodInfo         ,
#endif
    credentialsIsSameUser                   ,


-- ** new #method:new#

    credentialsNew                          ,


-- ** setNative #method:setNative#

#if defined(ENABLE_OVERLOADING)
    CredentialsSetNativeMethodInfo          ,
#endif
    credentialsSetNative                    ,


-- ** setUnixUser #method:setUnixUser#

#if defined(ENABLE_OVERLOADING)
    CredentialsSetUnixUserMethodInfo        ,
#endif
    credentialsSetUnixUser                  ,


-- ** toString #method:toString#

#if defined(ENABLE_OVERLOADING)
    CredentialsToStringMethodInfo           ,
#endif
    credentialsToString                     ,




    ) where

import Data.GI.Base.ShortPrelude
import qualified Data.GI.Base.ShortPrelude as SP
import qualified Data.GI.Base.Overloading as O
import qualified Prelude as P

import qualified Data.GI.Base.Attributes as GI.Attributes
import qualified Data.GI.Base.BasicTypes as B.Types
import qualified Data.GI.Base.ManagedPtr as B.ManagedPtr
import qualified Data.GI.Base.GArray as B.GArray
import qualified Data.GI.Base.GClosure as B.GClosure
import qualified Data.GI.Base.GError as B.GError
import qualified Data.GI.Base.GHashTable as B.GHT
import qualified Data.GI.Base.GVariant as B.GVariant
import qualified Data.GI.Base.GValue as B.GValue
import qualified Data.GI.Base.GParamSpec as B.GParamSpec
import qualified Data.GI.Base.CallStack as B.CallStack
import qualified Data.GI.Base.Properties as B.Properties
import qualified Data.GI.Base.Signals as B.Signals
import qualified Control.Monad.IO.Class as MIO
import qualified Data.Coerce as Coerce
import qualified Data.Text as T
import qualified Data.Kind as DK
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.Gio.Enums as Gio.Enums

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

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

foreign import ccall "g_credentials_get_type"
    c_g_credentials_get_type :: IO B.Types.GType

instance B.Types.TypedObject Credentials where
    glibType :: IO GType
glibType = IO GType
c_g_credentials_get_type

instance B.Types.GObject Credentials

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

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

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveCredentialsMethod (t :: Symbol) (o :: DK.Type) :: DK.Type where
    ResolveCredentialsMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCredentialsMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCredentialsMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCredentialsMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCredentialsMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCredentialsMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCredentialsMethod "isSameUser" o = CredentialsIsSameUserMethodInfo
    ResolveCredentialsMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCredentialsMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCredentialsMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCredentialsMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCredentialsMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCredentialsMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCredentialsMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCredentialsMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCredentialsMethod "toString" o = CredentialsToStringMethodInfo
    ResolveCredentialsMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCredentialsMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCredentialsMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCredentialsMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCredentialsMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCredentialsMethod "getUnixPid" o = CredentialsGetUnixPidMethodInfo
    ResolveCredentialsMethod "getUnixUser" o = CredentialsGetUnixUserMethodInfo
    ResolveCredentialsMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCredentialsMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCredentialsMethod "setNative" o = CredentialsSetNativeMethodInfo
    ResolveCredentialsMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCredentialsMethod "setUnixUser" o = CredentialsSetUnixUserMethodInfo
    ResolveCredentialsMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Credentials
type instance O.AttributeList Credentials = CredentialsAttributeList
type CredentialsAttributeList = ('[ ] :: [(Symbol, DK.Type)])
#endif

#if defined(ENABLE_OVERLOADING)
#endif

#if defined(ENABLE_OVERLOADING)
type instance O.SignalList Credentials = CredentialsSignalList
type CredentialsSignalList = ('[ '("notify", GObject.Object.ObjectNotifySignalInfo)] :: [(Symbol, DK.Type)])

#endif

-- method Credentials::new
-- method type : Constructor
-- Args: []
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "Credentials" })
-- throws : False
-- Skip return : False

foreign import ccall "g_credentials_new" g_credentials_new :: 
    IO (Ptr Credentials)

-- | Creates a new t'GI.Gio.Objects.Credentials.Credentials' object with credentials matching the
-- the current process.
-- 
-- /Since: 2.26/
credentialsNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Credentials
    -- ^ __Returns:__ A t'GI.Gio.Objects.Credentials.Credentials'. Free with 'GI.GObject.Objects.Object.objectUnref'.
credentialsNew :: forall (m :: * -> *). (HasCallStack, MonadIO m) => m Credentials
credentialsNew  = IO Credentials -> m Credentials
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Credentials -> m Credentials)
-> IO Credentials -> m Credentials
forall a b. (a -> b) -> a -> b
$ do
    Ptr Credentials
result <- IO (Ptr Credentials)
g_credentials_new
    Text -> Ptr Credentials -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"credentialsNew" Ptr Credentials
result
    Credentials
result' <- ((ManagedPtr Credentials -> Credentials)
-> Ptr Credentials -> IO Credentials
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Credentials -> Credentials
Credentials) Ptr Credentials
result
    Credentials -> IO Credentials
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Credentials
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Credentials::get_unix_pid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "credentials"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Credentials" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCredentials" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TInt)
-- throws : True
-- Skip return : False

foreign import ccall "g_credentials_get_unix_pid" g_credentials_get_unix_pid :: 
    Ptr Credentials ->                      -- credentials : TInterface (Name {namespace = "Gio", name = "Credentials"})
    Ptr (Ptr GError) ->                     -- error
    IO Int32

-- | Tries to get the UNIX process identifier from /@credentials@/. This
-- method is only available on UNIX platforms.
-- 
-- This operation can fail if t'GI.Gio.Objects.Credentials.Credentials' is not supported on the
-- OS or if the native credentials type does not contain information
-- about the UNIX process ID.
-- 
-- /Since: 2.36/
credentialsGetUnixPid ::
    (B.CallStack.HasCallStack, MonadIO m, IsCredentials a) =>
    a
    -- ^ /@credentials@/: A t'GI.Gio.Objects.Credentials.Credentials'
    -> m Int32
    -- ^ __Returns:__ The UNIX process ID, or @-1@ if /@error@/ is set. /(Can throw 'Data.GI.Base.GError.GError')/
credentialsGetUnixPid :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCredentials a) =>
a -> m Int32
credentialsGetUnixPid a
credentials = IO Int32 -> m Int32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Credentials
credentials' <- a -> IO (Ptr Credentials)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
credentials
    IO Int32 -> IO () -> IO Int32
forall a b. IO a -> IO b -> IO a
onException (do
        Int32
result <- (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Int32) -> IO Int32)
-> (Ptr (Ptr GError) -> IO Int32) -> IO Int32
forall a b. (a -> b) -> a -> b
$ Ptr Credentials -> Ptr (Ptr GError) -> IO Int32
g_credentials_get_unix_pid Ptr Credentials
credentials'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
credentials
        Int32 -> IO Int32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CredentialsGetUnixPidMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsCredentials a) => O.OverloadedMethod CredentialsGetUnixPidMethodInfo a signature where
    overloadedMethod = credentialsGetUnixPid

instance O.OverloadedMethodInfo CredentialsGetUnixPidMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Credentials.credentialsGetUnixPid",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-Credentials.html#v:credentialsGetUnixPid"
        })


#endif

-- method Credentials::get_unix_user
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "credentials"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Credentials" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCredentials" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : True
-- Skip return : False

foreign import ccall "g_credentials_get_unix_user" g_credentials_get_unix_user :: 
    Ptr Credentials ->                      -- credentials : TInterface (Name {namespace = "Gio", name = "Credentials"})
    Ptr (Ptr GError) ->                     -- error
    IO Word32

-- | Tries to get the UNIX user identifier from /@credentials@/. This
-- method is only available on UNIX platforms.
-- 
-- This operation can fail if t'GI.Gio.Objects.Credentials.Credentials' is not supported on the
-- OS or if the native credentials type does not contain information
-- about the UNIX user.
-- 
-- /Since: 2.26/
credentialsGetUnixUser ::
    (B.CallStack.HasCallStack, MonadIO m, IsCredentials a) =>
    a
    -- ^ /@credentials@/: A t'GI.Gio.Objects.Credentials.Credentials'
    -> m Word32
    -- ^ __Returns:__ The UNIX user identifier or @-1@ if /@error@/ is set. /(Can throw 'Data.GI.Base.GError.GError')/
credentialsGetUnixUser :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCredentials a) =>
a -> m Word32
credentialsGetUnixUser a
credentials = IO Word32 -> m Word32
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word32 -> m Word32) -> IO Word32 -> m Word32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Credentials
credentials' <- a -> IO (Ptr Credentials)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
credentials
    IO Word32 -> IO () -> IO Word32
forall a b. IO a -> IO b -> IO a
onException (do
        Word32
result <- (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO Word32) -> IO Word32)
-> (Ptr (Ptr GError) -> IO Word32) -> IO Word32
forall a b. (a -> b) -> a -> b
$ Ptr Credentials -> Ptr (Ptr GError) -> IO Word32
g_credentials_get_unix_user Ptr Credentials
credentials'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
credentials
        Word32 -> IO Word32
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CredentialsGetUnixUserMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsCredentials a) => O.OverloadedMethod CredentialsGetUnixUserMethodInfo a signature where
    overloadedMethod = credentialsGetUnixUser

instance O.OverloadedMethodInfo CredentialsGetUnixUserMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Credentials.credentialsGetUnixUser",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-Credentials.html#v:credentialsGetUnixUser"
        })


#endif

-- method Credentials::is_same_user
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "credentials"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Credentials" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCredentials." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "other_credentials"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Credentials" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCredentials." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_credentials_is_same_user" g_credentials_is_same_user :: 
    Ptr Credentials ->                      -- credentials : TInterface (Name {namespace = "Gio", name = "Credentials"})
    Ptr Credentials ->                      -- other_credentials : TInterface (Name {namespace = "Gio", name = "Credentials"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Checks if /@credentials@/ and /@otherCredentials@/ is the same user.
-- 
-- This operation can fail if t'GI.Gio.Objects.Credentials.Credentials' is not supported on the
-- the OS.
-- 
-- /Since: 2.26/
credentialsIsSameUser ::
    (B.CallStack.HasCallStack, MonadIO m, IsCredentials a, IsCredentials b) =>
    a
    -- ^ /@credentials@/: A t'GI.Gio.Objects.Credentials.Credentials'.
    -> b
    -- ^ /@otherCredentials@/: A t'GI.Gio.Objects.Credentials.Credentials'.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
credentialsIsSameUser :: forall (m :: * -> *) a b.
(HasCallStack, MonadIO m, IsCredentials a, IsCredentials b) =>
a -> b -> m ()
credentialsIsSameUser a
credentials b
otherCredentials = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Credentials
credentials' <- a -> IO (Ptr Credentials)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
credentials
    Ptr Credentials
otherCredentials' <- b -> IO (Ptr Credentials)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
otherCredentials
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Credentials -> Ptr Credentials -> Ptr (Ptr GError) -> IO CInt
g_credentials_is_same_user Ptr Credentials
credentials' Ptr Credentials
otherCredentials'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
credentials
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
otherCredentials
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CredentialsIsSameUserMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsCredentials a, IsCredentials b) => O.OverloadedMethod CredentialsIsSameUserMethodInfo a signature where
    overloadedMethod = credentialsIsSameUser

instance O.OverloadedMethodInfo CredentialsIsSameUserMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Credentials.credentialsIsSameUser",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-Credentials.html#v:credentialsIsSameUser"
        })


#endif

-- method Credentials::set_native
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "credentials"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Credentials" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCredentials." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "native_type"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "CredentialsType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The type of native credentials to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "native"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A pointer to native credentials."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "g_credentials_set_native" g_credentials_set_native :: 
    Ptr Credentials ->                      -- credentials : TInterface (Name {namespace = "Gio", name = "Credentials"})
    CUInt ->                                -- native_type : TInterface (Name {namespace = "Gio", name = "CredentialsType"})
    Ptr () ->                               -- native : TBasicType TPtr
    IO ()

-- | Copies the native credentials of type /@nativeType@/ from /@native@/
-- into /@credentials@/.
-- 
-- It is a programming error (which will cause a warning to be
-- logged) to use this method if there is no t'GI.Gio.Objects.Credentials.Credentials' support for
-- the OS or if /@nativeType@/ isn\'t supported by the OS.
-- 
-- /Since: 2.26/
credentialsSetNative ::
    (B.CallStack.HasCallStack, MonadIO m, IsCredentials a) =>
    a
    -- ^ /@credentials@/: A t'GI.Gio.Objects.Credentials.Credentials'.
    -> Gio.Enums.CredentialsType
    -- ^ /@nativeType@/: The type of native credentials to set.
    -> Ptr ()
    -- ^ /@native@/: A pointer to native credentials.
    -> m ()
credentialsSetNative :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCredentials a) =>
a -> CredentialsType -> Ptr () -> m ()
credentialsSetNative a
credentials CredentialsType
nativeType Ptr ()
native = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Credentials
credentials' <- a -> IO (Ptr Credentials)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
credentials
    let nativeType' :: CUInt
nativeType' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (CredentialsType -> Int) -> CredentialsType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CredentialsType -> Int
forall a. Enum a => a -> Int
fromEnum) CredentialsType
nativeType
    Ptr Credentials -> CUInt -> Ptr () -> IO ()
g_credentials_set_native Ptr Credentials
credentials' CUInt
nativeType' Ptr ()
native
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
credentials
    () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data CredentialsSetNativeMethodInfo
instance (signature ~ (Gio.Enums.CredentialsType -> Ptr () -> m ()), MonadIO m, IsCredentials a) => O.OverloadedMethod CredentialsSetNativeMethodInfo a signature where
    overloadedMethod = credentialsSetNative

instance O.OverloadedMethodInfo CredentialsSetNativeMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Credentials.credentialsSetNative",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-Credentials.html#v:credentialsSetNative"
        })


#endif

-- method Credentials::set_unix_user
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "credentials"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Credentials" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCredentials." , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "uid"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The UNIX user identifier to set."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "g_credentials_set_unix_user" g_credentials_set_unix_user :: 
    Ptr Credentials ->                      -- credentials : TInterface (Name {namespace = "Gio", name = "Credentials"})
    Word32 ->                               -- uid : TBasicType TUInt
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Tries to set the UNIX user identifier on /@credentials@/. This method
-- is only available on UNIX platforms.
-- 
-- This operation can fail if t'GI.Gio.Objects.Credentials.Credentials' is not supported on the
-- OS or if the native credentials type does not contain information
-- about the UNIX user. It can also fail if the OS does not allow the
-- use of \"spoofed\" credentials.
-- 
-- /Since: 2.26/
credentialsSetUnixUser ::
    (B.CallStack.HasCallStack, MonadIO m, IsCredentials a) =>
    a
    -- ^ /@credentials@/: A t'GI.Gio.Objects.Credentials.Credentials'.
    -> Word32
    -- ^ /@uid@/: The UNIX user identifier to set.
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
credentialsSetUnixUser :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCredentials a) =>
a -> Word32 -> m ()
credentialsSetUnixUser a
credentials Word32
uid = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Ptr Credentials
credentials' <- a -> IO (Ptr Credentials)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
credentials
    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
onException (do
        CInt
_ <- (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO CInt) -> IO CInt)
-> (Ptr (Ptr GError) -> IO CInt) -> IO CInt
forall a b. (a -> b) -> a -> b
$ Ptr Credentials -> Word32 -> Ptr (Ptr GError) -> IO CInt
g_credentials_set_unix_user Ptr Credentials
credentials' Word32
uid
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
credentials
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data CredentialsSetUnixUserMethodInfo
instance (signature ~ (Word32 -> m ()), MonadIO m, IsCredentials a) => O.OverloadedMethod CredentialsSetUnixUserMethodInfo a signature where
    overloadedMethod = credentialsSetUnixUser

instance O.OverloadedMethodInfo CredentialsSetUnixUserMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Credentials.credentialsSetUnixUser",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-Credentials.html#v:credentialsSetUnixUser"
        })


#endif

-- method Credentials::to_string
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "credentials"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Credentials" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCredentials object."
--                 , 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 "g_credentials_to_string" g_credentials_to_string :: 
    Ptr Credentials ->                      -- credentials : TInterface (Name {namespace = "Gio", name = "Credentials"})
    IO CString

-- | Creates a human-readable textual representation of /@credentials@/
-- that can be used in logging and debug messages. The format of the
-- returned string may change in future GLib release.
-- 
-- /Since: 2.26/
credentialsToString ::
    (B.CallStack.HasCallStack, MonadIO m, IsCredentials a) =>
    a
    -- ^ /@credentials@/: A t'GI.Gio.Objects.Credentials.Credentials' object.
    -> m T.Text
    -- ^ __Returns:__ A string that should be freed with 'GI.GLib.Functions.free'.
credentialsToString :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCredentials a) =>
a -> m Text
credentialsToString a
credentials = IO Text -> m Text
forall a. IO a -> m a
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 Credentials
credentials' <- a -> IO (Ptr Credentials)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
credentials
    CString
result <- Ptr Credentials -> IO CString
g_credentials_to_string Ptr Credentials
credentials'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"credentialsToString" 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
credentials
    Text -> IO Text
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CredentialsToStringMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsCredentials a) => O.OverloadedMethod CredentialsToStringMethodInfo a signature where
    overloadedMethod = credentialsToString

instance O.OverloadedMethodInfo CredentialsToStringMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Gio.Objects.Credentials.credentialsToString",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-gio-2.0.32/docs/GI-Gio-Objects-Credentials.html#v:credentialsToString"
        })


#endif