Hashed.hs

-- Copyright (C) 2006-2007 David Roundy
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2, or (at your option)
-- any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software Foundation,
-- Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

module Darcs.Repository.Hashed
    ( inventoriesDir
    , inventoriesDirPath
    , pristineDir
    , pristineDirPath
    , patchesDir
    , patchesDirPath
    , hashedInventory
    , hashedInventoryPath

    , revertTentativeChanges
    , revertRepositoryChanges
    , finalizeTentativeChanges
    , cleanPristine
    , filterDirContents
    , cleanInventories
    , cleanPatches
    , copyPristine
    , copyPartialsPristine
    , applyToTentativePristine
    , applyToTentativePristineCwd
    , addToTentativeInventory
    , readRepo
    , readRepoHashed
    , readTentativeRepo
    , writeAndReadPatch
    , writeTentativeInventory
    , copyHashedInventory
    , readHashedPristineRoot
    , pokePristineHash
    , peekPristineHash
    , listInventories
    , listInventoriesLocal
    , listInventoriesRepoDir
    , listPatchesLocalBucketed
    , writePatchIfNecessary
    , diffHashLists
    , withRecorded
    , withTentative
    , tentativelyAddPatch
    , tentativelyRemovePatches
    , tentativelyRemovePatches_
    , tentativelyAddPatch_
    , tentativelyAddPatches_
    , tentativelyReplacePatches
    , finalizeRepositoryChanges
    , unrevertUrl
    , createPristineDirectoryTree
    , createPartialsPristineDirectoryTree
    , reorderInventory
    , cleanRepository
    , UpdatePristine(..)
    , repoXor
    ) where

import Prelude ()
import Darcs.Prelude

