{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson and Iñaki García Etxebarria
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- Represents a ssh interactive credential.

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

module GI.Ggit.Objects.CredSshInteractive
    ( 

-- * Exported types
    CredSshInteractive(..)                  ,
    IsCredSshInteractive                    ,
    toCredSshInteractive                    ,


 -- * 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"), [init]("GI.Gio.Interfaces.Initable#g:method:init"), [isFloating]("GI.GObject.Objects.Object#g:method:isFloating"), [notify]("GI.GObject.Objects.Object#g:method:notify"), [notifyByPspec]("GI.GObject.Objects.Object#g:method:notifyByPspec"), [ref]("GI.GObject.Objects.Object#g:method:ref"), [refSink]("GI.GObject.Objects.Object#g:method:refSink"), [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"), [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"), [getUsername]("GI.Ggit.Objects.CredSshInteractive#g:method:getUsername").
-- 
-- ==== 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)
    ResolveCredSshInteractiveMethod         ,
#endif

-- ** getUsername #method:getUsername#

#if defined(ENABLE_OVERLOADING)
    CredSshInteractiveGetUsernameMethodInfo ,
#endif
    credSshInteractiveGetUsername           ,


-- ** new #method:new#

    credSshInteractiveNew                   ,




 -- * Properties


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

#if defined(ENABLE_OVERLOADING)
    CredSshInteractiveUsernamePropertyInfo  ,
#endif
    constructCredSshInteractiveUsername     ,
#if defined(ENABLE_OVERLOADING)
    credSshInteractiveUsername              ,
#endif
    getCredSshInteractiveUsername           ,




    ) 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.Ggit.Objects.Cred as Ggit.Cred
import {-# SOURCE #-} qualified GI.Ggit.Objects.Native as Ggit.Native
import {-# SOURCE #-} qualified GI.Ggit.Objects.ObjectFactoryBase as Ggit.ObjectFactoryBase
import qualified GI.Gio.Interfaces.Initable as Gio.Initable

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

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

foreign import ccall "ggit_cred_ssh_interactive_get_type"
    c_ggit_cred_ssh_interactive_get_type :: IO B.Types.GType

instance B.Types.TypedObject CredSshInteractive where
    glibType :: IO GType
glibType = IO GType
c_ggit_cred_ssh_interactive_get_type

instance B.Types.GObject CredSshInteractive

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

instance O.HasParentTypes CredSshInteractive
type instance O.ParentTypes CredSshInteractive = '[Ggit.Cred.Cred, Ggit.Native.Native, Ggit.ObjectFactoryBase.ObjectFactoryBase, GObject.Object.Object, Gio.Initable.Initable]

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

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

#if defined(ENABLE_OVERLOADING)
type family ResolveCredSshInteractiveMethod (t :: Symbol) (o :: *) :: * where
    ResolveCredSshInteractiveMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveCredSshInteractiveMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveCredSshInteractiveMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveCredSshInteractiveMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveCredSshInteractiveMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveCredSshInteractiveMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveCredSshInteractiveMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveCredSshInteractiveMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveCredSshInteractiveMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveCredSshInteractiveMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveCredSshInteractiveMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveCredSshInteractiveMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveCredSshInteractiveMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveCredSshInteractiveMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveCredSshInteractiveMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveCredSshInteractiveMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveCredSshInteractiveMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveCredSshInteractiveMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveCredSshInteractiveMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveCredSshInteractiveMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveCredSshInteractiveMethod "getUsername" o = CredSshInteractiveGetUsernameMethodInfo
    ResolveCredSshInteractiveMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveCredSshInteractiveMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveCredSshInteractiveMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveCredSshInteractiveMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#endif

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

-- | Get the value of the “@username@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' credSshInteractive #username
-- @
getCredSshInteractiveUsername :: (MonadIO m, IsCredSshInteractive o) => o -> m T.Text
getCredSshInteractiveUsername :: forall (m :: * -> *) o.
(MonadIO m, IsCredSshInteractive o) =>
o -> m Text
getCredSshInteractiveUsername 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
"getCredSshInteractiveUsername" (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
"username"

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

#if defined(ENABLE_OVERLOADING)
data CredSshInteractiveUsernamePropertyInfo
instance AttrInfo CredSshInteractiveUsernamePropertyInfo where
    type AttrAllowedOps CredSshInteractiveUsernamePropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint CredSshInteractiveUsernamePropertyInfo = IsCredSshInteractive
    type AttrSetTypeConstraint CredSshInteractiveUsernamePropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint CredSshInteractiveUsernamePropertyInfo = (~) T.Text
    type AttrTransferType CredSshInteractiveUsernamePropertyInfo = T.Text
    type AttrGetType CredSshInteractiveUsernamePropertyInfo = T.Text
    type AttrLabel CredSshInteractiveUsernamePropertyInfo = "username"
    type AttrOrigin CredSshInteractiveUsernamePropertyInfo = CredSshInteractive
    attrGet = getCredSshInteractiveUsername
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructCredSshInteractiveUsername
    attrClear = undefined
    dbgAttrInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.CredSshInteractive.username"
        , O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Objects-CredSshInteractive.html#g:attr:username"
        })
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList CredSshInteractive
type instance O.AttributeList CredSshInteractive = CredSshInteractiveAttributeList
type CredSshInteractiveAttributeList = ('[ '("native", Ggit.Native.NativeNativePropertyInfo), '("username", CredSshInteractiveUsernamePropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
credSshInteractiveUsername :: AttrLabelProxy "username"
credSshInteractiveUsername = AttrLabelProxy

#endif

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

#endif

-- method CredSshInteractive::new
-- method type : Constructor
-- Args: [ 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
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "Ggit" , name = "CredSshInteractive" })
-- throws : True
-- Skip return : False

foreign import ccall "ggit_cred_ssh_interactive_new" ggit_cred_ssh_interactive_new :: 
    CString ->                              -- username : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr CredSshInteractive)

