mfmts 1.1.0.0 → 1.2.0.0

raw patch · 21 files changed

+437/−298 lines, 21 filesdep +deepseqdep +xcodecdep ~basesystemsPVP ok

version bump matches the API change (PVP)

Dependencies added: deepseq, xcodec

Dependency ranges changed: basesystems

API changes (from Hackage documentation)

Files

• CHANGELOG.md +23/−2
• README.md +17/−21
• cid/MultiFormats/CID.hs +60/−33
• cid/MultiFormats/CID/Component/Codec.hs +7/−2
• cid/MultiFormats/CID/Component/Decoder.hs +1/−1
• cid/MultiFormats/CID/Component/Hash.hs +14/−8
• cid/MultiFormats/CID/Component/Version.hs +11/−45
• cid/MultiFormats/CID/Constants.hs +58/−0
• cid/MultiFormats/CID/Errors.hs +21/−0
• cid/MultiFormats/CID/Extractor.hs +6/−3
• mfmts.cabal +6/−3
• multibase/MultiFormats/MultiBase.hs +1/−1
• multibase/MultiFormats/MultiBase/DigitSystem.hs +0/−102
• multibase/MultiFormats/MultiBase/DigitSystems.hs +102/−0
• multibase/MultiFormats/MultiBase/DigitTranscoder.hs +6/−6
• multibase/MultiFormats/MultiBase/Lazy.hs +1/−1
• multibase/MultiFormats/MultiBase/Strict.hs +1/−1
• multicodec/MultiFormats/MultiCodec.hs +40/−14
• multihash/MultiFormats/MultiHash.hs +17/−15
• varint/MultiFormats/VarInt.hs +39/−40
• varint/MultiFormats/VarInt/Errors.hs +6/−0

