{-# 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.OSTree.Objects.GpgVerifyResult
    ( 

-- * Exported types
    GpgVerifyResult(..)                     ,
    IsGpgVerifyResult                       ,
    toGpgVerifyResult                       ,
    noGpgVerifyResult                       ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveGpgVerifyResultMethod            ,
#endif


-- ** countAll #method:countAll#

#if defined(ENABLE_OVERLOADING)
    GpgVerifyResultCountAllMethodInfo       ,
#endif
    gpgVerifyResultCountAll                 ,


-- ** countValid #method:countValid#

#if defined(ENABLE_OVERLOADING)
    GpgVerifyResultCountValidMethodInfo     ,
#endif
    gpgVerifyResultCountValid               ,


-- ** describe #method:describe#

#if defined(ENABLE_OVERLOADING)
    GpgVerifyResultDescribeMethodInfo       ,
#endif
    gpgVerifyResultDescribe                 ,


-- ** describeVariant #method:describeVariant#

    gpgVerifyResultDescribeVariant          ,


-- ** get #method:get#

#if defined(ENABLE_OVERLOADING)
    GpgVerifyResultGetMethodInfo            ,
#endif
    gpgVerifyResultGet                      ,


-- ** getAll #method:getAll#

#if defined(ENABLE_OVERLOADING)
    GpgVerifyResultGetAllMethodInfo         ,
#endif
    gpgVerifyResultGetAll                   ,


-- ** lookup #method:lookup#

#if defined(ENABLE_OVERLOADING)
    GpgVerifyResultLookupMethodInfo         ,
#endif
    gpgVerifyResultLookup                   ,


-- ** requireValidSignature #method:requireValidSignature#

#if defined(ENABLE_OVERLOADING)
    GpgVerifyResultRequireValidSignatureMethodInfo,
#endif
    gpgVerifyResultRequireValidSignature    ,




    ) 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.Structs.String as GLib.String
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Interfaces.Initable as Gio.Initable
import {-# SOURCE #-} qualified GI.OSTree.Enums as OSTree.Enums

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

instance GObject GpgVerifyResult where
    gobjectType :: IO GType
gobjectType = IO GType
c_ostree_gpg_verify_result_get_type
    

-- | Convert 'GpgVerifyResult' to and from 'Data.GI.Base.GValue.GValue' with 'Data.GI.Base.GValue.toGValue' and 'Data.GI.Base.GValue.fromGValue'.
instance B.GValue.IsGValue GpgVerifyResult where
    toGValue :: GpgVerifyResult -> IO GValue
toGValue o :: GpgVerifyResult
o = do
        GType
gtype <- IO GType
c_ostree_gpg_verify_result_get_type
        GpgVerifyResult -> (Ptr GpgVerifyResult -> IO GValue) -> IO GValue
forall a c.
(HasCallStack, ManagedPtrNewtype a) =>
a -> (Ptr a -> IO c) -> IO c
B.ManagedPtr.withManagedPtr GpgVerifyResult
o (GType
-> (GValue -> Ptr GpgVerifyResult -> IO ())
-> Ptr GpgVerifyResult
-> IO GValue
forall a. GType -> (GValue -> a -> IO ()) -> a -> IO GValue
B.GValue.buildGValue GType
gtype GValue -> Ptr GpgVerifyResult -> IO ()
forall a. GObject a => GValue -> Ptr a -> IO ()
B.GValue.set_object)
        
    fromGValue :: GValue -> IO GpgVerifyResult
fromGValue gv :: GValue
gv = do
        Ptr GpgVerifyResult
ptr <- GValue -> IO (Ptr GpgVerifyResult)
forall b. GObject b => GValue -> IO (Ptr b)
B.GValue.get_object GValue
gv :: IO (Ptr GpgVerifyResult)
        (ManagedPtr GpgVerifyResult -> GpgVerifyResult)
-> Ptr GpgVerifyResult -> IO GpgVerifyResult
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
B.ManagedPtr.newObject ManagedPtr GpgVerifyResult -> GpgVerifyResult
GpgVerifyResult Ptr GpgVerifyResult
ptr
        
    

-- | Type class for types which can be safely cast to `GpgVerifyResult`, for instance with `toGpgVerifyResult`.
class (GObject o, O.IsDescendantOf GpgVerifyResult o) => IsGpgVerifyResult o
instance (GObject o, O.IsDescendantOf GpgVerifyResult o) => IsGpgVerifyResult o

instance O.HasParentTypes GpgVerifyResult
type instance O.ParentTypes GpgVerifyResult = '[GObject.Object.Object, Gio.Initable.Initable]

-- | Cast to `GpgVerifyResult`, for types for which this is known to be safe. For general casts, use `Data.GI.Base.ManagedPtr.castTo`.
toGpgVerifyResult :: (MonadIO m, IsGpgVerifyResult o) => o -> m GpgVerifyResult
toGpgVerifyResult :: o -> m GpgVerifyResult
toGpgVerifyResult = IO GpgVerifyResult -> m GpgVerifyResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GpgVerifyResult -> m GpgVerifyResult)
-> (o -> IO GpgVerifyResult) -> o -> m GpgVerifyResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ManagedPtr GpgVerifyResult -> GpgVerifyResult)
-> o -> IO GpgVerifyResult
forall o o'.
(HasCallStack, GObject o, GObject o') =>
(ManagedPtr o' -> o') -> o -> IO o'
unsafeCastTo ManagedPtr GpgVerifyResult -> GpgVerifyResult
GpgVerifyResult

-- | A convenience alias for `Nothing` :: `Maybe` `GpgVerifyResult`.
noGpgVerifyResult :: Maybe GpgVerifyResult
noGpgVerifyResult :: Maybe GpgVerifyResult
noGpgVerifyResult = Maybe GpgVerifyResult
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveGpgVerifyResultMethod (t :: Symbol) (o :: *) :: * where
    ResolveGpgVerifyResultMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveGpgVerifyResultMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveGpgVerifyResultMethod "countAll" o = GpgVerifyResultCountAllMethodInfo
    ResolveGpgVerifyResultMethod "countValid" o = GpgVerifyResultCountValidMethodInfo
    ResolveGpgVerifyResultMethod "describe" o = GpgVerifyResultDescribeMethodInfo
    ResolveGpgVerifyResultMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveGpgVerifyResultMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveGpgVerifyResultMethod "get" o = GpgVerifyResultGetMethodInfo
    ResolveGpgVerifyResultMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveGpgVerifyResultMethod "init" o = Gio.Initable.InitableInitMethodInfo
    ResolveGpgVerifyResultMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveGpgVerifyResultMethod "lookup" o = GpgVerifyResultLookupMethodInfo
    ResolveGpgVerifyResultMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveGpgVerifyResultMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveGpgVerifyResultMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveGpgVerifyResultMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveGpgVerifyResultMethod "requireValidSignature" o = GpgVerifyResultRequireValidSignatureMethodInfo
    ResolveGpgVerifyResultMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveGpgVerifyResultMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveGpgVerifyResultMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveGpgVerifyResultMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveGpgVerifyResultMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveGpgVerifyResultMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveGpgVerifyResultMethod "getAll" o = GpgVerifyResultGetAllMethodInfo
    ResolveGpgVerifyResultMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveGpgVerifyResultMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveGpgVerifyResultMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveGpgVerifyResultMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveGpgVerifyResultMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveGpgVerifyResultMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveGpgVerifyResultMethod l o = O.MethodResolutionFailed l o

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

#endif

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

#if defined(ENABLE_OVERLOADING)
#endif

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

#endif

-- method GpgVerifyResult::count_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "GpgVerifyResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeGpgVerifyResult"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ostree_gpg_verify_result_count_all" ostree_gpg_verify_result_count_all :: 
    Ptr GpgVerifyResult ->                  -- result : TInterface (Name {namespace = "OSTree", name = "GpgVerifyResult"})
    IO Word32

-- | Counts all the signatures in /@result@/.
gpgVerifyResultCountAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsGpgVerifyResult a) =>
    a
    -- ^ /@result@/: an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'
    -> m Word32
    -- ^ __Returns:__ signature count
