ostree-test.hs

{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

import Control.Conditional(whenM)
import Control.Exception(bracket_)
import Control.Monad(forM_, void)
import Control.Monad.State(StateT, execStateT, lift, modify)
import Data.GI.Base.ManagedPtr(unsafeCastTo)
import Data.Text(Text)
import GI.Gio
import GI.OSTree
import System.FilePath((</>))
import System.IO.Temp(withTempDirectory)
import System.Posix.Files(createSymbolicLink)


initRepo :: FilePath -> IO (Repo, [Text])
initRepo repoDir = do
    path <- fileNewForPath repoDir
    repo <- repoNew path

    repoCreate repo RepoModeArchiveZ2 noCancellable

    commit <- addContent repo
    checksums <- execStateT (commitContents repo commit) []

    return (repo, checksums)

 where
    addContent :: IsRepo a => a -> IO Text
    addContent repo = withTransaction repo $ \r -> do
        -- create a temp directory with some content to import
        f <- withTempDirectory "." "ostree-test-content" $ \contentDir -> do
            cdPath <- fileNewForPath contentDir
            createSymbolicLink "/dev/null" (contentDir </> "test-link")
            mtree <- mutableTreeNew
            repoWriteDirectoryToMtree r cdPath mtree Nothing noCancellable
            repoWriteMtree r mtree noCancellable

        -- commit the tree as "master"
        unsafeCastTo RepoFile f >>= \root -> do
            checksum <- repoWriteCommit r Nothing (Just "Test commit") Nothing Nothing root noCancellable
            repoTransactionSetRef r Nothing "master" (Just checksum)
            repoRegenerateSummary r Nothing noCancellable
            return checksum

    withTransaction :: IsRepo a => a -> (a -> IO b) -> IO b
    withTransaction repo fn =
        bracket_ (repoPrepareTransaction repo noCancellable)
                 (repoCommitTransaction repo noCancellable)
                 (fn repo)

    commitContents :: IsRepo a => a -> Text -> StateT [Text] IO ()
    commitContents repo commit = do
        (root, _) <- repoReadCommit repo commit noCancellable
        file <- fileResolveRelativePath root "/"
        info <- fileQueryInfo file "*" [FileQueryInfoFlagsNofollowSymlinks] noCancellable
        walk file info
     where
        walk :: File -> FileInfo -> StateT [Text] IO ()
        walk f i = lift (fileInfoGetFileType i) >>= \case
            FileTypeDirectory -> do getChecksum FileTypeDirectory f >>= addChecksum

                                    -- Grab the info for everything in this directory.
                                    dirEnum <- fileEnumerateChildren f "*" [FileQueryInfoFlagsNofollowSymlinks] noCancellable
                                    childrenInfo <- getAllChildren dirEnum []

                                    -- Examine the contents of this directory recursively - this results in all
                                    -- the files being added by the other branch of the case, and other directories
                                    -- being handled recusrively.  Thus, we do this depth-first.
                                    forM_ childrenInfo $ \childInfo -> do
                                        child <- fileInfoGetName childInfo >>= fileGetChild f
                                        walk child childInfo

            ty                -> getChecksum ty f >>= addChecksum

        addChecksum :: Text -> StateT [Text] IO ()
        addChecksum c = modify (c:)

        getAllChildren :: FileEnumerator -> [FileInfo] -> StateT [Text] IO [FileInfo]
        getAllChildren enum accum =
            fileEnumeratorNextFile enum noCancellable >>= \case
                Just next -> getAllChildren enum (accum ++ [next])
                Nothing   -> return accum

        getChecksum :: FileType -> File -> StateT [Text] IO Text
        getChecksum ty f = lift $ unsafeCastTo RepoFile f >>= \repoFile ->
            case ty of
                FileTypeDirectory -> do -- this needs to be called before repoFileTreeGetMetadataChecksum to populate the data
                                        repoFileEnsureResolved repoFile
                                        repoFileTreeGetMetadataChecksum repoFile
                _                 -> repoFileGetChecksum repoFile

main :: IO ()
main = void $ withTempDirectory "." "ostree-test-" $ \tmpDir -> do
    -- create the repo and add some content
    -- (all of this seems to work fine)
    (repo, checksums) <- initRepo tmpDir

    mapM_ (getObject repo) checksums
 where
    getObject :: IsRepo a => a -> Text -> IO ()
    getObject repo checksum = do
        print $ "Loading " ++ show checksum
        whenM (repoHasObject repo ObjectTypeFile checksum noCancellable) loadFile
     where
        loadFile :: IO ()
        -- This is where the problems happen
        loadFile = void $ repoLoadFile repo checksum noCancellable