{- This file is part of Vervis. - - Written in 2016 by fr33domlover <fr33domlover@riseup.net>. - - ♡ Copying is an act of love. Please copy, reuse and share. - - The author(s) have dedicated all copyright and related and neighboring - rights to this software to the public domain worldwide. This software is - distributed without any warranty. - - You should have received a copy of the CC0 Public Domain Dedication along - with this software. If not, see - <http://creativecommons.org/publicdomain/zero/1.0/>. -} -- We use the ByteString based Attoparsec and not the Text based one because we -- need to create a hash of the patch info. If we use the Text one, Attoparsec -- decodes the text, hopefully as UTF-8, and then we need to encode again to -- ByteString for the hashing. This is dangerous because if the encoding -- doesn't result with the exact original text, we'll have the wrong hash. To -- make sure it's exactly the right content, we use ByteString first and then -- later decode to Text. module Darcs.Local.Inventory.Parser ( latestInventoryPristineP , latestInventorySizeP , latestInventoryPrevSizeP , latestInventoryPageP , latestInventoryAllP , earlyInventorySizeP , earlyInventoryPrevSizeP , earlyInventoryPageP , earlyInventoryAllP ) where import Prelude hiding (take, takeWhile) import Control.Applicative (many, optional, liftA2) import Control.Arrow (second) import Control.Monad (replicateM_) import Crypto.Hash import Data.Attoparsec.ByteString import Data.ByteArray (convert) import Data.ByteString (ByteString) import Data.Time.Calendar (fromGregorianValid) import Data.Time.Clock (UTCTime (..), secondsToDiffTime) import Data.Word (Word8) import System.FilePath ((</>)) import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Lex.Integral as BX import Control.Applicative.Local import Darcs.Local.Hash.Types import Darcs.Local.Inventory.Types import Darcs.Local.Patch import Darcs.Local.Patch.Types import Data.Attoparsec.ByteString.Local import Data.ByteString.Local (stripPrefix) import Data.Text.UTF8.Local (decodeStrict) lf :: Word8 lf = 10 space :: Word8 space = 32 star :: Word8 star = 42 dash :: Word8 dash = 45 zero :: Word8 zero = 48 nine :: Word8 nine = 57 sqrOpen :: Word8 sqrOpen = 91 --sqrClose :: Word8 --sqrClose = 93 digit :: Parser Word8 digit = satisfy $ \ w -> zero <= w && w <= nine digitP :: Num a => Parser a digitP = fmap (\ c -> fromIntegral $ c - zero) digit decimal2P :: Num a => Parser a decimal2P = (\ h l -> 10 * h + l) <$> digitP <*> digitP decimal4P :: Num a => Parser a decimal4P = (\ hh h l ll -> 10 * (10 * (10 * hh + h) + l) + ll) <$> digitP <*> digitP <*> digitP <*> digitP patchTimeP :: Parser UTCTime patchTimeP = do year <- decimal4P month <- decimal2P day <- decimal2P hours <- decimal2P minutes <- decimal2P seconds <- decimal2P case fromGregorianValid year month day of Nothing -> fail "Invalid patch date" Just uday -> return UTCTime { utctDay = uday , utctDayTime = secondsToDiffTime $ 3600 * hours + 60 * minutes + seconds } line :: Parser ByteString line = restOfLine restOfLine :: Parser ByteString restOfLine = takeWhile (/= lf) eol :: Parser () eol = skip (== lf) skipLine :: Parser () skipLine = skipWhile (/= lf) skipRestOfLine :: Parser () skipRestOfLine = skipLine skipPatchP :: Parser () skipPatchP = -- title skipLine *> eol *> -- author, inverted, time skipLine *> eol *> -- ignore, description (skipMany $ skip (== space) *> skipRestOfLine *> eol) *> -- end of info (string "] \n") *> -- hash skipLine sha256P :: Parser ByteString sha256P = do bs <- take 64 case second B.null $ B16.decode bs of (h, True) -> return h _ -> fail "SHA256 decoding from hex failed" sizeP :: Parser Int sizeP = do bs <- take 10 case second B.null <$> BX.readDecimal bs of Just (n, True) -> return n _ -> fail "sizeP failed" sizeSha256P :: Parser (Int, ByteString) sizeSha256P = liftA2 (,) sizeP (skip (== dash) *> sha256P) pristineP :: Parser PristineHash pristineP = string "pristine:" *> (PristineHash <$> sha256P) prevInvP :: Parser InventoryHash prevInvP = string "Starting with inventory" *> eol *> (uncurry InventoryHash <$> sizeSha256P) patchInfoRawP :: Parser PatchInfoRaw patchInfoRawP = do word8 sqrOpen title <- takeWhile1 (/= lf) eol author <- takeWhile1 (/= star) word8 star inverted <- (/= star) <$> (satisfy $ \ c -> c == star || c == dash) (timeRaw, time) <- match patchTimeP eol word8 space junkp <- string "Ignore-this: " junkc <- takeWhile1 (/= lf) eol lines <- many $ word8 space *> takeWhile (/= lf) <* eol string "] \nhash: " hash <- sizeSha256P return PatchInfoRaw { pirAuthor = author , pirHash = hash , pirTitle = title , pirDescription = lines , pirJunkPrefix = junkp , pirJunkContent = junkc , pirTime = (timeRaw, time) , pirInverted = inverted } -- TODO -- -- * Finish DarcsRev code, make it build -- * Update darcs change view code to work correctly in the case of previous -- inventories, test vervis against libravatar for that -- | Parse patch metadata and compute the metadata's hash, which can be used as -- a patch identifier for lookup and matching. patchInfoP :: Parser (PatchInfo, PatchHash) patchInfoP = do pir <- patchInfoRawP return (refinePatchInfo pir, PatchHash $ convert $ hashPatchInfo SHA1 pir) tagInfoP :: Parser (TagInfo, PatchHash) tagInfoP = do (pi, ph) <- patchInfoP case patchToTag pi of Nothing -> fail "Expected a tag, got a patch that isn't a tag" Just ti -> return (ti, ph) ------------------------------------------------------------------------------- -- Latest inventory ------------------------------------------------------------------------------- latestInventoryPristineP :: Parser PristineHash latestInventoryPristineP = pristineP latestInventorySizeP :: Parser Int latestInventorySizeP = -- pristine hash skipLine *> -- previous inventory optional ( eol *> string "Starting" *> skipRestOfLine *> eol *> skipLine ) *> -- patch info (length <$> many (eol *> skipPatchP)) <* eol latestInventoryPrevSizeP :: Parser (Maybe InventoryHash, Int) latestInventoryPrevSizeP = liftA2 (,) ( -- pristine hash skipLine *> -- previous inventory optional (eol *> prevInvP) ) ( -- patch info (length <$> many (eol *> skipPatchP)) <* eol ) latestInventoryPageP :: Int -> Int -> Parser (Maybe InventoryHash, [(PatchInfo, PatchHash)]) latestInventoryPageP off lim = let f mPrevTag pis = case mPrevTag of Nothing -> (Nothing, pis) Just (ih, pi) -> (Just ih, pi : pis) in liftA2 f -- pristine ( skipLine *> -- previous inventory and clean tag optional (liftA2 (,) (eol *> prevInvP) (eol *> patchInfoP)) <* -- skip offset replicateM_ off (eol *> skipPatchP) ) -- take limit (atMost lim $ eol *> patchInfoP) latestInventoryAllP :: Parser LatestInventory latestInventoryAllP = LatestInventory <$> pristineP <*> optional (liftA2 (,) (eol *> prevInvP) (eol *> tagInfoP)) <*> many (eol *> patchInfoP) <* eol ------------------------------------------------------------------------------- -- Early inventory ------------------------------------------------------------------------------- earlyInventorySizeP :: Parser Int earlyInventorySizeP = -- previous inventory optional ( string "Starting" *> skipRestOfLine *> eol *> skipLine ) *> -- patch info (length <$> many (eol *> skipPatchP)) <* eol earlyInventoryPrevSizeP :: Parser (Maybe InventoryHash, Int) earlyInventoryPrevSizeP = liftA2 (,) -- previous inventory (optional $ prevInvP <* eol) -- patch info (length <$> many (skipPatchP *> eol)) earlyInventoryPageP :: Int -> Int -> Parser (Maybe InventoryHash, [(PatchInfo, PatchHash)]) earlyInventoryPageP off lim = let f mPrevTag pis = case mPrevTag of Nothing -> (Nothing, pis) Just (ih, pi) -> (Just ih, pi : pis) in liftA2 f -- previous inventory and clean tag ( optional (liftA2 (,) (prevInvP <* eol) (patchInfoP <* eol)) <* -- skip offset replicateM_ off (skipPatchP *> eol) ) -- take limit (atMost lim $ patchInfoP <* eol) earlyInventoryAllP :: Parser (Either EarliestInventory MiddleInventory) earlyInventoryAllP = let f Nothing pis = Left $ EarliestInventory pis f (Just (prev, ti)) pis = Right $ MiddleInventory prev ti pis in liftA2 f (optional $ liftA2 (,) (prevInvP <* eol) (tagInfoP <* eol)) (many (patchInfoP <* eol)) {- patchInfosOffsetP :: Int -> Parser PatchSeq patchInfosOffsetP off = PatchSeq <$> pristineP <*> optional (eol *> prevInvP) <*> ( replicateM_ off (eol *> skipPatchP) *> many (eol *> patchInfoP) ) <* eol patchInfosLimitP :: Int -> Parser PatchSeq patchInfosLimitP lim = PatchSeq <$> pristineP <*> optional (eol *> prevInvP) <*> atMost lim (eol *> patchInfoP) -}