gpgVerifyResultCountAll :: a -> m Word32
gpgVerifyResultCountAll result_ :: a
result_ = IO Word32 -> m Word32
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 GpgVerifyResult
result_' <- a -> IO (Ptr GpgVerifyResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    Word32
result <- Ptr GpgVerifyResult -> IO Word32
ostree_gpg_verify_result_count_all Ptr GpgVerifyResult
result_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data GpgVerifyResultCountAllMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsGpgVerifyResult a) => O.MethodInfo GpgVerifyResultCountAllMethodInfo a signature where
    overloadedMethod = gpgVerifyResultCountAll

#endif

-- method GpgVerifyResult::count_valid
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "GpgVerifyResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeGpgVerifyResult"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TUInt)
-- throws : False
-- Skip return : False

foreign import ccall "ostree_gpg_verify_result_count_valid" ostree_gpg_verify_result_count_valid :: 
    Ptr GpgVerifyResult ->                  -- result : TInterface (Name {namespace = "OSTree", name = "GpgVerifyResult"})
    IO Word32

-- | Counts only the valid signatures in /@result@/.
gpgVerifyResultCountValid ::
    (B.CallStack.HasCallStack, MonadIO m, IsGpgVerifyResult a) =>
    a
    -- ^ /@result@/: an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'
    -> m Word32
    -- ^ __Returns:__ valid signature count
gpgVerifyResultCountValid :: a -> m Word32
gpgVerifyResultCountValid result_ :: a
result_ = IO Word32 -> m Word32
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 GpgVerifyResult
result_' <- a -> IO (Ptr GpgVerifyResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    Word32
result <- Ptr GpgVerifyResult -> IO Word32
ostree_gpg_verify_result_count_valid Ptr GpgVerifyResult
result_'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data GpgVerifyResultCountValidMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsGpgVerifyResult a) => O.MethodInfo GpgVerifyResultCountValidMethodInfo a signature where
    overloadedMethod = gpgVerifyResultCountValid

#endif

-- method GpgVerifyResult::describe
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "GpgVerifyResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeGpgVerifyResult"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signature_index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "which signature to describe"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "output_buffer"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "String" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GString to hold the description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_prefix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional line prefix string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "GpgSignatureFormatFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags to adjust the description format"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_gpg_verify_result_describe" ostree_gpg_verify_result_describe :: 
    Ptr GpgVerifyResult ->                  -- result : TInterface (Name {namespace = "OSTree", name = "GpgVerifyResult"})
    Word32 ->                               -- signature_index : TBasicType TUInt
    Ptr GLib.String.String ->               -- output_buffer : TInterface (Name {namespace = "GLib", name = "String"})
    CString ->                              -- line_prefix : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "OSTree", name = "GpgSignatureFormatFlags"})
    IO ()

-- | Appends a brief, human-readable description of the GPG signature at
-- /@signatureIndex@/ in /@result@/ to the /@outputBuffer@/.  The description
-- spans multiple lines.  A /@linePrefix@/ string, if given, will precede
-- each line of the description.
-- 
-- The /@flags@/ argument is reserved for future variations to the description
-- format.  Currently must be 0.
-- 
-- It is a programmer error to request an invalid /@signatureIndex@/.  Use
-- 'GI.OSTree.Objects.GpgVerifyResult.gpgVerifyResultCountAll' to find the number of signatures in
-- /@result@/.
gpgVerifyResultDescribe ::
    (B.CallStack.HasCallStack, MonadIO m, IsGpgVerifyResult a) =>
    a
    -- ^ /@result@/: an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'
    -> Word32
    -- ^ /@signatureIndex@/: which signature to describe
    -> GLib.String.String
    -- ^ /@outputBuffer@/: a t'GI.GLib.Structs.String.String' to hold the description
    -> Maybe (T.Text)
    -- ^ /@linePrefix@/: optional line prefix string
    -> OSTree.Enums.GpgSignatureFormatFlags
    -- ^ /@flags@/: flags to adjust the description format
    -> m ()
gpgVerifyResultDescribe :: a
-> Word32
-> String
-> Maybe Text
-> GpgSignatureFormatFlags
-> m ()
gpgVerifyResultDescribe result_ :: a
result_ signatureIndex :: Word32
signatureIndex outputBuffer :: String
outputBuffer linePrefix :: Maybe Text
linePrefix flags :: GpgSignatureFormatFlags
flags = 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 GpgVerifyResult
result_' <- a -> IO (Ptr GpgVerifyResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    Ptr String
outputBuffer' <- String -> IO (Ptr String)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr String
outputBuffer
    Ptr CChar