@@ -1,8 +1,29 @@-[`mfmts`](http://hackage-content.haskell.org/package/mfmts) change log:-=======================================================================+[`mfmts`](http://hackage.haskell.org/package/mfmts) change log:+=============================================================== +Major release 1.2+-----------------++## Version 1.2.0.0 (07-08-26)++This version introduces the new XCodec changes and renames modules to match the+rest of the ipfshs project. It also creates a unified module for CID constants+in `MultiFormats.CID.Constants` and cleans up the naming of each exported name.++Another addition is the introduction of the `deepseq` library and implementing+`NFData` for the various mutltiformats modules. Strict evaluation is introduced+in several areas of the project in order to increase performance.++The `MultiFormats.MultiCodec` has been regenerated against multicodec commit+[833c740](https://github.com/multiformats/multicodec/commit/833c740d685f2114cd2d05406823168e3eb28502).++The `Show` instances for `MultiCodec`, `MultiHash` and `CID` were revamped to+be easier to read and copy from a terminal window.+ Major release 1.1 -----------------++## Version 1.1.0.0 (05-19-2026)  ### Cabal - Upgrade major versions for `text` and `containers` versions.

@@ -1,8 +1,8 @@ mfmts [![hackage.haskell.org]( https://img.shields.io/badge/hackage%2Ehaskell%2Eorg-5C5181?logo=haskell)]( https://hackage.haskell.org/package/mfmts)[![builds.sr.ht status](-https://builds.sr.ht/~z0/mfmts/commits/main/mfmts-testing.yml.svg)](-https://builds.sr.ht/~z0/mfmts/commits/main/mfmts-testing.yml?)+https://builds.sr.ht/~z0/mfmts/commits/main/ipfshs-ci.yml.svg)](+https://builds.sr.ht/~z0/mfmts/commits/main/ipfshs-ci.yml?) ---------------------------------------------------------------  This project implements the specifications described by Protocol Lab's@@ -22,12 +22,7 @@ λ> import MultiFormats.CID.Parser qualified as CID λ> import MultiFormats.CID.Errors qualified as CID λ> CID.parser "zb2rhe5P4gXftAwvA4eXQ5HJwsER2owDyS9sKaQRRVQPn93bA" :: CID.Okay CID-Right CIDv1 {-    DataCodec=MultiCodec(0x55, "raw"),-    HashCodec=MultiHash(0x12, "sha2-256"),-    HashDigest=[base58btc]("8S6sXBSX8wVLcT88GnuZpbvmaxetTmPri26tufEByBKS"),-    HashSize=32-}+Right CIDv1(DataCodec=MultiCodec(raw=0x55), HashCodec=MultiHash(sha2-256=0x12), HashDigest[32]=0x6e6ff7950a36187a801613426e858dce686cd7d7e3c0fc42ee0330072d245c95) ```  - CID specification - [https://github.com/multiformats/cid](@@ -41,7 +36,7 @@ `multibase` - Multibase prefix data transcoding ----------------------------------------------- -Implements encoders and decoders for numeric basesytems identitified by a+Implements encoders and decoders for numeric basesystems identified by a specified prefix symbol. It implements transcoders from the [basesystems]( https://git.sr.ht/~z0/basesystems) library, allowing for different types of bytestring data to be specified as type parameters.@@ -51,18 +46,20 @@ λ> {-# LANGUAGE OverloadedStrings #-} λ> import MultiFormats.MultiBase.DigitTranscoder (decodeFromPrefix) λ> import Data.ByteString.Short (ShortByteString)-λ> type Str = ShortByteString-λ> -- uppercase hexadecimal-λ> decodeFromPrefix "F4D756C74696261736520697320617765736F6D6521205C6F2F" :: Maybe Str+λ> import Data.ByteString.Lazy (LazyByteString)+λ> type Sbs = ShortByteString+λ> type Lbs = LazyByteString+λ> -- uppercase hexadecimal (F)+λ> decodeFromPrefix "F4D756C74696261736520697320617765736F6D6521205C6F2F" :: Maybe Sbs Just "Multibase is awesome! \\o/"-λ> -- base32 no padding-λ> decodeFromPrefix "BJV2WY5DJMJQXGZJANFZSAYLXMVZW63LFEEQFY3ZP" :: Maybe Str+λ> -- base32 no padding (B)+λ> decodeFromPrefix "BJV2WY5DJMJQXGZJANFZSAYLXMVZW63LFEEQFY3ZP" :: Maybe Lbs Just "Multibase is awesome! \\o/"-λ> -- bitcoin base58-λ> decodeFromPrefix "zYAjKoNbau5KiqmHPmSxYCvn66dA1vLmwbt" :: Maybe Str+λ> -- bitcoin base58 (z)+λ> decodeFromPrefix "zYAjKoNbau5KiqmHPmSxYCvn66dA1vLmwbt" :: Maybe Sbs Just "Multibase is awesome! \\o/"-λ> -- base64 with padding-λ> decodeFromPrefix "MTXVsdGliYXNlIGlzIGF3ZXNvbWUhIFxvLw==" :: Maybe Str+λ> -- base64 with padding (M)+λ> decodeFromPrefix "MTXVsdGliYXNlIGlzIGF3ZXNvbWUhIFxvLw==" :: Maybe Lbs Just "Multibase is awesome! \\o/" ``` @@ -120,8 +117,7 @@ Just MultiHash(0x12, "sha2-256") λ> -- Building a function call that hashes the string "Hello World!" using the λ> -- sha2-256 algorithm, then outputs the digest as hexadecimal:-λ> import Data.BaseSystem.Lazy (encoder)-λ> import Data.BaseSystem.DigitSystem (base16lower)+λ> import Data.BaseSystem.Lazy (encoder, base16lower) λ> import Data.ByteString.Builder qualified as Builder λ> import Data.Maybe (fromJust) λ> let sha256 = MH.multiHashFunction $ fromJust (MH.resolveHashName "sha2-256")@@ -142,7 +138,7 @@ Provides parsing and serialization for multiformats unsigned binary varints, with the special caveat from multiformats that requires them always to be minimally encoded, so this project also verifies that the varint inputs comply-with the rules of the multiformats specifiation.+with the rules of the multiformats specification.  Varint GitHub README example in GHCI using `packValue` from the [basesystems]( https://git.sr.ht/~z0/basesystems) library to transfer constants into

@@ -13,30 +13,35 @@     cidDataCodec,     cidHashCodec,     cidHashBuilder,+    cidHashSize,+    cidSizeOf,   ) where -import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder)-import Data.BaseSystem.BinaryTranscoder qualified as BXC-import Data.BaseSystem.DigitSystem (base58btc)-import Data.BaseSystem.Lazy (encoder)+import Control.DeepSeq (NFData (..), force, ($!!))+import Data.BaseSystems.Lazy (base16lower, encoder)+import Data.Bifunctor (first)+import Data.Bits ((.>>.)) import Data.ByteString.Builder (Builder) import Data.ByteString.Builder qualified as Builder import Data.ByteString.Short (ShortByteString) import Data.List (intercalate) import Data.Maybe (fromJust) import Data.Text qualified as Text+import Data.XCodec.BinaryTranscoder (BinaryTranscoder)+import Data.XCodec.BinaryTranscoder qualified as BXC import MultiFormats.CID.Component.Codec qualified as CID import MultiFormats.CID.Component.Decoder qualified as CID import MultiFormats.CID.Component.Hash qualified as CID import MultiFormats.CID.Component.Version (Version (CIDv0, CIDv1)) import MultiFormats.CID.Component.Version qualified as CID+import MultiFormats.CID.Constants qualified as CID import MultiFormats.CID.Errors import MultiFormats.CID.Extractor import MultiFormats.CID.Parser import MultiFormats.CID.Serializer-import MultiFormats.MultiCodec (MultiCodec, resolveCodecValue)-import MultiFormats.MultiHash (MultiHash, resolveHashName)+import MultiFormats.MultiCodec (MultiCodec (..), resolveMultiCodec)+import MultiFormats.MultiHash (MultiHash (..), resolveMultiHash) import MultiFormats.VarInt (VarInt)  -- | Defines the data-type for CID data.@@ -45,7 +50,7 @@     cidVersion :: CID.Version,     -- | Describes the content type of the hashed data.     cidDataCodec :: MultiCodec,-    -- | Contains the hash functoin used.+    -- | Contains the hash function used.     cidHashCodec :: MultiHash,     -- | Stores the # of bytes used to store the HashDigest     cidHashSize :: VarInt,@@ -53,6 +58,27 @@     cidHashBuilder :: Builder   } +-- | Returns the size of a CID in bytes.+{-# INLINE cidSizeOf #-}+cidSizeOf :: CID -> VarInt+cidSizeOf (CID CIDv0 _ _ _ _) = fromIntegral CID.v0TotalBytes+cidSizeOf (CID CIDv1 datacodec hashcodec hashsize _) =+  let datavar = multiCodecValue datacodec+      hashvar = multiCodecValue $ multiHashCodec hashcodec+   in hashsize+        + varSizeOf 0 CID.v1FirstVarInt+        + varSizeOf 0 datavar+        + varSizeOf 0 hashsize+        + varSizeOf 0 hashvar+  where+    -- Gets the #bytes for a VarInt, including the extra byte for 8-byte values.+    varSizeOf !total !var+      -- Shift the varint by 1 varint group (7 bits) until it reaches zero+      | var /= 0 = varSizeOf (total + 1) (var .>>. 7)+      -- Adjust the total for when the byte value is zero.+      | otherwise = max 1 total++-- | Checks equality of the CID values, version, and hash digest. instance Eq CID where   (CID v1 c1 h1 s1 d1) == (CID v2 c2 h2 s2 d2) =     -- Check that none of the comparable values mismatch@@ -60,30 +86,30 @@       -- And then check equality on the executed builder       && Builder.toLazyByteString d1 == Builder.toLazyByteString d2 +-- | Implements Show for CID. instance Show CID where   show (CID version datacodec hashcodec hashsize hashbuilder) =     let hashdigest = Builder.toLazyByteString hashbuilder-        basestring = show showbase-        hashstring = Text.unpack (encoder showbase hashdigest)+        hashstring = "0x" ++ Text.unpack (encoder showbase hashdigest)      in show version-          ++ (" {\n" ++ showtab)+          ++ "("           ++ intercalate-            (",\n" ++ showtab)+            ", "             [ "DataCodec=" ++ show datacodec,               "HashCodec=" ++ show hashcodec,-              "HashDigest=[" ++ basestring ++ "](" ++ quote hashstring ++ ")",-              "HashSize=" ++ show hashsize+              "HashDigest[" ++ show hashsize ++ "]=" ++ hashstring             ]-          ++ "\n}"+          ++ ")"     where       -- Sets the base implementation to show the hash digest with.-      showbase = base58btc-      -- Sets the # of spaces to show for tab-      showtab = replicate 4 ' '-      -- Puts a String in double quotes.-      quote str = "\"" ++ str ++ "\""+      showbase = base16lower --- | Parses a CIDv1 from a MultiBase encoded string OR a CIDv0 from a base58btc+-- | Evaluates CID struct into normal form without executing the hash builder.+instance NFData CID where+  rnf (CID version datacodec hashcodec hashsize _) =+    rnf version `seq` rnf datacodec `seq` rnf hashcodec `seq` rnf hashsize++-- | Parses a CIDv1 from a MultiBase encoded string OR a CIDv0 from a base16lower -- encoded string. Fails when there is extra bytes past the CID. instance Parser CID where   parser cidstr = do@@ -92,18 +118,19 @@     CID.Decoder cidbytes <- parser cidstr :: Okay (CID.Decoder ShortByteString)     -- Extracts the CID's data from bytes.     (cid, trailing) <- extractor cidbytes-    -- Fail if there is any leftovers.-    if BXC.lengthBytes trailing > 0+    -- Fail if there is any leftovers. Otherwise fully evaluate the CID.+    if BXC.totalOctets trailing > 0       then Left (InvalidData TrailingBytes)-      else Right cid+      else Right $!! cid  -- | Extracts a CID from a ByteString. Allows trailing bytes. instance (BinaryTranscoder t) => Extractor CID t where   extractor bytes = do     -- First, extract the version from bytes     (version, rest) <- extractor bytes-    -- Apply the constructor if the CID was successfully extracted from bytes-    case version of+    -- Apply the constructor if the CID was successfully extracted from bytes,+    -- and then strictly evaluate the CID into memory.+    first force <$> case version of       CIDv0 -> extractCIDv0 rest       CIDv1 -> extractCIDv1 rest @@ -111,12 +138,12 @@ extractCIDv0 :: (BinaryTranscoder t) => Extraction CID t extractCIDv0 ondata   -- Fail if there isn't enough bytes-  | totalbytes < CID.v0HashBytes = Left (InvalidHash IncorrectLength)+  | totalbytes /= CID.v0HashBytes = Left (InvalidHash IncorrectLength)   -- Create the CIDv0 from data   | otherwise = Right (mkCIDv0 ciddata, rest)   where-    totalbytes = BXC.lengthBytes ondata-    (ciddata, rest) = BXC.splitAtByte CID.v0HashBytes ondata+    totalbytes = BXC.totalOctets ondata+    (ciddata, rest) = BXC.splitOffset CID.v0HashBytes ondata  -- | Applies the extraction after version# for CIDv1 was extracted. extractCIDv1 :: (BinaryTranscoder t) => Extraction CID t@@ -169,10 +196,10 @@     { cidVersion = CIDv0,       cidDataCodec = codec "dag-pb",       cidHashCodec = hash "sha2-256",-      cidHashSize = varlength digest,-      cidHashBuilder = BXC.serializeValue digest+      cidHashSize = varlen digest,+      cidHashBuilder = BXC.unpackSerial digest     }   where-    codec str = fromJust $ resolveCodecValue str-    hash str = fromJust $ resolveHashName str-    varlength = fromIntegral . BXC.lengthBytes+    codec str = fromJust $!! resolveMultiCodec str+    hash str = fromJust $!! resolveMultiHash str+    varlen bxc = fromIntegral $! BXC.totalOctets bxc

@@ -6,14 +6,19 @@ --   Stability   : experimental module MultiFormats.CID.Component.Codec (Codec (Codec)) where -import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder)+import Control.DeepSeq (NFData (..), force) import Data.Bifunctor (first)+import Data.XCodec.BinaryTranscoder (BinaryTranscoder) import MultiFormats.CID.Extractor (Extractor (extractor)) import MultiFormats.MultiCodec (MultiCodec (MultiCodec))  -- | Represents a MultiCodec value embedded within CID data. newtype Codec = Codec MultiCodec deriving (Eq) +-- | Evaluates Codec into normal form.+instance NFData Codec where+  rnf (Codec mc) = rnf mc+ -- | Extracts the MultiCodec from VarInt in bytes and wraps in Codec. instance (BinaryTranscoder t) => Extractor Codec t where-  extractor bytes = first (Codec . MultiCodec) <$> extractor bytes+  extractor bytes = first (force . Codec . MultiCodec) <$> extractor bytes