-- | /No description available in the introspection data./
credSshInteractiveNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> m CredSshInteractive
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
credSshInteractiveNew :: forall (m :: * -> *).
(HasCallStack, MonadIO m) =>
Text -> m CredSshInteractive
credSshInteractiveNew Text
username = IO CredSshInteractive -> m CredSshInteractive
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO CredSshInteractive -> m CredSshInteractive)
-> IO CredSshInteractive -> m CredSshInteractive
forall a b. (a -> b) -> a -> b
$ do
    CString
username' <- Text -> IO CString
textToCString Text
username
    IO CredSshInteractive -> IO () -> IO CredSshInteractive
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr CredSshInteractive
result <- (Ptr (Ptr GError) -> IO (Ptr CredSshInteractive))
-> IO (Ptr CredSshInteractive)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr CredSshInteractive))
 -> IO (Ptr CredSshInteractive))
-> (Ptr (Ptr GError) -> IO (Ptr CredSshInteractive))
-> IO (Ptr CredSshInteractive)
forall a b. (a -> b) -> a -> b
$ CString -> Ptr (Ptr GError) -> IO (Ptr CredSshInteractive)
ggit_cred_ssh_interactive_new CString
username'
        Text -> Ptr CredSshInteractive -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"credSshInteractiveNew" Ptr CredSshInteractive
result
        CredSshInteractive
result' <- ((ManagedPtr CredSshInteractive -> CredSshInteractive)
-> Ptr CredSshInteractive -> IO CredSshInteractive
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr CredSshInteractive -> CredSshInteractive
CredSshInteractive) Ptr CredSshInteractive
result
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
username'
        CredSshInteractive -> IO CredSshInteractive
forall (m :: * -> *) a. Monad m => a -> m a
return CredSshInteractive
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
username'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method CredSshInteractive::get_username
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "cred"
--           , argType =
--               TInterface
--                 Name { namespace = "Ggit" , name = "CredSshInteractive" }
--           , 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 "ggit_cred_ssh_interactive_get_username" ggit_cred_ssh_interactive_get_username :: 
    Ptr CredSshInteractive ->               -- cred : TInterface (Name {namespace = "Ggit", name = "CredSshInteractive"})
    IO CString

-- | /No description available in the introspection data./
credSshInteractiveGetUsername ::
    (B.CallStack.HasCallStack, MonadIO m, IsCredSshInteractive a) =>
    a
    -> m T.Text
credSshInteractiveGetUsername :: forall (m :: * -> *) a.
(HasCallStack, MonadIO m, IsCredSshInteractive a) =>
a -> m Text
credSshInteractiveGetUsername a
cred = 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 CredSshInteractive
cred' <- a -> IO (Ptr CredSshInteractive)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
cred
    CString
result <- Ptr CredSshInteractive -> IO CString
ggit_cred_ssh_interactive_get_username Ptr CredSshInteractive
cred'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL Text
"credSshInteractiveGetUsername" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
cred
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data CredSshInteractiveGetUsernameMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsCredSshInteractive a) => O.OverloadedMethod CredSshInteractiveGetUsernameMethodInfo a signature where
    overloadedMethod = credSshInteractiveGetUsername

instance O.OverloadedMethodInfo CredSshInteractiveGetUsernameMethodInfo a where
    overloadedMethodInfo = P.Just (O.ResolvedSymbolInfo {
        O.resolvedSymbolName = "GI.Ggit.Objects.CredSshInteractive.credSshInteractiveGetUsername",
        O.resolvedSymbolURL = "https://hackage.haskell.org/package/gi-ggit-1.0.11/docs/GI-Ggit-Objects-CredSshInteractive.html#v:credSshInteractiveGetUsername"
        })


#endif