maybeLinePrefix <- case Maybe Text
linePrefix of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jLinePrefix :: Text
jLinePrefix -> do
            Ptr CChar
jLinePrefix' <- Text -> IO (Ptr CChar)
textToCString Text
jLinePrefix
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLinePrefix'
    let flags' :: CUInt
flags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (GpgSignatureFormatFlags -> Int)
-> GpgSignatureFormatFlags
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GpgSignatureFormatFlags -> Int
forall a. Enum a => a -> Int
fromEnum) GpgSignatureFormatFlags
flags
    Ptr GpgVerifyResult
-> Word32 -> Ptr String -> Ptr CChar -> CUInt -> IO ()
ostree_gpg_verify_result_describe Ptr GpgVerifyResult
result_' Word32
signatureIndex Ptr String
outputBuffer' Ptr CChar
maybeLinePrefix CUInt
flags'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
    String -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr String
outputBuffer
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLinePrefix
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data GpgVerifyResultDescribeMethodInfo
instance (signature ~ (Word32 -> GLib.String.String -> Maybe (T.Text) -> OSTree.Enums.GpgSignatureFormatFlags -> m ()), MonadIO m, IsGpgVerifyResult a) => O.MethodInfo GpgVerifyResultDescribeMethodInfo a signature where
    overloadedMethod = gpgVerifyResultDescribe

#endif

-- method GpgVerifyResult::get
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "GpgVerifyResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeGpgVerifyResult"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signature_index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "which signature to get attributes from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "attrs"
--           , argType =
--               TCArray
--                 False
--                 (-1)
--                 3
--                 (TInterface
--                    Name { namespace = "OSTree" , name = "GpgSignatureAttr" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Array of requested attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "n_attrs"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Length of the @attrs array"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "n_attrs"
--              , argType = TBasicType TUInt
--              , direction = DirectionIn
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "Length of the @attrs array"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferNothing
--              }
--          ]
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "ostree_gpg_verify_result_get" ostree_gpg_verify_result_get :: 
    Ptr GpgVerifyResult ->                  -- result : TInterface (Name {namespace = "OSTree", name = "GpgVerifyResult"})
    Word32 ->                               -- signature_index : TBasicType TUInt
    Ptr CUInt ->                            -- attrs : TCArray False (-1) 3 (TInterface (Name {namespace = "OSTree", name = "GpgSignatureAttr"}))
    Word32 ->                               -- n_attrs : TBasicType TUInt
    IO (Ptr GVariant)

-- | Builds a t'GVariant' tuple of requested attributes for the GPG signature at
-- /@signatureIndex@/ in /@result@/.  See the t'GI.OSTree.Enums.GpgSignatureAttr' description
-- for the t'GI.GLib.Structs.VariantType.VariantType' of each available attribute.
-- 
-- It is a programmer error to request an invalid t'GI.OSTree.Enums.GpgSignatureAttr' or
-- an invalid /@signatureIndex@/.  Use 'GI.OSTree.Objects.GpgVerifyResult.gpgVerifyResultCountAll' to
-- find the number of signatures in /@result@/.
gpgVerifyResultGet ::
    (B.CallStack.HasCallStack, MonadIO m, IsGpgVerifyResult a) =>
    a
    -- ^ /@result@/: an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'
    -> Word32
    -- ^ /@signatureIndex@/: which signature to get attributes from
    -> [OSTree.Enums.GpgSignatureAttr]
    -- ^ /@attrs@/: Array of requested attributes
    -> m GVariant
    -- ^ __Returns:__ a new, floating, t'GVariant' tuple
gpgVerifyResultGet :: a -> Word32 -> [GpgSignatureAttr] -> m GVariant
gpgVerifyResultGet result_ :: a
result_ signatureIndex :: Word32
signatureIndex attrs :: [GpgSignatureAttr]
attrs = IO GVariant -> m GVariant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    let nAttrs :: Word32
nAttrs = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ [GpgSignatureAttr] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [GpgSignatureAttr]
attrs
    Ptr GpgVerifyResult