@@ -6,8 +6,8 @@ --   Stability   : experimental module MultiFormats.CID.Component.Decoder (Decoder (Decoder)) where -import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder) import Data.Text qualified as Text+import Data.XCodec.BinaryTranscoder (BinaryTranscoder) import MultiFormats.CID.Component.Version (isTextCIDv0) import MultiFormats.CID.Errors import MultiFormats.CID.Parser

@@ -6,14 +6,16 @@ --   Stability   : experimental module MultiFormats.CID.Component.Hash (Hash (Hash)) where -import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder)-import Data.BaseSystem.BinaryTranscoder qualified as BXC+import Control.DeepSeq (force, NFData (..)) import Data.ByteString.Builder (Builder)+import Data.XCodec.BinaryTranscoder (BinaryTranscoder)+import Data.XCodec.BinaryTranscoder qualified as BXC import MultiFormats.CID.Component.Codec qualified as CID import MultiFormats.CID.Errors import MultiFormats.CID.Extractor (Extractor (extractor)) import MultiFormats.MultiHash (MultiHash, resolveHashCodec) import MultiFormats.VarInt (VarInt)+import Data.Bifunctor (first)  data Hash = Hash   { -- | Stores the MultiCodec for the hash function used.@@ -24,6 +26,10 @@     cidHashDigest :: Builder   } +-- | Evaluates the Hash into normal form without executing the hash builder.+instance NFData Hash where+  rnf (Hash codec len _) = rnf codec `seq` rnf len+ -- | Extracts the MultiHash codec and hash digest via a varint size following -- the MultiHash codec. instance (BinaryTranscoder t) => Extractor Hash t where@@ -37,13 +43,13 @@     case resolveHashCodec codec of       Nothing -> Left (InvalidHash $ UnknownHashCodec codec)       Just hash-        | isize < BXC.lengthBytes ondigest -> Left (InvalidHash IncorrectLength)-        | otherwise -> Right $ extractHashDigest hash ondigest+        | isize < BXC.totalOctets ondigest -> Left (InvalidHash IncorrectLength)+        | otherwise -> Right $ extractHashDigest hash usize ondigest         where           -- Gets the varint size as generic integral type           isize = fromIntegral usize           -- Extracts the hash data from the bytes-          extractHashDigest multihash rest =-            let (hashdata, final) = BXC.splitAtByte isize rest-                hashbuilder = BXC.serializeValue hashdata-             in (Hash multihash usize hashbuilder, final)+          extractHashDigest !multihash !size rest =+            let (hashdata, final) = BXC.splitOffset isize rest+                hashbuilder = BXC.unpackSerial hashdata+             in first force (Hash multihash size hashbuilder, final)

