bytepatch 0.3.0 → 0.3.1

raw patch · 11 files changed

+69/−117 lines, 11 filesdep ~QuickCheckdep ~hspecdep ~vinylPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependency ranges changed: QuickCheck, hspec, vinyl

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−1
• bytepatch.cabal +9/−9
• src/BytePatch/HexByteString.hs +5/−7
• src/StreamPatch/Apply.hs +3/−3
• src/StreamPatch/Patch.hs +1/−2
• src/StreamPatch/Patch/Binary.hs +16/−61
• src/StreamPatch/Patch/Binary/PascalText.hs +2/−2
• src/StreamPatch/Patch/Linearize.hs +1/−1
• src/StreamPatch/Stream.hs +9/−12
• src/StreamPatch/Util.hs +19/−0
• src/Util.hs +0/−19

@@ -1,4 +1,7 @@-## 0.3.0 (Unreleased)+## 0.3.1 (2021-12-21)+  * packaging improvements (documentation, CI)++## 0.3.0 (2021-12-18) Large internal refactoring.    * Various concepts surrounding stream patching have been decoupled and

@@ -1,11 +1,11 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.34.5. -- -- see: https://github.com/sol/hpack  name:           bytepatch-version:        0.3.0+version:        0.3.1 synopsis:       Patch byte-representable data in a bytestream. description:    Please see README.md. category:       CLI@@ -37,7 +37,7 @@       StreamPatch.Patch.Binary.PascalText       StreamPatch.Patch.Linearize       StreamPatch.Stream-      Util+      StreamPatch.Util   other-modules:       Paths_bytepatch   hs-source-dirs:@@ -78,7 +78,7 @@     , mtl >=2.2.2 && <2.3     , optics >=0.3 && <0.5     , text >=1.2.4.1 && <1.3-    , vinyl+    , vinyl >=0.13.3 && <0.14   default-language: Haskell2010  executable bytepatch@@ -128,7 +128,7 @@     , optics >=0.3 && <0.5     , optparse-applicative >=0.16.1 && <0.17     , text >=1.2.4.1 && <1.3-    , vinyl+    , vinyl >=0.13.3 && <0.14     , yaml >=0.11.7 && <0.12   default-language: Haskell2010 @@ -171,19 +171,19 @@       RankNTypes       ScopedTypeVariables   build-tool-depends:-      hspec-discover:hspec-discover+      hspec-discover:hspec-discover >=2.7 && <2.10   build-depends:-      QuickCheck+      QuickCheck >=2.14.2 && <2.15     , aeson >=1.5 && <2.1     , base >=4.12 && <4.17     , bytepatch     , bytestring >=0.10 && <0.12     , either >=5.0.1.1 && <5.1     , generic-optics >=2.1 && <2.4-    , hspec+    , hspec >=2.7 && <2.10     , megaparsec >=9.0 && <9.3     , mtl >=2.2.2 && <2.3     , optics >=0.3 && <0.5     , text >=1.2.4.1 && <1.3-    , vinyl+    , vinyl >=0.13.3 && <0.14   default-language: Haskell2010

@@ -1,6 +1,6 @@ {- |-A 'Data.ByteString.ByteString' newtype wrapper indicating a human-readable-bytestring, to be displayed in hex form (e.g. 00 12 AB FF).+A 'BS.ByteString' newtype wrapper indicating a human-readable bytestring, to be+displayed in hex form (e.g. 00 12 AB FF). -}  module BytePatch.HexByteString@@ -22,9 +22,7 @@ import           Data.List                  as List import           Data.Aeson -type Bytes = BS.ByteString--newtype HexByteString = HexByteString { unHexByteString :: Bytes }+newtype HexByteString = HexByteString { unHexByteString :: BS.ByteString }     deriving (Eq)  instance Show HexByteString where@@ -43,7 +41,7 @@  -- | A hex bytestring looks like this: @00 01 89 8a   FEff@. You can mix and -- match capitalization and spacing, but I prefer to space each byte, full caps.-parseHexByteString :: (MonadParsec e s m, Token s ~ Char) => m Bytes+parseHexByteString :: (MonadParsec e s m, Token s ~ Char) => m BS.ByteString parseHexByteString = BS.pack <$> parseHexByte `sepBy` MC.hspace  -- | Parse a byte formatted as two hex digits e.g. EF. You _must_ provide both@@ -56,7 +54,7 @@     c2 <- MC.hexDigitChar     return $ 0x10 * fromIntegral (Char.digitToInt c1) + fromIntegral (Char.digitToInt c2) -prettyHexByteString :: Bytes -> Text+prettyHexByteString :: BS.ByteString -> Text prettyHexByteString =     Text.concat . List.intersperse (Text.singleton ' ') . fmap (f . prettyHexByte) . BS.unpack   where

