{-# LANGUAGE TypeApplications #-}


-- | Copyright  : Will Thompson, Iñaki García Etxebarria and Jonas Platte
-- License    : LGPL-2.1
-- Maintainer : Iñaki García Etxebarria
-- 
-- A secret value, like a password or other binary secret.

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

module GI.Secret.Structs.Value
    ( 

-- * Exported types
    Value(..)                               ,
    noValue                                 ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveValueMethod                      ,
#endif


-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    ValueGetMethodInfo                      ,
#endif
    valueGet                                ,


-- ** getContentType #method:getContentType#

#if defined(ENABLE_OVERLOADING)
    ValueGetContentTypeMethodInfo           ,
#endif
    valueGetContentType                     ,


-- ** getText #method:getText#

#if defined(ENABLE_OVERLOADING)
    ValueGetTextMethodInfo                  ,
#endif
    valueGetText                            ,


-- ** new #method:new#

    valueNew                                ,


-- ** newFull #method:newFull#

    valueNewFull                            ,


-- ** ref #method:ref#

#if defined(ENABLE_OVERLOADING)
    ValueRefMethodInfo                      ,
#endif
    valueRef                                ,


-- ** unref #method:unref#

#if defined(ENABLE_OVERLOADING)
    ValueUnrefMethodInfo                    ,
#endif
    valueUnref                              ,




    ) 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 qualified GI.GLib.Callbacks as GLib.Callbacks

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

instance BoxedObject Value where
    boxedType :: Value -> IO GType
boxedType _ = IO GType
c_secret_value_get_type

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

-- | A convenience alias for `Nothing` :: `Maybe` `Value`.
noValue :: Maybe Value
noValue :: Maybe Value
noValue = Maybe Value
forall a. Maybe a
Nothing


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

-- method Value::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "secret"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content type of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "secret_value_new" secret_value_new :: 
    CString ->                              -- secret : TBasicType TUTF8
    Int64 ->                                -- length : TBasicType TInt64
    CString ->                              -- content_type : TBasicType TUTF8
    IO (Ptr Value)

-- | Create a t'GI.Secret.Structs.Value.Value' for the secret data passed in. The secret data is
-- copied into non-pageable \'secure\' memory.
-- 
-- If the length is less than zero, then /@secret@/ is assumed to be
-- null-terminated.
valueNew ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@secret@/: the secret data
    -> Int64
    -- ^ /@length@/: the length of the data
    -> T.Text
    -- ^ /@contentType@/: the content type of the data
    -> m Value
    -- ^ __Returns:__ the new t'GI.Secret.Structs.Value.Value'
valueNew :: Text -> Int64 -> Text -> m Value
valueNew secret :: Text
secret length_ :: Int64
length_ contentType :: Text
contentType = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    CString
secret' <- Text -> IO CString
textToCString Text
secret
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    Ptr Value
result <- CString -> Int64 -> CString -> IO (Ptr Value)
secret_value_new CString
secret' Int64
length_ CString
contentType'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "valueNew" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Value -> Value
Value) Ptr Value
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
secret'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::new_full
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "secret"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the secret data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "content_type"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the content type of the data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destroy"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "DestroyNotify" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "function to call to free the secret data"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "secret_value_new_full" secret_value_new_full :: 
    CString ->                              -- secret : TBasicType TUTF8
    Int64 ->                                -- length : TBasicType TInt64
    CString ->                              -- content_type : TBasicType TUTF8
    FunPtr GLib.Callbacks.C_DestroyNotify -> -- destroy : TInterface (Name {namespace = "GLib", name = "DestroyNotify"})
    IO (Ptr Value)

-- | Create a t'GI.Secret.Structs.Value.Value' for the secret data passed in. The secret data is
-- not copied, and will later be freed with the /@destroy@/ function.
-- 
-- If the length is less than zero, then /@secret@/ is assumed to be
-- null-terminated.
valueNewFull ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -- ^ /@secret@/: the secret data
    -> Int64
    -- ^ /@length@/: the length of the data
    -> T.Text
    -- ^ /@contentType@/: the content type of the data
    -> GLib.Callbacks.DestroyNotify
    -- ^ /@destroy@/: function to call to free the secret data
    -> m Value
    -- ^ __Returns:__ the new t'GI.Secret.Structs.Value.Value'
