fix failing test case

An empty list of [ContentIdenfier] serialized to the same thing
as a single ContentIdentifier "". Avoid this ambiguity by requiring the
list be non-empty.

Logs/ContentIdentifier.hs

@@ -20,6 +20,7 @@ import Logs.ContentIdentifier.Pure as X
 import qualified Annex
 
 import qualified Data.Map as M
+import Data.List.NonEmpty (NonEmpty(..))
 
 -- | Records a remote's content identifier and the key that it corresponds to.
 --
@@ -32,7 +33,7 @@ recordContentIdentifier u cid k = do
 	Annex.Branch.change (remoteContentIdentifierLogFile config k) $
 		buildLog . addcid c . parseLog
   where
-	addcid c l = changeMapLog c u (cid:fromMaybe [] (M.lookup u m)) l
+	addcid c l = changeMapLog c u (cid :| contentIdentifierList (M.lookup u m)) l
 	  where
 		m = simpleMap l
 
@@ -40,5 +41,5 @@ recordContentIdentifier u cid k = do
 getContentIdentifiers :: UUID -> Key -> Annex [ContentIdentifier]
 getContentIdentifiers u k = do
 	config <- Annex.getGitConfig
-	fromMaybe [] . M.lookup u . simpleMap . parseLog
+	contentIdentifierList . M.lookup u . simpleMap . parseLog
 		<$> Annex.Branch.get (remoteContentIdentifierLogFile config k)

Logs/ContentIdentifier/Pure.hs

@@ -20,39 +20,52 @@ import qualified Data.ByteString.Lazy as L
 import qualified Data.Attoparsec.ByteString.Lazy as A
 import qualified Data.Attoparsec.ByteString.Char8 as A8
 import Data.ByteString.Builder
+import Data.List.NonEmpty (NonEmpty(..))
+import qualified Data.List.NonEmpty
 
-type ContentIdentifierLog = Log [ContentIdentifier]
+-- A ContentIdentifier can contain "", so to avoid ambiguity
+-- in parsing, the list of them in the log must be non-empty.
+type ContentIdentifierLog = Log (NonEmpty ContentIdentifier)
+
+contentIdentifierList :: Maybe (NonEmpty ContentIdentifier) -> [ContentIdentifier]
+contentIdentifierList (Just l) = Data.List.NonEmpty.toList l
+contentIdentifierList Nothing = []
 
 buildLog :: ContentIdentifierLog -> Builder
 buildLog = buildLogNew buildContentIdentifierList
 
-buildContentIdentifierList :: [ContentIdentifier] -> Builder
+buildContentIdentifierList :: (NonEmpty ContentIdentifier) -> Builder
 buildContentIdentifierList l = case l of
-	[] -> mempty
+	c :| [] -> buildcid c
-	[c] -> buildcid c
+	(c :| cs) -> go (c:cs)
-	(c:cs) -> buildcid c <> charUtf8 ':' <> buildContentIdentifierList cs
   where
 	buildcid (ContentIdentifier c)
 		| S8.any (`elem` [':', '\r', '\n']) c || "!" `S8.isPrefixOf` c =
 			charUtf8 '!' <> byteString (toB64' c)
 		| otherwise = byteString c
+	go (c:cs) = buildcid c <> charUtf8 ':' <> go cs
+	go [] = mempty
 
 parseLog :: L.ByteString -> ContentIdentifierLog
 parseLog = parseLogNew parseContentIdentifierList
 
-parseContentIdentifierList :: A.Parser [ContentIdentifier]
+parseContentIdentifierList :: A.Parser (NonEmpty ContentIdentifier)
-parseContentIdentifierList = reverse . catMaybes <$> valueparser []
+parseContentIdentifierList = do
+	first <- cidparser
+	listparser first []
   where
-	valueparser l = do
+	cidparser = do
 		b <- A8.takeWhile (/= ':')
-		let cid = if "!" `S8.isPrefixOf` b
+		return $ if "!" `S8.isPrefixOf` b
-			then ContentIdentifier <$> fromB64Maybe' (S.drop 1 b)
+			then ContentIdentifier $ fromMaybe b (fromB64Maybe' (S.drop 1 b))
-			else Just $ ContentIdentifier b
+			else ContentIdentifier b
+	listparser first rest = do
+		cid <- cidparser
 		ifM A8.atEnd
-			( return (cid:l)
+			( return (first :| reverse (cid:rest))
 			, do
 				_ <- A8.char ':'
-				valueparser (cid:l)
+				listparser first (cid:rest)
 			)
 
 prop_parse_build_contentidentifier_log :: ContentIdentifierLog -> Bool

Utility/QuickCheck.hs

@@ -17,6 +17,7 @@ import Test.QuickCheck as X
 import Data.Time.Clock.POSIX
 import Data.Ratio
 import System.Posix.Types
+import Data.List.NonEmpty (NonEmpty(..))
 import Prelude
 
 {- Times before the epoch are excluded. Half with decimal and half without. -}
@@ -41,6 +42,10 @@ instance Arbitrary FileID where
 instance Arbitrary FileOffset where
 	arbitrary = nonNegative arbitrarySizedIntegral
 
+{- Quickcheck lacks this instance. -}
+instance Arbitrary l => Arbitrary (NonEmpty l) where
+	arbitrary = (:|) <$> arbitrary <*> arbitrary
+
 nonNegative :: (Num a, Ord a) => Gen a -> Gen a
 nonNegative g = g `suchThat` (>= 0)