@@ -14,30 +14,25 @@     -- * Helper functions     isTextCIDv0,     isStringCIDv0,--    -- * Constants-    v0EncodingPrefix,-    v0EncodingLength,-    v0TotalBytes,-    v0HashBytes,-    v0FirstByte,-    v0SecondByte,-    v1FirstVarInt,   ) where -import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder)-import Data.BaseSystem.BinaryTranscoder qualified as BXC+import Control.DeepSeq (NFData (..)) import Data.Text (Text) import Data.Text qualified as Text-import Data.Word (Word8)+import Data.XCodec.BinaryTranscoder (BinaryTranscoder)+import Data.XCodec.BinaryTranscoder qualified as BXC+import MultiFormats.CID.Constants import MultiFormats.CID.Errors import MultiFormats.CID.Extractor (Extraction, Extractor (extractor))-import MultiFormats.VarInt (VarInt)  -- | Implements available CID versions. data Version = CIDv0 | CIDv1 deriving (Show, Eq, Enum) +-- | Evaluates Version into strict normal form.+instance NFData Version where+  rnf _ = ()+ -- | Extracts and validates the CID versioning information from bytes. instance (BinaryTranscoder t) => Extractor Version t where   extractor cidbytes =@@ -64,9 +59,9 @@ -- | Performs extraction for CIDv0. extractVersion0 :: (BinaryTranscoder t) => Extraction Version t extractVersion0 ciddata =-  let (lead, rest) = BXC.splitAtByte 2 ciddata-      total = BXC.lengthBytes ciddata-   in case BXC.unpackBytes lead of+  let (lead, rest) = BXC.splitOffset 2 ciddata+      total = BXC.totalOctets ciddata+   in case BXC.unpackOctets lead of         [b1, b2]           | invalidCIDv0 b1 b2 total -> Left (InvalidEncoding MalformedCIDv0)           | otherwise -> Right (CIDv0, rest)@@ -76,35 +71,6 @@     {-# INLINE invalidCIDv0 #-}     invalidCIDv0 b1 b2 total =       b1 /= v0FirstByte || b2 /= v0SecondByte || total /= v0TotalBytes---- | This prefixes a CIDv0 instead of a multibase prefix.-v0EncodingPrefix :: String-v0EncodingPrefix = "Qm"---- | The length of a CIDv0 string, base58 encoded.-v0EncodingLength :: Int-v0EncodingLength = 46---- | Required length in bytes of all CIDv0 encodings.-v0TotalBytes :: Int-v0TotalBytes = 34---- | Length of hash digest in CIDv0, ie the length without its versioning--- information, since those are the only items in CIDv0.-v0HashBytes :: Int-v0HashBytes = v0TotalBytes - 2---- | Required first byte of all CIDv0 encodings.-v0FirstByte :: Word8-v0FirstByte = 0x12---- | Required second byte of all CIDv0 encodings.-v0SecondByte :: Word8-v0SecondByte = 0x20---- | Required first VarInt of all CIDv1 encodings.-v1FirstVarInt :: VarInt-v1FirstVarInt = 1  -- | /O(1)/ Checks if Text qualifes for CIDv0 decoding. isTextCIDv0 :: Text -> Bool

@@ -0,0 +1,58 @@+-- | Module      : MultiFormats.CID.Constants+--   Description : Defines constants used in CIDs+--   Copyright   : Zoey McBride (c) 2026+--   License     : AGPL-3.0-or-later+--   Maintainer  : zoeymcbride@mailbox.org+--   Stability   : experimental+module MultiFormats.CID.Constants+  ( -- * Versioning magic numbers+    v0EncodingPrefix,+    v0FirstByte,+    v0SecondByte,+    v1FirstVarInt,++    -- * Versioning metadata+    v0EncodingLength,+    v0TotalBytes,+    v0HashBytes,++    -- * CBOR tag number for IPLD's DAG-CBOR specification.+    ipldTagCBOR,+  )+where++import Data.Word (Word8)+import MultiFormats.VarInt (VarInt)++-- | This prefixes a CIDv0 instead of a multibase prefix.+v0EncodingPrefix :: String+v0EncodingPrefix = "Qm"++-- | The length of a CIDv0 string, base58 encoded.+v0EncodingLength :: Int+v0EncodingLength = 46++-- | Required length in bytes of all CIDv0 encodings.+v0TotalBytes :: Int+v0TotalBytes = 34++-- | Length of hash digest in CIDv0, ie the length without its versioning+-- information, since those are the only items in CIDv0.+v0HashBytes :: Int+v0HashBytes = v0TotalBytes - 2++-- | Required first byte of all CIDv0 encodings.+v0FirstByte :: Word8+v0FirstByte = 0x12++-- | Required second byte of all CIDv0 encodings.+v0SecondByte :: Word8+v0SecondByte = 0x20++-- | Required first VarInt of all CIDv1 encodings.+v1FirstVarInt :: VarInt+v1FirstVarInt = 1++-- | Used for CBOR tagged major-types to identify CID encoded bytestrings.+ipldTagCBOR :: Word8+ipldTagCBOR = 42

@@ -13,6 +13,7 @@   ) where +import Control.DeepSeq (NFData (..)) import MultiFormats.MultiCodec (MultiCodec (..)) import MultiFormats.VarInt.Errors qualified as VarInt @@ -27,6 +28,13 @@   | InvalidHash HashError   deriving (Eq, Show) +-- | Evaluates Error into normal form.+instance NFData Error where+  rnf (InvalidData dataerr) = rnf dataerr+  rnf (InvalidEncoding encerr) = rnf encerr+  rnf (InvalidVarInt varerr) = rnf varerr+  rnf (InvalidHash hasherr) = rnf hasherr+ -- | Errors with the CID itself, general/user caused errors. data DataError   = -- | When the total input is empty.@@ -37,6 +45,10 @@     TrailingBytes   deriving (Eq, Show) +-- | Evaluates DataError into normal form.+instance NFData DataError where+  rnf _ = ()+ -- | Errors arrising from the decoding process. data EncodingError   = -- | When the leading byte indicates CIDv0 but is malformed.@@ -49,6 +61,10 @@     ImproperDigit   deriving (Eq, Show) +-- | Evaluates EncodingError into normal form.+instance NFData EncodingError where+  rnf _ = ()+ -- | Errors with the CID's MultiHash. data HashError   = -- | If the given hash codec isn't known as a hash function (isn't@@ -57,3 +73,8 @@   | -- | If the encoded hash length doesn't match the digest size.     IncorrectLength   deriving (Eq, Show)++-- | Evaluates HashError into normal form.+instance NFData HashError where+  rnf (UnknownHashCodec mc) = rnf mc+  rnf _ = ()

@@ -14,8 +14,9 @@   ) where -import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder)-import Data.Bifunctor (Bifunctor (first))+import Data.Bifunctor (first)+import Control.DeepSeq (force)+import Data.XCodec.BinaryTranscoder (BinaryTranscoder) import MultiFormats.CID.Errors import MultiFormats.VarInt (VarInt, extractVarInt) @@ -28,4 +29,6 @@  -- | Extractor for VarInts in CID data. Converts VarInt.Error to CID.Error. instance (BinaryTranscoder t) => Extractor VarInt t where-  extractor = first InvalidVarInt . extractVarInt+  extractor =+    -- Either reconstruct the either or strictly evaulate into the context.+    either (Left . InvalidVarInt) (Right . first force) . extractVarInt

