summaryrefslogtreecommitdiff
path: root/Logs
diff options
context:
space:
mode:
authorJoey Hess <joeyh@joeyh.name>2019-01-03 13:21:48 -0400
committerJoey Hess <joeyh@joeyh.name>2019-01-03 13:21:48 -0400
commitbfc9039eadb769e3f7a52dc6c29484cd7f47adcb (patch)
tree99f5ff35d6d59ce6e57ce661ba3b925a241f4b27 /Logs
parent53905490dfaeb5a52fd69ea65e2cc137dd8597db (diff)
convert git-annex branch access to ByteStrings and Builders
Most of the individual logs are not converted yet, only presense logs have an efficient ByteString Builder implemented so far. The rest convert to and from String.
Diffstat (limited to 'Logs')
-rw-r--r--Logs/Activity.hs4
-rw-r--r--Logs/Chunk.hs4
-rw-r--r--Logs/Config.hs4
-rw-r--r--Logs/Difference.hs4
-rw-r--r--Logs/Export.hs10
-rw-r--r--Logs/Group.hs6
-rw-r--r--Logs/Location.hs11
-rw-r--r--Logs/MetaData.hs8
-rw-r--r--Logs/Multicast.hs4
-rw-r--r--Logs/PreferredContent.hs1
-rw-r--r--Logs/PreferredContent/Raw.hs14
-rw-r--r--Logs/Presence.hs12
-rw-r--r--Logs/Presence/Pure.hs45
-rw-r--r--Logs/Remote.hs4
-rw-r--r--Logs/RemoteState.hs4
-rw-r--r--Logs/Schedule.hs4
-rw-r--r--Logs/SingleValue.hs4
-rw-r--r--Logs/Transitions.hs5
-rw-r--r--Logs/Trust/Basic.hs6
-rw-r--r--Logs/UUID.hs4
-rw-r--r--Logs/Web.hs13
21 files changed, 94 insertions, 77 deletions
diff --git a/Logs/Activity.hs b/Logs/Activity.hs
index d7474704eb..240a1b92e7 100644
--- a/Logs/Activity.hs
+++ b/Logs/Activity.hs
@@ -24,10 +24,10 @@ recordActivity :: Activity -> UUID -> Annex ()
recordActivity act uuid = do
c <- liftIO currentVectorClock
Annex.Branch.change activityLog $
- showLog show . changeLog c uuid act . parseLog readish
+ encodeBL . showLog show . changeLog c uuid act . parseLog readish . decodeBL
lastActivities :: Maybe Activity -> Annex (Log Activity)
-lastActivities wantact = parseLog onlywanted <$> Annex.Branch.get activityLog
+lastActivities wantact = parseLog onlywanted . decodeBL <$> Annex.Branch.get activityLog
where
onlywanted s = case readish s of
Just a | wanted a -> Just a
diff --git a/Logs/Chunk.hs b/Logs/Chunk.hs
index 0a419716b8..7926713915 100644
--- a/Logs/Chunk.hs
+++ b/Logs/Chunk.hs
@@ -38,7 +38,7 @@ chunksStored u k chunkmethod chunkcount = do
c <- liftIO currentVectorClock
config <- Annex.getGitConfig
Annex.Branch.change (chunkLogFile config k) $
- showLog . changeMapLog c (u, chunkmethod) chunkcount . parseLog
+ encodeBL . showLog . changeMapLog c (u, chunkmethod) chunkcount . parseLog . decodeBL
chunksRemoved :: UUID -> Key -> ChunkMethod -> Annex ()
chunksRemoved u k chunkmethod = chunksStored u k chunkmethod 0
@@ -46,7 +46,7 @@ chunksRemoved u k chunkmethod = chunksStored u k chunkmethod 0
getCurrentChunks :: UUID -> Key -> Annex [(ChunkMethod, ChunkCount)]
getCurrentChunks u k = do
config <- Annex.getGitConfig
- select . parseLog <$> Annex.Branch.get (chunkLogFile config k)
+ select . parseLog . decodeBL <$> Annex.Branch.get (chunkLogFile config k)
where
select = filter (\(_m, ct) -> ct > 0)
. map (\((_ku, m), l) -> (m, value l))
diff --git a/Logs/Config.hs b/Logs/Config.hs
index 7d1576b272..a98ac64398 100644
--- a/Logs/Config.hs
+++ b/Logs/Config.hs
@@ -34,7 +34,7 @@ setGlobalConfig' :: ConfigName -> ConfigValue -> Annex ()
setGlobalConfig' name new = do
c <- liftIO currentVectorClock
Annex.Branch.change configLog $
- showMapLog id id . changeMapLog c name new . parseGlobalConfig
+ encodeBL . showMapLog id id . changeMapLog c name new . parseGlobalConfig . decodeBL
unsetGlobalConfig :: ConfigName -> Annex ()
unsetGlobalConfig name = do
@@ -50,5 +50,5 @@ parseGlobalConfig :: String -> MapLog ConfigName ConfigValue
parseGlobalConfig = parseMapLog Just Just
loadGlobalConfig :: Annex (M.Map ConfigName ConfigValue)
-loadGlobalConfig = M.filter (not . null) . simpleMap . parseGlobalConfig
+loadGlobalConfig = M.filter (not . null) . simpleMap . parseGlobalConfig . decodeBL
<$> Annex.Branch.get configLog
diff --git a/Logs/Difference.hs b/Logs/Difference.hs
index e392d3f118..cf95735bce 100644
--- a/Logs/Difference.hs
+++ b/Logs/Difference.hs
@@ -25,14 +25,14 @@ recordDifferences :: Differences -> UUID -> Annex ()
recordDifferences ds@(Differences {}) uuid = do
c <- liftIO currentVectorClock
Annex.Branch.change differenceLog $
- showLog id . changeLog c uuid (showDifferences ds) . parseLog Just
+ encodeBL . showLog id . changeLog c uuid (showDifferences ds) . parseLog Just . decodeBL
recordDifferences UnknownDifferences _ = return ()
-- Map of UUIDs that have Differences recorded.
-- If a new version of git-annex has added a Difference this version
-- doesn't know about, it will contain UnknownDifferences.
recordedDifferences :: Annex (M.Map UUID Differences)
-recordedDifferences = parseDifferencesLog <$> Annex.Branch.get differenceLog
+recordedDifferences = parseDifferencesLog . decodeBL <$> Annex.Branch.get differenceLog
recordedDifferencesFor :: UUID -> Annex Differences
recordedDifferencesFor u = fromMaybe mempty . M.lookup u
diff --git a/Logs/Export.hs b/Logs/Export.hs
index 6378881763..7817ca04dc 100644
--- a/Logs/Export.hs
+++ b/Logs/Export.hs
@@ -42,6 +42,7 @@ data ExportChange = ExportChange
getExport :: UUID -> Annex [Exported]
getExport remoteuuid = nub . mapMaybe get . M.toList . simpleMap
. parseExportLog
+ . decodeBL
<$> Annex.Branch.get exportLog
where
get (ep, exported)
@@ -68,10 +69,10 @@ recordExport remoteuuid ec = do
let ep = ExportParticipants { exportFrom = u, exportTo = remoteuuid }
let exported = Exported (newTreeish ec) []
Annex.Branch.change exportLog $
- showExportLog
+ encodeBL . showExportLog
. changeMapLog c ep exported
. M.mapWithKey (updateothers c u)
- . parseExportLog
+ . parseExportLog . decodeBL
where
updateothers c u ep le@(LogEntry _ exported@(Exported { exportedTreeish = t }))
| u == exportFrom ep || remoteuuid /= exportTo ep || t `notElem` oldTreeish ec = le
@@ -89,12 +90,13 @@ recordExportBeginning remoteuuid newtree = do
old <- fromMaybe (Exported emptyTree [])
. M.lookup ep . simpleMap
. parseExportLog
+ . decodeBL
<$> Annex.Branch.get exportLog
let new = old { incompleteExportedTreeish = nub (newtree:incompleteExportedTreeish old) }
Annex.Branch.change exportLog $
- showExportLog
+ encodeBL . showExportLog
. changeMapLog c ep new
- . parseExportLog
+ . parseExportLog . decodeBL
Annex.Branch.graftTreeish newtree (asTopFilePath "export.tree")
parseExportLog :: String -> MapLog ExportParticipants Exported
diff --git a/Logs/Group.hs b/Logs/Group.hs
index b430627462..548fb79398 100644
--- a/Logs/Group.hs
+++ b/Logs/Group.hs
@@ -37,9 +37,9 @@ groupChange uuid@(UUID _) modifier = do
curr <- lookupGroups uuid
c <- liftIO currentVectorClock
Annex.Branch.change groupLog $
- showLog (unwords . S.toList) .
+ encodeBL . showLog (unwords . S.toList) .
changeLog c uuid (modifier curr) .
- parseLog (Just . S.fromList . words)
+ parseLog (Just . S.fromList . words) . decodeBL
-- The changed group invalidates the preferred content cache.
Annex.changeState $ \s -> s
@@ -59,7 +59,7 @@ groupMap = maybe groupMapLoad return =<< Annex.getState Annex.groupmap
groupMapLoad :: Annex GroupMap
groupMapLoad = do
m <- makeGroupMap . simpleMap .
- parseLog (Just . S.fromList . words) <$>
+ parseLog (Just . S.fromList . words) . decodeBL <$>
Annex.Branch.get groupLog
Annex.changeState $ \s -> s { Annex.groupmap = Just m }
return m
diff --git a/Logs/Location.hs b/Logs/Location.hs
index 57c8f53908..dc3ecbfcc6 100644
--- a/Logs/Location.hs
+++ b/Logs/Location.hs
@@ -41,7 +41,6 @@ import Git.Types (RefDate, Ref)
import qualified Annex
import Data.Time.Clock
-import qualified Data.ByteString.Lazy.Char8 as L
{- Log a change in the presence of a key's value in current repository. -}
logStatus :: Key -> LogStatus -> Annex ()
@@ -53,10 +52,10 @@ logStatus key s = do
logChange :: Key -> UUID -> LogStatus -> Annex ()
logChange = logChange' logNow
-logChange' :: (LogStatus -> String -> Annex LogLine) -> Key -> UUID -> LogStatus -> Annex ()
+logChange' :: (LogStatus -> LogInfo -> Annex LogLine) -> Key -> UUID -> LogStatus -> Annex ()
logChange' mklog key u@(UUID _) s = do
config <- Annex.getGitConfig
- maybeAddLog (locationLogFile config key) =<< mklog s (fromUUID u)
+ maybeAddLog (locationLogFile config key) =<< mklog s (LogInfo (fromUUID u))
logChange' _ _ NoUUID _ = noop
{- Returns a list of repository UUIDs that, according to the log, have
@@ -70,12 +69,12 @@ loggedLocationsHistorical = getLoggedLocations . historicalLogInfo
{- Gets the locations contained in a git ref. -}
loggedLocationsRef :: Ref -> Annex [UUID]
-loggedLocationsRef ref = map toUUID . getLog . L.unpack <$> catObject ref
+loggedLocationsRef ref = map (toUUID . fromLogInfo) . getLog <$> catObject ref
-getLoggedLocations :: (FilePath -> Annex [String]) -> Key -> Annex [UUID]
+getLoggedLocations :: (FilePath -> Annex [LogInfo]) -> Key -> Annex [UUID]
getLoggedLocations getter key = do
config <- Annex.getGitConfig
- map toUUID <$> getter (locationLogFile config key)
+ map (toUUID . fromLogInfo) <$> getter (locationLogFile config key)
{- Is there a location log for the key? True even for keys with no
- remaining locations. -}
diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs
index 890c071458..a9a807cb25 100644
--- a/Logs/MetaData.hs
+++ b/Logs/MetaData.hs
@@ -110,9 +110,9 @@ addMetaDataClocked' getlogfile k d@(MetaData m) c
| otherwise = do
config <- Annex.getGitConfig
Annex.Branch.change (getlogfile config k) $
- showLog . simplifyLog
+ encodeBL . showLog . simplifyLog
. S.insert (LogEntry c metadata)
- . parseLog
+ . parseLog . decodeBL
where
metadata = MetaData $ M.filterWithKey (\f _ -> not (isLastChangedField f)) m
@@ -145,8 +145,8 @@ copyMetaData oldkey newkey
else do
config <- Annex.getGitConfig
Annex.Branch.change (metaDataLogFile config newkey) $
- const $ showLog l
+ const $ encodeBL $ showLog l
return True
readLog :: FilePath -> Annex (Log MetaData)
-readLog = parseLog <$$> Annex.Branch.get
+readLog = parseLog . decodeBL <$$> Annex.Branch.get
diff --git a/Logs/Multicast.hs b/Logs/Multicast.hs
index 8deb2800be..357e570e23 100644
--- a/Logs/Multicast.hs
+++ b/Logs/Multicast.hs
@@ -25,7 +25,7 @@ recordFingerprint :: Fingerprint -> UUID -> Annex ()
recordFingerprint fp uuid = do
c <- liftIO currentVectorClock
Annex.Branch.change multicastLog $
- showLog show . changeLog c uuid fp . parseLog readish
+ encodeBL . showLog show . changeLog c uuid fp . parseLog readish . decodeBL
knownFingerPrints :: Annex (M.Map UUID Fingerprint)
-knownFingerPrints = simpleMap . parseLog readish <$> Annex.Branch.get activityLog
+knownFingerPrints = simpleMap . parseLog readish . decodeBL <$> Annex.Branch.get activityLog
diff --git a/Logs/PreferredContent.hs b/Logs/PreferredContent.hs
index ff23485863..2cfcc57506 100644
--- a/Logs/PreferredContent.hs
+++ b/Logs/PreferredContent.hs
@@ -74,6 +74,7 @@ preferredRequiredMapsLoad = do
configmap <- readRemoteLog
let genmap l gm = simpleMap
. parseLogWithUUID ((Just .) . makeMatcher groupmap configmap gm)
+ . decodeBL
<$> Annex.Branch.get l
pc <- genmap preferredContentLog =<< groupPreferredContentMapRaw
rc <- genmap requiredContentLog M.empty
diff --git a/Logs/PreferredContent/Raw.hs b/Logs/PreferredContent/Raw.hs
index 8df5edd43b..730ec348f2 100644
--- a/Logs/PreferredContent/Raw.hs
+++ b/Logs/PreferredContent/Raw.hs
@@ -29,9 +29,9 @@ setLog :: FilePath -> UUID -> PreferredContentExpression -> Annex ()
setLog logfile uuid@(UUID _) val = do
c <- liftIO currentVectorClock
Annex.Branch.change logfile $
- showLog id
+ encodeBL . showLog id
. changeLog c uuid val
- . parseLog Just
+ . parseLog Just . decodeBL
Annex.changeState $ \s -> s
{ Annex.preferredcontentmap = Nothing
, Annex.requiredcontentmap = Nothing
@@ -43,19 +43,19 @@ groupPreferredContentSet :: Group -> PreferredContentExpression -> Annex ()
groupPreferredContentSet g val = do
c <- liftIO currentVectorClock
Annex.Branch.change groupPreferredContentLog $
- showMapLog id id
+ encodeBL . showMapLog id id
. changeMapLog c g val
- . parseMapLog Just Just
+ . parseMapLog Just Just . decodeBL
Annex.changeState $ \s -> s { Annex.preferredcontentmap = Nothing }
preferredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
-preferredContentMapRaw = simpleMap . parseLog Just
+preferredContentMapRaw = simpleMap . parseLog Just . decodeBL
<$> Annex.Branch.get preferredContentLog
requiredContentMapRaw :: Annex (M.Map UUID PreferredContentExpression)
-requiredContentMapRaw = simpleMap . parseLog Just
+requiredContentMapRaw = simpleMap . parseLog Just . decodeBL
<$> Annex.Branch.get requiredContentLog
groupPreferredContentMapRaw :: Annex (M.Map Group PreferredContentExpression)
-groupPreferredContentMapRaw = simpleMap . parseMapLog Just Just
+groupPreferredContentMapRaw = simpleMap . parseMapLog Just Just . decodeBL
<$> Annex.Branch.get groupPreferredContentLog
diff --git a/Logs/Presence.hs b/Logs/Presence.hs
index 382a5a302d..23cac58f13 100644
--- a/Logs/Presence.hs
+++ b/Logs/Presence.hs
@@ -31,8 +31,8 @@ import Git.Types (RefDate)
{- Adds a LogLine to the log, removing any LogLines that are obsoleted by
- adding it. -}
addLog :: FilePath -> LogLine -> Annex ()
-addLog file line = Annex.Branch.change file $ \s ->
- showLog $ compactLog (line : parseLog s)
+addLog file line = Annex.Branch.change file $ \b ->
+ buildLog $ compactLog (line : parseLog b)
{- When a LogLine already exists with the same status and info, but an
- older timestamp, that LogLine is preserved, rather than updating the log
@@ -41,7 +41,7 @@ addLog file line = Annex.Branch.change file $ \s ->
maybeAddLog :: FilePath -> LogLine -> Annex ()
maybeAddLog file line = Annex.Branch.maybeChange file $ \s -> do
m <- insertNewStatus line $ logMap $ parseLog s
- return $ showLog $ mapLog m
+ return $ buildLog $ mapLog m
{- Reads a log file.
- Note that the LogLines returned may be in any order. -}
@@ -49,13 +49,13 @@ readLog :: FilePath -> Annex [LogLine]
readLog = parseLog <$$> Annex.Branch.get
{- Generates a new LogLine with the current time. -}
-logNow :: LogStatus -> String -> Annex LogLine
+logNow :: LogStatus -> LogInfo -> Annex LogLine
logNow s i = do
c <- liftIO currentVectorClock
return $ LogLine c s i
{- Reads a log and returns only the info that is still in effect. -}
-currentLogInfo :: FilePath -> Annex [String]
+currentLogInfo :: FilePath -> Annex [LogInfo]
currentLogInfo file = map info <$> currentLog file
currentLog :: FilePath -> Annex [LogLine]
@@ -66,6 +66,6 @@ currentLog file = filterPresent <$> readLog file
-
- The date is formatted as shown in gitrevisions man page.
-}
-historicalLogInfo :: RefDate -> FilePath -> Annex [String]
+historicalLogInfo :: RefDate -> FilePath -> Annex [LogInfo]
historicalLogInfo refdate file = map info . filterPresent . parseLog
<$> Annex.Branch.getHistorical refdate file
diff --git a/Logs/Presence/Pure.hs b/Logs/Presence/Pure.hs
index 8fc1541776..4411fa0176 100644
--- a/Logs/Presence/Pure.hs
+++ b/Logs/Presence/Pure.hs
@@ -1,6 +1,6 @@
{- git-annex presence log, pure operations
-
- - Copyright 2010-2013 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2019 Joey Hess <id@joeyh.name>
-
- Licensed under the GNU GPL version 3 or higher.
-}
@@ -13,11 +13,17 @@ import Logs.Line
import Utility.QuickCheck
import qualified Data.Map as M
+import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString as S
+import Data.ByteString.Builder
+
+newtype LogInfo = LogInfo { fromLogInfo :: S.ByteString }
+ deriving (Show, Eq, Ord)
data LogLine = LogLine
{ date :: VectorClock
, status :: LogStatus
- , info :: String
+ , info :: LogInfo
} deriving (Eq)
instance Show LogLine where
@@ -27,13 +33,13 @@ data LogStatus = InfoPresent | InfoMissing | InfoDead
deriving (Eq, Show, Bounded, Enum)
{- Parses a log file. Unparseable lines are ignored. -}
-parseLog :: String -> [LogLine]
-parseLog = mapMaybe parseline . splitLines
+parseLog :: L.ByteString -> [LogLine]
+parseLog = mapMaybe parseline . splitLines . decodeBL
where
parseline l = LogLine
<$> parseVectorClock c
<*> parseStatus s
- <*> pure rest
+ <*> pure (LogInfo (encodeBS rest))
where
(c, pastc) = separate (== ' ') l
(s, rest) = separate (== ' ') pastc
@@ -44,17 +50,20 @@ parseStatus "0" = Just InfoMissing
parseStatus "X" = Just InfoDead
parseStatus _ = Nothing
-{- Generates a log file. -}
-showLog :: [LogLine] -> String
-showLog = unlines . map genline
+buildLog :: [LogLine] -> Builder
+buildLog = mconcat . map genline
where
- genline (LogLine c s i) = unwords [formatVectorClock c, genstatus s, i]
- genstatus InfoPresent = "1"
- genstatus InfoMissing = "0"
- genstatus InfoDead = "X"
+ genline (LogLine c s (LogInfo i)) =
+ byteString (encodeBS' (formatVectorClock c)) <> sp <>
+ genstatus s <> sp <> byteString i <> nl
+ sp = charUtf8 ' '
+ nl = charUtf8 '\n'
+ genstatus InfoPresent = charUtf8 '1'
+ genstatus InfoMissing = charUtf8 '0'
+ genstatus InfoDead = charUtf8 'X'
{- Given a log, returns only the info that is are still in effect. -}
-getLog :: String -> [String]
+getLog :: L.ByteString -> [LogInfo]
getLog = map info . filterPresent . parseLog
{- Returns the info from LogLines that are in effect. -}
@@ -66,7 +75,7 @@ filterPresent = filter (\l -> InfoPresent == status l) . compactLog
compactLog :: [LogLine] -> [LogLine]
compactLog = mapLog . logMap
-type LogMap = M.Map String LogLine
+type LogMap = M.Map LogInfo LogLine
mapLog :: LogMap -> [LogLine]
mapLog = M.elems
@@ -101,9 +110,11 @@ instance Arbitrary LogLine where
arbitrary = LogLine
<$> arbitrary
<*> elements [minBound..maxBound]
- <*> arbitrary `suchThat`
+ <*> (LogInfo . encodeBS <$> arbinfo)
+ where
+ arbinfo = arbitrary `suchThat`
(\c -> '\n' `notElem` c && '\r' `notElem` c)
-prop_parse_show_log :: [LogLine] -> Bool
-prop_parse_show_log l = parseLog (showLog l) == l
+prop_parse_build_log :: [LogLine] -> Bool
+prop_parse_build_log l = parseLog (toLazyByteString (buildLog l)) == l
diff --git a/Logs/Remote.hs b/Logs/Remote.hs
index 47a339a5f0..a37225ac8d 100644
--- a/Logs/Remote.hs
+++ b/Logs/Remote.hs
@@ -32,11 +32,11 @@ configSet :: UUID -> RemoteConfig -> Annex ()
configSet u cfg = do
c <- liftIO currentVectorClock
Annex.Branch.change remoteLog $
- showLog showConfig . changeLog c u cfg . parseLog parseConfig
+ encodeBL . showLog showConfig . changeLog c u cfg . parseLog parseConfig . decodeBL
{- Map of remotes by uuid containing key/value config maps. -}
readRemoteLog :: Annex (M.Map UUID RemoteConfig)
-readRemoteLog = simpleMap . parseLog parseConfig <$> Annex.Branch.get remoteLog
+readRemoteLog = simpleMap . parseLog parseConfig . decodeBL <$> Annex.Branch.get remoteLog
parseConfig :: String -> Maybe RemoteConfig
parseConfig = Just . keyValToConfig . words
diff --git a/Logs/RemoteState.hs b/Logs/RemoteState.hs
index 17d084f781..cfdb0c980f 100644
--- a/Logs/RemoteState.hs
+++ b/Logs/RemoteState.hs
@@ -25,12 +25,12 @@ setRemoteState u k s = do
c <- liftIO currentVectorClock
config <- Annex.getGitConfig
Annex.Branch.change (remoteStateLogFile config k) $
- showLogNew id . changeLog c u s . parseLogNew Just
+ encodeBL . showLogNew id . changeLog c u s . parseLogNew Just . decodeBL
getRemoteState :: UUID -> Key -> Annex (Maybe RemoteState)
getRemoteState u k = do
config <- Annex.getGitConfig
- extract . parseLogNew Just
+ extract . parseLogNew Just . decodeBL
<$> Annex.Branch.get (remoteStateLogFile config k)
where
extract m = value <$> M.lookup u m
diff --git a/Logs/Schedule.hs b/Logs/Schedule.hs
index 1868e34603..006e10cd6d 100644
--- a/Logs/Schedule.hs
+++ b/Logs/Schedule.hs
@@ -32,14 +32,14 @@ scheduleSet :: UUID -> [ScheduledActivity] -> Annex ()
scheduleSet uuid@(UUID _) activities = do
c <- liftIO currentVectorClock
Annex.Branch.change scheduleLog $
- showLog id . changeLog c uuid val . parseLog Just
+ encodeBL . showLog id . changeLog c uuid val . parseLog Just . decodeBL
where
val = fromScheduledActivities activities
scheduleSet NoUUID _ = error "unknown UUID; cannot modify"
scheduleMap :: Annex (M.Map UUID [ScheduledActivity])
scheduleMap = simpleMap
- . parseLogWithUUID parser
+ . parseLogWithUUID parser . decodeBL
<$> Annex.Branch.get scheduleLog
where
parser _uuid = eitherToMaybe . parseScheduledActivities
diff --git a/Logs/SingleValue.hs b/Logs/SingleValue.hs
index 8e648a6289..37ef6762b7 100644
--- a/Logs/SingleValue.hs
+++ b/Logs/SingleValue.hs
@@ -26,7 +26,7 @@ import Annex.VectorClock
import qualified Data.Set as S
readLog :: (Ord v, SingleValueSerializable v) => FilePath -> Annex (Log v)
-readLog = parseLog <$$> Annex.Branch.get
+readLog = parseLog . decodeBL <$$> Annex.Branch.get
getLog :: (Ord v, SingleValueSerializable v) => FilePath -> Annex (Maybe v)
getLog = newestValue <$$> readLog
@@ -35,4 +35,4 @@ setLog :: (SingleValueSerializable v) => FilePath -> v -> Annex ()
setLog f v = do
c <- liftIO currentVectorClock
let ent = LogEntry c v
- Annex.Branch.change f $ \_old -> showLog (S.singleton ent)
+ Annex.Branch.change f $ \_old -> encodeBL (showLog (S.singleton ent))
diff --git a/Logs/Transitions.hs b/Logs/Transitions.hs
index 0a90f118fc..d44bfd75b6 100644
--- a/Logs/Transitions.hs
+++ b/Logs/Transitions.hs
@@ -19,6 +19,7 @@ import Annex.VectorClock
import Logs.Line
import qualified Data.Set as S
+import qualified Data.ByteString.Lazy as L
transitionsLog :: FilePath
transitionsLog = "transitions.log"
@@ -81,6 +82,6 @@ transitionList = nub . map transition . S.elems
{- Typically ran with Annex.Branch.change, but we can't import Annex.Branch
- here since it depends on this module. -}
-recordTransitions :: (FilePath -> (String -> String) -> Annex ()) -> Transitions -> Annex ()
+recordTransitions :: (FilePath -> (L.ByteString -> L.ByteString) -> Annex ()) -> Transitions -> Annex ()
recordTransitions changer t = changer transitionsLog $
- showTransitions . S.union t . parseTransitionsStrictly "local"
+ encodeBL . showTransitions . S.union t . parseTransitionsStrictly "local" . decodeBL
diff --git a/Logs/Trust/Basic.hs b/Logs/Trust/Basic.hs
index 850fcc95ff..bef46f8002 100644
--- a/Logs/Trust/Basic.hs
+++ b/Logs/Trust/Basic.hs
@@ -24,13 +24,13 @@ trustSet :: UUID -> TrustLevel -> Annex ()
trustSet uuid@(UUID _) level = do
c <- liftIO currentVectorClock
Annex.Branch.change trustLog $
- showLog showTrustLog .
+ encodeBL . showLog showTrustLog .
changeLog c uuid level .
- parseLog (Just . parseTrustLog)
+ parseLog (Just . parseTrustLog) . decodeBL
Annex.changeState $ \s -> s { Annex.trustmap = Nothing }
trustSet NoUUID _ = error "unknown UUID; cannot modify"
{- Does not include forcetrust or git config values, just those from the
- log file. -}
trustMapRaw :: Annex TrustMap
-trustMapRaw = calcTrustMap <$> Annex.Branch.get trustLog
+trustMapRaw = calcTrustMap . decodeBL <$> Annex.Branch.get trustLog
diff --git a/Logs/UUID.hs b/Logs/UUID.hs
index 41ab7e69b9..7fe4fd8424 100644
--- a/Logs/UUID.hs
+++ b/Logs/UUID.hs
@@ -30,7 +30,7 @@ describeUUID :: UUID -> UUIDDesc -> Annex ()
describeUUID uuid desc = do
c <- liftIO currentVectorClock
Annex.Branch.change uuidLog $
- showLog id . changeLog c uuid (fromUUIDDesc desc) . fixBadUUID . parseLog Just
+ encodeBL . showLog id . changeLog c uuid (fromUUIDDesc desc) . fixBadUUID . parseLog Just . decodeBL
{- Temporarily here to fix badly formatted uuid logs generated by
- versions 3.20111105 and 3.20111025.
@@ -71,7 +71,7 @@ uuidDescMap = maybe uuidDescMapLoad return =<< Annex.getState Annex.uuiddescmap
- it may not have been described and otherwise would not appear. -}
uuidDescMapLoad :: Annex UUIDDescMap
uuidDescMapLoad = do
- m <- (simpleMap . parseLog (Just . UUIDDesc . encodeBS))
+ m <- (simpleMap . parseLog (Just . UUIDDesc . encodeBS)) . decodeBL
<$> Annex.Branch.get uuidLog
u <- Annex.UUID.getUUID
let m' = M.insertWith preferold u mempty m
diff --git a/Logs/Web.hs b/Logs/Web.hs
index 1d69dc8bde..5410a74e7a 100644
--- a/Logs/Web.hs
+++ b/Logs/Web.hs
@@ -20,7 +20,6 @@ module Logs.Web (
removeTempUrl,
) where
-import qualified Data.ByteString.Lazy.Char8 as L
import qualified Data.Map as M
import Annex.Common
@@ -49,7 +48,7 @@ getUrls key = do
us <- currentLogInfo l
if null us
then go ls
- else return us
+ else return $ map (decodeBS . fromLogInfo) us
getUrlsWithPrefix :: Key -> String -> Annex [URLString]
getUrlsWithPrefix key prefix = filter (prefix `isPrefixOf`)
@@ -61,7 +60,8 @@ setUrlPresent key url = do
us <- getUrls key
unless (url `elem` us) $ do
config <- Annex.getGitConfig
- addLog (urlLogFile config key) =<< logNow InfoPresent url
+ addLog (urlLogFile config key)
+ =<< logNow InfoPresent (LogInfo (encodeBS url))
-- If the url does not have an OtherDownloader, it must be present
-- in the web.
case snd (getDownloader url) of
@@ -71,7 +71,8 @@ setUrlPresent key url = do
setUrlMissing :: Key -> URLString -> Annex ()
setUrlMissing key url = do
config <- Annex.getGitConfig
- addLog (urlLogFile config key) =<< logNow InfoMissing url
+ addLog (urlLogFile config key)
+ =<< logNow InfoMissing (LogInfo (encodeBS url))
-- If the url was a web url (not OtherDownloader) and none of
-- the remaining urls for the key are web urls, the key must not
-- be present in the web.
@@ -102,7 +103,9 @@ knownUrls = do
Just k -> zip (repeat k) <$> geturls s
Nothing -> return []
geturls Nothing = return []
- geturls (Just logsha) = getLog . L.unpack <$> catObject logsha
+ geturls (Just logsha) =
+ map (decodeBS . fromLogInfo) . getLog
+ <$> catObject logsha
setTempUrl :: Key -> URLString -> Annex ()
setTempUrl key url = Annex.changeState $ \s ->