result_' <- a -> IO (Ptr GpgVerifyResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    let attrs' :: [CUInt]
attrs' = (GpgSignatureAttr -> CUInt) -> [GpgSignatureAttr] -> [CUInt]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (GpgSignatureAttr -> Int) -> GpgSignatureAttr -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GpgSignatureAttr -> Int
forall a. Enum a => a -> Int
fromEnum) [GpgSignatureAttr]
attrs
    Ptr CUInt
attrs'' <- [CUInt] -> IO (Ptr CUInt)
forall a. Storable a => [a] -> IO (Ptr a)
packStorableArray [CUInt]
attrs'
    Ptr GVariant
result <- Ptr GpgVerifyResult
-> Word32 -> Ptr CUInt -> Word32 -> IO (Ptr GVariant)
ostree_gpg_verify_result_get Ptr GpgVerifyResult
result_' Word32
signatureIndex Ptr CUInt
attrs'' Word32
nAttrs
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "gpgVerifyResultGet" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
    Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
attrs''
    GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data GpgVerifyResultGetMethodInfo
instance (signature ~ (Word32 -> [OSTree.Enums.GpgSignatureAttr] -> m GVariant), MonadIO m, IsGpgVerifyResult a) => O.MethodInfo GpgVerifyResultGetMethodInfo a signature where
    overloadedMethod = gpgVerifyResultGet

#endif

-- method GpgVerifyResult::get_all
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "GpgVerifyResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeGpgVerifyResult"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signature_index"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "which signature to get attributes from"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just TVariant
-- throws : False
-- Skip return : False

foreign import ccall "ostree_gpg_verify_result_get_all" ostree_gpg_verify_result_get_all :: 
    Ptr GpgVerifyResult ->                  -- result : TInterface (Name {namespace = "OSTree", name = "GpgVerifyResult"})
    Word32 ->                               -- signature_index : TBasicType TUInt
    IO (Ptr GVariant)

-- | Builds a t'GVariant' tuple of all available attributes for the GPG signature
-- at /@signatureIndex@/ in /@result@/.
-- 
-- The child values in the returned t'GVariant' tuple are ordered to match the
-- t'GI.OSTree.Enums.GpgSignatureAttr' enumeration, which means the enum values can be
-- used as index values in functions like @/g_variant_get_child()/@.  See the
-- t'GI.OSTree.Enums.GpgSignatureAttr' description for the t'GI.GLib.Structs.VariantType.VariantType' of each
-- available attribute.
-- 
-- \<note>
--   \<para>
--     The t'GI.OSTree.Enums.GpgSignatureAttr' enumeration may be extended in the future
--     with new attributes, which would affect the t'GVariant' tuple returned by
--     this function.  While the position and type of current child values in
--     the t'GVariant' tuple will not change, to avoid backward-compatibility
--     issues \<emphasis>please do not depend on the tuple\'s overall size or
--     type signature\<\/emphasis>.
--   \<\/para>
-- \<\/note>
-- 
-- It is a programmer error to request an invalid /@signatureIndex@/.  Use
-- 'GI.OSTree.Objects.GpgVerifyResult.gpgVerifyResultCountAll' to find the number of signatures in
-- /@result@/.
gpgVerifyResultGetAll ::
    (B.CallStack.HasCallStack, MonadIO m, IsGpgVerifyResult a) =>
    a
    -- ^ /@result@/: an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'
    -> Word32
    -- ^ /@signatureIndex@/: which signature to get attributes from
    -> m GVariant
    -- ^ __Returns:__ a new, floating, t'GVariant' tuple
gpgVerifyResultGetAll :: a -> Word32 -> m GVariant
gpgVerifyResultGetAll result_ :: a
result_ signatureIndex :: Word32
signatureIndex = IO GVariant -> m GVariant
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GVariant -> m GVariant) -> IO GVariant -> m GVariant
forall a b. (a -> b) -> a -> b
$ do
    Ptr GpgVerifyResult
result_' <- a -> IO (Ptr GpgVerifyResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    Ptr GVariant
result <- Ptr GpgVerifyResult -> Word32 -> IO (Ptr GVariant)
ostree_gpg_verify_result_get_all Ptr GpgVerifyResult
result_' Word32
signatureIndex
    Text -> Ptr GVariant -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "gpgVerifyResultGetAll" Ptr GVariant
