3e68c1c2fd
This allows a remote to store a piece of arbitrary state associated with a key. This is needed to support Tahoe, where the file-cap is calculated from the data stored in it, and used to retrieve a key later. Glacier also would be much improved by using this. GETSTATE and SETSTATE are added to the external special remote protocol. Note that the state is left as-is even when a key is removed from a remote. It's up to the remote to decide when it wants to clear the state. The remote state log, $KEY.log.rmt, is a UUID-based log. However, rather than using the old UUID-based log format, I created a new variant of that format. The new varient is more space efficient (since it lacks the "timestamp=" hack, and easier to parse (and the parser doesn't mess with whitespace in the value), and avoids compatability cruft in the old one. This seemed worth cleaning up for these new files, since there could be a lot of them, while before UUID-based logs were only used for a few log files at the top of the git-annex branch. The transition code has also been updated to handle these new UUID-based logs. This commit was sponsored by Daniel Hofer.
142 lines
3.9 KiB
Haskell
142 lines
3.9 KiB
Haskell
{- git-annex uuid-based logs
|
|
-
|
|
- This is used to store information about a UUID in a way that can
|
|
- be union merged.
|
|
-
|
|
- A line of the log will look like: "UUID[ INFO[ timestamp=foo]]"
|
|
- The timestamp is last for backwards compatability reasons,
|
|
- and may not be present on old log lines.
|
|
-
|
|
- New uuid based logs instead use the form: "timestamp UUID INFO"
|
|
-
|
|
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Logs.UUIDBased (
|
|
Log,
|
|
LogEntry(..),
|
|
TimeStamp(..),
|
|
parseLog,
|
|
parseLogNew,
|
|
parseLogWithUUID,
|
|
showLog,
|
|
showLogNew,
|
|
changeLog,
|
|
addLog,
|
|
simpleMap,
|
|
|
|
prop_TimeStamp_sane,
|
|
prop_addLog_sane,
|
|
) where
|
|
|
|
import qualified Data.Map as M
|
|
import Data.Time.Clock.POSIX
|
|
import Data.Time
|
|
import System.Locale
|
|
|
|
import Common
|
|
import Types.UUID
|
|
|
|
data TimeStamp = Unknown | Date POSIXTime
|
|
deriving (Eq, Ord, Show)
|
|
|
|
data LogEntry a = LogEntry
|
|
{ changed :: TimeStamp
|
|
, value :: a
|
|
} deriving (Eq, Show)
|
|
|
|
type Log a = M.Map UUID (LogEntry a)
|
|
|
|
tskey :: String
|
|
tskey = "timestamp="
|
|
|
|
showLog :: (a -> String) -> Log a -> String
|
|
showLog shower = unlines . map showpair . M.toList
|
|
where
|
|
showpair (k, LogEntry (Date p) v) =
|
|
unwords [fromUUID k, shower v, tskey ++ show p]
|
|
showpair (k, LogEntry Unknown v) =
|
|
unwords [fromUUID k, shower v]
|
|
|
|
showLogNew :: (a -> String) -> Log a -> String
|
|
showLogNew shower = unlines . map showpair . M.toList
|
|
where
|
|
showpair (k, LogEntry (Date p) v) =
|
|
unwords [show p, fromUUID k, shower v]
|
|
showpair (k, LogEntry Unknown v) =
|
|
unwords ["0", fromUUID k, shower v]
|
|
|
|
parseLog :: (String -> Maybe a) -> String -> Log a
|
|
parseLog = parseLogWithUUID . const
|
|
|
|
parseLogWithUUID :: (UUID -> String -> Maybe a) -> String -> Log a
|
|
parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines
|
|
where
|
|
parse line
|
|
-- This is a workaround for a bug that caused
|
|
-- NoUUID items to be stored in the log.
|
|
-- It can be removed at any time; is just here to clean
|
|
-- up logs where that happened temporarily.
|
|
| " " `isPrefixOf` line = Nothing
|
|
| null ws = Nothing
|
|
| otherwise = parser u (unwords info) >>= makepair
|
|
where
|
|
makepair v = Just (u, LogEntry ts v)
|
|
ws = words line
|
|
u = toUUID $ Prelude.head ws
|
|
t = Prelude.last ws
|
|
ts
|
|
| tskey `isPrefixOf` t =
|
|
pdate $ drop 1 $ dropWhile (/= '=') t
|
|
| otherwise = Unknown
|
|
info
|
|
| ts == Unknown = drop 1 ws
|
|
| otherwise = drop 1 $ beginning ws
|
|
pdate s = case parseTime defaultTimeLocale "%s%Qs" s of
|
|
Nothing -> Unknown
|
|
Just d -> Date $ utcTimeToPOSIXSeconds d
|
|
|
|
parseLogNew :: (String -> Maybe a) -> String -> Log a
|
|
parseLogNew parser = M.fromListWith best . mapMaybe parse . lines
|
|
where
|
|
parse line = do
|
|
let (ts, rest) = splitword line
|
|
(u, v) = splitword rest
|
|
date <- Date . utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts
|
|
val <- parser v
|
|
Just (toUUID u, LogEntry date val)
|
|
splitword = separate (== ' ')
|
|
|
|
changeLog :: POSIXTime -> UUID -> a -> Log a -> Log a
|
|
changeLog t u v = M.insert u $ LogEntry (Date t) v
|
|
|
|
{- Only add an LogEntry if it's newer (or at least as new as) than any
|
|
- existing LogEntry for a UUID. -}
|
|
addLog :: UUID -> LogEntry a -> Log a -> Log a
|
|
addLog = M.insertWith' best
|
|
|
|
{- Converts a Log into a simple Map without the timestamp information.
|
|
- This is a one-way trip, but useful for code that never needs to change
|
|
- the log. -}
|
|
simpleMap :: Log a -> M.Map UUID a
|
|
simpleMap = M.map value
|
|
|
|
best :: LogEntry a -> LogEntry a -> LogEntry a
|
|
best new old
|
|
| changed old > changed new = old
|
|
| otherwise = new
|
|
|
|
-- Unknown is oldest.
|
|
prop_TimeStamp_sane :: Bool
|
|
prop_TimeStamp_sane = Unknown < Date 1
|
|
|
|
prop_addLog_sane :: Bool
|
|
prop_addLog_sane = newWins && newestWins
|
|
where
|
|
newWins = addLog (UUID "foo") (LogEntry (Date 1) "new") l == l2
|
|
newestWins = addLog (UUID "foo") (LogEntry (Date 1) "newest") l2 /= l2
|
|
|
|
l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")]
|
|
l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")]
|