diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,11 @@ Major release 1.2 ----------------- +## Version 1.2.0.1 (07-21-2026) + +This version upgrades the XCodec module to v2.0 and modified `DigitTranscoder` +for the upgrade. + ## Version 1.2 (07-08-2026) This version removes the functionality that the [xcodec]( diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -6,9 +6,8 @@ --------------------------------------------------------------------------- This project contains code for encoding/decoding numeric basesystems in Haskell. -It's implemented in a strategy pattern style where `BaseSystem` is a type-class -which provides the `encoder` and `decoder` methods on, for instance, -`ShortByteString`, in `Data.BaseSystem`: +It's implemented for the Haskell bytestring types and provides a type-class +interface: ```haskell class BaseSystem a where @@ -18,47 +17,42 @@ The library creates more `BaseSystem` classes with methods on normal `ByteString` in `Data.BaseSystem.Strict` and `LazyByteString` -in `Data.BaseSystem.Lazy`. The basesystems passed as `a` to `encoder` and -`decoder` are defined in `Data.BaseSystem.DigitSystem`. See the [*example*]( -#example). +in `Data.BaseSystem.Lazy`. See the [*example*](#example). Coverage -------- -Eventually, This project aims to implement most if not all of the [mulitbase -specification's basesytems list]( +This project aims to implement the [multibase specification's basesystems list]( https://github.com/multiformats/multibase?tab=readme-ov-file#multibase-table). Currently, the following basesystems are supported: -- base2 -- base10 -- base16(upper/lower) -- base32(upper/lower) w/pad + nopad -- base32hex(lower/upper) w/pad + nopad -- base58btc -- base64 w/pad + nopad -- base64url w/pad + nopad +- `base2` for binary +- `base10` for decimal +- `base16upper` and `base16lower` for hexadecimal +- `base32upper` and `base32lower` for base32 +- `base32upperNP` and `base32lowerNP` for base32, without padding +- `base32hexupper` and `base32hexlower` for hex-style base32 +- `base32hexupperNP` and `base32hexlowerNP` for hex-style base32, without +padding +- `base58btc` for Bitcoin's base58 +- `base64` and `base64url` for base64 variants +- `base64NP` and `base64urlNP` for base64 variants, without padding Example ------- -For an example of using `basesystems`, we can do the following in GHCI: - -Set `OverloadedStrings` so strings can act as Text data and import the needed -functions. Then import the basesystem functions and `packValue` from -`Data.BaseSystem.BinaryTranscoder` to convert a number value directly into -bytes. +For an example of using basesystems, we can do the following in GHCI: -```haskell -λ> {-# LANGUAGE OverloadedStrings #-} -λ> import Data.BaseSystem (encoder, decoder, base2, base10, base16lower, base32lower) -λ> import Data.BaseSystem.BinaryTranscoder (packValue) -``` +Set `OverloadedStrings` so `Strings` can act as `Text` data and import the +needed functions. Then import the basesystem functions and `packValue` from +`XCodec.Transcoder` to convert a number value directly into bytes. This shows how we can take the binary value of `123` and display it in various -number systems. +number systems: ```haskell +λ> import Data.BaseSystem (encoder, decoder, base2, base10, base16lower, base32lower) +λ> import XCodec.Transcoder (packValue) λ> :t encoder encoder :: BaseSystem a => a -> ShortByteString -> Text λ> :t decoder @@ -72,7 +66,7 @@ ``` We can also use encoders and decoders to translate one numeric representation to -another. +another: ```haskell λ> encoder base10 <$> decoder base2 "1111011" @@ -86,15 +80,27 @@ Development ----------- -Unit tests are provided on the main [ipfshs repo](https://git.sr.ht/~z0/ipfshs), -and bugs can be reported on [ipfshs ticket tracker]( -https://todo.sr.ht/~z0/ipfshs). +This project is part of [ipfshs](https://sr.ht/~z0/ipfshs); unit tests are +provided on the main page and bugs can be reported on its [ticket tracker]( +https://todo.sr.ht/~z0/ipfshs). Patches and pull requests can be submitted with +[`git send-email`](https://git-send-email.io/). To build and test this project +against all of ipfshs read [this](https://sr.ht/~z0/ipfshs/#development) +section on setting up an ipfshs development environment. +This project can also be built as a standalone library with [`cabal`]( +https://github.com/haskell/cabal#ways-to-get-the-cabal-install-binary). + +```shell +$ git clone https://git.sr.ht/~z0/basesystems +$ cd basesystems +$ cabal build +``` + Licensing --------- -The `basesystems` project and its modules are free software and licensed under -the BSD 3-clause license. See [LICENSE.txt](LICENSE.txt). +The basesystems project and its modules are free software and licensed under the +BSD 3-clause license. See [`LICENSE.txt`](LICENSE.txt). Copyright © 2026 Zoey McBride | [zoeymcbride@mailbox.org]( mailto:zoeymcbride@mailbox.org) diff --git a/basesystems.cabal b/basesystems.cabal --- a/basesystems.cabal +++ b/basesystems.cabal @@ -1,5 +1,5 @@ cabal-version: 3.0 -version: 1.2.0.0 +version: 1.2.0.1 name: basesystems build-type: Simple author: Zoey McBride @@ -39,7 +39,7 @@ common Depends { build-depends: base >= 4.18 && < 5, - xcodec ^>= 1.1, + xcodec ^>= 2.0, array ^>= 0.5, bytestring >= 0.12 && < 0.13, containers >= 0.7 && < 8, diff --git a/basesystems/Data/BaseSystems/DigitTranscoder.hs b/basesystems/Data/BaseSystems/DigitTranscoder.hs --- a/basesystems/Data/BaseSystems/DigitTranscoder.hs +++ b/basesystems/Data/BaseSystems/DigitTranscoder.hs @@ -7,8 +7,6 @@ module Data.BaseSystems.DigitTranscoder ( -- * Transcoder interface for encoding/decoding digits from Text. DigitTranscoder (digitEncoder, digitDecoder), - Encoder, - Decoder, -- * Instances of DigitTranscoder RadixDigits (RadixDigits), @@ -27,10 +25,8 @@ import Data.Maybe (fromJust, fromMaybe) import Data.Text (Text) import Data.Text qualified as Text -import Data.XCodec.BinaryTranscoder (BinaryTranscoder, BitSet) -import Data.XCodec.BinaryTranscoder qualified as BXC -import Data.XCodec.StreamTranscoder (StreamTranscoder (..)) -import Data.XCodec.StreamTranscoder qualified as SXC +import XCodec.Transcoder (BitSet, Transcoder) +import XCodec.Transcoder qualified as XC -- | Implements BaseSystem over base radix modulus. data RadixDigits = RadixDigits @@ -70,26 +66,10 @@ instance Show BitwiseDigits where show = bitwiseShow --- | Type-alias for curried DigitTranscoder digitEncoder function. -type Encoder bxc = SXC.Encoder bxc Text - --- | Type-alias for curried DigitTranscoder digitDecoder function. -type Decoder bxc = SXC.Decoder bxc Text - --- TODO: docstrings -class (BinaryTranscoder bxc) => DigitTranscoder codec bxc where - digitEncoder :: codec -> Encoder bxc - digitDecoder :: codec -> Decoder bxc - --- TODO: docstrings -instance (BinaryTranscoder bxc) => DigitTranscoder RadixDigits bxc where - digitEncoder = streamEncoder - digitDecoder = streamDecoder - --- TODO: docstrings -instance (BinaryTranscoder bxc) => DigitTranscoder BitwiseDigits bxc where - digitEncoder = streamEncoder - digitDecoder = streamDecoder +-- Class of functions for encoding and decoding digits. +class (Transcoder tc) => DigitTranscoder codec tc where + digitEncoder :: codec -> tc -> Text + digitDecoder :: codec -> Text -> Maybe tc -- | Functor applies when in context of a BaseSystem decoder implementation that -- requires modifications to the entire bitset before converting to ByteString. @@ -100,14 +80,14 @@ type DeltaFunction = BitSet -> Alpha.Symbol -> Maybe BitSet -- | Using a transition function `delta`, build an BitSet into bytes data --- `bxc`, and use a final BitSet context to align the BitSet's bit contents. +-- `tc`, and use a final BitSet context to align the BitSet's bit contents. {-# INLINE binaryDecoder #-} binaryDecoder :: - (BinaryTranscoder bxc) => + (Transcoder tc) => Text -> FinalizeContext -> DeltaFunction -> - Maybe bxc + Maybe tc binaryDecoder text finalize delta | Text.null text = Nothing | otherwise = do @@ -116,23 +96,23 @@ bitvalue <- foldM delta 0 $ Text.unpack text -- Apply the finalizer to the bits and put it into a transcoder -- TODO: make endianness a parameter of the decoder - return $ BXC.packValueBE (applyFinalize bitvalue) + return $ XC.packValueBE (applyFinalize bitvalue) where -- If finalize exists, apply it, otherwise return the unchanged value. applyFinalize value = fromMaybe value $ finalize <*> Just value -- | Implements transcoding binary streams into radix-based number systems, such -- as base10 or base58btc. -instance (BinaryTranscoder bxc) => StreamTranscoder RadixDigits bxc Text where +instance (Transcoder tc) => DigitTranscoder RadixDigits tc where -- Encodes the value by converting the ByteString to Integer and repeatedly -- applying `divMod` until the quotient is zero. - streamEncoder (RadixDigits _ abc) = + digitEncoder (RadixDigits _ abc) = let radix = fromIntegral $ Alpha.alphaRadix abc in Text.pack . divModSymbols . takeWhile divModContinue . iterateInit (\(num, _) -> num `divMod` radix) mkDivMod - . BXC.unpackValueBE + . XC.unpackValueBE where -- Initial value to iterate on divMod. mkDivMod numerator = (numerator, 0) @@ -148,7 +128,7 @@ -- Decodes the value by multiplying the radix with the current integer state -- and adding the value. That value is decode directly, no finalization -- needed. - streamDecoder (RadixDigits _ abc) text = + digitDecoder (RadixDigits _ abc) text = let radix = fromIntegral $ Alpha.alphaRadix abc in binaryDecoder text Nothing $ \curvalue symbol -> do @@ -156,16 +136,57 @@ return $ curvalue * radix + value +-- | Resolves symbols from Alphabet for a BitwiseSystem's encoder. Partitions +-- a ByteString into N sized bitgroups where N is the bitwidth of the +-- Alphabet's radix. *IMPORTANT*: this function requires the groupsize to be +-- a multiple of two because it generates a mask from subtracting it by 1. +groupSymbols :: + (Transcoder tc) => Alphabet -> tc -> Int -> Int -> [Alpha.Symbol] +groupSymbols abc grouping groupsize symbits = + let groupint = + case XC.unpackValueBE grouping of + bits + | fitsBitGroup groupsize grouping bits -> fromIntegral bits + | otherwise -> error "invalid group size" + in -- Crash if the implementation isn't complete + fromJust + -- Extract the value from the shift and resolve its symbol. + . mapM (Alpha.resolveSymbol abc . valueExtract . nextInt groupint) + -- Take all non-zero shifts. + . takeWhile (>= 0) + -- Generate a list of shift values from the # bits in groupbytes. + $ iterateInit shiftValue mkBitLength grouping + where + -- Gets the next int to extract group. + nextInt groupint shift = groupint .>>. shift + -- Extracts the first group from LSB from an Int. + valueExtract int = fromIntegral $ int .&. (Alpha.alphaRadix abc - 1) + -- Finds the length in bits of a ByteString. + mkBitLength bstr = fromIntegral $ 8 * XC.totalOctets bstr + -- Gives the current shift value in iteration. + shiftValue bitstotal = bitstotal - symbits + +-- Checks if an Integral a fits within a BitwiseSystem's group. +{-# INLINE fitsBitGroup #-} +fitsBitGroup :: (Transcoder tc, Integral i) => Int -> tc -> i -> Bool +fitsBitGroup groupsize bxcdata groupbits = + XC.totalOctets bxcdata <= fromIntegral groupsize + && minInt <= groupbits + && groupbits <= maxInt + where + minInt = fromIntegral (minBound :: Int) + maxInt = fromIntegral (maxBound :: Int) + -- | Implements transcoding binary streams into bitwise based number systems, -- such as base64 and base32 that get digit symbols from grouping bits together. -instance (BinaryTranscoder bxc) => StreamTranscoder BitwiseDigits bxc Text where +instance (Transcoder tc) => DigitTranscoder BitwiseDigits tc where -- Encodes the input bytes by grouping into `groupsize` sized windows, then -- batch resolving the String of Symbols from each group, then resolve the -- correct padding chars from the number of bytes and append that to the -- encoder result. - streamEncoder (BitwiseDigits _ abc symbits groupsize _ padmethod) input = + digitEncoder (BitwiseDigits _ abc symbits groupsize _ padmethod) input = let -- Total # of bytes from input. - bytestotal = BXC.totalOctets input + bytestotal = XC.totalOctets input -- Total # of bits from input. bitstotal = fromIntegral (8 * bytestotal) :: Double -- Actual # of symbols for the # of bits in bytes. @@ -175,8 +196,8 @@ in paddingAppend (fromIntegral bytestotal) . take putsymbols . concatMap groupSyms - . takeWhile (\(group, _) -> BXC.totalOctets group > 0) - . iterateInit (\(_, rest) -> BXC.splitOffset groupsize rest) mkSplit + . takeWhile (\(group, _) -> XC.totalOctets group > 0) + . iterateInit (\(_, rest) -> XC.splitOffset groupsize rest) mkSplit $ minimalBytes bytestotal where -- Inits the iteration for splitOffset. @@ -185,9 +206,9 @@ -- here to maintain compatablity with other encoders. {-# INLINE minimalBytes #-} minimalBytes bytestotal - | bytestotal == 0 = BXC.packOctets [0, 0] - | bytestotal == 1 = BXC.pushOctetEnd input 0 - | bytesmodulus /= 0 = input `mappend` BXC.replicateOctet numzeros 0 + | bytestotal == 0 = XC.packOctets [0, 0] + | bytestotal == 1 = XC.pushOctetEnd input 0 + | bytesmodulus /= 0 = input `mappend` XC.replicateOctet numzeros 0 | otherwise = input where bytesmodulus = fromIntegral (bytestotal `mod` fromIntegral groupsize) @@ -204,7 +225,7 @@ -- shifting the value by the #bits per symbol and ORing the value in place. -- Finally, it needs to be aligned to the top of byte in memory so the value -- is represented correctly. - streamDecoder (BitwiseDigits _ abc symbits _ groupsyms padmethod) text = + digitDecoder (BitwiseDigits _ abc symbits _ groupsyms padmethod) text = let -- Gives just padding char if not nothing. padsym = paddingChar <$> padmethod -- Removes the trailing padding chars from the Text of str. @@ -237,44 +258,3 @@ -- Offset to Integer to align the bits in the final ByteString at the -- start of a byte in memory. pagealign = 8 * ceiling (fromIntegral needbits / 8 :: Double) - --- | Resolves symbols from Alphabet for a BitwiseSystem's encoder. Partitions --- a ByteString into N sized bitgroups where N is the bitwidth of the --- Alphabet's radix. *IMPORTANT*: this function requires the groupsize to be --- a multiple of two because it generates a mask from subtracting it by 1. -groupSymbols :: - (BinaryTranscoder bxc) => Alphabet -> bxc -> Int -> Int -> [Alpha.Symbol] -groupSymbols abc grouping groupsize symbits = - let groupint = - case BXC.unpackValueBE grouping of - bits - | fitsBitGroup groupsize grouping bits -> fromIntegral bits - | otherwise -> error "invalid group size" - in -- Crash if the implementation isn't complete - fromJust - -- Extract the value from the shift and resolve its symbol. - . mapM (Alpha.resolveSymbol abc . valueExtract . nextInt groupint) - -- Take all non-zero shifts. - . takeWhile (>= 0) - -- Generate a list of shift values from the # bits in groupbytes. - $ iterateInit shiftValue mkBitLength grouping - where - -- Gets the next int to extract group. - nextInt groupint shift = groupint .>>. shift - -- Extracts the first group from LSB from an Int. - valueExtract int = fromIntegral $ int .&. (Alpha.alphaRadix abc - 1) - -- Finds the length in bits of a ByteString. - mkBitLength bstr = fromIntegral $ 8 * BXC.totalOctets bstr - -- Gives the current shift value in iteration. - shiftValue bitstotal = bitstotal - symbits - --- Checks if an Integral a fits within a BitwiseSystem's group. -{-# INLINE fitsBitGroup #-} -fitsBitGroup :: (BinaryTranscoder bxc, Integral i) => Int -> bxc -> i -> Bool -fitsBitGroup groupsize bxcdata groupbits = - BXC.totalOctets bxcdata <= fromIntegral groupsize - && minInt <= groupbits - && groupbits <= maxInt - where - minInt = fromIntegral (minBound :: Int) - maxInt = fromIntegral (maxBound :: Int)