diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,97 @@ +[`basesystems`](http://hackage-content.haskell.org/package/basesystems) +change log: +=========== + +Major release 1.1 +----------------- + +## Version 1.1.0.0 (05-17-2026) + +### Cabal +- Upgrade major versions for `text` and `containers` versions. +- Add `tested-with` line for GHC 9.6.7. +- Remove the `Dev` flag. + +### Builds / CI +- Use `ghcup` to install the correct Haskell tooling instead of outdated +`cabal-install` package in all CI scripts. +- Combine documentation generation and packaging into a single script that +uploads everything to a candidate hackage page. +- Add script for running the `ipfshs` unit testing package for basesystems. + +### `Data.BaseSystem` module changes +- Both `encoder` and `decoder` now use `ShortByteString` as input/output instead +of `ByteString`. Also `encoder` and `decoder` now use `Text` as input/output +data instead of `String`. + +### `Data.BaseSystem.Alphabet` module changes +- This module now exports the defined `Alphabet` structs. +- Alpha.Symbol is now a plain `Char`. +- Alpha.Value is now `Word32`. + +### New modules +- `Data.BaseSystem.Strict` is where the basesystem encoders and decoders +used for strict `ByteString` typed data got moved to. +- `Data.BaseSystem.Lazy` provides basesystem encoders and decoders for +`LazyByteString` data. +- `Data.BaseSystem.DigitSystem` now provides the instances for used for +`BaseSystem`. +- `Data.BaseSystem.BinaryTranscoder` provides a unified type-class interface for +working with bytestring data and converting to and from bit data for numeric +values. This module is likely to become its own package in the future. +- `Data.BaseSystem.DigitTranscoder` provides generic encoders and decoders for +`BinaryTranscoder` derivied types. + +### Deleted modules +- `Data.BaseSystems` got replaced by `Data.BaseSystem.DigitSystem`. +- `Data.BaseSystem.Alphabets` got merged with `Data.BaseSystem.Alphabet`. + +Major release 1.0 +----------------- + +## Version 1.0.0.1 (04-01-2026) + +This version aims to fix the issues with the hackage page and provide CI via +sourcehut builds. + +- Set correct PVP bounds for cabal dependencies. +- Added CI/CD for builds.sr.ht: + * Add `.builds/nudge-parents.yml` to automatically update this submodule in + other sourcehut repositories. + * Add `.builds/upload-candidate-docs.yml` to generate and upload documentation + to Hackage. + * Add `.builds/upload-candidate-package.yml` to generate and upload a package + candidate to Hackage. + +## Version 1.0.0.0 (03-12-2026) + +Finally initialize this package! This version introduces the package to the +Hackage repository and the provides an interface for encoding/decoding digit +strings in several common numeric basesystems. Namely, this version provides +the following modules for processing this data: + +### `Data.BaseSystem` + +Provides the type-class for `BaseSystem` and the `encoder` and `decoder` methods +and generic implementations for 2 kinds of basesystems: + +- `RadixSystem` for typical basesystems such as base10 +- `BitwiseSystem` for special basesystems such as base64 and base32 + +### `Data.BaseSystems`: + +Defines common basesystems using the definitions found in +`Data.BaseSystem.Alphabets`. See the project source code for the names of +currently provided implementations. + +### Other modules: + +- `Data.BaseSystem.Alphabet` data structure definition for basesystem digit + alphabets and methods for querying alphabet information. +- `Data.BaseSystem.Alphabets` definitions for specific digit alphabets for + implementing basesystems. +- `Data.BaseSystem.Internal` provides useful methods used across modules. For + example the `packInteger` and `bytesToInteger` provides ways to convert + Integers to ByteString and vice-versa, which is handy for GHCi and unit + tests (so that we don't have to write numbers as ByteStrings before using the + encoders or decoders). diff --git a/CHANGE_LOG.md b/CHANGE_LOG.md deleted file mode 100644 --- a/CHANGE_LOG.md +++ /dev/null @@ -1,50 +0,0 @@ -[`basesystems`](http://hackage-content.haskell.org/package/basesystems) -change log: -=============================================================================== - -## Version 1.0.0.1 (04-01-2026) - -This version aims to fix the issues with the hackage page and provide CI via -sourcehut builds. - -- Set correct PVP bounds for cabal dependencies. -- Added CI/CD for builds.sr.ht: - * Add `.builds/nudge-parents.yml` to automatically update this submodule in - other sourcehut repositories. - * Add `.builds/upload-candidate-docs.yml` to generate and upload documentation - to Hackage. - * Add `.builds/upload-candidate-package.yml` to generate and upload a package - candidate to Hackage. - -## Version 1.0.0.0 (03-12-2026) - -Finally initialize this package! This version introduces the package to the -Hackage repository and the provides an interface for encoding/decoding digit -strings in several common numeric basesystems. Namely, this version provides -the following modules for processing this data: - -### `Data.BaseSystem` - -Provides the type-class for `BaseSystem` and the `encoder` and `decoder` methods -and generic implementations for 2 kinds of basesystems: - -- `RadixSystem` for typical basesystems such as base10 -- `BitwiseSystem` for special basesystems such as base64 and base32 - -### `Data.BaseSystems`: - -Defines common basesystems using the definitions found in -`Data.BaseSystem.Alphabets`. See the project source code for the names of -currently provided implementations. - -### Other modules: - -- `Data.BaseSystem.Alphabet` data structure definition for basesystem digit - alphabets and methods for querying alphabet information. -- `Data.BaseSystem.Alphabets` definitions for specific digit alphabets for - implementing basesystems. -- `Data.BaseSystem.Internal` provides useful methods used across modules. For - example the `packInteger` and `bytesToInteger` provides ways to convert - Integers to ByteString and vice-versa, which is handy for GHCi and unit - tests (so that we don't have to write numbers as ByteStrings before using the - encoders or decoders). diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -1,39 +1,37 @@ -basesystems -=========== +basesystems [![hackage.haskell.org]( +https://img.shields.io/badge/hackage%2Ehaskell%2Eorg-5C5181?logo=haskell)]( +https://hackage.haskell.org/package/basesystems)[![builds.sr.ht status]( +https://builds.sr.ht/~z0/basesystems/commits/main/basesystem-testing.yml.svg)]( +https://builds.sr.ht/~z0/basesystems/commits/main/basesystem-testing.yml?) +------------------------------------------------ -This project code contains for Encoding/Decoding number basesystems in Haskell. +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: +which provides the `encoder` and `decoder` methods on, for instance, +`ShortByteString`, in `Data.BaseSystem`: ```haskell class BaseSystem a where - encoder :: a -> ByteString -> String - decoder :: a -> String -> Maybe ByteString + encoder :: a -> ShortByteString -> String + decoder :: a -> String -> Maybe ShortByteString ``` -Then we define data structure representations for `a` and implement each -method with the data from `a`. For instance, this is how the implementations -of base64 and base10 are distinguished. - -Example -------- +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). -```haskell -ghci> import Data.BaseSystem -ghci> import Data.BaseSystems -ghci> import Data.BaseSystem.Internal (packInteger) -ghci> -ghci> encoder base10 (packInteger 123) -- "123" -ghci> decoder base10 "123" -- Just <123 as binary in ByteString> -ghci> encoder base64 (packInteger 123) -- "ew==" -ghci> decoder base64 "ew==" -- Just <123 as binary in ByteString> -``` +`basesystems` is a part of the [ipfshs](https://git.sr.ht/~z0/ipfshs) project +which contains [testing via sourcehut builds]( +https://builds.sr.ht/~z0/basesystems/commits/main/basesystem-testing.yml) and a +[bug ticket tracker](https://todo.sr.ht/~z0/ipfshs). Coverage -------- -This project aims to eventually implement most if not all of the -[mulitbase specification's basesytems list]( +Eventually, This project aims to implement most if not all of the [mulitbase +specification's basesytems list]( https://github.com/multiformats/multibase?tab=readme-ov-file#multibase-table). Currently, the following basesystems are supported: @@ -46,25 +44,56 @@ - base64 w/pad + nopad - base64url w/pad + nopad -Unit testing ------------- +Example +------- -Since these functions can have such a large amount of inputs/outputs + possible -edge cases, we generate test sets in bulk from scripts in the python folder to -JSON format. Code for running tests can be found at the [main ipfshs repo]( -https://git.sr.ht/~z0/ipfshs). +For an example of using `basesystems`, we can do the following in GHCI: -Reporting bugs --------------- +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. -Bugs can be reported to the ipfshs [ticket tracker]( -https://todo.sr.ht/~z0/ipfshs). +```haskell +λ> {-# LANGUAGE OverloadedStrings #-} +λ> import Data.BaseSystem (encoder, decoder) +λ> import Data.BaseSystem.DigitSystem (base2, base10, base16lower, base32lower) +λ> import Data.BaseSystem.BinaryTranscoder (packValue) +``` -License -------- +This shows how we can take the binary value of `123` and display it in various +number systems. -This project is free software and is provided under the BSD 3-clause licensing -agreement. +```haskell +λ> :t encoder +encoder :: BaseSystem a => a -> ShortByteString -> Text +λ> :t decoder +decoder :: BaseSystem a => a -> Text -> Maybe ShortByteString +λ> encoder base2 $ packValue (123 :: Int) +"1111011" +λ> encoder base16lower $ packValue (123 :: Int) +"7b" +λ> encoder base32lower $ packValue (123 :: Int) +"pm======" +``` -Copyright (C) 2026 Zoey McBride -<[zoeymcbride@mailbox.org](mailto:zoeymcbride@mailbox.org)> +We can also use encoders and decoders to translate one numeric representation to +another. + +```haskell +λ> encoder base10 <$> decoder base2 "1111011" +Just "123" +λ> encoder base10 <$> decoder base16lower "7b" +Just "123" +λ> encoder base10 <$> decoder base32lower "pm======" +Just "123" +``` + +Licensing +--------- + +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.0.0.1 +version: 1.1.0.0 name: basesystems build-type: Simple author: Zoey McBride @@ -14,10 +14,13 @@ base64, and more. extra-doc-files: README.md - CHANGE_LOG.md + CHANGELOG.md +tested-with: + GHC == 9.6.7 + source-repository head { - type: git - location: https://git.sr.ht/~z0/basesystems + type: git + location: https://git.sr.ht/~z0/basesystems } -- | Sets flag for CI build toggle @@ -27,65 +30,50 @@ Manual: True } --- | Sets flag for developer build toggle -flag Dev { - Description: Developer build options - Default: False - Manual: True +common HaskellConfig { + hs-source-dirs: basesystems + default-extensions: StrictData + default-language: GHC2021 } --- | These dependency versions are known to be compatable with mfmts common Depends { build-depends: base >= 4.18 && < 5, array ^>= 0.5, - bytestring ^>= 0.11, - containers ^>= 0.6, - text ^>= 2.0 + bytestring >= 0.12 && < 0.13, + containers >= 0.7 && < 8, + text >=2.1 && < 2.2 } --- | DefaultBuild: strict compilation + optimize for executable speed -common DefaultBuild { +common BuildUser { import: Depends ghc-options: -Wall -Wextra -Wno-unused-top-binds } --- | CIBuild: strict compilation + optimize for compile time -common CIBuild { +common BuildCI { import: Depends ghc-options: -Wall -Wextra -Werror -Wno-unused-top-binds } --- | Configures the Dev flag -common DevBuild { - import: Depends - ghc-options: -Wall -Wextra -Wno-unused-top-binds -} - --- | Configures basesystems library { - default-extensions: StrictData - default-language: GHC2021 - if flag(Dev) { - import: DevBuild - } - elif flag(CI) { - import: CIBuild - } - else { - import: DefaultBuild - } + import: HaskellConfig + if flag(CI) { import: BuildCI } + else { import: BuildUser } exposed-modules: - -- * Defines basesystem interface + -- * BaseSystems for ShortByteStrings Data.BaseSystem, - -- * Defines basesystem implmentors - Data.BaseSystems, - -- * Defines alphabet interface + -- * BaseSystems for LazyByteStrings + Data.BaseSystem.Lazy, + -- * BaseSystems for Strict ByteStrings + Data.BaseSystem.Strict, + -- * Defines Alphabet type + instances Data.BaseSystem.Alphabet, - -- * Defines alphabet implmentors - Data.BaseSystem.Alphabets, - -- * Provides common types and functions + -- * Data instances for working with strings of digits + Data.BaseSystem.DigitSystem, + -- * Interface for decoding strings of numbers into binary data. + Data.BaseSystem.DigitTranscoder, + -- * Interface for transcoding bitstreams + Data.BaseSystem.BinaryTranscoder, + -- * Provides utility functions Data.BaseSystem.Internal, - hs-source-dirs: - basesystems } diff --git a/basesystems/Data/BaseSystem.hs b/basesystems/Data/BaseSystem.hs --- a/basesystems/Data/BaseSystem.hs +++ b/basesystems/Data/BaseSystem.hs @@ -1,170 +1,47 @@ -- | Module : Data.BaseSystem --- Description : Defines + implements the BaseSystem type-class +-- Description : Implements BaseSystems for ShortByteString. -- Copyright : Zoey McBride (c) 2026 -- License : BSD-3-Clause -- Maintainer : zoeymcbride@mailbox.org -- Stability : experimental --- --- This file provides methods for encoding/decoding binary data to/from strings --- of digits in some basesystem. Digits can represent a sum of value placements --- (RadixSystem, eg: binary, base10) *OR* a concatination of fixed-width bit --- groups (BitwiseSystem, eg: base64, base32). module Data.BaseSystem - ( Encoder, - Decoder, + ( -- * BaseSystems on ShortByteString. BaseSystem (encoder, decoder), - ) -where -import Data.BaseSystem.Alphabet (Alphabet, alphaRadix) -import Data.BaseSystem.Alphabet qualified as Alpha -import Data.BaseSystem.Internal -import Data.Bits ((.&.), (.<<.), (.>>.), (.|.)) -import Data.ByteString (ByteString) -import Data.ByteString qualified as Bytes -import Data.Maybe (fromJust, fromMaybe) -import Data.Text qualified as Text + -- * Function signatures aliases. + Encoder, + Decoder, --- | Type-class (interface) for implementing encode/decode functionality for --- some data structure w/ Alphabet `a`. -class BaseSystem a where - encoder :: a -> Encoder - decoder :: a -> Decoder + -- * ByteString implementation for this file. + ByteStr, + ) +where --- | Function signature for encoding some ByteString to String of digits. -type Encoder = ByteString -> String +import Data.BaseSystem.DigitSystem (BitwiseDigits, RadixDigits) +import Data.BaseSystem.DigitTranscoder qualified as DXC +import Data.ByteString.Short (ShortByteString (ShortByteString)) +import Data.Text (Text) --- | Function signature for decoding some String of digits to ByteString, given --- all digits in String are valid Symbols. -type Decoder = String -> Maybe ByteString +-- | Sets the bytestring type to use in this file. +type ByteStr = ShortByteString --- | Implements BaseSystem for number systems built by modular arithmetic w/ the --- radix. -instance BaseSystem RadixSystem where - encoder :: RadixSystem -> ByteString -> String - encoder (RadixSystem _ abc) = - let radix = fromIntegral $ alphaRadix abc - in concatMap Text.unpack - . divModSymbols - . takeWhile divModContinue - . iterateInit (\(num, _) -> num `divMod` radix) mkDivMod - . bytesToInteger - where - -- Initial value to iterate on divMod. - mkDivMod numerator = (numerator, 0) - -- Predicates divMod iteration results. - divModContinue (nextinput, curresult) = nextinput > 0 || curresult > 0 - -- Resolves the symbols from the result of iterating divMod. - divModSymbols = - reverse - . fromJust - . mapM (\(_, digit) -> Alpha.resolveSymbol abc digit) - . replaceNull [(undefined, 0)] +-- | Alias for curried encoder method. +type Encoder = ByteStr -> Text - decoder :: RadixSystem -> String -> Maybe ByteString - decoder (RadixSystem _ abc) str = - let radix = fromIntegral $ alphaRadix abc - in binaryDecoder Nothing (Text.pack str) $ - \curvalue symbol -> do - value <- Alpha.resolveValue abc symbol - return $ curvalue * radix + value +-- | Alias for curried decoder method. +type Decoder = Text -> Maybe ByteStr --- | 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 :: Alphabet -> Int -> Int -> ByteString -> [Alpha.Symbol] -groupSymbols abc symbits groupsize groupbytes = - let groupint = - case bytesToInteger groupbytes of - groupnum - | fitsGroup groupsize groupbytes groupnum -> fromIntegral groupnum - | 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 groupbytes - 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 .&. (alphaRadix abc - 1) - -- Finds the length in bits of a ByteString. - mkBitLength bstr = fromIntegral $ 8 * Bytes.length bstr - -- Gives the current shift value in iteration. - shiftValue bitstotal = bitstotal - symbits +-- | Configures the BaseSystem for this file's ByteType. +class BaseSystem a where + encoder :: a -> ByteStr -> Text + decoder :: a -> Text -> Maybe ByteStr --- | Implements encoder/decoder for a BitwiseSystem. -instance BaseSystem BitwiseSystem where - encoder :: BitwiseSystem -> ByteString -> String - encoder (BitwiseSystem _ abc symbits groupbytes _ padmethod) input = - let -- Total # of bytes from input. - bytestotal = Bytes.length input - -- Total # of bits from input. - bitstotal = fromIntegral (8 * bytestotal) :: Double - -- Actual # of symbols for the # of bits in bytes. - numsymbols = ceiling (bitstotal / fromIntegral symbits) - -- Minimum # of symbols to put in the resulting string. - putsymbols = max 2 numsymbols - -- Result from applying the padding method to the # of bytes. - padapply = paddingResolve <$> padmethod <*> Just bytestotal - in (++ fromMaybe "" padapply) - . take putsymbols - . concatMap (\(group, _) -> groupString group) - . takeWhile (\(group, _) -> Bytes.length group > 0) - . iterateInit (\(_, rest) -> Bytes.splitAt groupbytes rest) mkSplit - $ minimalBytes bytestotal - where - -- Inits the iteration for Bytes.splitAt. - mkSplit initial = (Bytes.empty, initial) - -- Creates a string of symbols from a ByteString splitAt. - groupString = - Text.unpack . Text.concat . groupSymbols abc symbits groupbytes - -- Gives the minimal amount of bytes to produce a correct encoding. - {-# INLINE minimalBytes #-} - minimalBytes bytestotal - | bytestotal == 0 = Bytes.pack [0, 0] - | bytestotal == 1 = Bytes.snoc input 0 - | bytesmodulus /= 0 = Bytes.append input $ Bytes.replicate zeros 0 - | otherwise = input - where - bytesmodulus = bytestotal `mod` groupbytes - zeros = groupbytes - bytesmodulus +-- | BaseSystem for ShortByteString. +instance BaseSystem RadixDigits where + encoder = DXC.digitEncoder + decoder = DXC.digitDecoder - decoder :: BitwiseSystem -> String -> Maybe ByteString - decoder (BitwiseSystem _ abc symbits _ groupsyms pm) str = - let -- Gives just padding char if not nothing. - padchar = paddingChar <$> pm - -- Creates symbol from maybe padding char. - padsymbol = Text.singleton <$> padchar - -- Removes the trailing padding chars from the Text of str. - nopad = Text.dropWhileEnd (\sym -> Just sym == padchar) $ Text.pack str - -- Gives the total available characters. - totalsyms = Text.length nopad - -- Finds the needs # of symbols for the final padding chars. - needsyms = groupsyms - (totalsyms `mod` groupsyms) - -- Gives the number of bits to correct for missing final padding chars. - needbits = needsyms * symbits - -- Offset to Integer to byte-align the bits in the final ByteString. - bytealign = 8 * ceiling (fromIntegral needbits / 8 :: Double) - in binaryDecoder (finalizeBits needsyms bytealign) nopad $ - \curvalue symbol -> do - value <- Alpha.resolveValue abc symbol - return $ - if Just symbol /= padsymbol - then (curvalue .<<. symbits) .|. value - else curvalue .<<. symbits - where - -- Finds the value for the expected amount of padding regardless if the - -- BaseSystem has a PaddingMethod or not. - {-# INLINE finalizeBits #-} - finalizeBits needsyms align - -- If the # of Symbols in last group is the groupsyms size, pass - | needsyms == groupsyms = Nothing - -- Find the needed # of bits and align the output to first byte. - | otherwise = Just $ \finalvalue -> - finalvalue .<<. (symbits * needsyms) .>>. align +-- | BaseSystem for ShortByteString. +instance BaseSystem BitwiseDigits where + encoder = DXC.digitEncoder + decoder = DXC.digitDecoder diff --git a/basesystems/Data/BaseSystem/Alphabet.hs b/basesystems/Data/BaseSystem/Alphabet.hs --- a/basesystems/Data/BaseSystem/Alphabet.hs +++ b/basesystems/Data/BaseSystem/Alphabet.hs @@ -7,29 +7,52 @@ -- -- Implements digit alphabets for BaseSystems. module Data.BaseSystem.Alphabet - ( Symbol, + ( -- * Symbolic representation of a value + Symbol, + + -- * The value that's given to each digit Value, + + -- * Abstract Alphabet and functions Alphabet (alphaRadix, alphaHashId), mkAlphabet, resolveValue, resolveSymbol, + + -- * Available Alphabets + binary, + decimal, + hexlower, + hexupper, + btc58, + b32lower, + b32upper, + b32hexlower, + b32hexupper, + b64, + b64url, ) where -import Data.Array.IArray (Array, (!?)) import Data.Array.IArray qualified as Array +import Data.Array.Unboxed (UArray, (!?)) import Data.Char (ord) import Data.Function (on) import Data.Map.Strict (Map) import Data.Map.Strict qualified as Map import Data.Text (Text) import Data.Text qualified as Text +import Data.Word (Word32) +-- TODO: Another module for alphabets with symbols of multiple unicode code +-- points should be made. Then a DigitSystem can be built off that for +-- basesystems of multipoint symbols. + -- | Represents a symbol to act as a digit in a numbering system. -type Symbol = Text +type Symbol = Char -- | The value of a symbol in a number system. -type Value = Integer +type Value = Word32 -- | Stores the String hash for an Alphabet. Used for comparision. type HashId = Int @@ -38,7 +61,7 @@ data Alphabet = Alphabet { alphaRadix :: Int, alphaHashId :: HashId, - alphaValues :: Array Value Symbol, + alphaValues :: UArray Value Symbol, alphaSymbols :: Map Symbol Value } @@ -49,28 +72,29 @@ compare = compare `on` alphaHashId -- | Implements https://cp-algorithms.com/string/string-hashing.html -mkHashId :: String -> Int -mkHashId = - foldr (\term acc -> (term + acc) `mod` modprime) 0 - . zipWith (\i ch -> baseprime ^ i * ord ch) [(0 :: Int) ..] +mkHashId :: Text -> HashId +mkHashId = snd . Text.foldr buildPolynomial (0 :: Integer, 0 :: HashId) where -- Should be around of characters in any given alphabet baseprime = 53 - -- Large prime to prevent most collisions (1/modulus chance) + -- Large prime to prevent most collisions (1/modprime chance) modprime = 1_000_009 + -- Produces the term for a given character + buildPolynomial ch (expvalue, polysum) = + let term = baseprime ^ expvalue * ord ch + next = polysum + term + in (expvalue + 1, next `mod` modprime) --- | Creates an Alphabet from a given String by chunking the single unicode --- points into Symbols. -mkAlphabet :: String -> Alphabet -mkAlphabet str = - let text = Text.pack str - symbols = Text.chunksOf 1 text +-- | Creates an Alphabet from Text using its Chars as Symbols. +mkAlphabet :: Text -> Alphabet +mkAlphabet text = + let symbols = Text.unpack text numsymbols = Text.length text - arraybound = fromIntegral $ numsymbols - 1 + maxdigit = fromIntegral $ numsymbols - 1 in Alphabet { alphaRadix = numsymbols, - alphaHashId = mkHashId str, - alphaValues = Array.listArray (0, arraybound) symbols, + alphaHashId = mkHashId text, + alphaValues = Array.listArray (0, maxdigit) symbols, alphaSymbols = Map.fromList $ zip symbols [0 ..] } @@ -81,3 +105,73 @@ -- | /O(1)/ Find a symbol from a value in an alphabet. resolveSymbol :: Alphabet -> Value -> Maybe Symbol resolveSymbol abc value = alphaValues abc !? value + +-- | Constructs an Alphabet from a list of digit symbol strings. +mk :: [[Char]] -> Alphabet +mk = mkAlphabet . Text.pack . concat + +-- | Defines base 2. +binary :: Alphabet +binary = mk ["01"] + +-- | Defines base 10. +decimal :: Alphabet +decimal = mk ["0", ['1' .. '9']] + +-- | Defines base 16 upper-case. +hexupper :: Alphabet +hexupper = mk ["0", ['1' .. '9'], ['A' .. 'F']] + +-- | Defines base 16 lower-case. +hexlower :: Alphabet +hexlower = mk ["0", ['1' .. '9'], ['a' .. 'f']] + +-- | Defines base 58, bitcoin variant. +btc58 :: Alphabet +btc58 = + mk + [ ['1' .. '9'], + ['A' .. 'H'], + ['J' .. 'N'], + ['P' .. 'Z'], + ['a' .. 'k'], + ['m' .. 'z'] + ] + +-- | Defines base32, upper-case. +b32upper :: Alphabet +b32upper = mk [['A' .. 'Z'], ['2' .. '7']] + +-- | Defines base32, lower-case. +b32lower :: Alphabet +b32lower = mk [['a' .. 'z'], ['2' .. '7']] + +-- | Defines base32 hexadecimal, upper-case. +b32hexupper :: Alphabet +b32hexupper = mk ["0", ['1' .. '9'], ['A' .. 'V']] + +-- | Defines base32 hexadecimal, lower-case. +b32hexlower :: Alphabet +b32hexlower = mk ["0", ['1' .. '9'], ['a' .. 'v']] + +-- | Defines default base64 with + and /. +b64 :: Alphabet +b64 = + mk + [ ['A' .. 'Z'], + ['a' .. 'z'], + "0", + ['1' .. '9'], + ['+', '/'] + ] + +-- | Defines URL-safe base64 with - and _. +b64url :: Alphabet +b64url = + mk + [ ['A' .. 'Z'], + ['a' .. 'z'], + "0", + ['1' .. '9'], + ['-', '_'] + ] diff --git a/basesystems/Data/BaseSystem/Alphabets.hs b/basesystems/Data/BaseSystem/Alphabets.hs deleted file mode 100644 --- a/basesystems/Data/BaseSystem/Alphabets.hs +++ /dev/null @@ -1,83 +0,0 @@ --- | Module : Data.BaseSystem.Alphabets --- Description : Provides alphabets for common base-encodings --- Copyright : Zoey McBride (c) 2026 --- License : BSD-3-Clause --- Maintainer : zoeymcbride@mailbox.org --- Stability : experimental --- --- Defines common Alphabets for BaseSystems. -module Data.BaseSystem.Alphabets - ( binary, - decimal, - hexlower, - hexupper, - btc58, - b32lower, - b32upper, - b32hexlower, - b32hexupper, - b64, - b64url, - ) -where - -import Data.BaseSystem.Alphabet - --- | Represents base2. -binary :: Alphabet -binary = mkAlphabet "01" - --- | Represents base10. -decimal :: Alphabet -decimal = mkAlphabet $ '0' : ['1' .. '9'] - --- | Represents base16 w/ upper case A-F. -hexupper :: Alphabet -hexupper = mkAlphabet $ ['0'] ++ ['1' .. '9'] ++ ['A' .. 'F'] - --- | Represents base16 w/ lower case a-f. -hexlower :: Alphabet -hexlower = mkAlphabet $ ['0'] ++ ['1' .. '9'] ++ ['a' .. 'f'] - --- | Represents Bitcoin's base58. -btc58 :: Alphabet -btc58 = - mkAlphabet $ - ['1' .. '9'] - ++ ['A' .. 'H'] - ++ ['J' .. 'N'] - ++ ['P' .. 'Z'] - ++ ['a' .. 'k'] - ++ ['m' .. 'z'] - -b32lower :: Alphabet -b32lower = mkAlphabet $ ['a' .. 'z'] ++ ['2' .. '7'] - -b32upper :: Alphabet -b32upper = mkAlphabet $ ['A' .. 'Z'] ++ ['2' .. '7'] - -b32hexupper :: Alphabet -b32hexupper = mkAlphabet $ ['0'] ++ ['1' .. '9'] ++ ['A' .. 'V'] - -b32hexlower :: Alphabet -b32hexlower = mkAlphabet $ ['0'] ++ ['1' .. '9'] ++ ['a' .. 'v'] - --- | Represents base64 w/o padding implemented. -b64 :: Alphabet -b64 = - mkAlphabet $ - ['A' .. 'Z'] - ++ ['a' .. 'z'] - ++ ['0'] - ++ ['1' .. '9'] - ++ ['+', '/'] - --- | Represents base64 w/o padding implemented. -b64url :: Alphabet -b64url = - mkAlphabet $ - ['A' .. 'Z'] - ++ ['a' .. 'z'] - ++ ['0'] - ++ ['1' .. '9'] - ++ ['-', '_'] diff --git a/basesystems/Data/BaseSystem/BinaryTranscoder.hs b/basesystems/Data/BaseSystem/BinaryTranscoder.hs new file mode 100644 --- /dev/null +++ b/basesystems/Data/BaseSystem/BinaryTranscoder.hs @@ -0,0 +1,238 @@ +-- | Module : Data.BaseSystem.BinaryTranscoder +-- Description : Interfaces for transcoding numeric binary data. +-- Copyright : Zoey McBride (c) 2026 +-- License : BSD-3-Clause +-- Maintainer : zoeymcbride@mailbox.org +-- Stability : experimental +module Data.BaseSystem.BinaryTranscoder + ( -- * Interface for implementing generic binary decoders + BinaryTranscoder (..), + + -- * Converts streams of bytes into editable bits + BitSet, + ) +where + +import Data.BaseSystem.Internal +import Data.Bits (Bits, (.&.), (.<<.), (.>>.), (.|.)) +import Data.ByteString (ByteString) +import Data.ByteString qualified as Bytes +import Data.ByteString.Builder (Builder) +import Data.ByteString.Builder qualified as Builder +import Data.ByteString.Lazy (LazyByteString) +import Data.ByteString.Lazy qualified as LBS +import Data.ByteString.Short (ShortByteString) +import Data.ByteString.Short qualified as SBS +import Data.Word (Word8) + +-- | Storage for data with bitwise operations. +type BitSet = Integer + +-- | Class of functions for working on binary transcoder streams, that is +-- streams of bytes that we can easily turn into a bitset, and can partition +-- into smaller streams for extracting and parsing data. +class (Monoid bxc) => BinaryTranscoder bxc where + -- This defines basic methods that all BinaryTranscoders share. + {-# MINIMAL + lengthBytes, + unpackValue, + serializeValue, + packBytes, + unpackBytes, + pushByte, + pushByteEnd, + takeBytes, + takeBytesEnd, + dropBytes, + dropBytesEnd, + splitAtByte, + spanBytes, + spanBytesEnd, + replicateByte + #-} + + -- | Gives back the length in bytes of the Transcoder data. + lengthBytes :: bxc -> Int + + -- | Unpacks transcoder data as BitSet, ie, an infinite bitarray. + unpackValue :: bxc -> BitSet + + -- | Places the contents of the transcoder into a ByteString Builder. + serializeValue :: bxc -> Builder + + -- | Packs Word8 values into transcoder data `bxc`. + packBytes :: [Word8] -> bxc + + -- | Unpacks transcoder data into a list of bytes. + unpackBytes :: bxc -> [Word8] + + -- | Prepends a byte value to the top of the transcoder data. + pushByte :: bxc -> Word8 -> bxc + + -- | Appends the byte value to the end of the transcoder data. + pushByteEnd :: bxc -> Word8 -> bxc + + -- | Takes a subsection of bytes from the beginning of the transcoder data. + takeBytes :: Int -> bxc -> bxc + + -- | Removes bytes from the beginning of transcoder data. + dropBytes :: Int -> bxc -> bxc + + -- | Removes bytes from the end of transcoder data. + takeBytesEnd :: Int -> bxc -> bxc + + -- | Removes bytes from the end of transcoder data. + dropBytesEnd :: Int -> bxc -> bxc + + -- | Parititions the binary data at the nth byte. + splitAtByte :: Int -> bxc -> (bxc, bxc) + + -- | Repeats a byte value in binary data. + replicateByte :: Int -> Word8 -> bxc + + -- | Splits byte values based on the first false result from the predicate. + spanBytes :: (Word8 -> Bool) -> bxc -> (bxc, bxc) + + -- | Implements `takeWhile` for byte data in binary transcoder. + takeWhileBytes :: (Word8 -> Bool) -> bxc -> bxc + takeWhileBytes f = fst . spanBytesEnd f + + -- | Implements `dropWhile` for byte data in binary transcoder. + dropWhileBytes :: (Word8 -> Bool) -> bxc -> bxc + dropWhileBytes f = snd . spanBytesEnd f + + -- | Splits the list while the element predicate holds staring from the left + -- side. + spanBytesEnd :: (Word8 -> Bool) -> bxc -> (bxc, bxc) + + -- | Implements `takeWhileEnd` for byte data in binary transcoder. + takeWhileBytesEnd :: (Word8 -> Bool) -> bxc -> bxc + takeWhileBytesEnd f = snd . spanBytesEnd f + + -- | Implements `dropWhileEnd` for byte data in binary transcoder. + dropWhileBytesEnd :: (Word8 -> Bool) -> bxc -> bxc + dropWhileBytesEnd f = fst . spanBytesEnd f + + -- | Represents empty binary transcoder data. + empty :: bxc + empty = mempty + + -- | Appends the contents of two binary transcoders. + append :: bxc -> bxc -> bxc + append = mappend + + -- | Creates a binary transcoder from a single byte. + {-# INLINE singleton #-} + singleton :: Word8 -> bxc + singleton w8 = packBytes [w8] + + -- | Returns True if the binary transcoder data is empty. + {-# INLINE null #-} + null :: bxc -> Bool + null bxc = lengthBytes bxc == 0 + + -- | Returns the first byte removed from the transcoder data, if available. + {-# INLINE uncons #-} + uncons :: bxc -> Maybe (Word8, bxc) + uncons bxc = + let (start, rest) = splitAtByte 1 bxc + in case unpackBytes start of + [top] -> Just (top, rest) + _ -> Nothing + + -- | Returns the last byte removed from the transcoder data, if available. + {-# INLINE usnoc #-} + usnoc :: bxc -> Maybe (bxc, Word8) + usnoc bxc = + let offset = lengthBytes bxc - 1 + (rest, taken) = splitAtByte offset bxc + in case unpackBytes taken of + [final] -> Just (rest, final) + _ -> Nothing + + -- | Packs a bit string value into some bytes data `bxc`. + packValue :: (Integral b, Bits b) => b -> bxc + packValue intdata = + -- This code can be optimized; if we precalculate the length of the BitSet + -- in bits we can mask from the other direction using left shifts, and + -- remove the call to reverse, maybe we can even use a list comprehension to + -- build in place for Bytes.packBytes + packBytes + . replaceNull [0] + . reverse + . map (\(_, byte) -> fromIntegral byte) + . takeWhile (\(rest, byte) -> rest > 0 || byte > 0) + $ iterateInit (\(input, _) -> extractByte input) (,0) intdata + where + -- Gets the byte from LSB in input and shifts the value 8 bits. + extractByte input = (input .>>. 8, input .&. 0xFF) + +-- | Implements binary decoder for Bytestrings, best for constant values that +-- exist for the lifetime of the program. +-- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString.html#g:2 +instance BinaryTranscoder ByteString where + lengthBytes = Bytes.length + packBytes = Bytes.pack + serializeValue = Builder.byteString + unpackBytes = Bytes.unpack + pushByte = flip Bytes.cons + pushByteEnd = Bytes.snoc + takeBytes = Bytes.take + takeBytesEnd = Bytes.takeEnd + dropBytes = Bytes.drop + dropBytesEnd = Bytes.dropEnd + spanBytes = Bytes.span + spanBytesEnd = Bytes.spanEnd + splitAtByte = Bytes.splitAt + replicateByte k = Bytes.replicate $ fromIntegral k + unpackValue = unpackValue . LBS.fromStrict + +-- TODO: we can improve the proformance of unpackBits by examining the current +-- bytestring, and loading a range of 1-8 bytes to OR simulaneously + +-- | Implements binary decoder for LazyByteString, best for very large data sets +-- that can be loaded in and out of memory on demand. +-- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString-Lazy.html +instance BinaryTranscoder LazyByteString where + lengthBytes = fromIntegral . LBS.length + packBytes = LBS.pack + unpackBytes = LBS.unpack + serializeValue = Builder.lazyByteString + pushByte = flip LBS.cons + pushByteEnd = LBS.snoc + takeBytes k = LBS.take $ fromIntegral k + takeBytesEnd k = LBS.takeEnd $ fromIntegral k + dropBytes k = LBS.drop $ fromIntegral k + dropBytesEnd k = LBS.dropEnd $ fromIntegral k + spanBytes = LBS.span + spanBytesEnd = LBS.spanEnd + splitAtByte k = LBS.splitAt $ fromIntegral k + replicateByte k = LBS.replicate $ fromIntegral k + unpackValue = + -- From LSB to MSB, OR the current byte and shift the total bits. + LBS.foldl' (\bits byte -> (bits .<<. 8) .|. fromIntegral byte) 0 + . LBS.dropWhile (== 0) + +-- | Implements binary decoder for ShortByteString, best for compact data that +-- doesn't exist long in memory. Notably, it packs better in memory than normal +-- ByteString (prone to Heap Fragmentation). +-- https://hackage-content.haskell.org/package/bytestring-0.12.2.0/docs/Data-ByteString-Short.html#g:1 +instance BinaryTranscoder ShortByteString where + lengthBytes = SBS.length + packBytes = SBS.pack + unpackBytes = SBS.unpack + serializeValue = Builder.shortByteString + pushByte = flip SBS.cons + pushByteEnd = SBS.snoc + takeBytes = SBS.take + takeBytesEnd = SBS.takeEnd + dropBytes = SBS.drop + dropBytesEnd = SBS.dropEnd + spanBytes = SBS.span + spanBytesEnd = SBS.spanEnd + splitAtByte = SBS.splitAt + replicateByte k = SBS.replicate $ fromIntegral k + unpackValue = + -- From LSB to MSB, OR the current byte and shift the total bits. + SBS.foldl' (\bits byte -> (bits .<<. 8) .|. fromIntegral byte) 0 + . SBS.dropWhile (== 0) diff --git a/basesystems/Data/BaseSystem/DigitSystem.hs b/basesystems/Data/BaseSystem/DigitSystem.hs new file mode 100644 --- /dev/null +++ b/basesystems/Data/BaseSystem/DigitSystem.hs @@ -0,0 +1,191 @@ +-- | Module : Data.BaseSystem.DigitSystem +-- Description : Implements DigitSystems for DigitTranscoders +-- Copyright : Zoey McBride (c) 2026 +-- License : BSD-3-Clause +-- Maintainer : zoeymcbride@mailbox.org +-- Stability : experimental +module Data.BaseSystem.DigitSystem + ( -- * Abstract DigitSystems data types + RadixDigits (RadixDigits), + BitwiseDigits (BitwiseDigits), + + -- * Data member of BitwiseDigits. Determines how to post process encodings. + PaddingMethod (paddingChar, paddingResolve), + + -- * Concrete instances of DigitSystems + base2, + base10, + base16lower, + base16upper, + base32lower, + base32lowerNP, + base32upper, + base32upperNP, + base32hexlower, + base32hexlowerNP, + base32hexupper, + base32hexupperNP, + base58btc, + base64, + base64NP, + base64url, + base64urlNP, + ) +where + +import Data.BaseSystem.Alphabet (Alphabet) +import Data.BaseSystem.Alphabet qualified as ABCs +import Data.Text (Text) +import Data.Text qualified as Text + +-- | Implements BaseSystem over base radix modulus. +data RadixDigits = RadixDigits + { -- | Used to implement instance of Show. + radixShow :: String, + -- | Alphabet for the base system. + radixAlpha :: Alphabet + } + +instance Show RadixDigits where + show = radixShow + +-- | Implements padding for encoding BitwiseDigits. +data PaddingMethod = PaddingMethod + { -- | Gives the char to use as padding. + paddingChar :: Char, + -- | Provides the callback to resolve the padding from # of bytes. + paddingResolve :: Int -> Text + } + +-- | Implements BaseSystem over series of bit groups. +data BitwiseDigits = BitwiseDigits + { -- | String used to implement instance of Show. + bitwiseShow :: String, + -- | Base system alphabet. + bitwiseAlpha :: Alphabet, + -- | # of bits per symbol + bitwiseSymBits :: Int, + -- | # of bytes to be processed into symbols in encoding. + bitwiseGroupBytes :: Int, + -- | # of bytes forming a group to find padding in decoding. + bitwiseGroupSymbols :: Int, + -- | Gives the method for padding. + bitwisePadMethod :: Maybe PaddingMethod + } + +instance Show BitwiseDigits where + show = bitwiseShow + +-- | Provides methods for building a base32 system, with an option to toggle +-- padding. +mkBaseSystem32 :: String -> Maybe Char -> Alphabet -> BitwiseDigits +mkBaseSystem32 name padchar abc = + BitwiseDigits name abc symbits groupbytes groupsymbols $ + PaddingMethod <*> padImpl <$> padchar + where + groupbytes = 5 + groupsymbols = 8 + symbits = 5 + padImpl padding bytestotal + | bytestotal > 5 = padImpl padding $ bytestotal `mod` symbits + | bytestotal == 4 = Text.singleton padding + | bytestotal == 3 = Text.pack (replicate 3 padding) + | bytestotal == 2 = Text.pack (replicate 4 padding) + | bytestotal == 1 = Text.pack (replicate 6 padding) + | otherwise = Text.empty + +-- | Provides methods for building a base64 system, with an option to toggle +-- padding. +mkBaseSystem64 :: String -> Maybe Char -> Alphabet -> BitwiseDigits +mkBaseSystem64 name padchar abc = + BitwiseDigits name abc symbits groupbytes groupsymbols $ + PaddingMethod <*> padImpl <$> padchar + where + groupbytes = 3 + groupsymbols = 4 + symbits = 6 + padImpl padding bytestotal + | bytestotal > 3 = padImpl padding $ bytestotal `mod` groupbytes + | bytestotal == 2 = Text.singleton padding + | bytestotal == 1 = Text.pack [padding, padding] + | otherwise = Text.empty + +-- | Defines the BaseSystem for binary. +base2 :: RadixDigits +base2 = RadixDigits "base2" ABCs.binary + +-- | Defines base10 as RadixDigits. +base10 :: RadixDigits +base10 = RadixDigits "base10" ABCs.decimal + +-- | Defines Bitcoin's base58 implementation. +base58btc :: RadixDigits +base58btc = RadixDigits "base58btc" ABCs.btc58 + +-- | Defines uppercase hexidecimal on BitwiseDigits. +base16upper :: RadixDigits +base16upper = RadixDigits "base16upper" ABCs.hexupper + +-- | Defines lowercase hexadecimal on BitwiseDigits. +base16lower :: RadixDigits +base16lower = RadixDigits "base16lower" ABCs.hexlower + +-- | Defines lowercase base32 from RFC4648, with padding. +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6 +base32lower :: BitwiseDigits +base32lower = mkBaseSystem32 "base32lower" (Just '=') ABCs.b32lower + +-- | Defines lowercase base32 from RFC4648. No padding! +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6 +base32lowerNP :: BitwiseDigits +base32lowerNP = mkBaseSystem32 "base32lowerNP" Nothing ABCs.b32lower + +-- | Defines uppercase base32 from RFC4648, with padding. +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6 +base32upper :: BitwiseDigits +base32upper = mkBaseSystem32 "base32upper" (Just '=') ABCs.b32upper + +-- | Defines uppercase base32 from RFC4648. No padding! +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6 +base32upperNP :: BitwiseDigits +base32upperNP = mkBaseSystem32 "base32upperNP" Nothing ABCs.b32upper + +-- | Defines lowercase base32 from RFC4648, extended hex version, with padding. +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7 +base32hexlower :: BitwiseDigits +base32hexlower = mkBaseSystem32 "base32hexlower" (Just '=') ABCs.b32hexlower + +-- | Defines lowercase base32 from RFC4648, extended hex version. No padding! +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7 +base32hexlowerNP :: BitwiseDigits +base32hexlowerNP = mkBaseSystem32 "base32hexlowerNP" Nothing ABCs.b32hexlower + +-- | Defines lowercase base32 from RFC4648, extended hex version, with padding. +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7 +base32hexupper :: BitwiseDigits +base32hexupper = mkBaseSystem32 "base32hexupper" (Just '=') ABCs.b32hexupper + +-- | Defines uppercase base32 from RFC4648, extended hex version. No padding! +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7 +base32hexupperNP :: BitwiseDigits +base32hexupperNP = mkBaseSystem32 "base32hexupperNP" Nothing ABCs.b32hexupper + +-- | Defines base64 from RFC4648, with padding. +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-4 +base64 :: BitwiseDigits +base64 = mkBaseSystem64 "base64" (Just '=') ABCs.b64 + +-- | Defines base64 from RFC4648. No padding! +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-4 +base64NP :: BitwiseDigits +base64NP = mkBaseSystem64 "base64NP" Nothing ABCs.b64 + +-- | Defines URL safe base64 from RFC4648, with padding. +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-5 +base64url :: BitwiseDigits +base64url = mkBaseSystem64 "base64url" (Just '=') ABCs.b64url + +-- | Defines URL safe base64 from RFC4648. No padding! +-- https://datatracker.ietf.org/doc/html/rfc4648.html#section-5 +base64urlNP :: BitwiseDigits +base64urlNP = mkBaseSystem64 "base64urlNP" Nothing ABCs.b64url diff --git a/basesystems/Data/BaseSystem/DigitTranscoder.hs b/basesystems/Data/BaseSystem/DigitTranscoder.hs new file mode 100644 --- /dev/null +++ b/basesystems/Data/BaseSystem/DigitTranscoder.hs @@ -0,0 +1,226 @@ +-- | Module : Data.BaseSystem.DigitTranscoder +-- Description : Implements BaseSystems for strict ByteStrings. +-- Copyright : Zoey McBride (c) 2026 +-- License : BSD-3-Clause +-- Maintainer : zoeymcbride@mailbox.org +-- Stability : experimental +module Data.BaseSystem.DigitTranscoder + ( DigitTranscoder (digitEncoder, digitDecoder), + Encoder, + Decoder, + ) +where + +import Control.Monad (foldM) +import Data.BaseSystem.Alphabet (Alphabet) +import Data.BaseSystem.Alphabet qualified as Alpha +import Data.BaseSystem.BinaryTranscoder (BinaryTranscoder, BitSet) +import Data.BaseSystem.BinaryTranscoder qualified as BXC +import Data.BaseSystem.DigitSystem +import Data.BaseSystem.Internal +import Data.Bits ((.&.), (.<<.), (.>>.), (.|.)) +import Data.Maybe (fromJust, fromMaybe) +import Data.Text (Text) +import Data.Text qualified as Text + +-- | Functor applies when in context of a BaseSystem decoder implementation that +-- requires modifications to the entire bitset before converting to ByteString. +type FinalizeContext = Maybe (BitSet -> BitSet) + +-- | Builds symbols from a number in decoding. +-- https://en.wikipedia.org/wiki/Finite-state_machine#Mathematical_model +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. +{-# INLINE binaryDecoder #-} +binaryDecoder :: + (BinaryTranscoder bxc) => + Text -> + FinalizeContext -> + DeltaFunction -> + Maybe bxc +binaryDecoder text finalize delta + | Text.null text = Nothing + | otherwise = do + -- For each symbol, build the bitvalue using the delta function if the + -- symbol is valid. + bitvalue <- foldM delta 0 $ Text.unpack text + -- Apply the finalizer to the bits and put it into a transcoder + return $ BXC.packValue (applyFinalize bitvalue) + where + -- If finalize exists, apply it, otherwise return the unchanged value. + applyFinalize value = fromMaybe value $ finalize <*> Just value + +-- | Type alias for curried DigitTranscoder digitEncoder function. +type Encoder t = t -> Text + +-- | Type alias for curried DigitTranscoder digitDecoder function. +type Decoder t = Text -> Maybe t + +-- | Type-class (interface) for implementing encode/decode functionality for +-- some data structure w/ Alphabet `a`. +class (BinaryTranscoder t) => DigitTranscoder a t where + -- | Method signature for encoding some ByteString to String of digits. + digitEncoder :: a -> t -> Text + + -- | Method signature for decoding some String of digits to ByteString, given + -- all digits in String are valid Symbols. + digitDecoder :: a -> Text -> Maybe t + +-- | Implements BaseSystem for number systems built by modular arithmetic w/ the +-- radix. +instance (BinaryTranscoder t) => DigitTranscoder RadixDigits t where + -- Encodes the value by converting the ByteString to Integer and repeatedly + -- applying `divMod` until the quotient is zero. + digitEncoder (RadixDigits _ abc) = + let radix = fromIntegral $ Alpha.alphaRadix abc + in Text.pack + . divModSymbols + . takeWhile divModContinue + . iterateInit (\(num, _) -> num `divMod` radix) mkDivMod + . BXC.unpackValue + where + -- Initial value to iterate on divMod. + mkDivMod numerator = (numerator, 0) + -- Predicates divMod iteration results. + divModContinue (nextinput, curresult) = nextinput > 0 || curresult > 0 + -- Resolves the symbols from the result of iterating divMod. + divModSymbols = + reverse + . fromJust + . mapM (\(_, digit) -> Alpha.resolveSymbol abc $ fromIntegral digit) + . replaceNull [(undefined, 0)] + + -- Decodes the value by multiplying the radix with the current integer state + -- and adding the value. That value is decode directly, no finalization + -- needed. + digitDecoder (RadixDigits _ abc) text = + let radix = fromIntegral $ Alpha.alphaRadix abc + in binaryDecoder text Nothing $ + \curvalue symbol -> do + value <- fromIntegral <$> Alpha.resolveValue abc symbol + return $ + curvalue * radix + value + +-- | Implements encoder/decoder for a BitwiseDigits. +instance (BinaryTranscoder t) => DigitTranscoder BitwiseDigits t 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. + digitEncoder (BitwiseDigits _ abc symbits groupsize _ padmethod) input = + let -- Total # of bytes from input. + bytestotal = BXC.lengthBytes input + -- Total # of bits from input. + bitstotal = fromIntegral (8 * bytestotal) :: Double + -- Actual # of symbols for the # of bits in bytes. + numsymbols = ceiling (bitstotal / fromIntegral symbits) + -- Minimum # of symbols to put in the resulting string. + putsymbols = max 2 numsymbols + in paddingAppend (fromIntegral bytestotal) + . take putsymbols + . concatMap groupSyms + . takeWhile (\(group, _) -> BXC.lengthBytes group > 0) + . iterateInit (\(_, rest) -> BXC.splitAtByte groupsize rest) mkSplit + $ minimalBytes bytestotal + where + -- Inits the iteration for Bytes.splitAt. + mkSplit initial = (BXC.empty, initial) + -- Gives the minimal amount of bytes to produce a correct encoding. It's + -- here to maintain compatablity with other encoders. + {-# INLINE minimalBytes #-} + minimalBytes bytestotal + | bytestotal == 0 = BXC.packBytes [0, 0] + | bytestotal == 1 = BXC.pushByteEnd input 0 + | bytesmodulus /= 0 = BXC.append input (BXC.replicateByte zeros 0) + | otherwise = input + where + bytesmodulus = fromIntegral (bytestotal `mod` fromIntegral groupsize) + zeros = groupsize - bytesmodulus + -- Gets the symbols for the byte group. + groupSyms (group, _) = groupSymbols abc group groupsize symbits + -- Appends the padding chars to the end of a list of symbols, when the + -- padding method exists and gives back a string for the bytestotal + paddingAppend bytestotal syms = + let padapply = paddingResolve <$> padmethod <*> Just bytestotal + in Text.append (Text.pack syms) (fromMaybe Text.empty padapply) + + -- Decodes the text by filtering out padding resolving each symbol and then + -- 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. + 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. + notrailing = Text.dropWhileEnd (\sym -> Just sym == padsym) text + -- Gives the total available characters. + totalsyms = Text.length notrailing + -- Finds the needs # of symbols for the final padding chars. + needsyms = groupsyms - (totalsyms `mod` groupsyms) + in binaryDecoder notrailing (finalizeBits needsyms) $ + \curvalue symbol -> + if Just symbol == padsym + -- When the symbol is the padding char, shift an empty value + then return (curvalue .<<. symbits) + -- Otherwise put the value in place + else do + value <- fromIntegral <$> Alpha.resolveValue abc symbol + return $ (curvalue .<<. symbits) .|. value + where + -- Finds the value for the expected amount of padding regardless if the + -- BaseSystem has a PaddingMethod or not. + {-# INLINE finalizeBits #-} + finalizeBits needsyms + -- If the # of Symbols in last group is the groupsyms size, pass + | needsyms == groupsyms = Nothing + -- Find the needed # of bits and align the output to first byte. + | otherwise = Just $ \final -> final .<<. needbits .>>. pagealign + where + -- Gives the number of bits to correct in missing final padding chars. + needbits = needsyms * symbits + -- 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.unpackValue 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.lengthBytes 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.lengthBytes bxcdata <= fromIntegral groupsize + && minInt <= groupbits + && groupbits <= maxInt + where + minInt = fromIntegral (minBound :: Int) + maxInt = fromIntegral (maxBound :: Int) diff --git a/basesystems/Data/BaseSystem/Internal.hs b/basesystems/Data/BaseSystem/Internal.hs --- a/basesystems/Data/BaseSystem/Internal.hs +++ b/basesystems/Data/BaseSystem/Internal.hs @@ -7,73 +7,12 @@ -- -- Common data definitions and helper functions for this library. module Data.BaseSystem.Internal - ( -- * BaseSystem data structures - RadixSystem (..), - PaddingMethod (..), - BitwiseSystem (..), - - -- * List utilities + ( -- * List utilities replaceNull, iterateInit, - - -- * ByteString utilities - bytesToInteger, - packInteger, - fitsGroup, - - -- * Decoder implementations - binaryDecoder, ) where -import Control.Monad (foldM) -import Data.BaseSystem.Alphabet (Alphabet) -import Data.BaseSystem.Alphabet qualified as Alpha -import Data.Bits ((.&.), (.<<.), (.>>.), (.|.)) -import Data.ByteString (ByteString) -import Data.ByteString qualified as Bytes -import Data.Maybe (fromMaybe) -import Data.Text (Text) -import Data.Text qualified as Text - --- | Implements BaseSystem over base radix modulus. -data RadixSystem = RadixSystem - { -- | Used to implement instance of Show. - radixShow :: String, - -- | Alphabet for the base system. - radixAlpha :: Alphabet - } - -instance Show RadixSystem where - show = radixShow - --- | Implements padding for encoding BitwiseSystem. -data PaddingMethod = PaddingMethod - { -- | Gives the char to use as padding. - paddingChar :: Char, - -- | Provides the callback to resolve the padding from # of bytes. - paddingResolve :: Int -> String - } - --- | Implements BaseSystem over series of bit groups. -data BitwiseSystem = BitwiseSystem - { -- | String used to implement instance of Show. - bitwiseShow :: String, - -- | Base system alphabet. - bitwiseAlpha :: Alphabet, - -- | # of bits per symbol - bitwiseSymBits :: Int, - -- | # of bytes to be processed into symbols in encoding. - bitwiseGroupBytes :: Int, - -- | # of bytes forming a group to find padding in decoding. - bitwiseGroupSymbols :: Int, - -- | Gives the method for padding. - bitwisePadMethod :: Maybe PaddingMethod - } - -instance Show BitwiseSystem where - show = bitwiseShow - -- | Return the the first param if the second param is empty. {-# INLINE replaceNull #-} replaceNull :: [a] -> [a] -> [a] @@ -84,57 +23,3 @@ -- | Wraps iterate to compose with an intermediary type constructor. iterateInit :: (b -> b) -> (a -> b) -> a -> [b] iterateInit f iterinit = drop 1 . iterate f . iterinit - --- | Builds an Integer from ByteString. -bytesToInteger :: ByteString -> Integer -bytesToInteger = - Bytes.foldl' (\acc x -> (acc .<<. 8) .|. fromIntegral x) 0 - . Bytes.dropWhile (== 0) - --- | Encode an Integer's numeric value in a ByteString as raw base2 binary --- values from the the Integer's bit values. -packInteger :: Integer -> ByteString -packInteger = - -- This code can be optimized; if we precalculate the length of the integer - -- in bits we can mask from the other direction using left shifts, and remove - -- the call to reverse, maybe we can even use a list comprehension to build - -- in place for Bytes.pack - let maskbyte = (.&. 0xFF) - shiftbyte = (.>>. 8) - in Bytes.pack - . replaceNull [0] - . reverse - . map (\(_, byte) -> fromIntegral byte) - . takeWhile (\(rest, byte) -> rest > 0 || byte > 0) - . iterateInit (\(input, _) -> (shiftbyte input, maskbyte input)) (,0) - --- | Checks if an Integral a fits within a BitwiseSystem's group. -{-# INLINE fitsGroup #-} -fitsGroup :: Int -> ByteString -> Integer -> Bool -fitsGroup groupsize groupbytes groupbits = - Bytes.length groupbytes <= groupsize - && minInt <= groupbits - && groupbits <= maxInt - where - minInt = fromIntegral (minBound :: Int) - maxInt = fromIntegral (maxBound :: Int) - --- | Function to cleanup data in decoding. -type FinalizeBits = Maybe (Integer -> Integer) - --- Builds symbols from a number in decoding. -type DecoderBuilder = Integer -> Alpha.Symbol -> Maybe Integer - --- | Provides generic structure for decoding symbols into binary data --- ByteString. -{-# INLINE binaryDecoder #-} -binaryDecoder :: FinalizeBits -> Text -> DecoderBuilder -> Maybe ByteString -binaryDecoder finalize text builder - | Text.null text = Nothing - | otherwise = - fmap (packInteger . applyFinalize) - . foldM builder 0 - $ Text.chunksOf 1 text - where - -- If finalize exists, apply it, otherwise return the unchanged value. - applyFinalize value = fromMaybe value $ finalize <*> Just value diff --git a/basesystems/Data/BaseSystem/Lazy.hs b/basesystems/Data/BaseSystem/Lazy.hs new file mode 100644 --- /dev/null +++ b/basesystems/Data/BaseSystem/Lazy.hs @@ -0,0 +1,47 @@ +-- | Module : Data.BaseSystem.Lazy +-- Description : Implements BaseSystems for LazyByteString. +-- Copyright : Zoey McBride (c) 2026 +-- License : BSD-3-Clause +-- Maintainer : zoeymcbride@mailbox.org +-- Stability : experimental +module Data.BaseSystem.Lazy + ( -- * BaseSystems on LazyByteString. + BaseSystem (encoder, decoder), + + -- * Function signatures aliases. + Encoder, + Decoder, + + -- * ByteString implementation for this file. + ByteStr, + ) +where + +import Data.BaseSystem.DigitSystem (BitwiseDigits, RadixDigits) +import Data.BaseSystem.DigitTranscoder qualified as DXC +import Data.ByteString.Lazy (LazyByteString) +import Data.Text (Text) + +-- | Sets the bytestring type to use in this file. +type ByteStr = LazyByteString + +-- | Alias for curried encoder method. +type Encoder = ByteStr -> Text + +-- | Alias for curried decoder method. +type Decoder = Text -> Maybe ByteStr + +-- | Configures the BaseSystem for this file's ByteType. +class BaseSystem a where + encoder :: a -> ByteStr -> Text + decoder :: a -> Text -> Maybe ByteStr + +-- | BaseSystem for LazyByteString. +instance BaseSystem RadixDigits where + encoder = DXC.digitEncoder + decoder = DXC.digitDecoder + +-- | BaseSystem for LazyByteString. +instance BaseSystem BitwiseDigits where + encoder = DXC.digitEncoder + decoder = DXC.digitDecoder diff --git a/basesystems/Data/BaseSystem/Strict.hs b/basesystems/Data/BaseSystem/Strict.hs new file mode 100644 --- /dev/null +++ b/basesystems/Data/BaseSystem/Strict.hs @@ -0,0 +1,47 @@ +-- | Module : Data.BaseSystem.Strict +-- Description : Implements BaseSystems for strict ByteStrings. +-- Copyright : Zoey McBride (c) 2026 +-- License : BSD-3-Clause +-- Maintainer : zoeymcbride@mailbox.org +-- Stability : experimental +module Data.BaseSystem.Strict + ( -- * BaseSystems on ByteString + BaseSystem (encoder, decoder), + + -- * Function signatures aliases. + Encoder, + Decoder, + + -- * ByteString implementation for this file + ByteStr, + ) +where + +import Data.BaseSystem.DigitSystem (BitwiseDigits, RadixDigits) +import Data.BaseSystem.DigitTranscoder qualified as DXC +import Data.ByteString (ByteString) +import Data.Text (Text) + +-- | Sets the bytestring type to use in this file. +type ByteStr = ByteString + +-- | Alias for curried encoder method. +type Encoder = ByteStr -> Text + +-- | Alias for curried decoder method. +type Decoder = Text -> Maybe ByteStr + +-- | Configures the BaseSystem for this file's ByteType. +class BaseSystem a where + encoder :: a -> ByteStr -> Text + decoder :: a -> Text -> Maybe ByteStr + +-- | BaseSystem for ByteString. +instance BaseSystem RadixDigits where + encoder = DXC.digitEncoder + decoder = DXC.digitDecoder + +-- | BaseSystem for ByteString. +instance BaseSystem BitwiseDigits where + encoder = DXC.digitEncoder + decoder = DXC.digitDecoder diff --git a/basesystems/Data/BaseSystems.hs b/basesystems/Data/BaseSystems.hs deleted file mode 100644 --- a/basesystems/Data/BaseSystems.hs +++ /dev/null @@ -1,151 +0,0 @@ --- | Module : Data.BaseSystems --- Description : Provides default implementations for BaseSystem --- Copyright : Zoey McBride (c) 2026 --- License : BSD-3-Clause --- Maintainer : zoeymcbride@mailbox.org --- Stability : experimental --- --- This file provides common implementations for BaseSystem. These can be used --- by calling either `encoder ` or `decoder `. -module Data.BaseSystems - ( base2, - base10, - base16lower, - base16upper, - base32lower, - base32lowerNP, - base32upper, - base32upperNP, - base32hexlower, - base32hexlowerNP, - base32hexupper, - base32hexupperNP, - base58btc, - base64, - base64NP, - base64url, - base64urlNP, - ) -where - -import Data.BaseSystem.Alphabet (Alphabet) -import Data.BaseSystem.Alphabets qualified as ABCs -import Data.BaseSystem.Internal - --- | Provides methods for building a base32 system, with an option to toggle --- padding. -mkBaseSystem32 :: String -> Maybe Char -> Alphabet -> BitwiseSystem -mkBaseSystem32 name padchar abc = - BitwiseSystem name abc symbits groupbytes groupsymbols $ - PaddingMethod <*> padImpl <$> padchar - where - groupbytes = 5 - groupsymbols = 8 - symbits = 5 - padImpl padding bytestotal - | bytestotal > 5 = padImpl padding $ bytestotal `mod` symbits - | bytestotal == 4 = [padding] - | bytestotal == 3 = replicate 3 padding - | bytestotal == 2 = replicate 4 padding - | bytestotal == 1 = replicate 6 padding - | otherwise = [] - --- | Provides methods for building a base64 system, with an option to toggle --- padding. -mkBaseSystem64 :: String -> Maybe Char -> Alphabet -> BitwiseSystem -mkBaseSystem64 name padchar abc = - BitwiseSystem name abc symbits groupbytes groupsymbols $ - PaddingMethod <*> padImpl <$> padchar - where - groupbytes = 3 - groupsymbols = 4 - symbits = 6 - padImpl padding bytestotal - | bytestotal > 3 = padImpl padding $ bytestotal `mod` groupbytes - | bytestotal == 2 = [padding] - | bytestotal == 1 = [padding, padding] - | otherwise = [] - --- | Defines the BaseSystem for binary. This could be a BitwiseSystem, but we --- would have to support multiple character ABCs.Symbols; currently we can't --- do this, because it depends on Text.chunksOf 1 to tokenize the utf8 codes. -base2 :: RadixSystem -base2 = RadixSystem "base2" ABCs.binary - --- | Defines base10 as RadixSystem. -base10 :: RadixSystem -base10 = RadixSystem "base10" ABCs.decimal - --- | Defines Bitcoin's base58 implementation. Flickr apparently has one too. -base58btc :: RadixSystem -base58btc = RadixSystem "base58btc" ABCs.btc58 - --- | Defines uppercase hexidecimal on BitwiseSystem. Orignally, this was on --- RadixSystem, but I believe BitwiseSystem can become the more optimized --- implementation. Either works. -base16upper :: RadixSystem -base16upper = RadixSystem "base16upper" ABCs.hexupper - --- | Defines lowercase hexadecimal on BitwiseSystem. -base16lower :: RadixSystem -base16lower = RadixSystem "base16lower" ABCs.hexlower - --- | Defines lowercase base32 from RFC4648, with padding. --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6 -base32lower :: BitwiseSystem -base32lower = mkBaseSystem32 "base32lower" (Just '=') ABCs.b32lower - --- | Defines lowercase base32 from RFC4648. No padding! --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6 -base32lowerNP :: BitwiseSystem -base32lowerNP = mkBaseSystem32 "base32lowerNP" Nothing ABCs.b32lower - --- | Defines uppercase base32 from RFC4648, with padding. --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6 -base32upper :: BitwiseSystem -base32upper = mkBaseSystem32 "base32upper" (Just '=') ABCs.b32upper - --- | Defines uppercase base32 from RFC4648. No padding! --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-6 -base32upperNP :: BitwiseSystem -base32upperNP = mkBaseSystem32 "base32upperNP" Nothing ABCs.b32upper - --- | Defines lowercase base32 from RFC4648, extended hex version, with padding. --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7 -base32hexlower :: BitwiseSystem -base32hexlower = mkBaseSystem32 "base32hexlower" (Just '=') ABCs.b32hexlower - --- | Defines lowercase base32 from RFC4648, extended hex version. No padding! --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7 -base32hexlowerNP :: BitwiseSystem -base32hexlowerNP = mkBaseSystem32 "base32hexlowerNP" Nothing ABCs.b32hexlower - --- | Defines lowercase base32 from RFC4648, extended hex version, with padding. --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7 -base32hexupper :: BitwiseSystem -base32hexupper = mkBaseSystem32 "base32hexupper" (Just '=') ABCs.b32hexupper - --- | Defines uppercase base32 from RFC4648, extended hex version. No padding! --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-7 -base32hexupperNP :: BitwiseSystem -base32hexupperNP = mkBaseSystem32 "base32hexupperNP" Nothing ABCs.b32hexupper - --- | Defines base64 from RFC4648, with padding. --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-4 -base64 :: BitwiseSystem -base64 = mkBaseSystem64 "base64" (Just '=') ABCs.b64 - --- | Defines base64 from RFC4648. No padding! --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-4 -base64NP :: BitwiseSystem -base64NP = mkBaseSystem64 "base64NP" Nothing ABCs.b64 - --- | Defines URL safe base64 from RFC4648, with padding. --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-5 -base64url :: BitwiseSystem -base64url = mkBaseSystem64 "base64url" (Just '=') ABCs.b64url - --- | Defines URL safe base64 from RFC4648. No padding! --- https://datatracker.ietf.org/doc/html/rfc4648.html#section-5 -base64urlNP :: BitwiseSystem -base64urlNP = mkBaseSystem64 "base64urlNP" Nothing ABCs.b64url