1{- git-annex presence log, pure operations
2 -
3 - Copyright 2010-2019 Joey Hess <id@joeyh.name>
4 -
5 - Licensed under the GNU AGPL version 3 or higher.
6 -}
7
8module Logs.Presence.Pure where
9
10import Annex.Common
11import Annex.VectorClock
12import Logs.Line
13import Utility.QuickCheck
14
15import qualified Data.Map as M
16import qualified Data.ByteString.Lazy as L
17import qualified Data.ByteString as S
18import qualified Data.ByteString.Char8 as C8
19import qualified Data.Attoparsec.ByteString.Lazy as A
20import Data.Attoparsec.ByteString.Char8 (char, anyChar)
21import Data.ByteString.Builder
22import Data.Char
23
24newtype LogInfo = LogInfo { fromLogInfo :: S.ByteString }
25	deriving (Show, Eq, Ord)
26
27data LogLine = LogLine
28	{ date :: VectorClock
29	, status :: LogStatus
30	, info :: LogInfo
31	} deriving (Eq, Show)
32
33data LogStatus = InfoPresent | InfoMissing | InfoDead
34	deriving (Eq, Show, Bounded, Enum)
35
36parseLog :: L.ByteString -> [LogLine]
37parseLog = fromMaybe [] . A.maybeResult . A.parse logParser
38
39logParser :: A.Parser [LogLine]
40logParser = parseLogLines $ LogLine
41	<$> vectorClockParser
42	<* char ' '
43	<*> statusParser
44	<* char ' '
45	<*> (LogInfo <$> A.takeByteString)
46
47statusParser :: A.Parser LogStatus
48statusParser = do
49	c <- anyChar
50	case c of
51		'1' -> return InfoPresent
52		'0' -> return InfoMissing
53		'X' -> return InfoDead
54		_ -> fail "unknown status character"
55
56parseStatus :: String -> Maybe LogStatus
57parseStatus "1" = Just InfoPresent
58parseStatus "0" = Just InfoMissing
59parseStatus "X" = Just InfoDead
60parseStatus _ = Nothing
61
62buildLog :: [LogLine] -> Builder
63buildLog = mconcat . map genline
64  where
65	genline (LogLine c s (LogInfo i)) =
66		buildVectorClock c <> sp <> genstatus s <> sp <> byteString i <> nl
67	sp = charUtf8 ' '
68	nl = charUtf8 '\n'
69	genstatus InfoPresent = charUtf8 '1'
70	genstatus InfoMissing = charUtf8 '0'
71	genstatus InfoDead = charUtf8 'X'
72
73{- Given a log, returns only the info that is are still in effect. -}
74getLog :: L.ByteString -> [LogInfo]
75getLog = map info . filterPresent . parseLog
76
77{- Returns the info from LogLines that are in effect. -}
78filterPresent :: [LogLine] -> [LogLine]
79filterPresent = filter (\l -> InfoPresent == status l) . compactLog
80
81{- Compacts a set of logs, returning a subset that contains the current
82 - status. -}
83compactLog :: [LogLine] -> [LogLine]
84compactLog = mapLog . logMap
85
86type LogMap = M.Map LogInfo LogLine
87
88mapLog :: LogMap -> [LogLine]
89mapLog = M.elems
90
91logMap :: [LogLine] -> LogMap
92logMap = foldr insertNewerLogLine M.empty
93
94insertBetter :: (LogLine -> Bool) -> LogLine -> LogMap -> Maybe LogMap
95insertBetter betterthan l m
96	| better = Just (M.insert i l m)
97	| otherwise = Nothing
98  where
99	better = maybe True betterthan (M.lookup i m)
100	i = info l
101
102{- Inserts a log into a map of logs, if the log has newer
103 - information than the other logs in the map for the same info. -}
104insertNewerLogLine :: LogLine -> LogMap -> LogMap
105insertNewerLogLine l m = fromMaybe m $ insertBetter newer l m
106  where
107	newer l' = date l' <= date l
108
109{- Inserts the log unless there's already one in the map with
110 - the same status for its info, in which case there's no need to
111 - change anything, to avoid log churn. -}
112insertNewStatus :: LogLine -> LogMap -> Maybe LogMap
113insertNewStatus l m  = insertBetter diffstatus l m
114  where
115	diffstatus l' = status l' /= status l
116
117instance Arbitrary LogLine where
118	arbitrary = LogLine
119		<$> arbitrary
120		<*> elements [minBound..maxBound]
121		<*> (LogInfo <$> arbinfo)
122	  where
123	  	-- Avoid newline characters, which cannot appear in
124		-- LogInfo.
125		--
126		-- Avoid non-ascii values because fully arbitrary
127		-- strings may not be encoded using the filesystem
128		-- encoding, which is normally applied to all input.
129		arbinfo = (encodeBS <$> arbitrary `suchThat` all isAscii)
130			`suchThat` (\b -> C8.notElem '\n' b && C8.notElem '\r' b)
131
132prop_parse_build_presence_log :: [LogLine] -> Bool
133prop_parse_build_presence_log l =
134	parseLog (toLazyByteString (buildLog l)) == l
135