valueNewFull :: Text -> Int64 -> Text -> DestroyNotify -> m Value
valueNewFull secret :: Text
secret length_ :: Int64
length_ contentType :: Text
contentType destroy :: DestroyNotify
destroy = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    CString
secret' <- Text -> IO CString
textToCString Text
secret
    CString
contentType' <- Text -> IO CString
textToCString Text
contentType
    Ptr (FunPtr DestroyNotify)
ptrdestroy <- IO (Ptr (FunPtr DestroyNotify))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr GLib.Callbacks.C_DestroyNotify))
    FunPtr DestroyNotify
destroy' <- DestroyNotify -> IO (FunPtr DestroyNotify)
GLib.Callbacks.mk_DestroyNotify (Maybe (Ptr (FunPtr DestroyNotify))
-> DestroyNotify -> DestroyNotify
GLib.Callbacks.wrap_DestroyNotify (Ptr (FunPtr DestroyNotify) -> Maybe (Ptr (FunPtr DestroyNotify))
forall a. a -> Maybe a
Just Ptr (FunPtr DestroyNotify)
ptrdestroy) DestroyNotify
destroy)
    Ptr (FunPtr DestroyNotify) -> FunPtr DestroyNotify -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr DestroyNotify)
ptrdestroy FunPtr DestroyNotify
destroy'
    Ptr Value
result <- CString
-> Int64 -> CString -> FunPtr DestroyNotify -> IO (Ptr Value)
secret_value_new_full CString
secret' Int64
length_ CString
contentType' FunPtr DestroyNotify
destroy'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "valueNewFull" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Value -> Value
Value) Ptr Value
result
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
secret'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
contentType'
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Value::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the length of the secret"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "length"
--              , argType = TBasicType TUInt64
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "the length of the secret"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TUInt8))
-- throws : False
-- Skip return : False

foreign import ccall "secret_value_get" secret_value_get :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "Secret", name = "Value"})
    Ptr Word64 ->                           -- length : TBasicType TUInt64
    IO (Ptr Word8)

-- | Get the secret data in the t'GI.Secret.Structs.Value.Value'. The value is not necessarily
-- null-terminated unless it was created with 'GI.Secret.Structs.Value.valueNew' or a
-- null-terminated string was passed to 'GI.Secret.Structs.Value.valueNewFull'.
valueGet ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Value
    -- ^ /@value@/: the value
    -> m ByteString
    -- ^ __Returns:__ the secret data
valueGet :: Value -> m ByteString
valueGet value :: Value
value = IO ByteString -> m ByteString
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ByteString -> m ByteString) -> IO ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
value' <- Value -> IO (Ptr Value)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Value
value
    Ptr Word64
length_ <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Word8
result <- Ptr Value -> Ptr Word64 -> IO (Ptr Word8)
secret_value_get Ptr Value
value' Ptr Word64
length_
    Word64
length_' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
length_
    Text -> Ptr Word8 -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "valueGet" Ptr Word8
result
    ByteString
result' <- (Word64 -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength Word64
length_') Ptr Word8
result
    Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Value
value
    Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
length_
    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
result'

#if defined(ENABLE_OVERLOADING)
data ValueGetMethodInfo
instance (signature ~ (m ByteString), MonadIO m) => O.MethodInfo ValueGetMethodInfo Value signature where
    overloadedMethod = valueGet

#endif

-- method Value::get_content_type
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value" , 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 "secret_value_get_content_type" secret_value_get_content_type :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "Secret", name = "Value"})
    IO CString

-- | Get the content type of the secret value, such as
-- \<literal>text\/plain\<\/literal>.
valueGetContentType ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Value
    -- ^ /@value@/: the value
    -> m T.Text
    -- ^ __Returns:__ the content type
valueGetContentType :: Value -> m Text
valueGetContentType value :: Value
value = 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 Value
value' <- Value -> IO (Ptr Value)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Value
value
    CString
result <- Ptr Value -> IO CString
secret_value_get_content_type Ptr Value
value'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "valueGetContentType" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Value
value
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data ValueGetContentTypeMethodInfo
instance (signature ~ (m T.Text), MonadIO m) => O.MethodInfo ValueGetContentTypeMethodInfo Value signature where
    overloadedMethod = valueGetContentType

#endif

-- method Value::get_text
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the value" , 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 "secret_value_get_text" secret_value_get_text :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "Secret", name = "Value"})
    IO CString

-- | Get the secret data in the t'GI.Secret.Structs.Value.Value' if it contains a textual
-- value. The content type must be \<literal>text\/plain\<\/literal>.
valueGetText ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Value
    -- ^ /@value@/: the value
    -> m (Maybe T.Text)
    -- ^ __Returns:__ the content type
valueGetText :: Value -> m (Maybe Text)
valueGetText value :: Value
value = IO (Maybe Text) -> m (Maybe Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
value' <- Value -> IO (Ptr Value)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Value
value
    CString
result <- Ptr Value -> IO CString
secret_value_get_text Ptr Value
value'
    Maybe Text
maybeResult <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
result ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \result' :: CString
result' -> do
        Text
result'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result'
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result''
    Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Value
value
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data ValueGetTextMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m) => O.MethodInfo ValueGetTextMethodInfo Value signature where
    overloadedMethod = valueGetText

#endif

-- method Value::ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to reference" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Secret" , name = "Value" })
-- throws : False
-- Skip return : False

foreign import ccall "secret_value_ref" secret_value_ref :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "Secret", name = "Value"})
    IO (Ptr Value)

-- | Add another reference to the t'GI.Secret.Structs.Value.Value'. For each reference
-- 'GI.Secret.Structs.Value.valueUnref' should be called to unreference the value.
valueRef ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Value
    -- ^ /@value@/: value to reference
    -> m Value
    -- ^ __Returns:__ the value
valueRef :: Value -> m Value
valueRef value :: Value
value = IO Value -> m Value
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Value -> m Value) -> IO Value -> m Value
forall a b. (a -> b) -> a -> b
$ do
    Ptr Value
value' <- Value -> IO (Ptr Value)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Value
value
    Ptr Value
result <- Ptr Value -> IO (Ptr Value)
secret_value_ref Ptr Value
value'
    Text -> Ptr Value -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "valueRef" Ptr Value
result
    Value
result' <- ((ManagedPtr Value -> Value) -> Ptr Value -> IO Value
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Value -> Value
Value) Ptr Value
result
    Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Value
value
    Value -> IO Value
forall (m :: * -> *) a. Monad m => a -> m a
return Value
result'

#if defined(ENABLE_OVERLOADING)
data ValueRefMethodInfo
instance (signature ~ (m Value), MonadIO m) => O.MethodInfo ValueRefMethodInfo Value signature where
    overloadedMethod = valueRef

#endif

-- method Value::unref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "value"
--           , argType =
--               TInterface Name { namespace = "Secret" , name = "Value" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "value to unreference"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "secret_value_unref" secret_value_unref :: 
    Ptr Value ->                            -- value : TInterface (Name {namespace = "Secret", name = "Value"})
    IO ()

-- | Unreference a t'GI.Secret.Structs.Value.Value'. When the last reference is gone, then
-- the value will be freed.
valueUnref ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Value
    -- ^ /@value@/: value to unreference
    -> m ()
valueUnref :: Value -> m ()
valueUnref value :: Value
value = 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 Value
value' <- Value -> IO (Ptr Value)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Value
value
    Ptr Value -> IO ()
secret_value_unref Ptr Value
value'
    Value -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Value
value
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data ValueUnrefMethodInfo
instance (signature ~ (m ()), MonadIO m) => O.MethodInfo ValueUnrefMethodInfo Value signature where
    overloadedMethod = valueUnref

#endif

#if defined(ENABLE_OVERLOADING)
type family ResolveValueMethod (t :: Symbol) (o :: *) :: * where
    ResolveValueMethod "get" o = ValueGetMethodInfo
    ResolveValueMethod "ref" o = ValueRefMethodInfo
    ResolveValueMethod "unref" o = ValueUnrefMethodInfo
    ResolveValueMethod "getContentType" o = ValueGetContentTypeMethodInfo
    ResolveValueMethod "getText" o = ValueGetTextMethodInfo
    ResolveValueMethod l o = O.MethodResolutionFailed l o

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

#endif