bytepatch 0.2.0 → 0.2.1

raw patch · 10 files changed

+266/−208 lines, 10 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +5/−0
• README.md +8/−6
• app/Main.hs +37/−7
• bytepatch.cabal +7/−2
• src/BytePatch/Core.hs +32/−11
• src/BytePatch/JSON.hs +24/−26
• src/BytePatch/Linear/Core.hs +0/−13
• src/BytePatch/Linear/Gen.hs +24/−17
• src/BytePatch/Linear/Patch.hs +36/−29
• src/BytePatch/Pretty.hs +93/−97

@@ -1,3 +1,8 @@+## 0.2.1 (2021-12-03)+  * large internal refactoring (still more to come!)+  * schema refactoring (patch -> edit, offsets -> at)+  * Hackage metadata improvements (initial release was a bit wonky)+ ## 0.2.0 (2021-12-03) Initial release. 

@@ -1,10 +1,12 @@ # bytepatch-A CLI tool for patching byte-representable data in a bytestream. Write-**patchscripts** (in-place edits to a file) using a convenient YAML format, and-apply them with a safe patching algorithm. You choose how explicit to be: edits-may be written as a simple `(offset, content)` tuple, or you can provide-metadata regarding expected original data, so you know you're patching the right-file.+A Haskell library and CLI tool for patching byte-representable data in a+bytestream. Write **patchscripts** (in-place edits to a file) using a convenient+YAML format, and apply them with a safe patching algorithm. You choose how+explicit to be: edits may be written as a simple `(offset, content)` tuple, or+you can provide metadata regarding expected original data, so you know you're+patching the right file.++Intended as a general tool for making simple binary editing more manageable.  ## What? If you're modifying binaries, you often end up needing to make edits in a hex