@@ -1,5 +1,5 @@ cabal-version: 3.0-version:       1.1.0.0+version:       1.2.0.0 name:          mfmts build-type:    Simple author:        Zoey McBride@@ -38,11 +38,13 @@ common DefaultVersions {     build-depends:         base >= 4.18 && < 5,-        basesystems ^>= 1.1,+        basesystems ^>= 1.2,+        xcodec ^>= 1.1,         text >= 2.1 && < 2.2,         array ^>= 0.5,         bytestring ^>= 0.12,         containers >= 0.7 && < 0.8,+        deepseq ^>= 1.4,         crypton ^>= 1.1,         ram >= 0.20.1 && < 0.23 }@@ -76,7 +78,7 @@         MultiFormats.MultiBase.Lazy,         MultiFormats.MultiBase.Strict,         -- * Data.BaseSystem.DigitSystems with prefix identifiers for MultiBase-        MultiFormats.MultiBase.DigitSystem,+        MultiFormats.MultiBase.DigitSystems,         -- * Instance of Data.BaseSystem.DigitTranscoder for MultiBase         MultiFormats.MultiBase.DigitTranscoder,         -- * Associates various hash functions with their Mutlicodec identifier@@ -84,6 +86,7 @@         -- * CID definitions         MultiFormats.CID,         MultiFormats.CID.Errors,+        MultiFormats.CID.Constants,         -- * CID interfaces         MultiFormats.CID.Serializer,         MultiFormats.CID.Extractor,

@@ -12,7 +12,7 @@   ) where -import Data.BaseSystem.DigitTranscoder qualified as DXC+import Data.BaseSystems.DigitTranscoder qualified as DXC import Data.ByteString.Short (ShortByteString) import Data.Text (Text) import MultiFormats.MultiBase.DigitTranscoder (MultiBase)

@@ -1,102 +0,0 @@--- | Module      : MultiFormats.MultiBase.DigitSystem---   Description : Parameters to set multibase encoder/decoder basesystem---   Copyright   : Zoey McBride (c) 2026---   License     : AGPL-3.0-or-later---   Maintainer  : zoeymcbride@mailbox.org---   Stability   : experimental-module MultiFormats.MultiBase.DigitSystem-  ( multibase2,-    multibase10,-    multibase16lower,-    multibase16upper,-    multibase32lower,-    multibase32lowerNP,-    multibase32upper,-    multibase32upperNP,-    multibase32hexlower,-    multibase32hexlowerNP,-    multibase32hexupper,-    multibase32hexupperNP,-    multibase58btc,-    multibase64,-    multibase64NP,-    multibase64url,-    multibase64urlNP,-  )-where--import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder)-import Data.Maybe (fromJust)-import MultiFormats.MultiBase.DigitTranscoder (MultiBase, resolvePrefix)---- | Creates the multibase from Char, and crashes if Char is an invalid prefix.-mk :: (BinaryTranscoder bxc) => Char -> MultiBase bxc-mk = fromJust . resolvePrefix---- | Binary has prefix "0".-multibase2 :: (BinaryTranscoder bxc) => MultiBase bxc-multibase2 = mk '0'---- | Decimal has prefix "9".-multibase10 :: (BinaryTranscoder bxc) => MultiBase bxc-multibase10 = mk '9'---- | Hex-lower has prefix "f".-multibase16lower :: (BinaryTranscoder bxc) => MultiBase bxc-multibase16lower = mk 'f'---- | Hex-upper has prefix "F".-multibase16upper :: (BinaryTranscoder bxc) => MultiBase bxc-multibase16upper = mk 'F'---- | base32lower (no pad) has prefix "b".-multibase32lowerNP :: (BinaryTranscoder bxc) => MultiBase bxc-multibase32lowerNP = mk 'b'---- | base32uppper (no pad) has prefix "B".-multibase32upperNP :: (BinaryTranscoder bxc) => MultiBase bxc-multibase32upperNP = mk 'B'---- | base32lower (with pad) has prefix "c".-multibase32lower :: (BinaryTranscoder bxc) => MultiBase bxc-multibase32lower = mk 'c'---- | base32upper (with pad) has prefix "C".-multibase32upper :: (BinaryTranscoder bxc) => MultiBase bxc-multibase32upper = mk 'C'---- | Hex-base32lower (no pad) has prefix "v".-multibase32hexlowerNP :: (BinaryTranscoder bxc) => MultiBase bxc-multibase32hexlowerNP = mk 'v'---- | Hex-base32upper (no pad) has prefix "V".-multibase32hexupperNP :: (BinaryTranscoder bxc) => MultiBase bxc-multibase32hexupperNP = mk 'V'---- | Hex-base32lower (with pad) has prefix "t".-multibase32hexlower :: (BinaryTranscoder bxc) => MultiBase bxc-multibase32hexlower = mk 't'---- | Hex-base32upper (with pad) has prefix "T".-multibase32hexupper :: (BinaryTranscoder bxc) => MultiBase bxc-multibase32hexupper = mk 'T'---- | Bitcoin base58 has prefix "z".-multibase58btc :: (BinaryTranscoder bxc) => MultiBase bxc-multibase58btc = mk 'z'---- | base64 (no pad) has prefix "m".-multibase64NP :: (BinaryTranscoder bxc) => MultiBase bxc-multibase64NP = mk 'm'---- | base64 (with pad) has prefix "M".-multibase64 :: (BinaryTranscoder bxc) => MultiBase bxc-multibase64 = mk 'M'---- | base64url (no pad) has prefix "u".-multibase64urlNP :: (BinaryTranscoder bxc) => MultiBase bxc-multibase64urlNP = mk 'u'---- | base64url (with pad) has prefix "U".-multibase64url :: (BinaryTranscoder bxc) => MultiBase bxc-multibase64url = mk 'U'

@@ -0,0 +1,102 @@+-- | Module      : MultiFormats.MultiBase.DigitSystems+--   Description : Parameters to set multibase encoder/decoder basesystem+--   Copyright   : Zoey McBride (c) 2026+--   License     : AGPL-3.0-or-later+--   Maintainer  : zoeymcbride@mailbox.org+--   Stability   : experimental+module MultiFormats.MultiBase.DigitSystems+  ( multibase2,+    multibase10,+    multibase16lower,+    multibase16upper,+    multibase32lower,+    multibase32lowerNP,+    multibase32upper,+    multibase32upperNP,+    multibase32hexlower,+    multibase32hexlowerNP,+    multibase32hexupper,+    multibase32hexupperNP,+    multibase58btc,+    multibase64,+    multibase64NP,+    multibase64url,+    multibase64urlNP,+  )+where++import Data.Maybe (fromJust)+import Data.XCodec.BinaryTranscoder (BinaryTranscoder)+import MultiFormats.MultiBase.DigitTranscoder (MultiBase, resolvePrefix)++-- | Creates the multibase from Char, and crashes if Char is an invalid prefix.+mk :: (BinaryTranscoder bxc) => Char -> MultiBase bxc+mk = fromJust . resolvePrefix++-- | Binary has prefix "0".+multibase2 :: (BinaryTranscoder bxc) => MultiBase bxc+multibase2 = mk '0'++-- | Decimal has prefix "9".+multibase10 :: (BinaryTranscoder bxc) => MultiBase bxc+multibase10 = mk '9'++-- | Hex-lower has prefix "f".+multibase16lower :: (BinaryTranscoder bxc) => MultiBase bxc+multibase16lower = mk 'f'++-- | Hex-upper has prefix "F".+multibase16upper :: (BinaryTranscoder bxc) => MultiBase bxc+multibase16upper = mk 'F'++-- | base32lower (no pad) has prefix "b".+multibase32lowerNP :: (BinaryTranscoder bxc) => MultiBase bxc+multibase32lowerNP = mk 'b'++-- | base32uppper (no pad) has prefix "B".+multibase32upperNP :: (BinaryTranscoder bxc) => MultiBase bxc+multibase32upperNP = mk 'B'++-- | base32lower (with pad) has prefix "c".+multibase32lower :: (BinaryTranscoder bxc) => MultiBase bxc+multibase32lower = mk 'c'++-- | base32upper (with pad) has prefix "C".+multibase32upper :: (BinaryTranscoder bxc) => MultiBase bxc+multibase32upper = mk 'C'++-- | Hex-base32lower (no pad) has prefix "v".+multibase32hexlowerNP :: (BinaryTranscoder bxc) => MultiBase bxc+multibase32hexlowerNP = mk 'v'++-- | Hex-base32upper (no pad) has prefix "V".+multibase32hexupperNP :: (BinaryTranscoder bxc) => MultiBase bxc+multibase32hexupperNP = mk 'V'++-- | Hex-base32lower (with pad) has prefix "t".+multibase32hexlower :: (BinaryTranscoder bxc) => MultiBase bxc+multibase32hexlower = mk 't'++-- | Hex-base32upper (with pad) has prefix "T".+multibase32hexupper :: (BinaryTranscoder bxc) => MultiBase bxc+multibase32hexupper = mk 'T'++-- | Bitcoin base58 has prefix "z".+multibase58btc :: (BinaryTranscoder bxc) => MultiBase bxc+multibase58btc = mk 'z'++-- | base64 (no pad) has prefix "m".+multibase64NP :: (BinaryTranscoder bxc) => MultiBase bxc+multibase64NP = mk 'm'++-- | base64 (with pad) has prefix "M".+multibase64 :: (BinaryTranscoder bxc) => MultiBase bxc+multibase64 = mk 'M'++-- | base64url (no pad) has prefix "u".+multibase64urlNP :: (BinaryTranscoder bxc) => MultiBase bxc+multibase64urlNP = mk 'u'++-- | base64url (with pad) has prefix "U".+multibase64url :: (BinaryTranscoder bxc) => MultiBase bxc+multibase64url = mk 'U'

@@ -1,5 +1,5 @@ -- | Module      : MultiFormats.MultiBase.DigitTranscoder---   Description : Implements Data.BaseSystem.DigitTranscoder for MultiBase+--   Description : Implements Data.BaseSystems.DigitTranscoder for MultiBase --   Copyright   : Zoey McBride (c) 2026 --   License     : AGPL-3.0-or-later --   Maintainer  : zoeymcbride@mailbox.org@@ -20,10 +20,9 @@   ) where -import Data.BaseSystem.Alphabet qualified as Alpha-import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder)-import Data.BaseSystem.DigitSystem qualified as Digits-import Data.BaseSystem.DigitTranscoder (DigitTranscoder (..))+import Data.BaseSystems.Alphabet qualified as Alpha+import Data.BaseSystems.DigitSystems qualified as Digits+import Data.BaseSystems.DigitTranscoder (DigitTranscoder (..)) import Data.ByteString (ByteString) import Data.Char (ord) import Data.Function (on)@@ -32,9 +31,10 @@ import Data.Maybe (fromMaybe) import Data.Text (Text) import Data.Text qualified as Text+import Data.XCodec.BinaryTranscoder (BinaryTranscoder)  -- | Stores a multibase basesystem's prefix and its implementations for--- digitDecoder/digitEncoder from Data.BaseSystem.DigitTranscoder.+-- digitDecoder/digitEncoder from Data.BaseSystems.DigitTranscoder. data MultiBase bxc = MultiBase   { -- | The name of the basesystem for displaying in show (prepends "multi").     multibaseName :: String,

@@ -12,7 +12,7 @@   ) where -import Data.BaseSystem.DigitTranscoder qualified as DXC+import Data.BaseSystems.DigitTranscoder qualified as DXC import Data.ByteString.Lazy (LazyByteString) import Data.Text (Text) import MultiFormats.MultiBase.DigitTranscoder (MultiBase)

@@ -12,7 +12,7 @@   ) where -import Data.BaseSystem.DigitTranscoder qualified as DXC+import Data.BaseSystems.DigitTranscoder qualified as DXC import Data.ByteString (ByteString) import Data.Text (Text) import MultiFormats.MultiBase.DigitTranscoder (MultiBase)