result
    GVariant
result' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
    GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
result'

#if defined(ENABLE_OVERLOADING)
data GpgVerifyResultGetAllMethodInfo
instance (signature ~ (Word32 -> m GVariant), MonadIO m, IsGpgVerifyResult a) => O.MethodInfo GpgVerifyResultGetAllMethodInfo a signature where
    overloadedMethod = gpgVerifyResultGetAll

#endif

-- method GpgVerifyResult::lookup
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "GpgVerifyResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeGpgVerifyResult"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a GPG key ID or fingerprint"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_signature_index"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the index of the signature\n                             signed by @key_id, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ostree_gpg_verify_result_lookup" ostree_gpg_verify_result_lookup :: 
    Ptr GpgVerifyResult ->                  -- result : TInterface (Name {namespace = "OSTree", name = "GpgVerifyResult"})
    CString ->                              -- key_id : TBasicType TUTF8
    Ptr Word32 ->                           -- out_signature_index : TBasicType TUInt
    IO CInt

-- | Searches /@result@/ for a signature signed by /@keyId@/.  If a match is found,
-- the function returns 'P.True' and sets /@outSignatureIndex@/ so that further
-- signature details can be obtained through 'GI.OSTree.Objects.GpgVerifyResult.gpgVerifyResultGet'.
-- If no match is found, the function returns 'P.False' and leaves
-- /@outSignatureIndex@/ unchanged.
gpgVerifyResultLookup ::
    (B.CallStack.HasCallStack, MonadIO m, IsGpgVerifyResult a) =>
    a
    -- ^ /@result@/: an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'
    -> T.Text
    -- ^ /@keyId@/: a GPG key ID or fingerprint
    -> m ((Bool, Word32))
    -- ^ __Returns:__ 'P.True' on success, 'P.False' on failure
gpgVerifyResultLookup :: a -> Text -> m (Bool, Word32)
gpgVerifyResultLookup result_ :: a
result_ keyId :: Text
keyId = IO (Bool, Word32) -> m (Bool, Word32)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bool, Word32) -> m (Bool, Word32))
-> IO (Bool, Word32) -> m (Bool, Word32)
forall a b. (a -> b) -> a -> b
$ do
    Ptr GpgVerifyResult
result_' <- a -> IO (Ptr GpgVerifyResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    Ptr CChar
keyId' <- Text -> IO (Ptr CChar)
textToCString Text
keyId
    Ptr Word32
outSignatureIndex <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    CInt
result <- Ptr GpgVerifyResult -> Ptr CChar -> Ptr Word32 -> IO CInt
ostree_gpg_verify_result_lookup Ptr GpgVerifyResult
result_' Ptr CChar
keyId' Ptr Word32
outSignatureIndex
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    Word32
outSignatureIndex' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
outSignatureIndex
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
keyId'
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
outSignatureIndex
    (Bool, Word32) -> IO (Bool, Word32)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool
result', Word32
outSignatureIndex')

#if defined(ENABLE_OVERLOADING)
data GpgVerifyResultLookupMethodInfo
instance (signature ~ (T.Text -> m ((Bool, Word32))), MonadIO m, IsGpgVerifyResult a) => O.MethodInfo GpgVerifyResultLookupMethodInfo a signature where
    overloadedMethod = gpgVerifyResultLookup

#endif

