factor out Annex.GitShaKey

This commit is contained in:
Joey Hess 2025-03-03 11:08:36 -04:00
parent 63d73d8d1b
commit 6ebab7fb00
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
5 changed files with 45 additions and 30 deletions

View file

@ -11,16 +11,13 @@ module Annex.Export where
import Annex
import Annex.CatFile
import Annex.GitShaKey
import Types
import Types.Key
import qualified Git
import qualified Types.Remote as Remote
import Git.Quote
import Messages
import Data.Maybe
import qualified Data.ByteString.Short as S (fromShort, toShort)
-- From a sha pointing to the content of a file to the key
-- to use to export it. When the file is annexed, it's the annexed key.
-- When the file is stored in git, it's a special type of key to indicate
@ -31,31 +28,6 @@ exportKey sha = mk <$> catKey sha
mk (Just k) = k
mk Nothing = gitShaKey sha
-- Encodes a git sha as a key. This is used to represent a non-annexed
-- file that is stored on a special remote, which necessarily needs a
-- key.
--
-- This is not the same as a SHA1 key, because the mapping needs to be
-- bijective, also because git may not always use SHA1, and because git
-- takes a SHA1 of the file size + content, while git-annex SHA1 keys
-- only checksum the content.
gitShaKey :: Git.Sha -> Key
gitShaKey (Git.Ref s) = mkKey $ \kd -> kd
{ keyName = S.toShort s
, keyVariety = OtherKey "GIT"
}
-- Reverse of gitShaKey
keyGitSha :: Key -> Maybe Git.Sha
keyGitSha k
| fromKey keyVariety k == OtherKey "GIT" =
Just (Git.Ref (S.fromShort (fromKey keyName k)))
| otherwise = Nothing
-- Is a key storing a git sha, and not used for an annexed file?
isGitShaKey :: Key -> Bool
isGitShaKey = isJust . keyGitSha
warnExportImportConflict :: Remote -> Annex ()
warnExportImportConflict r = do
isimport <- Remote.isImportSupported r

41
Annex/GitShaKey.hs Normal file
View file

@ -0,0 +1,41 @@
{- Encoding a git sha as a Key
-
- Copyright 2017-2025 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
{-# LANGUAGE OverloadedStrings #-}
module Annex.GitShaKey where
import Types
import Types.Key
import qualified Git
import Data.Maybe
import qualified Data.ByteString.Short as S (fromShort, toShort)
-- Encodes a git sha as a Key. This is used to represent a non-annexed
-- file. For example, when storing a git sha on a special remote.
--
-- This is not the same as a SHA1 key, because the mapping needs to be
-- bijective, also because git may not always use SHA1, and because git
-- takes a SHA1 of the file size + content, while git-annex SHA1 keys
-- only checksum the content.
gitShaKey :: Git.Sha -> Key
gitShaKey (Git.Ref s) = mkKey $ \kd -> kd
{ keyName = S.toShort s
, keyVariety = OtherKey "GIT"
}
-- Reverse of gitShaKey
keyGitSha :: Key -> Maybe Git.Sha
keyGitSha k
| fromKey keyVariety k == OtherKey "GIT" =
Just (Git.Ref (S.fromShort (fromKey keyName k)))
| otherwise = Nothing
-- Is a key storing a git sha, and not used for an annexed file?
isGitShaKey :: Key -> Bool
isGitShaKey = isJust . keyGitSha

View file

@ -38,12 +38,12 @@ import qualified Annex
import Annex.Link
import Annex.LockFile
import Annex.Content
import Annex.Export
import Annex.RemoteTrackingBranch
import Annex.HashObject
import Annex.Transfer
import Annex.CheckIgnore
import Annex.CatFile
import Annex.GitShaKey
import Annex.VectorClock
import Annex.SpecialRemote.Config
import Command

View file

@ -26,6 +26,7 @@ import Types.Remote
import Types.Export
import Annex.Export
import Annex.Content
import Annex.GitShaKey
import Annex.Transfer
import Annex.CatFile
import Annex.FileMatcher

View file

@ -562,6 +562,7 @@ Executable git-annex
Annex.FileMatcher
Annex.Fixup
Annex.GitOverlay
Annex.GitShaKey
Annex.HashObject
Annex.Hook
Annex.Import