{-# 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.Repo
    ( 
#if defined(ENABLE_OVERLOADING)
    RepoListCollectionRefsMethodInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    RepoListCommitObjectsStartingWithMethodInfo,
#endif
#if defined(ENABLE_OVERLOADING)
    RepoListObjectsMethodInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    RepoListRefsMethodInfo                  ,
#endif
#if defined(ENABLE_OVERLOADING)
    RepoListRefsExtMethodInfo               ,
#endif
#if defined(ENABLE_OVERLOADING)
    RepoRemoteListCollectionRefsMethodInfo  ,
#endif
#if defined(ENABLE_OVERLOADING)
    RepoRemoteListRefsMethodInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    RepoTraverseCommitMethodInfo            ,
#endif
#if defined(ENABLE_OVERLOADING)
    RepoTraverseReachableRefsMethodInfo     ,
#endif
#if defined(ENABLE_OVERLOADING)
    RepoTraverseNewParentsMethodInfo        ,
#endif
#if defined(ENABLE_OVERLOADING)
    RepoTraverseNewReachableMethodInfo      ,
#endif

-- * Exported types
    Repo(..)                                ,
    IsRepo                                  ,
    toRepo                                  ,
    noRepo                                  ,


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

#if defined(ENABLE_OVERLOADING)
    ResolveRepoMethod                       ,
#endif


-- ** abortTransaction #method:abortTransaction#

#if defined(ENABLE_OVERLOADING)
    RepoAbortTransactionMethodInfo          ,
#endif
    repoAbortTransaction                    ,


-- ** addGpgSignatureSummary #method:addGpgSignatureSummary#

#if defined(ENABLE_OVERLOADING)
    RepoAddGpgSignatureSummaryMethodInfo    ,
#endif
    repoAddGpgSignatureSummary              ,


-- ** appendGpgSignature #method:appendGpgSignature#

#if defined(ENABLE_OVERLOADING)
    RepoAppendGpgSignatureMethodInfo        ,
#endif
    repoAppendGpgSignature                  ,


-- ** checkoutAt #method:checkoutAt#

#if defined(ENABLE_OVERLOADING)
    RepoCheckoutAtMethodInfo                ,
#endif
    repoCheckoutAt                          ,


-- ** checkoutGc #method:checkoutGc#

#if defined(ENABLE_OVERLOADING)
    RepoCheckoutGcMethodInfo                ,
#endif
    repoCheckoutGc                          ,


-- ** checkoutTree #method:checkoutTree#

#if defined(ENABLE_OVERLOADING)
    RepoCheckoutTreeMethodInfo              ,
#endif
    repoCheckoutTree                        ,


-- ** commitTransaction #method:commitTransaction#

#if defined(ENABLE_OVERLOADING)
    RepoCommitTransactionMethodInfo         ,
#endif
    repoCommitTransaction                   ,


-- ** copyConfig #method:copyConfig#

#if defined(ENABLE_OVERLOADING)
    RepoCopyConfigMethodInfo                ,
#endif
    repoCopyConfig                          ,


-- ** create #method:create#

#if defined(ENABLE_OVERLOADING)
    RepoCreateMethodInfo                    ,
#endif
    repoCreate                              ,


-- ** createAt #method:createAt#

    repoCreateAt                            ,


-- ** deleteObject #method:deleteObject#

#if defined(ENABLE_OVERLOADING)
    RepoDeleteObjectMethodInfo              ,
#endif
    repoDeleteObject                        ,


-- ** equal #method:equal#

#if defined(ENABLE_OVERLOADING)
    RepoEqualMethodInfo                     ,
#endif
    repoEqual                               ,


-- ** findRemotesAsync #method:findRemotesAsync#

#if defined(ENABLE_OVERLOADING)
    RepoFindRemotesAsyncMethodInfo          ,
#endif
    repoFindRemotesAsync                    ,


-- ** findRemotesFinish #method:findRemotesFinish#

#if defined(ENABLE_OVERLOADING)
    RepoFindRemotesFinishMethodInfo         ,
#endif
    repoFindRemotesFinish                   ,


-- ** fsckObject #method:fsckObject#

#if defined(ENABLE_OVERLOADING)
    RepoFsckObjectMethodInfo                ,
#endif
    repoFsckObject                          ,


-- ** getBootloader #method:getBootloader#

#if defined(ENABLE_OVERLOADING)
    RepoGetBootloaderMethodInfo             ,
#endif
    repoGetBootloader                       ,


-- ** getCollectionId #method:getCollectionId#

#if defined(ENABLE_OVERLOADING)
    RepoGetCollectionIdMethodInfo           ,
#endif
    repoGetCollectionId                     ,


-- ** getConfig #method:getConfig#

#if defined(ENABLE_OVERLOADING)
    RepoGetConfigMethodInfo                 ,
#endif
    repoGetConfig                           ,


-- ** getDefaultRepoFinders #method:getDefaultRepoFinders#

#if defined(ENABLE_OVERLOADING)
    RepoGetDefaultRepoFindersMethodInfo     ,
#endif
    repoGetDefaultRepoFinders               ,


-- ** getDfd #method:getDfd#

#if defined(ENABLE_OVERLOADING)
    RepoGetDfdMethodInfo                    ,
#endif
    repoGetDfd                              ,


-- ** getDisableFsync #method:getDisableFsync#

#if defined(ENABLE_OVERLOADING)
    RepoGetDisableFsyncMethodInfo           ,
#endif
    repoGetDisableFsync                     ,


-- ** getMinFreeSpaceBytes #method:getMinFreeSpaceBytes#

#if defined(ENABLE_OVERLOADING)
    RepoGetMinFreeSpaceBytesMethodInfo      ,
#endif
    repoGetMinFreeSpaceBytes                ,


-- ** getMode #method:getMode#

#if defined(ENABLE_OVERLOADING)
    RepoGetModeMethodInfo                   ,
#endif
    repoGetMode                             ,


-- ** getParent #method:getParent#

#if defined(ENABLE_OVERLOADING)
    RepoGetParentMethodInfo                 ,
#endif
    repoGetParent                           ,


-- ** getPath #method:getPath#

#if defined(ENABLE_OVERLOADING)
    RepoGetPathMethodInfo                   ,
#endif
    repoGetPath                             ,


-- ** getRemoteBooleanOption #method:getRemoteBooleanOption#

#if defined(ENABLE_OVERLOADING)
    RepoGetRemoteBooleanOptionMethodInfo    ,
#endif
    repoGetRemoteBooleanOption              ,


-- ** getRemoteListOption #method:getRemoteListOption#

#if defined(ENABLE_OVERLOADING)
    RepoGetRemoteListOptionMethodInfo       ,
#endif
    repoGetRemoteListOption                 ,


-- ** getRemoteOption #method:getRemoteOption#

#if defined(ENABLE_OVERLOADING)
    RepoGetRemoteOptionMethodInfo           ,
#endif
    repoGetRemoteOption                     ,


-- ** gpgVerifyData #method:gpgVerifyData#

#if defined(ENABLE_OVERLOADING)
    RepoGpgVerifyDataMethodInfo             ,
#endif
    repoGpgVerifyData                       ,


-- ** hasObject #method:hasObject#

#if defined(ENABLE_OVERLOADING)
    RepoHasObjectMethodInfo                 ,
#endif
    repoHasObject                           ,


-- ** hash #method:hash#

#if defined(ENABLE_OVERLOADING)
    RepoHashMethodInfo                      ,
#endif
    repoHash                                ,


-- ** importObjectFrom #method:importObjectFrom#

#if defined(ENABLE_OVERLOADING)
    RepoImportObjectFromMethodInfo          ,
#endif
    repoImportObjectFrom                    ,


-- ** importObjectFromWithTrust #method:importObjectFromWithTrust#

#if defined(ENABLE_OVERLOADING)
    RepoImportObjectFromWithTrustMethodInfo ,
#endif
    repoImportObjectFromWithTrust           ,


-- ** isSystem #method:isSystem#

#if defined(ENABLE_OVERLOADING)
    RepoIsSystemMethodInfo                  ,
#endif
    repoIsSystem                            ,


-- ** isWritable #method:isWritable#

#if defined(ENABLE_OVERLOADING)
    RepoIsWritableMethodInfo                ,
#endif
    repoIsWritable                          ,


-- ** listStaticDeltaNames #method:listStaticDeltaNames#

#if defined(ENABLE_OVERLOADING)
    RepoListStaticDeltaNamesMethodInfo      ,
#endif
    repoListStaticDeltaNames                ,


-- ** loadCommit #method:loadCommit#

#if defined(ENABLE_OVERLOADING)
    RepoLoadCommitMethodInfo                ,
#endif
    repoLoadCommit                          ,


-- ** loadFile #method:loadFile#

#if defined(ENABLE_OVERLOADING)
    RepoLoadFileMethodInfo                  ,
#endif
    repoLoadFile                            ,


-- ** loadObjectStream #method:loadObjectStream#

#if defined(ENABLE_OVERLOADING)
    RepoLoadObjectStreamMethodInfo          ,
#endif
    repoLoadObjectStream                    ,


-- ** loadVariant #method:loadVariant#

#if defined(ENABLE_OVERLOADING)
    RepoLoadVariantMethodInfo               ,
#endif
    repoLoadVariant                         ,


-- ** loadVariantIfExists #method:loadVariantIfExists#

#if defined(ENABLE_OVERLOADING)
    RepoLoadVariantIfExistsMethodInfo       ,
#endif
    repoLoadVariantIfExists                 ,


-- ** markCommitPartial #method:markCommitPartial#

#if defined(ENABLE_OVERLOADING)
    RepoMarkCommitPartialMethodInfo         ,
#endif
    repoMarkCommitPartial                   ,


-- ** modeFromString #method:modeFromString#

    repoModeFromString                      ,


-- ** new #method:new#

    repoNew                                 ,


-- ** newDefault #method:newDefault#

    repoNewDefault                          ,


-- ** newForSysrootPath #method:newForSysrootPath#

    repoNewForSysrootPath                   ,


-- ** open #method:open#

#if defined(ENABLE_OVERLOADING)
    RepoOpenMethodInfo                      ,
#endif
    repoOpen                                ,


-- ** openAt #method:openAt#

    repoOpenAt                              ,


-- ** prepareTransaction #method:prepareTransaction#

#if defined(ENABLE_OVERLOADING)
    RepoPrepareTransactionMethodInfo        ,
#endif
    repoPrepareTransaction                  ,


-- ** prune #method:prune#

#if defined(ENABLE_OVERLOADING)
    RepoPruneMethodInfo                     ,
#endif
    repoPrune                               ,


-- ** pruneFromReachable #method:pruneFromReachable#

#if defined(ENABLE_OVERLOADING)
    RepoPruneFromReachableMethodInfo        ,
#endif
    repoPruneFromReachable                  ,


-- ** pruneStaticDeltas #method:pruneStaticDeltas#

#if defined(ENABLE_OVERLOADING)
    RepoPruneStaticDeltasMethodInfo         ,
#endif
    repoPruneStaticDeltas                   ,


-- ** pull #method:pull#

#if defined(ENABLE_OVERLOADING)
    RepoPullMethodInfo                      ,
#endif
    repoPull                                ,


-- ** pullDefaultConsoleProgressChanged #method:pullDefaultConsoleProgressChanged#

    repoPullDefaultConsoleProgressChanged   ,


-- ** pullFromRemotesAsync #method:pullFromRemotesAsync#

#if defined(ENABLE_OVERLOADING)
    RepoPullFromRemotesAsyncMethodInfo      ,
#endif
    repoPullFromRemotesAsync                ,


-- ** pullFromRemotesFinish #method:pullFromRemotesFinish#

#if defined(ENABLE_OVERLOADING)
    RepoPullFromRemotesFinishMethodInfo     ,
#endif
    repoPullFromRemotesFinish               ,


-- ** pullOneDir #method:pullOneDir#

#if defined(ENABLE_OVERLOADING)
    RepoPullOneDirMethodInfo                ,
#endif
    repoPullOneDir                          ,


-- ** pullWithOptions #method:pullWithOptions#

#if defined(ENABLE_OVERLOADING)
    RepoPullWithOptionsMethodInfo           ,
#endif
    repoPullWithOptions                     ,


-- ** queryObjectStorageSize #method:queryObjectStorageSize#

#if defined(ENABLE_OVERLOADING)
    RepoQueryObjectStorageSizeMethodInfo    ,
#endif
    repoQueryObjectStorageSize              ,


-- ** readCommit #method:readCommit#

#if defined(ENABLE_OVERLOADING)
    RepoReadCommitMethodInfo                ,
#endif
    repoReadCommit                          ,


-- ** readCommitDetachedMetadata #method:readCommitDetachedMetadata#

#if defined(ENABLE_OVERLOADING)
    RepoReadCommitDetachedMetadataMethodInfo,
#endif
    repoReadCommitDetachedMetadata          ,


-- ** regenerateSummary #method:regenerateSummary#

#if defined(ENABLE_OVERLOADING)
    RepoRegenerateSummaryMethodInfo         ,
#endif
    repoRegenerateSummary                   ,


-- ** reloadConfig #method:reloadConfig#

#if defined(ENABLE_OVERLOADING)
    RepoReloadConfigMethodInfo              ,
#endif
    repoReloadConfig                        ,


-- ** remoteAdd #method:remoteAdd#

#if defined(ENABLE_OVERLOADING)
    RepoRemoteAddMethodInfo                 ,
#endif
    repoRemoteAdd                           ,


-- ** remoteChange #method:remoteChange#

#if defined(ENABLE_OVERLOADING)
    RepoRemoteChangeMethodInfo              ,
#endif
    repoRemoteChange                        ,


-- ** remoteDelete #method:remoteDelete#

#if defined(ENABLE_OVERLOADING)
    RepoRemoteDeleteMethodInfo              ,
#endif
    repoRemoteDelete                        ,


-- ** remoteFetchSummary #method:remoteFetchSummary#

#if defined(ENABLE_OVERLOADING)
    RepoRemoteFetchSummaryMethodInfo        ,
#endif
    repoRemoteFetchSummary                  ,


-- ** remoteFetchSummaryWithOptions #method:remoteFetchSummaryWithOptions#

#if defined(ENABLE_OVERLOADING)
    RepoRemoteFetchSummaryWithOptionsMethodInfo,
#endif
    repoRemoteFetchSummaryWithOptions       ,


-- ** remoteGetGpgVerify #method:remoteGetGpgVerify#

#if defined(ENABLE_OVERLOADING)
    RepoRemoteGetGpgVerifyMethodInfo        ,
#endif
    repoRemoteGetGpgVerify                  ,


-- ** remoteGetGpgVerifySummary #method:remoteGetGpgVerifySummary#

#if defined(ENABLE_OVERLOADING)
    RepoRemoteGetGpgVerifySummaryMethodInfo ,
#endif
    repoRemoteGetGpgVerifySummary           ,


-- ** remoteGetUrl #method:remoteGetUrl#

#if defined(ENABLE_OVERLOADING)
    RepoRemoteGetUrlMethodInfo              ,
#endif
    repoRemoteGetUrl                        ,


-- ** remoteGpgImport #method:remoteGpgImport#

#if defined(ENABLE_OVERLOADING)
    RepoRemoteGpgImportMethodInfo           ,
#endif
    repoRemoteGpgImport                     ,


-- ** remoteList #method:remoteList#

#if defined(ENABLE_OVERLOADING)
    RepoRemoteListMethodInfo                ,
#endif
    repoRemoteList                          ,


-- ** resolveCollectionRef #method:resolveCollectionRef#

#if defined(ENABLE_OVERLOADING)
    RepoResolveCollectionRefMethodInfo      ,
#endif
    repoResolveCollectionRef                ,


-- ** resolveKeyringForCollection #method:resolveKeyringForCollection#

#if defined(ENABLE_OVERLOADING)
    RepoResolveKeyringForCollectionMethodInfo,
#endif
    repoResolveKeyringForCollection         ,


-- ** resolveRev #method:resolveRev#

#if defined(ENABLE_OVERLOADING)
    RepoResolveRevMethodInfo                ,
#endif
    repoResolveRev                          ,


-- ** resolveRevExt #method:resolveRevExt#

#if defined(ENABLE_OVERLOADING)
    RepoResolveRevExtMethodInfo             ,
#endif
    repoResolveRevExt                       ,


-- ** scanHardlinks #method:scanHardlinks#

#if defined(ENABLE_OVERLOADING)
    RepoScanHardlinksMethodInfo             ,
#endif
    repoScanHardlinks                       ,


-- ** setAliasRefImmediate #method:setAliasRefImmediate#

#if defined(ENABLE_OVERLOADING)
    RepoSetAliasRefImmediateMethodInfo      ,
#endif
    repoSetAliasRefImmediate                ,


-- ** setCacheDir #method:setCacheDir#

#if defined(ENABLE_OVERLOADING)
    RepoSetCacheDirMethodInfo               ,
#endif
    repoSetCacheDir                         ,


-- ** setCollectionId #method:setCollectionId#

#if defined(ENABLE_OVERLOADING)
    RepoSetCollectionIdMethodInfo           ,
#endif
    repoSetCollectionId                     ,


-- ** setCollectionRefImmediate #method:setCollectionRefImmediate#

#if defined(ENABLE_OVERLOADING)
    RepoSetCollectionRefImmediateMethodInfo ,
#endif
    repoSetCollectionRefImmediate           ,


-- ** setDisableFsync #method:setDisableFsync#

#if defined(ENABLE_OVERLOADING)
    RepoSetDisableFsyncMethodInfo           ,
#endif
    repoSetDisableFsync                     ,


-- ** setRefImmediate #method:setRefImmediate#

#if defined(ENABLE_OVERLOADING)
    RepoSetRefImmediateMethodInfo           ,
#endif
    repoSetRefImmediate                     ,


-- ** signCommit #method:signCommit#

#if defined(ENABLE_OVERLOADING)
    RepoSignCommitMethodInfo                ,
#endif
    repoSignCommit                          ,


-- ** signDelta #method:signDelta#

#if defined(ENABLE_OVERLOADING)
    RepoSignDeltaMethodInfo                 ,
#endif
    repoSignDelta                           ,


-- ** staticDeltaExecuteOffline #method:staticDeltaExecuteOffline#

#if defined(ENABLE_OVERLOADING)
    RepoStaticDeltaExecuteOfflineMethodInfo ,
#endif
    repoStaticDeltaExecuteOffline           ,


-- ** staticDeltaGenerate #method:staticDeltaGenerate#

#if defined(ENABLE_OVERLOADING)
    RepoStaticDeltaGenerateMethodInfo       ,
#endif
    repoStaticDeltaGenerate                 ,


-- ** transactionSetCollectionRef #method:transactionSetCollectionRef#

#if defined(ENABLE_OVERLOADING)
    RepoTransactionSetCollectionRefMethodInfo,
#endif
    repoTransactionSetCollectionRef         ,


-- ** transactionSetRef #method:transactionSetRef#

#if defined(ENABLE_OVERLOADING)
    RepoTransactionSetRefMethodInfo         ,
#endif
    repoTransactionSetRef                   ,


-- ** transactionSetRefspec #method:transactionSetRefspec#

#if defined(ENABLE_OVERLOADING)
    RepoTransactionSetRefspecMethodInfo     ,
#endif
    repoTransactionSetRefspec               ,


-- ** traverseParentsGetCommits #method:traverseParentsGetCommits#

    repoTraverseParentsGetCommits           ,


-- ** verifyCommit #method:verifyCommit#

#if defined(ENABLE_OVERLOADING)
    RepoVerifyCommitMethodInfo              ,
#endif
    repoVerifyCommit                        ,


-- ** verifyCommitExt #method:verifyCommitExt#

#if defined(ENABLE_OVERLOADING)
    RepoVerifyCommitExtMethodInfo           ,
#endif
    repoVerifyCommitExt                     ,


-- ** verifyCommitForRemote #method:verifyCommitForRemote#

#if defined(ENABLE_OVERLOADING)
    RepoVerifyCommitForRemoteMethodInfo     ,
#endif
    repoVerifyCommitForRemote               ,


-- ** verifySummary #method:verifySummary#

#if defined(ENABLE_OVERLOADING)
    RepoVerifySummaryMethodInfo             ,
#endif
    repoVerifySummary                       ,


-- ** writeArchiveToMtree #method:writeArchiveToMtree#

#if defined(ENABLE_OVERLOADING)
    RepoWriteArchiveToMtreeMethodInfo       ,
#endif
    repoWriteArchiveToMtree                 ,


-- ** writeCommit #method:writeCommit#

#if defined(ENABLE_OVERLOADING)
    RepoWriteCommitMethodInfo               ,
#endif
    repoWriteCommit                         ,


-- ** writeCommitDetachedMetadata #method:writeCommitDetachedMetadata#

#if defined(ENABLE_OVERLOADING)
    RepoWriteCommitDetachedMetadataMethodInfo,
#endif
    repoWriteCommitDetachedMetadata         ,


-- ** writeCommitWithTime #method:writeCommitWithTime#

#if defined(ENABLE_OVERLOADING)
    RepoWriteCommitWithTimeMethodInfo       ,
#endif
    repoWriteCommitWithTime                 ,


-- ** writeConfig #method:writeConfig#

#if defined(ENABLE_OVERLOADING)
    RepoWriteConfigMethodInfo               ,
#endif
    repoWriteConfig                         ,


-- ** writeContent #method:writeContent#

#if defined(ENABLE_OVERLOADING)
    RepoWriteContentMethodInfo              ,
#endif
    repoWriteContent                        ,


-- ** writeContentAsync #method:writeContentAsync#

#if defined(ENABLE_OVERLOADING)
    RepoWriteContentAsyncMethodInfo         ,
#endif
    repoWriteContentAsync                   ,


-- ** writeContentFinish #method:writeContentFinish#

#if defined(ENABLE_OVERLOADING)
    RepoWriteContentFinishMethodInfo        ,
#endif
    repoWriteContentFinish                  ,


-- ** writeContentTrusted #method:writeContentTrusted#

#if defined(ENABLE_OVERLOADING)
    RepoWriteContentTrustedMethodInfo       ,
#endif
    repoWriteContentTrusted                 ,


-- ** writeDfdToMtree #method:writeDfdToMtree#

#if defined(ENABLE_OVERLOADING)
    RepoWriteDfdToMtreeMethodInfo           ,
#endif
    repoWriteDfdToMtree                     ,


-- ** writeDirectoryToMtree #method:writeDirectoryToMtree#

#if defined(ENABLE_OVERLOADING)
    RepoWriteDirectoryToMtreeMethodInfo     ,
#endif
    repoWriteDirectoryToMtree               ,


-- ** writeMetadata #method:writeMetadata#

#if defined(ENABLE_OVERLOADING)
    RepoWriteMetadataMethodInfo             ,
#endif
    repoWriteMetadata                       ,


-- ** writeMetadataAsync #method:writeMetadataAsync#

#if defined(ENABLE_OVERLOADING)
    RepoWriteMetadataAsyncMethodInfo        ,
#endif
    repoWriteMetadataAsync                  ,


-- ** writeMetadataFinish #method:writeMetadataFinish#

#if defined(ENABLE_OVERLOADING)
    RepoWriteMetadataFinishMethodInfo       ,
#endif
    repoWriteMetadataFinish                 ,


-- ** writeMetadataStreamTrusted #method:writeMetadataStreamTrusted#

#if defined(ENABLE_OVERLOADING)
    RepoWriteMetadataStreamTrustedMethodInfo,
#endif
    repoWriteMetadataStreamTrusted          ,


-- ** writeMetadataTrusted #method:writeMetadataTrusted#

#if defined(ENABLE_OVERLOADING)
    RepoWriteMetadataTrustedMethodInfo      ,
#endif
    repoWriteMetadataTrusted                ,


-- ** writeMtree #method:writeMtree#

#if defined(ENABLE_OVERLOADING)
    RepoWriteMtreeMethodInfo                ,
#endif
    repoWriteMtree                          ,




 -- * Properties
-- ** path #attr:path#
-- | Path to repository.  Note that if this repository was created
-- via @ostree_repo_new_at()@, this value will refer to a value in
-- the Linux kernel\'s @\/proc\/self\/fd@ directory.  Generally, you
-- should avoid using this property at all; you can gain a reference
-- to the repository\'s directory fd via @ostree_repo_get_dfd()@ and
-- use file-descriptor relative operations.

#if defined(ENABLE_OVERLOADING)
    RepoPathPropertyInfo                    ,
#endif
    constructRepoPath                       ,
    getRepoPath                             ,
#if defined(ENABLE_OVERLOADING)
    repoPath                                ,
#endif


-- ** remotesConfigDir #attr:remotesConfigDir#
-- | Path to directory containing remote definitions.  The default is @NULL@.
-- If a @sysroot-path@ property is defined, this value will default to
-- @${sysroot_path}\/etc\/ostree\/remotes.d@.
-- 
-- This value will only be used for system repositories.

#if defined(ENABLE_OVERLOADING)
    RepoRemotesConfigDirPropertyInfo        ,
#endif
    constructRepoRemotesConfigDir           ,
    getRepoRemotesConfigDir                 ,
#if defined(ENABLE_OVERLOADING)
    repoRemotesConfigDir                    ,
#endif


-- ** sysrootPath #attr:sysrootPath#
-- | A system using libostree for the host has a \"system\" repository; this
-- property will be set for repositories referenced via
-- @ostree_sysroot_repo()@ for example.
-- 
-- You should avoid using this property; if your code is operating
-- on a system repository, use @OstreeSysroot@ and access the repository
-- object via @ostree_sysroot_repo()@.

#if defined(ENABLE_OVERLOADING)
    RepoSysrootPathPropertyInfo             ,
#endif
    constructRepoSysrootPath                ,
    getRepoSysrootPath                      ,
#if defined(ENABLE_OVERLOADING)
    repoSysrootPath                         ,
#endif




 -- * Signals
-- ** gpgVerifyResult #signal:gpgVerifyResult#

    C_RepoGpgVerifyResultCallback           ,
    RepoGpgVerifyResultCallback             ,
#if defined(ENABLE_OVERLOADING)
    RepoGpgVerifyResultSignalInfo           ,
#endif
    afterRepoGpgVerifyResult                ,
    genClosure_RepoGpgVerifyResult          ,
    mk_RepoGpgVerifyResultCallback          ,
    noRepoGpgVerifyResultCallback           ,
    onRepoGpgVerifyResult                   ,
    wrap_RepoGpgVerifyResultCallback        ,




    ) 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.Bytes as GLib.Bytes
import qualified GI.GLib.Structs.KeyFile as GLib.KeyFile
import qualified GI.GObject.Objects.Object as GObject.Object
import qualified GI.Gio.Callbacks as Gio.Callbacks
import qualified GI.Gio.Interfaces.AsyncResult as Gio.AsyncResult
import qualified GI.Gio.Interfaces.File as Gio.File
import qualified GI.Gio.Objects.Cancellable as Gio.Cancellable
import qualified GI.Gio.Objects.FileInfo as Gio.FileInfo
import qualified GI.Gio.Objects.InputStream as Gio.InputStream
import {-# SOURCE #-} qualified GI.OSTree.Enums as OSTree.Enums
import {-# SOURCE #-} qualified GI.OSTree.Flags as OSTree.Flags
import {-# SOURCE #-} qualified GI.OSTree.Interfaces.RepoFinder as OSTree.RepoFinder
import {-# SOURCE #-} qualified GI.OSTree.Objects.AsyncProgress as OSTree.AsyncProgress
import {-# SOURCE #-} qualified GI.OSTree.Objects.GpgVerifyResult as OSTree.GpgVerifyResult
import {-# SOURCE #-} qualified GI.OSTree.Objects.MutableTree as OSTree.MutableTree
import {-# SOURCE #-} qualified GI.OSTree.Objects.RepoFile as OSTree.RepoFile
import {-# SOURCE #-} qualified GI.OSTree.Structs.CollectionRef as OSTree.CollectionRef
import {-# SOURCE #-} qualified GI.OSTree.Structs.Remote as OSTree.Remote
import {-# SOURCE #-} qualified GI.OSTree.Structs.RepoCheckoutAtOptions as OSTree.RepoCheckoutAtOptions
import {-# SOURCE #-} qualified GI.OSTree.Structs.RepoCommitModifier as OSTree.RepoCommitModifier
import {-# SOURCE #-} qualified GI.OSTree.Structs.RepoFinderResult as OSTree.RepoFinderResult
import {-# SOURCE #-} qualified GI.OSTree.Structs.RepoPruneOptions as OSTree.RepoPruneOptions
import {-# SOURCE #-} qualified GI.OSTree.Structs.RepoTransactionStats as OSTree.RepoTransactionStats

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

instance GObject Repo where
    gobjectType :: IO GType
gobjectType = IO GType
c_ostree_repo_get_type
    

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

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

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

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

-- | A convenience alias for `Nothing` :: `Maybe` `Repo`.
noRepo :: Maybe Repo
noRepo :: Maybe Repo
noRepo = Maybe Repo
forall a. Maybe a
Nothing

#if defined(ENABLE_OVERLOADING)
type family ResolveRepoMethod (t :: Symbol) (o :: *) :: * where
    ResolveRepoMethod "abortTransaction" o = RepoAbortTransactionMethodInfo
    ResolveRepoMethod "addGpgSignatureSummary" o = RepoAddGpgSignatureSummaryMethodInfo
    ResolveRepoMethod "appendGpgSignature" o = RepoAppendGpgSignatureMethodInfo
    ResolveRepoMethod "bindProperty" o = GObject.Object.ObjectBindPropertyMethodInfo
    ResolveRepoMethod "bindPropertyFull" o = GObject.Object.ObjectBindPropertyFullMethodInfo
    ResolveRepoMethod "checkoutAt" o = RepoCheckoutAtMethodInfo
    ResolveRepoMethod "checkoutGc" o = RepoCheckoutGcMethodInfo
    ResolveRepoMethod "checkoutTree" o = RepoCheckoutTreeMethodInfo
    ResolveRepoMethod "commitTransaction" o = RepoCommitTransactionMethodInfo
    ResolveRepoMethod "copyConfig" o = RepoCopyConfigMethodInfo
    ResolveRepoMethod "create" o = RepoCreateMethodInfo
    ResolveRepoMethod "deleteObject" o = RepoDeleteObjectMethodInfo
    ResolveRepoMethod "equal" o = RepoEqualMethodInfo
    ResolveRepoMethod "findRemotesAsync" o = RepoFindRemotesAsyncMethodInfo
    ResolveRepoMethod "findRemotesFinish" o = RepoFindRemotesFinishMethodInfo
    ResolveRepoMethod "forceFloating" o = GObject.Object.ObjectForceFloatingMethodInfo
    ResolveRepoMethod "freezeNotify" o = GObject.Object.ObjectFreezeNotifyMethodInfo
    ResolveRepoMethod "fsckObject" o = RepoFsckObjectMethodInfo
    ResolveRepoMethod "getv" o = GObject.Object.ObjectGetvMethodInfo
    ResolveRepoMethod "gpgVerifyData" o = RepoGpgVerifyDataMethodInfo
    ResolveRepoMethod "hasObject" o = RepoHasObjectMethodInfo
    ResolveRepoMethod "hash" o = RepoHashMethodInfo
    ResolveRepoMethod "importObjectFrom" o = RepoImportObjectFromMethodInfo
    ResolveRepoMethod "importObjectFromWithTrust" o = RepoImportObjectFromWithTrustMethodInfo
    ResolveRepoMethod "isFloating" o = GObject.Object.ObjectIsFloatingMethodInfo
    ResolveRepoMethod "isSystem" o = RepoIsSystemMethodInfo
    ResolveRepoMethod "isWritable" o = RepoIsWritableMethodInfo
    ResolveRepoMethod "listCollectionRefs" o = RepoListCollectionRefsMethodInfo
    ResolveRepoMethod "listCommitObjectsStartingWith" o = RepoListCommitObjectsStartingWithMethodInfo
    ResolveRepoMethod "listObjects" o = RepoListObjectsMethodInfo
    ResolveRepoMethod "listRefs" o = RepoListRefsMethodInfo
    ResolveRepoMethod "listRefsExt" o = RepoListRefsExtMethodInfo
    ResolveRepoMethod "listStaticDeltaNames" o = RepoListStaticDeltaNamesMethodInfo
    ResolveRepoMethod "loadCommit" o = RepoLoadCommitMethodInfo
    ResolveRepoMethod "loadFile" o = RepoLoadFileMethodInfo
    ResolveRepoMethod "loadObjectStream" o = RepoLoadObjectStreamMethodInfo
    ResolveRepoMethod "loadVariant" o = RepoLoadVariantMethodInfo
    ResolveRepoMethod "loadVariantIfExists" o = RepoLoadVariantIfExistsMethodInfo
    ResolveRepoMethod "markCommitPartial" o = RepoMarkCommitPartialMethodInfo
    ResolveRepoMethod "notify" o = GObject.Object.ObjectNotifyMethodInfo
    ResolveRepoMethod "notifyByPspec" o = GObject.Object.ObjectNotifyByPspecMethodInfo
    ResolveRepoMethod "open" o = RepoOpenMethodInfo
    ResolveRepoMethod "prepareTransaction" o = RepoPrepareTransactionMethodInfo
    ResolveRepoMethod "prune" o = RepoPruneMethodInfo
    ResolveRepoMethod "pruneFromReachable" o = RepoPruneFromReachableMethodInfo
    ResolveRepoMethod "pruneStaticDeltas" o = RepoPruneStaticDeltasMethodInfo
    ResolveRepoMethod "pull" o = RepoPullMethodInfo
    ResolveRepoMethod "pullFromRemotesAsync" o = RepoPullFromRemotesAsyncMethodInfo
    ResolveRepoMethod "pullFromRemotesFinish" o = RepoPullFromRemotesFinishMethodInfo
    ResolveRepoMethod "pullOneDir" o = RepoPullOneDirMethodInfo
    ResolveRepoMethod "pullWithOptions" o = RepoPullWithOptionsMethodInfo
    ResolveRepoMethod "queryObjectStorageSize" o = RepoQueryObjectStorageSizeMethodInfo
    ResolveRepoMethod "readCommit" o = RepoReadCommitMethodInfo
    ResolveRepoMethod "readCommitDetachedMetadata" o = RepoReadCommitDetachedMetadataMethodInfo
    ResolveRepoMethod "ref" o = GObject.Object.ObjectRefMethodInfo
    ResolveRepoMethod "refSink" o = GObject.Object.ObjectRefSinkMethodInfo
    ResolveRepoMethod "regenerateSummary" o = RepoRegenerateSummaryMethodInfo
    ResolveRepoMethod "reloadConfig" o = RepoReloadConfigMethodInfo
    ResolveRepoMethod "remoteAdd" o = RepoRemoteAddMethodInfo
    ResolveRepoMethod "remoteChange" o = RepoRemoteChangeMethodInfo
    ResolveRepoMethod "remoteDelete" o = RepoRemoteDeleteMethodInfo
    ResolveRepoMethod "remoteFetchSummary" o = RepoRemoteFetchSummaryMethodInfo
    ResolveRepoMethod "remoteFetchSummaryWithOptions" o = RepoRemoteFetchSummaryWithOptionsMethodInfo
    ResolveRepoMethod "remoteGetGpgVerify" o = RepoRemoteGetGpgVerifyMethodInfo
    ResolveRepoMethod "remoteGetGpgVerifySummary" o = RepoRemoteGetGpgVerifySummaryMethodInfo
    ResolveRepoMethod "remoteGetUrl" o = RepoRemoteGetUrlMethodInfo
    ResolveRepoMethod "remoteGpgImport" o = RepoRemoteGpgImportMethodInfo
    ResolveRepoMethod "remoteList" o = RepoRemoteListMethodInfo
    ResolveRepoMethod "remoteListCollectionRefs" o = RepoRemoteListCollectionRefsMethodInfo
    ResolveRepoMethod "remoteListRefs" o = RepoRemoteListRefsMethodInfo
    ResolveRepoMethod "resolveCollectionRef" o = RepoResolveCollectionRefMethodInfo
    ResolveRepoMethod "resolveKeyringForCollection" o = RepoResolveKeyringForCollectionMethodInfo
    ResolveRepoMethod "resolveRev" o = RepoResolveRevMethodInfo
    ResolveRepoMethod "resolveRevExt" o = RepoResolveRevExtMethodInfo
    ResolveRepoMethod "runDispose" o = GObject.Object.ObjectRunDisposeMethodInfo
    ResolveRepoMethod "scanHardlinks" o = RepoScanHardlinksMethodInfo
    ResolveRepoMethod "signCommit" o = RepoSignCommitMethodInfo
    ResolveRepoMethod "signDelta" o = RepoSignDeltaMethodInfo
    ResolveRepoMethod "staticDeltaExecuteOffline" o = RepoStaticDeltaExecuteOfflineMethodInfo
    ResolveRepoMethod "staticDeltaGenerate" o = RepoStaticDeltaGenerateMethodInfo
    ResolveRepoMethod "stealData" o = GObject.Object.ObjectStealDataMethodInfo
    ResolveRepoMethod "stealQdata" o = GObject.Object.ObjectStealQdataMethodInfo
    ResolveRepoMethod "thawNotify" o = GObject.Object.ObjectThawNotifyMethodInfo
    ResolveRepoMethod "transactionSetCollectionRef" o = RepoTransactionSetCollectionRefMethodInfo
    ResolveRepoMethod "transactionSetRef" o = RepoTransactionSetRefMethodInfo
    ResolveRepoMethod "transactionSetRefspec" o = RepoTransactionSetRefspecMethodInfo
    ResolveRepoMethod "traverseCommit" o = RepoTraverseCommitMethodInfo
    ResolveRepoMethod "traverseReachableRefs" o = RepoTraverseReachableRefsMethodInfo
    ResolveRepoMethod "unref" o = GObject.Object.ObjectUnrefMethodInfo
    ResolveRepoMethod "verifyCommit" o = RepoVerifyCommitMethodInfo
    ResolveRepoMethod "verifyCommitExt" o = RepoVerifyCommitExtMethodInfo
    ResolveRepoMethod "verifyCommitForRemote" o = RepoVerifyCommitForRemoteMethodInfo
    ResolveRepoMethod "verifySummary" o = RepoVerifySummaryMethodInfo
    ResolveRepoMethod "watchClosure" o = GObject.Object.ObjectWatchClosureMethodInfo
    ResolveRepoMethod "writeArchiveToMtree" o = RepoWriteArchiveToMtreeMethodInfo
    ResolveRepoMethod "writeCommit" o = RepoWriteCommitMethodInfo
    ResolveRepoMethod "writeCommitDetachedMetadata" o = RepoWriteCommitDetachedMetadataMethodInfo
    ResolveRepoMethod "writeCommitWithTime" o = RepoWriteCommitWithTimeMethodInfo
    ResolveRepoMethod "writeConfig" o = RepoWriteConfigMethodInfo
    ResolveRepoMethod "writeContent" o = RepoWriteContentMethodInfo
    ResolveRepoMethod "writeContentAsync" o = RepoWriteContentAsyncMethodInfo
    ResolveRepoMethod "writeContentFinish" o = RepoWriteContentFinishMethodInfo
    ResolveRepoMethod "writeContentTrusted" o = RepoWriteContentTrustedMethodInfo
    ResolveRepoMethod "writeDfdToMtree" o = RepoWriteDfdToMtreeMethodInfo
    ResolveRepoMethod "writeDirectoryToMtree" o = RepoWriteDirectoryToMtreeMethodInfo
    ResolveRepoMethod "writeMetadata" o = RepoWriteMetadataMethodInfo
    ResolveRepoMethod "writeMetadataAsync" o = RepoWriteMetadataAsyncMethodInfo
    ResolveRepoMethod "writeMetadataFinish" o = RepoWriteMetadataFinishMethodInfo
    ResolveRepoMethod "writeMetadataStreamTrusted" o = RepoWriteMetadataStreamTrustedMethodInfo
    ResolveRepoMethod "writeMetadataTrusted" o = RepoWriteMetadataTrustedMethodInfo
    ResolveRepoMethod "writeMtree" o = RepoWriteMtreeMethodInfo
    ResolveRepoMethod "getBootloader" o = RepoGetBootloaderMethodInfo
    ResolveRepoMethod "getCollectionId" o = RepoGetCollectionIdMethodInfo
    ResolveRepoMethod "getConfig" o = RepoGetConfigMethodInfo
    ResolveRepoMethod "getData" o = GObject.Object.ObjectGetDataMethodInfo
    ResolveRepoMethod "getDefaultRepoFinders" o = RepoGetDefaultRepoFindersMethodInfo
    ResolveRepoMethod "getDfd" o = RepoGetDfdMethodInfo
    ResolveRepoMethod "getDisableFsync" o = RepoGetDisableFsyncMethodInfo
    ResolveRepoMethod "getMinFreeSpaceBytes" o = RepoGetMinFreeSpaceBytesMethodInfo
    ResolveRepoMethod "getMode" o = RepoGetModeMethodInfo
    ResolveRepoMethod "getParent" o = RepoGetParentMethodInfo
    ResolveRepoMethod "getPath" o = RepoGetPathMethodInfo
    ResolveRepoMethod "getProperty" o = GObject.Object.ObjectGetPropertyMethodInfo
    ResolveRepoMethod "getQdata" o = GObject.Object.ObjectGetQdataMethodInfo
    ResolveRepoMethod "getRemoteBooleanOption" o = RepoGetRemoteBooleanOptionMethodInfo
    ResolveRepoMethod "getRemoteListOption" o = RepoGetRemoteListOptionMethodInfo
    ResolveRepoMethod "getRemoteOption" o = RepoGetRemoteOptionMethodInfo
    ResolveRepoMethod "setAliasRefImmediate" o = RepoSetAliasRefImmediateMethodInfo
    ResolveRepoMethod "setCacheDir" o = RepoSetCacheDirMethodInfo
    ResolveRepoMethod "setCollectionId" o = RepoSetCollectionIdMethodInfo
    ResolveRepoMethod "setCollectionRefImmediate" o = RepoSetCollectionRefImmediateMethodInfo
    ResolveRepoMethod "setData" o = GObject.Object.ObjectSetDataMethodInfo
    ResolveRepoMethod "setDataFull" o = GObject.Object.ObjectSetDataFullMethodInfo
    ResolveRepoMethod "setDisableFsync" o = RepoSetDisableFsyncMethodInfo
    ResolveRepoMethod "setProperty" o = GObject.Object.ObjectSetPropertyMethodInfo
    ResolveRepoMethod "setRefImmediate" o = RepoSetRefImmediateMethodInfo
    ResolveRepoMethod l o = O.MethodResolutionFailed l o

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

#endif

-- signal Repo::gpg-verify-result
-- | Emitted during a pull operation upon GPG verification (if enabled).
-- Applications can connect to this signal to output the verification
-- results if desired.
-- 
-- The signal will be emitted from whichever t'GI.GLib.Structs.MainContext.MainContext' is the
-- thread-default at the point when 'GI.OSTree.Objects.Repo.repoPullWithOptions'
-- is called.
type RepoGpgVerifyResultCallback =
    T.Text
    -- ^ /@checksum@/: checksum of the signed object
    -> OSTree.GpgVerifyResult.GpgVerifyResult
    -- ^ /@result@/: an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'
    -> IO ()

-- | A convenience synonym for @`Nothing` :: `Maybe` `RepoGpgVerifyResultCallback`@.
noRepoGpgVerifyResultCallback :: Maybe RepoGpgVerifyResultCallback
noRepoGpgVerifyResultCallback :: Maybe RepoGpgVerifyResultCallback
noRepoGpgVerifyResultCallback = Maybe RepoGpgVerifyResultCallback
forall a. Maybe a
Nothing

-- | Type for the callback on the (unwrapped) C side.
type C_RepoGpgVerifyResultCallback =
    Ptr () ->                               -- object
    CString ->
    Ptr OSTree.GpgVerifyResult.GpgVerifyResult ->
    Ptr () ->                               -- user_data
    IO ()

-- | Generate a function pointer callable from C code, from a `C_RepoGpgVerifyResultCallback`.
foreign import ccall "wrapper"
    mk_RepoGpgVerifyResultCallback :: C_RepoGpgVerifyResultCallback -> IO (FunPtr C_RepoGpgVerifyResultCallback)

-- | Wrap the callback into a `GClosure`.
genClosure_RepoGpgVerifyResult :: MonadIO m => RepoGpgVerifyResultCallback -> m (GClosure C_RepoGpgVerifyResultCallback)
genClosure_RepoGpgVerifyResult :: RepoGpgVerifyResultCallback
-> m (GClosure C_RepoGpgVerifyResultCallback)
genClosure_RepoGpgVerifyResult cb :: RepoGpgVerifyResultCallback
cb = IO (GClosure C_RepoGpgVerifyResultCallback)
-> m (GClosure C_RepoGpgVerifyResultCallback)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GClosure C_RepoGpgVerifyResultCallback)
 -> m (GClosure C_RepoGpgVerifyResultCallback))
-> IO (GClosure C_RepoGpgVerifyResultCallback)
-> m (GClosure C_RepoGpgVerifyResultCallback)
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RepoGpgVerifyResultCallback
cb' = RepoGpgVerifyResultCallback -> C_RepoGpgVerifyResultCallback
wrap_RepoGpgVerifyResultCallback RepoGpgVerifyResultCallback
cb
    C_RepoGpgVerifyResultCallback
-> IO (FunPtr C_RepoGpgVerifyResultCallback)
mk_RepoGpgVerifyResultCallback C_RepoGpgVerifyResultCallback
cb' IO (FunPtr C_RepoGpgVerifyResultCallback)
-> (FunPtr C_RepoGpgVerifyResultCallback
    -> IO (GClosure C_RepoGpgVerifyResultCallback))
-> IO (GClosure C_RepoGpgVerifyResultCallback)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FunPtr C_RepoGpgVerifyResultCallback
-> IO (GClosure C_RepoGpgVerifyResultCallback)
forall (m :: * -> *) a. MonadIO m => FunPtr a -> m (GClosure a)
B.GClosure.newGClosure


-- | Wrap a `RepoGpgVerifyResultCallback` into a `C_RepoGpgVerifyResultCallback`.
wrap_RepoGpgVerifyResultCallback ::
    RepoGpgVerifyResultCallback ->
    C_RepoGpgVerifyResultCallback
wrap_RepoGpgVerifyResultCallback :: RepoGpgVerifyResultCallback -> C_RepoGpgVerifyResultCallback
wrap_RepoGpgVerifyResultCallback _cb :: RepoGpgVerifyResultCallback
_cb _ checksum :: CString
checksum result_ :: Ptr GpgVerifyResult
result_ _ = do
    Text
checksum' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
checksum
    GpgVerifyResult
result_' <- ((ManagedPtr GpgVerifyResult -> GpgVerifyResult)
-> Ptr GpgVerifyResult -> IO GpgVerifyResult
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr GpgVerifyResult -> GpgVerifyResult
OSTree.GpgVerifyResult.GpgVerifyResult) Ptr GpgVerifyResult
result_
    RepoGpgVerifyResultCallback
_cb  Text
checksum' GpgVerifyResult
result_'


-- | Connect a signal handler for the [gpgVerifyResult](#signal:gpgVerifyResult) signal, to be run before the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.on' repo #gpgVerifyResult callback
-- @
-- 
-- 
onRepoGpgVerifyResult :: (IsRepo a, MonadIO m) => a -> RepoGpgVerifyResultCallback -> m SignalHandlerId
onRepoGpgVerifyResult :: a -> RepoGpgVerifyResultCallback -> m SignalHandlerId
onRepoGpgVerifyResult obj :: a
obj cb :: RepoGpgVerifyResultCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RepoGpgVerifyResultCallback
cb' = RepoGpgVerifyResultCallback -> C_RepoGpgVerifyResultCallback
wrap_RepoGpgVerifyResultCallback RepoGpgVerifyResultCallback
cb
    FunPtr C_RepoGpgVerifyResultCallback
cb'' <- C_RepoGpgVerifyResultCallback
-> IO (FunPtr C_RepoGpgVerifyResultCallback)
mk_RepoGpgVerifyResultCallback C_RepoGpgVerifyResultCallback
cb'
    a
-> Text
-> FunPtr C_RepoGpgVerifyResultCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "gpg-verify-result" FunPtr C_RepoGpgVerifyResultCallback
cb'' SignalConnectMode
SignalConnectBefore Maybe Text
forall a. Maybe a
Nothing

-- | Connect a signal handler for the [gpgVerifyResult](#signal:gpgVerifyResult) signal, to be run after the default handler.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Signals.after' repo #gpgVerifyResult callback
-- @
-- 
-- 
afterRepoGpgVerifyResult :: (IsRepo a, MonadIO m) => a -> RepoGpgVerifyResultCallback -> m SignalHandlerId
afterRepoGpgVerifyResult :: a -> RepoGpgVerifyResultCallback -> m SignalHandlerId
afterRepoGpgVerifyResult obj :: a
obj cb :: RepoGpgVerifyResultCallback
cb = IO SignalHandlerId -> m SignalHandlerId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SignalHandlerId -> m SignalHandlerId)
-> IO SignalHandlerId -> m SignalHandlerId
forall a b. (a -> b) -> a -> b
$ do
    let cb' :: C_RepoGpgVerifyResultCallback
cb' = RepoGpgVerifyResultCallback -> C_RepoGpgVerifyResultCallback
wrap_RepoGpgVerifyResultCallback RepoGpgVerifyResultCallback
cb
    FunPtr C_RepoGpgVerifyResultCallback
cb'' <- C_RepoGpgVerifyResultCallback
-> IO (FunPtr C_RepoGpgVerifyResultCallback)
mk_RepoGpgVerifyResultCallback C_RepoGpgVerifyResultCallback
cb'
    a
-> Text
-> FunPtr C_RepoGpgVerifyResultCallback
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
forall o a.
GObject o =>
o
-> Text
-> FunPtr a
-> SignalConnectMode
-> Maybe Text
-> IO SignalHandlerId
connectSignalFunPtr a
obj "gpg-verify-result" FunPtr C_RepoGpgVerifyResultCallback
cb'' SignalConnectMode
SignalConnectAfter Maybe Text
forall a. Maybe a
Nothing


#if defined(ENABLE_OVERLOADING)
data RepoGpgVerifyResultSignalInfo
instance SignalInfo RepoGpgVerifyResultSignalInfo where
    type HaskellCallbackType RepoGpgVerifyResultSignalInfo = RepoGpgVerifyResultCallback
    connectSignal obj cb connectMode detail = do
        let cb' = wrap_RepoGpgVerifyResultCallback cb
        cb'' <- mk_RepoGpgVerifyResultCallback cb'
        connectSignalFunPtr obj "gpg-verify-result" cb'' connectMode detail

#endif

-- VVV Prop "path"
   -- Type: TInterface (Name {namespace = "Gio", name = "File"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Just False,Nothing)

-- | Get the value of the “@path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' repo #path
-- @
getRepoPath :: (MonadIO m, IsRepo o) => o -> m Gio.File.File
getRepoPath :: o -> m File
getRepoPath obj :: o
obj = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ Text -> IO (Maybe File) -> IO File
forall a. HasCallStack => Text -> IO (Maybe a) -> IO a
checkUnexpectedNothing "getRepoPath" (IO (Maybe File) -> IO File) -> IO (Maybe File) -> IO File
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr File -> File) -> IO (Maybe File)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "path" ManagedPtr File -> File
Gio.File.File

-- | Construct a `GValueConstruct` with valid value for the “@path@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRepoPath :: (IsRepo o, Gio.File.IsFile a) => a -> IO (GValueConstruct o)
constructRepoPath :: a -> IO (GValueConstruct o)
constructRepoPath val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "path" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

#if defined(ENABLE_OVERLOADING)
data RepoPathPropertyInfo
instance AttrInfo RepoPathPropertyInfo where
    type AttrAllowedOps RepoPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint RepoPathPropertyInfo = IsRepo
    type AttrSetTypeConstraint RepoPathPropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint RepoPathPropertyInfo = Gio.File.IsFile
    type AttrTransferType RepoPathPropertyInfo = Gio.File.File
    type AttrGetType RepoPathPropertyInfo = Gio.File.File
    type AttrLabel RepoPathPropertyInfo = "path"
    type AttrOrigin RepoPathPropertyInfo = Repo
    attrGet = getRepoPath
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructRepoPath
    attrClear = undefined
#endif

-- VVV Prop "remotes-config-dir"
   -- Type: TBasicType TUTF8
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@remotes-config-dir@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' repo #remotesConfigDir
-- @
getRepoRemotesConfigDir :: (MonadIO m, IsRepo o) => o -> m (Maybe T.Text)
getRepoRemotesConfigDir :: o -> m (Maybe Text)
getRepoRemotesConfigDir obj :: o
obj = 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
$ o -> String -> IO (Maybe Text)
forall a. GObject a => a -> String -> IO (Maybe Text)
B.Properties.getObjectPropertyString o
obj "remotes-config-dir"

-- | Construct a `GValueConstruct` with valid value for the “@remotes-config-dir@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRepoRemotesConfigDir :: (IsRepo o) => T.Text -> IO (GValueConstruct o)
constructRepoRemotesConfigDir :: Text -> IO (GValueConstruct o)
constructRepoRemotesConfigDir val :: Text
val = String -> Maybe Text -> IO (GValueConstruct o)
forall o. String -> Maybe Text -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyString "remotes-config-dir" (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
val)

#if defined(ENABLE_OVERLOADING)
data RepoRemotesConfigDirPropertyInfo
instance AttrInfo RepoRemotesConfigDirPropertyInfo where
    type AttrAllowedOps RepoRemotesConfigDirPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint RepoRemotesConfigDirPropertyInfo = IsRepo
    type AttrSetTypeConstraint RepoRemotesConfigDirPropertyInfo = (~) T.Text
    type AttrTransferTypeConstraint RepoRemotesConfigDirPropertyInfo = (~) T.Text
    type AttrTransferType RepoRemotesConfigDirPropertyInfo = T.Text
    type AttrGetType RepoRemotesConfigDirPropertyInfo = (Maybe T.Text)
    type AttrLabel RepoRemotesConfigDirPropertyInfo = "remotes-config-dir"
    type AttrOrigin RepoRemotesConfigDirPropertyInfo = Repo
    attrGet = getRepoRemotesConfigDir
    attrSet = undefined
    attrTransfer _ v = do
        return v
    attrConstruct = constructRepoRemotesConfigDir
    attrClear = undefined
#endif

-- VVV Prop "sysroot-path"
   -- Type: TInterface (Name {namespace = "Gio", name = "File"})
   -- Flags: [PropertyReadable,PropertyWritable,PropertyConstructOnly]
   -- Nullable: (Nothing,Nothing)

-- | Get the value of the “@sysroot-path@” property.
-- When <https://github.com/haskell-gi/haskell-gi/wiki/Overloading overloading> is enabled, this is equivalent to
-- 
-- @
-- 'Data.GI.Base.Attributes.get' repo #sysrootPath
-- @
getRepoSysrootPath :: (MonadIO m, IsRepo o) => o -> m (Maybe Gio.File.File)
getRepoSysrootPath :: o -> m (Maybe File)
getRepoSysrootPath obj :: o
obj = IO (Maybe File) -> m (Maybe File)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe File) -> m (Maybe File))
-> IO (Maybe File) -> m (Maybe File)
forall a b. (a -> b) -> a -> b
$ o -> String -> (ManagedPtr File -> File) -> IO (Maybe File)
forall a b.
(GObject a, GObject b) =>
a -> String -> (ManagedPtr b -> b) -> IO (Maybe b)
B.Properties.getObjectPropertyObject o
obj "sysroot-path" ManagedPtr File -> File
Gio.File.File

-- | Construct a `GValueConstruct` with valid value for the “@sysroot-path@” property. This is rarely needed directly, but it is used by `Data.GI.Base.Constructible.new`.
constructRepoSysrootPath :: (IsRepo o, Gio.File.IsFile a) => a -> IO (GValueConstruct o)
constructRepoSysrootPath :: a -> IO (GValueConstruct o)
constructRepoSysrootPath val :: a
val = String -> Maybe a -> IO (GValueConstruct o)
forall a o.
GObject a =>
String -> Maybe a -> IO (GValueConstruct o)
B.Properties.constructObjectPropertyObject "sysroot-path" (a -> Maybe a
forall a. a -> Maybe a
Just a
val)

#if defined(ENABLE_OVERLOADING)
data RepoSysrootPathPropertyInfo
instance AttrInfo RepoSysrootPathPropertyInfo where
    type AttrAllowedOps RepoSysrootPathPropertyInfo = '[ 'AttrConstruct, 'AttrGet, 'AttrClear]
    type AttrBaseTypeConstraint RepoSysrootPathPropertyInfo = IsRepo
    type AttrSetTypeConstraint RepoSysrootPathPropertyInfo = Gio.File.IsFile
    type AttrTransferTypeConstraint RepoSysrootPathPropertyInfo = Gio.File.IsFile
    type AttrTransferType RepoSysrootPathPropertyInfo = Gio.File.File
    type AttrGetType RepoSysrootPathPropertyInfo = (Maybe Gio.File.File)
    type AttrLabel RepoSysrootPathPropertyInfo = "sysroot-path"
    type AttrOrigin RepoSysrootPathPropertyInfo = Repo
    attrGet = getRepoSysrootPath
    attrSet = undefined
    attrTransfer _ v = do
        unsafeCastTo Gio.File.File v
    attrConstruct = constructRepoSysrootPath
    attrClear = undefined
#endif

#if defined(ENABLE_OVERLOADING)
instance O.HasAttributeList Repo
type instance O.AttributeList Repo = RepoAttributeList
type RepoAttributeList = ('[ '("path", RepoPathPropertyInfo), '("remotesConfigDir", RepoRemotesConfigDirPropertyInfo), '("sysrootPath", RepoSysrootPathPropertyInfo)] :: [(Symbol, *)])
#endif

#if defined(ENABLE_OVERLOADING)
repoPath :: AttrLabelProxy "path"
repoPath = AttrLabelProxy

repoRemotesConfigDir :: AttrLabelProxy "remotesConfigDir"
repoRemotesConfigDir = AttrLabelProxy

repoSysrootPath :: AttrLabelProxy "sysrootPath"
repoSysrootPath = AttrLabelProxy

#endif

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

#endif

-- method Repo::new
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "path"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Path to a repository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "OSTree" , name = "Repo" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_new" ostree_repo_new :: 
    Ptr Gio.File.File ->                    -- path : TInterface (Name {namespace = "Gio", name = "File"})
    IO (Ptr Repo)

-- | /No description available in the introspection data./
repoNew ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a) =>
    a
    -- ^ /@path@/: Path to a repository
    -> m Repo
    -- ^ __Returns:__ An accessor object for an OSTree repository located at /@path@/
repoNew :: a -> m Repo
repoNew path :: a
path = IO Repo -> m Repo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Repo -> m Repo) -> IO Repo -> m Repo
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
path' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
path
    Ptr Repo
result <- Ptr File -> IO (Ptr Repo)
ostree_repo_new Ptr File
path'
    Text -> Ptr Repo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoNew" Ptr Repo
result
    Repo
result' <- ((ManagedPtr Repo -> Repo) -> Ptr Repo -> IO Repo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Repo -> Repo
Repo) Ptr Repo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
path
    Repo -> IO Repo
forall (m :: * -> *) a. Monad m => a -> m a
return Repo
result'

#if defined(ENABLE_OVERLOADING)
#endif

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

foreign import ccall "ostree_repo_new_default" ostree_repo_new_default :: 
    IO (Ptr Repo)

-- | If the current working directory appears to be an OSTree
-- repository, create a new t'GI.OSTree.Objects.Repo.Repo' object for accessing it.
-- Otherwise use the path in the OSTREE_REPO environment variable
-- (if defined) or else the default system repository located at
-- \/ostree\/repo.
repoNewDefault ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    m Repo
    -- ^ __Returns:__ An accessor object for an OSTree repository located at \/ostree\/repo
repoNewDefault :: m Repo
repoNewDefault  = IO Repo -> m Repo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Repo -> m Repo) -> IO Repo -> m Repo
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
result <- IO (Ptr Repo)
ostree_repo_new_default
    Text -> Ptr Repo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoNewDefault" Ptr Repo
result
    Repo
result' <- ((ManagedPtr Repo -> Repo) -> Ptr Repo -> IO Repo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Repo -> Repo
Repo) Ptr Repo
result
    Repo -> IO Repo
forall (m :: * -> *) a. Monad m => a -> m a
return Repo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repo::new_for_sysroot_path
-- method type : Constructor
-- Args: [ Arg
--           { argCName = "repo_path"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Path to a repository"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sysroot_path"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Path to the system root"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "OSTree" , name = "Repo" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_new_for_sysroot_path" ostree_repo_new_for_sysroot_path :: 
    Ptr Gio.File.File ->                    -- repo_path : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.File.File ->                    -- sysroot_path : TInterface (Name {namespace = "Gio", name = "File"})
    IO (Ptr Repo)

-- | Creates a new t'GI.OSTree.Objects.Repo.Repo' instance, taking the system root path explicitly
-- instead of assuming \"\/\".
repoNewForSysrootPath ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.File.IsFile a, Gio.File.IsFile b) =>
    a
    -- ^ /@repoPath@/: Path to a repository
    -> b
    -- ^ /@sysrootPath@/: Path to the system root
    -> m Repo
    -- ^ __Returns:__ An accessor object for the OSTree repository located at /@repoPath@/.
repoNewForSysrootPath :: a -> b -> m Repo
repoNewForSysrootPath repoPath :: a
repoPath sysrootPath :: b
sysrootPath = IO Repo -> m Repo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Repo -> m Repo) -> IO Repo -> m Repo
forall a b. (a -> b) -> a -> b
$ do
    Ptr File
repoPath' <- a -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repoPath
    Ptr File
sysrootPath' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
sysrootPath
    Ptr Repo
result <- Ptr File -> Ptr File -> IO (Ptr Repo)
ostree_repo_new_for_sysroot_path Ptr File
repoPath' Ptr File
sysrootPath'
    Text -> Ptr Repo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoNewForSysrootPath" Ptr Repo
result
    Repo
result' <- ((ManagedPtr Repo -> Repo) -> Ptr Repo -> IO Repo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Repo -> Repo
Repo) Ptr Repo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repoPath
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
sysrootPath
    Repo -> IO Repo
forall (m :: * -> *) a. Monad m => a -> m a
return Repo
result'

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repo::abort_transaction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_abort_transaction" ostree_repo_abort_transaction :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Abort the active transaction; any staged objects and ref changes will be
-- discarded. You *must* invoke this if you have chosen not to invoke
-- 'GI.OSTree.Objects.Repo.repoCommitTransaction'. Calling this function when not in a
-- transaction will do nothing and return successfully.
repoAbortTransaction ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoAbortTransaction :: a -> Maybe b -> m ()
repoAbortTransaction self :: a
self cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_repo_abort_transaction Ptr Repo
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoAbortTransactionMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoAbortTransactionMethodInfo a signature where
    overloadedMethod = repoAbortTransaction

#endif

-- method Repo::add_gpg_signature_summary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_id"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "NULL-terminated array of GPG keys."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "homedir"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GPG home directory, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable" , 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_repo_add_gpg_signature_summary" ostree_repo_add_gpg_signature_summary :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr CString ->                          -- key_id : TCArray True (-1) (-1) (TBasicType TUTF8)
    CString ->                              -- homedir : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Add a GPG signature to a summary file.
repoAddGpgSignatureSummary ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Self
    -> [T.Text]
    -- ^ /@keyId@/: NULL-terminated array of GPG keys.
    -> Maybe (T.Text)
    -- ^ /@homedir@/: GPG home directory, or 'P.Nothing'
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoAddGpgSignatureSummary :: a -> [Text] -> Maybe Text -> Maybe b -> m ()
repoAddGpgSignatureSummary self :: a
self keyId :: [Text]
keyId homedir :: Maybe Text
homedir cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
keyId' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
keyId
    CString
maybeHomedir <- case Maybe Text
homedir of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jHomedir :: Text
jHomedir -> do
            CString
jHomedir' <- Text -> IO CString
textToCString Text
jHomedir
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jHomedir'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Ptr CString
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_add_gpg_signature_summary Ptr Repo
self' Ptr CString
keyId' CString
maybeHomedir Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
keyId'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
keyId'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeHomedir
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
keyId'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
keyId'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeHomedir
     )

#if defined(ENABLE_OVERLOADING)
data RepoAddGpgSignatureSummaryMethodInfo
instance (signature ~ ([T.Text] -> Maybe (T.Text) -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoAddGpgSignatureSummaryMethodInfo a signature where
    overloadedMethod = repoAddGpgSignatureSummary

#endif

-- method Repo::append_gpg_signature
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "commit_checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "SHA256 of given commit to sign"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signature_bytes"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Signature data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable" , 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_repo_append_gpg_signature" ostree_repo_append_gpg_signature :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- commit_checksum : TBasicType TUTF8
    Ptr GLib.Bytes.Bytes ->                 -- signature_bytes : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Append a GPG signature to a commit.
repoAppendGpgSignature ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Self
    -> T.Text
    -- ^ /@commitChecksum@/: SHA256 of given commit to sign
    -> GLib.Bytes.Bytes
    -- ^ /@signatureBytes@/: Signature data
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoAppendGpgSignature :: a -> Text -> Bytes -> Maybe b -> m ()
repoAppendGpgSignature self :: a
self commitChecksum :: Text
commitChecksum signatureBytes :: Bytes
signatureBytes cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
commitChecksum' <- Text -> IO CString
textToCString Text
commitChecksum
    Ptr Bytes
signatureBytes' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
signatureBytes
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> Ptr Bytes
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_append_gpg_signature Ptr Repo
self' CString
commitChecksum' Ptr Bytes
signatureBytes' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
signatureBytes
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commitChecksum'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commitChecksum'
     )

#if defined(ENABLE_OVERLOADING)
data RepoAppendGpgSignatureMethodInfo
instance (signature ~ (T.Text -> GLib.Bytes.Bytes -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoAppendGpgSignatureMethodInfo a signature where
    overloadedMethod = repoAppendGpgSignature

#endif

-- method Repo::checkout_at
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoCheckoutAtOptions" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Options" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destination_dfd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Directory FD for destination"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destination_path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Directory for destination"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "commit"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Checksum for commit"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_checkout_at" ostree_repo_checkout_at :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr OSTree.RepoCheckoutAtOptions.RepoCheckoutAtOptions -> -- options : TInterface (Name {namespace = "OSTree", name = "RepoCheckoutAtOptions"})
    Int32 ->                                -- destination_dfd : TBasicType TInt
    CString ->                              -- destination_path : TBasicType TUTF8
    CString ->                              -- commit : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Similar to 'GI.OSTree.Objects.Repo.repoCheckoutTree', but uses directory-relative
-- paths for the destination, uses a new @OstreeRepoCheckoutAtOptions@,
-- and takes a commit checksum and optional subpath pair, rather than
-- requiring use of @GFile@ APIs for the caller.
-- 
-- It also replaces 'GI.OSTree.Objects.Repo.repoCheckoutAt' which was not safe to
-- use with GObject introspection.
-- 
-- Note in addition that unlike 'GI.OSTree.Objects.Repo.repoCheckoutTree', the
-- default is not to use the repository-internal uncompressed objects
-- cache.
repoCheckoutAt ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> Maybe (OSTree.RepoCheckoutAtOptions.RepoCheckoutAtOptions)
    -- ^ /@options@/: Options
    -> Int32
    -- ^ /@destinationDfd@/: Directory FD for destination
    -> T.Text
    -- ^ /@destinationPath@/: Directory for destination
    -> T.Text
    -- ^ /@commit@/: Checksum for commit
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoCheckoutAt :: a
-> Maybe RepoCheckoutAtOptions
-> Int32
-> Text
-> Text
-> Maybe b
-> m ()
repoCheckoutAt self :: a
self options :: Maybe RepoCheckoutAtOptions
options destinationDfd :: Int32
destinationDfd destinationPath :: Text
destinationPath commit :: Text
commit cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr RepoCheckoutAtOptions
maybeOptions <- case Maybe RepoCheckoutAtOptions
options of
        Nothing -> Ptr RepoCheckoutAtOptions -> IO (Ptr RepoCheckoutAtOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RepoCheckoutAtOptions
forall a. Ptr a
nullPtr
        Just jOptions :: RepoCheckoutAtOptions
jOptions -> do
            Ptr RepoCheckoutAtOptions
jOptions' <- RepoCheckoutAtOptions -> IO (Ptr RepoCheckoutAtOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RepoCheckoutAtOptions
jOptions
            Ptr RepoCheckoutAtOptions -> IO (Ptr RepoCheckoutAtOptions)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RepoCheckoutAtOptions
jOptions'
    CString
destinationPath' <- Text -> IO CString
textToCString Text
destinationPath
    CString
commit' <- Text -> IO CString
textToCString Text
commit
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Ptr RepoCheckoutAtOptions
-> Int32
-> CString
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_checkout_at Ptr Repo
self' Ptr RepoCheckoutAtOptions
maybeOptions Int32
destinationDfd CString
destinationPath' CString
commit' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe RepoCheckoutAtOptions
-> (RepoCheckoutAtOptions -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RepoCheckoutAtOptions
options RepoCheckoutAtOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
destinationPath'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commit'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
destinationPath'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commit'
     )

#if defined(ENABLE_OVERLOADING)
data RepoCheckoutAtMethodInfo
instance (signature ~ (Maybe (OSTree.RepoCheckoutAtOptions.RepoCheckoutAtOptions) -> Int32 -> T.Text -> T.Text -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoCheckoutAtMethodInfo a signature where
    overloadedMethod = repoCheckoutAt

#endif

-- method Repo::checkout_gc
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_checkout_gc" ostree_repo_checkout_gc :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Call this after finishing a succession of checkout operations; it
-- will delete any currently-unused uncompressed objects from the
-- cache.
repoCheckoutGc ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoCheckoutGc :: a -> Maybe b -> m ()
repoCheckoutGc self :: a
self cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_repo_checkout_gc Ptr Repo
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoCheckoutGcMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoCheckoutGcMethodInfo a signature where
    overloadedMethod = repoCheckoutGc

#endif

-- method Repo::checkout_tree
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoCheckoutMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Options controlling all files"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "overwrite_mode"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoCheckoutOverwriteMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether or not to overwrite files"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "destination"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Place tree here" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "RepoFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Source tree" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileInfo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Source info" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_checkout_tree" ostree_repo_checkout_tree :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "OSTree", name = "RepoCheckoutMode"})
    CUInt ->                                -- overwrite_mode : TInterface (Name {namespace = "OSTree", name = "RepoCheckoutOverwriteMode"})
    Ptr Gio.File.File ->                    -- destination : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr OSTree.RepoFile.RepoFile ->         -- source : TInterface (Name {namespace = "OSTree", name = "RepoFile"})
    Ptr Gio.FileInfo.FileInfo ->            -- source_info : TInterface (Name {namespace = "Gio", name = "FileInfo"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Check out /@source@/ into /@destination@/, which must live on the
-- physical filesystem.  /@source@/ may be any subdirectory of a given
-- commit.  The /@mode@/ and /@overwriteMode@/ allow control over how the
-- files are checked out.
repoCheckoutTree ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.File.IsFile b, OSTree.RepoFile.IsRepoFile c, Gio.FileInfo.IsFileInfo d, Gio.Cancellable.IsCancellable e) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.RepoCheckoutMode
    -- ^ /@mode@/: Options controlling all files
    -> OSTree.Enums.RepoCheckoutOverwriteMode
    -- ^ /@overwriteMode@/: Whether or not to overwrite files
    -> b
    -- ^ /@destination@/: Place tree here
    -> c
    -- ^ /@source@/: Source tree
    -> d
    -- ^ /@sourceInfo@/: Source info
    -> Maybe (e)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoCheckoutTree :: a
-> RepoCheckoutMode
-> RepoCheckoutOverwriteMode
-> b
-> c
-> d
-> Maybe e
-> m ()
repoCheckoutTree self :: a
self mode :: RepoCheckoutMode
mode overwriteMode :: RepoCheckoutOverwriteMode
overwriteMode destination :: b
destination source :: c
source sourceInfo :: d
sourceInfo cancellable :: Maybe e
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (RepoCheckoutMode -> Int) -> RepoCheckoutMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoCheckoutMode -> Int
forall a. Enum a => a -> Int
fromEnum) RepoCheckoutMode
mode
    let overwriteMode' :: CUInt
overwriteMode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (RepoCheckoutOverwriteMode -> Int)
-> RepoCheckoutOverwriteMode
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoCheckoutOverwriteMode -> Int
forall a. Enum a => a -> Int
fromEnum) RepoCheckoutOverwriteMode
overwriteMode
    Ptr File
destination' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
destination
    Ptr RepoFile
source' <- c -> IO (Ptr RepoFile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
source
    Ptr FileInfo
sourceInfo' <- d -> IO (Ptr FileInfo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
sourceInfo
    Ptr Cancellable
maybeCancellable <- case Maybe e
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: e
jCancellable -> do
            Ptr Cancellable
jCancellable' <- e -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr e
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CUInt
-> CUInt
-> Ptr File
-> Ptr RepoFile
-> Ptr FileInfo
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_checkout_tree Ptr Repo
self' CUInt
mode' CUInt
overwriteMode' Ptr File
destination' Ptr RepoFile
source' Ptr FileInfo
sourceInfo' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
destination
        c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
source
        d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr d
sourceInfo
        Maybe e -> (e -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe e
cancellable e -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoCheckoutTreeMethodInfo
instance (signature ~ (OSTree.Enums.RepoCheckoutMode -> OSTree.Enums.RepoCheckoutOverwriteMode -> b -> c -> d -> Maybe (e) -> m ()), MonadIO m, IsRepo a, Gio.File.IsFile b, OSTree.RepoFile.IsRepoFile c, Gio.FileInfo.IsFileInfo d, Gio.Cancellable.IsCancellable e) => O.MethodInfo RepoCheckoutTreeMethodInfo a signature where
    overloadedMethod = repoCheckoutTree

#endif

-- method Repo::commit_transaction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_stats"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoTransactionStats" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A set of statistics of things\nthat happened during this transaction."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = True
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_commit_transaction" ostree_repo_commit_transaction :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr OSTree.RepoTransactionStats.RepoTransactionStats -> -- out_stats : TInterface (Name {namespace = "OSTree", name = "RepoTransactionStats"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Complete the transaction. Any refs set with
-- 'GI.OSTree.Objects.Repo.repoTransactionSetRef' or
-- 'GI.OSTree.Objects.Repo.repoTransactionSetRefspec' will be written out.
-- 
-- Note that if multiple threads are performing writes, all such threads must
-- have terminated before this function is invoked.
-- 
-- Locking: Releases @shared@ lock acquired by @ostree_repo_prepare_transaction()@
-- Multithreading: This function is *not* MT safe; only one transaction can be
-- active at a time.
repoCommitTransaction ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m (OSTree.RepoTransactionStats.RepoTransactionStats)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoCommitTransaction :: a -> Maybe b -> m RepoTransactionStats
repoCommitTransaction self :: a
self cancellable :: Maybe b
cancellable = IO RepoTransactionStats -> m RepoTransactionStats
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RepoTransactionStats -> m RepoTransactionStats)
-> IO RepoTransactionStats -> m RepoTransactionStats
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr RepoTransactionStats
outStats <- Int -> IO (Ptr RepoTransactionStats)
forall a. BoxedObject a => Int -> IO (Ptr a)
callocBoxedBytes 56 :: IO (Ptr OSTree.RepoTransactionStats.RepoTransactionStats)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO RepoTransactionStats -> IO () -> IO RepoTransactionStats
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 Repo
-> Ptr RepoTransactionStats
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_commit_transaction Ptr Repo
self' Ptr RepoTransactionStats
outStats Ptr Cancellable
maybeCancellable
        RepoTransactionStats
outStats' <- ((ManagedPtr RepoTransactionStats -> RepoTransactionStats)
-> Ptr RepoTransactionStats -> IO RepoTransactionStats
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RepoTransactionStats -> RepoTransactionStats
OSTree.RepoTransactionStats.RepoTransactionStats) Ptr RepoTransactionStats
outStats
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        RepoTransactionStats -> IO RepoTransactionStats
forall (m :: * -> *) a. Monad m => a -> m a
return RepoTransactionStats
outStats'
     ) (do
        Ptr RepoTransactionStats -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr RepoTransactionStats
outStats
     )

#if defined(ENABLE_OVERLOADING)
data RepoCommitTransactionMethodInfo
instance (signature ~ (Maybe (b) -> m (OSTree.RepoTransactionStats.RepoTransactionStats)), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoCommitTransactionMethodInfo a signature where
    overloadedMethod = repoCommitTransaction

#endif

-- method Repo::copy_config
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , 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 = "GLib" , name = "KeyFile" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_copy_config" ostree_repo_copy_config :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO (Ptr GLib.KeyFile.KeyFile)

-- | /No description available in the introspection data./
repoCopyConfig ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -> m GLib.KeyFile.KeyFile
    -- ^ __Returns:__ A newly-allocated copy of the repository config
repoCopyConfig :: a -> m KeyFile
repoCopyConfig self :: a
self = IO KeyFile -> m KeyFile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO KeyFile -> m KeyFile) -> IO KeyFile -> m KeyFile
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr KeyFile
result <- Ptr Repo -> IO (Ptr KeyFile)
ostree_repo_copy_config Ptr Repo
self'
    Text -> Ptr KeyFile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoCopyConfig" Ptr KeyFile
result
    KeyFile
result' <- ((ManagedPtr KeyFile -> KeyFile) -> Ptr KeyFile -> IO KeyFile
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr KeyFile -> KeyFile
GLib.KeyFile.KeyFile) Ptr KeyFile
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    KeyFile -> IO KeyFile
forall (m :: * -> *) a. Monad m => a -> m a
return KeyFile
result'

#if defined(ENABLE_OVERLOADING)
data RepoCopyConfigMethodInfo
instance (signature ~ (m GLib.KeyFile.KeyFile), MonadIO m, IsRepo a) => O.MethodInfo RepoCopyConfigMethodInfo a signature where
    overloadedMethod = repoCopyConfig

#endif

-- method Repo::create
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "RepoMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The mode to store the repository in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_create" ostree_repo_create :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- mode : TInterface (Name {namespace = "OSTree", name = "RepoMode"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Create the underlying structure on disk for the repository, and call
-- 'GI.OSTree.Objects.Repo.repoOpen' on the result, preparing it for use.
-- 
-- Since version 2016.8, this function will succeed on an existing
-- repository, and finish creating any necessary files in a partially
-- created repository.  However, this function cannot change the mode
-- of an existing repository, and will silently ignore an attempt to
-- do so.
-- 
-- Since 2017.9, \"existing repository\" is defined by the existence of an
-- @objects@ subdirectory.
-- 
-- This function predates 'GI.OSTree.Objects.Repo.repoCreateAt'. It is an error to call
-- this function on a repository initialized via 'GI.OSTree.Objects.Repo.repoOpenAt'.
repoCreate ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> OSTree.Enums.RepoMode
    -- ^ /@mode@/: The mode to store the repository in
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoCreate :: a -> RepoMode -> Maybe b -> m ()
repoCreate self :: a
self mode :: RepoMode
mode cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (RepoMode -> Int) -> RepoMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoMode -> Int
forall a. Enum a => a -> Int
fromEnum) RepoMode
mode
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo -> CUInt -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_repo_create Ptr Repo
self' CUInt
mode' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoCreateMethodInfo
instance (signature ~ (OSTree.Enums.RepoMode -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoCreateMethodInfo a signature where
    overloadedMethod = repoCreate

#endif

-- method Repo::delete_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sha256"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Checksum" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_delete_object" ostree_repo_delete_object :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- sha256 : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Remove the object of type /@objtype@/ with checksum /@sha256@/
-- from the repository.  An error of type 'GI.Gio.Enums.IOErrorEnumNotFound'
-- is thrown if the object does not exist.
repoDeleteObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> T.Text
    -- ^ /@sha256@/: Checksum
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoDeleteObject :: a -> ObjectType -> Text -> Maybe b -> m ()
repoDeleteObject self :: a
self objtype :: ObjectType
objtype sha256 :: Text
sha256 cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
sha256' <- Text -> IO CString
textToCString Text
sha256
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CUInt
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_delete_object Ptr Repo
self' CUInt
objtype' CString
sha256' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sha256'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sha256'
     )

#if defined(ENABLE_OVERLOADING)
data RepoDeleteObjectMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> T.Text -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoDeleteObjectMethodInfo a signature where
    overloadedMethod = repoDeleteObject

#endif

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

foreign import ccall "ostree_repo_equal" ostree_repo_equal :: 
    Ptr Repo ->                             -- a : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Repo ->                             -- b : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO CInt

-- | Check whether two opened repositories are the same on disk: if their root
-- directories are the same inode. If /@a@/ or /@b@/ are not open yet (due to
-- 'GI.OSTree.Objects.Repo.repoOpen' not being called on them yet), 'P.False' will be returned.
-- 
-- /Since: 2017.12/
repoEqual ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, IsRepo b) =>
    a
    -- ^ /@a@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> b
    -- ^ /@b@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> m Bool
    -- ^ __Returns:__ 'P.True' if /@a@/ and /@b@/ are the same repository on disk, 'P.False' otherwise
repoEqual :: a -> b -> m Bool
repoEqual a :: a
a b :: b
b = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
a' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
a
    Ptr Repo
b' <- b -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
b
    CInt
result <- Ptr Repo -> Ptr Repo -> IO CInt
ostree_repo_equal Ptr Repo
a' Ptr Repo
b'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
a
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
b
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RepoEqualMethodInfo
instance (signature ~ (b -> m Bool), MonadIO m, IsRepo a, IsRepo b) => O.MethodInfo RepoEqualMethodInfo a signature where
    overloadedMethod = repoEqual

#endif

-- method Repo::find_remotes_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "refs"
--           , argType =
--               TCArray
--                 True
--                 (-1)
--                 (-1)
--                 (TInterface Name { namespace = "OSTree" , name = "CollectionRef" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "non-empty array of collection\8211ref pairs to find remotes for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a GVariant `a{sv}` with an extensible set of flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "finders"
--           , argType =
--               TCArray
--                 True
--                 (-1)
--                 (-1)
--                 (TInterface Name { namespace = "OSTree" , name = "RepoFinder" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "non-empty array of\n   #OstreeRepoFinder instances to use, or %NULL to use the system defaults"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an #OstreeAsyncProgress to update with the operation\8217s\n   progress, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "asynchronous completion callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 7
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_find_remotes_async" ostree_repo_find_remotes_async :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr (Ptr OSTree.CollectionRef.CollectionRef) -> -- refs : TCArray True (-1) (-1) (TInterface (Name {namespace = "OSTree", name = "CollectionRef"}))
    Ptr GVariant ->                         -- options : TVariant
    Ptr (Ptr OSTree.RepoFinder.RepoFinder) -> -- finders : TCArray True (-1) (-1) (TInterface (Name {namespace = "OSTree", name = "RepoFinder"}))
    Ptr OSTree.AsyncProgress.AsyncProgress -> -- progress : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Find reachable remote URIs which claim to provide any of the given named
-- /@refs@/. This will search for configured remotes (t'GI.OSTree.Objects.RepoFinderConfig.RepoFinderConfig'),
-- mounted volumes (t'GI.OSTree.Objects.RepoFinderMount.RepoFinderMount') and (if enabled at compile time)
-- local network peers (t'GI.OSTree.Objects.RepoFinderAvahi.RepoFinderAvahi'). In order to use a custom
-- configuration of t'GI.OSTree.Interfaces.RepoFinder.RepoFinder' instances, call
-- 'GI.OSTree.Functions.repoFinderResolveAllAsync' on them individually.
-- 
-- Any remote which is found and which claims to support any of the given /@refs@/
-- will be returned in the results. It is possible that a remote claims to
-- support a given ref, but turns out not to — it is not possible to verify this
-- until 'GI.OSTree.Objects.Repo.repoPullFromRemotesAsync' is called.
-- 
-- The returned results will be sorted with the most useful first — this is
-- typically the remote which claims to provide the most of /@refs@/, at the lowest
-- latency.
-- 
-- Each result contains a list of the subset of /@refs@/ it claims to provide. It
-- is possible for a non-empty list of results to be returned, but for some of
-- /@refs@/ to not be listed in any of the results. Callers must check for this.
-- 
-- Pass the results to 'GI.OSTree.Objects.Repo.repoPullFromRemotesAsync' to pull the given /@refs@/
-- from those remotes.
-- 
-- The following /@options@/ are currently defined:
-- 
--   * @override-commit-ids@ (@as@): Array of specific commit IDs to fetch. The nth
--   commit ID applies to the nth ref, so this must be the same length as /@refs@/, if
--   provided.
--   * @n-network-retries@ (@u@): Number of times to retry each download on
--   receiving a transient network error, such as a socket timeout; default is
--   5, 0 means return errors without retrying. Since: 2018.6
-- 
-- /@finders@/ must be a non-empty 'P.Nothing'-terminated array of the t'GI.OSTree.Interfaces.RepoFinder.RepoFinder'
-- instances to use, or 'P.Nothing' to use the system default set of finders, which
-- will typically be all available finders using their default options (but
-- this is not guaranteed).
-- 
-- GPG verification of commits will be used unconditionally.
-- 
-- This will use the thread-default t'GI.GLib.Structs.MainContext.MainContext', but will not iterate it.
-- 
-- /Since: 2018.6/
repoFindRemotesAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, OSTree.AsyncProgress.IsAsyncProgress b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> [OSTree.CollectionRef.CollectionRef]
    -- ^ /@refs@/: non-empty array of collection–ref pairs to find remotes for
    -> Maybe (GVariant)
    -- ^ /@options@/: a GVariant @a{sv}@ with an extensible set of flags
    -> [OSTree.RepoFinder.RepoFinder]
    -- ^ /@finders@/: non-empty array of
    --    t'GI.OSTree.Interfaces.RepoFinder.RepoFinder' instances to use, or 'P.Nothing' to use the system defaults
    -> Maybe (b)
    -- ^ /@progress@/: an t'GI.OSTree.Objects.AsyncProgress.AsyncProgress' to update with the operation’s
    --    progress, or 'P.Nothing'
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: asynchronous completion callback
    -> m ()
repoFindRemotesAsync :: a
-> [CollectionRef]
-> Maybe GVariant
-> [RepoFinder]
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
repoFindRemotesAsync self :: a
self refs :: [CollectionRef]
refs options :: Maybe GVariant
options finders :: [RepoFinder]
finders progress :: Maybe b
progress cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    [Ptr CollectionRef]
refs' <- (CollectionRef -> IO (Ptr CollectionRef))
-> [CollectionRef] -> IO [Ptr CollectionRef]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM CollectionRef -> IO (Ptr CollectionRef)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [CollectionRef]
refs
    Ptr (Ptr CollectionRef)
refs'' <- [Ptr CollectionRef] -> IO (Ptr (Ptr CollectionRef))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packZeroTerminatedPtrArray [Ptr CollectionRef]
refs'
    Ptr GVariant
maybeOptions <- case Maybe GVariant
options of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jOptions :: GVariant
jOptions -> do
            Ptr GVariant
jOptions' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jOptions
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jOptions'
    [Ptr RepoFinder]
finders' <- (RepoFinder -> IO (Ptr RepoFinder))
-> [RepoFinder] -> IO [Ptr RepoFinder]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RepoFinder -> IO (Ptr RepoFinder)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr [RepoFinder]
finders
    Ptr (Ptr RepoFinder)
finders'' <- [Ptr RepoFinder] -> IO (Ptr (Ptr RepoFinder))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packZeroTerminatedPtrArray [Ptr RepoFinder]
finders'
    Ptr AsyncProgress
maybeProgress <- case Maybe b
progress of
        Nothing -> Ptr AsyncProgress -> IO (Ptr AsyncProgress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AsyncProgress
forall a. Ptr a
nullPtr
        Just jProgress :: b
jProgress -> do
            Ptr AsyncProgress
jProgress' <- b -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProgress
            Ptr AsyncProgress -> IO (Ptr AsyncProgress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AsyncProgress
jProgress'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Repo
-> Ptr (Ptr CollectionRef)
-> Ptr GVariant
-> Ptr (Ptr RepoFinder)
-> Ptr AsyncProgress
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ostree_repo_find_remotes_async Ptr Repo
self' Ptr (Ptr CollectionRef)
refs'' Ptr GVariant
maybeOptions Ptr (Ptr RepoFinder)
finders'' Ptr AsyncProgress
maybeProgress Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    (CollectionRef -> IO ()) -> [CollectionRef] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ CollectionRef -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [CollectionRef]
refs
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
options GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    (RepoFinder -> IO ()) -> [RepoFinder] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RepoFinder -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [RepoFinder]
finders
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
progress b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr (Ptr CollectionRef) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CollectionRef)
refs''
    Ptr (Ptr RepoFinder) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr RepoFinder)
finders''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RepoFindRemotesAsyncMethodInfo
instance (signature ~ ([OSTree.CollectionRef.CollectionRef] -> Maybe (GVariant) -> [OSTree.RepoFinder.RepoFinder] -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsRepo a, OSTree.AsyncProgress.IsAsyncProgress b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoFindRemotesAsyncMethodInfo a signature where
    overloadedMethod = repoFindRemotesAsync

#endif

-- method Repo::find_remotes_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the asynchronous result"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TCArray
--                  True
--                  (-1)
--                  (-1)
--                  (TInterface
--                     Name { namespace = "OSTree" , name = "RepoFinderResult" }))
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_find_remotes_finish" ostree_repo_find_remotes_finish :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr (Ptr OSTree.RepoFinderResult.RepoFinderResult))

-- | Finish an asynchronous pull operation started with
-- 'GI.OSTree.Objects.Repo.repoFindRemotesAsync'.
-- 
-- /Since: 2018.6/
repoFindRemotesFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> b
    -- ^ /@result@/: the asynchronous result
    -> m [OSTree.RepoFinderResult.RepoFinderResult]
    -- ^ __Returns:__ a potentially empty array
    --    of @/OstreeRepoFinderResults/@, followed by a 'P.Nothing' terminator element; or
    --    'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
repoFindRemotesFinish :: a -> b -> m [RepoFinderResult]
repoFindRemotesFinish self :: a
self result_ :: b
result_ = IO [RepoFinderResult] -> m [RepoFinderResult]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [RepoFinderResult] -> m [RepoFinderResult])
-> IO [RepoFinderResult] -> m [RepoFinderResult]
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    IO [RepoFinderResult] -> IO () -> IO [RepoFinderResult]
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr (Ptr RepoFinderResult)
result <- (Ptr (Ptr GError) -> IO (Ptr (Ptr RepoFinderResult)))
-> IO (Ptr (Ptr RepoFinderResult))
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr (Ptr RepoFinderResult)))
 -> IO (Ptr (Ptr RepoFinderResult)))
-> (Ptr (Ptr GError) -> IO (Ptr (Ptr RepoFinderResult)))
-> IO (Ptr (Ptr RepoFinderResult))
forall a b. (a -> b) -> a -> b
$ Ptr Repo
-> Ptr AsyncResult
-> Ptr (Ptr GError)
-> IO (Ptr (Ptr RepoFinderResult))
ostree_repo_find_remotes_finish Ptr Repo
self' Ptr AsyncResult
result_'
        Text -> Ptr (Ptr RepoFinderResult) -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoFindRemotesFinish" Ptr (Ptr RepoFinderResult)
result
        [Ptr RepoFinderResult]
result' <- Ptr (Ptr RepoFinderResult) -> IO [Ptr RepoFinderResult]
forall a. Ptr (Ptr a) -> IO [Ptr a]
unpackZeroTerminatedPtrArray Ptr (Ptr RepoFinderResult)
result
        [RepoFinderResult]
result'' <- (Ptr RepoFinderResult -> IO RepoFinderResult)
-> [Ptr RepoFinderResult] -> IO [RepoFinderResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((ManagedPtr RepoFinderResult -> RepoFinderResult)
-> Ptr RepoFinderResult -> IO RepoFinderResult
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr RepoFinderResult -> RepoFinderResult
OSTree.RepoFinderResult.RepoFinderResult) [Ptr RepoFinderResult]
result'
        Ptr (Ptr RepoFinderResult) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr RepoFinderResult)
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        [RepoFinderResult] -> IO [RepoFinderResult]
forall (m :: * -> *) a. Monad m => a -> m a
return [RepoFinderResult]
result''
     ) (do
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     )

#if defined(ENABLE_OVERLOADING)
data RepoFindRemotesFinishMethodInfo
instance (signature ~ (b -> m [OSTree.RepoFinderResult.RepoFinderResult]), MonadIO m, IsRepo a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo RepoFindRemotesFinishMethodInfo a signature where
    overloadedMethod = repoFindRemotesFinish

#endif

-- method Repo::fsck_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sha256"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Checksum" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_fsck_object" ostree_repo_fsck_object :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- sha256 : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Verify consistency of the object; this performs checks only relevant to the
-- immediate object itself, such as checksumming. This API call will not itself
-- traverse metadata objects for example.
-- 
-- /Since: 2017.15/
repoFsckObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> T.Text
    -- ^ /@sha256@/: Checksum
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoFsckObject :: a -> ObjectType -> Text -> Maybe b -> m ()
repoFsckObject self :: a
self objtype :: ObjectType
objtype sha256 :: Text
sha256 cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
sha256' <- Text -> IO CString
textToCString Text
sha256
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CUInt
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_fsck_object Ptr Repo
self' CUInt
objtype' CString
sha256' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sha256'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sha256'
     )

#if defined(ENABLE_OVERLOADING)
data RepoFsckObjectMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> T.Text -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoFsckObjectMethodInfo a signature where
    overloadedMethod = repoFsckObject

#endif

-- method Repo::get_bootloader
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeRepo" , 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 "ostree_repo_get_bootloader" ostree_repo_get_bootloader :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO CString

-- | Get the bootloader configured. See the documentation for the
-- \"sysroot.bootloader\" config key.
-- 
-- /Since: 2019.2/
repoGetBootloader ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> m T.Text
    -- ^ __Returns:__ bootloader configuration for the sysroot
repoGetBootloader :: a -> m Text
repoGetBootloader self :: a
self = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Repo -> IO CString
ostree_repo_get_bootloader Ptr Repo
self'
    Text -> CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoGetBootloader" CString
result
    Text
result' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
result'

#if defined(ENABLE_OVERLOADING)
data RepoGetBootloaderMethodInfo
instance (signature ~ (m T.Text), MonadIO m, IsRepo a) => O.MethodInfo RepoGetBootloaderMethodInfo a signature where
    overloadedMethod = repoGetBootloader

#endif

-- method Repo::get_collection_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeRepo" , 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 "ostree_repo_get_collection_id" ostree_repo_get_collection_id :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO CString

-- | Get the collection ID of this repository. See [collection IDs][collection-ids].
-- 
-- /Since: 2018.6/
repoGetCollectionId ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> m (Maybe T.Text)
    -- ^ __Returns:__ collection ID for the repository
repoGetCollectionId :: a -> m (Maybe Text)
repoGetCollectionId self :: a
self = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
result <- Ptr Repo -> IO CString
ostree_repo_get_collection_id Ptr Repo
self'
    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''
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeResult

#if defined(ENABLE_OVERLOADING)
data RepoGetCollectionIdMethodInfo
instance (signature ~ (m (Maybe T.Text)), MonadIO m, IsRepo a) => O.MethodInfo RepoGetCollectionIdMethodInfo a signature where
    overloadedMethod = repoGetCollectionId

#endif

-- method Repo::get_config
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , 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 = "GLib" , name = "KeyFile" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_get_config" ostree_repo_get_config :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO (Ptr GLib.KeyFile.KeyFile)

-- | /No description available in the introspection data./
repoGetConfig ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -> m GLib.KeyFile.KeyFile
    -- ^ __Returns:__ The repository configuration; do not modify
repoGetConfig :: a -> m KeyFile
repoGetConfig self :: a
self = IO KeyFile -> m KeyFile
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO KeyFile -> m KeyFile) -> IO KeyFile -> m KeyFile
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr KeyFile
result <- Ptr Repo -> IO (Ptr KeyFile)
ostree_repo_get_config Ptr Repo
self'
    Text -> Ptr KeyFile -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoGetConfig" Ptr KeyFile
result
    KeyFile
result' <- ((ManagedPtr KeyFile -> KeyFile) -> Ptr KeyFile -> IO KeyFile
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
newBoxed ManagedPtr KeyFile -> KeyFile
GLib.KeyFile.KeyFile) Ptr KeyFile
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    KeyFile -> IO KeyFile
forall (m :: * -> *) a. Monad m => a -> m a
return KeyFile
result'

#if defined(ENABLE_OVERLOADING)
data RepoGetConfigMethodInfo
instance (signature ~ (m GLib.KeyFile.KeyFile), MonadIO m, IsRepo a) => O.MethodInfo RepoGetConfigMethodInfo a signature where
    overloadedMethod = repoGetConfig

#endif

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

foreign import ccall "ostree_repo_get_default_repo_finders" ostree_repo_get_default_repo_finders :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO (Ptr CString)

-- | Get the set of default repo finders configured. See the documentation for
-- the \"core.default-repo-finders\" config key.
-- 
-- /Since: 2018.9/
repoGetDefaultRepoFinders ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> m [T.Text]
    -- ^ __Returns:__ 
    --    'P.Nothing'-terminated array of strings.
repoGetDefaultRepoFinders :: a -> m [Text]
repoGetDefaultRepoFinders self :: a
self = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CString
result <- Ptr Repo -> IO (Ptr CString)
ostree_repo_get_default_repo_finders Ptr Repo
self'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoGetDefaultRepoFinders" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data RepoGetDefaultRepoFindersMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsRepo a) => O.MethodInfo RepoGetDefaultRepoFindersMethodInfo a signature where
    overloadedMethod = repoGetDefaultRepoFinders

#endif

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

foreign import ccall "ostree_repo_get_dfd" ostree_repo_get_dfd :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO Int32

-- | In some cases it\'s useful for applications to access the repository
-- directly; for example, writing content into @repo\/tmp@ ensures it\'s
-- on the same filesystem.  Another case is detecting the mtime on the
-- repository (to see whether a ref was written).
repoGetDfd ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> m Int32
    -- ^ __Returns:__ File descriptor for repository root - owned by /@self@/
repoGetDfd :: a -> m Int32
repoGetDfd self :: a
self = IO Int32 -> m Int32
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Int32 -> m Int32) -> IO Int32 -> m Int32
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Int32
result <- Ptr Repo -> IO Int32
ostree_repo_get_dfd Ptr Repo
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Int32 -> IO Int32
forall (m :: * -> *) a. Monad m => a -> m a
return Int32
result

#if defined(ENABLE_OVERLOADING)
data RepoGetDfdMethodInfo
instance (signature ~ (m Int32), MonadIO m, IsRepo a) => O.MethodInfo RepoGetDfdMethodInfo a signature where
    overloadedMethod = repoGetDfd

#endif

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

foreign import ccall "ostree_repo_get_disable_fsync" ostree_repo_get_disable_fsync :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO CInt

-- | For more information see 'GI.OSTree.Objects.Repo.repoSetDisableFsync'.
repoGetDisableFsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> m Bool
    -- ^ __Returns:__ Whether or not @/fsync()/@ is enabled for this repo.
repoGetDisableFsync :: a -> m Bool
repoGetDisableFsync self :: a
self = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CInt
result <- Ptr Repo -> IO CInt
ostree_repo_get_disable_fsync Ptr Repo
self'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RepoGetDisableFsyncMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRepo a) => O.MethodInfo RepoGetDisableFsyncMethodInfo a signature where
    overloadedMethod = repoGetDisableFsync

#endif

-- method Repo::get_min_free_space_bytes
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_reserved_bytes"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_repo_get_min_free_space_bytes" ostree_repo_get_min_free_space_bytes :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Word64 ->                               -- out_reserved_bytes : TBasicType TUInt64
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
repoGetMinFreeSpaceBytes ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -> Word64
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoGetMinFreeSpaceBytes :: a -> Word64 -> m ()
repoGetMinFreeSpaceBytes self :: a
self outReservedBytes :: Word64
outReservedBytes = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    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 Repo -> Word64 -> Ptr (Ptr GError) -> IO CInt
ostree_repo_get_min_free_space_bytes Ptr Repo
self' Word64
outReservedBytes
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        () -> 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 RepoGetMinFreeSpaceBytesMethodInfo
instance (signature ~ (Word64 -> m ()), MonadIO m, IsRepo a) => O.MethodInfo RepoGetMinFreeSpaceBytesMethodInfo a signature where
    overloadedMethod = repoGetMinFreeSpaceBytes

#endif

-- method Repo::get_mode
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , 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 = "OSTree" , name = "RepoMode" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_get_mode" ostree_repo_get_mode :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO CUInt

-- | /No description available in the introspection data./
repoGetMode ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -> m OSTree.Enums.RepoMode
repoGetMode :: a -> m RepoMode
repoGetMode self :: a
self = IO RepoMode -> m RepoMode
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO RepoMode -> m RepoMode) -> IO RepoMode -> m RepoMode
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CUInt
result <- Ptr Repo -> IO CUInt
ostree_repo_get_mode Ptr Repo
self'
    let result' :: RepoMode
result' = (Int -> RepoMode
forall a. Enum a => Int -> a
toEnum (Int -> RepoMode) -> (CUInt -> Int) -> CUInt -> RepoMode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CUInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral) CUInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    RepoMode -> IO RepoMode
forall (m :: * -> *) a. Monad m => a -> m a
return RepoMode
result'

#if defined(ENABLE_OVERLOADING)
data RepoGetModeMethodInfo
instance (signature ~ (m OSTree.Enums.RepoMode), MonadIO m, IsRepo a) => O.MethodInfo RepoGetModeMethodInfo a signature where
    overloadedMethod = repoGetMode

#endif

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

foreign import ccall "ostree_repo_get_parent" ostree_repo_get_parent :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO (Ptr Repo)

-- | Before this function can be used, @/ostree_repo_init()/@ must have been
-- called.
repoGetParent ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> m Repo
    -- ^ __Returns:__ Parent repository, or 'P.Nothing' if none
repoGetParent :: a -> m Repo
repoGetParent self :: a
self = IO Repo -> m Repo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Repo -> m Repo) -> IO Repo -> m Repo
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Repo
result <- Ptr Repo -> IO (Ptr Repo)
ostree_repo_get_parent Ptr Repo
self'
    Text -> Ptr Repo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoGetParent" Ptr Repo
result
    Repo
result' <- ((ManagedPtr Repo -> Repo) -> Ptr Repo -> IO Repo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr Repo -> Repo
Repo) Ptr Repo
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Repo -> IO Repo
forall (m :: * -> *) a. Monad m => a -> m a
return Repo
result'

#if defined(ENABLE_OVERLOADING)
data RepoGetParentMethodInfo
instance (signature ~ (m Repo), MonadIO m, IsRepo a) => O.MethodInfo RepoGetParentMethodInfo a signature where
    overloadedMethod = repoGetParent

#endif

-- method Repo::get_path
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "Gio" , name = "File" })
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_get_path" ostree_repo_get_path :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO (Ptr Gio.File.File)

-- | Note that since the introduction of 'GI.OSTree.Objects.Repo.repoOpenAt', this function may
-- return a process-specific path in @\/proc@ if the repository was created using
-- that API. In general, you should avoid use of this API.
repoGetPath ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> m Gio.File.File
    -- ^ __Returns:__ Path to repo
repoGetPath :: a -> m File
repoGetPath self :: a
self = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
result <- Ptr Repo -> IO (Ptr File)
ostree_repo_get_path Ptr Repo
self'
    Text -> Ptr File -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoGetPath" Ptr File
result
    File
result' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
newObject ManagedPtr File -> File
Gio.File.File) Ptr File
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
result'

#if defined(ENABLE_OVERLOADING)
data RepoGetPathMethodInfo
instance (signature ~ (m Gio.File.File), MonadIO m, IsRepo a) => O.MethodInfo RepoGetPathMethodInfo a signature where
    overloadedMethod = repoGetPath

#endif

-- method Repo::get_remote_boolean_option
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "option_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Option" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Value returned if @option_name is not present"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_value"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "location to store the result."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_get_remote_boolean_option" ostree_repo_get_remote_boolean_option :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote_name : TBasicType TUTF8
    CString ->                              -- option_name : TBasicType TUTF8
    CInt ->                                 -- default_value : TBasicType TBoolean
    Ptr CInt ->                             -- out_value : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | OSTree remotes are represented by keyfile groups, formatted like:
-- @[remote \"remotename\"]@. This function returns a value named /@optionName@/
-- underneath that group, and returns it as a boolean.
-- If the option is not set, /@outValue@/ will be set to /@defaultValue@/. If an
-- error is returned, /@outValue@/ will be set to 'P.False'.
repoGetRemoteBooleanOption ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: A OstreeRepo
    -> T.Text
    -- ^ /@remoteName@/: Name
    -> T.Text
    -- ^ /@optionName@/: Option
    -> Bool
    -- ^ /@defaultValue@/: Value returned if /@optionName@/ is not present
    -> m (Bool)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoGetRemoteBooleanOption :: a -> Text -> Text -> Bool -> m Bool
repoGetRemoteBooleanOption self :: a
self remoteName :: Text
remoteName optionName :: Text
optionName defaultValue :: Bool
defaultValue = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
remoteName' <- Text -> IO CString
textToCString Text
remoteName
    CString
optionName' <- Text -> IO CString
textToCString Text
optionName
    let defaultValue' :: CInt
defaultValue' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
defaultValue
    Ptr CInt
outValue <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO Bool -> IO () -> IO Bool
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 Repo
-> CString
-> CString
-> CInt
-> Ptr CInt
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_get_remote_boolean_option Ptr Repo
self' CString
remoteName' CString
optionName' CInt
defaultValue' Ptr CInt
outValue
        CInt
outValue' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
outValue
        let outValue'' :: Bool
outValue'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
outValue'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
optionName'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outValue
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
outValue''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
optionName'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outValue
     )

#if defined(ENABLE_OVERLOADING)
data RepoGetRemoteBooleanOptionMethodInfo
instance (signature ~ (T.Text -> T.Text -> Bool -> m (Bool)), MonadIO m, IsRepo a) => O.MethodInfo RepoGetRemoteBooleanOptionMethodInfo a signature where
    overloadedMethod = repoGetRemoteBooleanOption

#endif

-- method Repo::get_remote_list_option
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "option_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Option" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_value"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "location to store the list\n           of strings. The list should be freed with\n           g_strfreev()."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_get_remote_list_option" ostree_repo_get_remote_list_option :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote_name : TBasicType TUTF8
    CString ->                              -- option_name : TBasicType TUTF8
    Ptr (Ptr CString) ->                    -- out_value : TCArray True (-1) (-1) (TBasicType TUTF8)
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | OSTree remotes are represented by keyfile groups, formatted like:
-- @[remote \"remotename\"]@. This function returns a value named /@optionName@/
-- underneath that group, and returns it as a zero terminated array of strings.
-- If the option is not set, or if an error is returned, /@outValue@/ will be set
-- to 'P.Nothing'.
repoGetRemoteListOption ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: A OstreeRepo
    -> T.Text
    -- ^ /@remoteName@/: Name
    -> T.Text
    -- ^ /@optionName@/: Option
    -> m ([T.Text])
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoGetRemoteListOption :: a -> Text -> Text -> m [Text]
repoGetRemoteListOption self :: a
self remoteName :: Text
remoteName optionName :: Text
optionName = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
remoteName' <- Text -> IO CString
textToCString Text
remoteName
    CString
optionName' <- Text -> IO CString
textToCString Text
optionName
    Ptr (Ptr CString)
outValue <- IO (Ptr (Ptr CString))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr CString))
    IO [Text] -> IO () -> IO [Text]
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 Repo
-> CString
-> CString
-> Ptr (Ptr CString)
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_get_remote_list_option Ptr Repo
self' CString
remoteName' CString
optionName' Ptr (Ptr CString)
outValue
        Ptr CString
outValue' <- Ptr (Ptr CString) -> IO (Ptr CString)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr CString)
outValue
        [Text]
outValue'' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
outValue'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outValue'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outValue'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
optionName'
        Ptr (Ptr CString) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CString)
outValue
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
outValue''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
optionName'
        Ptr (Ptr CString) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr CString)
outValue
     )

#if defined(ENABLE_OVERLOADING)
data RepoGetRemoteListOptionMethodInfo
instance (signature ~ (T.Text -> T.Text -> m ([T.Text])), MonadIO m, IsRepo a) => O.MethodInfo RepoGetRemoteListOptionMethodInfo a signature where
    overloadedMethod = repoGetRemoteListOption

#endif

-- method Repo::get_remote_option
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Name" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "option_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Option" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "default_value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Value returned if @option_name is not present"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_value"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Return location for value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_get_remote_option" ostree_repo_get_remote_option :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote_name : TBasicType TUTF8
    CString ->                              -- option_name : TBasicType TUTF8
    CString ->                              -- default_value : TBasicType TUTF8
    Ptr CString ->                          -- out_value : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | OSTree remotes are represented by keyfile groups, formatted like:
-- @[remote \"remotename\"]@. This function returns a value named /@optionName@/
-- underneath that group, or /@defaultValue@/ if the remote exists but not the
-- option name.  If an error is returned, /@outValue@/ will be set to 'P.Nothing'.
repoGetRemoteOption ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: A OstreeRepo
    -> T.Text
    -- ^ /@remoteName@/: Name
    -> T.Text
    -- ^ /@optionName@/: Option
    -> Maybe (T.Text)
    -- ^ /@defaultValue@/: Value returned if /@optionName@/ is not present
    -> m (T.Text)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoGetRemoteOption :: a -> Text -> Text -> Maybe Text -> m Text
repoGetRemoteOption self :: a
self remoteName :: Text
remoteName optionName :: Text
optionName defaultValue :: Maybe Text
defaultValue = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
remoteName' <- Text -> IO CString
textToCString Text
remoteName
    CString
optionName' <- Text -> IO CString
textToCString Text
optionName
    CString
maybeDefaultValue <- case Maybe Text
defaultValue of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jDefaultValue :: Text
jDefaultValue -> do
            CString
jDefaultValue' <- Text -> IO CString
textToCString Text
jDefaultValue
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jDefaultValue'
    Ptr CString
outValue <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    IO Text -> IO () -> IO Text
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 Repo
-> CString
-> CString
-> CString
-> Ptr CString
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_get_remote_option Ptr Repo
self' CString
remoteName' CString
optionName' CString
maybeDefaultValue Ptr CString
outValue
        CString
outValue' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outValue
        Text
outValue'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outValue'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
outValue'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
optionName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeDefaultValue
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outValue
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
outValue''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
optionName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeDefaultValue
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outValue
     )

#if defined(ENABLE_OVERLOADING)
data RepoGetRemoteOptionMethodInfo
instance (signature ~ (T.Text -> T.Text -> Maybe (T.Text) -> m (T.Text)), MonadIO m, IsRepo a) => O.MethodInfo RepoGetRemoteOptionMethodInfo a signature where
    overloadedMethod = repoGetRemoteOption

#endif

-- method Repo::gpg_verify_data
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Repository" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "data"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Data as a #GBytes" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signatures"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Signatures as a #GBytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyringdir"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Path to directory GPG keyrings; overrides built-in default if given"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "extra_keyring"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Path to additional keyring file (not a directory)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "OSTree" , name = "GpgVerifyResult" })
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_gpg_verify_data" ostree_repo_gpg_verify_data :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote_name : TBasicType TUTF8
    Ptr GLib.Bytes.Bytes ->                 -- data : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr GLib.Bytes.Bytes ->                 -- signatures : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr Gio.File.File ->                    -- keyringdir : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.File.File ->                    -- extra_keyring : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr OSTree.GpgVerifyResult.GpgVerifyResult)

-- | Verify /@signatures@/ for /@data@/ using GPG keys in the keyring for
-- /@remoteName@/, and return an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'.
-- 
-- The /@remoteName@/ parameter can be 'P.Nothing'. In that case it will do
-- the verifications using GPG keys in the keyrings of all remotes.
repoGpgVerifyData ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.File.IsFile b, Gio.File.IsFile c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@self@/: Repository
    -> Maybe (T.Text)
    -- ^ /@remoteName@/: Name of remote
    -> GLib.Bytes.Bytes
    -- ^ /@data@/: Data as a t'GI.GLib.Structs.Bytes.Bytes'
    -> GLib.Bytes.Bytes
    -- ^ /@signatures@/: Signatures as a t'GI.GLib.Structs.Bytes.Bytes'
    -> Maybe (b)
    -- ^ /@keyringdir@/: Path to directory GPG keyrings; overrides built-in default if given
    -> Maybe (c)
    -- ^ /@extraKeyring@/: Path to additional keyring file (not a directory)
    -> Maybe (d)
    -- ^ /@cancellable@/: Cancellable
    -> m OSTree.GpgVerifyResult.GpgVerifyResult
    -- ^ __Returns:__ an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult', or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
repoGpgVerifyData :: a
-> Maybe Text
-> Bytes
-> Bytes
-> Maybe b
-> Maybe c
-> Maybe d
-> m GpgVerifyResult
repoGpgVerifyData self :: a
self remoteName :: Maybe Text
remoteName data_ :: Bytes
data_ signatures :: Bytes
signatures keyringdir :: Maybe b
keyringdir extraKeyring :: Maybe c
extraKeyring cancellable :: Maybe d
cancellable = IO GpgVerifyResult -> m GpgVerifyResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GpgVerifyResult -> m GpgVerifyResult)
-> IO GpgVerifyResult -> m GpgVerifyResult
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeRemoteName <- case Maybe Text
remoteName of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jRemoteName :: Text
jRemoteName -> do
            CString
jRemoteName' <- Text -> IO CString
textToCString Text
jRemoteName
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jRemoteName'
    Ptr Bytes
data_' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
data_
    Ptr Bytes
signatures' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
signatures
    Ptr File
maybeKeyringdir <- case Maybe b
keyringdir of
        Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just jKeyringdir :: b
jKeyringdir -> do
            Ptr File
jKeyringdir' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jKeyringdir
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jKeyringdir'
    Ptr File
maybeExtraKeyring <- case Maybe c
extraKeyring of
        Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just jExtraKeyring :: c
jExtraKeyring -> do
            Ptr File
jExtraKeyring' <- c -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jExtraKeyring
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jExtraKeyring'
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO GpgVerifyResult -> IO () -> IO GpgVerifyResult
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GpgVerifyResult
result <- (Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
-> IO (Ptr GpgVerifyResult)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
 -> IO (Ptr GpgVerifyResult))
-> (Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
-> IO (Ptr GpgVerifyResult)
forall a b. (a -> b) -> a -> b
$ Ptr Repo
-> CString
-> Ptr Bytes
-> Ptr Bytes
-> Ptr File
-> Ptr File
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr GpgVerifyResult)
ostree_repo_gpg_verify_data Ptr Repo
self' CString
maybeRemoteName Ptr Bytes
data_' Ptr Bytes
signatures' Ptr File
maybeKeyringdir Ptr File
maybeExtraKeyring Ptr Cancellable
maybeCancellable
        Text -> Ptr GpgVerifyResult -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoGpgVerifyData" Ptr GpgVerifyResult
result
        GpgVerifyResult
result' <- ((ManagedPtr GpgVerifyResult -> GpgVerifyResult)
-> Ptr GpgVerifyResult -> IO GpgVerifyResult
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr GpgVerifyResult -> GpgVerifyResult
OSTree.GpgVerifyResult.GpgVerifyResult) Ptr GpgVerifyResult
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
data_
        Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
signatures
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
keyringdir b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
extraKeyring c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeRemoteName
        GpgVerifyResult -> IO GpgVerifyResult
forall (m :: * -> *) a. Monad m => a -> m a
return GpgVerifyResult
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeRemoteName
     )

#if defined(ENABLE_OVERLOADING)
data RepoGpgVerifyDataMethodInfo
instance (signature ~ (Maybe (T.Text) -> GLib.Bytes.Bytes -> GLib.Bytes.Bytes -> Maybe (b) -> Maybe (c) -> Maybe (d) -> m OSTree.GpgVerifyResult.GpgVerifyResult), MonadIO m, IsRepo a, Gio.File.IsFile b, Gio.File.IsFile c, Gio.Cancellable.IsCancellable d) => O.MethodInfo RepoGpgVerifyDataMethodInfo a signature where
    overloadedMethod = repoGpgVerifyData

#endif

-- method Repo::has_object
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII SHA256 checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_have_object"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "%TRUE if repository contains object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_has_object" ostree_repo_has_object :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr CInt ->                             -- out_have_object : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Set /@outHaveObject@/ to 'P.True' if /@self@/ contains the given object;
-- 'P.False' otherwise.
repoHasObject ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> T.Text
    -- ^ /@checksum@/: ASCII SHA256 checksum
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m (Bool)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoHasObject :: a -> ObjectType -> Text -> Maybe b -> m Bool
repoHasObject self :: a
self objtype :: ObjectType
objtype checksum :: Text
checksum cancellable :: Maybe b
cancellable = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    Ptr CInt
outHaveObject <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Bool -> IO () -> IO Bool
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 Repo
-> CUInt
-> CString
-> Ptr CInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_has_object Ptr Repo
self' CUInt
objtype' CString
checksum' Ptr CInt
outHaveObject Ptr Cancellable
maybeCancellable
        CInt
outHaveObject' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
outHaveObject
        let outHaveObject'' :: Bool
outHaveObject'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
outHaveObject'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outHaveObject
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
outHaveObject''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outHaveObject
     )

#if defined(ENABLE_OVERLOADING)
data RepoHasObjectMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> T.Text -> Maybe (b) -> m (Bool)), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoHasObjectMethodInfo a signature where
    overloadedMethod = repoHasObject

#endif

-- method Repo::hash
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeRepo" , 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_repo_hash" ostree_repo_hash :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO Word32

-- | Calculate a hash value for the given open repository, suitable for use when
-- putting it into a hash table. It is an error to call this on an t'GI.OSTree.Objects.Repo.Repo'
-- which is not yet open, as a persistent hash value cannot be calculated until
-- the repository is open and the inode of its root directory has been loaded.
-- 
-- This function does no I\/O.
-- 
-- /Since: 2017.12/
repoHash ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> m Word32
    -- ^ __Returns:__ hash value for the t'GI.OSTree.Objects.Repo.Repo'
repoHash :: a -> m Word32
repoHash self :: a
self = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Word32
result <- Ptr Repo -> IO Word32
ostree_repo_hash Ptr Repo
self'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Word32 -> IO Word32
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
result

#if defined(ENABLE_OVERLOADING)
data RepoHashMethodInfo
instance (signature ~ (m Word32), MonadIO m, IsRepo a) => O.MethodInfo RepoHashMethodInfo a signature where
    overloadedMethod = repoHash

#endif

-- method Repo::import_object_from
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Destination repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Source repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "checksum" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_import_object_from" ostree_repo_import_object_from :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Repo ->                             -- source : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Copy object named by /@objtype@/ and /@checksum@/ into /@self@/ from the
-- source repository /@source@/.  If both repositories are of the same
-- type and on the same filesystem, this will simply be a fast Unix
-- hard link operation.
-- 
-- Otherwise, a copy will be performed.
repoImportObjectFrom ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, IsRepo b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Destination repo
    -> b
    -- ^ /@source@/: Source repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> T.Text
    -- ^ /@checksum@/: checksum
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoImportObjectFrom :: a -> b -> ObjectType -> Text -> Maybe c -> m ()
repoImportObjectFrom self :: a
self source :: b
source objtype :: ObjectType
objtype checksum :: Text
checksum cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Repo
source' <- b -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
source
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Ptr Repo
-> CUInt
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_import_object_from Ptr Repo
self' Ptr Repo
source' CUInt
objtype' CString
checksum' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
source
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
     )

#if defined(ENABLE_OVERLOADING)
data RepoImportObjectFromMethodInfo
instance (signature ~ (b -> OSTree.Enums.ObjectType -> T.Text -> Maybe (c) -> m ()), MonadIO m, IsRepo a, IsRepo b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoImportObjectFromMethodInfo a signature where
    overloadedMethod = repoImportObjectFrom

#endif

-- method Repo::import_object_from_with_trust
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Destination repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Source repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "checksum" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "trusted"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "If %TRUE, assume the source repo is valid and trusted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_import_object_from_with_trust" ostree_repo_import_object_from_with_trust :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Repo ->                             -- source : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- checksum : TBasicType TUTF8
    CInt ->                                 -- trusted : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Copy object named by /@objtype@/ and /@checksum@/ into /@self@/ from the
-- source repository /@source@/. If /@trusted@/ is 'P.True' and both
-- repositories are of the same type and on the same filesystem,
-- this will simply be a fast Unix hard link operation.
-- 
-- Otherwise, a copy will be performed.
repoImportObjectFromWithTrust ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, IsRepo b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Destination repo
    -> b
    -- ^ /@source@/: Source repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> T.Text
    -- ^ /@checksum@/: checksum
    -> Bool
    -- ^ /@trusted@/: If 'P.True', assume the source repo is valid and trusted
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoImportObjectFromWithTrust :: a -> b -> ObjectType -> Text -> Bool -> Maybe c -> m ()
repoImportObjectFromWithTrust self :: a
self source :: b
source objtype :: ObjectType
objtype checksum :: Text
checksum trusted :: Bool
trusted cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Repo
source' <- b -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
source
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    let trusted' :: CInt
trusted' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
trusted
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Ptr Repo
-> CUInt
-> CString
-> CInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_import_object_from_with_trust Ptr Repo
self' Ptr Repo
source' CUInt
objtype' CString
checksum' CInt
trusted' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
source
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
     )

#if defined(ENABLE_OVERLOADING)
data RepoImportObjectFromWithTrustMethodInfo
instance (signature ~ (b -> OSTree.Enums.ObjectType -> T.Text -> Bool -> Maybe (c) -> m ()), MonadIO m, IsRepo a, IsRepo b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoImportObjectFromWithTrustMethodInfo a signature where
    overloadedMethod = repoImportObjectFromWithTrust

#endif

-- method Repo::is_system
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "repo"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Repository" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_is_system" ostree_repo_is_system :: 
    Ptr Repo ->                             -- repo : TInterface (Name {namespace = "OSTree", name = "Repo"})
    IO CInt

-- | /No description available in the introspection data./
repoIsSystem ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@repo@/: Repository
    -> m Bool
    -- ^ __Returns:__ 'P.True' if this repository is the root-owned system global repository
repoIsSystem :: a -> m Bool
repoIsSystem repo :: a
repo = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
repo' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
repo
    CInt
result <- Ptr Repo -> IO CInt
ostree_repo_is_system Ptr Repo
repo'
    let result' :: Bool
result' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
repo
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
result'

#if defined(ENABLE_OVERLOADING)
data RepoIsSystemMethodInfo
instance (signature ~ (m Bool), MonadIO m, IsRepo a) => O.MethodInfo RepoIsSystemMethodInfo a signature where
    overloadedMethod = repoIsSystem

#endif

-- method Repo::is_writable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , 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_repo_is_writable" ostree_repo_is_writable :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Returns whether the repository is writable by the current user.
-- If the repository is not writable, the /@error@/ indicates why.
repoIsWritable ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoIsWritable :: a -> m ()
repoIsWritable self :: a
self = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    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 Repo -> Ptr (Ptr GError) -> IO CInt
ostree_repo_is_writable Ptr Repo
self'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        () -> 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 RepoIsWritableMethodInfo
instance (signature ~ (m ()), MonadIO m, IsRepo a) => O.MethodInfo RepoIsWritableMethodInfo a signature where
    overloadedMethod = repoIsWritable

#endif

-- XXX Could not generate method Repo::list_collection_refs
-- Error was : Not implemented: "GHashTable element of type TInterface (Name {namespace = \"OSTree\", name = \"CollectionRef\"}) unsupported."
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoListCollectionRefsMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "listCollectionRefs" Repo) => O.MethodInfo RepoListCollectionRefsMethodInfo o p where
    overloadedMethod = undefined
#endif

-- XXX Could not generate method Repo::list_commit_objects_starting_with
-- Error was : Not implemented: "GHashTable element of type TVariant unsupported."
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoListCommitObjectsStartingWithMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "listCommitObjectsStartingWith" Repo) => O.MethodInfo RepoListCommitObjectsStartingWithMethodInfo o p where
    overloadedMethod = undefined
#endif

-- XXX Could not generate method Repo::list_objects
-- Error was : Not implemented: "GHashTable element of type TVariant unsupported."
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoListObjectsMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "listObjects" Repo) => O.MethodInfo RepoListObjectsMethodInfo o p where
    overloadedMethod = undefined
#endif

-- XXX Could not generate method Repo::list_refs
-- Error was : Not implemented: "Hash table argument with transfer = Container? outAllRefs'"
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoListRefsMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "listRefs" Repo) => O.MethodInfo RepoListRefsMethodInfo o p where
    overloadedMethod = undefined
#endif

-- XXX Could not generate method Repo::list_refs_ext
-- Error was : Not implemented: "Hash table argument with transfer = Container? outAllRefs'"
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoListRefsExtMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "listRefsExt" Repo) => O.MethodInfo RepoListRefsExtMethodInfo o p where
    overloadedMethod = undefined
#endif

-- method Repo::list_static_delta_names
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_deltas"
--           , argType = TPtrArray (TBasicType TUTF8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "String name of deltas (checksum-checksum.delta)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferContainer
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_list_static_delta_names" ostree_repo_list_static_delta_names :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr (Ptr (GPtrArray CString)) ->        -- out_deltas : TPtrArray (TBasicType TUTF8)
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | This function synchronously enumerates all static deltas in the
-- repository, returning its result in /@outDeltas@/.
repoListStaticDeltaNames ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ([T.Text])
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoListStaticDeltaNames :: a -> Maybe b -> m [Text]
repoListStaticDeltaNames self :: a
self cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr (Ptr (GPtrArray CString))
outDeltas <- IO (Ptr (Ptr (GPtrArray CString)))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr (GPtrArray CString)))
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO [Text] -> IO () -> IO [Text]
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 Repo
-> Ptr (Ptr (GPtrArray CString))
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_list_static_delta_names Ptr Repo
self' Ptr (Ptr (GPtrArray CString))
outDeltas Ptr Cancellable
maybeCancellable
        Ptr (GPtrArray CString)
outDeltas' <- Ptr (Ptr (GPtrArray CString)) -> IO (Ptr (GPtrArray CString))
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr (GPtrArray CString))
outDeltas
        [CString]
outDeltas'' <- Ptr (GPtrArray CString) -> IO [CString]
forall a. Ptr (GPtrArray (Ptr a)) -> IO [Ptr a]
unpackGPtrArray Ptr (GPtrArray CString)
outDeltas'
        [Text]
outDeltas''' <- (CString -> IO Text) -> [CString] -> IO [Text]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText [CString]
outDeltas''
        Ptr (GPtrArray CString) -> IO ()
forall a. Ptr (GPtrArray a) -> IO ()
unrefPtrArray Ptr (GPtrArray CString)
outDeltas'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (Ptr (GPtrArray CString)) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GPtrArray CString))
outDeltas
        [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
outDeltas'''
     ) (do
        Ptr (Ptr (GPtrArray CString)) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr (GPtrArray CString))
outDeltas
     )

#if defined(ENABLE_OVERLOADING)
data RepoListStaticDeltaNamesMethodInfo
instance (signature ~ (Maybe (b) -> m ([T.Text])), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoListStaticDeltaNamesMethodInfo a signature where
    overloadedMethod = repoListStaticDeltaNames

#endif

-- method Repo::load_commit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Commit checksum" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_commit"
--           , argType = TVariant
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Commit" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_state"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "RepoCommitState" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Commit state" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_load_commit" ostree_repo_load_commit :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr (Ptr GVariant) ->                   -- out_commit : TVariant
    Ptr CUInt ->                            -- out_state : TInterface (Name {namespace = "OSTree", name = "RepoCommitState"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | A version of 'GI.OSTree.Objects.Repo.repoLoadVariant' specialized to commits,
-- capable of returning extended state information.  Currently
-- the only extended state is 'GI.OSTree.Flags.RepoCommitStatePartial', which
-- means that only a sub-path of the commit is available.
repoLoadCommit ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@checksum@/: Commit checksum
    -> m ((GVariant, [OSTree.Flags.RepoCommitState]))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoLoadCommit :: a -> Text -> m (GVariant, [RepoCommitState])
repoLoadCommit self :: a
self checksum :: Text
checksum = IO (GVariant, [RepoCommitState]) -> m (GVariant, [RepoCommitState])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (GVariant, [RepoCommitState])
 -> m (GVariant, [RepoCommitState]))
-> IO (GVariant, [RepoCommitState])
-> m (GVariant, [RepoCommitState])
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    Ptr (Ptr GVariant)
outCommit <- IO (Ptr (Ptr GVariant))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GVariant))
    Ptr CUInt
outState <- IO (Ptr CUInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CUInt)
    IO (GVariant, [RepoCommitState])
-> IO () -> IO (GVariant, [RepoCommitState])
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 Repo
-> CString
-> Ptr (Ptr GVariant)
-> Ptr CUInt
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_load_commit Ptr Repo
self' CString
checksum' Ptr (Ptr GVariant)
outCommit Ptr CUInt
outState
        Ptr GVariant
outCommit' <- Ptr (Ptr GVariant) -> IO (Ptr GVariant)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GVariant)
outCommit
        GVariant
outCommit'' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
outCommit'
        CUInt
outState' <- Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
outState
        let outState'' :: [RepoCommitState]
outState'' = CUInt -> [RepoCommitState]
forall a b. (Storable a, Integral a, Bits a, IsGFlag b) => a -> [b]
wordToGFlags CUInt
outState'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outCommit
        Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
outState
        (GVariant, [RepoCommitState]) -> IO (GVariant, [RepoCommitState])
forall (m :: * -> *) a. Monad m => a -> m a
return (GVariant
outCommit'', [RepoCommitState]
outState'')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outCommit
        Ptr CUInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CUInt
outState
     )

#if defined(ENABLE_OVERLOADING)
data RepoLoadCommitMethodInfo
instance (signature ~ (T.Text -> m ((GVariant, [OSTree.Flags.RepoCommitState]))), MonadIO m, IsRepo a) => O.MethodInfo RepoLoadCommitMethodInfo a signature where
    overloadedMethod = repoLoadCommit

#endif

-- method Repo::load_file
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII SHA256 checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_input"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "File content" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_file_info"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "FileInfo" }
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "File information" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_xattrs"
--           , argType = TVariant
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Extended attributes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_load_file" ostree_repo_load_file :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr (Ptr Gio.InputStream.InputStream) -> -- out_input : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Ptr (Ptr Gio.FileInfo.FileInfo) ->      -- out_file_info : TInterface (Name {namespace = "Gio", name = "FileInfo"})
    Ptr (Ptr GVariant) ->                   -- out_xattrs : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Load content object, decomposing it into three parts: the actual
-- content (for regular files), the metadata, and extended attributes.
repoLoadFile ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@checksum@/: ASCII SHA256 checksum
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ((Maybe Gio.InputStream.InputStream, Maybe Gio.FileInfo.FileInfo, Maybe GVariant))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoLoadFile :: a
-> Text
-> Maybe b
-> m (Maybe InputStream, Maybe FileInfo, Maybe GVariant)
repoLoadFile self :: a
self checksum :: Text
checksum cancellable :: Maybe b
cancellable = IO (Maybe InputStream, Maybe FileInfo, Maybe GVariant)
-> m (Maybe InputStream, Maybe FileInfo, Maybe GVariant)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Maybe InputStream, Maybe FileInfo, Maybe GVariant)
 -> m (Maybe InputStream, Maybe FileInfo, Maybe GVariant))
-> IO (Maybe InputStream, Maybe FileInfo, Maybe GVariant)
-> m (Maybe InputStream, Maybe FileInfo, Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    Ptr (Ptr InputStream)
outInput <- IO (Ptr (Ptr InputStream))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gio.InputStream.InputStream))
    Ptr (Ptr FileInfo)
outFileInfo <- IO (Ptr (Ptr FileInfo))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gio.FileInfo.FileInfo))
    Ptr (Ptr GVariant)
outXattrs <- IO (Ptr (Ptr GVariant))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GVariant))
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Maybe InputStream, Maybe FileInfo, Maybe GVariant)
-> IO () -> IO (Maybe InputStream, Maybe FileInfo, Maybe GVariant)
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 Repo
-> CString
-> Ptr (Ptr InputStream)
-> Ptr (Ptr FileInfo)
-> Ptr (Ptr GVariant)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_load_file Ptr Repo
self' CString
checksum' Ptr (Ptr InputStream)
outInput Ptr (Ptr FileInfo)
outFileInfo Ptr (Ptr GVariant)
outXattrs Ptr Cancellable
maybeCancellable
        Ptr InputStream
outInput' <- Ptr (Ptr InputStream) -> IO (Ptr InputStream)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr InputStream)
outInput
        Maybe InputStream
maybeOutInput' <- Ptr InputStream
-> (Ptr InputStream -> IO InputStream) -> IO (Maybe InputStream)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr InputStream
outInput' ((Ptr InputStream -> IO InputStream) -> IO (Maybe InputStream))
-> (Ptr InputStream -> IO InputStream) -> IO (Maybe InputStream)
forall a b. (a -> b) -> a -> b
$ \outInput'' :: Ptr InputStream
outInput'' -> do
            InputStream
outInput''' <- ((ManagedPtr InputStream -> InputStream)
-> Ptr InputStream -> IO InputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream) Ptr InputStream
outInput''
            InputStream -> IO InputStream
forall (m :: * -> *) a. Monad m => a -> m a
return InputStream
outInput'''
        Ptr FileInfo
outFileInfo' <- Ptr (Ptr FileInfo) -> IO (Ptr FileInfo)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr FileInfo)
outFileInfo
        Maybe FileInfo
maybeOutFileInfo' <- Ptr FileInfo
-> (Ptr FileInfo -> IO FileInfo) -> IO (Maybe FileInfo)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr FileInfo
outFileInfo' ((Ptr FileInfo -> IO FileInfo) -> IO (Maybe FileInfo))
-> (Ptr FileInfo -> IO FileInfo) -> IO (Maybe FileInfo)
forall a b. (a -> b) -> a -> b
$ \outFileInfo'' :: Ptr FileInfo
outFileInfo'' -> do
            FileInfo
outFileInfo''' <- ((ManagedPtr FileInfo -> FileInfo) -> Ptr FileInfo -> IO FileInfo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr FileInfo -> FileInfo
Gio.FileInfo.FileInfo) Ptr FileInfo
outFileInfo''
            FileInfo -> IO FileInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FileInfo
outFileInfo'''
        Ptr GVariant
outXattrs' <- Ptr (Ptr GVariant) -> IO (Ptr GVariant)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GVariant)
outXattrs
        Maybe GVariant
maybeOutXattrs' <- Ptr GVariant
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull Ptr GVariant
outXattrs' ((Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant))
-> (Ptr GVariant -> IO GVariant) -> IO (Maybe GVariant)
forall a b. (a -> b) -> a -> b
$ \outXattrs'' :: Ptr GVariant
outXattrs'' -> do
            GVariant
outXattrs''' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
outXattrs''
            GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
outXattrs'''
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        Ptr (Ptr InputStream) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr InputStream)
outInput
        Ptr (Ptr FileInfo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr FileInfo)
outFileInfo
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outXattrs
        (Maybe InputStream, Maybe FileInfo, Maybe GVariant)
-> IO (Maybe InputStream, Maybe FileInfo, Maybe GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe InputStream
maybeOutInput', Maybe FileInfo
maybeOutFileInfo', Maybe GVariant
maybeOutXattrs')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        Ptr (Ptr InputStream) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr InputStream)
outInput
        Ptr (Ptr FileInfo) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr FileInfo)
outFileInfo
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outXattrs
     )

#if defined(ENABLE_OVERLOADING)
data RepoLoadFileMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ((Maybe Gio.InputStream.InputStream, Maybe Gio.FileInfo.FileInfo, Maybe GVariant))), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoLoadFileMethodInfo a signature where
    overloadedMethod = repoLoadFile

#endif

-- method Repo::load_object_stream
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII SHA256 checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_input"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Stream for object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Length of @out_input"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_load_object_stream" ostree_repo_load_object_stream :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr (Ptr Gio.InputStream.InputStream) -> -- out_input : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Ptr Word64 ->                           -- out_size : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Load object as a stream; useful when copying objects between
-- repositories.
repoLoadObjectStream ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> T.Text
    -- ^ /@checksum@/: ASCII SHA256 checksum
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ((Gio.InputStream.InputStream, Word64))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoLoadObjectStream :: a -> ObjectType -> Text -> Maybe b -> m (InputStream, Word64)
repoLoadObjectStream self :: a
self objtype :: ObjectType
objtype checksum :: Text
checksum cancellable :: Maybe b
cancellable = IO (InputStream, Word64) -> m (InputStream, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (InputStream, Word64) -> m (InputStream, Word64))
-> IO (InputStream, Word64) -> m (InputStream, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    Ptr (Ptr InputStream)
outInput <- IO (Ptr (Ptr InputStream))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gio.InputStream.InputStream))
    Ptr Word64
outSize <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (InputStream, Word64) -> IO () -> IO (InputStream, Word64)
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 Repo
-> CUInt
-> CString
-> Ptr (Ptr InputStream)
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_load_object_stream Ptr Repo
self' CUInt
objtype' CString
checksum' Ptr (Ptr InputStream)
outInput Ptr Word64
outSize Ptr Cancellable
maybeCancellable
        Ptr InputStream
outInput' <- Ptr (Ptr InputStream) -> IO (Ptr InputStream)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr InputStream)
outInput
        InputStream
outInput'' <- ((ManagedPtr InputStream -> InputStream)
-> Ptr InputStream -> IO InputStream
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr InputStream -> InputStream
Gio.InputStream.InputStream) Ptr InputStream
outInput'
        Word64
outSize' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
outSize
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        Ptr (Ptr InputStream) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr InputStream)
outInput
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outSize
        (InputStream, Word64) -> IO (InputStream, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (InputStream
outInput'', Word64
outSize')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        Ptr (Ptr InputStream) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr InputStream)
outInput
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outSize
     )

#if defined(ENABLE_OVERLOADING)
data RepoLoadObjectStreamMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> T.Text -> Maybe (b) -> m ((Gio.InputStream.InputStream, Word64))), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoLoadObjectStreamMethodInfo a signature where
    overloadedMethod = repoLoadObjectStream

#endif

-- method Repo::load_variant
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Expected object type"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sha256"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Checksum string" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_variant"
--           , argType = TVariant
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Metadata object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_load_variant" ostree_repo_load_variant :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- sha256 : TBasicType TUTF8
    Ptr (Ptr GVariant) ->                   -- out_variant : TVariant
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Load the metadata object /@sha256@/ of type /@objtype@/, storing the
-- result in /@outVariant@/.
repoLoadVariant ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Expected object type
    -> T.Text
    -- ^ /@sha256@/: Checksum string
    -> m (GVariant)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoLoadVariant :: a -> ObjectType -> Text -> m GVariant
repoLoadVariant self :: a
self objtype :: ObjectType
objtype sha256 :: Text
sha256 = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
sha256' <- Text -> IO CString
textToCString Text
sha256
    Ptr (Ptr GVariant)
outVariant <- IO (Ptr (Ptr GVariant))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GVariant))
    IO GVariant -> IO () -> IO GVariant
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 Repo
-> CUInt
-> CString
-> Ptr (Ptr GVariant)
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_load_variant Ptr Repo
self' CUInt
objtype' CString
sha256' Ptr (Ptr GVariant)
outVariant
        Ptr GVariant
outVariant' <- Ptr (Ptr GVariant) -> IO (Ptr GVariant)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GVariant)
outVariant
        GVariant
outVariant'' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
outVariant'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sha256'
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outVariant
        GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
outVariant''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sha256'
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outVariant
     )

#if defined(ENABLE_OVERLOADING)
data RepoLoadVariantMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> T.Text -> m (GVariant)), MonadIO m, IsRepo a) => O.MethodInfo RepoLoadVariantMethodInfo a signature where
    overloadedMethod = repoLoadVariant

#endif

-- method Repo::load_variant_if_exists
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sha256"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII checksum" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_variant"
--           , argType = TVariant
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Metadata" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_load_variant_if_exists" ostree_repo_load_variant_if_exists :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- sha256 : TBasicType TUTF8
    Ptr (Ptr GVariant) ->                   -- out_variant : TVariant
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Attempt to load the metadata object /@sha256@/ of type /@objtype@/ if it
-- exists, storing the result in /@outVariant@/.  If it doesn\'t exist,
-- 'P.Nothing' is returned.
repoLoadVariantIfExists ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> T.Text
    -- ^ /@sha256@/: ASCII checksum
    -> m (GVariant)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoLoadVariantIfExists :: a -> ObjectType -> Text -> m GVariant
repoLoadVariantIfExists self :: a
self objtype :: ObjectType
objtype sha256 :: Text
sha256 = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
sha256' <- Text -> IO CString
textToCString Text
sha256
    Ptr (Ptr GVariant)
outVariant <- IO (Ptr (Ptr GVariant))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GVariant))
    IO GVariant -> IO () -> IO GVariant
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 Repo
-> CUInt
-> CString
-> Ptr (Ptr GVariant)
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_load_variant_if_exists Ptr Repo
self' CUInt
objtype' CString
sha256' Ptr (Ptr GVariant)
outVariant
        Ptr GVariant
outVariant' <- Ptr (Ptr GVariant) -> IO (Ptr GVariant)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GVariant)
outVariant
        GVariant
outVariant'' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
outVariant'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sha256'
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outVariant
        GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
outVariant''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sha256'
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outVariant
     )

#if defined(ENABLE_OVERLOADING)
data RepoLoadVariantIfExistsMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> T.Text -> m (GVariant)), MonadIO m, IsRepo a) => O.MethodInfo RepoLoadVariantIfExistsMethodInfo a signature where
    overloadedMethod = repoLoadVariantIfExists

#endif

-- method Repo::mark_commit_partial
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Commit SHA-256" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "is_partial"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Whether or not this commit is partial"
--                 , 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_repo_mark_commit_partial" ostree_repo_mark_commit_partial :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- checksum : TBasicType TUTF8
    CInt ->                                 -- is_partial : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Commits in \"partial\" state do not have all their child objects written. This
-- occurs in various situations, such as during a pull, but also if a \"subpath\"
-- pull is used, as well as \"commit only\" pulls.
-- 
-- This function is used by 'GI.OSTree.Objects.Repo.repoPullWithOptions'; you
-- should use this if you are implementing a different type of transport.
-- 
-- /Since: 2017.15/
repoMarkCommitPartial ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@checksum@/: Commit SHA-256
    -> Bool
    -- ^ /@isPartial@/: Whether or not this commit is partial
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoMarkCommitPartial :: a -> Text -> Bool -> m ()
repoMarkCommitPartial self :: a
self checksum :: Text
checksum isPartial :: Bool
isPartial = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    let isPartial' :: CInt
isPartial' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
isPartial
    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 Repo -> CString -> CInt -> Ptr (Ptr GError) -> IO CInt
ostree_repo_mark_commit_partial Ptr Repo
self' CString
checksum' CInt
isPartial'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
     )

#if defined(ENABLE_OVERLOADING)
data RepoMarkCommitPartialMethodInfo
instance (signature ~ (T.Text -> Bool -> m ()), MonadIO m, IsRepo a) => O.MethodInfo RepoMarkCommitPartialMethodInfo a signature where
    overloadedMethod = repoMarkCommitPartial

#endif

-- method Repo::open
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_repo_open" ostree_repo_open :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
repoOpen ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -> Maybe (b)
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoOpen :: a -> Maybe b -> m ()
repoOpen self :: a
self cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_repo_open Ptr Repo
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoOpenMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoOpenMethodInfo a signature where
    overloadedMethod = repoOpen

#endif

-- method Repo::prepare_transaction
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_transaction_resume"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Whether this transaction\nis resuming from a previous one.  This is a legacy state, now OSTree\npulls use per-commit `state/.commitpartial` files."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_prepare_transaction" ostree_repo_prepare_transaction :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr CInt ->                             -- out_transaction_resume : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Starts or resumes a transaction. In order to write to a repo, you
-- need to start a transaction. You can complete the transaction with
-- 'GI.OSTree.Objects.Repo.repoCommitTransaction', or abort the transaction with
-- 'GI.OSTree.Objects.Repo.repoAbortTransaction'.
-- 
-- Currently, transactions may result in partial commits or data in the target
-- repository if interrupted during 'GI.OSTree.Objects.Repo.repoCommitTransaction', and
-- further writing refs is also not currently atomic.
-- 
-- There can be at most one transaction active on a repo at a time per instance
-- of @OstreeRepo@; however, it is safe to have multiple threads writing objects
-- on a single @OstreeRepo@ instance as long as their lifetime is bounded by the
-- transaction.
-- 
-- Locking: Acquires a @shared@ lock; release via commit or abort
-- Multithreading: This function is *not* MT safe; only one transaction can be
-- active at a time.
repoPrepareTransaction ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m (Bool)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoPrepareTransaction :: a -> Maybe b -> m Bool
repoPrepareTransaction self :: a
self cancellable :: Maybe b
cancellable = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CInt
outTransactionResume <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Bool -> IO () -> IO Bool
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 Repo
-> Ptr CInt -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_repo_prepare_transaction Ptr Repo
self' Ptr CInt
outTransactionResume Ptr Cancellable
maybeCancellable
        CInt
outTransactionResume' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
outTransactionResume
        let outTransactionResume'' :: Bool
outTransactionResume'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
outTransactionResume'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outTransactionResume
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
outTransactionResume''
     ) (do
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outTransactionResume
     )

#if defined(ENABLE_OVERLOADING)
data RepoPrepareTransactionMethodInfo
instance (signature ~ (Maybe (b) -> m (Bool)), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoPrepareTransactionMethodInfo a signature where
    overloadedMethod = repoPrepareTransaction

#endif

-- method Repo::prune
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "RepoPruneFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Options controlling prune process"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "depth"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Stop traversal after this many iterations (-1 for unlimited)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_objects_total"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Number of objects found"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_objects_pruned"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Number of objects deleted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_pruned_object_size_total"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Storage size in bytes of objects deleted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_prune" ostree_repo_prune :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- flags : TInterface (Name {namespace = "OSTree", name = "RepoPruneFlags"})
    Int32 ->                                -- depth : TBasicType TInt
    Ptr Int32 ->                            -- out_objects_total : TBasicType TInt
    Ptr Int32 ->                            -- out_objects_pruned : TBasicType TInt
    Ptr Word64 ->                           -- out_pruned_object_size_total : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Delete content from the repository.  By default, this function will
-- only delete \"orphaned\" objects not referred to by any commit.  This
-- can happen during a local commit operation, when we have written
-- content objects but not saved the commit referencing them.
-- 
-- However, if 'GI.OSTree.Enums.RepoPruneFlagsRefsOnly' is provided, instead
-- of traversing all commits, only refs will be used.  Particularly
-- when combined with /@depth@/, this is a convenient way to delete
-- history from the repository.
-- 
-- Use the 'GI.OSTree.Enums.RepoPruneFlagsNoPrune' to just determine
-- statistics on objects that would be deleted, without actually
-- deleting them.
-- 
-- Locking: exclusive
repoPrune ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.RepoPruneFlags
    -- ^ /@flags@/: Options controlling prune process
    -> Int32
    -- ^ /@depth@/: Stop traversal after this many iterations (-1 for unlimited)
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ((Int32, Int32, Word64))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoPrune :: a -> RepoPruneFlags -> Int32 -> Maybe b -> m (Int32, Int32, Word64)
repoPrune self :: a
self flags :: RepoPruneFlags
flags depth :: Int32
depth cancellable :: Maybe b
cancellable = IO (Int32, Int32, Word64) -> m (Int32, Int32, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32, Word64) -> m (Int32, Int32, Word64))
-> IO (Int32, Int32, Word64) -> m (Int32, Int32, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let flags' :: CUInt
flags' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (RepoPruneFlags -> Int) -> RepoPruneFlags -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoPruneFlags -> Int
forall a. Enum a => a -> Int
fromEnum) RepoPruneFlags
flags
    Ptr Int32
outObjectsTotal <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
outObjectsPruned <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Word64
outPrunedObjectSizeTotal <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Int32, Int32, Word64) -> IO () -> IO (Int32, Int32, Word64)
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 Repo
-> CUInt
-> Int32
-> Ptr Int32
-> Ptr Int32
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_prune Ptr Repo
self' CUInt
flags' Int32
depth Ptr Int32
outObjectsTotal Ptr Int32
outObjectsPruned Ptr Word64
outPrunedObjectSizeTotal Ptr Cancellable
maybeCancellable
        Int32
outObjectsTotal' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
outObjectsTotal
        Int32
outObjectsPruned' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
outObjectsPruned
        Word64
outPrunedObjectSizeTotal' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
outPrunedObjectSizeTotal
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsTotal
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsPruned
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outPrunedObjectSizeTotal
        (Int32, Int32, Word64) -> IO (Int32, Int32, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
outObjectsTotal', Int32
outObjectsPruned', Word64
outPrunedObjectSizeTotal')
     ) (do
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsTotal
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsPruned
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outPrunedObjectSizeTotal
     )

#if defined(ENABLE_OVERLOADING)
data RepoPruneMethodInfo
instance (signature ~ (OSTree.Enums.RepoPruneFlags -> Int32 -> Maybe (b) -> m ((Int32, Int32, Word64))), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoPruneMethodInfo a signature where
    overloadedMethod = repoPrune

#endif

-- method Repo::prune_from_reachable
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoPruneOptions" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Options controlling prune process"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_objects_total"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Number of objects found"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_objects_pruned"
--           , argType = TBasicType TInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Number of objects deleted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_pruned_object_size_total"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Storage size in bytes of objects deleted"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_prune_from_reachable" ostree_repo_prune_from_reachable :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr OSTree.RepoPruneOptions.RepoPruneOptions -> -- options : TInterface (Name {namespace = "OSTree", name = "RepoPruneOptions"})
    Ptr Int32 ->                            -- out_objects_total : TBasicType TInt
    Ptr Int32 ->                            -- out_objects_pruned : TBasicType TInt
    Ptr Word64 ->                           -- out_pruned_object_size_total : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Delete content from the repository.  This function is the \"backend\"
-- half of the higher level 'GI.OSTree.Objects.Repo.repoPrune'.  To use this function,
-- you determine the root set yourself, and this function finds all other
-- unreferenced objects and deletes them.
-- 
-- Use this API when you want to perform more selective pruning - for example,
-- retain all commits from a production branch, but just GC some history from
-- your dev branch.
-- 
-- The 'GI.OSTree.Enums.RepoPruneFlagsNoPrune' flag may be specified to just determine
-- statistics on objects that would be deleted, without actually deleting them.
-- 
-- Locking: exclusive
repoPruneFromReachable ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.RepoPruneOptions.RepoPruneOptions
    -- ^ /@options@/: Options controlling prune process
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ((Int32, Int32, Word64))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoPruneFromReachable :: a -> RepoPruneOptions -> Maybe b -> m (Int32, Int32, Word64)
repoPruneFromReachable self :: a
self options :: RepoPruneOptions
options cancellable :: Maybe b
cancellable = IO (Int32, Int32, Word64) -> m (Int32, Int32, Word64)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int32, Int32, Word64) -> m (Int32, Int32, Word64))
-> IO (Int32, Int32, Word64) -> m (Int32, Int32, Word64)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr RepoPruneOptions
options' <- RepoPruneOptions -> IO (Ptr RepoPruneOptions)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RepoPruneOptions
options
    Ptr Int32
outObjectsTotal <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Int32
outObjectsPruned <- IO (Ptr Int32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Int32)
    Ptr Word64
outPrunedObjectSizeTotal <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Int32, Int32, Word64) -> IO () -> IO (Int32, Int32, Word64)
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 Repo
-> Ptr RepoPruneOptions
-> Ptr Int32
-> Ptr Int32
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_prune_from_reachable Ptr Repo
self' Ptr RepoPruneOptions
options' Ptr Int32
outObjectsTotal Ptr Int32
outObjectsPruned Ptr Word64
outPrunedObjectSizeTotal Ptr Cancellable
maybeCancellable
        Int32
outObjectsTotal' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
outObjectsTotal
        Int32
outObjectsPruned' <- Ptr Int32 -> IO Int32
forall a. Storable a => Ptr a -> IO a
peek Ptr Int32
outObjectsPruned
        Word64
outPrunedObjectSizeTotal' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
outPrunedObjectSizeTotal
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        RepoPruneOptions -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr RepoPruneOptions
options
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsTotal
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsPruned
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outPrunedObjectSizeTotal
        (Int32, Int32, Word64) -> IO (Int32, Int32, Word64)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int32
outObjectsTotal', Int32
outObjectsPruned', Word64
outPrunedObjectSizeTotal')
     ) (do
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsTotal
        Ptr Int32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Int32
outObjectsPruned
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outPrunedObjectSizeTotal
     )

#if defined(ENABLE_OVERLOADING)
data RepoPruneFromReachableMethodInfo
instance (signature ~ (OSTree.RepoPruneOptions.RepoPruneOptions -> Maybe (b) -> m ((Int32, Int32, Word64))), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoPruneFromReachableMethodInfo a signature where
    overloadedMethod = repoPruneFromReachable

#endif

-- method Repo::prune_static_deltas
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "commit"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "ASCII SHA256 checksum for commit, or %NULL for each\nnon existing commit"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_prune_static_deltas" ostree_repo_prune_static_deltas :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- commit : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Prune static deltas, if COMMIT is specified then delete static delta files only
-- targeting that commit; otherwise any static delta of non existing commits are
-- deleted.
-- 
-- Locking: exclusive
repoPruneStaticDeltas ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> Maybe (T.Text)
    -- ^ /@commit@/: ASCII SHA256 checksum for commit, or 'P.Nothing' for each
    -- non existing commit
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoPruneStaticDeltas :: a -> Maybe Text -> Maybe b -> m ()
repoPruneStaticDeltas self :: a
self commit :: Maybe Text
commit cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeCommit <- case Maybe Text
commit of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jCommit :: Text
jCommit -> do
            CString
jCommit' <- Text -> IO CString
textToCString Text
jCommit
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCommit'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_repo_prune_static_deltas Ptr Repo
self' CString
maybeCommit Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCommit
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCommit
     )

#if defined(ENABLE_OVERLOADING)
data RepoPruneStaticDeltasMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoPruneStaticDeltasMethodInfo a signature where
    overloadedMethod = repoPruneStaticDeltas

#endif

-- method Repo::pull
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "refs_to_fetch"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Optional list of refs; if %NULL, fetch all configured refs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "RepoPullFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Options controlling fetch behavior"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Progress" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_pull" ostree_repo_pull :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote_name : TBasicType TUTF8
    Ptr CString ->                          -- refs_to_fetch : TCArray True (-1) (-1) (TBasicType TUTF8)
    CUInt ->                                -- flags : TInterface (Name {namespace = "OSTree", name = "RepoPullFlags"})
    Ptr OSTree.AsyncProgress.AsyncProgress -> -- progress : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Connect to the remote repository, fetching the specified set of
-- refs /@refsToFetch@/.  For each ref that is changed, download the
-- commit, all metadata, and all content objects, storing them safely
-- on disk in /@self@/.
-- 
-- If /@flags@/ contains 'GI.OSTree.Flags.RepoPullFlagsMirror', and
-- the /@refsToFetch@/ is 'P.Nothing', and the remote repository contains a
-- summary file, then all refs will be fetched.
-- 
-- If /@flags@/ contains 'GI.OSTree.Flags.RepoPullFlagsCommitOnly', then only the
-- metadata for the commits in /@refsToFetch@/ is pulled.
-- 
-- Warning: This API will iterate the thread default main context,
-- which is a bug, but kept for compatibility reasons.  If you want to
-- avoid this, use 'GI.GLib.Structs.MainContext.mainContextPushThreadDefault' to push a new
-- one around this call.
repoPull ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, OSTree.AsyncProgress.IsAsyncProgress b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@remoteName@/: Name of remote
    -> Maybe ([T.Text])
    -- ^ /@refsToFetch@/: Optional list of refs; if 'P.Nothing', fetch all configured refs
    -> [OSTree.Flags.RepoPullFlags]
    -- ^ /@flags@/: Options controlling fetch behavior
    -> Maybe (b)
    -- ^ /@progress@/: Progress
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoPull :: a
-> Text
-> Maybe [Text]
-> [RepoPullFlags]
-> Maybe b
-> Maybe c
-> m ()
repoPull self :: a
self remoteName :: Text
remoteName refsToFetch :: Maybe [Text]
refsToFetch flags :: [RepoPullFlags]
flags progress :: Maybe b
progress cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
remoteName' <- Text -> IO CString
textToCString Text
remoteName
    Ptr CString
maybeRefsToFetch <- case Maybe [Text]
refsToFetch of
        Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just jRefsToFetch :: [Text]
jRefsToFetch -> do
            Ptr CString
jRefsToFetch' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jRefsToFetch
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jRefsToFetch'
    let flags' :: CUInt
flags' = [RepoPullFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [RepoPullFlags]
flags
    Ptr AsyncProgress
maybeProgress <- case Maybe b
progress of
        Nothing -> Ptr AsyncProgress -> IO (Ptr AsyncProgress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AsyncProgress
forall a. Ptr a
nullPtr
        Just jProgress :: b
jProgress -> do
            Ptr AsyncProgress
jProgress' <- b -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProgress
            Ptr AsyncProgress -> IO (Ptr AsyncProgress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AsyncProgress
jProgress'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> Ptr CString
-> CUInt
-> Ptr AsyncProgress
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_pull Ptr Repo
self' CString
remoteName' Ptr CString
maybeRefsToFetch CUInt
flags' Ptr AsyncProgress
maybeProgress Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
progress b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeRefsToFetch
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeRefsToFetch
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeRefsToFetch
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeRefsToFetch
     )

#if defined(ENABLE_OVERLOADING)
data RepoPullMethodInfo
instance (signature ~ (T.Text -> Maybe ([T.Text]) -> [OSTree.Flags.RepoPullFlags] -> Maybe (b) -> Maybe (c) -> m ()), MonadIO m, IsRepo a, OSTree.AsyncProgress.IsAsyncProgress b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoPullMethodInfo a signature where
    overloadedMethod = repoPull

#endif

-- method Repo::pull_from_remotes_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "results"
--           , argType =
--               TCArray
--                 True
--                 (-1)
--                 (-1)
--                 (TInterface
--                    Name { namespace = "OSTree" , name = "RepoFinderResult" })
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "%NULL-terminated array of remotes to\n   pull from, including the refs to pull from each"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A GVariant `a{sv}` with an extensible set of flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "an #OstreeAsyncProgress to update with the operation\8217s\n   progress, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "asynchronous completion callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "data to pass to @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_pull_from_remotes_async" ostree_repo_pull_from_remotes_async :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr (Ptr OSTree.RepoFinderResult.RepoFinderResult) -> -- results : TCArray True (-1) (-1) (TInterface (Name {namespace = "OSTree", name = "RepoFinderResult"}))
    Ptr GVariant ->                         -- options : TVariant
    Ptr OSTree.AsyncProgress.AsyncProgress -> -- progress : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Pull refs from multiple remotes which have been found using
-- 'GI.OSTree.Objects.Repo.repoFindRemotesAsync'.
-- 
-- /@results@/ are expected to be in priority order, with the best remotes to pull
-- from listed first. 'GI.OSTree.Objects.Repo.repoPullFromRemotesAsync' will generally pull
-- from the remotes in order, but may parallelise its downloads.
-- 
-- If an error is encountered when pulling from a given remote, that remote will
-- be ignored and another will be tried instead. If any refs have not been
-- downloaded successfully after all remotes have been tried, 'GI.Gio.Enums.IOErrorEnumFailed'
-- will be returned. The results of any successful downloads will remain cached
-- in the local repository.
-- 
-- If /@cancellable@/ is cancelled, 'GI.Gio.Enums.IOErrorEnumCancelled' will be returned
-- immediately. The results of any successfully completed downloads at that
-- point will remain cached in the local repository.
-- 
-- GPG verification of commits will be used unconditionally.
-- 
-- The following /@options@/ are currently defined:
-- 
--   * @flags@ (@i@): t'GI.OSTree.Flags.RepoPullFlags' to apply to the pull operation
--   * @inherit-transaction@ (@b@): 'P.True' to inherit an ongoing transaction on
--     the t'GI.OSTree.Objects.Repo.Repo', rather than encapsulating the pull in a new one
--   * @depth@ (@i@): How far in the history to traverse; default is 0, -1 means infinite
--   * @disable-static-deltas@ (@b@): Do not use static deltas
--   * @http-headers@ (@a(ss)@): Additional headers to add to all HTTP requests
--   * @subdirs@ (@as@): Pull just these subdirectories
--   * @update-frequency@ (@u@): Frequency to call the async progress callback in
--     milliseconds, if any; only values higher than 0 are valid
--   * @append-user-agent@ (@s@): Additional string to append to the user agent
--   * @n-network-retries@ (@u@): Number of times to retry each download on receiving
--     a transient network error, such as a socket timeout; default is 5, 0
--     means return errors without retrying. Since: 2018.6
--   * @ref-keyring-map@ (@a(sss)@): Array of (collection ID, ref name, keyring
--     remote name) tuples specifying which remote\'s keyring should be used when
--     doing GPG verification of each collection-ref. This is useful to prevent a
--     remote from serving malicious updates to refs which did not originate from
--     it. This can be a subset or superset of the refs being pulled; any ref
--     not being pulled will be ignored and any ref without a keyring remote
--     will be verified with the keyring of the remote being pulled from.
--     Since: 2019.2
-- 
-- /Since: 2018.6/
repoPullFromRemotesAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, OSTree.AsyncProgress.IsAsyncProgress b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> [OSTree.RepoFinderResult.RepoFinderResult]
    -- ^ /@results@/: 'P.Nothing'-terminated array of remotes to
    --    pull from, including the refs to pull from each
    -> Maybe (GVariant)
    -- ^ /@options@/: A GVariant @a{sv}@ with an extensible set of flags
    -> Maybe (b)
    -- ^ /@progress@/: an t'GI.OSTree.Objects.AsyncProgress.AsyncProgress' to update with the operation’s
    --    progress, or 'P.Nothing'
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: asynchronous completion callback
    -> m ()
repoPullFromRemotesAsync :: a
-> [RepoFinderResult]
-> Maybe GVariant
-> Maybe b
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
repoPullFromRemotesAsync self :: a
self results :: [RepoFinderResult]
results options :: Maybe GVariant
options progress :: Maybe b
progress cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    [Ptr RepoFinderResult]
results' <- (RepoFinderResult -> IO (Ptr RepoFinderResult))
-> [RepoFinderResult] -> IO [Ptr RepoFinderResult]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM RepoFinderResult -> IO (Ptr RepoFinderResult)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr [RepoFinderResult]
results
    Ptr (Ptr RepoFinderResult)
results'' <- [Ptr RepoFinderResult] -> IO (Ptr (Ptr RepoFinderResult))
forall a. [Ptr a] -> IO (Ptr (Ptr a))
packZeroTerminatedPtrArray [Ptr RepoFinderResult]
results'
    Ptr GVariant
maybeOptions <- case Maybe GVariant
options of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jOptions :: GVariant
jOptions -> do
            Ptr GVariant
jOptions' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jOptions
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jOptions'
    Ptr AsyncProgress
maybeProgress <- case Maybe b
progress of
        Nothing -> Ptr AsyncProgress -> IO (Ptr AsyncProgress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AsyncProgress
forall a. Ptr a
nullPtr
        Just jProgress :: b
jProgress -> do
            Ptr AsyncProgress
jProgress' <- b -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProgress
            Ptr AsyncProgress -> IO (Ptr AsyncProgress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AsyncProgress
jProgress'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Repo
-> Ptr (Ptr RepoFinderResult)
-> Ptr GVariant
-> Ptr AsyncProgress
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ostree_repo_pull_from_remotes_async Ptr Repo
self' Ptr (Ptr RepoFinderResult)
results'' Ptr GVariant
maybeOptions Ptr AsyncProgress
maybeProgress Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    (RepoFinderResult -> IO ()) -> [RepoFinderResult] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ RepoFinderResult -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr [RepoFinderResult]
results
    Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
options GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
progress b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    Ptr (Ptr RepoFinderResult) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr RepoFinderResult)
results''
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RepoPullFromRemotesAsyncMethodInfo
instance (signature ~ ([OSTree.RepoFinderResult.RepoFinderResult] -> Maybe (GVariant) -> Maybe (b) -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsRepo a, OSTree.AsyncProgress.IsAsyncProgress b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoPullFromRemotesAsyncMethodInfo a signature where
    overloadedMethod = repoPullFromRemotesAsync

#endif

-- method Repo::pull_from_remotes_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the asynchronous result"
--                 , 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_repo_pull_from_remotes_finish" ostree_repo_pull_from_remotes_finish :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Finish an asynchronous pull operation started with
-- 'GI.OSTree.Objects.Repo.repoPullFromRemotesAsync'.
-- 
-- /Since: 2018.6/
repoPullFromRemotesFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> b
    -- ^ /@result@/: the asynchronous result
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoPullFromRemotesFinish :: a -> b -> m ()
repoPullFromRemotesFinish self :: a
self result_ :: b
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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
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 Repo -> Ptr AsyncResult -> Ptr (Ptr GError) -> IO CInt
ostree_repo_pull_from_remotes_finish Ptr Repo
self' Ptr AsyncResult
result_'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
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 RepoPullFromRemotesFinishMethodInfo
instance (signature ~ (b -> m ()), MonadIO m, IsRepo a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo RepoPullFromRemotesFinishMethodInfo a signature where
    overloadedMethod = repoPullFromRemotesFinish

#endif

-- method Repo::pull_one_dir
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dir_to_pull"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Subdirectory path" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "refs_to_fetch"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Optional list of refs; if %NULL, fetch all configured refs"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "RepoPullFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Options controlling fetch behavior"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Progress" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_pull_one_dir" ostree_repo_pull_one_dir :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote_name : TBasicType TUTF8
    CString ->                              -- dir_to_pull : TBasicType TUTF8
    Ptr CString ->                          -- refs_to_fetch : TCArray True (-1) (-1) (TBasicType TUTF8)
    CUInt ->                                -- flags : TInterface (Name {namespace = "OSTree", name = "RepoPullFlags"})
    Ptr OSTree.AsyncProgress.AsyncProgress -> -- progress : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | This is similar to 'GI.OSTree.Objects.Repo.repoPull', but only fetches a single
-- subpath.
repoPullOneDir ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, OSTree.AsyncProgress.IsAsyncProgress b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@remoteName@/: Name of remote
    -> T.Text
    -- ^ /@dirToPull@/: Subdirectory path
    -> Maybe ([T.Text])
    -- ^ /@refsToFetch@/: Optional list of refs; if 'P.Nothing', fetch all configured refs
    -> [OSTree.Flags.RepoPullFlags]
    -- ^ /@flags@/: Options controlling fetch behavior
    -> Maybe (b)
    -- ^ /@progress@/: Progress
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoPullOneDir :: a
-> Text
-> Text
-> Maybe [Text]
-> [RepoPullFlags]
-> Maybe b
-> Maybe c
-> m ()
repoPullOneDir self :: a
self remoteName :: Text
remoteName dirToPull :: Text
dirToPull refsToFetch :: Maybe [Text]
refsToFetch flags :: [RepoPullFlags]
flags progress :: Maybe b
progress cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
remoteName' <- Text -> IO CString
textToCString Text
remoteName
    CString
dirToPull' <- Text -> IO CString
textToCString Text
dirToPull
    Ptr CString
maybeRefsToFetch <- case Maybe [Text]
refsToFetch of
        Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just jRefsToFetch :: [Text]
jRefsToFetch -> do
            Ptr CString
jRefsToFetch' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jRefsToFetch
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jRefsToFetch'
    let flags' :: CUInt
flags' = [RepoPullFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [RepoPullFlags]
flags
    Ptr AsyncProgress
maybeProgress <- case Maybe b
progress of
        Nothing -> Ptr AsyncProgress -> IO (Ptr AsyncProgress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AsyncProgress
forall a. Ptr a
nullPtr
        Just jProgress :: b
jProgress -> do
            Ptr AsyncProgress
jProgress' <- b -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProgress
            Ptr AsyncProgress -> IO (Ptr AsyncProgress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AsyncProgress
jProgress'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> CString
-> Ptr CString
-> CUInt
-> Ptr AsyncProgress
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_pull_one_dir Ptr Repo
self' CString
remoteName' CString
dirToPull' Ptr CString
maybeRefsToFetch CUInt
flags' Ptr AsyncProgress
maybeProgress Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
progress b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
dirToPull'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeRefsToFetch
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeRefsToFetch
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
dirToPull'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeRefsToFetch
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeRefsToFetch
     )

#if defined(ENABLE_OVERLOADING)
data RepoPullOneDirMethodInfo
instance (signature ~ (T.Text -> T.Text -> Maybe ([T.Text]) -> [OSTree.Flags.RepoPullFlags] -> Maybe (b) -> Maybe (c) -> m ()), MonadIO m, IsRepo a, OSTree.AsyncProgress.IsAsyncProgress b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoPullOneDirMethodInfo a signature where
    overloadedMethod = repoPullOneDir

#endif

-- method Repo::pull_with_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote_name_or_baseurl"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote or file:// url"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A GVariant a{sv} with an extensible set of flags."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "progress"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Progress" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_pull_with_options" ostree_repo_pull_with_options :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote_name_or_baseurl : TBasicType TUTF8
    Ptr GVariant ->                         -- options : TVariant
    Ptr OSTree.AsyncProgress.AsyncProgress -> -- progress : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Like 'GI.OSTree.Objects.Repo.repoPull', but supports an extensible set of flags.
-- The following are currently defined:
-- 
--   * refs (as): Array of string refs
--   * collection-refs (a(sss)): Array of (collection ID, ref name, checksum) tuples to pull;
--     mutually exclusive with @refs@ and @override-commit-ids@. Checksums may be the empty
--     string to pull the latest commit for that ref
--   * flags (i): An instance of t'GI.OSTree.Flags.RepoPullFlags'
--   * subdir (s): Pull just this subdirectory
--   * subdirs (as): Pull just these subdirectories
--   * override-remote-name (s): If local, add this remote to refspec
--   * gpg-verify (b): GPG verify commits
--   * gpg-verify-summary (b): GPG verify summary
--   * depth (i): How far in the history to traverse; default is 0, -1 means infinite
--   * disable-static-deltas (b): Do not use static deltas
--   * require-static-deltas (b): Require static deltas
--   * override-commit-ids (as): Array of specific commit IDs to fetch for refs
--   * timestamp-check (b): Verify commit timestamps are newer than current (when pulling via ref); Since: 2017.11
--   * metadata-size-restriction (t): Restrict metadata objects to a maximum number of bytes; 0 to disable.  Since: 2018.9
--   * dry-run (b): Only print information on what will be downloaded (requires static deltas)
--   * override-url (s): Fetch objects from this URL if remote specifies no metalink in options
--   * inherit-transaction (b): Don\'t initiate, finish or abort a transaction, useful to do multiple pulls in one transaction.
--   * http-headers (a(ss)): Additional headers to add to all HTTP requests
--   * update-frequency (u): Frequency to call the async progress callback in milliseconds, if any; only values higher than 0 are valid
--   * localcache-repos (as): File paths for local repos to use as caches when doing remote fetches
--   * append-user-agent (s): Additional string to append to the user agent
--   * n-network-retries (u): Number of times to retry each download on receiving
--     a transient network error, such as a socket timeout; default is 5, 0
--     means return errors without retrying. Since: 2018.6
--   * ref-keyring-map (a(sss)): Array of (collection ID, ref name, keyring
--     remote name) tuples specifying which remote\'s keyring should be used when
--     doing GPG verification of each collection-ref. This is useful to prevent a
--     remote from serving malicious updates to refs which did not originate from
--     it. This can be a subset or superset of the refs being pulled; any ref
--     not being pulled will be ignored and any ref without a keyring remote
--     will be verified with the keyring of the remote being pulled from.
--     Since: 2019.2
repoPullWithOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, OSTree.AsyncProgress.IsAsyncProgress b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@remoteNameOrBaseurl@/: Name of remote or file:\/\/ url
    -> GVariant
    -- ^ /@options@/: A GVariant a{sv} with an extensible set of flags.
    -> Maybe (b)
    -- ^ /@progress@/: Progress
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoPullWithOptions :: a -> Text -> GVariant -> Maybe b -> Maybe c -> m ()
repoPullWithOptions self :: a
self remoteNameOrBaseurl :: Text
remoteNameOrBaseurl options :: GVariant
options progress :: Maybe b
progress cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
remoteNameOrBaseurl' <- Text -> IO CString
textToCString Text
remoteNameOrBaseurl
    Ptr GVariant
options' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
options
    Ptr AsyncProgress
maybeProgress <- case Maybe b
progress of
        Nothing -> Ptr AsyncProgress -> IO (Ptr AsyncProgress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AsyncProgress
forall a. Ptr a
nullPtr
        Just jProgress :: b
jProgress -> do
            Ptr AsyncProgress
jProgress' <- b -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jProgress
            Ptr AsyncProgress -> IO (Ptr AsyncProgress)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr AsyncProgress
jProgress'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> Ptr GVariant
-> Ptr AsyncProgress
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_pull_with_options Ptr Repo
self' CString
remoteNameOrBaseurl' Ptr GVariant
options' Ptr AsyncProgress
maybeProgress Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
options
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
progress b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteNameOrBaseurl'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteNameOrBaseurl'
     )

#if defined(ENABLE_OVERLOADING)
data RepoPullWithOptionsMethodInfo
instance (signature ~ (T.Text -> GVariant -> Maybe (b) -> Maybe (c) -> m ()), MonadIO m, IsRepo a, OSTree.AsyncProgress.IsAsyncProgress b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoPullWithOptionsMethodInfo a signature where
    overloadedMethod = repoPullWithOptions

#endif

-- method Repo::query_object_storage_size
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sha256"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Checksum" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_size"
--           , argType = TBasicType TUInt64
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Size in bytes object occupies physically"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_query_object_storage_size" ostree_repo_query_object_storage_size :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- sha256 : TBasicType TUTF8
    Ptr Word64 ->                           -- out_size : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Return the size in bytes of object with checksum /@sha256@/, after any
-- compression has been applied.
repoQueryObjectStorageSize ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> T.Text
    -- ^ /@sha256@/: Checksum
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m (Word64)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoQueryObjectStorageSize :: a -> ObjectType -> Text -> Maybe b -> m Word64
repoQueryObjectStorageSize self :: a
self objtype :: ObjectType
objtype sha256 :: Text
sha256 cancellable :: Maybe b
cancellable = IO Word64 -> m Word64
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word64 -> m Word64) -> IO Word64 -> m Word64
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
sha256' <- Text -> IO CString
textToCString Text
sha256
    Ptr Word64
outSize <- IO (Ptr Word64)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word64)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Word64 -> IO () -> IO Word64
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 Repo
-> CUInt
-> CString
-> Ptr Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_query_object_storage_size Ptr Repo
self' CUInt
objtype' CString
sha256' Ptr Word64
outSize Ptr Cancellable
maybeCancellable
        Word64
outSize' <- Ptr Word64 -> IO Word64
forall a. Storable a => Ptr a -> IO a
peek Ptr Word64
outSize
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sha256'
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outSize
        Word64 -> IO Word64
forall (m :: * -> *) a. Monad m => a -> m a
return Word64
outSize'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
sha256'
        Ptr Word64 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word64
outSize
     )

#if defined(ENABLE_OVERLOADING)
data RepoQueryObjectStorageSizeMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> T.Text -> Maybe (b) -> m (Word64)), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoQueryObjectStorageSizeMethodInfo a signature where
    overloadedMethod = repoQueryObjectStorageSize

#endif

-- method Repo::read_commit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Ref or ASCII checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_root"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepoFile corresponding to the root"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_commit"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The resolved commit checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_read_commit" ostree_repo_read_commit :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- ref : TBasicType TUTF8
    Ptr (Ptr Gio.File.File) ->              -- out_root : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr CString ->                          -- out_commit : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Load the content for /@rev@/ into /@outRoot@/.
repoReadCommit ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@ref@/: Ref or ASCII checksum
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ((Gio.File.File, T.Text))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoReadCommit :: a -> Text -> Maybe b -> m (File, Text)
repoReadCommit self :: a
self ref :: Text
ref cancellable :: Maybe b
cancellable = IO (File, Text) -> m (File, Text)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (File, Text) -> m (File, Text))
-> IO (File, Text) -> m (File, Text)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
ref' <- Text -> IO CString
textToCString Text
ref
    Ptr (Ptr File)
outRoot <- IO (Ptr (Ptr File))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gio.File.File))
    Ptr CString
outCommit <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (File, Text) -> IO () -> IO (File, Text)
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 Repo
-> CString
-> Ptr (Ptr File)
-> Ptr CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_read_commit Ptr Repo
self' CString
ref' Ptr (Ptr File)
outRoot Ptr CString
outCommit Ptr Cancellable
maybeCancellable
        Ptr File
outRoot' <- Ptr (Ptr File) -> IO (Ptr File)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr File)
outRoot
        File
outRoot'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
outRoot'
        CString
outCommit' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outCommit
        Text
outCommit'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outCommit'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
outCommit'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
ref'
        Ptr (Ptr File) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr File)
outRoot
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outCommit
        (File, Text) -> IO (File, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (File
outRoot'', Text
outCommit'')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
ref'
        Ptr (Ptr File) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr File)
outRoot
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outCommit
     )

#if defined(ENABLE_OVERLOADING)
data RepoReadCommitMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ((Gio.File.File, T.Text))), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoReadCommitMethodInfo a signature where
    overloadedMethod = repoReadCommit

#endif

-- method Repo::read_commit_detached_metadata
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII SHA256 commit checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_metadata"
--           , argType = TVariant
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Metadata associated with commit in with format \"a{sv}\", or %NULL if none exists"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_read_commit_detached_metadata" ostree_repo_read_commit_detached_metadata :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr (Ptr GVariant) ->                   -- out_metadata : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | OSTree commits can have arbitrary metadata associated; this
-- function retrieves them.  If none exists, /@outMetadata@/ will be set
-- to 'P.Nothing'.
repoReadCommitDetachedMetadata ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@checksum@/: ASCII SHA256 commit checksum
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m (GVariant)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoReadCommitDetachedMetadata :: a -> Text -> Maybe b -> m GVariant
repoReadCommitDetachedMetadata self :: a
self checksum :: Text
checksum cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    Ptr (Ptr GVariant)
outMetadata <- IO (Ptr (Ptr GVariant))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GVariant))
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO GVariant -> IO () -> IO GVariant
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 Repo
-> CString
-> Ptr (Ptr GVariant)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_read_commit_detached_metadata Ptr Repo
self' CString
checksum' Ptr (Ptr GVariant)
outMetadata Ptr Cancellable
maybeCancellable
        Ptr GVariant
outMetadata' <- Ptr (Ptr GVariant) -> IO (Ptr GVariant)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr GVariant)
outMetadata
        GVariant
outMetadata'' <- Ptr GVariant -> IO GVariant
B.GVariant.wrapGVariantPtr Ptr GVariant
outMetadata'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outMetadata
        GVariant -> IO GVariant
forall (m :: * -> *) a. Monad m => a -> m a
return GVariant
outMetadata''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        Ptr (Ptr GVariant) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr GVariant)
outMetadata
     )

#if defined(ENABLE_OVERLOADING)
data RepoReadCommitDetachedMetadataMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m (GVariant)), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoReadCommitDetachedMetadataMethodInfo a signature where
    overloadedMethod = repoReadCommitDetachedMetadata

#endif

-- method Repo::regenerate_summary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "additional_metadata"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A GVariant of type a{sv}, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_regenerate_summary" ostree_repo_regenerate_summary :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr GVariant ->                         -- additional_metadata : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | An OSTree repository can contain a high level \"summary\" file that
-- describes the available branches and other metadata.
-- 
-- If the timetable for making commits and updating the summary file is fairly
-- regular, setting the @ostree.summary.expires@ key in /@additionalMetadata@/
-- will aid clients in working out when to check for updates.
-- 
-- It is regenerated automatically after any ref is
-- added, removed, or updated if @core\/auto-update-summary@ is set.
-- 
-- If the @core\/collection-id@ key is set in the configuration, it will be
-- included as @/OSTREE_SUMMARY_COLLECTION_ID/@ in the summary file. Refs that
-- have associated collection IDs will be included in the generated summary
-- file, listed under the @/OSTREE_SUMMARY_COLLECTION_MAP/@ key. Collection IDs
-- and refs in @/OSTREE_SUMMARY_COLLECTION_MAP/@ are guaranteed to be in
-- lexicographic order.
-- 
-- Locking: exclusive
repoRegenerateSummary ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> Maybe (GVariant)
    -- ^ /@additionalMetadata@/: A GVariant of type a{sv}, or 'P.Nothing'
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoRegenerateSummary :: a -> Maybe GVariant -> Maybe b -> m ()
repoRegenerateSummary self :: a
self additionalMetadata :: Maybe GVariant
additionalMetadata cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr GVariant
maybeAdditionalMetadata <- case Maybe GVariant
additionalMetadata of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jAdditionalMetadata :: GVariant
jAdditionalMetadata -> do
            Ptr GVariant
jAdditionalMetadata' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jAdditionalMetadata
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jAdditionalMetadata'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Ptr GVariant -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_repo_regenerate_summary Ptr Repo
self' Ptr GVariant
maybeAdditionalMetadata Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
additionalMetadata GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoRegenerateSummaryMethodInfo
instance (signature ~ (Maybe (GVariant) -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoRegenerateSummaryMethodInfo a signature where
    overloadedMethod = repoRegenerateSummary

#endif

-- method Repo::reload_config
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "cancellable" , 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_repo_reload_config" ostree_repo_reload_config :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | By default, an t'GI.OSTree.Objects.Repo.Repo' will cache the remote configuration and its
-- own repo\/config data.  This API can be used to reload it.
repoReloadConfig ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: repo
    -> Maybe (b)
    -- ^ /@cancellable@/: cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoReloadConfig :: a -> Maybe b -> m ()
repoReloadConfig self :: a
self cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_repo_reload_config Ptr Repo
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoReloadConfigMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoReloadConfigMethodInfo a signature where
    overloadedMethod = repoReloadConfig

#endif

-- method Repo::remote_add
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "url"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "URL for remote (if URL begins with metalink=, it will be used as such)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GVariant of type a{sv}"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_remote_add" ostree_repo_remote_add :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- url : TBasicType TUTF8
    Ptr GVariant ->                         -- options : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Create a new remote named /@name@/ pointing to /@url@/.  If /@options@/ is
-- provided, then it will be mapped to t'GI.GLib.Structs.KeyFile.KeyFile' entries, where the
-- GVariant dictionary key is an option string, and the value is
-- mapped as follows:
--   * s: 'GI.GLib.Structs.KeyFile.keyFileSetString'
--   * b: 'GI.GLib.Structs.KeyFile.keyFileSetBoolean'
--   * as: 'GI.GLib.Structs.KeyFile.keyFileSetStringList'
repoRemoteAdd ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@name@/: Name of remote
    -> T.Text
    -- ^ /@url@/: URL for remote (if URL begins with metalink=, it will be used as such)
    -> Maybe (GVariant)
    -- ^ /@options@/: GVariant of type a{sv}
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoRemoteAdd :: a -> Text -> Text -> Maybe GVariant -> Maybe b -> m ()
repoRemoteAdd self :: a
self name :: Text
name url :: Text
url options :: Maybe GVariant
options cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
url' <- Text -> IO CString
textToCString Text
url
    Ptr GVariant
maybeOptions <- case Maybe GVariant
options of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jOptions :: GVariant
jOptions -> do
            Ptr GVariant
jOptions' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jOptions
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jOptions'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> CString
-> Ptr GVariant
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_remote_add Ptr Repo
self' CString
name' CString
url' Ptr GVariant
maybeOptions Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
options GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
url'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
url'
     )

#if defined(ENABLE_OVERLOADING)
data RepoRemoteAddMethodInfo
instance (signature ~ (T.Text -> T.Text -> Maybe (GVariant) -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoRemoteAddMethodInfo a signature where
    overloadedMethod = repoRemoteAdd

#endif

-- method Repo::remote_change
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "sysroot"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "System root" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "changeop"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoRemoteChange" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Operation to perform"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "url"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "URL for remote (if URL begins with metalink=, it will be used as such)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GVariant of type a{sv}"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_remote_change" ostree_repo_remote_change :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.File.File ->                    -- sysroot : TInterface (Name {namespace = "Gio", name = "File"})
    CUInt ->                                -- changeop : TInterface (Name {namespace = "OSTree", name = "RepoRemoteChange"})
    CString ->                              -- name : TBasicType TUTF8
    CString ->                              -- url : TBasicType TUTF8
    Ptr GVariant ->                         -- options : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | A combined function handling the equivalent of
-- 'GI.OSTree.Objects.Repo.repoRemoteAdd', 'GI.OSTree.Objects.Repo.repoRemoteDelete', with more
-- options.
repoRemoteChange ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> Maybe (b)
    -- ^ /@sysroot@/: System root
    -> OSTree.Enums.RepoRemoteChange
    -- ^ /@changeop@/: Operation to perform
    -> T.Text
    -- ^ /@name@/: Name of remote
    -> T.Text
    -- ^ /@url@/: URL for remote (if URL begins with metalink=, it will be used as such)
    -> Maybe (GVariant)
    -- ^ /@options@/: GVariant of type a{sv}
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoRemoteChange :: a
-> Maybe b
-> RepoRemoteChange
-> Text
-> Text
-> Maybe GVariant
-> Maybe c
-> m ()
repoRemoteChange self :: a
self sysroot :: Maybe b
sysroot changeop :: RepoRemoteChange
changeop name :: Text
name url :: Text
url options :: Maybe GVariant
options cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
maybeSysroot <- case Maybe b
sysroot of
        Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just jSysroot :: b
jSysroot -> do
            Ptr File
jSysroot' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSysroot
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jSysroot'
    let changeop' :: CUInt
changeop' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (RepoRemoteChange -> Int) -> RepoRemoteChange -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoRemoteChange -> Int
forall a. Enum a => a -> Int
fromEnum) RepoRemoteChange
changeop
    CString
name' <- Text -> IO CString
textToCString Text
name
    CString
url' <- Text -> IO CString
textToCString Text
url
    Ptr GVariant
maybeOptions <- case Maybe GVariant
options of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jOptions :: GVariant
jOptions -> do
            Ptr GVariant
jOptions' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jOptions
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jOptions'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Ptr File
-> CUInt
-> CString
-> CString
-> Ptr GVariant
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_remote_change Ptr Repo
self' Ptr File
maybeSysroot CUInt
changeop' CString
name' CString
url' Ptr GVariant
maybeOptions Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
sysroot b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
options GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
url'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
url'
     )

#if defined(ENABLE_OVERLOADING)
data RepoRemoteChangeMethodInfo
instance (signature ~ (Maybe (b) -> OSTree.Enums.RepoRemoteChange -> T.Text -> T.Text -> Maybe (GVariant) -> Maybe (c) -> m ()), MonadIO m, IsRepo a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoRemoteChangeMethodInfo a signature where
    overloadedMethod = repoRemoteChange

#endif

-- method Repo::remote_delete
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_remote_delete" ostree_repo_remote_delete :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Delete the remote named /@name@/.  It is an error if the provided
-- remote does not exist.
repoRemoteDelete ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@name@/: Name of remote
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoRemoteDelete :: a -> Text -> Maybe b -> m ()
repoRemoteDelete self :: a
self name :: Text
name cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_repo_remote_delete Ptr Repo
self' CString
name' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
     )

#if defined(ENABLE_OVERLOADING)
data RepoRemoteDeleteMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoRemoteDeleteMethodInfo a signature where
    overloadedMethod = repoRemoteDelete

#endif

-- method Repo::remote_fetch_summary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of a remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_summary"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for raw summary data, or\n              %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_signatures"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for raw summary\n                 signature data, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , 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_repo_remote_fetch_summary" ostree_repo_remote_fetch_summary :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr (Ptr GLib.Bytes.Bytes) ->           -- out_summary : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr (Ptr GLib.Bytes.Bytes) ->           -- out_signatures : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Tries to fetch the summary file and any GPG signatures on the summary file
-- over HTTP, and returns the binary data in /@outSummary@/ and /@outSignatures@/
-- respectively.
-- 
-- If no summary file exists on the remote server, /@outSummary@/ is set to
-- /@nULL@/.  Likewise if the summary file is not signed, /@outSignatures@/ is
-- set to /@nULL@/.  In either case the function still returns 'P.True'.
-- 
-- This method does not verify the signature of the downloaded summary file.
-- Use 'GI.OSTree.Objects.Repo.repoVerifySummary' for that.
-- 
-- Parse the summary data into a t'GVariant' using 'GI.GLib.Structs.Variant.variantNewFromBytes'
-- with @/OSTREE_SUMMARY_GVARIANT_FORMAT/@ as the format string.
repoRemoteFetchSummary ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Self
    -> T.Text
    -- ^ /@name@/: name of a remote
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m ((GLib.Bytes.Bytes, GLib.Bytes.Bytes))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoRemoteFetchSummary :: a -> Text -> Maybe b -> m (Bytes, Bytes)
repoRemoteFetchSummary self :: a
self name :: Text
name cancellable :: Maybe b
cancellable = IO (Bytes, Bytes) -> m (Bytes, Bytes)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bytes, Bytes) -> m (Bytes, Bytes))
-> IO (Bytes, Bytes) -> m (Bytes, Bytes)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr (Ptr Bytes)
outSummary <- IO (Ptr (Ptr Bytes))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GLib.Bytes.Bytes))
    Ptr (Ptr Bytes)
outSignatures <- IO (Ptr (Ptr Bytes))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GLib.Bytes.Bytes))
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Bytes, Bytes) -> IO () -> IO (Bytes, Bytes)
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 Repo
-> CString
-> Ptr (Ptr Bytes)
-> Ptr (Ptr Bytes)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_remote_fetch_summary Ptr Repo
self' CString
name' Ptr (Ptr Bytes)
outSummary Ptr (Ptr Bytes)
outSignatures Ptr Cancellable
maybeCancellable
        Ptr Bytes
outSummary' <- Ptr (Ptr Bytes) -> IO (Ptr Bytes)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Bytes)
outSummary
        Bytes
outSummary'' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
outSummary'
        Ptr Bytes
outSignatures' <- Ptr (Ptr Bytes) -> IO (Ptr Bytes)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Bytes)
outSignatures
        Bytes
outSignatures'' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
outSignatures'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr (Ptr Bytes) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Bytes)
outSummary
        Ptr (Ptr Bytes) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Bytes)
outSignatures
        (Bytes, Bytes) -> IO (Bytes, Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
outSummary'', Bytes
outSignatures'')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr (Ptr Bytes) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Bytes)
outSummary
        Ptr (Ptr Bytes) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Bytes)
outSignatures
     )

#if defined(ENABLE_OVERLOADING)
data RepoRemoteFetchSummaryMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m ((GLib.Bytes.Bytes, GLib.Bytes.Bytes))), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoRemoteFetchSummaryMethodInfo a signature where
    overloadedMethod = repoRemoteFetchSummary

#endif

-- method Repo::remote_fetch_summary_with_options
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of a remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A GVariant a{sv} with an extensible set of flags"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_summary"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for raw summary data, or\n              %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "out_signatures"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for raw summary\n                 signature data, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , 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_repo_remote_fetch_summary_with_options" ostree_repo_remote_fetch_summary_with_options :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr GVariant ->                         -- options : TVariant
    Ptr (Ptr GLib.Bytes.Bytes) ->           -- out_summary : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr (Ptr GLib.Bytes.Bytes) ->           -- out_signatures : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Like 'GI.OSTree.Objects.Repo.repoRemoteFetchSummary', but supports an extensible set of flags.
-- The following are currently defined:
-- 
-- * override-url (s): Fetch summary from this URL if remote specifies no metalink in options
-- * http-headers (a(ss)): Additional headers to add to all HTTP requests
-- * append-user-agent (s): Additional string to append to the user agent
-- * n-network-retries (u): Number of times to retry each download on receiving
-- a transient network error, such as a socket timeout; default is 5, 0
-- means return errors without retrying
repoRemoteFetchSummaryWithOptions ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Self
    -> T.Text
    -- ^ /@name@/: name of a remote
    -> Maybe (GVariant)
    -- ^ /@options@/: A GVariant a{sv} with an extensible set of flags
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m ((GLib.Bytes.Bytes, GLib.Bytes.Bytes))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoRemoteFetchSummaryWithOptions :: a -> Text -> Maybe GVariant -> Maybe b -> m (Bytes, Bytes)
repoRemoteFetchSummaryWithOptions self :: a
self name :: Text
name options :: Maybe GVariant
options cancellable :: Maybe b
cancellable = IO (Bytes, Bytes) -> m (Bytes, Bytes)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Bytes, Bytes) -> m (Bytes, Bytes))
-> IO (Bytes, Bytes) -> m (Bytes, Bytes)
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr GVariant
maybeOptions <- case Maybe GVariant
options of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jOptions :: GVariant
jOptions -> do
            Ptr GVariant
jOptions' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jOptions
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jOptions'
    Ptr (Ptr Bytes)
outSummary <- IO (Ptr (Ptr Bytes))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GLib.Bytes.Bytes))
    Ptr (Ptr Bytes)
outSignatures <- IO (Ptr (Ptr Bytes))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr GLib.Bytes.Bytes))
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Bytes, Bytes) -> IO () -> IO (Bytes, Bytes)
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 Repo
-> CString
-> Ptr GVariant
-> Ptr (Ptr Bytes)
-> Ptr (Ptr Bytes)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_remote_fetch_summary_with_options Ptr Repo
self' CString
name' Ptr GVariant
maybeOptions Ptr (Ptr Bytes)
outSummary Ptr (Ptr Bytes)
outSignatures Ptr Cancellable
maybeCancellable
        Ptr Bytes
outSummary' <- Ptr (Ptr Bytes) -> IO (Ptr Bytes)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Bytes)
outSummary
        Bytes
outSummary'' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
outSummary'
        Ptr Bytes
outSignatures' <- Ptr (Ptr Bytes) -> IO (Ptr Bytes)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Bytes)
outSignatures
        Bytes
outSignatures'' <- ((ManagedPtr Bytes -> Bytes) -> Ptr Bytes -> IO Bytes
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Bytes -> Bytes
GLib.Bytes.Bytes) Ptr Bytes
outSignatures'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
options GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr (Ptr Bytes) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Bytes)
outSummary
        Ptr (Ptr Bytes) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Bytes)
outSignatures
        (Bytes, Bytes) -> IO (Bytes, Bytes)
forall (m :: * -> *) a. Monad m => a -> m a
return (Bytes
outSummary'', Bytes
outSignatures'')
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr (Ptr Bytes) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Bytes)
outSummary
        Ptr (Ptr Bytes) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Bytes)
outSignatures
     )

#if defined(ENABLE_OVERLOADING)
data RepoRemoteFetchSummaryWithOptionsMethodInfo
instance (signature ~ (T.Text -> Maybe (GVariant) -> Maybe (b) -> m ((GLib.Bytes.Bytes, GLib.Bytes.Bytes))), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoRemoteFetchSummaryWithOptionsMethodInfo a signature where
    overloadedMethod = repoRemoteFetchSummaryWithOptions

#endif

-- method Repo::remote_get_gpg_verify
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_gpg_verify"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Remote's GPG option"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_remote_get_gpg_verify" ostree_repo_remote_get_gpg_verify :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr CInt ->                             -- out_gpg_verify : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Return whether GPG verification is enabled for the remote named /@name@/
-- through /@outGpgVerify@/.  It is an error if the provided remote does
-- not exist.
repoRemoteGetGpgVerify ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@name@/: Name of remote
    -> m (Bool)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoRemoteGetGpgVerify :: a -> Text -> m Bool
repoRemoteGetGpgVerify self :: a
self name :: Text
name = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CInt
outGpgVerify <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO Bool -> IO () -> IO Bool
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 Repo -> CString -> Ptr CInt -> Ptr (Ptr GError) -> IO CInt
ostree_repo_remote_get_gpg_verify Ptr Repo
self' CString
name' Ptr CInt
outGpgVerify
        CInt
outGpgVerify' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
outGpgVerify
        let outGpgVerify'' :: Bool
outGpgVerify'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
outGpgVerify'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outGpgVerify
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
outGpgVerify''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outGpgVerify
     )

#if defined(ENABLE_OVERLOADING)
data RepoRemoteGetGpgVerifyMethodInfo
instance (signature ~ (T.Text -> m (Bool)), MonadIO m, IsRepo a) => O.MethodInfo RepoRemoteGetGpgVerifyMethodInfo a signature where
    overloadedMethod = repoRemoteGetGpgVerify

#endif

-- method Repo::remote_get_gpg_verify_summary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_gpg_verify_summary"
--           , argType = TBasicType TBoolean
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Remote's GPG option"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_remote_get_gpg_verify_summary" ostree_repo_remote_get_gpg_verify_summary :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr CInt ->                             -- out_gpg_verify_summary : TBasicType TBoolean
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Return whether GPG verification of the summary is enabled for the remote
-- named /@name@/ through /@outGpgVerifySummary@/.  It is an error if the provided
-- remote does not exist.
repoRemoteGetGpgVerifySummary ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@name@/: Name of remote
    -> m (Bool)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoRemoteGetGpgVerifySummary :: a -> Text -> m Bool
repoRemoteGetGpgVerifySummary self :: a
self name :: Text
name = IO Bool -> m Bool
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> m Bool) -> IO Bool -> m Bool
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CInt
outGpgVerifySummary <- IO (Ptr CInt)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CInt)
    IO Bool -> IO () -> IO Bool
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 Repo -> CString -> Ptr CInt -> Ptr (Ptr GError) -> IO CInt
ostree_repo_remote_get_gpg_verify_summary Ptr Repo
self' CString
name' Ptr CInt
outGpgVerifySummary
        CInt
outGpgVerifySummary' <- Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
outGpgVerifySummary
        let outGpgVerifySummary'' :: Bool
outGpgVerifySummary'' = (CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= 0) CInt
outGpgVerifySummary'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outGpgVerifySummary
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
outGpgVerifySummary''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr CInt -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CInt
outGpgVerifySummary
     )

#if defined(ENABLE_OVERLOADING)
data RepoRemoteGetGpgVerifySummaryMethodInfo
instance (signature ~ (T.Text -> m (Bool)), MonadIO m, IsRepo a) => O.MethodInfo RepoRemoteGetGpgVerifySummaryMethodInfo a signature where
    overloadedMethod = repoRemoteGetGpgVerifySummary

#endif

-- method Repo::remote_get_url
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_url"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Remote's URL" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_remote_get_url" ostree_repo_remote_get_url :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr CString ->                          -- out_url : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Return the URL of the remote named /@name@/ through /@outUrl@/.  It is an
-- error if the provided remote does not exist.
repoRemoteGetUrl ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@name@/: Name of remote
    -> m (T.Text)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoRemoteGetUrl :: a -> Text -> m Text
repoRemoteGetUrl self :: a
self name :: Text
name = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr CString
outUrl <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    IO Text -> IO () -> IO Text
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 Repo -> CString -> Ptr CString -> Ptr (Ptr GError) -> IO CInt
ostree_repo_remote_get_url Ptr Repo
self' CString
name' Ptr CString
outUrl
        CString
outUrl' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outUrl
        Text
outUrl'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outUrl'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
outUrl'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outUrl
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
outUrl''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outUrl
     )

#if defined(ENABLE_OVERLOADING)
data RepoRemoteGetUrlMethodInfo
instance (signature ~ (T.Text -> m (T.Text)), MonadIO m, IsRepo a) => O.MethodInfo RepoRemoteGetUrlMethodInfo a signature where
    overloadedMethod = repoRemoteGetUrl

#endif

-- method Repo::remote_gpg_import
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "name of a remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "source_stream"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GInputStream, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "key_ids"
--           , argType = TCArray True (-1) (-1) (TBasicType TUTF8)
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "a %NULL-terminated array of GPG key IDs, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_imported"
--           , argType = TBasicType TUInt
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for the number of imported\n                             keys, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , 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_repo_remote_gpg_import" ostree_repo_remote_gpg_import :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- name : TBasicType TUTF8
    Ptr Gio.InputStream.InputStream ->      -- source_stream : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Ptr CString ->                          -- key_ids : TCArray True (-1) (-1) (TBasicType TUTF8)
    Word32 ->                               -- out_imported : TBasicType TUInt
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Imports one or more GPG keys from the open /@sourceStream@/, or from the
-- user\'s personal keyring if /@sourceStream@/ is 'P.Nothing'.  The /@keyIds@/ array
-- can optionally restrict which keys are imported.  If /@keyIds@/ is 'P.Nothing',
-- then all keys are imported.
-- 
-- The imported keys will be used to conduct GPG verification when pulling
-- from the remote named /@name@/.
repoRemoteGpgImport ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Self
    -> T.Text
    -- ^ /@name@/: name of a remote
    -> Maybe (b)
    -- ^ /@sourceStream@/: a t'GI.Gio.Objects.InputStream.InputStream', or 'P.Nothing'
    -> Maybe ([T.Text])
    -- ^ /@keyIds@/: a 'P.Nothing'-terminated array of GPG key IDs, or 'P.Nothing'
    -> Word32
    -- ^ /@outImported@/: return location for the number of imported
    --                              keys, or 'P.Nothing'
    -> Maybe (c)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoRemoteGpgImport :: a -> Text -> Maybe b -> Maybe [Text] -> Word32 -> Maybe c -> m ()
repoRemoteGpgImport self :: a
self name :: Text
name sourceStream :: Maybe b
sourceStream keyIds :: Maybe [Text]
keyIds outImported :: Word32
outImported cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
name' <- Text -> IO CString
textToCString Text
name
    Ptr InputStream
maybeSourceStream <- case Maybe b
sourceStream of
        Nothing -> Ptr InputStream -> IO (Ptr InputStream)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr InputStream
forall a. Ptr a
nullPtr
        Just jSourceStream :: b
jSourceStream -> do
            Ptr InputStream
jSourceStream' <- b -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jSourceStream
            Ptr InputStream -> IO (Ptr InputStream)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr InputStream
jSourceStream'
    Ptr CString
maybeKeyIds <- case Maybe [Text]
keyIds of
        Nothing -> Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
forall a. Ptr a
nullPtr
        Just jKeyIds :: [Text]
jKeyIds -> do
            Ptr CString
jKeyIds' <- [Text] -> IO (Ptr CString)
packZeroTerminatedUTF8CArray [Text]
jKeyIds
            Ptr CString -> IO (Ptr CString)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr CString
jKeyIds'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> Ptr InputStream
-> Ptr CString
-> Word32
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_remote_gpg_import Ptr Repo
self' CString
name' Ptr InputStream
maybeSourceStream Ptr CString
maybeKeyIds Word32
outImported Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
sourceStream b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeKeyIds
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeKeyIds
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
name'
        (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeKeyIds
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
maybeKeyIds
     )

#if defined(ENABLE_OVERLOADING)
data RepoRemoteGpgImportMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe ([T.Text]) -> Word32 -> Maybe (c) -> m ()), MonadIO m, IsRepo a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoRemoteGpgImportMethodInfo a signature where
    overloadedMethod = repoRemoteGpgImport

#endif

-- method Repo::remote_list
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_n_remotes"
--           , argType = TBasicType TUInt
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Number of remotes available"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: [ Arg
--              { argCName = "out_n_remotes"
--              , argType = TBasicType TUInt
--              , direction = DirectionOut
--              , mayBeNull = False
--              , argDoc =
--                  Documentation
--                    { rawDocText = Just "Number of remotes available"
--                    , sinceVersion = Nothing
--                    }
--              , argScope = ScopeTypeInvalid
--              , argClosure = -1
--              , argDestroy = -1
--              , argCallerAllocates = False
--              , transfer = TransferEverything
--              }
--          ]
-- returnType: Just (TCArray False (-1) 1 (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_remote_list" ostree_repo_remote_list :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Word32 ->                           -- out_n_remotes : TBasicType TUInt
    IO (Ptr CString)

-- | List available remote names in an t'GI.OSTree.Objects.Repo.Repo'.  Remote names are sorted
-- alphabetically.  If no remotes are available the function returns 'P.Nothing'.
repoRemoteList ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> m [T.Text]
    -- ^ __Returns:__ a 'P.Nothing'-terminated
    --          array of remote names
repoRemoteList :: a -> m [Text]
repoRemoteList self :: a
self = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Word32
outNRemotes <- IO (Ptr Word32)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word32)
    Ptr CString
result <- Ptr Repo -> Ptr Word32 -> IO (Ptr CString)
ostree_repo_remote_list Ptr Repo
self' Ptr Word32
outNRemotes
    Word32
outNRemotes' <- Ptr Word32 -> IO Word32
forall a. Storable a => Ptr a -> IO a
peek Ptr Word32
outNRemotes
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoRemoteList" Ptr CString
result
    [Text]
result' <- (Word32 -> Ptr CString -> IO [Text]
forall a.
(HasCallStack, Integral a) =>
a -> Ptr CString -> IO [Text]
unpackUTF8CArrayWithLength Word32
outNRemotes') Ptr CString
result
    (Word32 -> (CString -> IO ()) -> Ptr CString -> IO ()
forall a b c.
(Storable a, Integral b) =>
b -> (a -> IO c) -> Ptr a -> IO ()
mapCArrayWithLength Word32
outNRemotes') CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    Ptr Word32 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word32
outNRemotes
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
data RepoRemoteListMethodInfo
instance (signature ~ (m [T.Text]), MonadIO m, IsRepo a) => O.MethodInfo RepoRemoteListMethodInfo a signature where
    overloadedMethod = repoRemoteList

#endif

-- XXX Could not generate method Repo::remote_list_collection_refs
-- Error was : Not implemented: "GHashTable element of type TInterface (Name {namespace = \"OSTree\", name = \"CollectionRef\"}) unsupported."
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoRemoteListCollectionRefsMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "remoteListCollectionRefs" Repo) => O.MethodInfo RepoRemoteListCollectionRefsMethodInfo o p where
    overloadedMethod = undefined
#endif

-- XXX Could not generate method Repo::remote_list_refs
-- Error was : Not implemented: "Hash table argument with transfer = Container? outAllRefs'"
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoRemoteListRefsMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "remoteListRefs" Repo) => O.MethodInfo RepoRemoteListRefsMethodInfo o p where
    overloadedMethod = undefined
#endif

-- method Repo::resolve_collection_ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "CollectionRef" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a collection\8211ref to resolve"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allow_noent"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "%TRUE to not throw an error if @ref doesn\8217t exist"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoResolveRevExtFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "options controlling behaviour"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_rev"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "return location for\n   the checksum corresponding to @ref, or %NULL if @allow_noent is %TRUE and\n   the @ref could not be found"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , 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_repo_resolve_collection_ref" ostree_repo_resolve_collection_ref :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr OSTree.CollectionRef.CollectionRef -> -- ref : TInterface (Name {namespace = "OSTree", name = "CollectionRef"})
    CInt ->                                 -- allow_noent : TBasicType TBoolean
    CUInt ->                                -- flags : TInterface (Name {namespace = "OSTree", name = "RepoResolveRevExtFlags"})
    Ptr CString ->                          -- out_rev : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Look up the checksum for the given collection–ref, returning it in /@outRev@/.
-- This will search through the mirrors and remote refs.
-- 
-- If /@allowNoent@/ is 'P.True' and the given /@ref@/ cannot be found, 'P.True' will be
-- returned and /@outRev@/ will be set to 'P.Nothing'. If /@allowNoent@/ is 'P.False' and
-- the given /@ref@/ cannot be found, a 'GI.Gio.Enums.IOErrorEnumNotFound' error will be
-- returned.
-- 
-- If you want to check only local refs, not remote or mirrored ones, use the
-- flag 'GI.OSTree.Flags.RepoResolveRevExtFlagsLocalOnly'. This is analogous to using
-- 'GI.OSTree.Objects.Repo.repoResolveRevExt' but for collection-refs.
-- 
-- /Since: 2018.6/
repoResolveCollectionRef ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> OSTree.CollectionRef.CollectionRef
    -- ^ /@ref@/: a collection–ref to resolve
    -> Bool
    -- ^ /@allowNoent@/: 'P.True' to not throw an error if /@ref@/ doesn’t exist
    -> [OSTree.Flags.RepoResolveRevExtFlags]
    -- ^ /@flags@/: options controlling behaviour
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m ((Maybe T.Text))
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoResolveCollectionRef :: a
-> CollectionRef
-> Bool
-> [RepoResolveRevExtFlags]
-> Maybe b
-> m (Maybe Text)
repoResolveCollectionRef self :: a
self ref :: CollectionRef
ref allowNoent :: Bool
allowNoent flags :: [RepoResolveRevExtFlags]
flags cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CollectionRef
ref' <- CollectionRef -> IO (Ptr CollectionRef)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectionRef
ref
    let allowNoent' :: CInt
allowNoent' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
allowNoent
    let flags' :: CUInt
flags' = [RepoResolveRevExtFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [RepoResolveRevExtFlags]
flags
    Ptr CString
outRev <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO (Maybe Text) -> IO () -> IO (Maybe Text)
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 Repo
-> Ptr CollectionRef
-> CInt
-> CUInt
-> Ptr CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_resolve_collection_ref Ptr Repo
self' Ptr CollectionRef
ref' CInt
allowNoent' CUInt
flags' Ptr CString
outRev Ptr Cancellable
maybeCancellable
        CString
outRev' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outRev
        Maybe Text
maybeOutRev' <- CString -> (CString -> IO Text) -> IO (Maybe Text)
forall a b. Ptr a -> (Ptr a -> IO b) -> IO (Maybe b)
convertIfNonNull CString
outRev' ((CString -> IO Text) -> IO (Maybe Text))
-> (CString -> IO Text) -> IO (Maybe Text)
forall a b. (a -> b) -> a -> b
$ \outRev'' :: CString
outRev'' -> do
            Text
outRev''' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outRev''
            Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
outRev'''
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
outRev'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CollectionRef -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectionRef
ref
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outRev
        Maybe Text -> IO (Maybe Text)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Text
maybeOutRev'
     ) (do
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outRev
     )

#if defined(ENABLE_OVERLOADING)
data RepoResolveCollectionRefMethodInfo
instance (signature ~ (OSTree.CollectionRef.CollectionRef -> Bool -> [OSTree.Flags.RepoResolveRevExtFlags] -> Maybe (b) -> m ((Maybe T.Text))), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoResolveCollectionRefMethodInfo a signature where
    overloadedMethod = repoResolveCollectionRef

#endif

-- method Repo::resolve_keyring_for_collection
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "collection_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "the collection ID to look up a keyring for"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "OSTree" , name = "Remote" })
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_resolve_keyring_for_collection" ostree_repo_resolve_keyring_for_collection :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- collection_id : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr OSTree.Remote.Remote)

-- | Find the GPG keyring for the given /@collectionId@/, using the local
-- configuration from the given t'GI.OSTree.Objects.Repo.Repo'. This will search the configured
-- remotes for ones whose @collection-id@ key matches /@collectionId@/, and will
-- return the first matching remote.
-- 
-- If multiple remotes match and have different keyrings, a debug message will
-- be emitted, and the first result will be returned. It is expected that the
-- keyrings should match.
-- 
-- If no match can be found, a 'GI.Gio.Enums.IOErrorEnumNotFound' error will be returned.
-- 
-- /Since: 2018.6/
repoResolveKeyringForCollection ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> T.Text
    -- ^ /@collectionId@/: the collection ID to look up a keyring for
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable', or 'P.Nothing'
    -> m OSTree.Remote.Remote
    -- ^ __Returns:__ t'GI.OSTree.Structs.Remote.Remote' containing the GPG keyring for
    --    /@collectionId@/ /(Can throw 'Data.GI.Base.GError.GError')/
repoResolveKeyringForCollection :: a -> Text -> Maybe b -> m Remote
repoResolveKeyringForCollection self :: a
self collectionId :: Text
collectionId cancellable :: Maybe b
cancellable = IO Remote -> m Remote
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Remote -> m Remote) -> IO Remote -> m Remote
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
collectionId' <- Text -> IO CString
textToCString Text
collectionId
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Remote -> IO () -> IO Remote
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Remote
result <- (Ptr (Ptr GError) -> IO (Ptr Remote)) -> IO (Ptr Remote)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Remote)) -> IO (Ptr Remote))
-> (Ptr (Ptr GError) -> IO (Ptr Remote)) -> IO (Ptr Remote)
forall a b. (a -> b) -> a -> b
$ Ptr Repo
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Remote)
ostree_repo_resolve_keyring_for_collection Ptr Repo
self' CString
collectionId' Ptr Cancellable
maybeCancellable
        Text -> Ptr Remote -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoResolveKeyringForCollection" Ptr Remote
result
        Remote
result' <- ((ManagedPtr Remote -> Remote) -> Ptr Remote -> IO Remote
forall a.
(HasCallStack, BoxedObject a) =>
(ManagedPtr a -> a) -> Ptr a -> IO a
wrapBoxed ManagedPtr Remote -> Remote
OSTree.Remote.Remote) Ptr Remote
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
collectionId'
        Remote -> IO Remote
forall (m :: * -> *) a. Monad m => a -> m a
return Remote
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
collectionId'
     )

#if defined(ENABLE_OVERLOADING)
data RepoResolveKeyringForCollectionMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> m OSTree.Remote.Remote), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoResolveKeyringForCollectionMethodInfo a signature where
    overloadedMethod = repoResolveKeyringForCollection

#endif

-- method Repo::resolve_rev
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "refspec"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A refspec" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allow_noent"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Do not throw an error if refspec does not exist"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_rev"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A checksum,or %NULL if @allow_noent is true and it does not exist"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_resolve_rev" ostree_repo_resolve_rev :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- refspec : TBasicType TUTF8
    CInt ->                                 -- allow_noent : TBasicType TBoolean
    Ptr CString ->                          -- out_rev : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Look up the given refspec, returning the checksum it references in
-- the parameter /@outRev@/. Will fall back on remote directory if cannot
-- find the given refspec in local.
repoResolveRev ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@refspec@/: A refspec
    -> Bool
    -- ^ /@allowNoent@/: Do not throw an error if refspec does not exist
    -> m (T.Text)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoResolveRev :: a -> Text -> Bool -> m Text
repoResolveRev self :: a
self refspec :: Text
refspec allowNoent :: Bool
allowNoent = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
refspec' <- Text -> IO CString
textToCString Text
refspec
    let allowNoent' :: CInt
allowNoent' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
allowNoent
    Ptr CString
outRev <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    IO Text -> IO () -> IO Text
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 Repo
-> CString -> CInt -> Ptr CString -> Ptr (Ptr GError) -> IO CInt
ostree_repo_resolve_rev Ptr Repo
self' CString
refspec' CInt
allowNoent' Ptr CString
outRev
        CString
outRev' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outRev
        Text
outRev'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outRev'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
outRev'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
refspec'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outRev
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
outRev''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
refspec'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outRev
     )

#if defined(ENABLE_OVERLOADING)
data RepoResolveRevMethodInfo
instance (signature ~ (T.Text -> Bool -> m (T.Text)), MonadIO m, IsRepo a) => O.MethodInfo RepoResolveRevMethodInfo a signature where
    overloadedMethod = repoResolveRev

#endif

-- method Repo::resolve_rev_ext
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "refspec"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A refspec" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "allow_noent"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Do not throw an error if refspec does not exist"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "flags"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoResolveRevExtFlags" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Options controlling behavior"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_rev"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "A checksum,or %NULL if @allow_noent is true and it does not exist"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_resolve_rev_ext" ostree_repo_resolve_rev_ext :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- refspec : TBasicType TUTF8
    CInt ->                                 -- allow_noent : TBasicType TBoolean
    CUInt ->                                -- flags : TInterface (Name {namespace = "OSTree", name = "RepoResolveRevExtFlags"})
    Ptr CString ->                          -- out_rev : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Look up the given refspec, returning the checksum it references in
-- the parameter /@outRev@/. Differently from 'GI.OSTree.Objects.Repo.repoResolveRev',
-- this will not fall back to searching through remote repos if a
-- local ref is specified but not found.
-- 
-- The flag 'GI.OSTree.Flags.RepoResolveRevExtFlagsLocalOnly' is implied so
-- using it has no effect.
repoResolveRevExt ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@refspec@/: A refspec
    -> Bool
    -- ^ /@allowNoent@/: Do not throw an error if refspec does not exist
    -> [OSTree.Flags.RepoResolveRevExtFlags]
    -- ^ /@flags@/: Options controlling behavior
    -> m (T.Text)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoResolveRevExt :: a -> Text -> Bool -> [RepoResolveRevExtFlags] -> m Text
repoResolveRevExt self :: a
self refspec :: Text
refspec allowNoent :: Bool
allowNoent flags :: [RepoResolveRevExtFlags]
flags = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
refspec' <- Text -> IO CString
textToCString Text
refspec
    let allowNoent' :: CInt
allowNoent' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
allowNoent
    let flags' :: CUInt
flags' = [RepoResolveRevExtFlags] -> CUInt
forall b a. (Num b, IsGFlag a) => [a] -> b
gflagsToWord [RepoResolveRevExtFlags]
flags
    Ptr CString
outRev <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    IO Text -> IO () -> IO Text
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 Repo
-> CString
-> CInt
-> CUInt
-> Ptr CString
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_resolve_rev_ext Ptr Repo
self' CString
refspec' CInt
allowNoent' CUInt
flags' Ptr CString
outRev
        CString
outRev' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outRev
        Text
outRev'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outRev'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
outRev'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
refspec'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outRev
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
outRev''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
refspec'
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outRev
     )

#if defined(ENABLE_OVERLOADING)
data RepoResolveRevExtMethodInfo
instance (signature ~ (T.Text -> Bool -> [OSTree.Flags.RepoResolveRevExtFlags] -> m (T.Text)), MonadIO m, IsRepo a) => O.MethodInfo RepoResolveRevExtMethodInfo a signature where
    overloadedMethod = repoResolveRevExt

#endif

-- method Repo::scan_hardlinks
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_scan_hardlinks" ostree_repo_scan_hardlinks :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | This function is deprecated in favor of using 'GI.OSTree.Structs.RepoDevInoCache.repoDevInoCacheNew',
-- which allows a precise mapping to be built up between hardlink checkout files
-- and their checksums between @ostree_repo_checkout_at()@ and
-- @ostree_repo_write_directory_to_mtree()@.
-- 
-- When invoking 'GI.OSTree.Objects.Repo.repoWriteDirectoryToMtree', it has to compute the
-- checksum of all files. If your commit contains hardlinks from a checkout,
-- this functions builds a mapping of device numbers and inodes to their
-- checksum.
-- 
-- There is an upfront cost to creating this mapping, as this will scan the
-- entire objects directory. If your commit is composed of mostly hardlinks to
-- existing ostree objects, then this will speed up considerably, so call it
-- before you call 'GI.OSTree.Objects.Repo.repoWriteDirectoryToMtree' or similar.  However,
-- 'GI.OSTree.Structs.RepoDevInoCache.repoDevInoCacheNew' is better as it avoids scanning all objects.
-- 
-- Multithreading: This function is *not* MT safe.
repoScanHardlinks ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoScanHardlinks :: a -> Maybe b -> m ()
repoScanHardlinks self :: a
self cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo -> Ptr Cancellable -> Ptr (Ptr GError) -> IO CInt
ostree_repo_scan_hardlinks Ptr Repo
self' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoScanHardlinksMethodInfo
instance (signature ~ (Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoScanHardlinksMethodInfo a signature where
    overloadedMethod = repoScanHardlinks

#endif

-- method Repo::set_alias_ref_immediate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A remote for the ref"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The ref to write" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "target"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The ref target to point it to, or %NULL to unset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GCancellable" , 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_repo_set_alias_ref_immediate" ostree_repo_set_alias_ref_immediate :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote : TBasicType TUTF8
    CString ->                              -- ref : TBasicType TUTF8
    CString ->                              -- target : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Like 'GI.OSTree.Objects.Repo.repoSetRefImmediate', but creates an alias.
repoSetAliasRefImmediate ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> Maybe (T.Text)
    -- ^ /@remote@/: A remote for the ref
    -> T.Text
    -- ^ /@ref@/: The ref to write
    -> Maybe (T.Text)
    -- ^ /@target@/: The ref target to point it to, or 'P.Nothing' to unset
    -> Maybe (b)
    -- ^ /@cancellable@/: GCancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoSetAliasRefImmediate :: a -> Maybe Text -> Text -> Maybe Text -> Maybe b -> m ()
repoSetAliasRefImmediate self :: a
self remote :: Maybe Text
remote ref :: Text
ref target :: Maybe Text
target cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeRemote <- case Maybe Text
remote of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jRemote :: Text
jRemote -> do
            CString
jRemote' <- Text -> IO CString
textToCString Text
jRemote
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jRemote'
    CString
ref' <- Text -> IO CString
textToCString Text
ref
    CString
maybeTarget <- case Maybe Text
target of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jTarget :: Text
jTarget -> do
            CString
jTarget' <- Text -> IO CString
textToCString Text
jTarget
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jTarget'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> CString
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_set_alias_ref_immediate Ptr Repo
self' CString
maybeRemote CString
ref' CString
maybeTarget Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeRemote
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
ref'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTarget
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeRemote
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
ref'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeTarget
     )

#if defined(ENABLE_OVERLOADING)
data RepoSetAliasRefImmediateMethodInfo
instance (signature ~ (Maybe (T.Text) -> T.Text -> Maybe (T.Text) -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoSetAliasRefImmediateMethodInfo a signature where
    overloadedMethod = repoSetAliasRefImmediate

#endif

-- method Repo::set_cache_dir
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dfd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "directory fd" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "subpath in @dfd" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GCancellable" , 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_repo_set_cache_dir" ostree_repo_set_cache_dir :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Int32 ->                                -- dfd : TBasicType TInt
    CString ->                              -- path : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Set a custom location for the cache directory used for e.g.
-- per-remote summary caches. Setting this manually is useful when
-- doing operations on a system repo as a user because you don\'t have
-- write permissions in the repo, where the cache is normally stored.
repoSetCacheDir ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> Int32
    -- ^ /@dfd@/: directory fd
    -> T.Text
    -- ^ /@path@/: subpath in /@dfd@/
    -> Maybe (b)
    -- ^ /@cancellable@/: a t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoSetCacheDir :: a -> Int32 -> Text -> Maybe b -> m ()
repoSetCacheDir self :: a
self dfd :: Int32
dfd path :: Text
path cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Int32
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_set_cache_dir Ptr Repo
self' Int32
dfd CString
path' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
     )

#if defined(ENABLE_OVERLOADING)
data RepoSetCacheDirMethodInfo
instance (signature ~ (Int32 -> T.Text -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoSetCacheDirMethodInfo a signature where
    overloadedMethod = repoSetCacheDir

#endif

-- method Repo::set_collection_id
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "an #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "collection_id"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "new collection ID, or %NULL to unset it"
--                 , 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_repo_set_collection_id" ostree_repo_set_collection_id :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- collection_id : TBasicType TUTF8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Set or clear the collection ID of this repository. See [collection IDs][collection-ids].
-- The update will be made in memory, but must be written out to the repository
-- configuration on disk using 'GI.OSTree.Objects.Repo.repoWriteConfig'.
-- 
-- /Since: 2018.6/
repoSetCollectionId ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: an t'GI.OSTree.Objects.Repo.Repo'
    -> Maybe (T.Text)
    -- ^ /@collectionId@/: new collection ID, or 'P.Nothing' to unset it
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoSetCollectionId :: a -> Maybe Text -> m ()
repoSetCollectionId self :: a
self collectionId :: Maybe Text
collectionId = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeCollectionId <- case Maybe Text
collectionId of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jCollectionId :: Text
jCollectionId -> do
            CString
jCollectionId' <- Text -> IO CString
textToCString Text
jCollectionId
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jCollectionId'
    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 Repo -> CString -> Ptr (Ptr GError) -> IO CInt
ostree_repo_set_collection_id Ptr Repo
self' CString
maybeCollectionId
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCollectionId
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeCollectionId
     )

#if defined(ENABLE_OVERLOADING)
data RepoSetCollectionIdMethodInfo
instance (signature ~ (Maybe (T.Text) -> m ()), MonadIO m, IsRepo a) => O.MethodInfo RepoSetCollectionIdMethodInfo a signature where
    overloadedMethod = repoSetCollectionId

#endif

-- method Repo::set_collection_ref_immediate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "CollectionRef" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The collection\8211ref to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The checksum to point it to, or %NULL to unset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GCancellable" , 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_repo_set_collection_ref_immediate" ostree_repo_set_collection_ref_immediate :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr OSTree.CollectionRef.CollectionRef -> -- ref : TInterface (Name {namespace = "OSTree", name = "CollectionRef"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | This is like 'GI.OSTree.Objects.Repo.repoTransactionSetCollectionRef', except it may be
-- invoked outside of a transaction.  This is presently safe for the
-- case where we\'re creating or overwriting an existing ref.
-- 
-- /Since: 2018.6/
repoSetCollectionRefImmediate ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> OSTree.CollectionRef.CollectionRef
    -- ^ /@ref@/: The collection–ref to write
    -> Maybe (T.Text)
    -- ^ /@checksum@/: The checksum to point it to, or 'P.Nothing' to unset
    -> Maybe (b)
    -- ^ /@cancellable@/: GCancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoSetCollectionRefImmediate :: a -> CollectionRef -> Maybe Text -> Maybe b -> m ()
repoSetCollectionRefImmediate self :: a
self ref :: CollectionRef
ref checksum :: Maybe Text
checksum cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CollectionRef
ref' <- CollectionRef -> IO (Ptr CollectionRef)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectionRef
ref
    CString
maybeChecksum <- case Maybe Text
checksum of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jChecksum :: Text
jChecksum -> do
            CString
jChecksum' <- Text -> IO CString
textToCString Text
jChecksum
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jChecksum'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Ptr CollectionRef
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_set_collection_ref_immediate Ptr Repo
self' Ptr CollectionRef
ref' CString
maybeChecksum Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        CollectionRef -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectionRef
ref
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeChecksum
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeChecksum
     )

#if defined(ENABLE_OVERLOADING)
data RepoSetCollectionRefImmediateMethodInfo
instance (signature ~ (OSTree.CollectionRef.CollectionRef -> Maybe (T.Text) -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoSetCollectionRefImmediateMethodInfo a signature where
    overloadedMethod = repoSetCollectionRefImmediate

#endif

-- method Repo::set_disable_fsync
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "disable_fsync"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "If %TRUE, do not fsync"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_set_disable_fsync" ostree_repo_set_disable_fsync :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CInt ->                                 -- disable_fsync : TBasicType TBoolean
    IO ()

-- | Disable requests to @/fsync()/@ to stable storage during commits.  This
-- option should only be used by build system tools which are creating
-- disposable virtual machines, or have higher level mechanisms for
-- ensuring data consistency.
repoSetDisableFsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> Bool
    -- ^ /@disableFsync@/: If 'P.True', do not fsync
    -> m ()
repoSetDisableFsync :: a -> Bool -> m ()
repoSetDisableFsync self :: a
self disableFsync :: Bool
disableFsync = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let disableFsync' :: CInt
disableFsync' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
disableFsync
    Ptr Repo -> CInt -> IO ()
ostree_repo_set_disable_fsync Ptr Repo
self' CInt
disableFsync'
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RepoSetDisableFsyncMethodInfo
instance (signature ~ (Bool -> m ()), MonadIO m, IsRepo a) => O.MethodInfo RepoSetDisableFsyncMethodInfo a signature where
    overloadedMethod = repoSetDisableFsync

#endif

-- method Repo::set_ref_immediate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A remote for the ref"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The ref to write" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "The checksum to point it to, or %NULL to unset"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GCancellable" , 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_repo_set_ref_immediate" ostree_repo_set_ref_immediate :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote : TBasicType TUTF8
    CString ->                              -- ref : TBasicType TUTF8
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | This is like 'GI.OSTree.Objects.Repo.repoTransactionSetRef', except it may be
-- invoked outside of a transaction.  This is presently safe for the
-- case where we\'re creating or overwriting an existing ref.
-- 
-- Multithreading: This function is MT safe.
repoSetRefImmediate ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> Maybe (T.Text)
    -- ^ /@remote@/: A remote for the ref
    -> T.Text
    -- ^ /@ref@/: The ref to write
    -> Maybe (T.Text)
    -- ^ /@checksum@/: The checksum to point it to, or 'P.Nothing' to unset
    -> Maybe (b)
    -- ^ /@cancellable@/: GCancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoSetRefImmediate :: a -> Maybe Text -> Text -> Maybe Text -> Maybe b -> m ()
repoSetRefImmediate self :: a
self remote :: Maybe Text
remote ref :: Text
ref checksum :: Maybe Text
checksum cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeRemote <- case Maybe Text
remote of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jRemote :: Text
jRemote -> do
            CString
jRemote' <- Text -> IO CString
textToCString Text
jRemote
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jRemote'
    CString
ref' <- Text -> IO CString
textToCString Text
ref
    CString
maybeChecksum <- case Maybe Text
checksum of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jChecksum :: Text
jChecksum -> do
            CString
jChecksum' <- Text -> IO CString
textToCString Text
jChecksum
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jChecksum'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> CString
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_set_ref_immediate Ptr Repo
self' CString
maybeRemote CString
ref' CString
maybeChecksum Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeRemote
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
ref'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeChecksum
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeRemote
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
ref'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeChecksum
     )

#if defined(ENABLE_OVERLOADING)
data RepoSetRefImmediateMethodInfo
instance (signature ~ (Maybe (T.Text) -> T.Text -> Maybe (T.Text) -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoSetRefImmediateMethodInfo a signature where
    overloadedMethod = repoSetRefImmediate

#endif

-- method Repo::sign_commit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "commit_checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "SHA256 of given commit to sign"
--                 , 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 "Use this GPG key id"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "homedir"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GPG home directory, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A #GCancellable" , 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_repo_sign_commit" ostree_repo_sign_commit :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- commit_checksum : TBasicType TUTF8
    CString ->                              -- key_id : TBasicType TUTF8
    CString ->                              -- homedir : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Add a GPG signature to a commit.
repoSignCommit ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Self
    -> T.Text
    -- ^ /@commitChecksum@/: SHA256 of given commit to sign
    -> T.Text
    -- ^ /@keyId@/: Use this GPG key id
    -> Maybe (T.Text)
    -- ^ /@homedir@/: GPG home directory, or 'P.Nothing'
    -> Maybe (b)
    -- ^ /@cancellable@/: A t'GI.Gio.Objects.Cancellable.Cancellable'
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoSignCommit :: a -> Text -> Text -> Maybe Text -> Maybe b -> m ()
repoSignCommit self :: a
self commitChecksum :: Text
commitChecksum keyId :: Text
keyId homedir :: Maybe Text
homedir cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
commitChecksum' <- Text -> IO CString
textToCString Text
commitChecksum
    CString
keyId' <- Text -> IO CString
textToCString Text
keyId
    CString
maybeHomedir <- case Maybe Text
homedir of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jHomedir :: Text
jHomedir -> do
            CString
jHomedir' <- Text -> IO CString
textToCString Text
jHomedir
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jHomedir'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> CString
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_sign_commit Ptr Repo
self' CString
commitChecksum' CString
keyId' CString
maybeHomedir Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commitChecksum'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keyId'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeHomedir
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commitChecksum'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keyId'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeHomedir
     )

#if defined(ENABLE_OVERLOADING)
data RepoSignCommitMethodInfo
instance (signature ~ (T.Text -> T.Text -> Maybe (T.Text) -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoSignCommitMethodInfo a signature where
    overloadedMethod = repoSignCommit

#endif

-- method Repo::sign_delta
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Self" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "from_commit"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "From commit" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to_commit"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "To commit" , 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 "key id" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "homedir"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "homedir" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "cancellable" , 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_repo_sign_delta" ostree_repo_sign_delta :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- from_commit : TBasicType TUTF8
    CString ->                              -- to_commit : TBasicType TUTF8
    CString ->                              -- key_id : TBasicType TUTF8
    CString ->                              -- homedir : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | This function is deprecated, sign the summary file instead.
-- Add a GPG signature to a static delta.
repoSignDelta ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Self
    -> T.Text
    -- ^ /@fromCommit@/: From commit
    -> T.Text
    -- ^ /@toCommit@/: To commit
    -> T.Text
    -- ^ /@keyId@/: key id
    -> T.Text
    -- ^ /@homedir@/: homedir
    -> Maybe (b)
    -- ^ /@cancellable@/: cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoSignDelta :: a -> Text -> Text -> Text -> Text -> Maybe b -> m ()
repoSignDelta self :: a
self fromCommit :: Text
fromCommit toCommit :: Text
toCommit keyId :: Text
keyId homedir :: Text
homedir cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
fromCommit' <- Text -> IO CString
textToCString Text
fromCommit
    CString
toCommit' <- Text -> IO CString
textToCString Text
toCommit
    CString
keyId' <- Text -> IO CString
textToCString Text
keyId
    CString
homedir' <- Text -> IO CString
textToCString Text
homedir
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> CString
-> CString
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_sign_delta Ptr Repo
self' CString
fromCommit' CString
toCommit' CString
keyId' CString
homedir' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fromCommit'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
toCommit'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keyId'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
homedir'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
fromCommit'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
toCommit'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
keyId'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
homedir'
     )

#if defined(ENABLE_OVERLOADING)
data RepoSignDeltaMethodInfo
instance (signature ~ (T.Text -> T.Text -> T.Text -> T.Text -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoSignDeltaMethodInfo a signature where
    overloadedMethod = repoSignDelta

#endif

-- method Repo::static_delta_execute_offline
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dir_or_file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Path to a directory containing static delta data, or directly to the superblock"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "skip_validation"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "If %TRUE, assume data integrity"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_static_delta_execute_offline" ostree_repo_static_delta_execute_offline :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.File.File ->                    -- dir_or_file : TInterface (Name {namespace = "Gio", name = "File"})
    CInt ->                                 -- skip_validation : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Given a directory representing an already-downloaded static delta
-- on disk, apply it, generating a new commit.  The directory must be
-- named with the form \"FROM-TO\", where both are checksums, and it
-- must contain a file named \"superblock\", along with at least one part.
repoStaticDeltaExecuteOffline ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> b
    -- ^ /@dirOrFile@/: Path to a directory containing static delta data, or directly to the superblock
    -> Bool
    -- ^ /@skipValidation@/: If 'P.True', assume data integrity
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoStaticDeltaExecuteOffline :: a -> b -> Bool -> Maybe c -> m ()
repoStaticDeltaExecuteOffline self :: a
self dirOrFile :: b
dirOrFile skipValidation :: Bool
skipValidation cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
dirOrFile' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
dirOrFile
    let skipValidation' :: CInt
skipValidation' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
skipValidation
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Ptr File
-> CInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_static_delta_execute_offline Ptr Repo
self' Ptr File
dirOrFile' CInt
skipValidation' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dirOrFile
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoStaticDeltaExecuteOfflineMethodInfo
instance (signature ~ (b -> Bool -> Maybe (c) -> m ()), MonadIO m, IsRepo a, Gio.File.IsFile b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoStaticDeltaExecuteOfflineMethodInfo a signature where
    overloadedMethod = repoStaticDeltaExecuteOffline

#endif

-- method Repo::static_delta_generate
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "opt"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "StaticDeltaGenerateOpt" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "High level optimization choice"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "from"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII SHA256 checksum of origin, or %NULL"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "to"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII SHA256 checksum of target"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "metadata"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Optional metadata" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "params"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Parameters, see below"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_static_delta_generate" ostree_repo_static_delta_generate :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- opt : TInterface (Name {namespace = "OSTree", name = "StaticDeltaGenerateOpt"})
    CString ->                              -- from : TBasicType TUTF8
    CString ->                              -- to : TBasicType TUTF8
    Ptr GVariant ->                         -- metadata : TVariant
    Ptr GVariant ->                         -- params : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Generate a lookaside \"static delta\" from /@from@/ ('P.Nothing' means
-- from-empty) which can generate the objects in /@to@/.  This delta is
-- an optimization over fetching individual objects, and can be
-- conveniently stored and applied offline.
-- 
-- The /@params@/ argument should be an a{sv}.  The following attributes
-- are known:
--   - min-fallback-size: u: Minimum uncompressed size in megabytes to use fallback, 0 to disable fallbacks
--   - max-chunk-size: u: Maximum size in megabytes of a delta part
--   - max-bsdiff-size: u: Maximum size in megabytes to consider bsdiff compression
--   for input files
--   - compression: y: Compression type: 0=none, x=lzma, g=gzip
--   - bsdiff-enabled: b: Enable bsdiff compression.  Default TRUE.
--   - inline-parts: b: Put part data in header, to get a single file delta.  Default FALSE.
--   - verbose: b: Print diagnostic messages.  Default FALSE.
--   - endianness: b: Deltas use host byte order by default; this option allows choosing (G_BIG_ENDIAN or G_LITTLE_ENDIAN)
--   - filename: ay: Save delta superblock to this filename, and parts in the same directory.  Default saves to repository.
repoStaticDeltaGenerate ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.StaticDeltaGenerateOpt
    -- ^ /@opt@/: High level optimization choice
    -> T.Text
    -- ^ /@from@/: ASCII SHA256 checksum of origin, or 'P.Nothing'
    -> T.Text
    -- ^ /@to@/: ASCII SHA256 checksum of target
    -> Maybe (GVariant)
    -- ^ /@metadata@/: Optional metadata
    -> Maybe (GVariant)
    -- ^ /@params@/: Parameters, see below
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoStaticDeltaGenerate :: a
-> StaticDeltaGenerateOpt
-> Text
-> Text
-> Maybe GVariant
-> Maybe GVariant
-> Maybe b
-> m ()
repoStaticDeltaGenerate self :: a
self opt :: StaticDeltaGenerateOpt
opt from :: Text
from to :: Text
to metadata :: Maybe GVariant
metadata params :: Maybe GVariant
params cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let opt' :: CUInt
opt' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt)
-> (StaticDeltaGenerateOpt -> Int)
-> StaticDeltaGenerateOpt
-> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StaticDeltaGenerateOpt -> Int
forall a. Enum a => a -> Int
fromEnum) StaticDeltaGenerateOpt
opt
    CString
from' <- Text -> IO CString
textToCString Text
from
    CString
to' <- Text -> IO CString
textToCString Text
to
    Ptr GVariant
maybeMetadata <- case Maybe GVariant
metadata of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jMetadata :: GVariant
jMetadata -> do
            Ptr GVariant
jMetadata' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jMetadata
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jMetadata'
    Ptr GVariant
maybeParams <- case Maybe GVariant
params of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jParams :: GVariant
jParams -> do
            Ptr GVariant
jParams' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jParams
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jParams'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CUInt
-> CString
-> CString
-> Ptr GVariant
-> Ptr GVariant
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_static_delta_generate Ptr Repo
self' CUInt
opt' CString
from' CString
to' Ptr GVariant
maybeMetadata Ptr GVariant
maybeParams Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
metadata GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
params GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
from'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
to'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
from'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
to'
     )

#if defined(ENABLE_OVERLOADING)
data RepoStaticDeltaGenerateMethodInfo
instance (signature ~ (OSTree.Enums.StaticDeltaGenerateOpt -> T.Text -> T.Text -> Maybe (GVariant) -> Maybe (GVariant) -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoStaticDeltaGenerateMethodInfo a signature where
    overloadedMethod = repoStaticDeltaGenerate

#endif

-- method Repo::transaction_set_collection_ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "CollectionRef" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The collection\8211ref to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The checksum to point it to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_transaction_set_collection_ref" ostree_repo_transaction_set_collection_ref :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr OSTree.CollectionRef.CollectionRef -> -- ref : TInterface (Name {namespace = "OSTree", name = "CollectionRef"})
    CString ->                              -- checksum : TBasicType TUTF8
    IO ()

-- | If /@checksum@/ is not 'P.Nothing', then record it as the target of local ref named
-- /@ref@/.
-- 
-- Otherwise, if /@checksum@/ is 'P.Nothing', then record that the ref should
-- be deleted.
-- 
-- The change will not be written out immediately, but when the transaction
-- is completed with 'GI.OSTree.Objects.Repo.repoCommitTransaction'. If the transaction
-- is instead aborted with 'GI.OSTree.Objects.Repo.repoAbortTransaction', no changes will
-- be made to the repository.
-- 
-- Multithreading: Since v2017.15 this function is MT safe.
-- 
-- /Since: 2018.6/
repoTransactionSetCollectionRef ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> OSTree.CollectionRef.CollectionRef
    -- ^ /@ref@/: The collection–ref to write
    -> Maybe (T.Text)
    -- ^ /@checksum@/: The checksum to point it to
    -> m ()
repoTransactionSetCollectionRef :: a -> CollectionRef -> Maybe Text -> m ()
repoTransactionSetCollectionRef self :: a
self ref :: CollectionRef
ref checksum :: Maybe Text
checksum = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr CollectionRef
ref' <- CollectionRef -> IO (Ptr CollectionRef)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr CollectionRef
ref
    CString
maybeChecksum <- case Maybe Text
checksum of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jChecksum :: Text
jChecksum -> do
            CString
jChecksum' <- Text -> IO CString
textToCString Text
jChecksum
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jChecksum'
    Ptr Repo -> Ptr CollectionRef -> CString -> IO ()
ostree_repo_transaction_set_collection_ref Ptr Repo
self' Ptr CollectionRef
ref' CString
maybeChecksum
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CollectionRef -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr CollectionRef
ref
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeChecksum
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RepoTransactionSetCollectionRefMethodInfo
instance (signature ~ (OSTree.CollectionRef.CollectionRef -> Maybe (T.Text) -> m ()), MonadIO m, IsRepo a) => O.MethodInfo RepoTransactionSetCollectionRefMethodInfo a signature where
    overloadedMethod = repoTransactionSetCollectionRef

#endif

-- method Repo::transaction_set_ref
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A remote for the ref"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "ref"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The ref to write" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The checksum to point it to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_transaction_set_ref" ostree_repo_transaction_set_ref :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote : TBasicType TUTF8
    CString ->                              -- ref : TBasicType TUTF8
    CString ->                              -- checksum : TBasicType TUTF8
    IO ()

-- | If /@checksum@/ is not 'P.Nothing', then record it as the target of ref named
-- /@ref@/; if /@remote@/ is provided, the ref will appear to originate from that
-- remote.
-- 
-- Otherwise, if /@checksum@/ is 'P.Nothing', then record that the ref should
-- be deleted.
-- 
-- The change will be written when the transaction is completed with
-- 'GI.OSTree.Objects.Repo.repoCommitTransaction'; that function takes care of writing all of
-- the objects (such as the commit referred to by /@checksum@/) before updating the
-- refs. If the transaction is instead aborted with
-- 'GI.OSTree.Objects.Repo.repoAbortTransaction', no changes to the ref will be made to the
-- repository.
-- 
-- Note however that currently writing *multiple* refs is not truly atomic; if
-- the process or system is terminated during
-- 'GI.OSTree.Objects.Repo.repoCommitTransaction', it is possible that just some of the refs
-- will have been updated. Your application should take care to handle this
-- case.
-- 
-- Multithreading: Since v2017.15 this function is MT safe.
repoTransactionSetRef ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> Maybe (T.Text)
    -- ^ /@remote@/: A remote for the ref
    -> T.Text
    -- ^ /@ref@/: The ref to write
    -> Maybe (T.Text)
    -- ^ /@checksum@/: The checksum to point it to
    -> m ()
repoTransactionSetRef :: a -> Maybe Text -> Text -> Maybe Text -> m ()
repoTransactionSetRef self :: a
self remote :: Maybe Text
remote ref :: Text
ref checksum :: Maybe Text
checksum = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeRemote <- case Maybe Text
remote of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jRemote :: Text
jRemote -> do
            CString
jRemote' <- Text -> IO CString
textToCString Text
jRemote
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jRemote'
    CString
ref' <- Text -> IO CString
textToCString Text
ref
    CString
maybeChecksum <- case Maybe Text
checksum of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jChecksum :: Text
jChecksum -> do
            CString
jChecksum' <- Text -> IO CString
textToCString Text
jChecksum
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jChecksum'
    Ptr Repo -> CString -> CString -> CString -> IO ()
ostree_repo_transaction_set_ref Ptr Repo
self' CString
maybeRemote CString
ref' CString
maybeChecksum
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeRemote
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
ref'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeChecksum
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RepoTransactionSetRefMethodInfo
instance (signature ~ (Maybe (T.Text) -> T.Text -> Maybe (T.Text) -> m ()), MonadIO m, IsRepo a) => O.MethodInfo RepoTransactionSetRefMethodInfo a signature where
    overloadedMethod = repoTransactionSetRef

#endif

-- method Repo::transaction_set_refspec
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "refspec"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The refspec to write"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The checksum to point it to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_transaction_set_refspec" ostree_repo_transaction_set_refspec :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- refspec : TBasicType TUTF8
    CString ->                              -- checksum : TBasicType TUTF8
    IO ()

-- | Like 'GI.OSTree.Objects.Repo.repoTransactionSetRef', but takes concatenated
-- /@refspec@/ format as input instead of separate remote and name
-- arguments.
-- 
-- Multithreading: Since v2017.15 this function is MT safe.
repoTransactionSetRefspec ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> T.Text
    -- ^ /@refspec@/: The refspec to write
    -> Maybe (T.Text)
    -- ^ /@checksum@/: The checksum to point it to
    -> m ()
repoTransactionSetRefspec :: a -> Text -> Maybe Text -> m ()
repoTransactionSetRefspec self :: a
self refspec :: Text
refspec checksum :: Maybe Text
checksum = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
refspec' <- Text -> IO CString
textToCString Text
refspec
    CString
maybeChecksum <- case Maybe Text
checksum of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jChecksum :: Text
jChecksum -> do
            CString
jChecksum' <- Text -> IO CString
textToCString Text
jChecksum
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jChecksum'
    Ptr Repo -> CString -> CString -> IO ()
ostree_repo_transaction_set_refspec Ptr Repo
self' CString
refspec' CString
maybeChecksum
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
refspec'
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeChecksum
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RepoTransactionSetRefspecMethodInfo
instance (signature ~ (T.Text -> Maybe (T.Text) -> m ()), MonadIO m, IsRepo a) => O.MethodInfo RepoTransactionSetRefspecMethodInfo a signature where
    overloadedMethod = repoTransactionSetRefspec

#endif

-- XXX Could not generate method Repo::traverse_commit
-- Error was : Not implemented: "GHashTable element of type TVariant unsupported."
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoTraverseCommitMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "traverseCommit" Repo) => O.MethodInfo RepoTraverseCommitMethodInfo o p where
    overloadedMethod = undefined
#endif

-- XXX Could not generate method Repo::traverse_reachable_refs
-- Error was : Not implemented: "GHashTable key of type TVariant unsupported."
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoTraverseReachableRefsMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "traverseReachableRefs" Repo) => O.MethodInfo RepoTraverseReachableRefsMethodInfo o p where
    overloadedMethod = undefined
#endif

-- method Repo::verify_commit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Repository" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "commit_checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII SHA256 checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyringdir"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Path to directory GPG keyrings; overrides built-in default if given"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "extra_keyring"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Path to additional keyring file (not a directory)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_verify_commit" ostree_repo_verify_commit :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- commit_checksum : TBasicType TUTF8
    Ptr Gio.File.File ->                    -- keyringdir : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.File.File ->                    -- extra_keyring : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Check for a valid GPG signature on commit named by the ASCII
-- checksum /@commitChecksum@/.
repoVerifyCommit ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.File.IsFile b, Gio.File.IsFile c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@self@/: Repository
    -> T.Text
    -- ^ /@commitChecksum@/: ASCII SHA256 checksum
    -> Maybe (b)
    -- ^ /@keyringdir@/: Path to directory GPG keyrings; overrides built-in default if given
    -> Maybe (c)
    -- ^ /@extraKeyring@/: Path to additional keyring file (not a directory)
    -> Maybe (d)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoVerifyCommit :: a -> Text -> Maybe b -> Maybe c -> Maybe d -> m ()
repoVerifyCommit self :: a
self commitChecksum :: Text
commitChecksum keyringdir :: Maybe b
keyringdir extraKeyring :: Maybe c
extraKeyring cancellable :: Maybe d
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
commitChecksum' <- Text -> IO CString
textToCString Text
commitChecksum
    Ptr File
maybeKeyringdir <- case Maybe b
keyringdir of
        Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just jKeyringdir :: b
jKeyringdir -> do
            Ptr File
jKeyringdir' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jKeyringdir
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jKeyringdir'
    Ptr File
maybeExtraKeyring <- case Maybe c
extraKeyring of
        Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just jExtraKeyring :: c
jExtraKeyring -> do
            Ptr File
jExtraKeyring' <- c -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jExtraKeyring
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jExtraKeyring'
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> Ptr File
-> Ptr File
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_verify_commit Ptr Repo
self' CString
commitChecksum' Ptr File
maybeKeyringdir Ptr File
maybeExtraKeyring Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
keyringdir b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
extraKeyring c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commitChecksum'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commitChecksum'
     )

#if defined(ENABLE_OVERLOADING)
data RepoVerifyCommitMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (c) -> Maybe (d) -> m ()), MonadIO m, IsRepo a, Gio.File.IsFile b, Gio.File.IsFile c, Gio.Cancellable.IsCancellable d) => O.MethodInfo RepoVerifyCommitMethodInfo a signature where
    overloadedMethod = repoVerifyCommit

#endif

-- method Repo::verify_commit_ext
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Repository" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "commit_checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII SHA256 checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "keyringdir"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Path to directory GPG keyrings; overrides built-in default if given"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "extra_keyring"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Path to additional keyring file (not a directory)"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "OSTree" , name = "GpgVerifyResult" })
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_verify_commit_ext" ostree_repo_verify_commit_ext :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- commit_checksum : TBasicType TUTF8
    Ptr Gio.File.File ->                    -- keyringdir : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.File.File ->                    -- extra_keyring : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr OSTree.GpgVerifyResult.GpgVerifyResult)

-- | Read GPG signature(s) on the commit named by the ASCII checksum
-- /@commitChecksum@/ and return detailed results.
repoVerifyCommitExt ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.File.IsFile b, Gio.File.IsFile c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@self@/: Repository
    -> T.Text
    -- ^ /@commitChecksum@/: ASCII SHA256 checksum
    -> Maybe (b)
    -- ^ /@keyringdir@/: Path to directory GPG keyrings; overrides built-in default if given
    -> Maybe (c)
    -- ^ /@extraKeyring@/: Path to additional keyring file (not a directory)
    -> Maybe (d)
    -- ^ /@cancellable@/: Cancellable
    -> m OSTree.GpgVerifyResult.GpgVerifyResult
    -- ^ __Returns:__ an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult', or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
repoVerifyCommitExt :: a -> Text -> Maybe b -> Maybe c -> Maybe d -> m GpgVerifyResult
repoVerifyCommitExt self :: a
self commitChecksum :: Text
commitChecksum keyringdir :: Maybe b
keyringdir extraKeyring :: Maybe c
extraKeyring cancellable :: Maybe d
cancellable = IO GpgVerifyResult -> m GpgVerifyResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GpgVerifyResult -> m GpgVerifyResult)
-> IO GpgVerifyResult -> m GpgVerifyResult
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
commitChecksum' <- Text -> IO CString
textToCString Text
commitChecksum
    Ptr File
maybeKeyringdir <- case Maybe b
keyringdir of
        Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just jKeyringdir :: b
jKeyringdir -> do
            Ptr File
jKeyringdir' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jKeyringdir
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jKeyringdir'
    Ptr File
maybeExtraKeyring <- case Maybe c
extraKeyring of
        Nothing -> Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
forall a. Ptr a
nullPtr
        Just jExtraKeyring :: c
jExtraKeyring -> do
            Ptr File
jExtraKeyring' <- c -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jExtraKeyring
            Ptr File -> IO (Ptr File)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr File
jExtraKeyring'
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO GpgVerifyResult -> IO () -> IO GpgVerifyResult
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GpgVerifyResult
result <- (Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
-> IO (Ptr GpgVerifyResult)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
 -> IO (Ptr GpgVerifyResult))
-> (Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
-> IO (Ptr GpgVerifyResult)
forall a b. (a -> b) -> a -> b
$ Ptr Repo
-> CString
-> Ptr File
-> Ptr File
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr GpgVerifyResult)
ostree_repo_verify_commit_ext Ptr Repo
self' CString
commitChecksum' Ptr File
maybeKeyringdir Ptr File
maybeExtraKeyring Ptr Cancellable
maybeCancellable
        Text -> Ptr GpgVerifyResult -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoVerifyCommitExt" Ptr GpgVerifyResult
result
        GpgVerifyResult
result' <- ((ManagedPtr GpgVerifyResult -> GpgVerifyResult)
-> Ptr GpgVerifyResult -> IO GpgVerifyResult
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr GpgVerifyResult -> GpgVerifyResult
OSTree.GpgVerifyResult.GpgVerifyResult) Ptr GpgVerifyResult
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
keyringdir b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
extraKeyring c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commitChecksum'
        GpgVerifyResult -> IO GpgVerifyResult
forall (m :: * -> *) a. Monad m => a -> m a
return GpgVerifyResult
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commitChecksum'
     )

#if defined(ENABLE_OVERLOADING)
data RepoVerifyCommitExtMethodInfo
instance (signature ~ (T.Text -> Maybe (b) -> Maybe (c) -> Maybe (d) -> m OSTree.GpgVerifyResult.GpgVerifyResult), MonadIO m, IsRepo a, Gio.File.IsFile b, Gio.File.IsFile c, Gio.Cancellable.IsCancellable d) => O.MethodInfo RepoVerifyCommitExtMethodInfo a signature where
    overloadedMethod = repoVerifyCommitExt

#endif

-- method Repo::verify_commit_for_remote
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Repository" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "commit_checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII SHA256 checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "OSTree remote to use for configuration"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "OSTree" , name = "GpgVerifyResult" })
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_verify_commit_for_remote" ostree_repo_verify_commit_for_remote :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- commit_checksum : TBasicType TUTF8
    CString ->                              -- remote_name : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr OSTree.GpgVerifyResult.GpgVerifyResult)

-- | Read GPG signature(s) on the commit named by the ASCII checksum
-- /@commitChecksum@/ and return detailed results, based on the keyring
-- configured for /@remote@/.
repoVerifyCommitForRemote ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repository
    -> T.Text
    -- ^ /@commitChecksum@/: ASCII SHA256 checksum
    -> T.Text
    -- ^ /@remoteName@/: OSTree remote to use for configuration
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m OSTree.GpgVerifyResult.GpgVerifyResult
    -- ^ __Returns:__ an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult', or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
repoVerifyCommitForRemote :: a -> Text -> Text -> Maybe b -> m GpgVerifyResult
repoVerifyCommitForRemote self :: a
self commitChecksum :: Text
commitChecksum remoteName :: Text
remoteName cancellable :: Maybe b
cancellable = IO GpgVerifyResult -> m GpgVerifyResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GpgVerifyResult -> m GpgVerifyResult)
-> IO GpgVerifyResult -> m GpgVerifyResult
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
commitChecksum' <- Text -> IO CString
textToCString Text
commitChecksum
    CString
remoteName' <- Text -> IO CString
textToCString Text
remoteName
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO GpgVerifyResult -> IO () -> IO GpgVerifyResult
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GpgVerifyResult
result <- (Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
-> IO (Ptr GpgVerifyResult)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
 -> IO (Ptr GpgVerifyResult))
-> (Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
-> IO (Ptr GpgVerifyResult)
forall a b. (a -> b) -> a -> b
$ Ptr Repo
-> CString
-> CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr GpgVerifyResult)
ostree_repo_verify_commit_for_remote Ptr Repo
self' CString
commitChecksum' CString
remoteName' Ptr Cancellable
maybeCancellable
        Text -> Ptr GpgVerifyResult -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoVerifyCommitForRemote" Ptr GpgVerifyResult
result
        GpgVerifyResult
result' <- ((ManagedPtr GpgVerifyResult -> GpgVerifyResult)
-> Ptr GpgVerifyResult -> IO GpgVerifyResult
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr GpgVerifyResult -> GpgVerifyResult
OSTree.GpgVerifyResult.GpgVerifyResult) Ptr GpgVerifyResult
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commitChecksum'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        GpgVerifyResult -> IO GpgVerifyResult
forall (m :: * -> *) a. Monad m => a -> m a
return GpgVerifyResult
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
commitChecksum'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
     )

#if defined(ENABLE_OVERLOADING)
data RepoVerifyCommitForRemoteMethodInfo
instance (signature ~ (T.Text -> T.Text -> Maybe (b) -> m OSTree.GpgVerifyResult.GpgVerifyResult), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoVerifyCommitForRemoteMethodInfo a signature where
    overloadedMethod = repoVerifyCommitForRemote

#endif

-- method Repo::verify_summary
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "remote_name"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Name of remote" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "summary"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Summary data as a #GBytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "signatures"
--           , argType = TInterface Name { namespace = "GLib" , name = "Bytes" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Summary signatures as a #GBytes"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just
--               (TInterface
--                  Name { namespace = "OSTree" , name = "GpgVerifyResult" })
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_verify_summary" ostree_repo_verify_summary :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- remote_name : TBasicType TUTF8
    Ptr GLib.Bytes.Bytes ->                 -- summary : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr GLib.Bytes.Bytes ->                 -- signatures : TInterface (Name {namespace = "GLib", name = "Bytes"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr OSTree.GpgVerifyResult.GpgVerifyResult)

-- | Verify /@signatures@/ for /@summary@/ data using GPG keys in the keyring for
-- /@remoteName@/, and return an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult'.
repoVerifySummary ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@remoteName@/: Name of remote
    -> GLib.Bytes.Bytes
    -- ^ /@summary@/: Summary data as a t'GI.GLib.Structs.Bytes.Bytes'
    -> GLib.Bytes.Bytes
    -- ^ /@signatures@/: Summary signatures as a t'GI.GLib.Structs.Bytes.Bytes'
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m OSTree.GpgVerifyResult.GpgVerifyResult
    -- ^ __Returns:__ an t'GI.OSTree.Objects.GpgVerifyResult.GpgVerifyResult', or 'P.Nothing' on error /(Can throw 'Data.GI.Base.GError.GError')/
repoVerifySummary :: a -> Text -> Bytes -> Bytes -> Maybe b -> m GpgVerifyResult
repoVerifySummary self :: a
self remoteName :: Text
remoteName summary :: Bytes
summary signatures :: Bytes
signatures cancellable :: Maybe b
cancellable = IO GpgVerifyResult -> m GpgVerifyResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO GpgVerifyResult -> m GpgVerifyResult)
-> IO GpgVerifyResult -> m GpgVerifyResult
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
remoteName' <- Text -> IO CString
textToCString Text
remoteName
    Ptr Bytes
summary' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
summary
    Ptr Bytes
signatures' <- Bytes -> IO (Ptr Bytes)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr Bytes
signatures
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO GpgVerifyResult -> IO () -> IO GpgVerifyResult
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr GpgVerifyResult
result <- (Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
-> IO (Ptr GpgVerifyResult)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
 -> IO (Ptr GpgVerifyResult))
-> (Ptr (Ptr GError) -> IO (Ptr GpgVerifyResult))
-> IO (Ptr GpgVerifyResult)
forall a b. (a -> b) -> a -> b
$ Ptr Repo
-> CString
-> Ptr Bytes
-> Ptr Bytes
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr GpgVerifyResult)
ostree_repo_verify_summary Ptr Repo
self' CString
remoteName' Ptr Bytes
summary' Ptr Bytes
signatures' Ptr Cancellable
maybeCancellable
        Text -> Ptr GpgVerifyResult -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoVerifySummary" Ptr GpgVerifyResult
result
        GpgVerifyResult
result' <- ((ManagedPtr GpgVerifyResult -> GpgVerifyResult)
-> Ptr GpgVerifyResult -> IO GpgVerifyResult
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr GpgVerifyResult -> GpgVerifyResult
OSTree.GpgVerifyResult.GpgVerifyResult) Ptr GpgVerifyResult
result
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
summary
        Bytes -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr Bytes
signatures
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
        GpgVerifyResult -> IO GpgVerifyResult
forall (m :: * -> *) a. Monad m => a -> m a
return GpgVerifyResult
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
remoteName'
     )

#if defined(ENABLE_OVERLOADING)
data RepoVerifySummaryMethodInfo
instance (signature ~ (T.Text -> GLib.Bytes.Bytes -> GLib.Bytes.Bytes -> Maybe (b) -> m OSTree.GpgVerifyResult.GpgVerifyResult), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoVerifySummaryMethodInfo a signature where
    overloadedMethod = repoVerifySummary

#endif

-- method Repo::write_archive_to_mtree
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "An #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "archive"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "A path to an archive file"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mtree"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "MutableTree" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The #OstreeMutableTree to write to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifier"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoCommitModifier" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Optional commit modifier"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "autocreate_parents"
--           , argType = TBasicType TBoolean
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Autocreate parent directories"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_archive_to_mtree" ostree_repo_write_archive_to_mtree :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.File.File ->                    -- archive : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr OSTree.MutableTree.MutableTree ->   -- mtree : TInterface (Name {namespace = "OSTree", name = "MutableTree"})
    Ptr OSTree.RepoCommitModifier.RepoCommitModifier -> -- modifier : TInterface (Name {namespace = "OSTree", name = "RepoCommitModifier"})
    CInt ->                                 -- autocreate_parents : TBasicType TBoolean
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Import an archive file /@archive@/ into the repository, and write its
-- file structure to /@mtree@/.
repoWriteArchiveToMtree ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.File.IsFile b, OSTree.MutableTree.IsMutableTree c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@self@/: An t'GI.OSTree.Objects.Repo.Repo'
    -> b
    -- ^ /@archive@/: A path to an archive file
    -> c
    -- ^ /@mtree@/: The t'GI.OSTree.Objects.MutableTree.MutableTree' to write to
    -> Maybe (OSTree.RepoCommitModifier.RepoCommitModifier)
    -- ^ /@modifier@/: Optional commit modifier
    -> Bool
    -- ^ /@autocreateParents@/: Autocreate parent directories
    -> Maybe (d)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteArchiveToMtree :: a -> b -> c -> Maybe RepoCommitModifier -> Bool -> Maybe d -> m ()
repoWriteArchiveToMtree self :: a
self archive :: b
archive mtree :: c
mtree modifier :: Maybe RepoCommitModifier
modifier autocreateParents :: Bool
autocreateParents cancellable :: Maybe d
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
archive' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
archive
    Ptr MutableTree
mtree' <- c -> IO (Ptr MutableTree)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
mtree
    Ptr RepoCommitModifier
maybeModifier <- case Maybe RepoCommitModifier
modifier of
        Nothing -> Ptr RepoCommitModifier -> IO (Ptr RepoCommitModifier)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RepoCommitModifier
forall a. Ptr a
nullPtr
        Just jModifier :: RepoCommitModifier
jModifier -> do
            Ptr RepoCommitModifier
jModifier' <- RepoCommitModifier -> IO (Ptr RepoCommitModifier)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RepoCommitModifier
jModifier
            Ptr RepoCommitModifier -> IO (Ptr RepoCommitModifier)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RepoCommitModifier
jModifier'
    let autocreateParents' :: CInt
autocreateParents' = (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CInt) -> (Bool -> Int) -> Bool -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Int
forall a. Enum a => a -> Int
fromEnum) Bool
autocreateParents
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Ptr File
-> Ptr MutableTree
-> Ptr RepoCommitModifier
-> CInt
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_archive_to_mtree Ptr Repo
self' Ptr File
archive' Ptr MutableTree
mtree' Ptr RepoCommitModifier
maybeModifier CInt
autocreateParents' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
archive
        c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
mtree
        Maybe RepoCommitModifier -> (RepoCommitModifier -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RepoCommitModifier
modifier RepoCommitModifier -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoWriteArchiveToMtreeMethodInfo
instance (signature ~ (b -> c -> Maybe (OSTree.RepoCommitModifier.RepoCommitModifier) -> Bool -> Maybe (d) -> m ()), MonadIO m, IsRepo a, Gio.File.IsFile b, OSTree.MutableTree.IsMutableTree c, Gio.Cancellable.IsCancellable d) => O.MethodInfo RepoWriteArchiveToMtreeMethodInfo a signature where
    overloadedMethod = repoWriteArchiveToMtree

#endif

-- method Repo::write_commit
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "ASCII SHA256 checksum for parent, or %NULL for none"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subject"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Subject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "body"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Just "Body" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "metadata"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GVariant of type a{sv}, or %NULL for none"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "root"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "RepoFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The tree to point the commit to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_commit"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Resulting ASCII SHA256 checksum for commit"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_commit" ostree_repo_write_commit :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- parent : TBasicType TUTF8
    CString ->                              -- subject : TBasicType TUTF8
    CString ->                              -- body : TBasicType TUTF8
    Ptr GVariant ->                         -- metadata : TVariant
    Ptr OSTree.RepoFile.RepoFile ->         -- root : TInterface (Name {namespace = "OSTree", name = "RepoFile"})
    Ptr CString ->                          -- out_commit : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Write a commit metadata object, referencing /@rootContentsChecksum@/
-- and /@rootMetadataChecksum@/.
repoWriteCommit ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, OSTree.RepoFile.IsRepoFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> Maybe (T.Text)
    -- ^ /@parent@/: ASCII SHA256 checksum for parent, or 'P.Nothing' for none
    -> Maybe (T.Text)
    -- ^ /@subject@/: Subject
    -> Maybe (T.Text)
    -- ^ /@body@/: Body
    -> Maybe (GVariant)
    -- ^ /@metadata@/: GVariant of type a{sv}, or 'P.Nothing' for none
    -> b
    -- ^ /@root@/: The tree to point the commit to
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m (T.Text)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteCommit :: a
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe GVariant
-> b
-> Maybe c
-> m Text
repoWriteCommit self :: a
self parent :: Maybe Text
parent subject :: Maybe Text
subject body :: Maybe Text
body metadata :: Maybe GVariant
metadata root :: b
root cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeParent <- case Maybe Text
parent of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jParent :: Text
jParent -> do
            CString
jParent' <- Text -> IO CString
textToCString Text
jParent
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jParent'
    CString
maybeSubject <- case Maybe Text
subject of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jSubject :: Text
jSubject -> do
            CString
jSubject' <- Text -> IO CString
textToCString Text
jSubject
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jSubject'
    CString
maybeBody <- case Maybe Text
body of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jBody :: Text
jBody -> do
            CString
jBody' <- Text -> IO CString
textToCString Text
jBody
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jBody'
    Ptr GVariant
maybeMetadata <- case Maybe GVariant
metadata of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jMetadata :: GVariant
jMetadata -> do
            Ptr GVariant
jMetadata' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jMetadata
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jMetadata'
    Ptr RepoFile
root' <- b -> IO (Ptr RepoFile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
root
    Ptr CString
outCommit <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Text -> IO () -> IO Text
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 Repo
-> CString
-> CString
-> CString
-> Ptr GVariant
-> Ptr RepoFile
-> Ptr CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_commit Ptr Repo
self' CString
maybeParent CString
maybeSubject CString
maybeBody Ptr GVariant
maybeMetadata Ptr RepoFile
root' Ptr CString
outCommit Ptr Cancellable
maybeCancellable
        CString
outCommit' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outCommit
        Text
outCommit'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outCommit'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
outCommit'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
metadata GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
root
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeParent
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeSubject
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeBody
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outCommit
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
outCommit''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeParent
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeSubject
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeBody
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outCommit
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteCommitMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> Maybe (GVariant) -> b -> Maybe (c) -> m (T.Text)), MonadIO m, IsRepo a, OSTree.RepoFile.IsRepoFile b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoWriteCommitMethodInfo a signature where
    overloadedMethod = repoWriteCommit

#endif

-- method Repo::write_commit_detached_metadata
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "ASCII SHA256 commit checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "metadata"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just
--                       "Metadata to associate with commit in with format \"a{sv}\", or %NULL to delete"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_commit_detached_metadata" ostree_repo_write_commit_detached_metadata :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr GVariant ->                         -- metadata : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Replace any existing metadata associated with commit referred to by
-- /@checksum@/ with /@metadata@/.  If /@metadata@/ is 'P.Nothing', then existing
-- data will be deleted.
repoWriteCommitDetachedMetadata ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@checksum@/: ASCII SHA256 commit checksum
    -> Maybe (GVariant)
    -- ^ /@metadata@/: Metadata to associate with commit in with format \"a{sv}\", or 'P.Nothing' to delete
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteCommitDetachedMetadata :: a -> Text -> Maybe GVariant -> Maybe b -> m ()
repoWriteCommitDetachedMetadata self :: a
self checksum :: Text
checksum metadata :: Maybe GVariant
metadata cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    Ptr GVariant
maybeMetadata <- case Maybe GVariant
metadata of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jMetadata :: GVariant
jMetadata -> do
            Ptr GVariant
jMetadata' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jMetadata
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jMetadata'
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> Ptr GVariant
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_commit_detached_metadata Ptr Repo
self' CString
checksum' Ptr GVariant
maybeMetadata Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
metadata GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteCommitDetachedMetadataMethodInfo
instance (signature ~ (T.Text -> Maybe (GVariant) -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoWriteCommitDetachedMetadataMethodInfo a signature where
    overloadedMethod = repoWriteCommitDetachedMetadata

#endif

-- method Repo::write_commit_with_time
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "parent"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "ASCII SHA256 checksum for parent, or %NULL for none"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "subject"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Subject" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "body"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Just "Body" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "metadata"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "GVariant of type a{sv}, or %NULL for none"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "root"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "RepoFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The tree to point the commit to"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "time"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The time to use to stamp the commit"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_commit"
--           , argType = TBasicType TUTF8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Resulting ASCII SHA256 checksum for commit"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_commit_with_time" ostree_repo_write_commit_with_time :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- parent : TBasicType TUTF8
    CString ->                              -- subject : TBasicType TUTF8
    CString ->                              -- body : TBasicType TUTF8
    Ptr GVariant ->                         -- metadata : TVariant
    Ptr OSTree.RepoFile.RepoFile ->         -- root : TInterface (Name {namespace = "OSTree", name = "RepoFile"})
    Word64 ->                               -- time : TBasicType TUInt64
    Ptr CString ->                          -- out_commit : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Write a commit metadata object, referencing /@rootContentsChecksum@/
-- and /@rootMetadataChecksum@/.
repoWriteCommitWithTime ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, OSTree.RepoFile.IsRepoFile b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> Maybe (T.Text)
    -- ^ /@parent@/: ASCII SHA256 checksum for parent, or 'P.Nothing' for none
    -> Maybe (T.Text)
    -- ^ /@subject@/: Subject
    -> Maybe (T.Text)
    -- ^ /@body@/: Body
    -> Maybe (GVariant)
    -- ^ /@metadata@/: GVariant of type a{sv}, or 'P.Nothing' for none
    -> b
    -- ^ /@root@/: The tree to point the commit to
    -> Word64
    -- ^ /@time@/: The time to use to stamp the commit
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m (T.Text)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteCommitWithTime :: a
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe GVariant
-> b
-> Word64
-> Maybe c
-> m Text
repoWriteCommitWithTime self :: a
self parent :: Maybe Text
parent subject :: Maybe Text
subject body :: Maybe Text
body metadata :: Maybe GVariant
metadata root :: b
root time :: Word64
time cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeParent <- case Maybe Text
parent of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jParent :: Text
jParent -> do
            CString
jParent' <- Text -> IO CString
textToCString Text
jParent
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jParent'
    CString
maybeSubject <- case Maybe Text
subject of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jSubject :: Text
jSubject -> do
            CString
jSubject' <- Text -> IO CString
textToCString Text
jSubject
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jSubject'
    CString
maybeBody <- case Maybe Text
body of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jBody :: Text
jBody -> do
            CString
jBody' <- Text -> IO CString
textToCString Text
jBody
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jBody'
    Ptr GVariant
maybeMetadata <- case Maybe GVariant
metadata of
        Nothing -> Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
forall a. Ptr a
nullPtr
        Just jMetadata :: GVariant
jMetadata -> do
            Ptr GVariant
jMetadata' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
jMetadata
            Ptr GVariant -> IO (Ptr GVariant)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr GVariant
jMetadata'
    Ptr RepoFile
root' <- b -> IO (Ptr RepoFile)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
root
    Ptr CString
outCommit <- IO (Ptr CString)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr CString)
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Text -> IO () -> IO Text
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 Repo
-> CString
-> CString
-> CString
-> Ptr GVariant
-> Ptr RepoFile
-> Word64
-> Ptr CString
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_commit_with_time Ptr Repo
self' CString
maybeParent CString
maybeSubject CString
maybeBody Ptr GVariant
maybeMetadata Ptr RepoFile
root' Word64
time Ptr CString
outCommit Ptr Cancellable
maybeCancellable
        CString
outCommit' <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
outCommit
        Text
outCommit'' <- HasCallStack => CString -> IO Text
CString -> IO Text
cstringToText CString
outCommit'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
outCommit'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        Maybe GVariant -> (GVariant -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe GVariant
metadata GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
root
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeParent
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeSubject
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeBody
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outCommit
        Text -> IO Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
outCommit''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeParent
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeSubject
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeBody
        Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
outCommit
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteCommitWithTimeMethodInfo
instance (signature ~ (Maybe (T.Text) -> Maybe (T.Text) -> Maybe (T.Text) -> Maybe (GVariant) -> b -> Word64 -> Maybe (c) -> m (T.Text)), MonadIO m, IsRepo a, OSTree.RepoFile.IsRepoFile b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoWriteCommitWithTimeMethodInfo a signature where
    overloadedMethod = repoWriteCommitWithTime

#endif

-- method Repo::write_config
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "new_config"
--           , argType =
--               TInterface Name { namespace = "GLib" , name = "KeyFile" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Overwrite the config file with this data"
--                 , 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_repo_write_config" ostree_repo_write_config :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr GLib.KeyFile.KeyFile ->             -- new_config : TInterface (Name {namespace = "GLib", name = "KeyFile"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Save /@newConfig@/ in place of this repository\'s config file.
repoWriteConfig ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a) =>
    a
    -- ^ /@self@/: Repo
    -> GLib.KeyFile.KeyFile
    -- ^ /@newConfig@/: Overwrite the config file with this data
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteConfig :: a -> KeyFile -> m ()
repoWriteConfig self :: a
self newConfig :: KeyFile
newConfig = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr KeyFile
newConfig' <- KeyFile -> IO (Ptr KeyFile)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr KeyFile
newConfig
    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 Repo -> Ptr KeyFile -> Ptr (Ptr GError) -> IO CInt
ostree_repo_write_config Ptr Repo
self' Ptr KeyFile
newConfig'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        KeyFile -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr KeyFile
newConfig
        () -> 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 RepoWriteConfigMethodInfo
instance (signature ~ (GLib.KeyFile.KeyFile -> m ()), MonadIO m, IsRepo a) => O.MethodInfo RepoWriteConfigMethodInfo a signature where
    overloadedMethod = repoWriteConfig

#endif

-- method Repo::write_content
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "expected_checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "If provided, validate content against this checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_input"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Content object stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Length of @object_input"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_csum"
--           , argType = TCArray False 32 (-1) (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Binary checksum" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_content" ostree_repo_write_content :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- expected_checksum : TBasicType TUTF8
    Ptr Gio.InputStream.InputStream ->      -- object_input : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Word64 ->                               -- length : TBasicType TUInt64
    Ptr (Ptr Word8) ->                      -- out_csum : TCArray False 32 (-1) (TBasicType TUInt8)
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Store the content object streamed as /@objectInput@/,
-- with total length /@length@/.  The actual checksum will
-- be returned as /@outCsum@/.
repoWriteContent ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> Maybe (T.Text)
    -- ^ /@expectedChecksum@/: If provided, validate content against this checksum
    -> b
    -- ^ /@objectInput@/: Content object stream
    -> Word64
    -- ^ /@length@/: Length of /@objectInput@/
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m (ByteString)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteContent :: a -> Maybe Text -> b -> Word64 -> Maybe c -> m ByteString
repoWriteContent self :: a
self expectedChecksum :: Maybe Text
expectedChecksum objectInput :: b
objectInput length_ :: Word64
length_ cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeExpectedChecksum <- case Maybe Text
expectedChecksum of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jExpectedChecksum :: Text
jExpectedChecksum -> do
            CString
jExpectedChecksum' <- Text -> IO CString
textToCString Text
jExpectedChecksum
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jExpectedChecksum'
    Ptr InputStream
objectInput' <- b -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
objectInput
    Ptr (Ptr Word8)
outCsum <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Word8))
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO ByteString -> IO () -> IO ByteString
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 Repo
-> CString
-> Ptr InputStream
-> Word64
-> Ptr (Ptr Word8)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_content Ptr Repo
self' CString
maybeExpectedChecksum Ptr InputStream
objectInput' Word64
length_ Ptr (Ptr Word8)
outCsum Ptr Cancellable
maybeCancellable
        Ptr Word8
outCsum' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
outCsum
        ByteString
outCsum'' <- (Integer -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength 32) Ptr Word8
outCsum'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
outCsum'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
objectInput
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeExpectedChecksum
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
outCsum
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
outCsum''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeExpectedChecksum
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
outCsum
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteContentMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> Word64 -> Maybe (c) -> m (ByteString)), MonadIO m, IsRepo a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoWriteContentMethodInfo a signature where
    overloadedMethod = repoWriteContent

#endif

-- method Repo::write_content_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "expected_checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "If provided, validate content against this checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Input" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Length of @object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Invoked when content is writed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "User data for @callback"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_write_content_async" ostree_repo_write_content_async :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- expected_checksum : TBasicType TUTF8
    Ptr Gio.InputStream.InputStream ->      -- object : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Word64 ->                               -- length : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously store the content object /@object@/.  If provided, the
-- checksum /@expectedChecksum@/ will be verified.
repoWriteContentAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> Maybe (T.Text)
    -- ^ /@expectedChecksum@/: If provided, validate content against this checksum
    -> b
    -- ^ /@object@/: Input
    -> Word64
    -- ^ /@length@/: Length of /@object@/
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: Invoked when content is writed
    -> m ()
repoWriteContentAsync :: a
-> Maybe Text
-> b
-> Word64
-> Maybe c
-> Maybe AsyncReadyCallback
-> m ()
repoWriteContentAsync self :: a
self expectedChecksum :: Maybe Text
expectedChecksum object :: b
object length_ :: Word64
length_ cancellable :: Maybe c
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
maybeExpectedChecksum <- case Maybe Text
expectedChecksum of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jExpectedChecksum :: Text
jExpectedChecksum -> do
            CString
jExpectedChecksum' <- Text -> IO CString
textToCString Text
jExpectedChecksum
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jExpectedChecksum'
    Ptr InputStream
object' <- b -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
object
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Repo
-> CString
-> Ptr InputStream
-> Word64
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ostree_repo_write_content_async Ptr Repo
self' CString
maybeExpectedChecksum Ptr InputStream
object' Word64
length_ Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
object
    Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeExpectedChecksum
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RepoWriteContentAsyncMethodInfo
instance (signature ~ (Maybe (T.Text) -> b -> Word64 -> Maybe (c) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsRepo a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoWriteContentAsyncMethodInfo a signature where
    overloadedMethod = repoWriteContentAsync

#endif

-- method Repo::write_content_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #OstreeRepo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a #GAsyncResult" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_csum"
--           , argType = TBasicType TUInt8
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "A binary SHA256 checksum of the content object"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_write_content_finish" ostree_repo_write_content_finish :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr Word8 ->                            -- out_csum : TBasicType TUInt8
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Completes an invocation of 'GI.OSTree.Objects.Repo.repoWriteContentAsync'.
repoWriteContentFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: a t'GI.OSTree.Objects.Repo.Repo'
    -> b
    -- ^ /@result@/: a t'GI.Gio.Interfaces.AsyncResult.AsyncResult'
    -> m (Word8)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteContentFinish :: a -> b -> m Word8
repoWriteContentFinish self :: a
self result_ :: b
result_ = IO Word8 -> m Word8
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Word8 -> m Word8) -> IO Word8 -> m Word8
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr Word8
outCsum <- IO (Ptr Word8)
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr Word8)
    IO Word8 -> IO () -> IO Word8
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 Repo
-> Ptr AsyncResult -> Ptr Word8 -> Ptr (Ptr GError) -> IO CInt
ostree_repo_write_content_finish Ptr Repo
self' Ptr AsyncResult
result_' Ptr Word8
outCsum
        Word8
outCsum' <- Ptr Word8 -> IO Word8
forall a. Storable a => Ptr a -> IO a
peek Ptr Word8
outCsum
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
outCsum
        Word8 -> IO Word8
forall (m :: * -> *) a. Monad m => a -> m a
return Word8
outCsum'
     ) (do
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
outCsum
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteContentFinishMethodInfo
instance (signature ~ (b -> m (Word8)), MonadIO m, IsRepo a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo RepoWriteContentFinishMethodInfo a signature where
    overloadedMethod = repoWriteContentFinish

#endif

-- method Repo::write_content_trusted
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "Store content using this ASCII SHA256 checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_input"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Content stream" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Length of @object_input"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_content_trusted" ostree_repo_write_content_trusted :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr Gio.InputStream.InputStream ->      -- object_input : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Word64 ->                               -- length : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Store the content object streamed as /@objectInput@/, with total
-- length /@length@/.  The given /@checksum@/ will be treated as trusted.
-- 
-- This function should be used when importing file objects from local
-- disk, for example.
repoWriteContentTrusted ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> T.Text
    -- ^ /@checksum@/: Store content using this ASCII SHA256 checksum
    -> b
    -- ^ /@objectInput@/: Content stream
    -> Word64
    -- ^ /@length@/: Length of /@objectInput@/
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteContentTrusted :: a -> Text -> b -> Word64 -> Maybe c -> m ()
repoWriteContentTrusted self :: a
self checksum :: Text
checksum objectInput :: b
objectInput length_ :: Word64
length_ cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    Ptr InputStream
objectInput' <- b -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
objectInput
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CString
-> Ptr InputStream
-> Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_content_trusted Ptr Repo
self' CString
checksum' Ptr InputStream
objectInput' Word64
length_ Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
objectInput
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteContentTrustedMethodInfo
instance (signature ~ (T.Text -> b -> Word64 -> Maybe (c) -> m ()), MonadIO m, IsRepo a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoWriteContentTrustedMethodInfo a signature where
    overloadedMethod = repoWriteContentTrusted

#endif

-- method Repo::write_dfd_to_mtree
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dfd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Directory file descriptor"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Path" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mtree"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "MutableTree" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Overlay directory contents into this tree"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifier"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoCommitModifier" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Optional modifier" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_dfd_to_mtree" ostree_repo_write_dfd_to_mtree :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Int32 ->                                -- dfd : TBasicType TInt
    CString ->                              -- path : TBasicType TUTF8
    Ptr OSTree.MutableTree.MutableTree ->   -- mtree : TInterface (Name {namespace = "OSTree", name = "MutableTree"})
    Ptr OSTree.RepoCommitModifier.RepoCommitModifier -> -- modifier : TInterface (Name {namespace = "OSTree", name = "RepoCommitModifier"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Store as objects all contents of the directory referred to by /@dfd@/
-- and /@path@/ all children into the repository /@self@/, overlaying the
-- resulting filesystem hierarchy into /@mtree@/.
repoWriteDfdToMtree ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, OSTree.MutableTree.IsMutableTree b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> Int32
    -- ^ /@dfd@/: Directory file descriptor
    -> T.Text
    -- ^ /@path@/: Path
    -> b
    -- ^ /@mtree@/: Overlay directory contents into this tree
    -> Maybe (OSTree.RepoCommitModifier.RepoCommitModifier)
    -- ^ /@modifier@/: Optional modifier
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteDfdToMtree :: a
-> Int32
-> Text
-> b
-> Maybe RepoCommitModifier
-> Maybe c
-> m ()
repoWriteDfdToMtree self :: a
self dfd :: Int32
dfd path :: Text
path mtree :: b
mtree modifier :: Maybe RepoCommitModifier
modifier cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr MutableTree
mtree' <- b -> IO (Ptr MutableTree)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
mtree
    Ptr RepoCommitModifier
maybeModifier <- case Maybe RepoCommitModifier
modifier of
        Nothing -> Ptr RepoCommitModifier -> IO (Ptr RepoCommitModifier)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RepoCommitModifier
forall a. Ptr a
nullPtr
        Just jModifier :: RepoCommitModifier
jModifier -> do
            Ptr RepoCommitModifier
jModifier' <- RepoCommitModifier -> IO (Ptr RepoCommitModifier)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RepoCommitModifier
jModifier
            Ptr RepoCommitModifier -> IO (Ptr RepoCommitModifier)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RepoCommitModifier
jModifier'
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Int32
-> CString
-> Ptr MutableTree
-> Ptr RepoCommitModifier
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_dfd_to_mtree Ptr Repo
self' Int32
dfd CString
path' Ptr MutableTree
mtree' Ptr RepoCommitModifier
maybeModifier Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
mtree
        Maybe RepoCommitModifier -> (RepoCommitModifier -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RepoCommitModifier
modifier RepoCommitModifier -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteDfdToMtreeMethodInfo
instance (signature ~ (Int32 -> T.Text -> b -> Maybe (OSTree.RepoCommitModifier.RepoCommitModifier) -> Maybe (c) -> m ()), MonadIO m, IsRepo a, OSTree.MutableTree.IsMutableTree b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoWriteDfdToMtreeMethodInfo a signature where
    overloadedMethod = repoWriteDfdToMtree

#endif

-- method Repo::write_directory_to_mtree
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "dir"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Path to a directory"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mtree"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "MutableTree" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Overlay directory contents into this tree"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "modifier"
--           , argType =
--               TInterface
--                 Name { namespace = "OSTree" , name = "RepoCommitModifier" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Optional modifier" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_directory_to_mtree" ostree_repo_write_directory_to_mtree :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.File.File ->                    -- dir : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr OSTree.MutableTree.MutableTree ->   -- mtree : TInterface (Name {namespace = "OSTree", name = "MutableTree"})
    Ptr OSTree.RepoCommitModifier.RepoCommitModifier -> -- modifier : TInterface (Name {namespace = "OSTree", name = "RepoCommitModifier"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Store objects for /@dir@/ and all children into the repository /@self@/,
-- overlaying the resulting filesystem hierarchy into /@mtree@/.
repoWriteDirectoryToMtree ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.File.IsFile b, OSTree.MutableTree.IsMutableTree c, Gio.Cancellable.IsCancellable d) =>
    a
    -- ^ /@self@/: Repo
    -> b
    -- ^ /@dir@/: Path to a directory
    -> c
    -- ^ /@mtree@/: Overlay directory contents into this tree
    -> Maybe (OSTree.RepoCommitModifier.RepoCommitModifier)
    -- ^ /@modifier@/: Optional modifier
    -> Maybe (d)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteDirectoryToMtree :: a -> b -> c -> Maybe RepoCommitModifier -> Maybe d -> m ()
repoWriteDirectoryToMtree self :: a
self dir :: b
dir mtree :: c
mtree modifier :: Maybe RepoCommitModifier
modifier cancellable :: Maybe d
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr File
dir' <- b -> IO (Ptr File)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
dir
    Ptr MutableTree
mtree' <- c -> IO (Ptr MutableTree)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
mtree
    Ptr RepoCommitModifier
maybeModifier <- case Maybe RepoCommitModifier
modifier of
        Nothing -> Ptr RepoCommitModifier -> IO (Ptr RepoCommitModifier)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RepoCommitModifier
forall a. Ptr a
nullPtr
        Just jModifier :: RepoCommitModifier
jModifier -> do
            Ptr RepoCommitModifier
jModifier' <- RepoCommitModifier -> IO (Ptr RepoCommitModifier)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr RepoCommitModifier
jModifier
            Ptr RepoCommitModifier -> IO (Ptr RepoCommitModifier)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr RepoCommitModifier
jModifier'
    Ptr Cancellable
maybeCancellable <- case Maybe d
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: d
jCancellable -> do
            Ptr Cancellable
jCancellable' <- d -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr d
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> Ptr File
-> Ptr MutableTree
-> Ptr RepoCommitModifier
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_directory_to_mtree Ptr Repo
self' Ptr File
dir' Ptr MutableTree
mtree' Ptr RepoCommitModifier
maybeModifier Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
dir
        c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr c
mtree
        Maybe RepoCommitModifier -> (RepoCommitModifier -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe RepoCommitModifier
modifier RepoCommitModifier -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Maybe d -> (d -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe d
cancellable d -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        () -> 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 RepoWriteDirectoryToMtreeMethodInfo
instance (signature ~ (b -> c -> Maybe (OSTree.RepoCommitModifier.RepoCommitModifier) -> Maybe (d) -> m ()), MonadIO m, IsRepo a, Gio.File.IsFile b, OSTree.MutableTree.IsMutableTree c, Gio.Cancellable.IsCancellable d) => O.MethodInfo RepoWriteDirectoryToMtreeMethodInfo a signature where
    overloadedMethod = repoWriteDirectoryToMtree

#endif

-- method Repo::write_metadata
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "expected_checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "If provided, validate content against this checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Metadata" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_csum"
--           , argType = TCArray False 32 (-1) (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Binary checksum" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_metadata" ostree_repo_write_metadata :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- expected_checksum : TBasicType TUTF8
    Ptr GVariant ->                         -- object : TVariant
    Ptr (Ptr Word8) ->                      -- out_csum : TCArray False 32 (-1) (TBasicType TUInt8)
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Store the metadata object /@object@/.  Return the checksum
-- as /@outCsum@/.
-- 
-- If /@expectedChecksum@/ is not 'P.Nothing', verify it against the
-- computed checksum.
repoWriteMetadata ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> Maybe (T.Text)
    -- ^ /@expectedChecksum@/: If provided, validate content against this checksum
    -> GVariant
    -- ^ /@object@/: Metadata
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m (ByteString)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteMetadata :: a
-> ObjectType -> Maybe Text -> GVariant -> Maybe b -> m ByteString
repoWriteMetadata self :: a
self objtype :: ObjectType
objtype expectedChecksum :: Maybe Text
expectedChecksum object :: GVariant
object cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
maybeExpectedChecksum <- case Maybe Text
expectedChecksum of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jExpectedChecksum :: Text
jExpectedChecksum -> do
            CString
jExpectedChecksum' <- Text -> IO CString
textToCString Text
jExpectedChecksum
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jExpectedChecksum'
    Ptr GVariant
object' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
object
    Ptr (Ptr Word8)
outCsum <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Word8))
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO ByteString -> IO () -> IO ByteString
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 Repo
-> CUInt
-> CString
-> Ptr GVariant
-> Ptr (Ptr Word8)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_metadata Ptr Repo
self' CUInt
objtype' CString
maybeExpectedChecksum Ptr GVariant
object' Ptr (Ptr Word8)
outCsum Ptr Cancellable
maybeCancellable
        Ptr Word8
outCsum' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
outCsum
        ByteString
outCsum'' <- (Integer -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength 32) Ptr Word8
outCsum'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
outCsum'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
object
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeExpectedChecksum
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
outCsum
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
outCsum''
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeExpectedChecksum
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
outCsum
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteMetadataMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> Maybe (T.Text) -> GVariant -> Maybe (b) -> m (ByteString)), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoWriteMetadataMethodInfo a signature where
    overloadedMethod = repoWriteMetadata

#endif

-- method Repo::write_metadata_async
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "expected_checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "If provided, validate content against this checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Metadata" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "callback"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncReadyCallback" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Invoked when metadata is writed"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeAsync
--           , argClosure = 6
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Data for @callback" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_write_metadata_async" ostree_repo_write_metadata_async :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- expected_checksum : TBasicType TUTF8
    Ptr GVariant ->                         -- object : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    FunPtr Gio.Callbacks.C_AsyncReadyCallback -> -- callback : TInterface (Name {namespace = "Gio", name = "AsyncReadyCallback"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Asynchronously store the metadata object /@variant@/.  If provided,
-- the checksum /@expectedChecksum@/ will be verified.
repoWriteMetadataAsync ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> Maybe (T.Text)
    -- ^ /@expectedChecksum@/: If provided, validate content against this checksum
    -> GVariant
    -- ^ /@object@/: Metadata
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> Maybe (Gio.Callbacks.AsyncReadyCallback)
    -- ^ /@callback@/: Invoked when metadata is writed
    -> m ()
repoWriteMetadataAsync :: a
-> ObjectType
-> Maybe Text
-> GVariant
-> Maybe b
-> Maybe AsyncReadyCallback
-> m ()
repoWriteMetadataAsync self :: a
self objtype :: ObjectType
objtype expectedChecksum :: Maybe Text
expectedChecksum object :: GVariant
object cancellable :: Maybe b
cancellable callback :: Maybe AsyncReadyCallback
callback = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
maybeExpectedChecksum <- case Maybe Text
expectedChecksum of
        Nothing -> CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
forall a. Ptr a
nullPtr
        Just jExpectedChecksum :: Text
jExpectedChecksum -> do
            CString
jExpectedChecksum' <- Text -> IO CString
textToCString Text
jExpectedChecksum
            CString -> IO CString
forall (m :: * -> *) a. Monad m => a -> m a
return CString
jExpectedChecksum'
    Ptr GVariant
object' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
object
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    FunPtr C_AsyncReadyCallback
maybeCallback <- case Maybe AsyncReadyCallback
callback of
        Nothing -> FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any -> FunPtr C_AsyncReadyCallback
forall a b. Ptr a -> FunPtr b
castPtrToFunPtr Ptr Any
forall a. Ptr a
nullPtr)
        Just jCallback :: AsyncReadyCallback
jCallback -> do
            Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback <- IO (Ptr (FunPtr C_AsyncReadyCallback))
forall a. Storable a => IO (Ptr a)
callocMem :: IO (Ptr (FunPtr Gio.Callbacks.C_AsyncReadyCallback))
            FunPtr C_AsyncReadyCallback
jCallback' <- C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
Gio.Callbacks.mk_AsyncReadyCallback (Maybe (Ptr (FunPtr C_AsyncReadyCallback))
-> AsyncReadyCallback_WithClosures -> C_AsyncReadyCallback
Gio.Callbacks.wrap_AsyncReadyCallback (Ptr (FunPtr C_AsyncReadyCallback)
-> Maybe (Ptr (FunPtr C_AsyncReadyCallback))
forall a. a -> Maybe a
Just Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback) (AsyncReadyCallback -> AsyncReadyCallback_WithClosures
Gio.Callbacks.drop_closures_AsyncReadyCallback AsyncReadyCallback
jCallback))
            Ptr (FunPtr C_AsyncReadyCallback)
-> FunPtr C_AsyncReadyCallback -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (FunPtr C_AsyncReadyCallback)
ptrcallback FunPtr C_AsyncReadyCallback
jCallback'
            FunPtr C_AsyncReadyCallback -> IO (FunPtr C_AsyncReadyCallback)
forall (m :: * -> *) a. Monad m => a -> m a
return FunPtr C_AsyncReadyCallback
jCallback'
    let userData :: Ptr a
userData = Ptr a
forall a. Ptr a
nullPtr
    Ptr Repo
-> CUInt
-> CString
-> Ptr GVariant
-> Ptr Cancellable
-> FunPtr C_AsyncReadyCallback
-> Ptr ()
-> IO ()
ostree_repo_write_metadata_async Ptr Repo
self' CUInt
objtype' CString
maybeExpectedChecksum Ptr GVariant
object' Ptr Cancellable
maybeCancellable FunPtr C_AsyncReadyCallback
maybeCallback Ptr ()
forall a. Ptr a
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
object
    Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
    CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
maybeExpectedChecksum
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
data RepoWriteMetadataAsyncMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> Maybe (T.Text) -> GVariant -> Maybe (b) -> Maybe (Gio.Callbacks.AsyncReadyCallback) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoWriteMetadataAsyncMethodInfo a signature where
    overloadedMethod = repoWriteMetadataAsync

#endif

-- method Repo::write_metadata_finish
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "result"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "AsyncResult" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Result" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_csum"
--           , argType = TCArray False 32 (-1) (TBasicType TUInt8)
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Binary checksum value"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       ]
-- Lengths: []
-- returnType: Just (TBasicType TBoolean)
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_write_metadata_finish" ostree_repo_write_metadata_finish :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr Gio.AsyncResult.AsyncResult ->      -- result : TInterface (Name {namespace = "Gio", name = "AsyncResult"})
    Ptr (Ptr Word8) ->                      -- out_csum : TCArray False 32 (-1) (TBasicType TUInt8)
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Complete a call to 'GI.OSTree.Objects.Repo.repoWriteMetadataAsync'.
repoWriteMetadataFinish ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.AsyncResult.IsAsyncResult b) =>
    a
    -- ^ /@self@/: Repo
    -> b
    -- ^ /@result@/: Result
    -> m (ByteString)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteMetadataFinish :: a -> b -> m ByteString
repoWriteMetadataFinish self :: a
self result_ :: b
result_ = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr AsyncResult
result_' <- b -> IO (Ptr AsyncResult)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
result_
    Ptr (Ptr Word8)
outCsum <- IO (Ptr (Ptr Word8))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Word8))
    IO ByteString -> IO () -> IO ByteString
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 Repo
-> Ptr AsyncResult
-> Ptr (Ptr Word8)
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_metadata_finish Ptr Repo
self' Ptr AsyncResult
result_' Ptr (Ptr Word8)
outCsum
        Ptr Word8
outCsum' <- Ptr (Ptr Word8) -> IO (Ptr Word8)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr Word8)
outCsum
        ByteString
outCsum'' <- (Integer -> Ptr Word8 -> IO ByteString
forall a. Integral a => a -> Ptr Word8 -> IO ByteString
unpackByteStringWithLength 32) Ptr Word8
outCsum'
        Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr Word8
outCsum'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
result_
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
outCsum
        ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
outCsum''
     ) (do
        Ptr (Ptr Word8) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr Word8)
outCsum
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteMetadataFinishMethodInfo
instance (signature ~ (b -> m (ByteString)), MonadIO m, IsRepo a, Gio.AsyncResult.IsAsyncResult b) => O.MethodInfo RepoWriteMetadataFinishMethodInfo a signature where
    overloadedMethod = repoWriteMetadataFinish

#endif

-- method Repo::write_metadata_stream_trusted
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Store object with this ASCII SHA256 checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object_input"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "InputStream" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Metadata object stream"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "length"
--           , argType = TBasicType TUInt64
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Length, may be 0 for unknown"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_metadata_stream_trusted" ostree_repo_write_metadata_stream_trusted :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr Gio.InputStream.InputStream ->      -- object_input : TInterface (Name {namespace = "Gio", name = "InputStream"})
    Word64 ->                               -- length : TBasicType TUInt64
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Store the metadata object /@variant@/; the provided /@checksum@/ is
-- trusted.
repoWriteMetadataStreamTrusted ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> T.Text
    -- ^ /@checksum@/: Store object with this ASCII SHA256 checksum
    -> b
    -- ^ /@objectInput@/: Metadata object stream
    -> Word64
    -- ^ /@length@/: Length, may be 0 for unknown
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteMetadataStreamTrusted :: a -> ObjectType -> Text -> b -> Word64 -> Maybe c -> m ()
repoWriteMetadataStreamTrusted self :: a
self objtype :: ObjectType
objtype checksum :: Text
checksum objectInput :: b
objectInput length_ :: Word64
length_ cancellable :: Maybe c
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    Ptr InputStream
objectInput' <- b -> IO (Ptr InputStream)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
objectInput
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CUInt
-> CString
-> Ptr InputStream
-> Word64
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_metadata_stream_trusted Ptr Repo
self' CUInt
objtype' CString
checksum' Ptr InputStream
objectInput' Word64
length_ Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
objectInput
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteMetadataStreamTrustedMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> T.Text -> b -> Word64 -> Maybe (c) -> m ()), MonadIO m, IsRepo a, Gio.InputStream.IsInputStream b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoWriteMetadataStreamTrustedMethodInfo a signature where
    overloadedMethod = repoWriteMetadataStreamTrusted

#endif

-- method Repo::write_metadata_trusted
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "objtype"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "ObjectType" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Object type" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "checksum"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Store object with this ASCII SHA256 checksum"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "variant"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Metadata object" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_metadata_trusted" ostree_repo_write_metadata_trusted :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    CUInt ->                                -- objtype : TInterface (Name {namespace = "OSTree", name = "ObjectType"})
    CString ->                              -- checksum : TBasicType TUTF8
    Ptr GVariant ->                         -- variant : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Store the metadata object /@variant@/; the provided /@checksum@/ is
-- trusted.
repoWriteMetadataTrusted ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) =>
    a
    -- ^ /@self@/: Repo
    -> OSTree.Enums.ObjectType
    -- ^ /@objtype@/: Object type
    -> T.Text
    -- ^ /@checksum@/: Store object with this ASCII SHA256 checksum
    -> GVariant
    -- ^ /@variant@/: Metadata object
    -> Maybe (b)
    -- ^ /@cancellable@/: Cancellable
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteMetadataTrusted :: a -> ObjectType -> Text -> GVariant -> Maybe b -> m ()
repoWriteMetadataTrusted self :: a
self objtype :: ObjectType
objtype checksum :: Text
checksum variant :: GVariant
variant cancellable :: Maybe b
cancellable = 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 Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    let objtype' :: CUInt
objtype' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (ObjectType -> Int) -> ObjectType -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ObjectType -> Int
forall a. Enum a => a -> Int
fromEnum) ObjectType
objtype
    CString
checksum' <- Text -> IO CString
textToCString Text
checksum
    Ptr GVariant
variant' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
variant
    Ptr Cancellable
maybeCancellable <- case Maybe b
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: b
jCancellable -> do
            Ptr Cancellable
jCancellable' <- b -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    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 Repo
-> CUInt
-> CString
-> Ptr GVariant
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_metadata_trusted Ptr Repo
self' CUInt
objtype' CString
checksum' Ptr GVariant
variant' Ptr Cancellable
maybeCancellable
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
variant
        Maybe b -> (b -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe b
cancellable b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
checksum'
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteMetadataTrustedMethodInfo
instance (signature ~ (OSTree.Enums.ObjectType -> T.Text -> GVariant -> Maybe (b) -> m ()), MonadIO m, IsRepo a, Gio.Cancellable.IsCancellable b) => O.MethodInfo RepoWriteMetadataTrustedMethodInfo a signature where
    overloadedMethod = repoWriteMetadataTrusted

#endif

-- method Repo::write_mtree
-- method type : OrdinaryMethod
-- Args: [ Arg
--           { argCName = "self"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "Repo" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Repo" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mtree"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "MutableTree" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Mutable tree" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_file"
--           , argType = TInterface Name { namespace = "Gio" , name = "File" }
--           , direction = DirectionOut
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText =
--                     Just "An #OstreeRepoFile representing @mtree's root."
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferEverything
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , 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_repo_write_mtree" ostree_repo_write_mtree :: 
    Ptr Repo ->                             -- self : TInterface (Name {namespace = "OSTree", name = "Repo"})
    Ptr OSTree.MutableTree.MutableTree ->   -- mtree : TInterface (Name {namespace = "OSTree", name = "MutableTree"})
    Ptr (Ptr Gio.File.File) ->              -- out_file : TInterface (Name {namespace = "Gio", name = "File"})
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | Write all metadata objects for /@mtree@/ to repo; the resulting
-- /@outFile@/ points to the 'GI.OSTree.Enums.ObjectTypeDirTree' object that
-- the /@mtree@/ represented.
repoWriteMtree ::
    (B.CallStack.HasCallStack, MonadIO m, IsRepo a, OSTree.MutableTree.IsMutableTree b, Gio.Cancellable.IsCancellable c) =>
    a
    -- ^ /@self@/: Repo
    -> b
    -- ^ /@mtree@/: Mutable tree
    -> Maybe (c)
    -- ^ /@cancellable@/: Cancellable
    -> m (Gio.File.File)
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoWriteMtree :: a -> b -> Maybe c -> m File
repoWriteMtree self :: a
self mtree :: b
mtree cancellable :: Maybe c
cancellable = IO File -> m File
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO File -> m File) -> IO File -> m File
forall a b. (a -> b) -> a -> b
$ do
    Ptr Repo
self' <- a -> IO (Ptr Repo)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
self
    Ptr MutableTree
mtree' <- b -> IO (Ptr MutableTree)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr b
mtree
    Ptr (Ptr File)
outFile <- IO (Ptr (Ptr File))
forall a. Storable a => IO (Ptr a)
allocMem :: IO (Ptr (Ptr Gio.File.File))
    Ptr Cancellable
maybeCancellable <- case Maybe c
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: c
jCancellable -> do
            Ptr Cancellable
jCancellable' <- c -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr c
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO File -> IO () -> IO File
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 Repo
-> Ptr MutableTree
-> Ptr (Ptr File)
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO CInt
ostree_repo_write_mtree Ptr Repo
self' Ptr MutableTree
mtree' Ptr (Ptr File)
outFile Ptr Cancellable
maybeCancellable
        Ptr File
outFile' <- Ptr (Ptr File) -> IO (Ptr File)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr File)
outFile
        File
outFile'' <- ((ManagedPtr File -> File) -> Ptr File -> IO File
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr File -> File
Gio.File.File) Ptr File
outFile'
        a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
self
        b -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr b
mtree
        Maybe c -> (c -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe c
cancellable c -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        Ptr (Ptr File) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr File)
outFile
        File -> IO File
forall (m :: * -> *) a. Monad m => a -> m a
return File
outFile''
     ) (do
        Ptr (Ptr File) -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr (Ptr File)
outFile
     )

#if defined(ENABLE_OVERLOADING)
data RepoWriteMtreeMethodInfo
instance (signature ~ (b -> Maybe (c) -> m (Gio.File.File)), MonadIO m, IsRepo a, OSTree.MutableTree.IsMutableTree b, Gio.Cancellable.IsCancellable c) => O.MethodInfo RepoWriteMtreeMethodInfo a signature where
    overloadedMethod = repoWriteMtree

#endif

-- method Repo::create_at
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "dfd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Directory fd" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Path" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "mode"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "RepoMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "The mode to store the repository in"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "options"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "a{sv}: See below for accepted keys"
--                 , sinceVersion = Nothing
--                 }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Cancellable" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "OSTree" , name = "Repo" })
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_create_at" ostree_repo_create_at :: 
    Int32 ->                                -- dfd : TBasicType TInt
    CString ->                              -- path : TBasicType TUTF8
    CUInt ->                                -- mode : TInterface (Name {namespace = "OSTree", name = "RepoMode"})
    Ptr GVariant ->                         -- options : TVariant
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Repo)

-- | This is a file-descriptor relative version of 'GI.OSTree.Objects.Repo.repoCreate'.
-- Create the underlying structure on disk for the repository, and call
-- 'GI.OSTree.Objects.Repo.repoOpenAt' on the result, preparing it for use.
-- 
-- If a repository already exists at /@dfd@/ + /@path@/ (defined by an @objects\/@
-- subdirectory existing), then this function will simply call
-- 'GI.OSTree.Objects.Repo.repoOpenAt'.  In other words, this function cannot be used to change
-- the mode or configuration (@repo\/config@) of an existing repo.
-- 
-- The /@options@/ dict may contain:
-- 
--   - collection-id: s: Set as collection ID in repo\/config (Since 2017.9)
repoCreateAt ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    Int32
    -- ^ /@dfd@/: Directory fd
    -> T.Text
    -- ^ /@path@/: Path
    -> OSTree.Enums.RepoMode
    -- ^ /@mode@/: The mode to store the repository in
    -> GVariant
    -- ^ /@options@/: a{sv}: See below for accepted keys
    -> Maybe (a)
    -- ^ /@cancellable@/: Cancellable
    -> m Repo
    -- ^ __Returns:__ A new OSTree repository reference /(Can throw 'Data.GI.Base.GError.GError')/
repoCreateAt :: Int32 -> Text -> RepoMode -> GVariant -> Maybe a -> m Repo
repoCreateAt dfd :: Int32
dfd path :: Text
path mode :: RepoMode
mode options :: GVariant
options cancellable :: Maybe a
cancellable = IO Repo -> m Repo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Repo -> m Repo) -> IO Repo -> m Repo
forall a b. (a -> b) -> a -> b
$ do
    CString
path' <- Text -> IO CString
textToCString Text
path
    let mode' :: CUInt
mode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (RepoMode -> Int) -> RepoMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoMode -> Int
forall a. Enum a => a -> Int
fromEnum) RepoMode
mode
    Ptr GVariant
options' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
options
    Ptr Cancellable
maybeCancellable <- case Maybe a
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: a
jCancellable -> do
            Ptr Cancellable
jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Repo -> IO () -> IO Repo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Repo
result <- (Ptr (Ptr GError) -> IO (Ptr Repo)) -> IO (Ptr Repo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Repo)) -> IO (Ptr Repo))
-> (Ptr (Ptr GError) -> IO (Ptr Repo)) -> IO (Ptr Repo)
forall a b. (a -> b) -> a -> b
$ Int32
-> CString
-> CUInt
-> Ptr GVariant
-> Ptr Cancellable
-> Ptr (Ptr GError)
-> IO (Ptr Repo)
ostree_repo_create_at Int32
dfd CString
path' CUInt
mode' Ptr GVariant
options' Ptr Cancellable
maybeCancellable
        Text -> Ptr Repo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoCreateAt" Ptr Repo
result
        Repo
result' <- ((ManagedPtr Repo -> Repo) -> Ptr Repo -> IO Repo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Repo -> Repo
Repo) Ptr Repo
result
        GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
options
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
cancellable a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
        Repo -> IO Repo
forall (m :: * -> *) a. Monad m => a -> m a
return Repo
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repo::mode_from_string
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "mode"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "out_mode"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "RepoMode" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , 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_repo_mode_from_string" ostree_repo_mode_from_string :: 
    CString ->                              -- mode : TBasicType TUTF8
    CUInt ->                                -- out_mode : TInterface (Name {namespace = "OSTree", name = "RepoMode"})
    Ptr (Ptr GError) ->                     -- error
    IO CInt

-- | /No description available in the introspection data./
repoModeFromString ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    T.Text
    -> OSTree.Enums.RepoMode
    -> m ()
    -- ^ /(Can throw 'Data.GI.Base.GError.GError')/
repoModeFromString :: Text -> RepoMode -> m ()
repoModeFromString mode :: Text
mode outMode :: RepoMode
outMode = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    CString
mode' <- Text -> IO CString
textToCString Text
mode
    let outMode' :: CUInt
outMode' = (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> (RepoMode -> Int) -> RepoMode -> CUInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RepoMode -> Int
forall a. Enum a => a -> Int
fromEnum) RepoMode
outMode
    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
$ CString -> CUInt -> Ptr (Ptr GError) -> IO CInt
ostree_repo_mode_from_string CString
mode' CUInt
outMode'
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mode'
        () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
mode'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repo::open_at
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "dfd"
--           , argType = TBasicType TInt
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Directory fd" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "path"
--           , argType = TBasicType TUTF8
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Just "Path" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "cancellable"
--           , argType =
--               TInterface Name { namespace = "Gio" , name = "Cancellable" }
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TInterface Name { namespace = "OSTree" , name = "Repo" })
-- throws : True
-- Skip return : False

foreign import ccall "ostree_repo_open_at" ostree_repo_open_at :: 
    Int32 ->                                -- dfd : TBasicType TInt
    CString ->                              -- path : TBasicType TUTF8
    Ptr Gio.Cancellable.Cancellable ->      -- cancellable : TInterface (Name {namespace = "Gio", name = "Cancellable"})
    Ptr (Ptr GError) ->                     -- error
    IO (Ptr Repo)

-- | This combines 'GI.OSTree.Objects.Repo.repoNew' (but using fd-relative access) with
-- 'GI.OSTree.Objects.Repo.repoOpen'.  Use this when you know you should be operating on an
-- already extant repository.  If you want to create one, use 'GI.OSTree.Objects.Repo.repoCreateAt'.
repoOpenAt ::
    (B.CallStack.HasCallStack, MonadIO m, Gio.Cancellable.IsCancellable a) =>
    Int32
    -- ^ /@dfd@/: Directory fd
    -> T.Text
    -- ^ /@path@/: Path
    -> Maybe (a)
    -> m Repo
    -- ^ __Returns:__ An accessor object for an OSTree repository located at /@dfd@/ + /@path@/ /(Can throw 'Data.GI.Base.GError.GError')/
repoOpenAt :: Int32 -> Text -> Maybe a -> m Repo
repoOpenAt dfd :: Int32
dfd path :: Text
path cancellable :: Maybe a
cancellable = IO Repo -> m Repo
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Repo -> m Repo) -> IO Repo -> m Repo
forall a b. (a -> b) -> a -> b
$ do
    CString
path' <- Text -> IO CString
textToCString Text
path
    Ptr Cancellable
maybeCancellable <- case Maybe a
cancellable of
        Nothing -> Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
forall a. Ptr a
nullPtr
        Just jCancellable :: a
jCancellable -> do
            Ptr Cancellable
jCancellable' <- a -> IO (Ptr Cancellable)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
jCancellable
            Ptr Cancellable -> IO (Ptr Cancellable)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr Cancellable
jCancellable'
    IO Repo -> IO () -> IO Repo
forall a b. IO a -> IO b -> IO a
onException (do
        Ptr Repo
result <- (Ptr (Ptr GError) -> IO (Ptr Repo)) -> IO (Ptr Repo)
forall a. (Ptr (Ptr GError) -> IO a) -> IO a
propagateGError ((Ptr (Ptr GError) -> IO (Ptr Repo)) -> IO (Ptr Repo))
-> (Ptr (Ptr GError) -> IO (Ptr Repo)) -> IO (Ptr Repo)
forall a b. (a -> b) -> a -> b
$ Int32
-> CString -> Ptr Cancellable -> Ptr (Ptr GError) -> IO (Ptr Repo)
ostree_repo_open_at Int32
dfd CString
path' Ptr Cancellable
maybeCancellable
        Text -> Ptr Repo -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoOpenAt" Ptr Repo
result
        Repo
result' <- ((ManagedPtr Repo -> Repo) -> Ptr Repo -> IO Repo
forall a b.
(HasCallStack, GObject a, GObject b) =>
(ManagedPtr a -> a) -> Ptr b -> IO a
wrapObject ManagedPtr Repo -> Repo
Repo) Ptr Repo
result
        Maybe a -> (a -> IO ()) -> IO ()
forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
cancellable a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
        Repo -> IO Repo
forall (m :: * -> *) a. Monad m => a -> m a
return Repo
result'
     ) (do
        CString -> IO ()
forall a. Ptr a -> IO ()
freeMem CString
path'
     )

#if defined(ENABLE_OVERLOADING)
#endif

-- method Repo::pull_default_console_progress_changed
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "progress"
--           , argType =
--               TInterface Name { namespace = "OSTree" , name = "AsyncProgress" }
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "Async progress" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "user_data"
--           , argType = TBasicType TPtr
--           , direction = DirectionIn
--           , mayBeNull = True
--           , argDoc =
--               Documentation
--                 { rawDocText = Just "User data" , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Nothing
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_pull_default_console_progress_changed" ostree_repo_pull_default_console_progress_changed :: 
    Ptr OSTree.AsyncProgress.AsyncProgress -> -- progress : TInterface (Name {namespace = "OSTree", name = "AsyncProgress"})
    Ptr () ->                               -- user_data : TBasicType TPtr
    IO ()

-- | Convenient \"changed\" callback for use with
-- 'GI.OSTree.Objects.AsyncProgress.asyncProgressNewAndConnect' when pulling from a remote
-- repository.
-- 
-- Depending on the state of the t'GI.OSTree.Objects.AsyncProgress.AsyncProgress', either displays a
-- custom status message, or else outstanding fetch progress in bytes\/sec,
-- or else outstanding content or metadata writes to the repository in
-- number of objects.
-- 
-- Compatibility note: this function previously assumed that /@userData@/
-- was a pointer to a @/GSConsole/@ instance.  This is no longer the case,
-- and /@userData@/ is ignored.
repoPullDefaultConsoleProgressChanged ::
    (B.CallStack.HasCallStack, MonadIO m, OSTree.AsyncProgress.IsAsyncProgress a) =>
    a
    -- ^ /@progress@/: Async progress
    -> Ptr ()
    -- ^ /@userData@/: User data
    -> m ()
repoPullDefaultConsoleProgressChanged :: a -> Ptr () -> m ()
repoPullDefaultConsoleProgressChanged progress :: a
progress userData :: Ptr ()
userData = 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 AsyncProgress
progress' <- a -> IO (Ptr AsyncProgress)
forall a b. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr b)
unsafeManagedPtrCastPtr a
progress
    Ptr AsyncProgress -> Ptr () -> IO ()
ostree_repo_pull_default_console_progress_changed Ptr AsyncProgress
progress' Ptr ()
userData
    a -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr a
progress
    () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

#if defined(ENABLE_OVERLOADING)
#endif

-- XXX Could not generate method Repo::traverse_new_parents
-- Error was : Not implemented: "GHashTable element of type TVariant unsupported."
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoTraverseNewParentsMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "traverseNewParents" Repo) => O.MethodInfo RepoTraverseNewParentsMethodInfo o p where
    overloadedMethod = undefined
#endif

-- XXX Could not generate method Repo::traverse_new_reachable
-- Error was : Not implemented: "GHashTable element of type TVariant unsupported."
#if defined(ENABLE_OVERLOADING)
-- XXX: Dummy instance, since code generation failed.
-- Please file a bug at http://github.com/haskell-gi/haskell-gi.
data RepoTraverseNewReachableMethodInfo
instance (p ~ (), o ~ O.UnsupportedMethodError "traverseNewReachable" Repo) => O.MethodInfo RepoTraverseNewReachableMethodInfo o p where
    overloadedMethod = undefined
#endif

-- method Repo::traverse_parents_get_commits
-- method type : MemberFunction
-- Args: [ Arg
--           { argCName = "parents"
--           , argType = TGHash (TBasicType TPtr) (TBasicType TPtr)
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       , Arg
--           { argCName = "object"
--           , argType = TVariant
--           , direction = DirectionIn
--           , mayBeNull = False
--           , argDoc =
--               Documentation { rawDocText = Nothing , sinceVersion = Nothing }
--           , argScope = ScopeTypeInvalid
--           , argClosure = -1
--           , argDestroy = -1
--           , argCallerAllocates = False
--           , transfer = TransferNothing
--           }
--       ]
-- Lengths: []
-- returnType: Just (TCArray True (-1) (-1) (TBasicType TUTF8))
-- throws : False
-- Skip return : False

foreign import ccall "ostree_repo_traverse_parents_get_commits" ostree_repo_traverse_parents_get_commits :: 
    Ptr (GHashTable (Ptr ()) (Ptr ())) ->   -- parents : TGHash (TBasicType TPtr) (TBasicType TPtr)
    Ptr GVariant ->                         -- object : TVariant
    IO (Ptr CString)

-- | Gets all the commits that a certain object belongs to, as recorded
-- by a parents table gotten from ostree_repo_traverse_commit_union_with_parents.
-- 
-- /Since: 2018.5/
repoTraverseParentsGetCommits ::
    (B.CallStack.HasCallStack, MonadIO m) =>
    Map.Map (Ptr ()) (Ptr ())
    -> GVariant
    -> m [T.Text]
    -- ^ __Returns:__ An array of checksums for
    -- the commits the key belongs to.
repoTraverseParentsGetCommits :: Map (Ptr ()) (Ptr ()) -> GVariant -> m [Text]
repoTraverseParentsGetCommits parents :: Map (Ptr ()) (Ptr ())
parents object :: GVariant
object = 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
    let parents' :: [(Ptr (), Ptr ())]
parents' = Map (Ptr ()) (Ptr ()) -> [(Ptr (), Ptr ())]
forall k a. Map k a -> [(k, a)]
Map.toList Map (Ptr ()) (Ptr ())
parents
    let parents'' :: [(PtrWrapped (Ptr ()), Ptr ())]
parents'' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(Ptr (), Ptr ())] -> [(PtrWrapped (Ptr ()), Ptr ())]
forall a c b. (a -> c) -> [(a, b)] -> [(c, b)]
mapFirst Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
ptrPackPtr [(Ptr (), Ptr ())]
parents'
    let parents''' :: [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
parents''' = (Ptr () -> PtrWrapped (Ptr ()))
-> [(PtrWrapped (Ptr ()), Ptr ())]
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
forall b c a. (b -> c) -> [(a, b)] -> [(a, c)]
mapSecond Ptr () -> PtrWrapped (Ptr ())
forall a. Ptr a -> PtrWrapped (Ptr a)
ptrPackPtr [(PtrWrapped (Ptr ()), Ptr ())]
parents''
    Ptr (GHashTable (Ptr ()) (Ptr ()))
parents'''' <- GHashFunc (Ptr ())
-> GEqualFunc (Ptr ())
-> Maybe (GDestroyNotify (Ptr ()))
-> Maybe (GDestroyNotify (Ptr ()))
-> [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
-> IO (Ptr (GHashTable (Ptr ()) (Ptr ())))
forall a b.
GHashFunc a
-> GEqualFunc a
-> Maybe (GDestroyNotify a)
-> Maybe (GDestroyNotify b)
-> [(PtrWrapped a, PtrWrapped b)]
-> IO (Ptr (GHashTable a b))
packGHashTable GHashFunc (Ptr ())
forall a. GHashFunc (Ptr a)
gDirectHash GEqualFunc (Ptr ())
forall a. GEqualFunc (Ptr a)
gDirectEqual Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing Maybe (GDestroyNotify (Ptr ()))
forall a. Maybe a
Nothing [(PtrWrapped (Ptr ()), PtrWrapped (Ptr ()))]
parents'''
    Ptr GVariant
object' <- GVariant -> IO (Ptr GVariant)
forall a. (HasCallStack, ManagedPtrNewtype a) => a -> IO (Ptr a)
unsafeManagedPtrGetPtr GVariant
object
    Ptr CString
result <- Ptr (GHashTable (Ptr ()) (Ptr ()))
-> Ptr GVariant -> IO (Ptr CString)
ostree_repo_traverse_parents_get_commits Ptr (GHashTable (Ptr ()) (Ptr ()))
parents'''' Ptr GVariant
object'
    Text -> Ptr CString -> IO ()
forall a. HasCallStack => Text -> Ptr a -> IO ()
checkUnexpectedReturnNULL "repoTraverseParentsGetCommits" Ptr CString
result
    [Text]
result' <- HasCallStack => Ptr CString -> IO [Text]
Ptr CString -> IO [Text]
unpackZeroTerminatedUTF8CArray Ptr CString
result
    (CString -> IO ()) -> Ptr CString -> IO ()
forall a b. (Ptr a -> IO b) -> Ptr (Ptr a) -> IO ()
mapZeroTerminatedCArray CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    Ptr CString -> IO ()
forall a. Ptr a -> IO ()
freeMem Ptr CString
result
    GVariant -> IO ()
forall a. ManagedPtrNewtype a => a -> IO ()
touchManagedPtr GVariant
object
    Ptr (GHashTable (Ptr ()) (Ptr ())) -> IO ()
forall a b. Ptr (GHashTable a b) -> IO ()
unrefGHashTable Ptr (GHashTable (Ptr ()) (Ptr ()))
parents''''
    [Text] -> IO [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
result'

#if defined(ENABLE_OVERLOADING)
#endif