-- method GpgVerifyResult::require_valid_signature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "GpgVerifyResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeGpgVerifyResult"
--                 , 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 "ostree_gpg_verify_result_require_valid_signature" ostree_gpg_verify_result_require_valid_signature :: 
    Ptr GpgVerifyResult ->                  -- result : TInterface (Name {namespace = "OSTree", name = "GpgVerifyResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Checks if the result contains at least one signature from the
-- trusted keyring.  You can call this function immediately after
-- 'GI.OSTree.Objects.Repo.repoVerifySummary' or 'GI.OSTree.Objects.Repo.repoVerifyCommitExt' -
-- it will handle the 'P.Nothing' /@result@/ and filled /@error@/ too.
gpgVerifyResultRequireValidSignature ::
    (B.CallStack.HasCallStack, MonadIO m, IsGpgVerifyResult a) =>
    a
    -- ^ /@result@/: an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
gpgVerifyResultRequireValidSignature :: a -> m ()
gpgVerifyResultRequireValidSignature result_ :: a
result_ = 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 GpgVerifyResult
result_' <- a -> IO (Ptr GpgVerifyResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
result_
    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 GpgVerifyResult -> Ptr (Ptr GError) -> IO CInt
ostree_gpg_verify_result_require_valid_signature Ptr GpgVerifyResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
result_
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data GpgVerifyResultRequireValidSignatureMethodInfo
instance (signature ~ (m ()), MonadIO m, IsGpgVerifyResult a) => O.MethodInfo GpgVerifyResultRequireValidSignatureMethodInfo a signature where
    overloadedMethod = gpgVerifyResultRequireValidSignature

#endif

-- method GpgVerifyResult::describe_variant
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "variant"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a #GVariant from ostree_gpg_verify_result_get_all()"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "output_buffer"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "String" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GString to hold the description"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "line_prefix"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "optional line prefix string"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "GpgSignatureFormatFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "flags to adjust the description format"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_gpg_verify_result_describe_variant" ostree_gpg_verify_result_describe_variant :: 
    Ptr GVariant ->                         -- variant : TVariant
    Ptr GLib.String.String ->               -- output_buffer : TInterface (Name {namespace = "GLib", name = "String"})
    CString ->                              -- line_prefix : TBasicType TUTF8
    CUInt ->                                -- flags : TInterface (Name {namespace = "OSTree", name = "GpgSignatureFormatFlags"})
    IO ()

-- | Similar to 'GI.OSTree.Objects.GpgVerifyResult.gpgVerifyResultDescribe' but takes a t'GVariant' of
-- all attributes for a GPG signature instead of an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'
-- and signature index.
-- 
-- The /@variant@/ \<emphasis>MUST\<\/emphasis> have been created by
-- 'GI.OSTree.Objects.GpgVerifyResult.gpgVerifyResultGetAll'.
gpgVerifyResultDescribeVariant ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    GVariant
    -- ^ /@variant@/: a t'GVariant' from 'GI.OSTree.Objects.GpgVerifyResult.gpgVerifyResultGetAll'
    -> GLib.String.String
    -- ^ /@outputBuffer@/: a t'GI.GLib.Structs.String.String' to hold the description
    -> Maybe (T.Text)
    -- ^ /@linePrefix@/: optional line prefix string
    -> OSTree.Enums.GpgSignatureFormatFlags
    -- ^ /@flags@/: flags to adjust the description format
    -> m ()
gpgVerifyResultDescribeVariant :: GVariant -> String -> Maybe Text -> GpgSignatureFormatFlags -> m ()
gpgVerifyResultDescribeVariant variant :: GVariant
variant outputBuffer :: String
outputBuffer linePrefix :: Maybe Text
linePrefix flags :: GpgSignatureFormatFlags
flags = 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 GVariant
variant' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
variant
    Ptr String
outputBuffer' <- String -> IO (Ptr String)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr String
outputBuffer
    Ptr CChar
maybeLinePrefix <- case Maybe Text
linePrefix of
        Nothing -> Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
forall a. Ptr a
nullPtr
        Just jLinePrefix :: Text
jLinePrefix -> do
            Ptr CChar
jLinePrefix' <- Text -> IO (Ptr CChar)
textToCString Text
jLinePrefix
            Ptr CChar -> IO (Ptr CChar)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CChar
jLinePrefix'
    let flags' :: CUInt
flags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (GpgSignatureFormatFlags -> Int)
-> GpgSignatureFormatFlags
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GpgSignatureFormatFlags -> Int
forall a. Enum a => a -> Int
fromEnum) GpgSignatureFormatFlags
flags
    Ptr GVariant -> Ptr String -> Ptr CChar -> CUInt -> IO ()
ostree_gpg_verify_result_describe_variant Ptr GVariant
variant' Ptr String
outputBuffer' Ptr CChar
maybeLinePrefix CUInt
flags'
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
variant
    String -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr String
outputBuffer
    Ptr CChar -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CChar
maybeLinePrefix
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif