quickcheck property for parsing of content identifier logs

Logs/ContentIdentifier.hs

@@ -6,6 +6,7 @@
  -}
 
 module Logs.ContentIdentifier (
+	module X,
 	recordContentIdentifier,
 	getContentIdentifiers,
 ) where
@@ -15,7 +16,7 @@ import Logs
 import Logs.MapLog
 import Types.Remote (ContentIdentifier)
 import qualified Annex.Branch
-import Logs.ContentIdentifier.Pure
+import Logs.ContentIdentifier.Pure as X
 import qualified Annex
 
 import qualified Data.Map as M

Logs/ContentIdentifier/Pure.hs

@@ -7,11 +7,7 @@
 
 {-# LANGUAGE OverloadedStrings #-}
 
-module Logs.ContentIdentifier.Pure 
+module Logs.ContentIdentifier.Pure where
-	( ContentIdentifierLog
-	, parseLog
-	, buildLog
-	) where
 
 import Annex.Common
 import Logs.MapLog
@@ -28,11 +24,14 @@ import Data.ByteString.Builder
 type ContentIdentifierLog = MapLog UUID [ContentIdentifier]
 
 buildLog :: ContentIdentifierLog -> Builder
-buildLog = buildMapLog buildUUID valuebuilder
+buildLog = buildMapLog buildUUID buildContentIdentifierList
+
+buildContentIdentifierList :: [ContentIdentifier] -> Builder
+buildContentIdentifierList l = case l of
+	[] -> mempty
+	[c] -> buildcid c
+	(c:cs) -> buildcid c <> charUtf8 ' ' <> buildContentIdentifierList cs
   where
-	valuebuilder [] = mempty
-	valuebuilder [c] = buildcid c
-	valuebuilder (c:cs) = buildcid c <> charUtf8 ' ' <> valuebuilder cs
 	buildcid (ContentIdentifier c)
 		| S8.any (`elem` [' ', '\r', '\n']) c || "!" `S8.isPrefixOf` c =
 			charUtf8 '!' <> byteString (toB64' c)
@@ -41,7 +40,10 @@ buildLog = buildMapLog buildUUID valuebuilder
 parseLog :: L.ByteString -> ContentIdentifierLog
 parseLog = parseMapLog
 	(toUUID <$> A.takeByteString)
-	(reverse . catMaybes <$> valueparser [])
+	parseContentIdentifierList
+
+parseContentIdentifierList :: A.Parser [ContentIdentifier]
+parseContentIdentifierList = reverse . catMaybes <$> valueparser []
   where
 	valueparser l = do
 		b <- A8.takeWhile1 (/= ' ')
@@ -54,3 +56,7 @@ parseLog = parseMapLog
 				_ <- A8.char ' '
 				valueparser (cid:l)
 			)
+
+prop_parse_build_contentidentifier_log :: ContentIdentifierLog -> Bool
+prop_parse_build_contentidentifier_log l =
+	parseLog (toLazyByteString (buildLog l)) == l

Logs/MapLog.hs

@@ -20,6 +20,7 @@ module Logs.MapLog (
 import Common
 import Annex.VectorClock
 import Logs.Line
+import Utility.QuickCheck
 
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map.Strict as M
@@ -32,6 +33,9 @@ data LogEntry v = LogEntry
 	, value :: v
 	} deriving (Eq, Show)
 
+instance Arbitrary v => Arbitrary (LogEntry v) where
+	arbitrary = LogEntry <$> arbitrary <*> arbitrary
+
 type MapLog f v = M.Map f (LogEntry v)
 
 buildMapLog :: (f -> Builder) -> (v -> Builder) -> MapLog f v -> Builder

Logs/Presence/Pure.hs

@@ -122,6 +122,5 @@ instance Arbitrary LogLine where
 		arbinfo = (encodeBS <$> arbitrary) `suchThat`
 			(\b -> C8.notElem '\n' b && C8.notElem '\r' b)
 
-prop_parse_build_log :: [LogLine] -> Bool
+prop_parse_build_presence_log :: [LogLine] -> Bool
-prop_parse_build_log l = parseLog (toLazyByteString (buildLog l)) == l
+prop_parse_build_presence_log l = parseLog (toLazyByteString (buildLog l)) == l
-

Test.hs

@@ -48,6 +48,7 @@ import qualified Logs.Remote
 import qualified Logs.Unused
 import qualified Logs.Transfer
 import qualified Logs.Presence
+import qualified Logs.ContentIdentifier
 import qualified Logs.PreferredContent
 import qualified Types.MetaData
 import qualified Remote
@@ -175,7 +176,8 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck"
 	, testProperty "prop_segment_regressionTest" Utility.Misc.prop_segment_regressionTest
 	, testProperty "prop_read_write_transferinfo" Logs.Transfer.prop_read_write_transferinfo
 	, testProperty "prop_read_show_inodecache" Utility.InodeCache.prop_read_show_inodecache
-	, testProperty "prop_parse_build_log" Logs.Presence.prop_parse_build_log
+	, testProperty "prop_parse_build_presence_log" Logs.Presence.prop_parse_build_presence_log
+	, testProperty "prop_parse_build_contentidentifier_log" Logs.ContentIdentifier.prop_parse_build_contentidentifier_log
 	, testProperty "prop_read_show_TrustLevel" Types.TrustLevel.prop_read_show_TrustLevel
 	, testProperty "prop_parse_build_TrustLevelLog" Logs.Trust.prop_parse_build_TrustLevelLog
 	, testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable

Types/Remote.hs

@@ -45,6 +45,7 @@ import Utility.Metered
 import Git.Types (RemoteName)
 import Utility.SafeCommand
 import Utility.Url
+import Utility.QuickCheck
 
 type RemoteConfigKey = String
 
@@ -246,7 +247,7 @@ data ExportActions a = ExportActions
 {- An identifier for content stored on a remote. It should be reasonably
  - short since it is stored in the git-annex branch. -}
 newtype ContentIdentifier = ContentIdentifier S.ByteString
-	deriving (Eq, Ord, Show)
+	deriving (Eq, Ord, Show, Arbitrary)
 
 {- Some remotes may support importing a history of versions of content that
  - is stored in them. This is equivilant to a git commit history. -}
@@ -256,6 +257,7 @@ data ContentHistory t
 		{ contentHistoryCurrent :: t
 		, contentHistoryPrev :: [ContentHistory t]
 		}
+	deriving (Show)
 
 data ImportActions a = ImportActions
 	-- Finds the current set of files that are stored in the remote,

Types/UUID.hs

@@ -14,10 +14,12 @@ import qualified Data.Map as M
 import qualified Data.UUID as U
 import Data.Maybe
 import Data.String
+import Data.Char
 import Data.ByteString.Builder
 import qualified Data.Semigroup as Sem
 
 import Utility.FileSystemEncoding
+import Utility.QuickCheck
 import qualified Utility.SimpleProtocol as Proto
 
 -- A UUID is either an arbitrary opaque string, or UUID info may be missing.
@@ -81,3 +83,11 @@ type UUIDDescMap = M.Map UUID UUIDDesc
 instance Proto.Serializable UUID where
 	serialize = fromUUID
 	deserialize = Just . toUUID
+
+instance Arbitrary UUID where
+	arbitrary = frequency [(1, return NoUUID), (3, UUID <$> arb)]
+	  where
+		-- Avoid non-ascii because fully arbitrary
+		-- strings may not be encoded using the filesystem
+       		-- encoding, which is normally applied to all input.
+		arb = encodeBS <$> arbitrary `suchThat` all isAscii