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.
This commit is contained in:
parent
be6085cfe5
commit
c0bd202147
3 changed files with 34 additions and 15 deletions
|
@ -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)
|
||||
|
|
|
@ -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:cs) -> buildcid c <> charUtf8 ':' <> buildContentIdentifierList cs
|
||||
c :| [] -> buildcid c
|
||||
(c :| cs) -> go (c: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 = reverse . catMaybes <$> valueparser []
|
||||
parseContentIdentifierList :: A.Parser (NonEmpty ContentIdentifier)
|
||||
parseContentIdentifierList = do
|
||||
first <- cidparser
|
||||
listparser first []
|
||||
where
|
||||
valueparser l = do
|
||||
cidparser = do
|
||||
b <- A8.takeWhile (/= ':')
|
||||
let cid = if "!" `S8.isPrefixOf` b
|
||||
then ContentIdentifier <$> fromB64Maybe' (S.drop 1 b)
|
||||
else Just $ ContentIdentifier b
|
||||
return $ if "!" `S8.isPrefixOf` b
|
||||
then ContentIdentifier $ fromMaybe b (fromB64Maybe' (S.drop 1 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
|
||||
|
|
|
@ -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)
|
||||
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue