git-annex/Logs/Multicast.hs
Joey Hess 6280af2901
generate more compact git-annex branch for imports
Especially from borg, where the content identifier logs
all end up being the same identical file!

But also, for other imports, the location tracking logs can,
in some cases, be identical files.

Bonus optimisation: Avoid looking up (and parsing when set)
GIT_ANNEX_VECTOR_CLOCK env var every time a log is written to.
Although the lookup does happen at startup even when no
log will be written now.
2020-12-23 15:25:16 -04:00

43 lines
1.1 KiB
Haskell

{- git-annex multicast fingerprint log
-
- Copyright 2017, 2019 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU AGPL version 3 or higher.
-}
module Logs.Multicast (
Fingerprint(..),
recordFingerprint,
knownFingerPrints,
) where
import Annex.Common
import qualified Annex.Branch
import Logs
import Logs.UUIDBased
import qualified Data.Map as M
import qualified Data.Attoparsec.ByteString.Lazy as A
import Data.ByteString.Builder
newtype Fingerprint = Fingerprint String
deriving (Eq, Read, Show)
recordFingerprint :: Fingerprint -> UUID -> Annex ()
recordFingerprint fp uuid = do
c <- currentVectorClock
Annex.Branch.change multicastLog $
buildLogOld buildFindgerPrint
. changeLog c uuid fp
. parseLogOld fingerprintParser
knownFingerPrints :: Annex (M.Map UUID Fingerprint)
knownFingerPrints = simpleMap . parseLogOld fingerprintParser
<$> Annex.Branch.get activityLog
fingerprintParser :: A.Parser Fingerprint
fingerprintParser = maybe (fail "fingerprint parse failed") pure
. readish . decodeBS =<< A.takeByteString
buildFindgerPrint :: Fingerprint -> Builder
buildFindgerPrint = byteString . encodeBS . show