@@ -6,7 +6,7 @@ --   Stability   : experimental module MultiFormats.MultiCodec   ( MultiCodec (MultiCodec, multiCodecValue),-    resolveCodecValue,+    resolveMultiCodec,     resolveCodecName,     gitCommitHash,     gitCommitDate,@@ -16,32 +16,34 @@ -- !!! WARNING: !!! -- This file is generated! Don't edit it. Instead, use the scripts provided in -- the python folder at the root of the git repository. The current file was--- generated on: 2026-05-18 21:27:03.095413+00:00+-- generated on: 2026-07-09 00:44:21.844503+00:00 -import Data.BaseSystem (encoder)-import Data.BaseSystem.BinaryTranscoder (packValue)-import Data.BaseSystem.DigitSystem (base16lower)+import Control.DeepSeq (NFData (..))+import Data.BaseSystems (base16lower, encoder) import Data.Map (Map) import Data.Map qualified as LazyMap import Data.Maybe (fromMaybe) import Data.Text qualified as Text+import Data.XCodec.BinaryTranscoder (packValueBE) import MultiFormats.VarInt (VarInt)  -- | Represents MultiCodec code. newtype MultiCodec = MultiCodec {multiCodecValue :: VarInt} deriving (Eq, Ord) +-- | Gives the MultiCodec string representation. instance Show MultiCodec where   show codec@(MultiCodec value) =     let name = fromMaybe "<invalid codec>" $ resolveCodecName codec-        hexstring = "0x" ++ Text.unpack (encoder base16lower $ packValue value)-     in "MultiCodec(" ++ hexstring ++ ", " ++ quote name ++ ")"-    where-      -- Puts a String in double quotes.-      quote str = "\"" ++ str ++ "\""+        hex = "0x" ++ Text.unpack (encoder base16lower $ packValueBE value)+     in "MultiCodec(" ++ name ++ "=" ++ hex ++ ")" +-- | Evaluates MultiCodec into strict normal form.+instance NFData MultiCodec where+  rnf (MultiCodec value) = rnf value+ -- | Resolves MultiCodec code from its string name.-resolveCodecValue :: String -> Maybe MultiCodec-resolveCodecValue name = MultiCodec <$> LazyMap.lookup name nameToCodec+resolveMultiCodec :: String -> Maybe MultiCodec+resolveMultiCodec name = MultiCodec <$> LazyMap.lookup name nameToCodec  -- | Resolves MultiCodec name from its numeric code. resolveCodecName :: MultiCodec -> Maybe String@@ -49,11 +51,11 @@  -- | The git hash for table.csv used to generate this file. gitCommitHash :: String-gitCommitHash = "45c88b89ab909c0fac7c86dafe43ad72d1e8e8a9"+gitCommitHash = "833c740d685f2114cd2d05406823168e3eb28502"  -- | This is the date the table.csv was commited. gitCommitDate :: String-gitCommitDate = "2026-04-17 09:53:49 +0200"+gitCommitDate = "2026-06-23 02:32:07 -0700"  nameToCodec :: Map String VarInt nameToCodec =@@ -280,6 +282,18 @@       ("mldsa-44-priv-seed", 0x131a),       ("mldsa-65-priv-seed", 0x131b),       ("mldsa-87-priv-seed", 0x131c),+      ("slhdsa-sha2-128s-priv", 0x131d),+      ("slhdsa-shake-128s-priv", 0x131e),+      ("slhdsa-sha2-128f-priv", 0x131f),+      ("slhdsa-shake-128f-priv", 0x1320),+      ("slhdsa-sha2-192s-priv", 0x1321),+      ("slhdsa-shake-192s-priv", 0x1322),+      ("slhdsa-sha2-192f-priv", 0x1323),+      ("slhdsa-shake-192f-priv", 0x1324),+      ("slhdsa-sha2-256s-priv", 0x1325),+      ("slhdsa-shake-256s-priv", 0x1326),+      ("slhdsa-sha2-256f-priv", 0x1327),+      ("slhdsa-shake-256f-priv", 0x1328),       ("bip340-pub", 0x1340),       ("bip340-priv", 0x1341),       ("lamport-sha3-512-pub", 0x1a14),@@ -918,6 +932,18 @@       (0x131a, "mldsa-44-priv-seed"),       (0x131b, "mldsa-65-priv-seed"),       (0x131c, "mldsa-87-priv-seed"),+      (0x131d, "slhdsa-sha2-128s-priv"),+      (0x131e, "slhdsa-shake-128s-priv"),+      (0x131f, "slhdsa-sha2-128f-priv"),+      (0x1320, "slhdsa-shake-128f-priv"),+      (0x1321, "slhdsa-sha2-192s-priv"),+      (0x1322, "slhdsa-shake-192s-priv"),+      (0x1323, "slhdsa-sha2-192f-priv"),+      (0x1324, "slhdsa-shake-192f-priv"),+      (0x1325, "slhdsa-sha2-256s-priv"),+      (0x1326, "slhdsa-shake-256s-priv"),+      (0x1327, "slhdsa-sha2-256f-priv"),+      (0x1328, "slhdsa-shake-256f-priv"),       (0x1340, "bip340-pub"),       (0x1341, "bip340-priv"),       (0x1a14, "lamport-sha3-512-pub"),

@@ -10,18 +10,17 @@ -- https://github.com/multiformats/multihash module MultiFormats.MultiHash   ( MultiHash (MultiHash, multiHashCodec, multiHashFunction),+    resolveMultiHash,     resolveHashCodec,-    resolveHashName,   ) where -import Control.Monad (join)+import Control.DeepSeq (NFData (..))+import Control.Monad (join, (<$!>)) import Crypto.Hash (HashAlgorithm) import Crypto.Hash qualified as Hash import Crypto.Hash.Algorithms qualified as Algo-import Data.BaseSystem (encoder)-import Data.BaseSystem.BinaryTranscoder (packValue)-import Data.BaseSystem.DigitSystem (base16lower)+import Data.BaseSystems (base16lower, encoder) import Data.ByteArray qualified as Memory import Data.ByteString.Builder (Builder) import Data.ByteString.Builder qualified as Builder@@ -33,6 +32,7 @@ import Data.Map qualified as LazyMap import Data.Maybe (fromMaybe, mapMaybe) import Data.Text qualified as Text+import Data.XCodec.BinaryTranscoder (packValueBE) import Foreign.ForeignPtr (newForeignPtr) import Foreign.Marshal.Alloc (finalizerFree) import Foreign.Marshal.Array (copyArray, mallocArray)@@ -51,14 +51,15 @@     multiHashFunction :: ~HashFunction   } +-- | Evaluates MultiHash into strict normal form.+instance NFData MultiHash where+  rnf (MultiHash codec hashfunc) = rnf codec `seq` rnf hashfunc+ instance Show MultiHash where   show (MultiHash codec@(MultiCodec value) _) =     let name = fromMaybe "<invalid codec>" $ MC.resolveCodecName codec-        hexstring = "0x" ++ Text.unpack (encoder base16lower $ packValue value)-     in "MultiHash(" ++ hexstring ++ ", " ++ quote name ++ ")"-    where-      -- Puts a String in double quotes.-      quote str = "\"" ++ str ++ "\""+        hex = "0x" ++ Text.unpack (encoder base16lower $ packValueBE value)+     in "MultiHash(" ++ name ++ "=" ++ hex ++ ")"  instance Eq MultiHash where   (==) = (==) `on` multiHashCodec@@ -69,11 +70,12 @@ -- | Resolves a MultiHash from a MultiCodec. resolveHashCodec :: MultiCodec -> Maybe MultiHash resolveHashCodec codec =-  MultiHash codec <$> join (LazyMap.lookup codec hashFunctionTable)+  -- Strictly contructs the MultiHash with the codec and the hash lookup+  (MultiHash $! codec) <$!> join (LazyMap.lookup codec hashFunctionTable)  -- | Resolves a MultiHash from MultiCodec name.-resolveHashName :: String -> Maybe MultiHash-resolveHashName name = resolveHashCodec =<< MC.resolveCodecValue name+resolveMultiHash :: String -> Maybe MultiHash+resolveMultiHash name = resolveHashCodec =<< MC.resolveMultiCodec name  -- | Runs the hash function and copies the result into a new buffer. hashBytesCopy :: (HashAlgorithm a) => a -> HashFunction@@ -81,7 +83,7 @@   -- This was done as a pure function with pack/unpack, but we're going to use   -- IO to improve the performance of the copy, which needs to happen to   -- instantiate a new bytestring type from Crypto.Hash function results.-  unsafePerformIO $+  unsafePerformIO $!     -- In order to work with the data produced by the hash via Memory, we have     -- pass an IO transformation on the pointer to the data. The data at the     -- pointer gets GC'd after this, so we can't copy by referenece and have to@@ -139,6 +141,6 @@       return $ hash . Builder.lazyByteString . hash     -- Returns a map entry if the multicodec exists     pairEntries (name, hfunc) =-      case MC.resolveCodecValue name of+      case MC.resolveMultiCodec name of         Just multicodec -> Just (multicodec, hfunc)         Nothing -> Nothing

@@ -15,13 +15,14 @@   ) where -import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder)-import Data.BaseSystem.BinaryTranscoder qualified as BXC+import Control.Monad ((>=>)) import Data.Bits ((.&.), (.<<.), (.>>.), (.|.)) import Data.ByteString.Builder (Builder) import Data.ByteString.Builder qualified as Builder import Data.ByteString.Short qualified as SBS import Data.Word (Word16, Word64, Word8)+import Data.XCodec.BinaryTranscoder (BinaryTranscoder)+import Data.XCodec.BinaryTranscoder qualified as BXC import MultiFormats.VarInt.Errors (Error (..), Okay)  -- | VarInt spec uses unsigned 64 bit integers.@@ -55,30 +56,33 @@ -- | Splits ByteString into it's first occurring VarInt and the remaining -- ByteString after. spanVarInt :: (BinaryTranscoder t) => t -> Okay (t, t)-spanVarInt bxc =-  -- Collect the bytes with MSB=1.-  case BXC.spanBytes isMSB1 bxc of-    -- The varint is the leading bytes with the MSB=1 and a final terminating-    -- byte with MSB=0.-    (msb1s, msb0s)-      -- Verify if a final byte exists.-      | BXC.null msb0s -> Left MissingTermination-      -- The loop invariant ensures &msb1s + 1 has MSB=0, so compute this offset-      -- and split the data there.-      | otherwise ->-          let nulloffset = BXC.lengthBytes msb1s + 1-           in Right (BXC.splitAtByte nulloffset bxc)+spanVarInt bxc+  -- Fail if empty bytes.+  | BXC.null bxc = Left EmptyBytes+  -- Otherwise, collect the bytes with MSB=1.+  | otherwise =+      case BXC.spanOctetsTop isMSB1 bxc of+        -- The varint is the leading bytes with the MSB=1 and a final+        -- terminating byte with MSB=0.+        (msb1s, msb0s)+          -- Verify if a final byte exists.+          | BXC.null msb0s -> Left MissingTermination+          -- The loop invariant ensures &msb1s + 1 has MSB=0, so compute this+          -- offset and split the data there.+          | otherwise ->+              let nulloffset = BXC.totalOctets msb1s + 1+               in Right (BXC.splitOffset nulloffset bxc)   where     -- Checks if the most-significant bit (MSB) is set to 1-    isMSB1 byte = (byte .&. msb1) /= 0+    isMSB1 !byte = (byte .&. msb1) /= 0  -- | Concats the lower 7 bits from bytes into single int value. buildVarInt :: (BinaryTranscoder t) => t -> VarInt-buildVarInt = foldr build 0 . BXC.unpackBytes+buildVarInt = foldr build 0 . BXC.unpackOctets   where     -- Shifts the accumulator 7 bits (1 byte minus MSB value) and ORs the     -- current byte into place, and remove the MSB set bit.-    build byte acc = acc .<<. 7 .|. fromIntegral (byte .&. mask7lsbs)+    build !byte !acc = acc .<<. 7 .|. fromIntegral (byte .&. mask7lsbs)  -- | Checks edge case where input is invalid from not being a minimal encoding -- of varints, (ie, we can fit 2 bytes of 7 bits into 1 byte of 7 bits). The@@ -88,7 +92,7 @@ nonMinimal vardata = last16bits == invalidsuffix   where     -- Puts the last two bytes of the transcoder into a Word16.-    last16bits = fromIntegral $ BXC.unpackValue (BXC.takeBytesEnd 2 vardata)+    last16bits = fromIntegral $! BXC.unpackValueBE (BXC.takeOctetsEnd 2 vardata)     -- This value is the same to the value from bytes 0x7F, so it's not minimal     invalidsuffix = (fromIntegral msb1lsb1 :: Word16) .<<. 8 @@ -96,20 +100,18 @@ {-# INLINE aboveCapacity #-} aboveCapacity :: (BinaryTranscoder t) => t -> Bool aboveCapacity vardata =-  let wholelen = BXC.lengthBytes vardata+  let wholelen = BXC.totalOctets vardata    in not (1 <= wholelen && wholelen <= bytesCapacity)  -- | Extracts the first minimally encoded varint from a ByteString. extractVarInt :: (BinaryTranscoder t) => t -> Okay (VarInt, t)-extractVarInt bytes-  | BXC.null bytes = Left EmptyBytes-  | otherwise =-      case spanVarInt bytes of-        Left err -> Left err-        Right (varbytes, rest)-          | aboveCapacity varbytes -> Left BytesOverflow-          | nonMinimal varbytes -> Left NotMinimal-          | otherwise -> Right (buildVarInt varbytes, rest)+extractVarInt = spanVarInt >=> spanBuild+  where+    -- Verifies the result from running spanVarInt+    spanBuild (vardata, rest)+      | aboveCapacity vardata = Left BytesOverflow+      | nonMinimal vardata = Left NotMinimal+      | otherwise = Right (buildVarInt vardata, rest)  -- | Puts a parsed VarInt (Word64 value) into a Builder of ShortByteString with -- MSB bits set, and a max size of 9 bytes.@@ -117,17 +119,14 @@ serializeVarInt varint   | varint > maxVarInt = Left AboveMaxValue   | otherwise =-      Right-        -- Put the ShortByteString into a ByteString Builder.-        . Builder.shortByteString-        -- Set the continuation bits in the bytes.-        . SBS.unfoldr setMSBs-        -- Replace empty bytestrings with a single zero byte.-        . replaceNull0-        -- Drop bytes until a minimal value is found.-        . SBS.dropWhileEnd (== 0)-        -- Pack the bytes from varint 7-bit groups.-        $ SBS.pack [var7sAt bytepos | bytepos <- [1 .. bytesCapacity]]+      let -- Expand the bits into byte-sized 7-bit groups+          grouped = SBS.pack [var7sAt bytepos | bytepos <- [1 .. bytesCapacity]]+          -- Get the minimal #bytes to represent a number+          minimal = replaceNull0 $ SBS.dropWhileEnd (== 0) grouped+          -- Set the MSB continuation bits+          setbits = SBS.unfoldr setMSBs minimal+       in -- Strictly evalate the resulting builder+          Right $! Builder.shortByteString setbits   where     -- Extracts 1-indexed groups of 7 bits from varint starting from the LSB.     {-# INLINEABLE var7sAt #-}

@@ -10,6 +10,8 @@   ) where +import Control.DeepSeq (NFData (..))+ -- | Functor for dealing with VarInt Error results. type Okay a = Either Error a @@ -26,3 +28,7 @@   | -- | If the encoded VarInt is larger than allowed maximum.     AboveMaxValue   deriving (Eq, Show)++-- | Evaluates Error into normal form.+instance NFData Error where+  rnf _ = ()