@@ -7,17 +7,18 @@  import           BytePatch.Pretty import           BytePatch.Pretty.PatchRep-import           BytePatch.JSON+import           BytePatch.JSON() import qualified BytePatch.Linear.Patch     as Linear import qualified BytePatch.Linear.Gen       as Linear  import           Control.Monad.IO.Class import qualified Data.ByteString            as BS+import qualified Data.ByteString.Lazy       as BL import qualified Data.Yaml                  as Yaml import           Data.Aeson                 ( FromJSON )-import           Data.Text                  ( Text ) -type Bytes = BS.ByteString+import           Data.Text                  ( Text )+import           BytePatch.Pretty.HexByteString  main :: IO () main = Options.parse >>= run@@ -25,20 +26,49 @@ run :: MonadIO m => Config -> m () run cfg = do     return ()-    tryReadPatchscript @Text (cfgPatchscript cfg) >>= \case+    tryReadPatchscript @HexByteString (cfgPatchscript cfg) >>= \case       Nothing -> quit "couldn't parse patchscript"       Just ps ->         case normalizeSimple ps of           Nothing -> quit "failed while normalizing patchscript"           Just p  ->             case Linear.gen p of-              (_, _:_)  -> quit "failed while generating patchscript"-              (ps', []) -> quit "TODO actually patch"+              (_, genErrs@(_:_)) -> quit' "patchscript generation failed" genErrs+              (ps', []) -> do+                bs <- readStream' io+                case Linear.patchPure (cfgPatchCfg cfg) ps' bs of+                  Left patchErr -> quit' "patching failed" patchErr+                  Right bs' -> writeStream' io (BL.toStrict bs')+  where+    io = cfgStreamInOut cfg +readStream :: MonadIO m => CStream -> m BS.ByteString+readStream stream = liftIO $+    case stream of+      CStreamStd     -> BS.getContents+      CStreamFile fp -> BS.readFile fp++readStream' :: MonadIO m => CStreamInOut -> m BS.ByteString+readStream' = readStream . fst . unCStreamInOut++writeStream :: MonadIO m => CStream -> BS.ByteString -> m ()+writeStream stream bs = liftIO $+    case stream of+      CStreamStd     -> BS.putStr bs+      CStreamFile fp -> BS.writeFile fp bs++writeStream' :: MonadIO m => CStreamInOut -> BS.ByteString -> m ()+writeStream' stream = writeStream (snd (unCStreamInOut stream))++quit' :: (MonadIO m, Show a) => String -> a -> m ()+quit' msg a = liftIO $ do+    putStrLn $ "bytepatch: error: " <> msg+    print a+ quit :: MonadIO m => String -> m () quit = liftIO . putStrLn -tryReadPatchscript :: forall a m. (PatchRep a, FromJSON a, MonadIO m) => FilePath -> m (Maybe [MultiPatches a])+tryReadPatchscript :: forall a m. (PatchRep a, FromJSON a, MonadIO m) => FilePath -> m (Maybe [CommonMultiEdits a]) tryReadPatchscript = tryDecodeYaml  tryDecodeYaml :: (FromJSON a, MonadIO m) => FilePath -> m (Maybe a)

@@ -5,13 +5,19 @@ -- see: https://github.com/sol/hpack  name:           bytepatch-version:        0.2.0+version:        0.2.1 synopsis:       Patch byte-representable data in a bytestream.+description:    Please see README.md.+category:       CLI homepage:       https://github.com/raehik/bytepatch#readme bug-reports:    https://github.com/raehik/bytepatch/issues+author:         Ben Orchard+maintainer:     Ben Orchard <thefirstmuffinman@gmail.com> license:        MIT license-file:   LICENSE build-type:     Simple+tested-with:+    GHC >= 8.6 && < 9.2 extra-source-files:     README.md     CHANGELOG.md@@ -24,7 +30,6 @@   exposed-modules:       BytePatch.Core       BytePatch.JSON-      BytePatch.Linear.Core       BytePatch.Linear.Gen       BytePatch.Linear.Patch       BytePatch.Pretty

@@ -1,17 +1,38 @@+{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-}+ module BytePatch.Core where --- | A single in-place edit.------ Overwrites may store extra metadata that can be used at patch time to--- validate input data (i.e. check we're patching the expected file).-data Overwrite a = Overwrite a (OverwriteMeta a)-    deriving (Eq, Show)+import GHC.Generics ( Generic )+import GHC.Natural --- | Optional patch time data for an overwrite.-data OverwriteMeta a = OverwriteMeta-  { omNullTerminates :: Maybe Int+data Patch (s :: SeekKind) a = Patch (SeekRep s) (Edit a)+    deriving (Generic, Functor, Foldable, Traversable)++deriving instance (Eq (SeekRep s), Eq a) => Eq (Patch s a)+deriving instance (Show (SeekRep s), Show a) => Show (Patch s a)++data SeekKind+  = FwdSeek    -- ^ seeks only move cursor forward+  | CursorSeek -- ^ seeks move cursor forward or backward+  | AbsSeek    -- ^ seeks specify an exact offset in stream+    deriving (Eq, Show, Generic)++type family SeekRep (s :: SeekKind) where+    SeekRep 'FwdSeek    = Natural+    SeekRep 'CursorSeek = Integer+    SeekRep 'AbsSeek    = Natural++-- | Data to add to a stream.+data Edit a = Edit+  { editData :: a+  , editMeta :: EditMeta a+  } deriving (Eq, Show, Generic, Functor, Foldable, Traversable)++-- | Various optional metadata defining expected existing data for an 'Edit'.+data EditMeta a = EditMeta+  { emNullTerminates :: Maybe Int   -- ^ Stream segment should be null bytes (0x00) only from this index onwards. -  , omExpected       :: Maybe a+  , emExpected       :: Maybe a   -- ^ Stream segment should be this.-  } deriving (Eq, Show, Functor, Foldable, Traversable)+  } deriving (Eq, Show, Generic, Functor, Foldable, Traversable)

@@ -1,13 +1,13 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE UndecidableInstances #-}  -- | Aeson instances for various types. module BytePatch.JSON where  import           BytePatch.Core-import           BytePatch.Pretty+import qualified BytePatch.Pretty               as Pretty import           BytePatch.Pretty.HexByteString import           Data.Aeson-import           GHC.Generics       (Generic) import           Text.Megaparsec import           Data.Void @@ -24,34 +24,32 @@   { fieldLabelModifier = camelTo2 '_' . drop x   , rejectUnknownFields = True } -instance ToJSON   a => ToJSON   (MultiPatches a) where-    toJSON     = genericToJSON     (jsonCfgCamelDrop 3)-    toEncoding = genericToEncoding (jsonCfgCamelDrop 3)-instance FromJSON a => FromJSON (MultiPatches a) where-    parseJSON  = genericParseJSON  (jsonCfgCamelDrop 3)+instance ToJSON   a => ToJSON   (Pretty.CommonMultiEdits a) where+    toJSON     = genericToJSON     $ jsonCfgCamelDrop 4+    toEncoding = genericToEncoding $ jsonCfgCamelDrop 4+instance FromJSON a => FromJSON (Pretty.CommonMultiEdits a) where+    parseJSON  = genericParseJSON  $ jsonCfgCamelDrop 4 -instance ToJSON   a => ToJSON   (MultiPatch a) where-    toJSON     = genericToJSON     (jsonCfgCamelDrop 2)-    toEncoding = genericToEncoding (jsonCfgCamelDrop 2)-instance FromJSON a => FromJSON (MultiPatch a) where-    parseJSON  = genericParseJSON  (jsonCfgCamelDrop 2)+instance (ToJSON   (SeekRep s), ToJSON   a) => ToJSON   (Pretty.MultiEdit s a) where+    toJSON     = genericToJSON     $ jsonCfgCamelDrop 2+    toEncoding = genericToEncoding $ jsonCfgCamelDrop 2+instance (FromJSON (SeekRep s), FromJSON a) => FromJSON (Pretty.MultiEdit s a) where+    parseJSON  = genericParseJSON  $ jsonCfgCamelDrop 2 -instance ToJSON   a => ToJSON   (Offset a) where-    toJSON     = genericToJSON     (jsonCfgCamelDrop 1)-    toEncoding = genericToEncoding (jsonCfgCamelDrop 1)-instance FromJSON a => FromJSON (Offset a) where-    parseJSON  = genericParseJSON  (jsonCfgCamelDrop 1)+instance (ToJSON   (SeekRep s), ToJSON   a) => ToJSON   (Pretty.EditOffset s a) where+    toJSON     = genericToJSON     $ jsonCfgCamelDrop 2+    toEncoding = genericToEncoding $ jsonCfgCamelDrop 2+instance (FromJSON (SeekRep s), FromJSON a) => FromJSON (Pretty.EditOffset s a) where+    parseJSON  = genericParseJSON  $ jsonCfgCamelDrop 2 -deriving instance Generic (OverwriteMeta a)-instance ToJSON   a => ToJSON   (OverwriteMeta a) where-    toJSON     = genericToJSON     (jsonCfgCamelDrop 2)-    toEncoding = genericToEncoding (jsonCfgCamelDrop 2)-instance FromJSON a => FromJSON (OverwriteMeta a) where-    parseJSON  = genericParseJSON  (jsonCfgCamelDrop 2)+instance ToJSON   a => ToJSON   (EditMeta a) where+    toJSON     = genericToJSON     $ jsonCfgCamelDrop 2+    toEncoding = genericToEncoding $ jsonCfgCamelDrop 2+instance FromJSON a => FromJSON (EditMeta a) where+    parseJSON  = genericParseJSON  $ jsonCfgCamelDrop 2 -deriving instance Generic (Overwrite a)-instance ToJSON   a => ToJSON   (Overwrite a) where+instance ToJSON   a => ToJSON   (Edit a) where     toJSON     = genericToJSON     defaultOptions     toEncoding = genericToEncoding defaultOptions-instance FromJSON a => FromJSON (Overwrite a) where+instance FromJSON a => FromJSON (Edit a) where     parseJSON  = genericParseJSON  defaultOptions

@@ -1,13 +0,0 @@-module BytePatch.Linear.Core where--import           BytePatch.Core---- | A list of "keep n bytes, write data in-place" actions.-type Patchscript a = [(Int, Overwrite a)]---- | Write the given data into the given offset.-data Patch a = Patch-  { patchContents :: a-  , patchOffset   :: Int-  , patchMeta     :: OverwriteMeta a-  } deriving (Eq, Show)

@@ -1,28 +1,34 @@+{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-}+ module BytePatch.Linear.Gen (gen, Error(..)) where  import           BytePatch.Core-import           BytePatch.Linear.Core  import qualified Data.ByteString        as BS import           Control.Monad.State import qualified Data.List              as List+import           GHC.Natural  type Bytes = BS.ByteString  -- | Error encountered during linear patchscript generation.-data Error a-  = ErrorOverlap (Patch a) (Patch a)+data Error s a+  = ErrorOverlap (Patch s a) (Patch s a)   -- ^ Two edits wrote to the same offset.-    deriving (Eq, Show) --- | Process an offset patchscript into a linear patchscript.+deriving instance (Eq (SeekRep s), Eq a) => Eq (Error s a)+deriving instance (Show (SeekRep s), Show a) => Show (Error s a)++-- | Process a list of patches into a linear patch script. -- -- Errors are reported, but do not interrupt patch generation. The user could -- discard patchscripts that errored, or perhaps attempt to recover them. This -- is what we do for errors: -- --   * overlapping edit: later edit is skipped & overlapping edits reported-gen :: [Patch Bytes] -> (Patchscript Bytes, [Error Bytes])+gen+    :: [Patch 'AbsSeek Bytes]+    -> ([Patch 'FwdSeek Bytes], [Error 'AbsSeek Bytes]) gen pList =     let pList'                 = List.sortBy comparePatchOffsets pList         (_, script, errors, _) = execState (go pList') (0, [], [], undefined)@@ -30,23 +36,24 @@         -- a non-negative offset (negative offsets are forbidden)      in (reverse script, reverse errors)   where-    comparePatchOffsets (Patch _ o1 _) (Patch _ o2 _) = compare o1 o2-    go :: (MonadState (Int, Patchscript Bytes, [Error Bytes], Patch Bytes) m) => [Patch Bytes] -> m ()+    comparePatchOffsets (Patch o1 _) (Patch o2 _) = compare o1 o2+    go+        :: (MonadState (Natural, [Patch 'FwdSeek Bytes], [Error 'AbsSeek Bytes], Patch 'AbsSeek Bytes) m)+        => [Patch 'AbsSeek Bytes]+        -> m ()     go [] = return ()-    go (p@(Patch bs offset meta):ps) = do+    go (p@(Patch offset edit) : ps) = do         (cursor, script, errors, prevPatch) <- get-        case trySkipTo offset cursor of+        case offset `minusNaturalMaybe` cursor of           -- next offset is behind current cursor: overlapping patches           -- record error, recover via dropping patch-          Left _ -> do+          Nothing -> do             let e = ErrorOverlap p prevPatch             let errors' = e : errors             put (cursor, script, errors', p)             go ps-          Right skip -> do-            let cursor' = cursor + skip + BS.length bs-                o       = Overwrite bs meta-            put (cursor', (skip, o):script, errors, p)+          Just skip -> do+            let dataLen = fromIntegral $ BS.length $ editData edit+            let cursor' = cursor + skip + dataLen+            put (cursor', Patch skip edit : script, errors, p)             go ps-    trySkipTo to from =-        let diff = to - from in if diff >= 0 then Right diff else Left (-diff)

@@ -1,3 +1,5 @@+{-# LANGUAGE DataKinds, TypeFamilies #-}+ {- | Low-level patchscript processing and application.  Patchscripts are applied as a list of @(skip x, write in-place y)@ commands. An@@ -13,44 +15,50 @@ -}  module BytePatch.Linear.Patch-  ( patch-  , MonadFwdByteStream(..)+  (+  -- * Patch interface+    MonadFwdByteStream(..)   , Cfg(..)   , Error(..)++  -- * Prepared patchers+  , patchPure++  -- * General patcher+  , patch+   ) where  import           BytePatch.Core-import           BytePatch.Linear.Core +import           GHC.Natural import qualified Data.ByteString         as BS+import qualified Data.ByteString.Lazy    as BL import qualified Data.ByteString.Builder as BB import           Control.Monad.State import           Control.Monad.Reader import           System.IO               ( Handle, SeekMode(..), hSeek )+import           Optics  type Bytes = BS.ByteString  -- TODO also require reporting cursor position (for error reporting) class Monad m => MonadFwdByteStream m where     -- | Read a number of bytes without advancing the cursor.-    readahead :: Int -> m Bytes+    readahead :: Natural -> m Bytes      -- | Advance cursor without reading.-    advance :: Int -> m ()+    advance :: Natural -> m ()      -- | Insert bytes into the stream at the cursor position, overwriting     --   existing bytes.     overwrite :: Bytes -> m ()  instance Monad m => MonadFwdByteStream (StateT (Bytes, BB.Builder) m) where-    readahead n = do-        (src, out) <- get-        let (bs, src') = BS.splitAt n src-        put (src', out)-        return bs+    readahead n = BS.take (fromIntegral n) <$> gets fst     advance n = do         (src, out) <- get-        let (bs, src') = BS.splitAt n src+        let (bs, src') = BS.splitAt (fromIntegral n) src         put (src', out <> BB.byteString bs)     overwrite bs = do         (src, out) <- get@@ -60,7 +68,7 @@ instance MonadIO m => MonadFwdByteStream (ReaderT Handle m) where     readahead n = do         hdl <- ask-        bs <- liftIO $ BS.hGet hdl n+        bs <- liftIO $ BS.hGet hdl (fromIntegral n)         liftIO $ hSeek hdl RelativeSeek (- fromIntegral n)         return bs     advance n = do@@ -88,21 +96,24 @@   | ErrorPatchDidNotMatchExpected Bytes Bytes     deriving (Eq, Show) -patch :: MonadFwdByteStream m => Cfg -> Patchscript Bytes -> m (Maybe Error)+patch+    :: MonadFwdByteStream m+    => Cfg -> [Patch 'FwdSeek Bytes]+    -> m (Maybe Error) patch cfg = go   where     go [] = return Nothing-    go ((n, Overwrite bs meta):es) = do+    go (Patch n (Edit bs meta):es) = do         advance n-        bsStream <- readahead $ BS.length bs -- TODO catch overlong error+        bsStream <- readahead $ fromIntegral $ BS.length bs -- TODO catch overlong error          -- if provided, strip trailing nulls from to-overwrite bytestring-        case tryStripNulls bsStream (omNullTerminates meta) of+        case tryStripNulls bsStream (emNullTerminates meta) of           Nothing -> return $ Just ErrorPatchUnexpectedNonnull           Just bsStream' -> do              -- if provided, check the to-overwrite bytestring matches expected-            case checkExpected bsStream' (omExpected meta) of+            case checkExpected bsStream' (emExpected meta) of               Just (bsa, bse) -> return $ Just $ ErrorPatchDidNotMatchExpected bsa bse               Nothing -> overwrite bs >> go es @@ -125,15 +136,11 @@                    then Nothing                    else Just (bs, bsExpected) -{--finishPurePatch :: (BS.ByteString, BB.Builder) -> BL.ByteString-finishPurePatch (src, out) = BB.toLazyByteString $ out <> BB.byteString src--tmpExPatchscript :: Patchscript-tmpExPatchscript =-  [ (1, "ABC")-  , (2, "DEFG") ]--tmpExInitialState :: (BS.ByteString, BB.Builder)-tmpExInitialState = ("abcdefghijklmnopqrstuvwxyz", mempty)--}+-- | Attempt to apply a patchscript to a 'Data.ByteString.ByteString'.+patchPure :: Cfg -> [Patch 'FwdSeek Bytes] -> BS.ByteString -> Either Error BL.ByteString+patchPure cfg ps bs =+    let (mErr, (bsRemaining, bbPatched)) = runState (patch cfg ps) (bs, mempty)+        bbPatched' = bbPatched <> BB.byteString bsRemaining+     in case mErr of+          Just err -> Left err+          Nothing  -> Right $ BB.toLazyByteString bbPatched'

@@ -1,12 +1,22 @@--- | Convenience interface to enable defining edits at offsets with some---   optional safety checks.+{-# LANGUAGE DataKinds, TypeFamilies, UndecidableInstances #-} +{-|+Convenience interface to enable defining edits at offsets with some optional+safety checks.++Redefines some types to enable us to easily leverage Aeson's generic JSON schema+deriving. That sadly means we can't use some of the interesting offset plumbing.++TODO I should definitely bite the bullet and use the plumbing now that it's so+cool.+-}+ module BytePatch.Pretty   (   -- * Core types-    MultiPatches(..)-  , MultiPatch(..)-  , Offset(..)+    CommonMultiEdits(..)+  , MultiEdit(..)+  , EditOffset(..)    -- * Convenience functions   , normalizeSimple@@ -18,96 +28,70 @@   ) where  import           BytePatch.Core-import           BytePatch.Linear.Core import           BytePatch.Pretty.PatchRep  import qualified Data.ByteString            as BS import           Data.Maybe                 ( fromMaybe ) import           GHC.Generics               ( Generic )+import           GHC.Natural  type Bytes = BS.ByteString --- | Normalize a set of 'MultiPatches', discarding everything on error.-normalizeSimple :: PatchRep a => [MultiPatches a] -> Maybe [Patch Bytes]-normalizeSimple mps =-    let (p, errs) = listAlgebraConcatEtc . map applyBaseOffset $ mps-     in case errs of-          _:_ -> Nothing-          []  -> normalize p+-- | A list of 'MultiEdit's with some common configuration.+data CommonMultiEdits a = CommonMultiEdits+  { cmesBaseOffset :: Maybe (SeekRep 'CursorSeek)+  -- ^+  -- The base offset from which all offsets are located. An actual offset is+  -- calculated by adding the base offset to an offset. Actual offsets below 0+  -- are invalid, meaning for an offset @o@ with base offset @bo@, the actual+  -- offset is only valid when @o >= bo@. Negative base offsets are allowed. --- | A list of patches sharing a configuration, each applied at a list of---   offsets, abstracted over patch type.-data MultiPatches a = MultiPatches-  { mpsBaseOffset :: Maybe Int-  -- ^ The base offset from which all offsets are located. Subtracted from each-  --   offset value to obtain the actual offset. Any offset located before the-  --   base offset (x where x < base) is discarded as erroneous.-  ---  -- This feature enables us to allow negative offsets. For example, say you set-  -- the base offset to @-10@. This is equivalent to stating that every offset-  -- in the list is to be shifted +10 bytes. Thus, all offsets x where x >= -10-  -- are now valid.-  ---  -- The original rationale behind this feature was to ease assembly patches on-  -- ELFs. Decompilers focus on virtual addresses, and apparently (in my-  -- experience) don't like to divulge physical file offsets. However, we can-  -- recover the physical offset of any virtual address via the following steps:-  ---  --   1. subtract the containing ELF segment's virtual address-  --   2.      add the containing ELF segment's physical offset-  ---  -- So we can prepare a base offset @elf_vaddr - elf_phys_offset@, which we can-  -- subtract from any virtual address inside that segment to retrieve its-  -- related byte offset in the ELF file. Thus, you need do that calculation-  -- manually once for every segment you patch, then you can use your-  -- decompiler's virtual addresses!-  ---  -- You can even specify absolute offsets, which are compared to the calculated-  -- actual offsets. So you get the best of both worlds!-  ---  -- Absolute offsets are only used for asserting correctness of calculated-  -- actual offsets. If you want to mix absolute and base-relative offsets...-  -- don't. I'm loath to support that, because I believe it would serve only to-  -- confuse the patch file interface. Instead, group patches into absolute-  -- (base offset = 0) and base-relative lists.+  , cmesEdits :: [MultiEdit 'CursorSeek a]+  } deriving (Eq, Show, Generic, Functor, Foldable, Traversable) -  , mpsPatches :: [MultiPatch a]-  } deriving (Eq, Show, Generic)+-- | A single edit to be applied at a list of offsets.+data MultiEdit (s :: SeekKind) a = MultiEdit+  { meData :: a              -- ^ The value (e.g. bytes, text) to add.+  , meAt   :: [EditOffset s a] -- ^ Offsets to apply edit at.+  } deriving (Generic, Functor, Foldable, Traversable) --- | A single patch applied at a list of offsets, parameterized by patch type.-data MultiPatch a = MultiPatch-  { mpContents    :: a-  -- ^ The value to patch in. Likely a bytestring or text for simple uses.-  , mpOffsets     :: [Offset a]-  } deriving (Eq, Show, Generic)+deriving instance (Eq (SeekRep s), Eq a) => Eq (MultiEdit s a)+deriving instance (Show (SeekRep s), Show a) => Show (MultiEdit s a) --- | An offset in a stream, with metadata about it to use when preparing the---   patch and at patch time.-data Offset a = Offset-  { oOffset         :: Int-  -- ^ Stream offset to patch at.+-- | An edit offset, with metadata to use for preparing and applying the edit.+data EditOffset (s :: SeekKind) a = EditOffset+  { eoOffset    :: SeekRep s+  -- ^ Stream offset for edit. -  , oAbsoluteOffset :: Maybe Int-  -- ^ Absolute stream offset to patch at. Compared with actual offset-  --   (calculated from offset and base offset).+  , eoAbsOffset :: Maybe (SeekRep 'AbsSeek)+  -- ^ Absolute stream offset for edit. Used for checking against actual offset. -  , oMaxLength      :: Maybe Int-  -- ^ Maximum bytestring length allowed to patch in at this offset.-  -- TODO: use single range/span instead (default 0->x, also allow y->x)+  , eoMaxLength :: Maybe Natural+  -- ^ Maximum number of bytes allowed to write at this offset. -  , oPatchMeta      :: Maybe (OverwriteMeta a)-  -- ^ Patch-time info for the overwrite at this offset.-  ---  -- Named "patch meta" instead of the more correct "overwrite meta" for more-  -- friendly JSON field naming. We wrap it in a 'Maybe' for similar reasons,-  -- plus it means the default can be inserted later on.-  } deriving (Eq, Show, Generic)+  , eoEditMeta  :: Maybe (EditMeta a)+  -- ^ Optional apply time metadata for the edit at this offset. +  } deriving (Generic, Functor, Foldable, Traversable)++deriving instance (Eq (SeekRep s), Eq a) => Eq (EditOffset s a)+deriving instance (Show (SeekRep s), Show a) => Show (EditOffset s a)++-- | Normalize a list of 'CommonMultiEdits's, discarding everything on error.+normalizeSimple :: PatchRep a => [CommonMultiEdits a] -> Maybe [Patch 'AbsSeek Bytes]+normalizeSimple cmess =+    let (p, errs) = listAlgebraConcatEtc . map applyBaseOffset $ cmess+     in case errs of+          _:_ -> Nothing+          []  -> normalize p+ -- Drops no info, not easy to consume.-applyBaseOffset :: MultiPatches a -> (Int, [(MultiPatch a, [Offset a])])-applyBaseOffset mps =-    (baseOffset, recalculateMultiPatchOffsets baseOffset (mpsPatches mps))-      where baseOffset = fromMaybe 0 (mpsBaseOffset mps)+applyBaseOffset+    :: CommonMultiEdits a+    -> (Integer, [(MultiEdit 'AbsSeek a, [EditOffset 'CursorSeek a])])+applyBaseOffset cmes =+    (baseOffset, recalculateMultiPatchOffsets baseOffset (cmesEdits cmes))+      where baseOffset = fromMaybe 0 (cmesBaseOffset cmes)  -- lmao this sucks. generalisation bad listAlgebraConcatEtc :: [(a, [(b, [c])])] -> ([b], [(c, a)])@@ -117,42 +101,54 @@     go' x (mp, offs) = (mp, map (\o -> (o, x)) offs)     tuplemconcat = foldr (\(a, bs) (as, bs') -> (a:as, bs <> bs')) ([], mempty) -recalculateMultiPatchOffsets :: Int -> [MultiPatch a] -> [(MultiPatch a, [Offset a])]+recalculateMultiPatchOffsets+    :: Integer+    -> [MultiEdit 'CursorSeek a]+    -> [(MultiEdit 'AbsSeek a, [EditOffset 'CursorSeek a])] recalculateMultiPatchOffsets baseOffset = map go   where-    go :: MultiPatch a -> (MultiPatch a, [Offset a])-    go mp =-        let (osRecalculated, osInvalid) = recalculateOffsets baseOffset (mpOffsets mp)-         in (mp { mpOffsets = osRecalculated }, osInvalid)+    go :: MultiEdit 'CursorSeek a -> (MultiEdit 'AbsSeek a, [EditOffset 'CursorSeek a])+    go me =+        let (osRecalculated, osInvalid) = recalculateOffsets baseOffset (meAt me)+         in (me { meAt = osRecalculated }, osInvalid) -recalculateOffsets :: Int -> [Offset a] -> ([Offset a], [Offset a])+recalculateOffsets+    :: Integer+    -> [EditOffset 'CursorSeek a]+    -> ([EditOffset 'AbsSeek a], [EditOffset 'CursorSeek a]) recalculateOffsets baseOffset = partitionMaybe go   where-    go o = if actualOffset >= 0 then Just (o { oOffset = actualOffset }) else Nothing-      where actualOffset = oOffset o - baseOffset+    go o = let actualOffset = baseOffset + eoOffset o+            in case tryIntegerToNatural actualOffset of+                 Nothing -> Nothing+                 Just actualOffset' -> Just $ o { eoOffset = actualOffset' } -normalize :: PatchRep a => [MultiPatch a] -> Maybe [Patch Bytes]+tryIntegerToNatural :: Integer -> Maybe Natural+tryIntegerToNatural n | n < 0     = Nothing+                      | otherwise = Just $ naturalFromInteger n++normalize :: PatchRep a => [MultiEdit 'AbsSeek a] -> Maybe [Patch 'AbsSeek Bytes] normalize xs = concat <$> mapM go xs-  where go (MultiPatch contents os) = mapM (tryMakeSingleReplace contents) os+  where go (MultiEdit contents os) = mapM (tryMakeSingleReplace contents) os  -- TODO now can error with "[expected] content has no valid patch rep"-tryMakeSingleReplace :: PatchRep a => a -> Offset a -> Maybe (Patch Bytes)-tryMakeSingleReplace contents (Offset os maos maxLen mMeta) =+tryMakeSingleReplace :: PatchRep a => a -> EditOffset 'AbsSeek a -> Maybe (Patch 'AbsSeek Bytes)+tryMakeSingleReplace contents (EditOffset os maos mMaxLen mMeta) =     case toPatchRep contents of       Left errStr -> error errStr -- TODO       Right bs ->         if   offsetIsCorrect-        then case maxLen of-               Just len -> if BS.length bs > len then Nothing else overwrite bs-               Nothing  -> overwrite bs+        then case mMaxLen of+               Just maxLen -> if BS.length bs > fromIntegral maxLen then Nothing else overwrite bs+               Nothing     -> overwrite bs         else Nothing   where     overwrite bs = case traverse toPatchRep meta of                      Left errStr -> error errStr -- TODO-                     Right meta' -> Just $ Patch { patchContents = bs-                                                 , patchOffset   = os-                                                 , patchMeta     = meta' }-    meta = fromMaybe (OverwriteMeta Nothing Nothing) mMeta+                     Right meta' ->+                         Just $ Patch os $ Edit { editData = bs+                                                , editMeta = meta' }+    meta = fromMaybe (EditMeta Nothing Nothing) mMeta     offsetIsCorrect = case maos of Nothing  -> True                                    Just aos -> os == aos