import Control.Arrow ( (&&&) )
import Control.Exception ( catch, IOException )
import Darcs.Util.Exception ( catchall )
import Control.Monad ( when, unless, void )
import Data.Maybe
import Data.List( foldl' )

import qualified Data.ByteString as B ( empty, readFile, append )
import qualified Data.ByteString.Char8 as BC ( unpack, pack )
import qualified Data.Set as Set

import Darcs.Util.Hash( encodeBase16, Hash(..), SHA1, sha1Xor, sha1zero )
import Darcs.Util.Prompt ( promptYorn )
import Darcs.Util.Tree( treeHash, Tree )
import Darcs.Util.Tree.Hashed( hashedTreeIO, readDarcsHashedNosize,
                             readDarcsHashed, writeDarcsHashed,
                             decodeDarcsHash, decodeDarcsSize )
import Darcs.Util.SignalHandler ( withSignalsBlocked )

import System.Directory ( createDirectoryIfMissing, getDirectoryContents
                        , doesFileExist, doesDirectoryExist )
import System.FilePath.Posix( (</>) )
import System.IO.Unsafe ( unsafeInterleaveIO )
import System.IO ( stderr, hPutStrLn )

import Darcs.Util.External
    ( copyFileOrUrl
    , cloneFile
    , fetchFilePS
    , gzFetchFilePS
    , Cachable( Uncachable )
    )
import Darcs.Repository.Flags ( Compression, RemoteDarcs, remoteDarcs
    , Verbosity(..), UpdateWorking (..), WithWorkingDir (WithWorkingDir) )

import Darcs.Repository.Format ( RepoProperty( HashedInventory ), formatHas )
import Darcs.Repository.Pending
    ( readPending
    , pendingName
    , tentativelyRemoveFromPending
    , finalizePending
    , setTentativePending
    , prepend
    )
import Darcs.Repository.PatchIndex ( createOrUpdatePatchIndexDisk, doesPatchIndexExist )
import Darcs.Repository.State ( readRecorded, updateIndex )

import Darcs.Util.Global ( darcsdir )
import Darcs.Util.Lock
    ( writeBinFile
    , writeDocBinFile
    , writeAtomicFilePS
    , appendDocBinFile
    , removeFileMayNotExist
    )
import Darcs.Patch.Set ( PatchSet(..), Tagged(..)
                       , SealedPatchSet, Origin
                       , patchSet2RL
                       )

import Darcs.Patch.Show ( ShowPatch, ShowPatchFor(..) )
import Darcs.Patch.PatchInfoAnd
    ( PatchInfoAnd, Hopefully, patchInfoAndPatch, info
    , extractHash, createHashed, hopefully )
import Darcs.Patch ( IsRepoType, RepoPatch, showPatch, apply
                   , description
                   , commuteRL
                   , readPatch
                   , effect
                   , invert
                   )

import Darcs.Patch.Apply ( Apply, ApplyState )

import Darcs.Patch.Bundle ( scanBundle
                          , makeBundleN
                          )
import Darcs.Patch.Named.Wrapped ( namedIsInternal )
import Darcs.Patch.Read ( ReadPatch )
import Darcs.Patch.Depends ( removeFromPatchSet, slightlyOptimizePatchset
                           , mergeThem, splitOnTag )
import Darcs.Patch.Info
    ( PatchInfo, displayPatchInfo, isTag, makePatchname )
import Darcs.Util.Path ( FilePathLike, ioAbsoluteOrRemote, toPath
                       , AbsolutePath, toFilePath )
import Darcs.Repository.Cache ( Cache(..), fetchFileUsingCache,
                                speculateFilesUsingCache, writeFileUsingCache,
                                HashedDir(..), hashedDir, peekInCache, bucketFolder )
import Darcs.Repository.HashedIO ( copyHashed, copyPartialsHashed,
                                   cleanHashdir )
import Darcs.Repository.Inventory
import Darcs.Repository.InternalTypes
    ( Repository
    , repoCache
    , repoFormat
    , repoLocation
    , withRepoLocation
    , coerceT )
import qualified Darcs.Repository.Old as Old ( readOldRepo, oldRepoFailMsg )
import Darcs.Util.File ( withCurrentDirectory )
import Darcs.Patch.Witnesses.Ordered
    ( (+<+), FL(..), RL(..), mapRL, foldFL_M
    , (:>)(..), lengthFL, filterOutFLFL
    , reverseFL, reverseRL )
import Darcs.Patch.Witnesses.Sealed ( Sealed(..), seal, unseal, mapSeal )
import Darcs.Patch.Witnesses.Unsafe ( unsafeCoerceP )

import Darcs.Util.ByteString ( gzReadFilePS )
import Darcs.Util.Printer.Color ( showDoc )
import Darcs.Util.Printer
    ( Doc, hcat, ($$), renderString, renderPS, text, putDocLn, (<+>) )
import Darcs.Util.Progress ( beginTedious, endTedious, debugMessage, finishedOneIO )
import Darcs.Patch.Progress (progressFL)
import Darcs.Util.Workaround ( renameFile )
import Darcs.Repository.Prefs ( globalCacheDir )


makeDarcsdirPath :: String -> String
makeDarcsdirPath name = darcsdir </> name

-- TODO rename xyzPath to xyzLocal to make it clear that it is
-- relative to the local darcsdir

-- Location of the (one and only) head inventory.
hashedInventory, hashedInventoryPath :: String
hashedInventory = "hashed_inventory"
hashedInventoryPath = makeDarcsdirPath hashedInventory

-- Location of the (one and only) tentative head inventory.
tentativeHashedInventory, tentativeHashedInventoryPath :: String
tentativeHashedInventory = "tentative_hashed_inventory"
tentativeHashedInventoryPath = makeDarcsdirPath tentativeHashedInventory

-- Location of parent inventories.
inventoriesDir, inventoriesDirPath :: String
inventoriesDir = "inventories"
inventoriesDirPath = makeDarcsdirPath inventoriesDir

-- Location of pristine trees.
pristineDir, tentativePristinePath, pristineDirPath :: String
tentativePristinePath = makeDarcsdirPath "tentative_pristine"
pristineDir = "pristine.hashed"
pristineDirPath = makeDarcsdirPath pristineDir

-- Location of patches.
patchesDir, patchesDirPath :: String
patchesDir = "patches"
patchesDirPath = makeDarcsdirPath patchesDir

-- | The way patchfiles, inventories, and pristine trees are stored.
-- 'PlainLayout' means all files are in the same directory. 'BucketedLayout'
-- means we create a second level of subdirectories, such that all files whose
-- hash starts with the same two letters are in the same directory.
data DirLayout = PlainLayout | BucketedLayout

-- | 'applyToHashedPristine' takes a root hash, a patch @p@ and attempts to
-- apply the patch to the 'Tree' identified by @h@. If we encounter an old,
-- size-prefixed pristine, we first convert it to the non-size-prefixed format,
-- then apply the patch.
applyToHashedPristine :: (Apply p, ApplyState p ~ Tree) => String -> p wX wY
                      -> IO String
applyToHashedPristine h p = applyOrConvertOldPristineAndApply
  where
    applyOrConvertOldPristineAndApply =
        tryApply hash `catch` \(_ :: IOException) -> handleOldPristineAndApply

    hash = decodeDarcsHash $ BC.pack h

    failOnMalformedRoot (SHA256 _) = return ()
    failOnMalformedRoot root = fail $ "Cannot handle hash: " ++ show root

    hash2root = BC.unpack . encodeBase16

    tryApply :: Hash -> IO String
    tryApply root = do
        failOnMalformedRoot root
        -- Read a non-size-prefixed pristine, failing if we encounter one.
        tree <- readDarcsHashedNosize pristineDirPath root
        (_, updatedTree) <- hashedTreeIO (apply p) tree pristineDirPath
        return . hash2root $ treeHash updatedTree

    warn = "WARNING: Doing a one-time conversion of pristine format.\n"
           ++ "This may take a while. The new format is backwards-compatible."

    handleOldPristineAndApply = do
        hPutStrLn stderr warn
        inv <- gzReadFilePS hashedInventoryPath
        let oldroot = BC.pack $ peekPristineHash inv
            oldrootSizeandHash = (decodeDarcsSize &&& decodeDarcsHash) oldroot
        -- Read the old size-prefixed pristine tree
        old <- readDarcsHashed pristineDirPath oldrootSizeandHash
        -- Write out the pristine tree as a non-size-prefixed pristine.
        root <- writeDarcsHashed old pristineDirPath
        let newroot = hash2root root
        -- Write out the new inventory.
        writeDocBinFile hashedInventoryPath $ pokePristineHash newroot inv
        cleanHashdir (Ca []) HashedPristineDir [newroot]
        hPutStrLn stderr "Pristine conversion done..."
        -- Retry applying the patch, which should now succeed.
        tryApply root

-- |revertTentativeChanges swaps the tentative and "real" hashed inventory
-- files, and then updates the tentative pristine with the "real" inventory
-- hash.
revertTentativeChanges :: IO ()
revertTentativeChanges = do
    cloneFile hashedInventoryPath tentativeHashedInventoryPath
    i <- gzReadFilePS hashedInventoryPath
    writeBinFile tentativePristinePath $ B.append pristineName (BC.pack (peekPristineHash i))

-- |finalizeTentativeChanges trys to atomically swap the tentative
-- inventory/pristine pointers with the "real" pointers; it first re-reads the
-- inventory to optimize it, presumably to take account of any new tags, and
-- then writes out the new tentative inventory, and finally does the atomic
-- swap. In general, we can't clean the pristine cache at the same time, since
-- a simultaneous get might be in progress.
finalizeTentativeChanges :: (IsRepoType rt, RepoPatch p)
                         => Repository rt p wR wU wT -> Compression -> IO ()
finalizeTentativeChanges r compr = do
    debugMessage "Optimizing the inventory..."
    -- Read the tentative patches
    ps <- readTentativeRepo r "."
    writeTentativeInventory (repoCache r) compr ps
    i <- gzReadFilePS tentativeHashedInventoryPath
    p <- gzReadFilePS tentativePristinePath
    -- Write out the "optimised" tentative inventory.
    writeDocBinFile tentativeHashedInventoryPath $ pokePristineHash (peekPristineHash p) i
    -- Atomically swap.
    renameFile tentativeHashedInventoryPath hashedInventoryPath

-- |readHashedPristineRoot attempts to read the pristine hash from the current
-- inventory, returning Nothing if it cannot do so.
readHashedPristineRoot :: Repository rt p wR wU wT -> IO (Maybe String)
readHashedPristineRoot r = withRepoLocation r $ do
    i <- (Just <$> gzReadFilePS hashedInventoryPath)
         `catch` (\(_ :: IOException) -> return Nothing)
    return $ peekPristineHash <$> i

-- |cleanPristine removes any obsolete (unreferenced) entries in the pristine
-- cache.
cleanPristine :: Repository rt p wR wU wT -> IO ()
cleanPristine r = withRepoLocation r $ do
    debugMessage "Cleaning out the pristine cache..."
    i <- gzReadFilePS hashedInventoryPath
    cleanHashdir (repoCache r) HashedPristineDir [peekPristineHash i]

-- |filterDirContents returns the contents of the directory @d@
-- except files whose names begin with '.' (directories . and ..,
-- hidden files) and files whose names are filtered by the function @f@, if
-- @dir@ is empty, no paths are returned.
filterDirContents :: FilePath -> (FilePath -> Bool) -> IO [FilePath]
filterDirContents d f = do
    let realPath = makeDarcsdirPath d
    exists <- doesDirectoryExist realPath
    if exists
        then filter (\x -> head x /= '.' && f x) <$>
            getDirectoryContents realPath
        else return []

-- | Set difference between two lists of hashes.
diffHashLists :: [String] -> [String] -> [String]
diffHashLists xs ys = from_set $ (to_set xs) `Set.difference` (to_set ys)
  where
    to_set = Set.fromList . map BC.pack
    from_set = map BC.unpack . Set.toList

-- |cleanInventories removes any obsolete (unreferenced) files in the
-- inventories directory.
cleanInventories :: Repository rt p wR wU wT -> IO ()
cleanInventories _ = do
    debugMessage "Cleaning out inventories..."
    hs <- listInventoriesLocal
    fs <- filterDirContents inventoriesDir (const True)
    mapM_ (removeFileMayNotExist . (inventoriesDirPath </>))
        (diffHashLists fs hs)

-- FIXME this is ugly, these files should be directly under _darcs
-- since they are not hashed. And 'unrevert' isn't even a real patch but
-- a patch bundle.
-- |specialPatches list of special patch files that may exist in the directory
-- _darcs/patches/.
specialPatches :: [FilePath]
specialPatches = ["unrevert", "pending", "pending.tentative"]

-- |cleanPatches removes any obsolete (unreferenced) files in the
-- patches directory.
cleanPatches :: Repository rt p wR wU wT -> IO ()
cleanPatches _ = do
    debugMessage "Cleaning out patches..."
    hs <- listPatchesLocal PlainLayout darcsdir darcsdir
    fs <- filterDirContents patchesDir (`notElem` specialPatches)
    mapM_ (removeFileMayNotExist . (patchesDirPath </>))
        (diffHashLists fs hs)


-- |addToSpecificInventory adds a patch to a specific inventory file, and
-- returns the FilePath whichs corresponds to the written-out patch.
addToSpecificInventory :: RepoPatch p => String -> Cache -> Compression
                       -> PatchInfoAnd rt p wX wY -> IO FilePath
addToSpecificInventory invPath c compr p = do
    let invFile = makeDarcsdirPath invPath
    hash <- snd <$> writePatchIfNecessary c compr p
    appendDocBinFile invFile $
      showInventoryEntry (info p, hash)
    return $ patchesDirPath </> getValidHash hash

-- | Warning: this allows to add any arbitrary patch! Used by convert import.
addToTentativeInventory :: RepoPatch p => Cache -> Compression
                        -> PatchInfoAnd rt p wX wY -> IO FilePath
addToTentativeInventory = addToSpecificInventory tentativeHashedInventory

-- | Attempt to remove an FL of patches from the tentative inventory.
-- This is used for commands that wish to modify already-recorded patches.
--
-- Precondition: it must be possible to remove the patches, i.e.
--
-- * the patches are in the repository
--
-- * any necessary commutations will succeed
removeFromTentativeInventory :: (IsRepoType rt, RepoPatch p)
                             => Repository rt p wR wU wT -> Compression
                             -> FL (PatchInfoAnd rt p) wX wT -> IO ()
removeFromTentativeInventory repo compr to_remove = do
    debugMessage $ "Start removeFromTentativeInventory"
    allpatches <- readTentativeRepo repo "."
    remaining <- case removeFromPatchSet to_remove allpatches of
        Nothing -> bug "Hashed.removeFromTentativeInventory: precondition violated"
        Just r -> return r
    writeTentativeInventory (repoCache repo) compr remaining
    debugMessage $ "Done removeFromTentativeInventory"

-- |writeHashFile takes a Doc and writes it as a hash-named file, returning the
-- filename that the contents were written to.
writeHashFile :: Cache -> Compression -> HashedDir -> Doc -> IO String
writeHashFile c compr subdir d = do
    debugMessage $ "Writing hash file to " ++ hashedDir subdir
    writeFileUsingCache c compr subdir $ renderPS d

-- |readRepo returns the "current" repo patchset.
readRepoHashed :: (IsRepoType rt, RepoPatch p) => Repository rt p wR wU wT
               -> String -> IO (PatchSet rt p Origin wR)
readRepoHashed = readRepoUsingSpecificInventory hashedInventory

-- |readRepo returns the tentative repo patchset.
readTentativeRepo :: (IsRepoType rt, RepoPatch p)
                  => Repository rt p wR wU wT -> String
                  -> IO (PatchSet rt p Origin wT)
readTentativeRepo = readRepoUsingSpecificInventory tentativeHashedInventory

-- |readRepoUsingSpecificInventory uses the inventory at @invPath@ to read the
-- repository @repo@.
readRepoUsingSpecificInventory :: (IsRepoType rt, RepoPatch p)
                               => String -> Repository rt p wR wU wT
                               -> String -> IO (PatchSet rt p Origin wS)
readRepoUsingSpecificInventory invPath repo dir = do
    realdir <- toPath <$> ioAbsoluteOrRemote dir
    Sealed ps <- readRepoPrivate (repoCache repo) realdir invPath
                 `catch` \e -> do
                     hPutStrLn stderr ("Invalid repository: " ++ realdir)
                     ioError e
    return $ unsafeCoerceP ps
  where
    readRepoPrivate :: (IsRepoType rt, RepoPatch p) => Cache -> FilePath
                    -> FilePath -> IO (SealedPatchSet rt p Origin)
    readRepoPrivate cache d iname = do
      inventory <- readInventoryPrivate (d </> darcsdir </> iname)
      readRepoFromInventoryList cache inventory

-- | Read a 'PatchSet' from the repository (assumed to be located at the
-- current working directory) by following the chain of 'Inventory's, starting
-- with the given one. The 'Cache' parameter is used to locate patches and parent
-- inventories, since not all of them need be present inside the current repo.
readRepoFromInventoryList
  :: (IsRepoType rt, RepoPatch p)
  => Cache
  -> Inventory
  -> IO (SealedPatchSet rt p Origin)
readRepoFromInventoryList cache = parseInv
  where
    parseInv :: (IsRepoType rt, RepoPatch p)
             => Inventory
             -> IO (SealedPatchSet rt p Origin)
    parseInv (Inventory Nothing ris) =
        mapSeal (PatchSet NilRL) <$> read_patches (reverse ris)
    parseInv (Inventory (Just h) []) =
        -- TODO could be more tolerant and create a larger PatchSet
        bug $ "bad inventory " ++ getValidHash h ++ " (no tag) in parseInv!"
    parseInv (Inventory (Just h) (t : ris)) = do
        Sealed ts <- unseal seal <$> unsafeInterleaveIO (read_ts t h)
        Sealed ps <- unseal seal <$>
                        unsafeInterleaveIO (read_patches $ reverse ris)
        return $ seal $ PatchSet ts ps

    read_patches :: (IsRepoType rt, RepoPatch p) => [InventoryEntry]
                 -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
    read_patches [] = return $ seal NilRL
    read_patches allis@((i1, h1) : is1) =
        lift2Sealed (\p rest -> rest :<: i1 `patchInfoAndPatch` p) (rp is1)
                    (createValidHashed h1 (const $ speculateAndParse h1 allis i1))
      where
        rp :: (IsRepoType rt, RepoPatch p) => [InventoryEntry]
           -> IO (Sealed (RL (PatchInfoAnd rt p) wX))
        rp [] = return $ seal NilRL
        rp [(i, h), (il, hl)] =
            lift2Sealed (\p rest -> rest :<: i `patchInfoAndPatch` p)
                        (rp [(il, hl)])
                        (createValidHashed h
                            (const $ speculateAndParse h (reverse allis) i))
        rp ((i, h) : is) =
            lift2Sealed (\p rest -> rest :<: i `patchInfoAndPatch` p)
                        (rp is)
                        (createValidHashed h (parse i))

    lift2Sealed :: (forall wY wZ . q wY wZ -> p wX wY -> r wX wZ)
                -> IO (Sealed (p wX))
                -> (forall wB . IO (Sealed (q wB)))
                -> IO (Sealed (r wX))
    lift2Sealed f iox ioy = do
        Sealed x <- unseal seal <$> unsafeInterleaveIO iox
        Sealed y <- unseal seal <$> unsafeInterleaveIO ioy
        return $ seal $ f y x

    speculateAndParse h is i = speculate h is >> parse i h

    speculate :: PatchHash -> [InventoryEntry] -> IO ()
    speculate h is = do
        already_got_one <- peekInCache cache HashedPatchesDir (getValidHash h)
        unless already_got_one $
            speculateFilesUsingCache cache HashedPatchesDir (map (getValidHash . snd) is)

    parse :: ReadPatch p => PatchInfo -> PatchHash -> IO (Sealed (p wX))
    parse i h = do
        debugMessage ("Reading patch file: "++ showDoc (displayPatchInfo i))
        (fn, ps) <- fetchFileUsingCache cache HashedPatchesDir (getValidHash h)
        case readPatch ps of
            Just p -> return p
            Nothing -> fail $ unlines [ "Couldn't parse file " ++ fn
                                      , "which is patch"
                                      , renderString $ displayPatchInfo i ]

    read_ts :: (IsRepoType rt, RepoPatch p) => InventoryEntry
            -> InventoryHash -> IO (Sealed (RL (Tagged rt p) Origin))
    read_ts tag0 h0 = do
        contents <- unsafeInterleaveIO $ readTaggedInventoryFromHash (getValidHash h0)
        let is = reverse $ case contents of
                               (Inventory (Just _) (_ : ris0)) -> ris0
                               (Inventory Nothing ris0) -> ris0
                               (Inventory (Just _) []) -> bug "inventory without tag!"
        Sealed ts <- unseal seal <$>
                         unsafeInterleaveIO
                            (case contents of
                                 (Inventory (Just h') (t' : _)) -> read_ts t' h'
                                 (Inventory (Just _) []) -> bug "inventory without tag!"
                                 (Inventory Nothing _) -> return $ seal NilRL)
        Sealed ps <- unseal seal <$> unsafeInterleaveIO (read_patches is)
        Sealed tag00 <- read_tag tag0
        return $ seal $ ts :<: Tagged tag00 (Just (getValidHash h0)) ps

    read_tag :: (IsRepoType rt, RepoPatch p) => InventoryEntry
             -> IO (Sealed (PatchInfoAnd rt p wX))
    read_tag (i, h) =
        mapSeal (patchInfoAndPatch i) <$> createValidHashed h (parse i)

    readTaggedInventoryFromHash :: String
                                -> IO Inventory
    readTaggedInventoryFromHash invHash = do
        (fileName, pristineAndInventory) <-
            fetchFileUsingCache cache HashedInventoriesDir invHash
        case parseInventory pristineAndInventory of
          Just r -> return r
          Nothing -> fail $ unwords ["parse error in file", fileName]

-- | Read an inventory from a file. Fails with an error message if
-- file is not there or cannot be parsed.
readInventoryPrivate :: FilePath
                     -> IO Inventory
readInventoryPrivate path = do
    inv <- skipPristineHash <$> gzFetchFilePS path Uncachable
    case parseInventory inv of
      Just r -> return r
      Nothing -> fail $ unwords ["parse error in file", path]

-- |copyRepo copies the hashed inventory of @repo@ to the repository located at
-- @remote@.
copyHashedInventory :: Repository rt p wR wU wT -> RemoteDarcs -> String -> IO ()
copyHashedInventory outrepo rdarcs inloc | remote <- remoteDarcs rdarcs = do
    let outloc = repoLocation outrepo
    createDirectoryIfMissing False (outloc ++ "/" ++ inventoriesDirPath)
    copyFileOrUrl remote (inloc </> hashedInventoryPath)
                         (outloc </> hashedInventoryPath)
                  Uncachable -- no need to copy anything but hashed_inventory!
    debugMessage "Done copying hashed inventory."

-- |writeAndReadPatch makes a patch lazy, by writing it out to disk (thus
-- forcing it), and then re-reads the patch lazily.
writeAndReadPatch :: (IsRepoType rt, RepoPatch p) => Cache -> Compression
                  -> PatchInfoAnd rt p wX wY -> IO (PatchInfoAnd rt p wX wY)
writeAndReadPatch c compr p = do
    (i, h) <- writePatchIfNecessary c compr p
    unsafeInterleaveIO $ readp h i
  where
    parse i h = do
        debugMessage ("Rereading patch file: "++ showDoc (displayPatchInfo i))
        (fn, ps) <- fetchFileUsingCache c HashedPatchesDir (getValidHash h)
        case readPatch ps of
            Just x -> return x
            Nothing -> fail $ unlines [ "Couldn't parse patch file " ++ fn
                                      , "which is"
                                      , renderString $ displayPatchInfo i]

    readp h i = do Sealed x <- createValidHashed h (parse i)
                   return . patchInfoAndPatch i $ unsafeCoerceP x

createValidHashed :: PatchHash
                  -> (PatchHash -> IO (Sealed (a wX)))
                  -> IO (Sealed (Darcs.Patch.PatchInfoAnd.Hopefully a wX))
createValidHashed h f = createHashed (getValidHash h) (f . mkValidHash)

-- | writeTentativeInventory writes @patchSet@ as the tentative inventory.
writeTentativeInventory :: RepoPatch p => Cache -> Compression
                        -> PatchSet rt p Origin wX -> IO ()
writeTentativeInventory cache compr patchSet = do
    debugMessage "in writeTentativeInventory..."
    createDirectoryIfMissing False inventoriesDirPath
    beginTedious tediousName
    hsh <- writeInventoryPrivate $ slightlyOptimizePatchset patchSet
    endTedious tediousName
    debugMessage "still in writeTentativeInventory..."
    case hsh of
        Nothing -> writeBinFile (makeDarcsdirPath tentativeHashedInventory) B.empty
        Just h -> do
            content <- snd <$> fetchFileUsingCache cache HashedInventoriesDir h
            writeAtomicFilePS (makeDarcsdirPath tentativeHashedInventory) content
  where
    tediousName = "Writing inventory"
    writeInventoryPrivate :: RepoPatch p => PatchSet rt p Origin wX
                          -> IO (Maybe String)
    writeInventoryPrivate (PatchSet NilRL NilRL) = return Nothing
    writeInventoryPrivate (PatchSet NilRL ps) = do
        inventory <- sequence $ mapRL (writePatchIfNecessary cache compr) ps
        let inventorylist = showInventoryPatches (reverse inventory)
        hash <- writeHashFile cache compr HashedInventoriesDir inventorylist
        return $ Just hash
    writeInventoryPrivate
        (PatchSet xs@(_ :<: Tagged t _ _) x) = do
        resthash <- write_ts xs
        finishedOneIO tediousName $ fromMaybe "" resthash
        inventory <- sequence $ mapRL (writePatchIfNecessary cache compr)
                                    (NilRL :<: t +<+ x)
        let inventorylist = hcat (map showInventoryEntry $ reverse inventory)
            inventorycontents =
                case resthash of
                    Just h -> text ("Starting with inventory:\n" ++ h) $$
                                  inventorylist
                    Nothing -> inventorylist
        hash <- writeHashFile cache compr HashedInventoriesDir inventorycontents
        return $ Just hash
      where
        -- | write_ts writes out a tagged patchset. If it has already been
        -- written, we'll have the hash, so we can immediately return it.
        write_ts :: RepoPatch p => RL (Tagged rt p) Origin wX
                 -> IO (Maybe String)
        write_ts (_ :<: Tagged _ (Just h) _) = return (Just h)
        write_ts (tts :<: Tagged _ Nothing pps) =
            writeInventoryPrivate $ PatchSet tts pps
        write_ts NilRL = return Nothing

-- |writeHashIfNecessary writes the patch and returns the resulting info/hash,
-- if it has not already been written. If it has been written, we have the hash
-- in the PatchInfoAnd, so we extract and return the info/hash.
writePatchIfNecessary :: RepoPatch p => Cache -> Compression
                      -> PatchInfoAnd rt p wX wY -> IO InventoryEntry
writePatchIfNecessary c compr hp = infohp `seq`
    case extractHash hp of
        Right h -> return (infohp, mkValidHash h)
        Left p -> do
          h <- writeHashFile c compr HashedPatchesDir (showPatch ForStorage p)
          return (infohp, mkValidHash h)
  where
    infohp = info hp

-- |listInventoriesWith returns a list of the inventories hashes.
-- The first argument is to choose directory format.
-- The first argument can be readInventoryPrivate or readInventoryLocalPrivate.
-- The second argument specifies whether the files are expected
-- to be stored in plain or in bucketed format.
-- The third argument is the directory of the parent inventory files.
-- The fourth argument is the directory of the head inventory file.
listInventoriesWith
  :: (FilePath -> IO Inventory)
  -> DirLayout
  -> String -> String -> IO [String]
listInventoriesWith readInv dirformat baseDir startDir = do
    mbStartingWithInv <- getStartingWithHash startDir hashedInventory
    followStartingWiths mbStartingWithInv
  where
    getStartingWithHash dir file = inventoryParent <$> readInv (dir </> file)

    invDir = baseDir </> inventoriesDir
    nextDir dir = case dirformat of
        BucketedLayout -> invDir </> bucketFolder dir
        PlainLayout -> invDir

    followStartingWiths Nothing = return []
    followStartingWiths (Just hash) = do
        let startingWith = getValidHash hash
        mbNextInv <- getStartingWithHash (nextDir startingWith) startingWith
        (startingWith :) <$> followStartingWiths mbNextInv

-- |listInventories returns a list of the inventories hashes.
-- This function attempts to retrieve missing inventory files.
listInventories :: IO [String]
listInventories =
    listInventoriesWith readInventoryPrivate PlainLayout darcsdir darcsdir

-- | Read the given inventory file if it exist, otherwise return an empty
-- inventory. Used when we expect that some inventory files may be missing.
readInventoryLocalPrivate :: FilePath -> IO Inventory
readInventoryLocalPrivate path = do
    b <- doesFileExist path
    if b then readInventoryPrivate path
        else return emptyInventory

-- | Return inventories hashes by following the head inventory.
-- This function does not attempt to retrieve missing inventory files.
listInventoriesLocal :: IO [String]
listInventoriesLocal =
    listInventoriesWith readInventoryLocalPrivate PlainLayout darcsdir darcsdir

-- |listInventoriesRepoDir returns a list of the inventories hashes.
-- The argument @repoDir@ is the directory of the repository from which
-- we are going to read the head inventory file.
-- The rest of hashed files are read from the global cache.
listInventoriesRepoDir :: String -> IO [String]
listInventoriesRepoDir repoDir = do
    gCacheDir' <- globalCacheDir
    let gCacheInvDir = fromJust gCacheDir'
    listInventoriesWith
      readInventoryLocalPrivate BucketedLayout gCacheInvDir (repoDir </> darcsdir)

-- | Return a list of the patch filenames, extracted from inventory
-- files, by starting with the head inventory and then following the
-- chain of parent inventories.
--
-- This function does not attempt to download missing inventory files.
--
-- * The first argument specifies whether the files are expected
--   to be stored in plain or in bucketed format.
-- * The second argument is the directory of the parent inventory.
-- * The third argument is the directory of the head inventory.
listPatchesLocal :: DirLayout -> String -> String -> IO [String]
listPatchesLocal dirformat baseDir startDir = do
    inventory <- readInventoryPrivate (startDir </> hashedInventory)
    followStartingWiths (inventoryParent inventory) (inventoryPatchNames inventory)
    where
        invDir = baseDir </> inventoriesDir
        nextDir dir = case dirformat of
            BucketedLayout -> invDir </> bucketFolder dir
            PlainLayout -> invDir

        followStartingWiths Nothing patches = return patches
        followStartingWiths (Just hash) patches = do
            let startingWith = getValidHash hash
            inv <- readInventoryLocalPrivate
                (nextDir startingWith </> startingWith)
            (patches++) <$> followStartingWiths (inventoryParent inv) (inventoryPatchNames inv)

-- |listPatchesLocalBucketed is similar to listPatchesLocal, but
-- it read the inventory directory under @darcsDir@ in bucketed format.
listPatchesLocalBucketed :: String -> String -> IO [String]
listPatchesLocalBucketed = listPatchesLocal BucketedLayout

-- | copyPristine copies a pristine tree into the current pristine dir,
--   and possibly copies a clean working copy.
--   The target is read from the passed-in dir/inventory name combination.
copyPristine :: Cache -> String -> String -> WithWorkingDir -> IO ()
copyPristine cache dir iname wwd = do
    i <- fetchFilePS (dir ++ "/" ++ iname) Uncachable
    debugMessage $ "Copying hashed pristine tree: " ++ peekPristineHash i
    let tediousName = "Copying pristine"
    beginTedious tediousName
    copyHashed tediousName cache wwd $ peekPristineHash i
    endTedious tediousName

-- |copyPartialsPristine copies the pristine entries for a given list of
-- filepaths.
copyPartialsPristine :: FilePathLike fp => Cache -> String
                     -> String -> [fp] -> IO ()
copyPartialsPristine c d iname fps = do
    i <- fetchFilePS (d ++ "/" ++ iname) Uncachable
    copyPartialsHashed c (peekPristineHash i) fps

unrevertUrl :: Repository rt p wR wU wT -> String
unrevertUrl r = repoLocation r ++ "/"++darcsdir++"/patches/unrevert"

tentativelyAddPatch :: (RepoPatch p, ApplyState p ~ Tree)
                    => Repository rt p wR wU wT
                    -> Compression
                    -> Verbosity
                    -> UpdateWorking
                    -> PatchInfoAnd rt p wT wY
                    -> IO (Repository rt p wR wU wY)
tentativelyAddPatch = tentativelyAddPatch_ UpdatePristine

data UpdatePristine = UpdatePristine 
                    | DontUpdatePristine
                    | DontUpdatePristineNorRevert deriving Eq

tentativelyAddPatches_ :: (RepoPatch p, ApplyState p ~ Tree)
                       => UpdatePristine
                       -> Repository rt p wR wU wT
                       -> Compression
                       -> Verbosity
                       -> UpdateWorking
                       -> FL (PatchInfoAnd rt p) wT wY
                       -> IO (Repository rt p wR wU wY)
tentativelyAddPatches_ up r c v uw ps =
    foldFL_M (\r' p -> tentativelyAddPatch_ up r' c v uw p) r ps

-- TODO re-add a safety catch for --dry-run? Maybe using a global, like dryRun
-- :: Bool, with dryRun = unsafePerformIO $ readIORef ...
tentativelyAddPatch_ :: (RepoPatch p, ApplyState p ~ Tree)
                     => UpdatePristine
                     -> Repository rt p wR wU wT
                     -> Compression
                     -> Verbosity
                     -> UpdateWorking
                     -> PatchInfoAnd rt p wT wY
                     -> IO (Repository rt p wR wU wY)

tentativelyAddPatch_ up r compr verb uw p =
    withRepoLocation r $ do
       void $ addToTentativeInventory (repoCache r) compr p
       when (up == UpdatePristine) $ do debugMessage "Applying to pristine cache..."
                                        applyToTentativePristine r verb p
                                        debugMessage "Updating pending..."
                                        tentativelyRemoveFromPending r uw p
       return (coerceT r)


-- |applyToTentativePristine applies a patch @p@ to the tentative pristine
-- tree, and updates the tentative pristine hash
applyToTentativePristine :: (ApplyState q ~ Tree, Apply q, ShowPatch q)
                         => Repository rt p wR wU wT
                         -> Verbosity
                         -> q wT wY
                         -> IO ()
applyToTentativePristine r verb p =
    withRepoLocation r $
    do when (verb == Verbose) $ putDocLn $ text "Applying to pristine..." <+> description p
       applyToTentativePristineCwd p

applyToTentativePristineCwd :: (ApplyState p ~ Tree, Apply p) => p wX wY
                            -> IO ()
applyToTentativePristineCwd p = do
    tentativePristine <- gzReadFilePS tentativePristinePath
    -- Extract the pristine hash from the tentativePristine file, using
    -- peekPristineHash (this is valid since we normally just extract the hash from the
    -- first line of an inventory file; we can pass in a one-line file that
    -- just contains said hash).
    let tentativePristineHash = peekPristineHash tentativePristine
    newPristineHash <- applyToHashedPristine tentativePristineHash p
    writeDocBinFile tentativePristinePath $
        pokePristineHash newPristineHash tentativePristine

tentativelyRemovePatches :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                         => Repository rt p wR wU wT
                         -> Compression
                         -> UpdateWorking
                         -> FL (PatchInfoAnd rt p) wX wT
                         -> IO (Repository rt p wR wU wX)
tentativelyRemovePatches = tentativelyRemovePatches_ UpdatePristine

tentativelyRemovePatches_ :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => UpdatePristine
                          -> Repository rt p wR wU wT
                          -> Compression
                          -> UpdateWorking
                          -> FL (PatchInfoAnd rt p) wX wT
                          -> IO (Repository rt p wR wU wX)
tentativelyRemovePatches_ up r compr uw ps =
    withRepoLocation r $ do
      when (up == UpdatePristine) $ do debugMessage "Adding changes to pending..."
                                       prepend r uw $ effect ps
      unless (up == DontUpdatePristineNorRevert) $ removeFromUnrevertContext r ps
      debugMessage "Removing changes from tentative inventory..."
      if formatHas HashedInventory (repoFormat r)
        then do removeFromTentativeInventory r compr ps
                when (up == UpdatePristine) $
                     applyToTentativePristineCwd $
                     progressFL "Applying inverse to pristine" $ invert ps
        else fail Old.oldRepoFailMsg
      return (coerceT r)

-- FIXME this is a rather weird API. If called with a patch that isn't already
-- in the repo, it fails with an obscure error from 'commuteToEnd'. It also
-- ends up redoing the work that the caller has already done - if it has
-- already commuted these patches to the end, it must also know the commuted
-- versions of the other patches in the repo.
-- |Given a sequence of patches anchored at the end of the current repository,
-- actually pull them to the end of the repository by removing any patches
-- with the same name and then adding the passed in sequence.
-- Typically callers will have obtained the passed in sequence using
-- 'findCommon' and friends.
tentativelyReplacePatches :: forall rt p wR wU wT wX
                           . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => Repository rt p wR wU wT
                          -> Compression
                          -> UpdateWorking
                          -> Verbosity
                          -> FL (PatchInfoAnd rt p) wX wT
                          -> IO ()
tentativelyReplacePatches repository compr uw verb ps =
    do let ps' = filterOutFLFL (namedIsInternal . hopefully) ps
       repository' <- tentativelyRemovePatches_ DontUpdatePristineNorRevert repository compr uw ps'
       mapAdd repository' ps'
  where mapAdd :: Repository rt p wM wL wI
               -> FL (PatchInfoAnd rt p) wI wJ
               -> IO ()
        mapAdd _ NilFL = return ()
        mapAdd r (a:>:as) =
               do r' <- tentativelyAddPatch_ DontUpdatePristine r compr verb uw a
                  mapAdd r' as

-- The type here should rather be
--  ... -> Repo rt p wR wU wT -> IO (Repo rt p wT wU wT)
-- In other words: we set the recorded state to the tentative state.
finalizeRepositoryChanges :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => Repository rt p wR wU wT
                          -> UpdateWorking
                          -> Compression
                          -> IO ()
finalizeRepositoryChanges r updateWorking compr
    | formatHas HashedInventory (repoFormat r) =
        withRepoLocation r $ do
            debugMessage "Finalizing changes..."
            withSignalsBlocked $ do
                 finalizeTentativeChanges r compr
                 recordedState <- readRecorded r
                 finalizePending r updateWorking recordedState
            debugMessage "Done finalizing changes..."
            ps <- readRepo r
            doesPatchIndexExist (repoLocation r) >>= (`when` createOrUpdatePatchIndexDisk r ps)
            updateIndex r
    | otherwise = fail Old.oldRepoFailMsg

-- TODO: rename this and document the transaction protocol (revert/finalize)
-- clearly.
-- |Slightly confusingly named: as well as throwing away any tentative
-- changes, revertRepositoryChanges also re-initialises the tentative state.
-- It's therefore used before makign any changes to the repo.
-- So the type should rather be
--
-- > ... -> Repo rt p wR wU wT -> IO (Repo rt p wR wU wR)
revertRepositoryChanges :: RepoPatch p
                        => Repository rt p wR wU wT
                        -> UpdateWorking
                        -> IO ()
revertRepositoryChanges r uw
 | formatHas HashedInventory (repoFormat r) =
    withRepoLocation r $
    do removeFileMayNotExist (pendingName ++ ".tentative")
       Sealed x <- readPending r
       setTentativePending r uw x
       when (uw == NoUpdateWorking) $ removeFileMayNotExist pendingName
       revertTentativeChanges
 | otherwise = fail Old.oldRepoFailMsg

removeFromUnrevertContext :: forall rt p wR wU wT wX
                           . (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                          => Repository rt p wR wU wT
                          -> FL (PatchInfoAnd rt p) wX wT
                          -> IO ()
removeFromUnrevertContext r ps = do
  Sealed bundle <- unrevert_patch_bundle `catchall` return (seal (PatchSet NilRL NilRL))
  remove_from_unrevert_context_ bundle
  where unrevert_impossible =
            do confirmed <- promptYorn "This operation will make unrevert impossible!\nProceed?"
               if confirmed then removeFileMayNotExist (unrevertUrl r)
                            else fail "Cancelled."
        unrevert_patch_bundle :: IO (SealedPatchSet rt p Origin)
        unrevert_patch_bundle = do pf <- B.readFile (unrevertUrl r)
                                   case scanBundle pf of
                                     Right foo -> return foo
                                     Left err -> fail $ "Couldn't parse unrevert patch:\n" ++ err
        remove_from_unrevert_context_ :: PatchSet rt p Origin wZ -> IO ()
        remove_from_unrevert_context_ (PatchSet NilRL NilRL) = return ()
        remove_from_unrevert_context_ bundle =
         do debugMessage "Adjusting the context of the unrevert changes..."
            debugMessage $ "Removing "++ show (lengthFL ps) ++
                                  " patches in removeFromUnrevertContext!"
            ref <- readTentativeRepo r (repoLocation r)
            let withSinglet :: Sealed (FL ppp wXxx)
                            -> (forall wYyy . ppp wXxx wYyy -> IO ()) -> IO ()
                withSinglet (Sealed (x :>: NilFL)) j = j x
                withSinglet _ _ = return ()
            withSinglet (mergeThem ref bundle) $ \h_us ->
                  case commuteRL (reverseFL ps :> h_us) of
                    Nothing -> unrevert_impossible
                    Just (us' :> _) ->
                      case removeFromPatchSet ps ref of
                      Nothing -> unrevert_impossible
                      Just common ->
                          do debugMessage "Have now found the new context..."
                             bundle' <- makeBundleN Nothing common (hopefully us':>:NilFL)
                             writeDocBinFile (unrevertUrl r) bundle'
            debugMessage "Done adjusting the context of the unrevert changes!"

cleanRepository :: Repository rt p wR wU wT -> IO ()
cleanRepository r = cleanPristine r >> cleanInventories r >> cleanPatches r

-- | grab the pristine hash of _darcs/hash_inventory, and retrieve whole pristine tree,
--   possibly writing a clean working copy in the process.
createPristineDirectoryTree :: Repository rt p wR wU wT -> FilePath -> WithWorkingDir -> IO ()
createPristineDirectoryTree r reldir wwd
    | formatHas HashedInventory (repoFormat r) =
        do createDirectoryIfMissing True reldir
           withCurrentDirectory reldir $
              copyPristine (repoCache r) (repoLocation r) hashedInventoryPath wwd
    | otherwise = fail Old.oldRepoFailMsg

-- fp below really should be FileName
-- | Used by the commands dist and diff
createPartialsPristineDirectoryTree :: (FilePathLike fp)
                                    => Repository rt p wR wU wT
                                    -> [fp]
                                    -> FilePath
                                    -> IO ()
createPartialsPristineDirectoryTree r prefs dir
    | formatHas HashedInventory (repoFormat r) =
        do createDirectoryIfMissing True dir
           withCurrentDirectory dir $
            copyPartialsPristine (repoCache r) (repoLocation r)
              hashedInventoryPath prefs
    | otherwise = fail Old.oldRepoFailMsg

withRecorded :: Repository rt p wR wU wT
             -> ((AbsolutePath -> IO a) -> IO a)
             -> (AbsolutePath -> IO a)
             -> IO a
withRecorded repository mk_dir f
    = mk_dir $ \d -> do createPristineDirectoryTree repository (toFilePath d) WithWorkingDir
                        f d

withTentative :: forall rt p a wR wU wT.
                 Repository rt p wR wU wT
              -> ((AbsolutePath -> IO a) -> IO a)
              -> (AbsolutePath -> IO a)
              -> IO a
withTentative r mk_dir f
    | formatHas HashedInventory (repoFormat r) =
        mk_dir $ \d -> do copyPristine
                              (repoCache r)
                              (repoLocation r)
                              (darcsdir++"/tentative_pristine")
                              WithWorkingDir
                          f d
    | otherwise = fail Old.oldRepoFailMsg

-- | Writes out a fresh copy of the inventory that minimizes the
-- amount of inventory that need be downloaded when people pull from
-- the repository.
--
-- Specifically, it breaks up the inventory on the most recent tag.
-- This speeds up most commands when run remotely, both because a
-- smaller file needs to be transfered (only the most recent
-- inventory).  It also gives a guarantee that all the patches prior
-- to a given tag are included in that tag, so less commutation and
-- history traversal is needed.  This latter issue can become very
-- important in large repositories.
reorderInventory :: (IsRepoType rt, RepoPatch p, ApplyState p ~ Tree)
                 => Repository rt p wR wU wR
                 -> Compression
                 -> UpdateWorking
                 -> Verbosity
                 -> IO ()
reorderInventory repository compr uw verb = do
        debugMessage "Reordering the inventory."
        PatchSet _ ps <- misplacedPatches `fmap` readRepo repository
        tentativelyReplacePatches repository compr uw verb $ reverseRL ps
        finalizeTentativeChanges repository compr
        debugMessage "Done reordering the inventory."

-- | Returns the patches that make the most recent tag dirty.
misplacedPatches :: forall rt p wS wX . RepoPatch p
                 => PatchSet rt p wS wX
                 -> PatchSet rt p wS wX
misplacedPatches ps = 
        -- Filter the repository keeping only with the tags, ordered from the
        -- most recent.
        case filter isTag $ mapRL info $ patchSet2RL ps of
                [] -> ps
                (lt:_) -> 
                    -- Take the most recent tag, and split the repository in,
                    -- the clean PatchSet "up to" the tag (ts), and a RL of
                    -- patches after the tag (r).
                    case splitOnTag lt ps of
                        Just (PatchSet ts xs :> r) -> PatchSet ts (xs+<+r)
                        _ -> impossible -- Because the tag is in ps.

-- @todo: we should not have to open the result of HashedRepo and
-- seal it.  Instead, update this function to work with type witnesses
-- by fixing DarcsRepo to match HashedRepo in the handling of
-- Repository state.
readRepo :: (IsRepoType rt, RepoPatch p)
         => Repository rt p wR wU wT
         -> IO (PatchSet rt p Origin wR)
readRepo r
    | formatHas HashedInventory (repoFormat r) = readRepoHashed r (repoLocation r)
    | otherwise = do Sealed ps <- Old.readOldRepo (repoLocation r)
                     return $ unsafeCoerceP ps

-- | XOR of all hashes of the patches' metadata.
-- It enables to quickly see whether two repositories
-- have the same patches, independently of their order.
-- It relies on the assumption that the same patch cannot
-- be present twice in a repository.
-- This checksum is not cryptographically secure,
-- see http://robotics.stanford.edu/~xb/crypto06b/ .
repoXor :: (IsRepoType rt, RepoPatch p)
        => Repository rt p wR wU wR -> IO SHA1
repoXor repo = do
  hashes <- mapRL (makePatchname . info) . patchSet2RL <$> readRepo repo
  return $ foldl' sha1Xor sha1zero hashes