@@ -10,11 +10,11 @@ import qualified Data.ByteString.Builder    as BB import qualified Data.ByteString.Lazy       as BL import           Control.Monad.State-import           Util+import           StreamPatch.Util           ( traverseM_ )  -- TODO how to clean up, use Either monad inside m? (lift didn't work) applyBinFwd-    :: forall a m. (MonadFwdStream m, Chunk m ~ BS.ByteString, BinRep a)+    :: forall a m. (MonadFwdInplaceStream m, Chunk m ~ BS.ByteString, BinRep a)     => Bin.Cfg     -> [Patch 'FwdSeek '[Bin.MetaStream] a]     -> m (Either (Bin.Error a) ())@@ -44,7 +44,7 @@           Right () -> Right $ BB.toLazyByteString bbPatched'  applySimpleFwd-    :: (MonadFwdStream m, Chunk m ~ a)+    :: (MonadFwdInplaceStream m, Chunk m ~ a)     => [Patch 'FwdSeek '[] a]     -> m () applySimpleFwd =

@@ -8,8 +8,7 @@ import           Data.Vinyl import           Control.Applicative ( liftA2 ) -type PatchLike = SeekKind -> [Type -> Type] -> Type -> Type-type Patch :: PatchLike+type Patch :: SeekKind -> [Type -> Type] -> Type -> Type data Patch s fs a = Patch   { patchData :: a   , patchSeek :: SeekRep s

@@ -1,5 +1,7 @@-{-# LANGUAGE RecordWildCards     #-}+{-# LANGUAGE RecordWildCards #-} +-- TODO rewrite patch/check bits (some overlap)+ module StreamPatch.Patch.Binary   ( Meta(..)   , MetaStream(..)@@ -24,8 +26,6 @@ import           Data.Functor.Const import           Data.Vinyl.TypeLevel -type Bytes = BS.ByteString- data Meta = Meta   { mMaxBytes :: Maybe (SeekRep 'FwdSeek)   -- ^ Maximum number of bytes permitted to write at the associated position.@@ -47,9 +47,9 @@  data Error a   = ErrorBadBinRep a String-  | ErrorUnexpectedNonNull Bytes-  | ErrorDidNotMatchExpected Bytes Bytes-  | ErrorBinRepTooLong Bytes Natural+  | ErrorUnexpectedNonNull BS.ByteString+  | ErrorDidNotMatchExpected BS.ByteString BS.ByteString+  | ErrorBinRepTooLong BS.ByteString Natural     deriving (Eq, Show, Generic, Functor, Foldable, Traversable)  patchBinRep@@ -61,7 +61,7 @@        , RElem r ss i        , RSubset rs ss is )     => Patch s ss a-    -> Either (Error a) (Patch s rs Bytes)+    -> Either (Error a) (Patch s rs BS.ByteString) patchBinRep (Patch a s ms) = do     a' <- toBinRep' a     () <- case mMaxBytes m of@@ -72,52 +72,7 @@     let msDroppedMeta = FunctorRec $ rcast @rs $ getFunctorRec ms     ms' <- traverse toBinRep' msDroppedMeta     return $ Patch a' s ms'-  where-    toBinRep' x = mapLeft (\e -> ErrorBadBinRep x e) $ toBinRep x-    m = getConst @Meta $ getFlap $ rget $ getFunctorRec ms--{-----checkBinRep :: BinRep => a -> Either String Bytes--binRep :: BinRep a => a -> Maybe Natural -> Either (Error a) Bytes-binRep a mN =-    case toBinRep a of-      Left  err -> Left $ ErrorBadBinRep a err-      Right bs  ->-        case mN of-          Nothing -> Right bs-          Just n  ->-            if   fromIntegral (BS.length bs) > n-            then Left $ ErrorBinRepTooLong bs n-            else Right bs--check :: BinRep a => Cfg -> Bytes -> MetaStream a -> Either (Error a) ()-check cfg bs meta = do-    case msExpected meta of-      Nothing -> Right ()-      Just aExpected -> do-        bsExpected <- binRep aExpected Nothing -- cheating a bit here-        case msNullTerminates meta of-          Nothing -> check' bs bsExpected-          Just nullsFrom ->-            let (bs', bsNulls) = BS.splitAt (fromIntegral nullsFrom) bs-             in if   bsNulls == BS.replicate (BS.length bsNulls) 0x00-                then check' bs' bsExpected-                else Left $ ErrorUnexpectedNonNull bs-  where-    check' bs' bsExpected =-        case checkExpected cfg bs' bsExpected of-          True  -> Right ()-          False -> Left $ ErrorDidNotMatchExpected bs' bsExpected--checkExpected :: Cfg -> Bytes -> Bytes -> Bool-checkExpected cfg bs bsExpected =-    case cfgAllowPartialExpected cfg of-      True  -> BS.isPrefixOf bs bsExpected-      False -> bs == bsExpected---}+  where m = getConst @Meta $ getFlap $ rget $ getFunctorRec ms  -- | Type has a binary representation for using in patchscripts. --@@ -132,9 +87,9 @@ -- patching a 1-byte length-prefixed string and your string is too long (>255 -- encoded bytes). Thus, 'toPatchRep' is failable. class BinRep a where-    toBinRep :: a -> Either String Bytes+    toBinRep :: a -> Either String BS.ByteString -toBinRep' :: BinRep a => a -> Either (Error a) Bytes+toBinRep' :: BinRep a => a -> Either (Error a) BS.ByteString toBinRep' a = mapLeft (ErrorBadBinRep a) $ toBinRep a  -- | Bytestrings are copied as-is.@@ -149,7 +104,7 @@ instance BinRep String where     toBinRep = toBinRep . Text.pack -check :: BinRep a => Cfg -> Bytes -> MetaStream a -> Either (Error a) ()+check :: BinRep a => Cfg -> BS.ByteString -> MetaStream a -> Either (Error a) () check cfg bs meta = do     case msExpected meta of       Nothing -> Right ()@@ -168,13 +123,13 @@           True  -> Right ()           False -> Left $ ErrorDidNotMatchExpected bs' bsExpected     checkInner a mn = do-        bs <- toBinRep' a+        bs' <- toBinRep' a         case mn of-          Nothing -> Right bs+          Nothing -> Right bs'           Just n  ->-            if   fromIntegral (BS.length bs) > n-            then Left $ ErrorBinRepTooLong bs n-            else Right bs+            if   fromIntegral (BS.length bs') > n+            then Left $ ErrorBinRepTooLong bs' n+            else Right bs'     checkExpected bs' bsExpected =         case cfgAllowPartialExpected cfg of           True  -> BS.isPrefixOf bs' bsExpected

@@ -39,8 +39,8 @@         then Nothing         else Just $ BS.replicate nulls 0x00 <> bs --- | Re-encode an 'Integer' to a little-endian integer stored as a 'ByteString'---   using the fewest bytes needed to represent it.+-- | Re-encode an 'Integer' to a little-endian integer stored as a+--   'BS.ByteString' using the fewest bytes needed to represent it. -- -- adapated from crypto-api 0.13.3, Crypto.Util.i2bs_unsized i2be :: (Integral a, Bits a) => a -> BS.ByteString

@@ -12,7 +12,7 @@ import qualified Data.ByteString        as BS import qualified Data.Text              as Text import           Data.Text              ( Text )-import           Util ( traverseM )+import           StreamPatch.Util       ( traverseM )  class HasLength a where     getLength :: a -> Natural

@@ -1,15 +1,9 @@ module StreamPatch.Stream where -import           StreamPatch.Patch--import           Util--import           Data.Vinyl import           GHC.Natural import           Data.Kind import qualified Data.ByteString            as BS import qualified Data.ByteString.Builder    as BB-import qualified Data.ByteString.Lazy       as BL import           Control.Monad.State import           Control.Monad.Reader import           System.IO                  ( Handle, SeekMode(..), hSeek )@@ -17,7 +11,7 @@ import qualified Data.List                  as List  -- TODO also require reporting cursor position (for error reporting)-class Monad m => MonadFwdStream m where+class Monad m => MonadFwdInplaceStream m where     type Chunk m :: Type      -- | Read a number of bytes without advancing the cursor.@@ -32,7 +26,7 @@  -- TODO Need MonoTraversable to define for Text, ByteString etc easily. Bleh. I -- think Snoyman's advice is to reimplement. Also bleh.-instance Monad m => MonadFwdStream (StateT ([a], [a]) m) where+instance Monad m => MonadFwdInplaceStream (StateT ([a], [a]) m) where     type Chunk (StateT ([a], [a]) m) = [a]     readahead n = List.take (fromIntegral n) <$> gets fst     advance n = do@@ -44,7 +38,7 @@         let (_, src') = List.splitAt (List.length bs) src         put (src', out <> bs) -instance MonadIO m => MonadFwdStream (ReaderT Handle m) where+instance MonadIO m => MonadFwdInplaceStream (ReaderT Handle m) where     type Chunk (ReaderT Handle m) = BS.ByteString     readahead n = do         hdl <- ask@@ -58,7 +52,7 @@         hdl <- ask         liftIO $ BS.hPut hdl bs -instance Monad m => MonadFwdStream (StateT (BS.ByteString, BB.Builder) m) where+instance Monad m => MonadFwdInplaceStream (StateT (BS.ByteString, BB.Builder) m) where     type Chunk (StateT (BS.ByteString, BB.Builder) m) = BS.ByteString     readahead n = BS.take (fromIntegral n) <$> gets fst     advance n = do@@ -71,11 +65,14 @@         put (src', out <> BB.byteString bs)  -- | A forward stream, but backward too.-class MonadFwdStream m => MonadCursorStream m where+class MonadFwdInplaceStream m => MonadCursorInplaceStream m where     -- | Move cursor.     move :: Integer -> m () -instance MonadIO m => MonadCursorStream (ReaderT Handle m) where+instance MonadIO m => MonadCursorInplaceStream (ReaderT Handle m) where     move n = do         hdl <- ask         liftIO $ hSeek hdl RelativeSeek (fromIntegral n)++class MonadFwdInplaceStream m => MonadFwdStream m where+    insert :: Chunk m -> m ()

@@ -0,0 +1,19 @@+module StreamPatch.Util where++import           Data.Foldable ( sequenceA_ )++-- lol. ty hw-kafka-client+traverseM+    :: (Traversable t, Applicative f, Monad m)+    => (v -> m (f v'))+    -> t v+    -> m (f (t v'))+traverseM f xs = sequenceA <$> traverse f xs++-- wonder if this is the correct type? oh well it works+traverseM_+    :: (Traversable t, Applicative f, Monad m)+    => (v -> m (f ()))+    -> t v+    -> m (f ())+traverseM_ f xs = sequenceA_ <$> traverse f xs

@@ -1,19 +0,0 @@-module Util where--import           Data.Foldable ( sequenceA_ )---- lol. ty hw-kafka-client-traverseM-    :: (Traversable t, Applicative f, Monad m)-    => (v -> m (f v'))-    -> t v-    -> m (f (t v'))-traverseM f xs = sequenceA <$> traverse f xs---- wonder if this is the correct type? oh well it works-traverseM_-    :: (Traversable t, Applicative f, Monad m)-    => (v -> m (f ()))-    -> t v-    -> m (f ())-traverseM_ f xs = sequenceA_ <$> traverse f xs