base32 0.4 → 1.0

raw patch · 35 files changed

+4591/−1753 lines, 35 filesdep +primitivedep −random-bytestringdep ~basedep ~bytestringdep ~deepseqPVP ok

version bump matches the API change (PVP)

Dependencies added: primitive

Dependencies removed: random-bytestring

Dependency ranges changed: base, bytestring, deepseq, text, text-short

API changes (from Hackage documentation)

Files

• CHANGELOG.md +23/−0
• LICENSE +1/−1
• MIGRATION-1.0.md +95/−0
• README.md +89/−15
• base32.cabal +44/−18
• benchmarks/Base32Bench.hs +122/−89
• cbits/base32_simd.c +466/−0
• cbits/base32_simd.h +15/−0
• src/Data/Base32/Types.hs +113/−0
• src/Data/ByteString/Base32.hs +149/−81
• src/Data/ByteString/Base32/Hex.hs +145/−72
• src/Data/ByteString/Base32/Internal.hs +0/−120
• src/Data/ByteString/Base32/Internal/Head.hs +53/−4
• src/Data/ByteString/Base32/Internal/Loop.hs +187/−126
• src/Data/ByteString/Base32/Internal/SIMD.hs +153/−0
• src/Data/ByteString/Base32/Internal/Short.hs +237/−0
• src/Data/ByteString/Base32/Internal/Tables.hs +21/−0
• src/Data/ByteString/Base32/Internal/Tail.hs +17/−0
• src/Data/ByteString/Base32/Internal/Utils.hs +72/−0
• src/Data/ByteString/Lazy/Base32.hs +143/−99
• src/Data/ByteString/Lazy/Base32/Hex.hs +141/−98
• src/Data/ByteString/Short/Base32.hs +175/−81
• src/Data/ByteString/Short/Base32/Hex.hs +178/−82
• src/Data/Text/Encoding/Base32.hs +167/−103
• src/Data/Text/Encoding/Base32/Error.hs +7/−1
• src/Data/Text/Encoding/Base32/Hex.hs +163/−98
• src/Data/Text/Lazy/Encoding/Base32.hs +164/−106
• src/Data/Text/Lazy/Encoding/Base32/Hex.hs +163/−105
• src/Data/Text/Short/Encoding/Base32.hs +198/−123
• src/Data/Text/Short/Encoding/Base32/Hex.hs +194/−117
• test/Internal.hs +182/−90
• test/Main.hs +163/−124
• test/Regression.hs +270/−0
• test/simd-native.c +184/−0
• test/typecheck.sh +97/−0

@@ -1,5 +1,28 @@ # Revision history for base32 +## 1.0++This release introduces a typed encoding API with breaking signature changes.+See [MIGRATION-1.0.md](MIGRATION-1.0.md) for the changes from 0.4.++* Introduce alphabet- and padding-tagged `Base32` values in `Data.Base32.Types`.+  Encoders return wrapped values; typed decoders consume them. Checked decoders+  now use the `Untyped` suffix for consuming raw Base32 encoded bytes.++  Typed decoding uses unchecked scalar and SIMD loops, with streaming lazy decoding.+  `StdAlphabet` and `HexAlphabet` admit both padding forms in general typed decoders;+  padding-specific typed decoders require exact tags.++* Replace `isBase32`, `isValidBase32`, `isBase32Hex`, and `isValidBase32Hex` with+  `parseBase32Padded` and `parseBase32Unpadded` in all twelve APIs.+  Parsers preserve input, accept the decoder's existing case-insensitive alphabets,+  and check unused pad bits. Noncanonical pad bits are now rejected by decoders too. These were removed because they had no measurable downstream usage, and were of questionable utility.  +* Added an optional, default-off `simd` flag with NEON, SSSE3, and AVX2 prefixes+  and a portable scalar fallback, for both standard and extended-hex alphabets.+* Remove `Data.ByteString.Base32.Internal`; use `Internal.Head` for codec entry+  points and `Internal.Utils` for `validateLastNPads`. They were relics of older development. +* Support GHC 9.6–9.14; update copyright through 2026, CI, bounds, and benchmarks.+ ## 0.4  * Support for GHC 9.8

@@ -1,4 +1,4 @@-Copyright (c) 2020, Emily Pillmore+Copyright (c) 2020-2026, Emily Pillmore  All rights reserved. 

@@ -0,0 +1,95 @@+# Migrating from base32 0.4 to 1.0++## Encoded values carry their alphabet and padding++Encoding now produces type-tagged values that carry the alphabet and padding provenance +carried out by the encoding. You can extract these bytes or assert their provenance by importing `Data.Base32.Types` and manipulating the wrapper through the supplied functions. `Alphabet(..)` is also included, and can be used in conjunction with `-XDataKinds` to assert what you need. Standard encoders return `Base32 'StdPadded a`+or `Base32 'StdUnpadded a`, while extended-hex encoders return `Base32 'HexPadded a` or+`Base32 'HexUnpadded a`. For example:++```haskell+-- Before+rawb32bytes = B32.encodeBase32' bytes++-- After, when the surrounding API expects a plain ByteString+rawb32bytes = extractBase32 (B32.encodeBase32' unencodedbytes)++-- A typed roundtrip no longer returns Either+unencodedBytesAgain = B32.decodeBase32 (B32.encodeBase32' unencodedbytes)+```++The reasoning behind this wrapper is clear from a performance perspective: by shoving the information about the bytes into the typed wrapper and shunting the contract to the user +or the program, we have all the info we need to forego validity checks during the decode +process. This removes most branching from the procedure and hotpath detection is both +faster and easier, resulting in a significant speedup. Go Haskell!++## Checked decoding keeps an explicit name++| 0.4 | 1.0 checked equivalent |+| --- | --- |+| `decodeBase32` | `decodeBase32Untyped` |+| `decodeBase32Padded` | `decodeBase32PaddedUntyped` |+| `decodeBase32Unpadded` | `decodeBase32UnpaddedUntyped` |++These replacements apply to all twelve ByteString/Text modules. The old names+now consume `Base32` values and return the decoded result directly. The+`decodeBase32With`, `decodeBase32PaddedWith`, and `decodeBase32UnpaddedWith`+functions keep their checked signatures and names, and are `Text` only, because +decoding is separate from utf8 conversion and errors are surfaced accordingly for each step.  ++Typed decoders use dedicated unchecked loops. They trust the established+provenance and do not check the alphabet, input length, padding, or unused bits.+`decodeBase32` accepts both padding forms within its alphabet through the+`StdAlphabet k` or `HexAlphabet k` constraint. The padding-specific decoders+require the corresponding exact tag, so mixing their API paths is a type error.+For example, `decodeBase32Padded (encodeBase32Unpadded' bytes)` cannot compile.+Use `TypeFamilies` when writing signatures with these constraints.+Callers using `assertBase32`, record updates, or mapping instances must preserve+validity themselves.++Typed lazy decoding streams through complete quanta. Checked lazy decoding and+parsing still validate a complete finite input.++## Replace predicates with parsers++`isBase32`, `isValidBase32`, `isBase32Hex`, and `isValidBase32Hex` are removed.+Use `parseBase32Padded` or `parseBase32Unpadded` from the corresponding standard+or `.Hex` module. Each returns the precise padding tag; there is no permissive+`parseBase32`. `Data.Either.isRight . parseBase32Padded` provides a Boolean check+for padded input when needed. Prefer retaining the successful parsed value:++```haskell+case B32.parseBase32Padded wire of+  Left err -> handleError err+  Right encoded -> consumeBytes (B32.decodeBase32 encoded)+```++Parsers return the original encoded representation, including case, padding,+and lazy chunk structure. Unlike the old shape predicates, they perform full+validation. The decoders' existing lowercase acceptance is preserved; encoders+produce uppercase. Inputs with nonzero unused bits, such as `MZ======`, are now+rejected instead of silently decoding as `f`.++## Text decoding and binary payloads++The wrapper establishes Base32 syntax, not the decoded payload's character+encoding. `parseBase32Padded (Text.pack "74======")` succeeds, since it encodes+byte `0xff`.+Checked Text decoding now reports invalid UTF-8 as `Left`, including short and+lazy Text. Typed Text decoding requires valid UTF-8 and fails otherwise. Use+ByteString decoding for binary data, or a `decode*With` function for explicit+character conversion.++## Build and compatibility++`Data.ByteString.Base32.Internal` is removed. Import codec entry points from+`Data.ByteString.Base32.Internal.Head` and `validateLastNPads` from+`Data.ByteString.Base32.Internal.Utils`.++The compiler range is GHC 9.6–9.14. Dependencies include `primitive` for direct+short byte-array codecs. SIMD is optional and remains disabled unless selected+with `-fsimd`; both modes use identical validation rules. The source archive+contains the bundled C sources, headers, tests, and this migration guide.++Update downstream libraries, including `base32-lens`, before widening their+bounds to accept 1.0.

@@ -3,25 +3,99 @@ ![Build Status](https://github.com/emilypi/base32/workflows/ci/badge.svg) [![Hackage](https://img.shields.io/hackage/v/base32.svg)](https://hackage.haskell.org/package/base32) -Padded and unpadded base32 and base32hex encoding and decoding for `Text` and `ByteString` values.+RFC 4648 standard and extended-hex Base32 encoding, with padded and unpadded+variants for strict, lazy, and short `ByteString` and `Text`. -For the companion optics and pattern synonyms, see [base32-lens](https://hackage.haskell.org/package/base32-lens).+```haskell+import Data.Base32.Types+import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Base32 as B32 -### Summary+encoded = B32.encodeBase32' (BS.pack "Sun")+-- encoded :: Base32 'StdPadded ByteString+-- extractBase32 encoded == BS.pack "KN2W4==="+-- B32.decodeBase32 encoded == BS.pack "Sun" -The following types are supported for both padded and unpadded std and extended hex alphabets:+parsed = B32.parseBase32Unpadded (BS.pack "KN2W4")+-- Right "KN2W4"; the original encoded representation is retained -- `Data.ByteString`-- `Data.ByteString.Lazy`-- `Data.ByteString.Short`-- `Data.Text`-- `Data.Text.Lazy`-- `Data.Text.Short`+raw = B32.decodeBase32Untyped (BS.pack "KN2W4")+-- Right "Sun"+``` -Additionally this library has+Use `.Hex` modules for the extended-hex alphabet. Values carry `'StdPadded`,+`'StdUnpadded`, `'HexPadded`, or `'HexUnpadded`, preventing accidental mixing of+alphabets or padding-specific APIs. See+[MIGRATION-1.0.md](MIGRATION-1.0.md) for the changes from 0.4. -- Better performance than `memory` for encode and decode 3-4x.-- Optics for handling more complex structures with Base32 representations via the `base32-lens` package-- Checks for both validity and correctness of Base32 and Base32hex encodings+## Validation -There are no dependencies aside from those bundled with GHC, `text-short`.+`parseBase32Padded` and `parseBase32Unpadded` establish the corresponding padding+tag. Both check the alphabet, input length, padding placement, and zero unused+trailing bits.+They accept upper- and lowercase letters, preserve the original case and+representation, and accept empty input. Whitespace is rejected.++Typed decoders use dedicated unchecked loops: provenance establishes validity,+so decoding does not repeat alphabet, length, padding, or canonical-bit checks.+`decodeBase32` uses the `StdAlphabet` or `HexAlphabet` constraint to accept both+padding forms of its alphabet. `decodeBase32Padded` and `decodeBase32Unpadded`+require their exact tags; calling them with the wrong padding form is a type error.++The wrapper identifies the alphabet; it does not prove that decoded bytes form UTF-8.+Checked Text decoders return `Left` for invalid UTF-8; `decodeBase32With` and+its variants let you choose a character conversion. For arbitrary binary+payloads, use ByteString decoders.++`assertBase32`, record updates, and the mapping instances+can bypass validation. Typed decoding requires a truthful encoded value and,+for Text, valid UTF-8 payload bytes. Use parsers and checked decoders for+external input.++Lazy encoding and typed decoding preserve streaming through rechunking.+Checked lazy decoding and parsing validate a complete finite input.++## Optional SIMD++```sh+cabal build -fsimd+cabal test -fsimd+```++The `simd` flag defaults to **off**. It enables bundled NEON kernels on AArch64+and runtime-dispatched SSSE3/AVX2 kernels on x86-64, with scalar fallback on+other targets. Small inputs and final quanta use Haskell scalar code. No+external native library is required.++Strict and short values use SIMD directly. Short codecs use byte arrays without+pinning; typed ShortText additionally converts the decoded UTF-8 payload. Lazy+variants reach the same kernels through their strict chunks or checked input.++## Development++```sh+cabal test -f-simd+cabal test -fsimd --ghc-options='-fcheck-prim-bounds -fno-ignore-asserts'+cabal exec -- sh test/typecheck.sh+cabal haddock -fsimd+cabal check+```++CI tests both flag configurations across GHC 9.6–9.14, builds from the source+archive, and runs native sanitizer and guard-page tests on x86-64 and ARM64.++Compare optimized scalar and SIMD benchmark builds separately:++```sh+cabal bench -f-simd --builddir=dist-scalar -O2 --benchmark-options='--csv scalar.csv'+cabal bench -fsimd --builddir=dist-simd -O2 --benchmark-options='--csv simd.csv'+```++Benchmark names identify the selected flag configuration. Both builds measure+the same deterministic inputs, with setup excluded from timing. The suite covers+strict and short codecs, both alphabets and padding forms, encoding, typed and+untyped decoding, parsing, sizes around dispatch thresholds, large buffers, and+sliced strict inputs.++The companion [base32-lens](https://hackage.haskell.org/package/base32-lens)+package needs an update for the 1.0 API before it can be used with this release.

@@ -1,10 +1,11 @@ cabal-version:      3.0 name:               base32-version:            0.4+version:            1.0 synopsis:           Fast RFC 4648-compliant Base32 encoding description:   RFC 4648-compliant Base32 encodings and decodings.-  This library provides performant encoding and decoding primitives, as well as support for textual values.+  This library provides performant encoding and decoding primitives,+  as well as support for textual values.  homepage:           https://github.com/emilypi/base32 bug-reports:        https://github.com/emilypi/base32/issues@@ -12,25 +13,36 @@ license-file:       LICENSE author:             Emily Pillmore maintainer:         emilypi@cohomolo.gy-copyright:          (c) 2020-2023 Emily Pillmore+copyright:          (c) 2020-2026 Emily Pillmore category:           Data build-type:         Simple-extra-source-files:+extra-doc-files:   CHANGELOG.md   README.md+  MIGRATION-1.0.md  tested-with:-  GHC ==9.0.2 || ==9.2.8 || ==9.4.7 || ==9.6.3 || ==9.8.1+  GHC ==9.6.7 || ==9.8.4 || ==9.10.3 || ==9.12.4 || ==9.14.1 +extra-source-files:+  cbits/base32_simd.h+  test/simd-native.c+  test/typecheck.sh++flag simd+  description:     Enable bundled SIMD kernels with portable scalar fallback+  default:         False+  manual:          True+ source-repository head   type:     git   location: https://github.com/emilypi/base32.git  library   exposed-modules:+    Data.Base32.Types     Data.ByteString.Base32     Data.ByteString.Base32.Hex-    Data.ByteString.Base32.Internal     Data.ByteString.Lazy.Base32     Data.ByteString.Lazy.Base32.Hex     Data.ByteString.Short.Base32@@ -43,37 +55,47 @@     Data.Text.Short.Encoding.Base32     Data.Text.Short.Encoding.Base32.Hex -  other-modules:+    Data.ByteString.Base32.Internal.Short     Data.ByteString.Base32.Internal.Head     Data.ByteString.Base32.Internal.Loop     Data.ByteString.Base32.Internal.Tables     Data.ByteString.Base32.Internal.Tail     Data.ByteString.Base32.Internal.Utils +  if flag(simd)+    exposed-modules: Data.ByteString.Base32.Internal.SIMD+    cpp-options:    -DBASE32_SIMD+    c-sources:      cbits/base32_simd.c+    include-dirs:   cbits+    cc-options:     -O2 -std=c99+   build-depends:-      base            >=4.15     && <4.20-    , bytestring     ^>=0.11+      base            >=4.18     && <4.23+    , bytestring      >=0.11     && <0.13     , deepseq         >=1.4.4.0  && <1.6-    , text            >=2.0      && <2.2+    , primitive       >=0.6      && <0.10+    , text            >=2.0      && <2.3     , text-short     ^>=0.1    hs-source-dirs:   src   default-language: Haskell2010   ghc-options:      -Wall -test-suite tasty+test-suite base32-tests   default-language: Haskell2010   type:             exitcode-stdio-1.0   hs-source-dirs:   test   other-modules:    Internal+                    Regression   main-is:          Main.hs+  ghc-options:      -Wall -threaded -rtsopts   build-depends:-      base               >=4.15 && <4.20+      base               >=4.18 && <4.23     , base32-    , bytestring        ^>=0.11+    , bytestring        >=0.11 && <0.13+    , deepseq     , memory     , QuickCheck-    , random-bytestring     , tasty     , tasty-hunit     , tasty-quickcheck@@ -86,11 +108,15 @@   hs-source-dirs:   benchmarks   main-is:          Base32Bench.hs   build-depends:-      base               >=4.15 && <4.20+      base               >=4.18 && <4.23     , base32-    , bytestring        ^>=0.11+    , bytestring        >=0.11 && <0.13     , criterion     , deepseq-    , memory-    , random-bytestring     , text              >=2.0+    , text-short++  if flag(simd)+    cpp-options:    -DBASE32_SIMD++  ghc-options:      -Wall -rtsopts

@@ -1,96 +1,129 @@-{-# LANGUAGE PackageImports #-}-module Main-( main-)where-+{-# LANGUAGE CPP #-}+-- |+-- Module       : Main+-- Copyright    : (c) 2020-2026 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- Build once with -f-simd and once with -fsimd to compare the same cases.+-- Sizes describe raw input bytes; sliced inputs also apply to decode buffers.+--+module Main (main) where -import Criterion import Criterion.Main--import "memory" Data.ByteArray.Encoding as Mem-import Data.ByteString-import "base32" Data.ByteString.Base32 as B32-import Data.ByteString.Random (random)-+import Data.Base32.Types (assertBase32, extractBase32)+import qualified Data.ByteString as B+import qualified Data.ByteString.Base32 as B32+import qualified Data.ByteString.Base32.Hex as H32+import qualified Data.ByteString.Short as S+import qualified Data.ByteString.Short.Base32 as S32+import qualified Data.ByteString.Short.Base32.Hex as SH32+import qualified Data.Text.Short as T+import qualified Data.Text.Short.Encoding.Base32 as T32  main :: IO ()-main =-  defaultMain-    [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) ->-      bgroup "encode"-      [ bgroup "25"-        [ bench "memory" $ whnf ctob bs25-        , bench "base32" $ whnf B32.encodeBase32' bs25-        ]-      , bgroup "100"-        [ bench "memory" $ whnf ctob bs100-        , bench "base32" $ whnf B32.encodeBase32' bs100-        ]-      , bgroup "1k"-        [ bench "memory" $ whnf ctob bs1k-        , bench "base32" $ whnf B32.encodeBase32' bs1k-        ]-      , bgroup "10k"-        [ bench "memory" $ whnf ctob bs10k-        , bench "base32" $ whnf B32.encodeBase32' bs10k-        ]-      , bgroup "100k"-        [ bench "memory" $ whnf ctob bs100k-        , bench "base32" $ whnf B32.encodeBase32' bs100k-        ]-      , bgroup "1mm"-        [ bench "memory" $ whnf ctob bs1mm-        , bench "base32" $ whnf B32.encodeBase32' bs1mm-        ]-      ]-    , env bs' $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) ->-      bgroup "decode"-      [ bgroup "25"-        [ bench "memory" $ whnf btoc bs25-        , bench "base32" $ whnf B32.decodeBase32 bs25-        ]-      , bgroup "100"-        [ bench "memory" $ whnf btoc bs100-        , bench "base32" $ whnf B32.decodeBase32 bs100-        ]-      , bgroup "1k"-        [ bench "memory" $ whnf btoc bs1k-        , bench "base32" $ whnf B32.decodeBase32 bs1k-        ]-      , bgroup "10k"-        [ bench "memory" $ whnf btoc bs10k-        , bench "base32" $ whnf B32.decodeBase32 bs10k-        ]-      , bgroup "100k"-        [ bench "memory" $ whnf btoc bs100k-        , bench "base32" $ whnf B32.decodeBase32 bs100k-        ]-      , bgroup "1mm"-        [ bench "memory" $ whnf btoc bs1mm-        , bench "base32" $ whnf B32.decodeBase32 bs1mm-        ]+main = defaultMain+  [ bgroup implementation+      [ bgroup (show size)+          [ bgroup "strict"+              [ env (inputs id size offset) $+                \ ~(raw, std, stdUnpadded, hex, hexUnpadded) ->+                  bgroup ("offset-" ++ show offset)+                    [ bgroup "standard-padded"+                        [ bench "encode" $ nf B32.encodeBase32' raw+                        , bench "decode-typed" $+                            nf (B32.decodeBase32Padded . assertBase32) std+                        , bench "decode-untyped" $ nf B32.decodeBase32PaddedUntyped std+                        , bench "parse" $ nf B32.parseBase32Padded std+                        ]+                    , bgroup "standard-unpadded"+                        [ bench "encode" $ nf B32.encodeBase32Unpadded' raw+                        , bench "decode-typed" $+                            nf (B32.decodeBase32Unpadded . assertBase32) stdUnpadded+                        , bench "decode-untyped" $+                            nf B32.decodeBase32UnpaddedUntyped stdUnpadded+                        , bench "parse" $ nf B32.parseBase32Unpadded stdUnpadded+                        ]+                    , bgroup "hex-padded"+                        [ bench "encode" $ nf H32.encodeBase32' raw+                        , bench "decode-typed" $+                            nf (H32.decodeBase32Padded . assertBase32) hex+                        , bench "decode-untyped" $ nf H32.decodeBase32PaddedUntyped hex+                        , bench "parse" $ nf H32.parseBase32Padded hex+                        ]+                    , bgroup "hex-unpadded"+                        [ bench "encode" $ nf H32.encodeBase32Unpadded' raw+                        , bench "decode-typed" $+                            nf (H32.decodeBase32Unpadded . assertBase32) hexUnpadded+                        , bench "decode-untyped" $+                            nf H32.decodeBase32UnpaddedUntyped hexUnpadded+                        , bench "parse" $ nf H32.parseBase32Unpadded hexUnpadded+                        ]+                    ]+              | offset <- [0, 1]+              ]+          , env (inputs S.toShort size 0) $+            \ ~(raw, std, stdUnpadded, hex, hexUnpadded) ->+              bgroup "short"+                [ bgroup "standard-padded"+                    [ bench "encode" $ nf S32.encodeBase32' raw+                    , bench "decode-typed" $+                        nf (S32.decodeBase32Padded . assertBase32) std+                    , bench "decode-untyped" $ nf S32.decodeBase32PaddedUntyped std+                    , bench "parse" $ nf S32.parseBase32Padded std+                    ]+                , bgroup "standard-unpadded"+                    [ bench "encode" $ nf S32.encodeBase32Unpadded' raw+                    , bench "decode-typed" $+                        nf (S32.decodeBase32Unpadded . assertBase32) stdUnpadded+                    , bench "decode-untyped" $+                        nf S32.decodeBase32UnpaddedUntyped stdUnpadded+                    , bench "parse" $ nf S32.parseBase32Unpadded stdUnpadded+                    ]+                , bgroup "hex-padded"+                    [ bench "encode" $ nf SH32.encodeBase32' raw+                    , bench "decode-typed" $+                        nf (SH32.decodeBase32Padded . assertBase32) hex+                    , bench "decode-untyped" $ nf SH32.decodeBase32PaddedUntyped hex+                    , bench "parse" $ nf SH32.parseBase32Padded hex+                    ]+                , bgroup "hex-unpadded"+                    [ bench "encode" $ nf SH32.encodeBase32Unpadded' raw+                    , bench "decode-typed" $+                        nf (SH32.decodeBase32Unpadded . assertBase32) hexUnpadded+                    , bench "decode-untyped" $+                        nf SH32.decodeBase32UnpaddedUntyped hexUnpadded+                    , bench "parse" $ nf SH32.parseBase32Unpadded hexUnpadded+                    ]+                ]+          ]+      | size <- [25, 39, 40, 41, 79, 80, 81, 4096, 1048576]       ]-    ]-  where-    ctob :: ByteString -> ByteString-    ctob = Mem.convertToBase Mem.Base32-    btoc :: ByteString -> Either String ByteString-    btoc = Mem.convertFromBase Mem.Base32+  , env (pure (T.pack "Base32 benchmark λ")) $ \shortText ->+      bgroup implementation [bench "short-text" $ nf T32.encodeBase32 shortText]+  ] -    bs = do-      a <- random 25-      b <- random 100-      c <- random 1000-      d <- random 10000-      e <- random 100000-      f <- random 1000000-      return (a,b,c,d,e,f)+implementation :: String+#ifdef BASE32_SIMD+implementation = "simd"+#else+implementation = "scalar"+#endif -    bs' = do-      a <- B32.encodeBase32' <$> random 25-      b <- B32.encodeBase32' <$> random 100-      c <- B32.encodeBase32' <$> random 1000-      d <- B32.encodeBase32' <$> random 10000-      e <- B32.encodeBase32' <$> random 100000-      f <- B32.encodeBase32' <$> random 1000000-      return (a,b,c,d,e,f)+-- Criterion forces this environment before timing. Both builds use the same+-- deterministic data; encoding, slicing, and conversion are excluded from timing.+inputs :: (B.ByteString -> a) -> Int -> Int -> IO (a, a, a, a, a)+inputs convert size offset = pure+  ( prepared raw+  , prepared (extractBase32 (B32.encodeBase32' raw))+  , prepared (extractBase32 (B32.encodeBase32Unpadded' raw))+  , prepared (extractBase32 (H32.encodeBase32' raw))+  , prepared (extractBase32 (H32.encodeBase32Unpadded' raw))+  )+  where+    raw = B.pack (take size (cycle [0 .. 255]))+    prepared bytes = convert . B.take (B.length bytes) . B.drop offset $+      B.replicate offset 0xe5 <> bytes <> B.replicate 32 0xff

@@ -0,0 +1,466 @@+/* Copyright (c) 2026 Emily Pillmore. BSD-3-Clause; see LICENSE. */+#include "base32_simd.h"+#include <string.h>++/* Each lane encodes ten bytes or decodes sixteen. All loads/stores are+ * bounded; invalid decode blocks are not committed. Target attributes keep+ * optional x86 instructions out of the baseline dispatcher. Force macros+ * only cap backend selection; they never bypass hardware/OS checks. */+#if !defined(HS_BASE32_SIMD_FORCE_SCALAR)+#if defined(__aarch64__) && defined(__ARM_NEON)+#define HS_BASE32_NEON+#include <arm_neon.h>+#elif defined(__x86_64__) && (defined(__GNUC__) || defined(__clang__))+#define HS_BASE32_X86+#include <immintrin.h>+#endif+#endif++#if defined(HS_BASE32_NEON) || defined(HS_BASE32_X86)+static const uint8_t enc_a[16] = {+    0, 0, 1, 1, 2, 3, 3, 4, 5, 5, 6, 6, 7, 8, 8, 9+};+static const uint8_t enc_b[16] = {+    255, 1, 255, 2, 3, 255, 4, 255, 255, 6, 255, 7, 8, 255, 9, 255+};+static const uint8_t dec_a[16] = {+    0, 1, 3, 4, 6, 8, 9, 11, 12, 14, 255, 255, 255, 255, 255, 255+};+static const uint8_t dec_b[16] = {+    1, 2, 4, 5, 7, 9, 10, 12, 13, 15, 255, 255, 255, 255, 255, 255+};+static const uint8_t dec_c[16] = {+    255, 3, 255, 6, 255, 255, 11, 255, 14, 255, 255, 255, 255, 255, 255, 255+};+#endif++#if defined(HS_BASE32_NEON)++static uint8x16_t load10(const uint8_t *src)+{+    uint8_t bytes[16] = {0};+    memcpy(bytes, src, 10);+    return vld1q_u8(bytes);+}++static void store10(uint8_t *dst, uint8x16_t value)+{+    uint8_t bytes[16];+    vst1q_u8(bytes, value);+    memcpy(dst, bytes, 10);+}++static size_t neon_encode(const uint8_t *src, size_t len, uint8_t *dst, int hex)+{+    static const int8_t shifts_a[16] = {+        -3,2,-1,4,1,-2,3,0, -3,2,-1,4,1,-2,3,0+    };+    static const int8_t shifts_b[16] = {+        0,-6,0,-4,-7,0,-5,0, 0,-6,0,-4,-7,0,-5,0+    };+    size_t done = 0;+    while (len - done >= 10) {+        const uint8x16_t input = load10(src + done);+        const uint8x16_t a = vqtbl1q_u8(input, vld1q_u8(enc_a));+        const uint8x16_t b = vqtbl1q_u8(input, vld1q_u8(enc_b));+        const uint8x16_t index = vandq_u8(vdupq_n_u8(31), vorrq_u8(+            vshlq_u8(a, vld1q_s8(shifts_a)), vshlq_u8(b, vld1q_s8(shifts_b))));+        const uint8x16_t high = vcgtq_u8(index, vdupq_n_u8(hex ? 9 : 25));+        const uint8x16_t offset = vbslq_u8(high,+            vdupq_n_u8(hex ? 55 : 24), vdupq_n_u8(hex ? 48 : 65));+        vst1q_u8(dst, vaddq_u8(index, offset));+        dst += 16;+        done += 10;+    }+    return done;+}++static size_t neon_decode(const uint8_t *src, size_t len, uint8_t *dst,+                         int hex, int checked)+{+    static const int8_t shifts_a[16] = {3,6,4,7,5,3,6,4,7,5,0,0,0,0,0,0};+    static const int8_t shifts_b[16] = {-2,1,-1,2,0,-2,1,-1,2,0,0,0,0,0,0,0};+    static const int8_t shifts_c[16] = {0,-4,0,-3,0,0,-4,0,-3,0,0,0,0,0,0,0};+    size_t done = 0;+    while (len - done >= 16) {+        const uint8x16_t input = vld1q_u8(src + done);+        const uint8x16_t upper = vandq_u8(input, vdupq_n_u8(0xdf));+        const uint8x16_t letter = vsubq_u8(upper, vdupq_n_u8('A'));+        const uint8x16_t digit = vsubq_u8(input, vdupq_n_u8(hex ? '0' : '2'));+        const uint8x16_t is_letter = vcleq_u8(letter, vdupq_n_u8(hex ? 21 : 25));+        const uint8x16_t is_digit = vcleq_u8(digit, vdupq_n_u8(hex ? 9 : 5));+        if (checked && vminvq_u8(vorrq_u8(is_letter, is_digit)) == 0) {+            break;+        }+        const uint8x16_t value = vbslq_u8(is_letter,+            vaddq_u8(letter, vdupq_n_u8(hex ? 10 : 0)),+            vaddq_u8(digit, vdupq_n_u8(hex ? 0 : 26)));+        const uint8x16_t a = vqtbl1q_u8(value, vld1q_u8(dec_a));+        const uint8x16_t b = vqtbl1q_u8(value, vld1q_u8(dec_b));+        const uint8x16_t c = vqtbl1q_u8(value, vld1q_u8(dec_c));+        store10(dst, vorrq_u8(vshlq_u8(a, vld1q_s8(shifts_a)),+            vorrq_u8(vshlq_u8(b, vld1q_s8(shifts_b)),+                     vshlq_u8(c, vld1q_s8(shifts_c)))));+        dst += 10;+        done += 16;+    }+    return done;+}+#elif defined(HS_BASE32_X86)++__attribute__((target("ssse3")))+static __m128i ssse3_mask(const uint8_t *bytes)+{+    const __m128i value = _mm_loadu_si128((const __m128i *)bytes);+    return value;+}++__attribute__((target("ssse3")))+static size_t ssse3_encode(const uint8_t *src, size_t len, uint8_t *dst, int hex)+{+    size_t done = 0;+    while (len - done >= 10) {+        uint8_t bytes[16] = {0};+        memcpy(bytes + 0, src + done + 0, 10);+        const __m128i value = _mm_loadu_si128((const __m128i *)bytes);+        __m128i output = _mm_setzero_si128();+        const __m128i a = _mm_shuffle_epi8(value, ssse3_mask(enc_a));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(a, 3),+            ssse3_mask((const uint8_t[16]){31,0,0,0,0,0,0,0,31,0,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(a, 2),+            ssse3_mask((const uint8_t[16]){0,0,0,0,0,31,0,0,0,0,0,0,0,31,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(a, 1),+            ssse3_mask((const uint8_t[16]){0,0,31,0,0,0,0,0,0,0,31,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            a,+            ssse3_mask((const uint8_t[16]){0,0,0,0,0,0,0,31,0,0,0,0,0,0,0,31})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(a, 1),+            ssse3_mask((const uint8_t[16]){0,0,0,0,30,0,0,0,0,0,0,0,30,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(a, 2),+            ssse3_mask((const uint8_t[16]){0,28,0,0,0,0,0,0,0,28,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(a, 3),+            ssse3_mask((const uint8_t[16]){0,0,0,0,0,0,24,0,0,0,0,0,0,0,24,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(a, 4),+            ssse3_mask((const uint8_t[16]){0,0,0,16,0,0,0,0,0,0,0,16,0,0,0,0})));+        const __m128i b = _mm_shuffle_epi8(value, ssse3_mask(enc_b));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(b, 7),+            ssse3_mask((const uint8_t[16]){0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(b, 6),+            ssse3_mask((const uint8_t[16]){0,3,0,0,0,0,0,0,0,3,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(b, 5),+            ssse3_mask((const uint8_t[16]){0,0,0,0,0,0,7,0,0,0,0,0,0,0,7,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(b, 4),+            ssse3_mask((const uint8_t[16]){0,0,0,15,0,0,0,0,0,0,0,15,0,0,0,0})));+        const __m128i high = _mm_cmpgt_epi8(output, _mm_set1_epi8(hex ? 9 : 25));+        const __m128i offset = _mm_or_si128(+            _mm_and_si128(high, _mm_set1_epi8(hex ? 55 : 24)),+            _mm_andnot_si128(high, _mm_set1_epi8(hex ? 48 : 65)));+        _mm_storeu_si128((__m128i *)dst, _mm_add_epi8(output, offset));+        dst += 16;+        done += 10;+    }+    return done;+}++__attribute__((target("ssse3")))+static size_t ssse3_decode(const uint8_t *src, size_t len, uint8_t *dst,+                          int hex, int checked)+{+    size_t done = 0;+    while (len - done >= 16) {+        const __m128i input = _mm_loadu_si128((const __m128i *)(src + done));+        const __m128i upper = _mm_and_si128(input, _mm_set1_epi8((char)0xdf));+        const __m128i letters = _mm_and_si128(+            _mm_cmpgt_epi8(upper, _mm_set1_epi8('A' - 1)),+            _mm_cmpgt_epi8(_mm_set1_epi8(hex ? 'V' + 1 : 'Z' + 1), upper));+        const __m128i digits = _mm_and_si128(+            _mm_cmpgt_epi8(input, _mm_set1_epi8(hex ? '0' - 1 : '2' - 1)),+            _mm_cmpgt_epi8(_mm_set1_epi8(hex ? '9' + 1 : '7' + 1), input));+        if (checked && (unsigned)_mm_movemask_epi8(_mm_or_si128(letters, digits))+            != 0xffffU) {+            break;+        }+        const __m128i value = _mm_or_si128(+            _mm_and_si128(letters,+                _mm_add_epi8(upper, _mm_set1_epi8(hex ? 10 - 'A' : -'A'))),+            _mm_and_si128(digits,+                _mm_add_epi8(input, _mm_set1_epi8(hex ? -'0' : 26 - '2'))));+        __m128i output = _mm_setzero_si128();+        const __m128i a = _mm_shuffle_epi8(value, ssse3_mask(dec_a));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(a, 3),+            ssse3_mask((const uint8_t[16]){248,0,0,0,0,248,0,0,0,0,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(a, 4),+            ssse3_mask((const uint8_t[16]){0,0,240,0,0,0,0,240,0,0,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(a, 5),+            ssse3_mask((const uint8_t[16]){0,0,0,0,224,0,0,0,0,224,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(a, 6),+            ssse3_mask((const uint8_t[16]){0,192,0,0,0,0,192,0,0,0,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(a, 7),+            ssse3_mask((const uint8_t[16]){0,0,0,128,0,0,0,0,128,0,0,0,0,0,0,0})));+        const __m128i b = _mm_shuffle_epi8(value, ssse3_mask(dec_b));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(b, 2),+            ssse3_mask((const uint8_t[16]){7,0,0,0,0,7,0,0,0,0,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(b, 1),+            ssse3_mask((const uint8_t[16]){0,0,15,0,0,0,0,15,0,0,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            b,+            ssse3_mask((const uint8_t[16]){0,0,0,0,31,0,0,0,0,31,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(b, 1),+            ssse3_mask((const uint8_t[16]){0,62,0,0,0,0,62,0,0,0,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_slli_epi16(b, 2),+            ssse3_mask((const uint8_t[16]){0,0,0,124,0,0,0,0,124,0,0,0,0,0,0,0})));+        const __m128i c = _mm_shuffle_epi8(value, ssse3_mask(dec_c));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(c, 4),+            ssse3_mask((const uint8_t[16]){0,15,0,0,0,0,15,0,0,0,0,0,0,0,0,0})));+        output = _mm_or_si128(output, _mm_and_si128(+            _mm_srli_epi16(c, 3),+            ssse3_mask((const uint8_t[16]){0,0,0,7,0,0,0,0,7,0,0,0,0,0,0,0})));+        uint8_t bytes[16];+        _mm_storeu_si128((__m128i *)bytes, output);+        memcpy(dst + 0, bytes + 0, 10);+        dst += 10;+        done += 16;+    }+    return done;+}++__attribute__((target("avx2")))+static __m256i avx2_mask(const uint8_t *bytes)+{+    const __m128i value = _mm_loadu_si128((const __m128i *)bytes);+    return _mm256_broadcastsi128_si256(value);+}++__attribute__((target("avx2")))+static size_t avx2_encode(const uint8_t *src, size_t len, uint8_t *dst, int hex)+{+    size_t done = 0;+    while (len - done >= 20) {+        uint8_t bytes[32] = {0};+        memcpy(bytes + 0, src + done + 0, 10);+        memcpy(bytes + 16, src + done + 10, 10);+        const __m256i value = _mm256_loadu_si256((const __m256i *)bytes);+        __m256i output = _mm256_setzero_si256();+        const __m256i a = _mm256_shuffle_epi8(value, avx2_mask(enc_a));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(a, 3),+            avx2_mask((const uint8_t[16]){31,0,0,0,0,0,0,0,31,0,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(a, 2),+            avx2_mask((const uint8_t[16]){0,0,0,0,0,31,0,0,0,0,0,0,0,31,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(a, 1),+            avx2_mask((const uint8_t[16]){0,0,31,0,0,0,0,0,0,0,31,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            a,+            avx2_mask((const uint8_t[16]){0,0,0,0,0,0,0,31,0,0,0,0,0,0,0,31})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(a, 1),+            avx2_mask((const uint8_t[16]){0,0,0,0,30,0,0,0,0,0,0,0,30,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(a, 2),+            avx2_mask((const uint8_t[16]){0,28,0,0,0,0,0,0,0,28,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(a, 3),+            avx2_mask((const uint8_t[16]){0,0,0,0,0,0,24,0,0,0,0,0,0,0,24,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(a, 4),+            avx2_mask((const uint8_t[16]){0,0,0,16,0,0,0,0,0,0,0,16,0,0,0,0})));+        const __m256i b = _mm256_shuffle_epi8(value, avx2_mask(enc_b));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(b, 7),+            avx2_mask((const uint8_t[16]){0,0,0,0,1,0,0,0,0,0,0,0,1,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(b, 6),+            avx2_mask((const uint8_t[16]){0,3,0,0,0,0,0,0,0,3,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(b, 5),+            avx2_mask((const uint8_t[16]){0,0,0,0,0,0,7,0,0,0,0,0,0,0,7,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(b, 4),+            avx2_mask((const uint8_t[16]){0,0,0,15,0,0,0,0,0,0,0,15,0,0,0,0})));+        const __m256i high = _mm256_cmpgt_epi8(output, _mm256_set1_epi8(hex ? 9 : 25));+        const __m256i offset = _mm256_or_si256(+            _mm256_and_si256(high, _mm256_set1_epi8(hex ? 55 : 24)),+            _mm256_andnot_si256(high, _mm256_set1_epi8(hex ? 48 : 65)));+        _mm256_storeu_si256((__m256i *)dst, _mm256_add_epi8(output, offset));+        dst += 32;+        done += 20;+    }+    return done;+}++__attribute__((target("avx2")))+static size_t avx2_decode(const uint8_t *src, size_t len, uint8_t *dst,+                          int hex, int checked)+{+    size_t done = 0;+    while (len - done >= 32) {+        const __m256i input = _mm256_loadu_si256((const __m256i *)(src + done));+        const __m256i upper = _mm256_and_si256(input, _mm256_set1_epi8((char)0xdf));+        const __m256i letters = _mm256_and_si256(+            _mm256_cmpgt_epi8(upper, _mm256_set1_epi8('A' - 1)),+            _mm256_cmpgt_epi8(_mm256_set1_epi8(hex ? 'V' + 1 : 'Z' + 1), upper));+        const __m256i digits = _mm256_and_si256(+            _mm256_cmpgt_epi8(input, _mm256_set1_epi8(hex ? '0' - 1 : '2' - 1)),+            _mm256_cmpgt_epi8(_mm256_set1_epi8(hex ? '9' + 1 : '7' + 1), input));+        if (checked && (unsigned)_mm256_movemask_epi8(_mm256_or_si256(letters, digits))+            != 0xffffffffU) {+            break;+        }+        const __m256i value = _mm256_or_si256(+            _mm256_and_si256(letters,+                _mm256_add_epi8(upper, _mm256_set1_epi8(hex ? 10 - 'A' : -'A'))),+            _mm256_and_si256(digits,+                _mm256_add_epi8(input, _mm256_set1_epi8(hex ? -'0' : 26 - '2'))));+        __m256i output = _mm256_setzero_si256();+        const __m256i a = _mm256_shuffle_epi8(value, avx2_mask(dec_a));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(a, 3),+            avx2_mask((const uint8_t[16]){248,0,0,0,0,248,0,0,0,0,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(a, 4),+            avx2_mask((const uint8_t[16]){0,0,240,0,0,0,0,240,0,0,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(a, 5),+            avx2_mask((const uint8_t[16]){0,0,0,0,224,0,0,0,0,224,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(a, 6),+            avx2_mask((const uint8_t[16]){0,192,0,0,0,0,192,0,0,0,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(a, 7),+            avx2_mask((const uint8_t[16]){0,0,0,128,0,0,0,0,128,0,0,0,0,0,0,0})));+        const __m256i b = _mm256_shuffle_epi8(value, avx2_mask(dec_b));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(b, 2),+            avx2_mask((const uint8_t[16]){7,0,0,0,0,7,0,0,0,0,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(b, 1),+            avx2_mask((const uint8_t[16]){0,0,15,0,0,0,0,15,0,0,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            b,+            avx2_mask((const uint8_t[16]){0,0,0,0,31,0,0,0,0,31,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(b, 1),+            avx2_mask((const uint8_t[16]){0,62,0,0,0,0,62,0,0,0,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_slli_epi16(b, 2),+            avx2_mask((const uint8_t[16]){0,0,0,124,0,0,0,0,124,0,0,0,0,0,0,0})));+        const __m256i c = _mm256_shuffle_epi8(value, avx2_mask(dec_c));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(c, 4),+            avx2_mask((const uint8_t[16]){0,15,0,0,0,0,15,0,0,0,0,0,0,0,0,0})));+        output = _mm256_or_si256(output, _mm256_and_si256(+            _mm256_srli_epi16(c, 3),+            avx2_mask((const uint8_t[16]){0,0,0,7,0,0,0,0,7,0,0,0,0,0,0,0})));+        uint8_t bytes[32];+        _mm256_storeu_si256((__m256i *)bytes, output);+        memcpy(dst + 0, bytes + 0, 10);+        memcpy(dst + 10, bytes + 16, 10);+        dst += 20;+        done += 32;+    }+    return done;+}++#endif++int hs_base32_simd_backend(void)+{+#if defined(HS_BASE32_NEON)+    return 2;+#elif defined(HS_BASE32_X86)+#if !defined(HS_BASE32_SIMD_FORCE_SSSE3)+    /* Compiler CPU queries include OS support for AVX register state. */+    if (__builtin_cpu_supports("avx2")) {+        return 3;+    }+#endif+    return __builtin_cpu_supports("ssse3") ? 1 : 0;+#else+    return 0;+#endif+}++size_t hs_base32_simd_encode(const uint8_t *src, size_t len, uint8_t *dst, int hex)+{+#if defined(HS_BASE32_NEON)+    return neon_encode(src, len, dst, hex);+#elif defined(HS_BASE32_X86)+    const int backend = hs_base32_simd_backend();+    if (backend == 3) {+        return avx2_encode(src, len, dst, hex);+    }+    if (backend == 1) {+        return ssse3_encode(src, len, dst, hex);+    }+#endif+    (void)src;+    (void)len;+    (void)dst;+    (void)hex;+    return 0;+}++size_t hs_base32_simd_decode(const uint8_t *src, size_t len, uint8_t *dst, int hex)+{+#if defined(HS_BASE32_NEON)+    return neon_decode(src, len, dst, hex, 1);+#elif defined(HS_BASE32_X86)+    const int backend = hs_base32_simd_backend();+    if (backend == 3) {+        return avx2_decode(src, len, dst, hex, 1);+    }+    if (backend == 1) {+        return ssse3_decode(src, len, dst, hex, 1);+    }+#endif+    (void)src;+    (void)len;+    (void)dst;+    (void)hex;+    return 0;+}++/* Typed callers establish validity before entering these loops. */+size_t hs_base32_simd_decode_typed(const uint8_t *src, size_t len,+                                  uint8_t *dst, int hex)+{+#if defined(HS_BASE32_NEON)+    return neon_decode(src, len, dst, hex, 0);+#elif defined(HS_BASE32_X86)+    const int backend = hs_base32_simd_backend();+    if (backend == 3) {+        return avx2_decode(src, len, dst, hex, 0);+    }+    if (backend == 1) {+        return ssse3_decode(src, len, dst, hex, 0);+    }+#endif+    (void)src;+    (void)len;+    (void)dst;+    (void)hex;+    return 0;+}

@@ -0,0 +1,15 @@+/* Copyright (c) 2026 Emily Pillmore. BSD-3-Clause; see LICENSE. */+#ifndef HS_BASE32_SIMD_H+#define HS_BASE32_SIMD_H+#include <stddef.h>+#include <stdint.h>+/* Backends: 0 scalar fallback, 1 SSSE3, 2 NEON, 3 AVX2. */+int hs_base32_simd_backend(void);+/* Return consumed input bytes. No tail, padding, or invalid block is written.+ * Source and destination must be distinct, nonoverlapping buffers; destination+ * capacities are len/5*8 (encode) and len/8*5 (decode). hex is 0 or 1. */+size_t hs_base32_simd_encode(const uint8_t *, size_t, uint8_t *, int hex);+size_t hs_base32_simd_decode(const uint8_t *, size_t, uint8_t *, int hex);+/* Known-valid symbols only, with trailing padding excluded. No validation. */+size_t hs_base32_simd_decode_typed(const uint8_t *, size_t, uint8_t *, int hex);+#endif

@@ -0,0 +1,113 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE ExplicitForAll #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE RoleAnnotations #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE Trustworthy #-}+-- |+-- Module       : Data.Base32.Types+-- Copyright    : (c) 2026 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable+--+-- Encoded values tagged with their alphabet and padding policy.+--+-- @since 1.0+--+module Data.Base32.Types+  ( Alphabet (..)+  , StdAlphabet+  , HexAlphabet+  , Base32+  , extractBase32+  , assertBase32+  ) where++import Control.DeepSeq (NFData)+import Data.Functor.Identity (Identity (..))+import Data.Kind (Constraint)+import GHC.TypeLits (ErrorMessage (..), TypeError)++-- | The alphabets and padding forms from RFC 4648 sections 6 and 7.+--+-- @since 1.0+--+data Alphabet = StdPadded | StdUnpadded | HexPadded | HexUnpadded+  deriving+    ( Eq   -- ^ @since 1.0+    , Ord  -- ^ @since 1.0+    , Show -- ^ @since 1.0+    )++-- | Padded and unpadded forms of the standard alphabet.+--+-- @since 1.0+--+type family StdAlphabet (k :: Alphabet) :: Constraint where+  StdAlphabet 'StdPadded = ()+  StdAlphabet 'StdUnpadded = ()+  StdAlphabet _ = TypeError+    ( 'Text "Cannot prove base32 value is encoded using the standard alphabet. "+      ':<>: 'Text "Use the standard encoders or padding-specific parsers."+    )++-- | Padded and unpadded forms of the extended-hex alphabet.+--+-- >>> let hex :: HexAlphabet k => Base32 k a -> a; hex = extractBase32+-- >>> hex (assertBase32 @'HexPadded "ADQMS===")+-- "ADQMS==="+-- >>> hex (assertBase32 @'HexUnpadded "ADQMS")+-- "ADQMS"+--+-- @since 1.0+--+type family HexAlphabet (k :: Alphabet) :: Constraint where+  HexAlphabet 'HexPadded = ()+  HexAlphabet 'HexUnpadded = ()+  HexAlphabet _ = TypeError+    ( 'Text "Cannot prove base32 value is encoded using the extended-hex alphabet. "+      ':<>: 'Text "Use the hex encoders or padding-specific parsers."+    )++-- | A value encoded with the given alphabet and padding. Encoding and parsing establish+-- this provenance. 'assertBase32', record updates, and the derived mapping+-- instances do not validate their results.+--+-- @since 1.0+--+type role Base32 nominal representational+newtype Base32 (alphabet :: Alphabet) a = Base32+  { extractBase32 :: a+    -- ^ Extract the encoded representation without decoding it.+    --+    -- @since 1.0+  }+  deriving+    ( Eq     -- ^ @since 1.0+    , Ord    -- ^ @since 1.0+    , Show   -- ^ @since 1.0+    , NFData -- ^ @since 1.0+    ) via a+  deriving+    ( Functor     -- ^ @since 1.0+    , Applicative -- ^ @since 1.0+    , Monad       -- ^ @since 1.0+    ) via Identity++-- | Assert that a value is Base32-encoded.  +--+-- @since 1.0+--+assertBase32 :: forall alphabet a. a -> Base32 alphabet a+assertBase32 = Base32+{-# INLINE assertBase32 #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> :seti -XDataKinds -XTypeApplications -XTypeFamilies -XFlexibleContexts

@@ -1,10 +1,11 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Base32--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -23,22 +24,27 @@ , encodeBase32Unpadded , encodeBase32Unpadded'   -- * Decoding+, decodeBase32Untyped+, decodeBase32UnpaddedUntyped+, decodeBase32PaddedUntyped+  -- * Validation , decodeBase32-, decodeBase32Unpadded , decodeBase32Padded--- , decodeBase32Lenient-  -- * Validation-, isBase32-, isValidBase32+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  +import Data.Base32.Types+ import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString(..))-import Data.ByteString.Base32.Internal+import Data.ByteString.Base32.Internal.Head import Data.ByteString.Base32.Internal.Tables-import Data.Either (isRight)+import Data.ByteString.Base32.Internal.Utils (validateLastNPads) import Data.Text (Text)+import qualified Data.Text as Text import qualified Data.Text.Encoding as T  import System.IO.Unsafe (unsafeDupablePerformIO)@@ -53,8 +59,10 @@ -- >>> encodeBase32 "Sun" -- "KN2W4===" ---encodeBase32 :: ByteString -> Text-encodeBase32 = T.decodeUtf8 . encodeBase32'+-- @since 1.0+--+encodeBase32 :: ByteString -> Base32 'StdPadded Text+encodeBase32 = fmap T.decodeUtf8 . encodeBase32' {-# INLINE encodeBase32 #-}  -- | Encode a 'ByteString' value as a Base32 'ByteString' value with padding.@@ -66,8 +74,10 @@ -- >>> encodeBase32' "Sun" -- "KN2W4===" ---encodeBase32' :: ByteString -> ByteString-encodeBase32' = encodeBase32_ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"#+-- @since 1.0+--+encodeBase32' :: ByteString -> Base32 'StdPadded ByteString+encodeBase32' = assertBase32 . encodeBase32_ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"# {-# INLINE encodeBase32' #-}  -- | Decode an arbitrarily padded Base32-encoded 'ByteString' value. If its length@@ -79,27 +89,33 @@ -- -- === __Examples__: ----- >>> decodeBase32 "KN2W4==="+-- >>> decodeBase32Untyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32 "KN2W4"+-- >>> decodeBase32Untyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32 "KN2W==="+-- >>> decodeBase32Untyped "KN2W===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: ByteString -> Either Text ByteString-decodeBase32 bs@(BS _ !l)+-- @since 1.0+--+decodeBase32Untyped :: ByteString -> Either Text ByteString+decodeBase32Untyped bs@(BS _ !l)     | l == 0 = Right bs     | r == 0 = unsafeDupablePerformIO $ decodeBase32_ stdDecodeTable bs-    | r == 2 = unsafeDupablePerformIO $ decodeBase32_ stdDecodeTable (BS.append bs "======")-    | r == 4 = validateLastNPads 2 bs $ decodeBase32_ stdDecodeTable (BS.append bs "====")-    | r == 5 = validateLastNPads 3 bs $ decodeBase32_ stdDecodeTable (BS.append bs "===")-    | r == 7 = validateLastNPads 5 bs $ decodeBase32_ stdDecodeTable (BS.append bs "=")-    | otherwise = Left "Base32-encoded bytestring has invalid size"+    | r == 2 = unsafeDupablePerformIO $+        decodeBase32_ stdDecodeTable (BS.append bs (BS.replicate 6 0x3d))+    | r == 4 = validateLastNPads 2 bs $+        decodeBase32_ stdDecodeTable (BS.append bs (BS.replicate 4 0x3d))+    | r == 5 = validateLastNPads 3 bs $+        decodeBase32_ stdDecodeTable (BS.append bs (BS.replicate 3 0x3d))+    | r == 7 = validateLastNPads 5 bs $+        decodeBase32_ stdDecodeTable (BS.append bs (BS.replicate 1 0x3d))+    | otherwise = Left (Text.pack "Base32-encoded bytestring has invalid size")   where     !r = l `rem` 8-{-# INLINE decodeBase32 #-}+{-# INLINE decodeBase32Untyped #-}  -- | Encode a 'ByteString' value as a Base32 'Text' value without padding. --@@ -110,8 +126,10 @@ -- >>> encodeBase32Unpadded "Sun" -- "KN2W4" ---encodeBase32Unpadded :: ByteString -> Text-encodeBase32Unpadded = T.decodeUtf8 . encodeBase32Unpadded'+-- @since 1.0+--+encodeBase32Unpadded :: ByteString -> Base32 'StdUnpadded Text+encodeBase32Unpadded = fmap T.decodeUtf8 . encodeBase32Unpadded' {-# INLINE encodeBase32Unpadded #-}  -- | Encode a 'ByteString' value as a Base32 'ByteString' value without padding.@@ -123,8 +141,11 @@ -- >>> encodeBase32Unpadded' "Sun" -- "KN2W4" ---encodeBase32Unpadded' :: ByteString -> ByteString-encodeBase32Unpadded' = encodeBase32NoPad_ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"#+-- @since 1.0+--+encodeBase32Unpadded' :: ByteString -> Base32 'StdUnpadded ByteString+encodeBase32Unpadded' = assertBase32+  . encodeBase32NoPad_ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"# {-# INLINE encodeBase32Unpadded' #-}  -- | Decode an unpadded Base32-encoded 'ByteString' value.@@ -133,24 +154,30 @@ -- -- === __Examples__: ----- >>> decodeBase32Unpadded "KN2W4"+-- >>> decodeBase32UnpaddedUntyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32Unpadded "KN2W4==="+-- >>> decodeBase32UnpaddedUntyped "KN2W4===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: ByteString -> Either Text ByteString-decodeBase32Unpadded bs@(BS _ !l)+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: ByteString -> Either Text ByteString+decodeBase32UnpaddedUntyped bs@(BS _ !l)     | l == 0 = Right bs     | r == 0 = validateLastNPads 1 bs $ decodeBase32_ stdDecodeTable bs-    | r == 2 = unsafeDupablePerformIO $ decodeBase32_ stdDecodeTable (BS.append bs "======")-    | r == 4 = validateLastNPads 1 bs $ decodeBase32_ stdDecodeTable (BS.append bs "====")-    | r == 5 = validateLastNPads 1 bs $ decodeBase32_ stdDecodeTable (BS.append bs "===")-    | r == 7 = validateLastNPads 1 bs $ decodeBase32_ stdDecodeTable (BS.append bs "=")-    | otherwise = Left "Base32-encoded bytestring has invalid size"+    | r == 2 = unsafeDupablePerformIO $+        decodeBase32_ stdDecodeTable (BS.append bs (BS.replicate 6 0x3d))+    | r == 4 = validateLastNPads 1 bs $+        decodeBase32_ stdDecodeTable (BS.append bs (BS.replicate 4 0x3d))+    | r == 5 = validateLastNPads 1 bs $+        decodeBase32_ stdDecodeTable (BS.append bs (BS.replicate 3 0x3d))+    | r == 7 = validateLastNPads 1 bs $+        decodeBase32_ stdDecodeTable (BS.append bs (BS.replicate 1 0x3d))+    | otherwise = Left (Text.pack "Base32-encoded bytestring has invalid size")   where     !r = l `rem` 8-{-# INLINE decodeBase32Unpadded #-}+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Decode a padded Base32-encoded 'ByteString' value. --@@ -158,68 +185,109 @@ -- -- === __Examples__: ----- >>> decodeBase32Padded "KN2W4==="+-- >>> decodeBase32PaddedUntyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32Padded "KN2W4"+-- >>> decodeBase32PaddedUntyped "KN2W4" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: ByteString -> Either Text ByteString-decodeBase32Padded bs@(BS _ !l)+-- @since 1.0+--+decodeBase32PaddedUntyped :: ByteString -> Either Text ByteString+decodeBase32PaddedUntyped bs@(BS _ !l)     | l == 0 = Right bs-    | r == 1 = Left "Base32-encoded bytestring has invalid size"-    | r == 3 = Left "Base32-encoded bytestring has invalid size"-    | r == 6 = Left "Base32-encoded bytestring has invalid size"-    | r /= 0 = Left "Base32-encoded bytestring requires padding"+    | r == 1 = Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r == 3 = Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r == 6 = Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r /= 0 = Left (Text.pack "Base32-encoded bytestring requires padding")     | otherwise = unsafeDupablePerformIO $ decodeBase32_ stdDecodeTable bs   where     !r = l `rem` 8-{-# INLINE decodeBase32Padded #-}+{-# INLINE decodeBase32PaddedUntyped #-} --- -- | Leniently decode an unpadded Base32-encoded 'ByteString' value. This function--- -- will not generate parse errors. If input data contains padding chars,--- -- then the input will be parsed up until the first pad character.--- ----- -- __Note:__ This is not RFC 4648-compliant.--- ----- decodeBase32Lenient :: ByteString -> ByteString--- decodeBase32Lenient = decodeBase32Lenient_ decodeB32Table--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32-encoded 'ByteString' value.+--+-- This function is padding-agnostic.+--+-- >>> decodeBase32 (encodeBase32' "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded' "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: StdAlphabet k => Base32 k ByteString -> ByteString+decodeBase32 = decodeBase32Typed_ stdDecodeTable+{-# INLINE decodeBase32 #-} --- | Tell whether a 'ByteString' value is encoded in padded or unpadded Base32 format+-- | Decode a typed, padded Base32-encoded 'ByteString' value. ----- === __Examples__:+-- >>> decodeBase32Padded (encodeBase32' "Sun")+-- "Sun" ----- >>> isBase32 "KN2W4"--- True+-- @since 1.0 ----- >>> isBase32 "KN2W4==="--- True+decodeBase32Padded :: Base32 'StdPadded ByteString -> ByteString+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32-encoded value, assuming that it has padding. ----- >>> isBase32 "KN2W4=="--- False+-- >>> parseBase32Padded "kn2w4==="+-- Right "kn2w4===" ---isBase32 :: ByteString -> Bool-isBase32 bs = isValidBase32 bs && isRight (decodeBase32 bs)-{-# INLINE isBase32 #-}+-- >>> fmap decodeBase32Padded (parseBase32Padded "KN2W4===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: ByteString -> Either Text (Base32 'StdPadded ByteString)+parseBase32Padded value = assertBase32 value+  <$ (decodeBase32PaddedUntyped) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'ByteString' value is a valid Base32 format.+-- | Decode a typed, unpadded Base32-encoded value. ----- This will not tell you whether or not this is a correct Base32 representation,--- only that it conforms to the correct shape (including padding/size etc.).--- To check whether it is a true Base32 encoded 'ByteString' value, use 'isBase32'.+-- >>> decodeBase32Unpadded (encodeBase32Unpadded' "Sun")+-- "Sun" ----- === __Examples__:+-- @since 1.0 ----- >>> isValidBase32 "KN2W4"--- True+decodeBase32Unpadded :: Base32 'StdUnpadded ByteString -> ByteString+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32-encoded value, assuming that it is unpadded. ----- >>> isValidBase32 "KN2W4="--- False+-- >>> parseBase32Unpadded "kn2w4"+-- Right "kn2w4" ----- >>> isValidBase32 "KN2W4%"--- False+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "KN2W4")+-- Right "Sun" ---isValidBase32 :: ByteString -> Bool-isValidBase32 = validateBase32 "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"-{-# INLINE isValidBase32 #-}+-- >>> parseBase32Unpadded ""+-- Right ""+--+-- >>> parseBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "MZ")+-- True+--+-- @since 1.0+--+parseBase32Unpadded :: ByteString -> Either Text (Base32 'StdUnpadded ByteString)+parseBase32Unpadded value = assertBase32 value+  <$ (decodeBase32UnpaddedUntyped) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import Data.Either (isLeft)

@@ -1,10 +1,11 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-}-{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Base32.Hex--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -23,22 +24,27 @@ , encodeBase32Unpadded , encodeBase32Unpadded'   -- * Decoding+, decodeBase32Untyped+, decodeBase32UnpaddedUntyped+, decodeBase32PaddedUntyped+  -- * Validation , decodeBase32-, decodeBase32Unpadded , decodeBase32Padded--- , decodeBase32Lenient-  -- * Validation-, isBase32Hex-, isValidBase32Hex+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  +import Data.Base32.Types+ import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString(..))-import Data.ByteString.Base32.Internal+import Data.ByteString.Base32.Internal.Head import Data.ByteString.Base32.Internal.Tables-import Data.Either (isRight)+import Data.ByteString.Base32.Internal.Utils (validateLastNPads) import Data.Text (Text)+import qualified Data.Text as Text import qualified Data.Text.Encoding as T  import System.IO.Unsafe (unsafeDupablePerformIO)@@ -53,8 +59,10 @@ -- >>> encodeBase32 "Sun" -- "ADQMS===" ---encodeBase32 :: ByteString -> Text-encodeBase32 = T.decodeUtf8 . encodeBase32'+-- @since 1.0+--+encodeBase32 :: ByteString -> Base32 'HexPadded Text+encodeBase32 = fmap T.decodeUtf8 . encodeBase32' {-# INLINE encodeBase32 #-}  -- | Encode a 'ByteString' value as a Base32hex 'ByteString' value with padding.@@ -66,8 +74,10 @@ -- >>> encodeBase32' "Sun" -- "ADQMS===" ---encodeBase32' :: ByteString -> ByteString-encodeBase32' = encodeBase32_ "0123456789ABCDEFGHIJKLMNOPQRSTUV"#+-- @since 1.0+--+encodeBase32' :: ByteString -> Base32 'HexPadded ByteString+encodeBase32' = assertBase32 . encodeBase32_ "0123456789ABCDEFGHIJKLMNOPQRSTUV"# {-# INLINE encodeBase32' #-}  -- | Decode an arbitrarily padded Base32hex-encoded 'ByteString' value. If its length@@ -79,27 +89,33 @@ -- -- === __Examples__: ----- >>> decodeBase32 "ADQMS==="+-- >>> decodeBase32Untyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32 "ADQMS"+-- >>> decodeBase32Untyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32 "ADQM==="+-- >>> decodeBase32Untyped "ADQM===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: ByteString -> Either Text ByteString-decodeBase32 bs@(BS _ !l)+-- @since 1.0+--+decodeBase32Untyped :: ByteString -> Either Text ByteString+decodeBase32Untyped bs@(BS _ !l)     | l == 0 = Right bs     | r == 0 = unsafeDupablePerformIO $ decodeBase32_ hexDecodeTable bs-    | r == 2 = unsafeDupablePerformIO $ decodeBase32_ hexDecodeTable (BS.append bs "======")-    | r == 4 = validateLastNPads 2 bs $ decodeBase32_ hexDecodeTable (BS.append bs "====")-    | r == 5 = validateLastNPads 3 bs $ decodeBase32_ hexDecodeTable (BS.append bs "===")-    | r == 7 = validateLastNPads 5 bs $ decodeBase32_ hexDecodeTable (BS.append bs "=")-    | otherwise = Left "Base32-encoded bytestring has invalid size"+    | r == 2 = unsafeDupablePerformIO $+        decodeBase32_ hexDecodeTable (BS.append bs (BS.replicate 6 0x3d))+    | r == 4 = validateLastNPads 2 bs $+        decodeBase32_ hexDecodeTable (BS.append bs (BS.replicate 4 0x3d))+    | r == 5 = validateLastNPads 3 bs $+        decodeBase32_ hexDecodeTable (BS.append bs (BS.replicate 3 0x3d))+    | r == 7 = validateLastNPads 5 bs $+        decodeBase32_ hexDecodeTable (BS.append bs (BS.replicate 1 0x3d))+    | otherwise = Left (Text.pack "Base32-encoded bytestring has invalid size")   where     !r = l `rem` 8-{-# INLINE decodeBase32 #-}+{-# INLINE decodeBase32Untyped #-}  -- | Encode a 'ByteString' value as a Base32hex 'Text' value without padding. --@@ -107,11 +123,13 @@ -- -- === __Examples__: ----- >>> encodeBase32Unpadded' "Sun"+-- >>> encodeBase32Unpadded "Sun" -- "ADQMS" ---encodeBase32Unpadded :: ByteString -> Text-encodeBase32Unpadded = T.decodeUtf8 . encodeBase32Unpadded'+-- @since 1.0+--+encodeBase32Unpadded :: ByteString -> Base32 'HexUnpadded Text+encodeBase32Unpadded = fmap T.decodeUtf8 . encodeBase32Unpadded' {-# INLINE encodeBase32Unpadded #-}  -- | Encode a 'ByteString' value as a Base32hex 'ByteString' value without padding.@@ -123,8 +141,11 @@ -- >>> encodeBase32Unpadded' "Sun" -- "ADQMS" ---encodeBase32Unpadded' :: ByteString -> ByteString-encodeBase32Unpadded' = encodeBase32NoPad_ "0123456789ABCDEFGHIJKLMNOPQRSTUV"#+-- @since 1.0+--+encodeBase32Unpadded' :: ByteString -> Base32 'HexUnpadded ByteString+encodeBase32Unpadded' = assertBase32+  . encodeBase32NoPad_ "0123456789ABCDEFGHIJKLMNOPQRSTUV"# {-# INLINE encodeBase32Unpadded' #-}  -- | Decode an unpadded Base32hex-encoded 'ByteString' value.@@ -133,24 +154,30 @@ -- -- === __Examples__: ----- >>> decodeBase32Unpadded "ADQMS"+-- >>> decodeBase32UnpaddedUntyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32Unpadded "ADQMS==="+-- >>> decodeBase32UnpaddedUntyped "ADQMS===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: ByteString -> Either Text ByteString-decodeBase32Unpadded bs@(BS _ !l)+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: ByteString -> Either Text ByteString+decodeBase32UnpaddedUntyped bs@(BS _ !l)     | l == 0 = Right bs     | r == 0 = validateLastNPads 1 bs $ decodeBase32_ hexDecodeTable bs-    | r == 2 = unsafeDupablePerformIO $ decodeBase32_ hexDecodeTable (BS.append bs "======")-    | r == 4 = validateLastNPads 1 bs $ decodeBase32_ hexDecodeTable (BS.append bs "====")-    | r == 5 = validateLastNPads 1 bs $ decodeBase32_ hexDecodeTable (BS.append bs "===")-    | r == 7 = validateLastNPads 1 bs $ decodeBase32_ hexDecodeTable (BS.append bs "=")-    | otherwise = Left "Base32-encoded bytestring has invalid size"+    | r == 2 = unsafeDupablePerformIO $+        decodeBase32_ hexDecodeTable (BS.append bs (BS.replicate 6 0x3d))+    | r == 4 = validateLastNPads 1 bs $+        decodeBase32_ hexDecodeTable (BS.append bs (BS.replicate 4 0x3d))+    | r == 5 = validateLastNPads 1 bs $+        decodeBase32_ hexDecodeTable (BS.append bs (BS.replicate 3 0x3d))+    | r == 7 = validateLastNPads 1 bs $+        decodeBase32_ hexDecodeTable (BS.append bs (BS.replicate 1 0x3d))+    | otherwise = Left (Text.pack "Base32-encoded bytestring has invalid size")   where     !r = l `rem` 8-{-# INLINE decodeBase32Unpadded #-}+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Decode a padded Base32hex-encoded 'ByteString' value. --@@ -158,58 +185,104 @@ -- -- === __Examples__: ----- >>> decodeBase32Padded "ADQMS==="+-- >>> decodeBase32PaddedUntyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32Padded "ADQMS"+-- >>> decodeBase32PaddedUntyped "ADQMS" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: ByteString -> Either Text ByteString-decodeBase32Padded bs@(BS _ !l)+-- @since 1.0+--+decodeBase32PaddedUntyped :: ByteString -> Either Text ByteString+decodeBase32PaddedUntyped bs@(BS _ !l)     | l == 0 = Right bs-    | r == 1 = Left "Base32-encoded bytestring has invalid size"-    | r == 3 = Left "Base32-encoded bytestring has invalid size"-    | r == 6 = Left "Base32-encoded bytestring has invalid size"-    | r /= 0 = Left "Base32-encoded bytestring requires padding"+    | r == 1 = Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r == 3 = Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r == 6 = Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r /= 0 = Left (Text.pack "Base32-encoded bytestring requires padding")     | otherwise = unsafeDupablePerformIO $ decodeBase32_ hexDecodeTable bs   where     !r = l `rem` 8+{-# INLINE decodeBase32PaddedUntyped #-}++-- | Decode a typed Base32hex-encoded 'ByteString' value. +-- +-- This function is padding-agnostic.+--+-- >>> decodeBase32 (encodeBase32' "Sun")+-- "Sun"+-- >>> decodeBase32 (encodeBase32Unpadded' "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: HexAlphabet k => Base32 k ByteString -> ByteString+decodeBase32 = decodeBase32Typed_ hexDecodeTable+{-# INLINE decodeBase32 #-}++-- | Decode a typed, padded Base32hex-encoded 'ByteString' value +--+-- >>> decodeBase32Padded (encodeBase32' "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32Padded :: Base32 'HexPadded ByteString -> ByteString+decodeBase32Padded = decodeBase32 {-# INLINE decodeBase32Padded #-} --- | Tell whether a 'ByteString' value is encoded in padded or unpadded Base32hex format+-- | Parse and validate a base32hex-encoded value, assuming that it has padding. ----- === __Examples__:+-- >>> parseBase32Padded "adqms==="+-- Right "adqms===" ----- >>> isBase32Hex "ADQMS"--- True+-- >>> fmap decodeBase32Padded (parseBase32Padded "ADQMS===")+-- Right "Sun"+-- +-- >>> parseBase32Padded ""+-- Right "" ----- >>> isBase32Hex "ADQMS==="--- True+-- >>> parseBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding" ----- >>> isBase32Hex "ADQMS=="--- False+-- @since 1.0 ---isBase32Hex :: ByteString -> Bool-isBase32Hex bs = isValidBase32Hex bs && isRight (decodeBase32 bs)-{-# INLINE isBase32Hex #-}+parseBase32Padded :: ByteString -> Either Text (Base32 'HexPadded ByteString)+parseBase32Padded value = assertBase32 value+  <$ (decodeBase32PaddedUntyped) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'ByteString' value is a valid Base32hex format.+-- | Decode a typed, unpadded Base32hex-encoded value. ----- This will not tell you whether or not this is a correct Base32hex representation,--- only that it conforms to the correct shape (including padding/size etc.).--- To check whether it is a true Base32hex encoded 'ByteString' value, use 'isBase32'.+-- >>> decodeBase32Unpadded (encodeBase32Unpadded' "Sun")+-- "Sun" ----- === __Examples__:+-- @since 1.0 ----- >>> isValidBase32Hex "ADQMS"--- True+decodeBase32Unpadded :: Base32 'HexUnpadded ByteString -> ByteString+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32hex-encoded value, assuming that is unpadded. ----- >>> isValidBase32Hex "ADQMS="--- False+-- >>> parseBase32Unpadded "adqms"+-- Right "adqms"+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "ADQMS")+-- Right "Sun"+-- >>> parseBase32Unpadded ""+-- Right ""+-- >>> parseBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+-- >>> isLeft (parseBase32Unpadded "CP")+-- True ----- >>> isValidBase32Hex "ADQMS%"--- False+-- @since 1.0 ---isValidBase32Hex :: ByteString -> Bool-isValidBase32Hex = validateBase32 "0123456789ABCDEFGHIJKLMNOPQRSTUV"-{-# INLINE isValidBase32Hex #-}+parseBase32Unpadded :: ByteString -> Either Text (Base32 'HexUnpadded ByteString)+parseBase32Unpadded value = assertBase32 value+  <$ (decodeBase32UnpaddedUntyped) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import Data.Either (isLeft)

@@ -1,120 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}--- |--- Module       : Data.ByteString.Base32.Internal--- Copyright 	: (c) 2020 Emily Pillmore--- License	: BSD-style------ Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>--- Stability	: Experimental--- Portability	: portable------ Internal module defining the encoding and decoding--- processes and tables.----module Data.ByteString.Base32.Internal-( encodeBase32_-, encodeBase32NoPad_-, decodeBase32_-, validateBase32-, validateLastNPads-) where---import qualified Data.ByteString as BS-import Data.ByteString.Internal-import Data.ByteString.Base32.Internal.Head-import Data.Text (Text)--import Foreign.ForeignPtr-import Foreign.Ptr-import Foreign.Storable--import GHC.Word--import System.IO.Unsafe---- -------------------------------------------------------------------------- ----- Validating Base32---- | Validate a base32-encoded bytestring against some alphabet.----validateBase32 :: ByteString -> ByteString -> Bool-validateBase32 !alphabet bs@(BS _ l)-    | l == 0 = True-    | r == 0 = f bs-    | r == 2 = f (BS.append bs "======")-    | r == 4 = f (BS.append bs "====")-    | r == 5 = f (BS.append bs "===")-    | r == 7 = f (BS.append bs "=")-    | otherwise = False-  where-    r = l `rem` 8--    f (BS fp l') = accursedUnutterablePerformIO $ withForeignPtr fp $ \p ->-      go p (plusPtr p l')--    go !p !end-      | p == end = return True-      | otherwise = do-        w <- peek p--        let check a-              | a == 0x3d, plusPtr p 1 == end = True-              | a == 0x3d, plusPtr p 2 == end = True-              | a == 0x3d, plusPtr p 3 == end = True-              | a == 0x3d, plusPtr p 4 == end = True-              | a == 0x3d, plusPtr p 5 == end = True-              | a == 0x3d, plusPtr p 6 == end = True-              | a == 0x3d = False-              | otherwise = BS.elem a alphabet--        if check w then go (plusPtr p 1) end else return False-{-# INLINE validateBase32 #-}---- | This function checks that the last N-chars of a bytestring are '='--- and, if true, fails with a message or completes some io action.------ This is necessary to check when decoding permissively (i.e. filling in padding chars).--- Consider the following 8 cases of a string of length l:------ - @l = 0 mod 8@: No pad chars are added, since the input is assumed to be good.--- - @l = 1 mod 8@: Never an admissible length in base32--- - @l = 2 mod 8@: 6 padding chars are added. If padding chars are present in the string, they will fail as to decode as final quanta--- - @l = 3 mod 8@: Never an admissible length in base32--- - @l = 4 mod 8@: 4 padding chars are added. If 2 padding chars are present in the string this can be "completed" in the sense that---              it now acts like a string `l == 2 mod 8` with 6 padding chars, and could potentially form corrupted data.--- - @l = 5 mod 8@: 3 padding chars are added. If 3 padding chars are present in the string, this could form corrupted data like in the---              previous case.--- - @l = 6 mod 8@: Never an admissible length in base32--- - @l = 7 mod 8@: 1 padding char is added. If 5 padding chars are present in the string, this could form corrupted data like the---              previous cases.------ Hence, permissive decodes should only fill in padding chars when it makes sense to add them. That is,--- if an input is degenerate, it should never succeed when we add padding chars. We need the following invariant to hold:------ @---   B32.decodeUnpadded <|> B32.decodePadded ~ B32.decode--- @----validateLastNPads-    :: Int-    -> ByteString-    -> IO (Either Text ByteString)-    -> Either Text ByteString-validateLastNPads !n (BS !fp !l) io-    | not valid = Left "Base32-encoded bytestring has invalid padding"-    | otherwise = unsafeDupablePerformIO io-  where-    valid = accursedUnutterablePerformIO $ withForeignPtr fp $ \p -> do-      let end = plusPtr p l--      let go :: Ptr Word8 -> IO Bool-          go !q-            | q == end = return True-            | otherwise = do-              a <- peek q-              if a == 0x3d then return False else go (plusPtr q 1)--      go (plusPtr p (l - n))-{-# INLINE validateLastNPads #-}

@@ -1,17 +1,37 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeApplications #-}+-- |+-- Module       : Data.ByteString.Base32.Internal.Head+-- Copyright    : (c) 2020-2026 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- Allocation and entry points for the strict encoding and decoding loops.+--+-- @since 1.0+-- module Data.ByteString.Base32.Internal.Head ( encodeBase32_ , encodeBase32NoPad_ , decodeBase32_+, decodeBase32Typed_ ) where  +import Prelude hiding (length, null)+import Data.Base32.Types (Base32, extractBase32)+import qualified Data.ByteString as BS+import Data.ByteString (length, null) import Data.ByteString.Internal+import Data.ByteString.Base32.Internal.Utils (encodedLength) import Data.ByteString.Base32.Internal.Loop import Data.ByteString.Base32.Internal.Tail import Data.Text (Text)+import qualified Data.Text as Text  import Foreign.Ptr import Foreign.ForeignPtr@@ -29,6 +49,8 @@ -- allocates the correct number of bytes that will be written, and -- executes the inner encoding loop against that data. --+-- @since 1.0+-- encodeBase32_ :: Addr# -> ByteString -> ByteString encodeBase32_ !lut (BS !sfp !l) = unsafeDupablePerformIO $ do     dfp <- mallocPlainForeignPtrBytes dlen@@ -39,7 +61,7 @@           (castPtr dptr) sptr           end (loopTail lut dfp dptr end)   where-    !dlen = ceiling (fromIntegral @_ @Double l / 5) * 8+    !dlen = encodedLength l  -- | Head of the unpadded base32 encoding loop. --@@ -47,6 +69,8 @@ -- allocates the correct number of bytes that will be written, and -- executes the inner encoding loop against that data. --+-- @since 1.0+-- encodeBase32NoPad_ :: Addr# -> ByteString -> ByteString encodeBase32NoPad_ !lut (BS !sfp !l) = unsafeDupablePerformIO $ do     !dfp <- mallocPlainForeignPtrBytes dlen@@ -57,7 +81,7 @@           (castPtr dptr) sptr           end (loopTailNoPad lut dfp dptr end)   where-    !dlen = ceiling (fromIntegral @_ @Double l / 5) * 8+    !dlen = encodedLength l  -- | Head of the base32 decoding loop. --@@ -65,12 +89,37 @@ -- bytestring, allocates the correct number of bytes that will be written, -- and executes the inner decoding loop against that data. --+-- @since 1.0+-- decodeBase32_ :: Ptr Word8 -> ByteString -> IO (Either Text ByteString)-decodeBase32_ (Ptr !dtable) (BS !sfp !slen) =+decodeBase32_ table bs+  | null bs = pure (Right bs)+  | length bs `rem` 8 /= 0 =+      pure (Left (Text.pack "Base32 input requires complete quanta"))+  | otherwise = decodeComplete table bs++decodeComplete :: Ptr Word8 -> ByteString -> IO (Either Text ByteString)+decodeComplete (Ptr !dtable) (BS !sfp !slen) =     withForeignPtr sfp $ \sptr -> do       dfp <- mallocPlainForeignPtrBytes dlen       withForeignPtr dfp $ \dptr -> do         let !end = plusPtr sptr slen         decodeLoop dtable dfp dptr sptr end   where-    !dlen = ceiling (fromIntegral @_ @Double slen / 1.6)+    !dlen = (slen `quot` 8) * 5++-- | Decode established Base32 provenance without validation.+-- Padding contributes no payload; partial final quanta need no copying.+--+-- @since 1.0+--+decodeBase32Typed_ :: Ptr Word8 -> Base32 alphabet ByteString -> ByteString+decodeBase32Typed_ (Ptr table) encoded = unsafeDupablePerformIO $ do+    dfp <- mallocPlainForeignPtrBytes dlen+    withForeignPtr dfp $ \dst ->+      withForeignPtr sfp $ \src -> decodeLoopTyped table dst src slen+    pure (BS dfp dlen)+  where+    BS sfp slen = BS.dropWhileEnd (== 61) (extractBase32 encoded)+    dlen = (slen `quot` 8) * 5 + (slen `rem` 8) * 5 `quot` 8+{-# INLINE decodeBase32Typed_ #-}

@@ -1,11 +1,31 @@+{-# LANGUAGE CPP #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE TypeApplications #-}+-- |+-- Module       : Data.ByteString.Base32.Internal.Loop+-- Copyright    : (c) 2020-2026 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- Encoding loops, checked and typed decoding loops, and quantum validation.+--+-- @since 1.0+-- module Data.ByteString.Base32.Internal.Loop ( innerLoop , decodeLoop+, decodeLoopTyped+, decodeQuantum ) where +#ifdef BASE32_SIMD+import qualified Data.ByteString.Base32.Internal.SIMD as SIMD+#endif+ import Data.Bits import Data.ByteString.Internal (ByteString(..)) import Data.ByteString.Base32.Internal.Utils@@ -16,6 +36,7 @@ import Foreign.ForeignPtr import Foreign.Storable +import GHC.ByteOrder import GHC.Exts import GHC.Word @@ -23,6 +44,10 @@ -- ------------------------------------------------------------------------ -- -- Encoding loops +-- | Encode complete quanta, then run the supplied tail handler.+--+-- @since 1.0+-- innerLoop     :: Addr#     -> Ptr Word64@@ -30,7 +55,14 @@     -> Ptr Word8     -> (Ptr Word8 -> Ptr Word8 -> IO ByteString)     -> IO ByteString-innerLoop !lut !dptr !sptr !end finish = go dptr sptr+innerLoop !lut !dptr !sptr !end finish = do+#ifdef BASE32_SIMD+    consumed <- SIMD.encodePrefix lut sptr+      (end `minusPtr` sptr) (castPtr dptr)+    go (plusPtr dptr (consumed `quot` 5 * 8)) (plusPtr sptr consumed)+#else+  go dptr sptr+#endif   where     lix a = w64 (aix (fromIntegral a .&. 0x1f) lut)     {-# INLINE lix #-}@@ -59,13 +91,19 @@              .|. unsafeShiftL g 48              .|. unsafeShiftL h 56 -        poke dst w+        poke dst (case targetByteOrder of+          LittleEndian -> w+          BigEndian -> byteSwap64 w)         go (plusPtr dst 8) (plusPtr src 5) {-# INLINE innerLoop #-}  -- ------------------------------------------------------------------------ -- -- Decoding loops +-- | Decode and validate complete quanta, including the final padding.+--+-- @since 1.0+-- decodeLoop     :: Addr#     -> ForeignPtr Word8@@ -73,132 +111,155 @@     -> Ptr Word8     -> Ptr Word8     -> IO (Either Text ByteString)-decodeLoop !lut !dfp !dptr !sptr !end = go dptr sptr+decodeLoop !lut !dfp !dptr !sptr !end = do+#ifdef BASE32_SIMD+    consumed <- SIMD.decodePrefix lut sptr+      (max 0 (end `minusPtr` sptr - 8)) dptr+    go (plusPtr dptr (consumed `quot` 8 * 5)) (plusPtr sptr consumed)+#else+  go dptr sptr+#endif   where-    lix a = w64 (aix (fromIntegral a) lut)--    err :: Ptr Word8 -> IO (Either Text ByteString)-    err p = return . Left . T.pack-      $ "invalid character at offset: "-      ++ show (p `minusPtr` sptr)--    padErr :: Ptr Word8 -> IO (Either Text ByteString)-    padErr p =  return . Left . T.pack-      $ "invalid padding at offset: "-      ++ show (p `minusPtr` sptr)--    look :: Ptr Word8 -> IO Word64-    look !p = lix <$> peek @Word8 p-+    look value = w64 (aix (fromIntegral value) lut)     go !dst !src-      | plusPtr src 8 >= end = do--        a <- look src-        b <- look (plusPtr src 1)-        c <- look (plusPtr src 2)-        d <- look (plusPtr src 3)-        e <- look (plusPtr src 4)-        f <- look (plusPtr src 5)-        g <- look (plusPtr src 6)-        h <- look (plusPtr src 7)-        finalChunk dst src a b c d e f g h--      | otherwise = do-        !t <- peekWord64BE (castPtr src)--        let a = lix (unsafeShiftR t 56)-            b = lix (unsafeShiftR t 48)-            c = lix (unsafeShiftR t 40)-            d = lix (unsafeShiftR t 32)-            e = lix (unsafeShiftR t 24)-            f = lix (unsafeShiftR t 16)-            g = lix (unsafeShiftR t 8)-            h = lix t--        decodeChunk dst src a b c d e f g h--    finalChunk !dst !src !a !b !c !d !e !f !g !h-      | a == 0x63 = padErr src-      | b == 0x63 = padErr (plusPtr src 1)-      | a == 0xff = err src-      | b == 0xff = err (plusPtr src 1)-      | c == 0xff = err (plusPtr src 2)-      | d == 0xff = err (plusPtr src 3)-      | e == 0xff = err (plusPtr src 4)-      | f == 0xff = err (plusPtr src 5)-      | g == 0xff = err (plusPtr src 6)-      | h == 0xff = err (plusPtr src 7)-      | otherwise = do--        let !o1 = (fromIntegral a `unsafeShiftL` 3) .|. (fromIntegral b `unsafeShiftR` 2)-            !o2 = (fromIntegral b `unsafeShiftL` 6)-              .|. (fromIntegral c `unsafeShiftL` 1)-              .|. (fromIntegral d `unsafeShiftR` 4)-            !o3 = (fromIntegral d `unsafeShiftL` 4) .|. (fromIntegral e `unsafeShiftR` 1)-            !o4 = (fromIntegral e `unsafeShiftL` 7)-              .|. (fromIntegral f `unsafeShiftL` 2)-              .|. (fromIntegral g `unsafeShiftR` 3)-            !o5 = (fromIntegral g `unsafeShiftL` 5) .|. fromIntegral h--        poke @Word8 dst o1-        poke @Word8 (plusPtr dst 1) o2--        case (c,d,e,f,g,h) of-          (0x63,0x63,0x63,0x63,0x63,0x63) ->-            return (Right (BS dfp (1 + minusPtr dst dptr)))-          (0x63,_,_,_,_,_) -> padErr (plusPtr src 3)-          (_,0x63,0x63,0x63,0x63,0x63) -> padErr (plusPtr src 3)-          (_,0x63,_,_,_,_) -> padErr (plusPtr src 4)-          (_,_,0x63,0x63,0x63,0x63) -> do-            poke @Word8 (plusPtr dst 2) o3-            return (Right (BS dfp (2 + minusPtr dst dptr)))-          (_,_,0x63,_,_,_) -> padErr (plusPtr src 5)-          (_,_,_,0x63,0x63,0x63) -> do-            poke @Word8 (plusPtr dst 2) o3-            poke @Word8 (plusPtr dst 3) o4-            return (Right (BS dfp (3 + minusPtr dst dptr)))-          (_,_,_,0x63,_,_) -> padErr (plusPtr src 6)-          (_,_,_,_,0x63,0x63) -> padErr (plusPtr src 6)-          (_,_,_,_,0x63,_) -> padErr (plusPtr src 7)-          (_,_,_,_,_,0x63) -> do-            poke @Word8 (plusPtr dst 2) o3-            poke @Word8 (plusPtr dst 3) o4-            poke @Word8 (plusPtr dst 4) o5-            return (Right (BS dfp (4 + minusPtr dst dptr)))-          (_,_,_,_,_,_) -> do-            poke @Word8 (plusPtr dst 2) o3-            poke @Word8 (plusPtr dst 3) o4-            poke @Word8 (plusPtr dst 4) o5-            return (Right (BS dfp (5 + minusPtr dst dptr)))--    decodeChunk !dst !src !a !b !c !d !e !f !g !h-      | a == 0x63 = padErr src-      | b == 0x63 = padErr (plusPtr src 1)-      | c == 0x63 = padErr (plusPtr src 2)-      | d == 0x63 = padErr (plusPtr src 3)-      | e == 0x63 = padErr (plusPtr src 4)-      | f == 0x63 = padErr (plusPtr src 5)-      | g == 0x63 = padErr (plusPtr src 6)-      | h == 0x63 = padErr (plusPtr src 7)-      | a == 0xff = err src-      | b == 0xff = err (plusPtr src 1)-      | c == 0xff = err (plusPtr src 2)-      | d == 0xff = err (plusPtr src 3)-      | e == 0xff = err (plusPtr src 4)-      | f == 0xff = err (plusPtr src 5)-      | g == 0xff = err (plusPtr src 6)-      | h == 0xff = err (plusPtr src 7)+      | src == end = pure (Right (BS dfp (dst `minusPtr` dptr)))       | otherwise = do+          t <- peekWord64BE (castPtr src)+          let !a = look (unsafeShiftR t 56)+              !b = look (unsafeShiftR t 48)+              !c = look (unsafeShiftR t 40)+              !d = look (unsafeShiftR t 32)+              !e = look (unsafeShiftR t 24)+              !f = look (unsafeShiftR t 16)+              !g = look (unsafeShiftR t 8)+              !h = look t+              final = plusPtr src 8 == end+          if not final && (a .|. b .|. c .|. d .|. e .|. f .|. g .|. h) < 32+            then do+              writeFull dst (pack a b c d e f g h)+              go (plusPtr dst 5) (plusPtr src 8)+            else case decodeQuantum final (src `minusPtr` sptr) a b c d e f g h of+              Left err -> pure (Left err)+              Right count -> do+                let clean v = if v == 0x63 then 0 else v+                    w = pack a b (clean c) (clean d) (clean e)+                      (clean f) (clean g) (clean h)+                    write i+                      | i == count = pure ()+                      | otherwise = do+                          poke @Word8 (plusPtr dst i)+                            (fromIntegral (unsafeShiftR w (32 - 8 * i)))+                          write (i + 1)+                write 0+                if final+                  then pure (Right (BS dfp (dst `minusPtr` dptr + count)))+                  else go (plusPtr dst 5) (plusPtr src 8)+    pack a b c d e f g h =+      unsafeShiftL a 35 .|. unsafeShiftL b 30+        .|. unsafeShiftL c 25 .|. unsafeShiftL d 20+        .|. unsafeShiftL e 15 .|. unsafeShiftL f 10+        .|. unsafeShiftL g 5 .|. h+    writeFull dst w = do+      let first = fromIntegral (w `unsafeShiftR` 8) :: Word32+      poke (castPtr dst) (case targetByteOrder of+        LittleEndian -> byteSwap32 first+        BigEndian -> first)+      poke @Word8 (plusPtr dst 4) (fromIntegral w)+{-# INLINE decodeLoop #-} -        let !w = (unsafeShiftL a 35-              .|. unsafeShiftL b 30-              .|. unsafeShiftL c 25-              .|. unsafeShiftL d 20-              .|. unsafeShiftL e 15-              .|. unsafeShiftL f 10-              .|. unsafeShiftL g 5-              .|. h) :: Word64+-- | Validate a decoded quantum before any output is written. Return its+-- payload length. Both pointer and byte-array loops use the same rules.+--+-- @since 1.0+--+decodeQuantum+  :: Bool -> Int+  -> Word64 -> Word64 -> Word64 -> Word64+  -> Word64 -> Word64 -> Word64 -> Word64+  -> Either Text Int+decodeQuantum !final !offset !a !b !c !d !e !f !g !h+  | a == 0x63 = padErr 0+  | b == 0x63 = padErr 1+  | not final, c == 0x63 = padErr 2+  | not final, d == 0x63 = padErr 3+  | not final, e == 0x63 = padErr 4+  | not final, f == 0x63 = padErr 5+  | not final, g == 0x63 = padErr 6+  | not final, h == 0x63 = padErr 7+  | a == 0xff = charErr 0+  | b == 0xff = charErr 1+  | c == 0xff = charErr 2+  | d == 0xff = charErr 3+  | e == 0xff = charErr 4+  | f == 0xff = charErr 5+  | g == 0xff = charErr 6+  | h == 0xff = charErr 7+  | not final = Right 5+  | otherwise = case (c,d,e,f,g,h) of+      (0x63,0x63,0x63,0x63,0x63,0x63) -> canonical b 3 1 1+      (0x63,_,_,_,_,_) -> padErr 3+      (_,0x63,0x63,0x63,0x63,0x63) -> padErr 3+      (_,0x63,_,_,_,_) -> padErr 4+      (_,_,0x63,0x63,0x63,0x63) -> canonical d 15 3 2+      (_,_,0x63,_,_,_) -> padErr 5+      (_,_,_,0x63,0x63,0x63) -> canonical e 1 4 3+      (_,_,_,0x63,_,_) -> padErr 6+      (_,_,_,_,0x63,0x63) -> padErr 6+      (_,_,_,_,0x63,_) -> padErr 7+      (_,_,_,_,_,0x63) -> canonical g 7 6 4+      _ -> Right 5+  where+    failure message i = Left (T.pack (message ++ show (offset + i)))+    padErr = failure "invalid padding at offset: "+    charErr = failure "invalid character at offset: "+    canonical value mask i count+      | value .&. mask == 0 = Right count+      | otherwise = failure "non-canonical encoding at offset: " i+{-# INLINE decodeQuantum #-} -        poke @Word32 (castPtr dst) (byteSwap32 (fromIntegral (unsafeShiftR w 8)))-        poke @Word8 (plusPtr dst 4) (fromIntegral w)-        go (plusPtr dst 5) (plusPtr src 8)+-- | Decode known-valid symbols. Alphabet, size, padding placement and unused+-- bits have already been established by the producer of the typed value.+-- The caller excludes trailing padding from the source length.+--+-- @since 1.0+--+decodeLoopTyped :: Addr# -> Ptr Word8 -> Ptr Word8 -> Int -> IO ()+decodeLoopTyped table dptr sptr slen = do+#ifdef BASE32_SIMD+    consumed <- SIMD.decodeTypedPrefix table sptr slen dptr+#else+    let consumed = 0+#endif+    go (plusPtr dptr (consumed `quot` 8 * 5)) consumed+  where+    look value = w64 (aix (fromIntegral value) table)+    go !dst !i+      | slen - i >= 8 = do+          t <- peekWord64BE (castPtr (plusPtr sptr i))+          let w = pack (look (t `unsafeShiftR` 56)) (look (t `unsafeShiftR` 48))+                (look (t `unsafeShiftR` 40)) (look (t `unsafeShiftR` 32))+                (look (t `unsafeShiftR` 24)) (look (t `unsafeShiftR` 16))+                (look (t `unsafeShiftR` 8)) (look t)+              first = fromIntegral (w `unsafeShiftR` 8) :: Word32+          poke (castPtr dst) (case targetByteOrder of+            LittleEndian -> byteSwap32 first+            BigEndian -> first)+          poke @Word8 (plusPtr dst 4) (fromIntegral w)+          go (plusPtr dst 5) (i + 8)+      | otherwise = tailBytes dst i 0 0 (0 :: Word16)+    tailBytes !dst !i !bits !j !buffer+      | bits >= 8 = do+          let rest = bits - 8+          poke @Word8 (plusPtr dst j) (fromIntegral (buffer `unsafeShiftR` rest))+          tailBytes dst i rest (j + 1) buffer+      | i < slen = do+          symbol <- peek @Word8 (plusPtr sptr i)+          tailBytes dst (i + 1) (bits + 5) j+            (buffer `unsafeShiftL` 5 .|. fromIntegral (aix symbol table))+      | otherwise = pure ()+    pack a b c d e f g h =+      a `unsafeShiftL` 35 .|. b `unsafeShiftL` 30+        .|. c `unsafeShiftL` 25 .|. d `unsafeShiftL` 20+        .|. e `unsafeShiftL` 15 .|. f `unsafeShiftL` 10+        .|. g `unsafeShiftL` 5 .|. h+{-# INLINE decodeLoopTyped #-}

@@ -0,0 +1,153 @@+{-# LANGUAGE ForeignFunctionInterface #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE UnliftedFFITypes #-}+-- |+-- Module       : Data.ByteString.Base32.Internal.SIMD+-- Copyright    : (c) 2026 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- Bounded native prefixes. Callers retain pointer buffers with withForeignPtr.+-- Byte arrays are passed directly to unsafe FFI: GHC cannot collect during+-- the call, and the kernels retain no pointers and make no callbacks.+--+-- @since 1.0+--+module Data.ByteString.Base32.Internal.SIMD+  ( encodePrefix+  , decodePrefix+  , decodeTypedPrefix+  , encodeByteArrayPrefix+  , decodeByteArrayPrefix+  , decodeByteArrayTypedPrefix+  ) where++import Control.Monad.ST (ST)+import Control.Monad.ST.Unsafe (unsafeIOToST)+import Data.ByteString.Base32.Internal.Tables (hexDecodeTable, stdDecodeTable)+import Data.ByteString.Base32.Internal.Utils (aix)+import Data.Primitive.ByteArray (ByteArray (..), MutableByteArray (..))+import Data.Word (Word8)+import Foreign.C.Types (CInt (..), CSize (..))+import GHC.Exts (Addr#, ByteArray#, MutableByteArray#)+import GHC.Ptr (Ptr (..))++foreign import ccall unsafe "hs_base32_simd_encode"+  c_encode :: Ptr Word8 -> CSize -> Ptr Word8 -> CInt -> IO CSize+foreign import ccall unsafe "hs_base32_simd_decode"+  c_decode :: Ptr Word8 -> CSize -> Ptr Word8 -> CInt -> IO CSize+foreign import ccall unsafe "hs_base32_simd_encode"+  c_encodeArray :: ByteArray# -> CSize -> MutableByteArray# s -> CInt -> IO CSize+foreign import ccall unsafe "hs_base32_simd_decode"+  c_decodeArray :: ByteArray# -> CSize -> MutableByteArray# s -> CInt -> IO CSize++foreign import ccall unsafe "hs_base32_simd_decode_typed"+  c_decodeTyped :: Ptr Word8 -> CSize -> Ptr Word8 -> CInt -> IO CSize+foreign import ccall unsafe "hs_base32_simd_decode_typed"+  c_decodeArrayTyped :: ByteArray# -> CSize -> MutableByteArray# s -> CInt -> IO CSize++-- | Encode complete quanta. Destination capacity must be at least len/5*8.+--+-- @since 1.0+--+encodePrefix :: Addr# -> Ptr Word8 -> Int -> Ptr Word8 -> IO Int+encodePrefix alphabet src len dst+  | len < 80 = pure 0+  | Just hex <- encodingAlphabet alphabet =+      fromIntegral <$> c_encode src (fromIntegral len) dst hex+  | otherwise = pure 0+{-# INLINE encodePrefix #-}++-- | Decode valid complete quanta; leave padding/invalid blocks for scalar code.+-- Destination capacity must be at least len/8*5.+--+-- @since 1.0+--+decodePrefix :: Addr# -> Ptr Word8 -> Int -> Ptr Word8 -> IO Int+decodePrefix table src len dst+  | len < 64 = pure 0+  | Just hex <- decodingAlphabet table =+      fromIntegral <$> c_decode src (fromIntegral len) dst hex+  | otherwise = pure 0+{-# INLINE decodePrefix #-}++-- | Decode known-valid symbols without validation; excludes trailing padding.+-- Destination capacity must be at least len/8*5.+--+-- @since 1.0+--+decodeTypedPrefix :: Addr# -> Ptr Word8 -> Int -> Ptr Word8 -> IO Int+decodeTypedPrefix table src len dst+  | len < 64 = pure 0+  | Just hex <- decodingAlphabet table =+      fromIntegral <$> c_decodeTyped src (fromIntegral len) dst hex+  | otherwise = pure 0+{-# INLINE decodeTypedPrefix #-}++-- | Direct unpinned-array encoding into a distinct mutable output buffer.+--+-- @since 1.0+--+encodeByteArrayPrefix ::+  Addr# -> ByteArray -> Int -> MutableByteArray s -> ST s Int+encodeByteArrayPrefix alphabet (ByteArray src) len (MutableByteArray dst)+  | len < 40 = pure 0+  | Just hex <- encodingAlphabet alphabet =+      unsafeIOToST $+        fromIntegral <$> c_encodeArray src (fromIntegral len) dst hex+  | otherwise = pure 0+{-# INLINE encodeByteArrayPrefix #-}++-- | Direct unpinned-array decoding into a distinct mutable output buffer.+--+-- @since 1.0+--+decodeByteArrayPrefix ::+  Addr# -> ByteArray -> Int -> MutableByteArray s -> ST s Int+decodeByteArrayPrefix table (ByteArray src) len (MutableByteArray dst)+  | len < 64 = pure 0+  | Just hex <- decodingAlphabet table =+      unsafeIOToST $+        fromIntegral <$> c_decodeArray src (fromIntegral len) dst hex+  | otherwise = pure 0+{-# INLINE decodeByteArrayPrefix #-}++-- | Unchecked array decoding of known-valid symbols, excluding padding.+--+-- @since 1.0+--+decodeByteArrayTypedPrefix ::+  Addr# -> ByteArray -> Int -> MutableByteArray s -> ST s Int+decodeByteArrayTypedPrefix table (ByteArray src) len (MutableByteArray dst)+  | len < 64 = pure 0+  | Just hex <- decodingAlphabet table =+      unsafeIOToST $+        fromIntegral <$> c_decodeArrayTyped src (fromIntegral len) dst hex+  | otherwise = pure 0+{-# INLINE decodeByteArrayTypedPrefix #-}++-- Arbitrary alphabets are part of the exposed low-level API. Only exact+-- built-in alphabets can use these kernels; other alphabets stay scalar.+encodingAlphabet :: Addr# -> Maybe CInt+encodingAlphabet alphabet+  | matches "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"# = Just 0+  | matches "0123456789ABCDEFGHIJKLMNOPQRSTUV"# = Just 1+  | otherwise = Nothing+ where+  matches expected = go 0+   where+    go i+      | i == 32 = True+      | aix i alphabet == aix i expected = go (i + 1)+      | otherwise = False+{-# INLINE encodingAlphabet #-}++decodingAlphabet :: Addr# -> Maybe CInt+decodingAlphabet table+  | Ptr table == stdDecodeTable = Just 0+  | Ptr table == hexDecodeTable = Just 1+  | otherwise = Nothing+{-# INLINE decodingAlphabet #-}

@@ -0,0 +1,237 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE MagicHash #-}+-- |+-- Module       : Data.ByteString.Base32.Internal.Short+-- Copyright    : (c) 2026 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- Direct byte-array codecs; no conversion through strict ByteString.+--+-- @since 1.0+--+module Data.ByteString.Base32.Internal.Short+  ( encodeShort+  , decodeShort+  , decodeShortTyped+  ) where++import Control.Monad.ST (runST)+import Data.Base32.Types (Base32, extractBase32)+import Data.Bits+import Data.ByteString.Base32.Internal.Loop (decodeQuantum)+import Data.ByteString.Base32.Internal.Utils (aix, encodedLength)+import Data.ByteString.Short.Internal (ShortByteString(..))+import qualified Data.ByteString.Short as SBS+import Data.Primitive.ByteArray+import Data.Text (Text)+import Data.Word+import GHC.Exts (Addr#)+import GHC.ByteOrder+import GHC.Ptr (Ptr(..))++#ifdef BASE32_SIMD+import qualified Data.ByteString.Base32.Internal.SIMD as SIMD+#endif++-- | Encode with the supplied 32-character ASCII alphabet.+--+-- @since 1.0+--+encodeShort :: Addr# -> Bool -> ShortByteString -> ShortByteString+encodeShort alphabet padded input@(SBS source) = runST $ do+    dst <- newByteArray capacity+#ifdef BASE32_SIMD+    consumed <- SIMD.encodeByteArrayPrefix alphabet src len dst+#else+    let consumed = 0+#endif+    let emit !i !j !bits !buffer+          | bits >= 5 = do+              let next = bits - 5+              writeByteArray dst j+                (aix (fromIntegral (buffer `unsafeShiftR` next) .&. 31) alphabet)+              emit i (j + 1) next buffer+          | i < len = emit (i + 1) j (bits + 8)+              ((buffer `unsafeShiftL` 8) .|. fromIntegral (byte i))+          | bits > 0 = do+              writeByteArray dst j+                (aix (fromIntegral (buffer `unsafeShiftL` (5 - bits)) .&. 31)+                  alphabet)+              finish (j + 1)+          | otherwise = finish j+        finish !j+          | padded && j < capacity = do+              writeByteArray dst j (61 :: Word8)+              finish (j + 1)+          | otherwise = do+              shrinkMutableByteArray dst j+              ByteArray result <- unsafeFreezeByteArray dst+              pure (SBS result)+    let full !i !j+          | i + 5 > len = emit i j 0 (0 :: Word16)+          | otherwise = do+              let t = fromIntegral (byte i) `unsafeShiftL` 32+                    .|. fromIntegral (byte (i + 1)) `unsafeShiftL` 24+                    .|. fromIntegral (byte (i + 2)) `unsafeShiftL` 16+                    .|. fromIntegral (byte (i + 3)) `unsafeShiftL` 8+                    .|. fromIntegral (byte (i + 4)) :: Word64+                  at shiftCount = fromIntegral+                    (aix (fromIntegral (t `unsafeShiftR` shiftCount) .&. 31) alphabet)+                  w = at 35 .|. at 30 `unsafeShiftL` 8+                    .|. at 25 `unsafeShiftL` 16 .|. at 20 `unsafeShiftL` 24+                    .|. at 15 `unsafeShiftL` 32 .|. at 10 `unsafeShiftL` 40+                    .|. at 5 `unsafeShiftL` 48 .|. at 0 `unsafeShiftL` 56 :: Word64+              writeByteArray dst (j `quot` 8) (case targetByteOrder of+                LittleEndian -> w+                BigEndian -> byteSwap64 w)+              full (i + 5) (j + 8)+    full consumed (consumed `quot` 5 * 8)+  where+    src = ByteArray source+    len = SBS.length input+    capacity = encodedLength len+    byte i = indexByteArray src i :: Word8+{-# INLINE encodeShort #-}++-- | Decode with an ASCII lookup table. The caller checks the input length+-- and final padding before entering the loop.+--+-- @since 1.0+--+decodeShort+  :: Ptr Word8 -> ShortByteString -> Either Text ShortByteString+decodeShort (Ptr table) input@(SBS source) = runST $ do+      dst <- newByteArray capacity+#ifdef BASE32_SIMD+      consumed <- SIMD.decodeByteArrayPrefix table+        src (max 0 (len - 8)) dst+#else+      let consumed = 0+#endif+      let go !i !j+            | i + 8 >= len = final i j+            | otherwise = do+                let word = indexByteArray src (i `quot` 8) :: Word64+                    t = case targetByteOrder of+                      LittleEndian -> byteSwap64 word+                      BigEndian -> word+                    from shiftCount = fromIntegral+                      (aix (fromIntegral (t `unsafeShiftR` shiftCount)) table) :: Word64+                    !a = from 56+                    !b = from 48+                    !c = from 40+                    !d = from 32+                    !e = from 24+                    !f = from 16+                    !g = from 8+                    !h = from 0+                if (a .|. b .|. c .|. d .|. e .|. f .|. g .|. h) < 32+                  then do+                    writeFull j (pack a b c d e f g h)+                    go (i + 8) (j + 5)+                  else finishQuantum False i j a b c d e f g h+          final !i !j+            | i >= len = freeze j+            | otherwise = finishQuantum True i j+                (look i) (look (i + 1)) (look (i + 2)) (look (i + 3))+                (look (i + 4)) (look (i + 5)) (look (i + 6)) (look (i + 7))+          finishQuantum lastQuantum i j a b c d e f g h =+            case decodeQuantum lastQuantum i a b c d e f g h of+              Left err -> pure (Left err)+              Right count -> do+                let clean v = if v == 0x63 then 0 else v+                    w = pack a b (clean c) (clean d) (clean e)+                      (clean f) (clean g) (clean h)+                    write !k+                      | k == count = pure ()+                      | otherwise = do+                          writeByteArray dst (j + k)+                            (fromIntegral (w `unsafeShiftR` (32 - 8 * k)) :: Word8)+                          write (k + 1)+                write 0+                if lastQuantum then freeze (j + count) else go (i + 8) (j + count)+          pack a b c d e f g h =+            unsafeShiftL a 35 .|. unsafeShiftL b 30+              .|. unsafeShiftL c 25 .|. unsafeShiftL d 20+              .|. unsafeShiftL e 15 .|. unsafeShiftL f 10+              .|. unsafeShiftL g 5 .|. h+          writeFull j w = do+            writeByteArray dst j (fromIntegral (w `unsafeShiftR` 32) :: Word8)+            writeByteArray dst (j + 1) (fromIntegral (w `unsafeShiftR` 24) :: Word8)+            writeByteArray dst (j + 2) (fromIntegral (w `unsafeShiftR` 16) :: Word8)+            writeByteArray dst (j + 3) (fromIntegral (w `unsafeShiftR` 8) :: Word8)+            writeByteArray dst (j + 4) (fromIntegral w :: Word8)+          freeze n = do+            shrinkMutableByteArray dst n+            ByteArray result <- unsafeFreezeByteArray dst+            pure (Right (SBS result))+      go consumed (consumed `quot` 8 * 5)+  where+    src = ByteArray source+    len = SBS.length input+    remainder = len `rem` 8+    capacity = (len `quot` 8) * 5 + (remainder * 5 `quot` 8)+    look i+      | i >= len = 0x63+      | otherwise = fromIntegral (aix (indexByteArray src i) table) :: Word64+{-# INLINE decodeShort #-}++-- | Decode established provenance directly from a byte array, without+-- alphabet, size, padding-policy or canonical-bit validation.+--+-- @since 1.0+--+decodeShortTyped+  :: Ptr Word8 -> Base32 alphabet ShortByteString -> ShortByteString+decodeShortTyped (Ptr table) encoded = runST $ do+    dst <- newByteArray capacity+#ifdef BASE32_SIMD+    consumed <- SIMD.decodeByteArrayTypedPrefix table src len dst+#else+    let consumed = 0+#endif+    let go !i !j+          | len - i >= 8 = do+              let word = indexByteArray src (i `quot` 8) :: Word64+                  t = case targetByteOrder of+                    LittleEndian -> byteSwap64 word+                    BigEndian -> word+                  at n = fromIntegral+                    (aix (fromIntegral (t `unsafeShiftR` n)) table) :: Word64+                  w = at 56 `unsafeShiftL` 35 .|. at 48 `unsafeShiftL` 30+                    .|. at 40 `unsafeShiftL` 25 .|. at 32 `unsafeShiftL` 20+                    .|. at 24 `unsafeShiftL` 15 .|. at 16 `unsafeShiftL` 10+                    .|. at 8 `unsafeShiftL` 5 .|. at 0+              writeByteArray dst j (fromIntegral (w `unsafeShiftR` 32) :: Word8)+              writeByteArray dst (j + 1) (fromIntegral (w `unsafeShiftR` 24) :: Word8)+              writeByteArray dst (j + 2) (fromIntegral (w `unsafeShiftR` 16) :: Word8)+              writeByteArray dst (j + 3) (fromIntegral (w `unsafeShiftR` 8) :: Word8)+              writeByteArray dst (j + 4) (fromIntegral w :: Word8)+              go (i + 8) (j + 5)+          | otherwise = tailBytes i j 0 (0 :: Word16)+        tailBytes !i !j !bits !buffer+          | bits >= 8 = do+              let rest = bits - 8+              writeByteArray dst j (fromIntegral (buffer `unsafeShiftR` rest) :: Word8)+              tailBytes i (j + 1) rest buffer+          | i < len = tailBytes (i + 1) j (bits + 5)+              (buffer `unsafeShiftL` 5 .|. fromIntegral (aix (byte i) table))+          | otherwise = pure ()+    go consumed (consumed `quot` 8 * 5)+    ByteArray result <- unsafeFreezeByteArray dst+    pure (SBS result)+  where+    !input@(SBS source) = extractBase32 encoded+    src = ByteArray source+    byte i = indexByteArray src i :: Word8+    payloadEnd n+      | n > 0 && byte (n - 1) == 61 = payloadEnd (n - 1)+      | otherwise = n+    len = payloadEnd (SBS.length input)+    capacity = (len `quot` 8) * 5 + (len `rem` 8) * 5 `quot` 8+{-# INLINE decodeShortTyped #-}

@@ -1,4 +1,17 @@ {-# LANGUAGE TypeApplications #-}+-- |+-- Module       : Data.ByteString.Base32.Internal.Tables+-- Copyright    : (c) 2020-2026 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- Decoding tables for the standard and extended-hex alphabets.+--+-- @since 1.0+-- module Data.ByteString.Base32.Internal.Tables ( stdDecodeTable , hexDecodeTable@@ -11,6 +24,10 @@ import GHC.Ptr (Ptr)  +-- | ASCII decoding table for the standard alphabet.+--+-- @since 1.0+-- stdDecodeTable :: Ptr Word8 stdDecodeTable = writeNPlainPtrBytes @Word8 256     [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff@@ -32,6 +49,10 @@     ] {-# NOINLINE stdDecodeTable #-} +-- | ASCII decoding table for the extended-hex alphabet.+--+-- @since 1.0+-- hexDecodeTable :: Ptr Word8 hexDecodeTable = writeNPlainPtrBytes @Word8 256     [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff

@@ -1,5 +1,18 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-}+-- |+-- Module       : Data.ByteString.Base32.Internal.Tail+-- Copyright    : (c) 2020-2026 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- Final quantum encoding for padded and unpadded output.+--+-- @since 1.0+-- module Data.ByteString.Base32.Internal.Tail ( loopTail , loopTailNoPad@@ -20,6 +33,8 @@  -- | Unroll final quantum encoding for base32 --+-- @since 1.0+-- loopTail     :: Addr#     -> ForeignPtr Word8@@ -108,6 +123,8 @@ {-# INLINE loopTail #-}  -- | Unroll final quantum encoding for base32+--+-- @since 1.0 -- loopTailNoPad     :: Addr#

@@ -1,5 +1,18 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-}+-- |+-- Module       : Data.ByteString.Base32.Internal.Utils+-- Copyright    : (c) 2020-2026 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- Shared allocation, byte-order, table lookup, rechunking, and padding utilities.+--+-- @since 1.0+-- module Data.ByteString.Base32.Internal.Utils ( aix , peekWord32BE@@ -8,12 +21,16 @@ , w32 , w64 , w64_32+, encodedLength , writeNPlainPtrBytes+, validateLastNPads ) where   import Data.ByteString (ByteString) import qualified Data.ByteString as BS+import Data.Text (Text)+import qualified Data.Text as Text  import Foreign.Ptr import Foreign.Storable@@ -28,26 +45,42 @@  -- | Read 'Word8' index off alphabet addr --+-- @since 1.0+-- aix :: Word8 -> Addr# -> Word8 aix w8 alpha = W8# (indexWord8OffAddr# alpha i)   where     !(I# i) = fromIntegral w8 {-# INLINE aix #-} +-- | Widen a 'Word8' to a 'Word32'.+--+-- @since 1.0+-- w32 :: Word8 -> Word32 w32 = fromIntegral {-# INLINE w32 #-} +-- | Widen a 'Word32' to a 'Word64'.+--+-- @since 1.0+-- w64_32 :: Word32 -> Word64 w64_32 = fromIntegral {-# INLINE w64_32 #-} +-- | Widen a 'Word8' to a 'Word64'.+--+-- @since 1.0+-- w64 :: Word8 -> Word64 w64 = fromIntegral {-# INLINE w64 #-}  -- | Allocate and fill @n@ bytes with some data --+-- @since 1.0+-- writeNPlainPtrBytes   :: Storable a   => Int@@ -62,12 +95,20 @@     go !p (x:xs) = poke p x >> go (plusPtr p 1) xs {-# INLINE writeNPlainPtrBytes #-} +-- | Read a 32-bit word in big-endian byte order.+--+-- @since 1.0+-- peekWord32BE :: Ptr Word32 -> IO Word32 peekWord32BE p = case targetByteOrder of   LittleEndian -> byteSwap32 <$> peek p   BigEndian -> peek p {-# inline peekWord32BE #-} +-- | Read a 64-bit word in big-endian byte order.+--+-- @since 1.0+-- peekWord64BE :: Ptr Word64 -> IO Word64 peekWord64BE p = case targetByteOrder of   LittleEndian -> byteSwap64 <$> peek p@@ -76,6 +117,8 @@  -- | Rechunk a list of bytestrings in multiples of @n@ --+-- @since 1.0+-- reChunkN :: Int -> [ByteString] -> [ByteString] reChunkN n = go   where@@ -96,3 +139,32 @@                in acc' : go cs'              else accum acc' cs {-# INLINE reChunkN #-}++-- | Padded output capacity, using checked integer arithmetic.+--+-- @since 1.0+--+encodedLength :: Int -> Int+encodedLength n+  | n < 0 || blocks > maxBound `quot` 8 = error "Base32 output is too large"+  | otherwise = blocks * 8+  where+    blocks = n `quot` 5 + if n `rem` 5 == 0 then 0 else 1+{-# INLINE encodedLength #-}++-- | Reject '=' in the final @n@ bytes before running the decoder.+-- The caller selects @n@ from the input length and padding policy, preventing+-- existing padding from being accepted when missing padding is added.+--+-- @since 1.0+--+validateLastNPads+    :: Int+    -> ByteString+    -> IO (Either Text ByteString)+    -> Either Text ByteString+validateLastNPads n bs io+    | BS.elem 0x3d (BS.drop (BS.length bs - n) bs) =+        Left (Text.pack "Base32-encoded bytestring has invalid padding")+    | otherwise = unsafeDupablePerformIO io+{-# INLINE validateLastNPads #-}

@@ -1,8 +1,10 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Lazy.Base32--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -21,30 +23,32 @@ , encodeBase32Unpadded , encodeBase32Unpadded'   -- * Decoding+, decodeBase32Untyped+, decodeBase32UnpaddedUntyped+, decodeBase32PaddedUntyped+  -- * Validation , decodeBase32-, decodeBase32Unpadded , decodeBase32Padded---, decodeBase32Lenient-  -- * Validation-, isBase32-, isValidBase32+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  -import Prelude hiding (all, elem) +import Data.Base32.Types+ import qualified Data.ByteString as BS import qualified Data.ByteString.Base32 as B32 import Data.ByteString.Base32.Internal.Utils (reChunkN)-import Data.ByteString.Lazy (elem, fromChunks, toChunks)+import Data.ByteString.Lazy (fromChunks, toChunks) import Data.ByteString.Lazy.Internal (ByteString(..))-import Data.Either (isRight) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL  --- | Encode a 'ByteString' value as a Base32 'Text' value with padding.+-- | Encode a 'ByteString' value as a Base32 'TL.Text' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --@@ -53,8 +57,10 @@ -- >>> encodeBase32 "Sun" -- "KN2W4===" ---encodeBase32 :: ByteString -> TL.Text-encodeBase32 = TL.decodeUtf8 . encodeBase32'+-- @since 1.0+--+encodeBase32 :: ByteString -> Base32 'StdPadded TL.Text+encodeBase32 = fmap TL.decodeUtf8 . encodeBase32' {-# INLINE encodeBase32 #-}  -- | Encode a 'ByteString' as a Base32 'ByteString' value with padding.@@ -63,40 +69,46 @@ -- -- === __Examples__: ----- >>> encodeBase32 "Sun"+-- >>> encodeBase32' "Sun" -- "KN2W4===" ---encodeBase32' :: ByteString -> ByteString-encodeBase32' = fromChunks-  . fmap B32.encodeBase32'+-- @since 1.0+--+encodeBase32' :: ByteString -> Base32 'StdPadded ByteString+encodeBase32' = assertBase32 . fromChunks+  . fmap (extractBase32 . B32.encodeBase32')   . reChunkN 5   . toChunks --- | Decode an arbitrarily padded Base32 encoded 'ByteString' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as Base32-encoded values are optionally padded.+-- | Decode an arbitrarily padded Base32 encoded 'ByteString' value. If its length is not+-- a multiple+-- of 8, then padding chars will be added to fill out the input to a multiple of+-- 8 for safe decoding as Base32-encoded values are optionally padded. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32 "KN2W4==="+-- >>> decodeBase32Untyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32 "KN2W4"+-- >>> decodeBase32Untyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32 "KN2W==="+-- >>> decodeBase32Untyped "KN2W===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: ByteString -> Either T.Text ByteString-decodeBase32 = fmap (fromChunks . (:[]))-  . B32.decodeBase32+-- @since 1.0+--+decodeBase32Untyped :: ByteString -> Either T.Text ByteString+decodeBase32Untyped = fmap (fromChunks . (:[]))+  . B32.decodeBase32Untyped   . BS.concat   . toChunks-{-# INLINE decodeBase32 #-}+{-# INLINE decodeBase32Untyped #-} --- | Encode a 'ByteString' value as Base32 'Text' without padding. Note that for Base32,+-- | Encode a 'ByteString' value as Base32 'TL.Text' without padding.+-- Note that for Base32, -- padding is optional. If you call this function, you will simply be encoding -- as Base32 and stripping padding chars from the output. --@@ -107,8 +119,10 @@ -- >>> encodeBase32Unpadded "Sun" -- "KN2W4" ---encodeBase32Unpadded :: ByteString -> TL.Text-encodeBase32Unpadded = TL.decodeUtf8 . encodeBase32Unpadded'+-- @since 1.0+--+encodeBase32Unpadded :: ByteString -> Base32 'StdUnpadded TL.Text+encodeBase32Unpadded = fmap TL.decodeUtf8 . encodeBase32Unpadded' {-# INLINE encodeBase32Unpadded #-}  -- | Encode a 'ByteString' value as Base32 without padding. Note that for Base32,@@ -122,9 +136,11 @@ -- >>> encodeBase32Unpadded' "Sun" -- "KN2W4" ---encodeBase32Unpadded' :: ByteString -> ByteString-encodeBase32Unpadded' = fromChunks-  . fmap B32.encodeBase32Unpadded'+-- @since 1.0+--+encodeBase32Unpadded' :: ByteString -> Base32 'StdUnpadded ByteString+encodeBase32Unpadded' = assertBase32 . fromChunks+  . fmap (extractBase32 . B32.encodeBase32Unpadded')   . reChunkN 5   . toChunks @@ -133,111 +149,139 @@ -- confirm. -- -- In general, unless unpadded Base32 is explicitly required, it is--- safer to call 'decodeBase32'.+-- safer to call 'decodeBase32Untyped'. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Unpadded "KN2W4"+-- >>> decodeBase32UnpaddedUntyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32Unpadded "KN2W4==="+-- >>> decodeBase32UnpaddedUntyped "KN2W4===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: ByteString -> Either T.Text ByteString-decodeBase32Unpadded = fmap (fromChunks . (:[]))-  . B32.decodeBase32Unpadded+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: ByteString -> Either T.Text ByteString+decodeBase32UnpaddedUntyped = fmap (fromChunks . (:[]))+  . B32.decodeBase32UnpaddedUntyped   . BS.concat   . toChunks-{-# INLINE decodeBase32Unpadded #-}+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Decode a padded Base32-encoded 'ByteString' value. Input strings are -- required to be correctly padded, and will be validated prior to decoding -- to confirm. -- -- In general, unless padded Base32 is explicitly required, it is--- safer to call 'decodeBase32'.+-- safer to call 'decodeBase32Untyped'. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Padded "KN2W4==="+-- >>> decodeBase32PaddedUntyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32Padded "KN2W4"+-- >>> decodeBase32PaddedUntyped "KN2W4" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: ByteString -> Either T.Text ByteString-decodeBase32Padded = fmap (fromChunks . (:[]))-  . B32.decodeBase32Padded+-- @since 1.0+--+decodeBase32PaddedUntyped :: ByteString -> Either T.Text ByteString+decodeBase32PaddedUntyped = fmap (fromChunks . (:[]))+  . B32.decodeBase32PaddedUntyped   . BS.concat   . toChunks-{-# INLINE decodeBase32Padded #-}+{-# INLINE decodeBase32PaddedUntyped #-} --- -- | Leniently decode an unpadded Base32-encoded 'ByteString'. This function--- -- will not generate parse errors. If input data contains padding chars,--- -- then the input will be parsed up until the first pad character.--- ----- -- __Note:__ This is not RFC 4648-compliant.--- ----- -- === __Examples__:--- ----- -- >>> decodeBase32Lenient "PDw_Pj4="--- -- "<<?>>"--- ----- -- >>> decodeBase32Lenient "PDw_%%%$}Pj4"--- -- "<<?>>"--- ----- decodeBase32Lenient :: ByteString -> ByteString--- decodeBase32Lenient = fromChunks---     . fmap B32.decodeBase32Lenient---     . reChunkN 8---     . fmap (BS.filter (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567="))---     . toChunks--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32-encoded 'ByteString' value.+--+-- This function is padding-agnostic.+--+-- >>> decodeBase32 (encodeBase32' "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded' "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: forall k. StdAlphabet k => Base32 k ByteString -> ByteString+decodeBase32 = fromChunks+  . fmap (B32.decodeBase32+      . (assertBase32 :: BS.ByteString -> Base32 k BS.ByteString))+  . reChunkN 8 . toChunks . extractBase32+{-# INLINE decodeBase32 #-} --- | Tell whether a 'ByteString' is Base32-encoded.+-- | Decode a typed, padded Base32-encoded 'ByteString' value. ----- === __Examples__:+-- >>> decodeBase32Padded (encodeBase32' "Sun")+-- "Sun" ----- >>> isBase32 "KN2W4"--- True+-- @since 1.0 ----- >>> isBase32 "KN2W4==="--- True+decodeBase32Padded :: Base32 'StdPadded ByteString -> ByteString+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32-encoded value, assuming that it has padding. ----- >>> isBase32 "KN2W4=="--- False+-- >>> parseBase32Padded "kn2w4==="+-- Right "kn2w4===" ---isBase32 :: ByteString -> Bool-isBase32 bs = isValidBase32 bs && isRight (decodeBase32 bs)-{-# INLINE isBase32 #-}+-- >>> fmap decodeBase32Padded (parseBase32Padded "KN2W4===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: ByteString -> Either T.Text (Base32 'StdPadded ByteString)+parseBase32Padded value = assertBase32 value+  <$ (decodeBase32PaddedUntyped) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'ByteString' is a valid Base32 format.+-- | Decode a typed, unpadded Base32-encoded value. ----- This will not tell you whether or not this is a correct Base32 representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base32 encoded 'ByteString' value, use 'isBase32'.+-- >>> decodeBase32Unpadded (encodeBase32Unpadded' "Sun")+-- "Sun" ----- === __Examples__:+-- @since 1.0 ----- >>> isValidBase32 "KN2W4"--- True+decodeBase32Unpadded :: Base32 'StdUnpadded ByteString -> ByteString+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32-encoded value, assuming that it is unpadded. ----- >>> isValidBase32 "KN2W4="--- False+-- >>> parseBase32Unpadded "kn2w4"+-- Right "kn2w4" ----- >>> isValidBase32 "KN2W4%"--- False+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "KN2W4")+-- Right "Sun" ---isValidBase32 :: ByteString -> Bool-isValidBase32 = go . toChunks-  where-    go [] = True-    go [c] = B32.isValidBase32 c-    go (c:cs) = -- note the lack of padding char-      BS.all (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567") c-      && go cs-{-# INLINE isValidBase32 #-}+-- >>> parseBase32Unpadded ""+-- Right ""+--+-- >>> parseBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "MZ")+-- True+--+-- @since 1.0+--+parseBase32Unpadded :: ByteString -> Either T.Text (Base32 'StdUnpadded ByteString)+parseBase32Unpadded value = assertBase32 value+  <$ (decodeBase32UnpaddedUntyped) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import Data.Either (isLeft)

@@ -1,8 +1,10 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Lazy.Base32.Hex--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -21,30 +23,32 @@ , encodeBase32Unpadded , encodeBase32Unpadded'   -- * Decoding+, decodeBase32Untyped+, decodeBase32UnpaddedUntyped+, decodeBase32PaddedUntyped+  -- * Validation , decodeBase32-, decodeBase32Unpadded , decodeBase32Padded---, decodeBase32Lenient-  -- * Validation-, isBase32Hex-, isValidBase32Hex+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  -import Prelude hiding (all, elem) +import Data.Base32.Types+ import qualified Data.ByteString as BS import qualified Data.ByteString.Base32.Hex as B32H import Data.ByteString.Base32.Internal.Utils (reChunkN)-import Data.ByteString.Lazy (elem, fromChunks, toChunks)+import Data.ByteString.Lazy (fromChunks, toChunks) import Data.ByteString.Lazy.Internal (ByteString(..))-import Data.Either (isRight) import qualified Data.Text as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL  --- | Encode a 'ByteString' value as a Base32hex 'Text' value with padding.+-- | Encode a 'ByteString' value as a Base32hex 'TL.Text' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> --@@ -53,8 +57,10 @@ -- >>> encodeBase32 "Sun" -- "ADQMS===" ---encodeBase32 :: ByteString -> TL.Text-encodeBase32 = TL.decodeUtf8 . encodeBase32'+-- @since 1.0+--+encodeBase32 :: ByteString -> Base32 'HexPadded TL.Text+encodeBase32 = fmap TL.decodeUtf8 . encodeBase32' {-# INLINE encodeBase32 #-}  -- | Encode a 'ByteString' as a Base32hex 'ByteString' value with padding.@@ -66,37 +72,43 @@ -- >>> encodeBase32' "Sun" -- "ADQMS===" ---encodeBase32' :: ByteString -> ByteString-encodeBase32' = fromChunks-    . fmap B32H.encodeBase32'+-- @since 1.0+--+encodeBase32' :: ByteString -> Base32 'HexPadded ByteString+encodeBase32' = assertBase32 . fromChunks+    . fmap (extractBase32 . B32H.encodeBase32')     . reChunkN 5     . toChunks --- | Decode an arbitrarily padded Base32hex encoded 'ByteString' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as Base32hex-encoded values are optionally padded.+-- | Decode an arbitrarily padded Base32hex encoded 'ByteString' value. If its length is+-- not a multiple+-- of 8, then padding chars will be added to fill out the input to a multiple of+-- 8 for safe decoding as Base32hex-encoded values are optionally padded. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32 "ADQMS==="+-- >>> decodeBase32Untyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32 "ADQMS"+-- >>> decodeBase32Untyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32 "ADQMS==="+-- >>> decodeBase32Untyped "ADQM===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: ByteString -> Either T.Text ByteString-decodeBase32 = fmap (fromChunks . (:[]))-    . B32H.decodeBase32+-- @since 1.0+--+decodeBase32Untyped :: ByteString -> Either T.Text ByteString+decodeBase32Untyped = fmap (fromChunks . (:[]))+    . B32H.decodeBase32Untyped     . BS.concat     . toChunks-{-# INLINE decodeBase32 #-}+{-# INLINE decodeBase32Untyped #-} --- | Encode a 'ByteString' value as Base32hex 'Text' without padding. Note that for Base32hex,+-- | Encode a 'ByteString' value as Base32hex 'TL.Text' without padding. Note that for+-- Base32hex, -- padding is optional. If you call this function, you will simply be encoding -- as Base32hex and stripping padding chars from the output. --@@ -107,8 +119,10 @@ -- >>> encodeBase32Unpadded "Sun" -- "ADQMS" ---encodeBase32Unpadded :: ByteString -> TL.Text-encodeBase32Unpadded = TL.decodeUtf8 . encodeBase32Unpadded'+-- @since 1.0+--+encodeBase32Unpadded :: ByteString -> Base32 'HexUnpadded TL.Text+encodeBase32Unpadded = fmap TL.decodeUtf8 . encodeBase32Unpadded' {-# INLINE encodeBase32Unpadded #-}  -- | Encode a 'ByteString' value as Base32hex without padding. Note that for Base32hex,@@ -122,9 +136,11 @@ -- >>> encodeBase32Unpadded' "Sun" -- "ADQMS" ---encodeBase32Unpadded' :: ByteString -> ByteString-encodeBase32Unpadded' = fromChunks-    . fmap B32H.encodeBase32Unpadded'+-- @since 1.0+--+encodeBase32Unpadded' :: ByteString -> Base32 'HexUnpadded ByteString+encodeBase32Unpadded' = assertBase32 . fromChunks+    . fmap (extractBase32 . B32H.encodeBase32Unpadded')     . reChunkN 5     . toChunks @@ -133,112 +149,139 @@ -- confirm. -- -- In general, unless unpadded Base32hex is explicitly required, it is--- safer to call 'decodeBase32'.+-- safer to call 'decodeBase32Untyped'. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32Unpadded "ADQMS"+-- >>> decodeBase32UnpaddedUntyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32Unpadded "ADQMS==="+-- >>> decodeBase32UnpaddedUntyped "ADQMS===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: ByteString -> Either T.Text ByteString-decodeBase32Unpadded = fmap (fromChunks . (:[]))-    . B32H.decodeBase32Unpadded+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: ByteString -> Either T.Text ByteString+decodeBase32UnpaddedUntyped = fmap (fromChunks . (:[]))+    . B32H.decodeBase32UnpaddedUntyped     . BS.concat     . toChunks-{-# INLINE decodeBase32Unpadded #-}+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Decode a padded Base32hex-encoded 'ByteString' value. Input strings are -- required to be correctly padded, and will be validated prior to decoding -- to confirm. -- -- In general, unless padded Base32hex is explicitly required, it is--- safer to call 'decodeBase32'.+-- safer to call 'decodeBase32Untyped'. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32Padded "ADQMS==="+-- >>> decodeBase32PaddedUntyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32Padded "ADQMS"+-- >>> decodeBase32PaddedUntyped "ADQMS" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: ByteString -> Either T.Text ByteString-decodeBase32Padded = fmap (fromChunks . (:[]))-    . B32H.decodeBase32Padded+-- @since 1.0+--+decodeBase32PaddedUntyped :: ByteString -> Either T.Text ByteString+decodeBase32PaddedUntyped = fmap (fromChunks . (:[]))+    . B32H.decodeBase32PaddedUntyped     . BS.concat     . toChunks-{-# INLINE decodeBase32Padded #-}+{-# INLINE decodeBase32PaddedUntyped #-} --- -- | Leniently decode an unpadded Base32hex-encoded 'ByteString'. This function--- -- will not generate parse errors. If input data contains padding chars,--- -- then the input will be parsed up until the first pad character.--- ----- -- __Note:__ This is not RFC 4648-compliant.--- ----- -- === __Examples__:--- ----- -- >>> decodeBase32Lenient "PDw_Pj4="--- -- "<<?>>"--- ----- -- >>> decodeBase32Lenient "PDw_%%%$}Pj4"--- -- "<<?>>"--- ----- decodeBase32Lenient :: ByteString -> ByteString--- decodeBase32Lenient = fromChunks---     . fmap B32H.decodeBase32Lenient---     . reChunkN 8---     . fmap (BS.filter (flip elem "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567="))---     . toChunks--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32hex-encoded 'ByteString' value.+--+-- This function is padding-agnostic.+--+-- >>> decodeBase32 (encodeBase32' "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded' "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: forall k. HexAlphabet k => Base32 k ByteString -> ByteString+decodeBase32 = fromChunks+  . fmap (B32H.decodeBase32+      . (assertBase32 :: BS.ByteString -> Base32 k BS.ByteString))+  . reChunkN 8 . toChunks . extractBase32+{-# INLINE decodeBase32 #-} --- | Tell whether a 'ByteString' is Base32hex-encoded.+-- | Decode a typed, padded Base32hex-encoded 'ByteString' value. ----- === __Examples__:+-- >>> decodeBase32Padded (encodeBase32' "Sun")+-- "Sun" ----- >>> isBase32Hex "ADQMS"--- True+-- @since 1.0 ----- >>> isBase32Hex "ADQMS==="--- True+decodeBase32Padded :: Base32 'HexPadded ByteString -> ByteString+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32hex-encoded value, assuming that it has padding. ----- >>> isBase32Hex "ADQMS=="--- False+-- >>> parseBase32Padded "adqms==="+-- Right "adqms===" ---isBase32Hex :: ByteString -> Bool-isBase32Hex bs = isValidBase32Hex bs && isRight (decodeBase32 bs)-{-# INLINE isBase32Hex #-}+-- >>> fmap decodeBase32Padded (parseBase32Padded "ADQMS===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: ByteString -> Either T.Text (Base32 'HexPadded ByteString)+parseBase32Padded value = assertBase32 value+  <$ (decodeBase32PaddedUntyped) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'ByteString' is a valid Base32hex format.+-- | Decode a typed, unpadded Base32hex-encoded value. ----- This will not tell you whether or not this is a correct Base32hex representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base32hex encoded 'ByteString' value, use 'isBase32Hex'.+-- >>> decodeBase32Unpadded (encodeBase32Unpadded' "Sun")+-- "Sun" ----- === __Examples__:+-- @since 1.0 --+decodeBase32Unpadded :: Base32 'HexUnpadded ByteString -> ByteString+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32hex-encoded value, assuming that it is unpadded. ----- >>> isValidBase32Hex "ADQMS"--- True+-- >>> parseBase32Unpadded "adqms"+-- Right "adqms" ----- >>> isValidBase32Hex "ADQMS="--- False+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "ADQMS")+-- Right "Sun" ----- >>> isValidBase32Hex "ADQMS%"--- False+-- >>> parseBase32Unpadded ""+-- Right "" ---isValidBase32Hex :: ByteString -> Bool-isValidBase32Hex = go . toChunks-  where-    go [] = True-    go [c] = B32H.isValidBase32Hex c-    go (c:cs) = -- note the lack of padding char-      BS.all (flip elem "0123456789ABCDEFGHIJKLMNOPQRSTUV") c-      && go cs-{-# INLINE isValidBase32Hex #-}+-- >>> parseBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "CP")+-- True+--+-- @since 1.0+--+parseBase32Unpadded :: ByteString -> Either T.Text (Base32 'HexUnpadded ByteString)+parseBase32Unpadded value = assertBase32 value+  <$ (decodeBase32UnpaddedUntyped) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import Data.Either (isLeft)

@@ -1,7 +1,10 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Short.Base32--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -20,19 +23,26 @@ , encodeBase32Unpadded , encodeBase32Unpadded'   -- * Decoding+, decodeBase32Untyped+, decodeBase32UnpaddedUntyped+, decodeBase32PaddedUntyped+  -- * Validation , decodeBase32-, decodeBase32Unpadded , decodeBase32Padded---, decodeBase32Lenient-  -- * Validation-, isBase32-, isValidBase32+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  -import qualified Data.ByteString.Base32 as B32-import Data.ByteString.Short (ShortByteString, fromShort, toShort)+import Data.ByteString.Base32.Internal.Short+import Data.ByteString.Base32.Internal.Tables+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as SBS+import Data.Base32.Types+ import Data.Text (Text)+import qualified Data.Text as Text import Data.Text.Short (ShortText) import Data.Text.Short.Unsafe (fromShortByteStringUnsafe) @@ -46,8 +56,10 @@ -- >>> encodeBase32 "Sun" -- "KN2W4===" ---encodeBase32 :: ShortByteString -> ShortText-encodeBase32 = fromShortByteStringUnsafe . encodeBase32'+-- @since 1.0+--+encodeBase32 :: ShortByteString -> Base32 'StdPadded ShortText+encodeBase32 = fmap fromShortByteStringUnsafe . encodeBase32' {-# INLINE encodeBase32 #-}  -- | Encode a 'ShortByteString' as a Base32 'ShortByteString' value with padding.@@ -59,32 +71,53 @@ -- >>> encodeBase32' "Sun" -- "KN2W4===" ---encodeBase32' :: ShortByteString -> ShortByteString-encodeBase32' = toShort . B32.encodeBase32' . fromShort+-- @since 1.0+--+encodeBase32' :: ShortByteString -> Base32 'StdPadded ShortByteString+encodeBase32' =+  assertBase32+    . encodeShort+      "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"#+      True --- | Decode an arbitrarily padded Base32 encoded 'ShortByteString' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as Base32-encoded values are optionally padded.+-- | Decode an arbitrarily padded Base32 encoded 'ShortByteString' value. If its length is+-- not a multiple+-- of 8, then padding chars will be added to fill out the input to a multiple of+-- 8 for safe decoding as Base32-encoded values are optionally padded. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32 "KN2W4==="+-- >>> decodeBase32Untyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32 "KN2W4"+-- >>> decodeBase32Untyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32 "KN2W==="+-- >>> decodeBase32Untyped "KN2W===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: ShortByteString -> Either Text ShortByteString-decodeBase32 = fmap toShort . B32.decodeBase32 . fromShort--{-# INLINE decodeBase32 #-}+-- @since 1.0+--+decodeBase32Untyped :: ShortByteString -> Either Text ShortByteString+decodeBase32Untyped bs+    | l == 0 = Right bs+    | r == 1 || r == 3 || r == 6 =+        Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r == 4 && any isPad [1 .. 2]+      || r == 5 && any isPad [1 .. 3]+      || r == 7 && any isPad [1 .. 5] =+        Left (Text.pack "Base32-encoded bytestring has invalid padding")+    | otherwise = decodeShort stdDecodeTable bs+  where+    l = SBS.length bs+    r = l `rem` 8+    isPad i = SBS.index bs (l - i) == 0x3d+{-# INLINE decodeBase32Untyped #-} --- | Encode a 'ShortByteString' value as Base32 'Text' without padding. Note that for Base32,+-- | Encode a 'ShortByteString' value as Base32 'Text' without padding. Note that for+-- Base32, -- padding is optional. If you call this function, you will simply be encoding -- as Base32 and stripping padding chars from the output. --@@ -95,8 +128,10 @@ -- >>> encodeBase32Unpadded "Sun" -- "KN2W4" ---encodeBase32Unpadded :: ShortByteString -> ShortText-encodeBase32Unpadded = fromShortByteStringUnsafe . encodeBase32Unpadded'+-- @since 1.0+--+encodeBase32Unpadded :: ShortByteString -> Base32 'StdUnpadded ShortText+encodeBase32Unpadded = fmap fromShortByteStringUnsafe . encodeBase32Unpadded' {-# INLINE encodeBase32Unpadded #-}  -- | Encode a 'ShortByteString' value as Base32 without padding. Note that for Base32,@@ -110,103 +145,162 @@ -- >>> encodeBase32Unpadded' "Sun" -- "KN2W4" ---encodeBase32Unpadded' :: ShortByteString -> ShortByteString-encodeBase32Unpadded' = toShort . B32.encodeBase32Unpadded' . fromShort+-- @since 1.0+--+encodeBase32Unpadded' :: ShortByteString -> Base32 'StdUnpadded ShortByteString+encodeBase32Unpadded' =+  assertBase32+    . encodeShort+      "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"#+      False  -- | Decode an unpadded Base32-encoded 'ShortByteString' value. Input strings are -- required to be unpadded, and will undergo validation prior to decoding to -- confirm. -- -- In general, unless unpadded Base32 is explicitly required, it is--- safer to call 'decodeBase32'.+-- safer to call 'decodeBase32Untyped'. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Unpadded "KN2W4"+-- >>> decodeBase32UnpaddedUntyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32Unpadded "KN2W4==="+-- >>> decodeBase32UnpaddedUntyped "KN2W4===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: ShortByteString -> Either Text ShortByteString-decodeBase32Unpadded = fmap toShort . B32.decodeBase32Unpadded . fromShort-{-# INLINE decodeBase32Unpadded #-}+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: ShortByteString -> Either Text ShortByteString+decodeBase32UnpaddedUntyped bs+    | l == 0 = Right bs+    | r == 1 || r == 3 || r == 6 =+        Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r /= 2 && SBS.index bs (l - 1) == 0x3d =+        Left (Text.pack "Base32-encoded bytestring has invalid padding")+    | otherwise = decodeShort stdDecodeTable bs+  where+    l = SBS.length bs+    r = l `rem` 8+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Decode a padded Base32-encoded 'ShortByteString' value. Input strings are -- required to be correctly padded, and will be validated prior to decoding -- to confirm. -- -- In general, unless padded Base32 is explicitly required, it is--- safer to call 'decodeBase32'.+-- safer to call 'decodeBase32Untyped'. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Padded "KN2W4==="+-- >>> decodeBase32PaddedUntyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32Padded "KN2W4"+-- >>> decodeBase32PaddedUntyped "KN2W4" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: ShortByteString -> Either Text ShortByteString-decodeBase32Padded = fmap toShort . B32.decodeBase32Padded . fromShort-{-# INLINE decodeBase32Padded #-}+-- @since 1.0+--+decodeBase32PaddedUntyped :: ShortByteString -> Either Text ShortByteString+decodeBase32PaddedUntyped bs+    | l == 0 = Right bs+    | r == 1 || r == 3 || r == 6 =+        Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r /= 0 = Left (Text.pack "Base32-encoded bytestring requires padding")+    | otherwise = decodeShort stdDecodeTable bs+  where+    l = SBS.length bs+    r = l `rem` 8+{-# INLINE decodeBase32PaddedUntyped #-} --- -- | Leniently decode an unpadded Base32-encoded 'ShortByteString'. This function--- -- will not generate parse errors. If input data contains padding chars,--- -- then the input will be parsed up until the first pad character.--- ----- -- __Note:__ This is not RFC 4648-compliant.--- ----- -- === __Examples__:--- ----- -- >>> decodeBase32Lenient "PDw_Pj4="--- -- "<<?>>"--- ----- -- >>> decodeBase32Lenient "PDw_%%%$}Pj4"--- -- "<<?>>"--- ----- decodeBase32Lenient :: ShortByteString -> ShortByteString--- decodeBase32Lenient = toShort . B32.decodeBase32Lenient . fromShort--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32-encoded 'ShortByteString' value.+--+-- This function is padding-agnostic.+--+-- >>> decodeBase32 (encodeBase32' "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded' "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: StdAlphabet k => Base32 k ShortByteString -> ShortByteString+decodeBase32 = decodeShortTyped stdDecodeTable+{-# INLINE decodeBase32 #-} --- | Tell whether a 'ShortByteString' is Base32-encoded.+-- | Decode a typed, padded Base32-encoded 'ShortByteString' value. ----- === __Examples__:+-- >>> decodeBase32Padded (encodeBase32' "Sun")+-- "Sun" ----- >>> isBase32 "KN2W4"--- True+-- @since 1.0 ----- >>> isBase32 "KN2W4==="--- True+decodeBase32Padded :: Base32 'StdPadded ShortByteString -> ShortByteString+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32-encoded value, assuming that it has padding. ----- >>> isBase32 "KN2W4=="--- False+-- >>> parseBase32Padded "kn2w4==="+-- Right "kn2w4===" ---isBase32 :: ShortByteString -> Bool-isBase32 = B32.isBase32 . fromShort-{-# INLINE isBase32 #-}+-- >>> fmap decodeBase32Padded (parseBase32Padded "KN2W4===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: ShortByteString -> Either Text (Base32 'StdPadded ShortByteString)+parseBase32Padded value = assertBase32 value+  <$ (decodeBase32PaddedUntyped) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'ShortByteString' is a valid Base32 format.+-- | Decode a typed, unpadded Base32-encoded value. ----- This will not tell you whether or not this is a correct Base32 representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base32 encoded 'ShortByteString' value, use 'isBase32'.+-- >>> decodeBase32Unpadded (encodeBase32Unpadded' "Sun")+-- "Sun" ----- === __Examples__:+-- @since 1.0 ----- >>> isValidBase32 "KN2W4"--- True+decodeBase32Unpadded :: Base32 'StdUnpadded ShortByteString -> ShortByteString+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32-encoded value, assuming that it is unpadded. ----- >>> isValidBase32 "KN2W4="--- False+-- >>> parseBase32Unpadded "kn2w4"+-- Right "kn2w4" ----- >>> isValidBase32 "KN2W4%"--- False+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "KN2W4")+-- Right "Sun" ---isValidBase32 :: ShortByteString -> Bool-isValidBase32 = B32.isValidBase32 . fromShort-{-# INLINE isValidBase32 #-}+-- >>> parseBase32Unpadded ""+-- Right ""+--+-- >>> parseBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "MZ")+-- True+--+-- @since 1.0+--+parseBase32Unpadded+  :: ShortByteString -> Either Text (Base32 'StdUnpadded ShortByteString)+parseBase32Unpadded value = assertBase32 value+  <$ (decodeBase32UnpaddedUntyped) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import Data.Either (isLeft)

@@ -1,7 +1,10 @@+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Short.Base32.Hex--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -20,19 +23,26 @@ , encodeBase32Unpadded , encodeBase32Unpadded'   -- * Decoding+, decodeBase32Untyped+, decodeBase32UnpaddedUntyped+, decodeBase32PaddedUntyped+  -- * Validation , decodeBase32-, decodeBase32Unpadded , decodeBase32Padded---, decodeBase32Lenient-  -- * Validation-, isBase32Hex-, isValidBase32Hex+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  -import qualified Data.ByteString.Base32.Hex as B32H-import Data.ByteString.Short (ShortByteString, fromShort, toShort)+import Data.ByteString.Base32.Internal.Short+import Data.ByteString.Base32.Internal.Tables+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as SBS+import Data.Base32.Types+ import Data.Text (Text)+import qualified Data.Text as Text import Data.Text.Short (ShortText) import Data.Text.Short.Unsafe (fromShortByteStringUnsafe) @@ -45,8 +55,10 @@ -- >>> encodeBase32 "Sun" -- "ADQMS===" ---encodeBase32 :: ShortByteString -> ShortText-encodeBase32 = fromShortByteStringUnsafe . encodeBase32'+-- @since 1.0+--+encodeBase32 :: ShortByteString -> Base32 'HexPadded ShortText+encodeBase32 = fmap fromShortByteStringUnsafe . encodeBase32' {-# INLINE encodeBase32 #-}  -- | Encode a 'ShortByteString' as a Base32hex 'ShortByteString' value with padding.@@ -58,31 +70,53 @@ -- >>> encodeBase32' "Sun" -- "ADQMS===" ---encodeBase32' :: ShortByteString -> ShortByteString-encodeBase32' = toShort . B32H.encodeBase32' . fromShort+-- @since 1.0+--+encodeBase32' :: ShortByteString -> Base32 'HexPadded ShortByteString+encodeBase32' =+  assertBase32+    . encodeShort+      "0123456789ABCDEFGHIJKLMNOPQRSTUV"#+      True --- | Decode an arbitrarily padded Base32hex encoded 'ShortByteString' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as Base32hex-encoded values are optionally padded.+-- | Decode an arbitrarily padded Base32hex encoded 'ShortByteString' value. If its length+-- is not a multiple+-- of 8, then padding chars will be added to fill out the input to a multiple of+-- 8 for safe decoding as Base32hex-encoded values are optionally padded. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32 "ADQMS==="+-- >>> decodeBase32Untyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32 "ADQMS"+-- >>> decodeBase32Untyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32 "ADQM==="+-- >>> decodeBase32Untyped "ADQM===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: ShortByteString -> Either Text ShortByteString-decodeBase32 = fmap toShort . B32H.decodeBase32 . fromShort-{-# INLINE decodeBase32 #-}+-- @since 1.0+--+decodeBase32Untyped :: ShortByteString -> Either Text ShortByteString+decodeBase32Untyped bs+    | l == 0 = Right bs+    | r == 1 || r == 3 || r == 6 =+        Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r == 4 && any isPad [1 .. 2]+      || r == 5 && any isPad [1 .. 3]+      || r == 7 && any isPad [1 .. 5] =+        Left (Text.pack "Base32-encoded bytestring has invalid padding")+    | otherwise = decodeShort hexDecodeTable bs+  where+    l = SBS.length bs+    r = l `rem` 8+    isPad i = SBS.index bs (l - i) == 0x3d+{-# INLINE decodeBase32Untyped #-} --- | Encode a 'ShortByteString' value as Base32hex 'Text' without padding. Note that for Base32hex,+-- | Encode a 'ShortByteString' value as Base32hex 'Text' without padding. Note that for+-- Base32hex, -- padding is optional. If you call this function, you will simply be encoding -- as Base32hex and stripping padding chars from the output. --@@ -90,14 +124,17 @@ -- -- === __Examples__: ----- >>> encodeBase32Unpadded' "Sun"+-- >>> encodeBase32Unpadded "Sun" -- "ADQMS" ---encodeBase32Unpadded :: ShortByteString -> ShortText-encodeBase32Unpadded = fromShortByteStringUnsafe . encodeBase32Unpadded'+-- @since 1.0+--+encodeBase32Unpadded :: ShortByteString -> Base32 'HexUnpadded ShortText+encodeBase32Unpadded = fmap fromShortByteStringUnsafe . encodeBase32Unpadded' {-# INLINE encodeBase32Unpadded #-} --- | Encode a 'ShortByteString' value as Base32hex without padding. Note that for Base32hex,+-- | Encode a 'ShortByteString' value as Base32hex without padding. Note that for+-- Base32hex, -- padding is optional. If you call this function, you will simply be encoding -- as Base32hex and stripping padding chars from the output. --@@ -108,103 +145,162 @@ -- >>> encodeBase32Unpadded' "Sun" -- "ADQMS" ---encodeBase32Unpadded' :: ShortByteString -> ShortByteString-encodeBase32Unpadded' = toShort . B32H.encodeBase32Unpadded' . fromShort+-- @since 1.0+--+encodeBase32Unpadded' :: ShortByteString -> Base32 'HexUnpadded ShortByteString+encodeBase32Unpadded' =+  assertBase32+    . encodeShort+      "0123456789ABCDEFGHIJKLMNOPQRSTUV"#+      False  -- | Decode an unpadded Base32hex-encoded 'ShortByteString' value. Input strings are -- required to be unpadded, and will undergo validation prior to decoding to -- confirm. -- -- In general, unless unpadded Base32hex is explicitly required, it is--- safer to call 'decodeBase32'.+-- safer to call 'decodeBase32Untyped'. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32Unpadded "ADQMS"+-- >>> decodeBase32UnpaddedUntyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32Unpadded "ADQMS==="+-- >>> decodeBase32UnpaddedUntyped "ADQMS===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: ShortByteString -> Either Text ShortByteString-decodeBase32Unpadded = fmap toShort . B32H.decodeBase32Unpadded . fromShort-{-# INLINE decodeBase32Unpadded #-}+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: ShortByteString -> Either Text ShortByteString+decodeBase32UnpaddedUntyped bs+    | l == 0 = Right bs+    | r == 1 || r == 3 || r == 6 =+        Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r /= 2 && SBS.index bs (l - 1) == 0x3d =+        Left (Text.pack "Base32-encoded bytestring has invalid padding")+    | otherwise = decodeShort hexDecodeTable bs+  where+    l = SBS.length bs+    r = l `rem` 8+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Decode a padded Base32hex-encoded 'ShortByteString' value. Input strings are -- required to be correctly padded, and will be validated prior to decoding -- to confirm. -- -- In general, unless padded Base32hex is explicitly required, it is--- safer to call 'decodeBase32'.+-- safer to call 'decodeBase32Untyped'. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32Padded "ADQMS==="+-- >>> decodeBase32PaddedUntyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32Padded "ADQMS"+-- >>> decodeBase32PaddedUntyped "ADQMS" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: ShortByteString -> Either Text ShortByteString-decodeBase32Padded = fmap toShort . B32H.decodeBase32Padded . fromShort-{-# INLINE decodeBase32Padded #-}+-- @since 1.0+--+decodeBase32PaddedUntyped :: ShortByteString -> Either Text ShortByteString+decodeBase32PaddedUntyped bs+    | l == 0 = Right bs+    | r == 1 || r == 3 || r == 6 =+        Left (Text.pack "Base32-encoded bytestring has invalid size")+    | r /= 0 = Left (Text.pack "Base32-encoded bytestring requires padding")+    | otherwise = decodeShort hexDecodeTable bs+  where+    l = SBS.length bs+    r = l `rem` 8+{-# INLINE decodeBase32PaddedUntyped #-} --- -- | Leniently decode an unpadded Base32hex-encoded 'ShortByteString'. This function--- -- will not generate parse errors. If input data contains padding chars,--- -- then the input will be parsed up until the first pad character.--- ----- -- __Note:__ This is not RFC 4648-compliant.--- ----- -- === __Examples__:--- ----- -- >>> decodeBase32Lenient "PDw_Pj4="--- -- "<<?>>"--- ----- -- >>> decodeBase32Lenient "PDw_%%%$}Pj4"--- -- "<<?>>"--- ----- decodeBase32Lenient :: ShortByteString -> ShortByteString--- decodeBase32Lenient = toShort . B32H.decodeBase32Lenient . fromShort--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32hex-encoded 'ShortByteString' value.+--+-- This function is padding-agnostic.+--+-- >>> decodeBase32 (encodeBase32' "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded' "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: HexAlphabet k => Base32 k ShortByteString -> ShortByteString+decodeBase32 = decodeShortTyped hexDecodeTable+{-# INLINE decodeBase32 #-} --- | Tell whether a 'ShortByteString' is Base32hex-encoded.+-- | Decode a typed, padded Base32hex-encoded 'ShortByteString' value. ----- === __Examples__:+-- >>> decodeBase32Padded (encodeBase32' "Sun")+-- "Sun" ----- >>> isBase32Hex "ADQMS"--- True+-- @since 1.0 ----- >>> isBase32Hex "ADQMS==="--- True+decodeBase32Padded :: Base32 'HexPadded ShortByteString -> ShortByteString+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32hex-encoded value, assuming that it has padding. ----- >>> isBase32Hex "ADQMS=="--- False+-- >>> parseBase32Padded "adqms==="+-- Right "adqms===" ---isBase32Hex :: ShortByteString -> Bool-isBase32Hex = B32H.isBase32Hex . fromShort-{-# INLINE isBase32Hex #-}+-- >>> fmap decodeBase32Padded (parseBase32Padded "ADQMS===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: ShortByteString -> Either Text (Base32 'HexPadded ShortByteString)+parseBase32Padded value = assertBase32 value+  <$ (decodeBase32PaddedUntyped) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'ShortByteString' is a valid Base32hex format.+-- | Decode a typed, unpadded Base32hex-encoded value. ----- This will not tell you whether or not this is a correct Base32hex representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base32 encoded 'ShortByteString' value, use 'isBase32Hex'.+-- >>> decodeBase32Unpadded (encodeBase32Unpadded' "Sun")+-- "Sun" ----- === __Examples__:+-- @since 1.0 ----- >>> isValidBase32Hex "ADQMS"--- True+decodeBase32Unpadded :: Base32 'HexUnpadded ShortByteString -> ShortByteString+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32hex-encoded value, assuming that it is unpadded. ----- >>> isValidBase32Hex "ADQMS="--- False+-- >>> parseBase32Unpadded "adqms"+-- Right "adqms" ----- >>> isValidBase32Hex "ADQMS%"--- False+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "ADQMS")+-- Right "Sun" ---isValidBase32Hex :: ShortByteString -> Bool-isValidBase32Hex = B32H.isValidBase32Hex . fromShort-{-# INLINE isValidBase32Hex #-}+-- >>> parseBase32Unpadded ""+-- Right ""+--+-- >>> parseBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "CP")+-- True+--+-- @since 1.0+--+parseBase32Unpadded+  :: ShortByteString -> Either Text (Base32 'HexUnpadded ShortByteString)+parseBase32Unpadded value = assertBase32 value+  <$ (decodeBase32UnpaddedUntyped) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import Data.Either (isLeft)

@@ -1,7 +1,9 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base32--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -15,19 +17,24 @@ -- module Data.Text.Encoding.Base32 ( encodeBase32-, decodeBase32+, decodeBase32Untyped , decodeBase32With , encodeBase32Unpadded-, decodeBase32Unpadded+, decodeBase32UnpaddedUntyped , decodeBase32UnpaddedWith-, decodeBase32Padded+, decodeBase32PaddedUntyped , decodeBase32PaddedWith--- , decodeBase32Lenient-, isBase32-, isValidBase32+, decodeBase32+, decodeBase32Padded+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  +import Data.Base32.Types+import qualified Data.Text as ErrorText+ import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString.Base32 as B32@@ -45,59 +52,65 @@ -- >>> encodeBase32 "Sun" -- "KN2W4===" ---encodeBase32 :: Text -> Text+-- @since 1.0+--+encodeBase32 :: Text -> Base32 'StdPadded Text encodeBase32 = B32.encodeBase32 . T.encodeUtf8 {-# INLINE encodeBase32 #-} --- | Decode an arbitrarily padded Base32-encoded 'Text' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as base32 encodings are optionally padded.+-- | Decode an arbitrarily padded Base32-encoded 'Text' value. If its length is not a+-- multiple+-- of 8, then padding chars will be added to fill out the input to a multiple of+-- 8 for safe decoding as base32 encodings are optionally padded. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32With`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32 "KN2W4==="+-- >>> decodeBase32Untyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32 "KN2W4"+-- >>> decodeBase32Untyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32 "KN2W==="+-- >>> decodeBase32Untyped "KN2W===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: Text -> Either Text Text-decodeBase32 = fmap T.decodeUtf8-    . B32.decodeBase32-    . T.encodeUtf8-{-# INLINE decodeBase32 #-}+-- @since 1.0+--+decodeBase32Untyped :: Text -> Either Text Text+decodeBase32Untyped value = B32.decodeBase32Untyped (T.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . T.decodeUtf8'+{-# INLINE decodeBase32Untyped #-}  -- | Attempt to decode a 'Text' value as Base32, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice,--- This is something like 'decodeUtf8'', which may produce an error.+-- This is something like 'T.decodeUtf8'', which may produce an error. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Example__: ----- @--- 'decodeBase32With' 'T.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'--- @+-- >>> decodeBase32With UTF8.decodeUtf8' "KN2W4==="+-- Right "Sun" --+-- >>> decodeBase32With UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32With (const (Left "unsupported encoding")) "KN2W4==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32With     :: (ByteString -> Either err Text)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) Text-decodeBase32With f t = case B32.decodeBase32 t of+decodeBase32With f t = case B32.decodeBase32Untyped t of     Left de -> Left $ DecodeError de     Right a -> first ConversionError (f a) {-# INLINE decodeBase32With #-}@@ -111,54 +124,59 @@ -- >>> encodeBase32Unpadded "Sun" -- "KN2W4" ---encodeBase32Unpadded :: Text -> Text+-- @since 1.0+--+encodeBase32Unpadded :: Text -> Base32 'StdUnpadded Text encodeBase32Unpadded = B32.encodeBase32Unpadded . T.encodeUtf8 {-# INLINE encodeBase32Unpadded #-}  -- | Decode an unpadded Base32 encoded 'Text' value. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32WUnpaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Unpadded "KN2W4"+-- >>> decodeBase32UnpaddedUntyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32Unpadded "KN2W4==="+-- >>> decodeBase32UnpaddedUntyped "KN2W4===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: Text -> Either Text Text-decodeBase32Unpadded = fmap T.decodeUtf8-    . B32.decodeBase32Unpadded-    . T.encodeUtf8-{-# INLINE decodeBase32Unpadded #-}+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: Text -> Either Text Text+decodeBase32UnpaddedUntyped value = B32.decodeBase32UnpaddedUntyped (T.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . T.decodeUtf8'+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Attempt to decode an unpadded 'ByteString' value as Base32, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice,--- This is something like 'decodeUtf8'', which may produce an error.+-- This is something like 'T.decodeUtf8'', which may produce an error. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Example__: ----- @--- 'decodeBase32UnpaddedWith' 'T.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'--- @+-- >>> decodeBase32UnpaddedWith UTF8.decodeUtf8' "KN2W4"+-- Right "Sun" --+-- >>> decodeBase32UnpaddedWith UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32UnpaddedWith (const (Left "unsupported encoding")) "KN2W4"+-- Left (ConversionError "unsupported encoding")+-- decodeBase32UnpaddedWith     :: (ByteString -> Either err Text)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) Text-decodeBase32UnpaddedWith f t = case B32.decodeBase32Unpadded t of+decodeBase32UnpaddedWith f t = case B32.decodeBase32UnpaddedUntyped t of     Left de -> Left $ DecodeError de     Right a -> first ConversionError (f a) {-# INLINE decodeBase32UnpaddedWith #-}@@ -166,98 +184,144 @@  -- | Decode an padded Base32 encoded 'Text' value ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32PaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Padded "KN2W4==="+-- >>> decodeBase32PaddedUntyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32Padded "KN2W4"+-- >>> decodeBase32PaddedUntyped "KN2W4" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: Text -> Either Text Text-decodeBase32Padded = fmap T.decodeUtf8-    . B32.decodeBase32Padded-    . T.encodeUtf8-{-# INLINE decodeBase32Padded #-}+-- @since 1.0+--+decodeBase32PaddedUntyped :: Text -> Either Text Text+decodeBase32PaddedUntyped value = B32.decodeBase32PaddedUntyped (T.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . T.decodeUtf8'+{-# INLINE decodeBase32PaddedUntyped #-}  -- | Attempt to decode a padded 'ByteString' value as Base32, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice,--- This is something like 'decodeUtf8'', which may produce an error.+-- This is something like 'T.decodeUtf8'', which may produce an error. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Example__: ----- @--- 'decodeBase32PaddedWith' 'T.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'--- @+-- >>> decodeBase32PaddedWith UTF8.decodeUtf8' "KN2W4==="+-- Right "Sun" --+-- >>> decodeBase32PaddedWith UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32PaddedWith (const (Left "unsupported encoding")) "KN2W4==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32PaddedWith     :: (ByteString -> Either err Text)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) Text-decodeBase32PaddedWith f t = case B32.decodeBase32Padded t of+decodeBase32PaddedWith f t = case B32.decodeBase32PaddedUntyped t of     Left de -> Left $ DecodeError de     Right a -> first ConversionError (f a) {-# INLINE decodeBase32PaddedWith #-} --- -- | Leniently decode a Base32-encoded 'Text' value. This function--- -- will not generate parse errors. If input data contains padding chars,--- -- then the input will be parsed up until the first pad character.--- ----- -- __Note:__ This is not RFC 4648-compliant.--- ----- decodeBase32Lenient :: Text -> Text--- decodeBase32Lenient = T.decodeUtf8---     . B32.decodeBase32Lenient---     . T.encodeUtf8--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32-encoded 'Text' value.+--+-- This function is padding-agnostic.+-- The decoded payload must be valid UTF-8.+--+-- >>> decodeBase32 (encodeBase32 "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: StdAlphabet k => Base32 k Text -> Text+decodeBase32 = T.decodeUtf8 . B32.decodeBase32 . fmap T.encodeUtf8+{-# INLINE decodeBase32 #-} --- | Tell whether a 'Text' value is Base32-encoded+-- | Decode a typed, padded Base32-encoded 'Text' value. ----- === __Examples__:+-- The decoded payload must be valid UTF-8. ----- >>> isBase32 "KN2W4"--- True+-- >>> decodeBase32Padded (encodeBase32 "Sun")+-- "Sun" ----- >>> isBase32 "KN2W4==="--- True+-- @since 1.0 ----- >>> isBase32 "KN2W4=="--- False+decodeBase32Padded :: Base32 'StdPadded Text -> Text+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32-encoded value, assuming that it has padding. ---isBase32 :: Text -> Bool-isBase32 = B32.isBase32 . T.encodeUtf8-{-# INLINE isBase32 #-}+-- >>> parseBase32Padded "kn2w4==="+-- Right "kn2w4==="+--+-- >>> fmap decodeBase32Padded (parseBase32Padded "KN2W4===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: Text -> Either Text (Base32 'StdPadded Text)+parseBase32Padded value = assertBase32 value+  <$ (B32.decodeBase32PaddedUntyped . T.encodeUtf8) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'Text' value is a valid Base32 format.+-- | Decode a typed, unpadded Base32-encoded value. ----- This will not tell you whether or not this is a correct Base32 representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base32 encoded 'Text' value, use 'isBase32'.+-- The decoded payload must be valid UTF-8. ----- === __Examples__:+-- >>> decodeBase32Unpadded (encodeBase32Unpadded "Sun")+-- "Sun" ----- >>> isValidBase32 "KN2W4"--- True+-- @since 1.0 ----- >>> isValidBase32 "KN2W4="--- False+decodeBase32Unpadded :: Base32 'StdUnpadded Text -> Text+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32-encoded value, assuming that it is unpadded. ----- >>> isValidBase32 "KN2W4%"--- False+-- >>> parseBase32Unpadded "kn2w4"+-- Right "kn2w4" ---isValidBase32 :: Text -> Bool-isValidBase32 = B32.isValidBase32 . T.encodeUtf8-{-# INLINE isValidBase32 #-}+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "KN2W4")+-- Right "Sun"+--+-- >>> parseBase32Unpadded ""+-- Right ""+--+-- >>> parseBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "MZ")+-- True+--+-- @since 1.0+--+parseBase32Unpadded :: Text -> Either Text (Base32 'StdUnpadded Text)+parseBase32Unpadded value = assertBase32 value+  <$ (B32.decodeBase32UnpaddedUntyped . T.encodeUtf8) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import Data.Either (isLeft)+-- >>> import qualified Data.Text.Encoding as UTF8

@@ -2,7 +2,7 @@ {-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base32.Error--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -29,6 +29,11 @@ -- Namely, to distinguish between decoding errors from opaque -- unicode exceptions caught in the unicode decoding process. --+-- >>> DecodeError "invalid padding" :: Base32Error String+-- DecodeError "invalid padding"+-- >>> ConversionError "invalid UTF-8" :: Base32Error String+-- ConversionError "invalid UTF-8"+-- data Base32Error e   = DecodeError Text     -- ^ The error associated with decoding failure@@ -54,3 +59,4 @@ -- @since 0.2.0.0 -- instance NFData e => NFData (Base32Error e)+

@@ -1,7 +1,9 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base32.Hex--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -16,19 +18,24 @@ -- module Data.Text.Encoding.Base32.Hex ( encodeBase32-, decodeBase32+, decodeBase32Untyped , decodeBase32With , encodeBase32Unpadded-, decodeBase32Unpadded+, decodeBase32UnpaddedUntyped , decodeBase32UnpaddedWith-, decodeBase32Padded+, decodeBase32PaddedUntyped , decodeBase32PaddedWith--- , decodeBase32Lenient-, isBase32Hex-, isValidBase32Hex+, decodeBase32+, decodeBase32Padded+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  +import Data.Base32.Types+import qualified Data.Text as ErrorText+ import Data.Bifunctor (first) import Data.ByteString (ByteString) import qualified Data.ByteString.Base32.Hex as B32H@@ -46,36 +53,39 @@ -- >>> encodeBase32 "Sun" -- "ADQMS===" ---encodeBase32 :: Text -> Text+-- @since 1.0+--+encodeBase32 :: Text -> Base32 'HexPadded Text encodeBase32 = B32H.encodeBase32 . T.encodeUtf8 {-# INLINE encodeBase32 #-}  -- | Decode a padded Base32hex-encoded 'Text' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as base32hex encodings are optionally padded.+-- of 8, then padding chars will be added to fill out the input to a multiple of+-- 8 for safe decoding as base32hex encodings are optionally padded. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32With`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32 "ADQMS==="+-- >>> decodeBase32Untyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32 "ADQMS"+-- >>> decodeBase32Untyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32 "ADQMS==="+-- >>> decodeBase32Untyped "ADQM===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: Text -> Either Text Text-decodeBase32 = fmap T.decodeUtf8 . B32H.decodeBase32 . T.encodeUtf8-{-# INLINE decodeBase32 #-}+-- @since 1.0+--+decodeBase32Untyped :: Text -> Either Text Text+decodeBase32Untyped value = B32H.decodeBase32Untyped (T.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . T.decodeUtf8'+{-# INLINE decodeBase32Untyped #-}  -- | Attempt to decode a 'ByteString' value as Base32hex, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice,@@ -85,18 +95,22 @@ -- -- === __Examples__: ----- @--- 'decodeBase32With' 'T.decodeUtf8''---   :: 'Text' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'--- @+-- >>> decodeBase32With UTF8.decodeUtf8' "ADQMS==="+-- Right "Sun" --+-- >>> decodeBase32With UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32With (const (Left "unsupported encoding")) "ADQMS==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32With     :: (ByteString -> Either err Text)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) Text-decodeBase32With f t = case B32H.decodeBase32 t of+decodeBase32With f t = case B32H.decodeBase32Untyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32With #-}@@ -112,56 +126,61 @@ -- >>> encodeBase32Unpadded "Sun" -- "ADQMS" ---encodeBase32Unpadded :: Text -> Text+-- @since 1.0+--+encodeBase32Unpadded :: Text -> Base32 'HexUnpadded Text encodeBase32Unpadded = B32H.encodeBase32Unpadded . T.encodeUtf8 {-# INLINE encodeBase32Unpadded #-}   -- | Decode an unpadded Base32hex encoded 'Text' value. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32WUnpaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Unpadded "ADQMS"+-- >>> decodeBase32UnpaddedUntyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32Unpadded "ADQMS==="+-- >>> decodeBase32UnpaddedUntyped "ADQMS===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: Text -> Either Text Text-decodeBase32Unpadded = fmap T.decodeUtf8-    . B32H.decodeBase32Unpadded-    . T.encodeUtf8-{-# INLINE decodeBase32Unpadded #-}+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: Text -> Either Text Text+decodeBase32UnpaddedUntyped value = B32H.decodeBase32UnpaddedUntyped (T.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . T.decodeUtf8'+{-# INLINE decodeBase32UnpaddedUntyped #-}   -- | Attempt to decode an unpadded 'ByteString' value as Base32hex, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice,--- This is something like 'decodeUtf8'', which may produce an error.+-- This is something like 'T.decodeUtf8'', which may produce an error. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Example__: ----- @--- 'decodeBase32UnpaddedWith' 'T.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'--- @+-- >>> decodeBase32UnpaddedWith UTF8.decodeUtf8' "ADQMS"+-- Right "Sun" --+-- >>> decodeBase32UnpaddedWith UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32UnpaddedWith (const (Left "unsupported encoding")) "ADQMS"+-- Left (ConversionError "unsupported encoding")+-- decodeBase32UnpaddedWith     :: (ByteString -> Either err Text)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) Text-decodeBase32UnpaddedWith f t = case B32H.decodeBase32Unpadded t of+decodeBase32UnpaddedWith f t = case B32H.decodeBase32UnpaddedUntyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32UnpaddedWith #-}@@ -169,27 +188,26 @@  -- | Decode an padded Base32hex encoded 'Text' value ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32PaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Padded "ADQMS==="+-- >>> decodeBase32PaddedUntyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32Padded "ADQMS"+-- >>> decodeBase32PaddedUntyped "ADQMS" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: Text -> Either Text Text-decodeBase32Padded = fmap T.decodeUtf8-    . B32H.decodeBase32Padded-    . T.encodeUtf8-{-# INLINE decodeBase32Padded #-}+-- @since 1.0+--+decodeBase32PaddedUntyped :: Text -> Either Text Text+decodeBase32PaddedUntyped value = B32H.decodeBase32PaddedUntyped (T.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . T.decodeUtf8'+{-# INLINE decodeBase32PaddedUntyped #-}  -- | Attempt to decode a padded 'ByteString' value as Base32hex, converting from -- 'ByteString' to 'Text' according to some encoding function. In practice,@@ -199,68 +217,115 @@ -- -- === __Example__: ----- @--- 'decodeBase32PaddedWith' 'T.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'--- @+-- >>> decodeBase32PaddedWith UTF8.decodeUtf8' "ADQMS==="+-- Right "Sun" --+-- >>> decodeBase32PaddedWith UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32PaddedWith (const (Left "unsupported encoding")) "ADQMS==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32PaddedWith     :: (ByteString -> Either err Text)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) Text-decodeBase32PaddedWith f t = case B32H.decodeBase32Padded t of+decodeBase32PaddedWith f t = case B32H.decodeBase32PaddedUntyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32PaddedWith #-} --- -- -- | Leniently decode an unpadded Base32hex-encoded 'Text'. This function--- -- -- will not generate parse errors. If input data contains padding chars,--- -- -- then the input will be parsed up until the first pad character.--- -- ----- -- -- __Note:__ This is not RFC 4648-compliant.--- -- ----- -- decodeBase32Lenient :: Text -> Text--- -- decodeBase32Lenient = T.decodeUtf8--- --     . B32H.decodeBase32Lenient--- --     . T.encodeUtf8--- -- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32hex-encoded 'Text' value.+--+-- This function is padding-agnostic.+-- The decoded payload must be valid UTF-8.+--+-- >>> decodeBase32 (encodeBase32 "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: HexAlphabet k => Base32 k Text -> Text+decodeBase32 = T.decodeUtf8 . B32H.decodeBase32 . fmap T.encodeUtf8+{-# INLINE decodeBase32 #-} --- | Tell whether a 'Text' value is Base32hex-encoded.+-- | Decode a typed, padded Base32hex-encoded 'Text' value. ----- === __Examples__:+-- The decoded payload must be valid UTF-8. ----- >>> isBase32Hex "ADQMS"--- True+-- >>> decodeBase32Padded (encodeBase32 "Sun")+-- "Sun" ----- >>> isBase32Hex "ADQMS==="--- True+-- @since 1.0 ----- >>> isBase32Hex "ADQMS=="--- False+decodeBase32Padded :: Base32 'HexPadded Text -> Text+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32hex-encoded value, assuming that it has padding. ---isBase32Hex :: Text -> Bool-isBase32Hex = B32H.isBase32Hex . T.encodeUtf8-{-# INLINE isBase32Hex #-}+-- >>> parseBase32Padded "adqms==="+-- Right "adqms==="+--+-- >>> fmap decodeBase32Padded (parseBase32Padded "ADQMS===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: Text -> Either Text (Base32 'HexPadded Text)+parseBase32Padded value = assertBase32 value+  <$ (B32H.decodeBase32PaddedUntyped . T.encodeUtf8) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'Text' value is a valid Base32hex format.+-- | Decode a typed, unpadded Base32hex-encoded value. ----- This will not tell you whether or not this is a correct Base32hex representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base32 encoded 'Text' value, use 'isBase32Hex'.+-- The decoded payload must be valid UTF-8. ----- === __Examples__:+-- >>> decodeBase32Unpadded (encodeBase32Unpadded "Sun")+-- "Sun" ----- >>> isValidBase32Hex "ADQMS"--- True+-- @since 1.0 ----- >>> isValidBase32Hex "ADQMS="--- False+decodeBase32Unpadded :: Base32 'HexUnpadded Text -> Text+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32hex-encoded value, assuming that it is unpadded. ----- >>> isValidBase32Hex "ADQMS%"--- False+-- >>> parseBase32Unpadded "adqms"+-- Right "adqms" ---isValidBase32Hex :: Text -> Bool-isValidBase32Hex = B32H.isValidBase32Hex . T.encodeUtf8-{-# INLINE isValidBase32Hex #-}+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "ADQMS")+-- Right "Sun"+--+-- >>> parseBase32Unpadded ""+-- Right ""+--+-- >>> parseBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "CP")+-- True+--+-- @since 1.0+--+parseBase32Unpadded :: Text -> Either Text (Base32 'HexUnpadded Text)+parseBase32Unpadded value = assertBase32 value+  <$ (B32H.decodeBase32UnpaddedUntyped . T.encodeUtf8) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import Data.Either (isLeft)+-- >>> import qualified Data.Text.Encoding as UTF8

@@ -1,7 +1,9 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Lazy.Encoding.Base32--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -18,19 +20,24 @@   encodeBase32 , encodeBase32Unpadded   -- * Decoding-, decodeBase32+, decodeBase32Untyped , decodeBase32With-, decodeBase32Unpadded+, decodeBase32UnpaddedUntyped , decodeBase32UnpaddedWith-, decodeBase32Padded+, decodeBase32PaddedUntyped , decodeBase32PaddedWith---, decodeBase32Lenient   -- * Validation-, isBase32-, isValidBase32+, decodeBase32+, decodeBase32Padded+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  +import Data.Base32.Types+import qualified Data.Text as ErrorText+ import Data.Bifunctor (first) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Base32 as BL32@@ -49,36 +56,40 @@ -- >>> encodeBase32 "Sun" -- "KN2W4===" ---encodeBase32 :: TL.Text -> TL.Text+-- @since 1.0+--+encodeBase32 :: TL.Text -> Base32 'StdPadded TL.Text encodeBase32 = BL32.encodeBase32 . TL.encodeUtf8 {-# INLINE encodeBase32 #-} --- | Decode an arbitrarily padded Base32-encoded 'TL.Text' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as base32 encodings are optionally padded.+-- | Decode an arbitrarily padded Base32-encoded 'TL.Text' value. If its length is not a+-- multiple+-- of 8, then padding chars will be added to fill out the input to a multiple of+-- 8 for safe decoding as base32 encodings are optionally padded. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'TL.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32With`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32 "KN2W4==="+-- >>> decodeBase32Untyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32 "KN2W4"+-- >>> decodeBase32Untyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32 "KN2W==="+-- >>> decodeBase32Untyped "KN2W===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: TL.Text -> Either T.Text TL.Text-decodeBase32 = fmap TL.decodeUtf8 . BL32.decodeBase32 . TL.encodeUtf8-{-# INLINE decodeBase32 #-}+-- @since 1.0+--+decodeBase32Untyped :: TL.Text -> Either T.Text TL.Text+decodeBase32Untyped value = BL32.decodeBase32Untyped (TL.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . TL.decodeUtf8'+{-# INLINE decodeBase32Untyped #-}  -- | Attempt to decode a lazy 'ByteString' value as Base32, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice,@@ -88,18 +99,22 @@ -- -- === __Examples__: ----- @--- 'decodeBase32With' 'TL.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'TL.Text'--- @+-- >>> decodeBase32With UTF8.decodeUtf8' "KN2W4==="+-- Right "Sun" --+-- >>> decodeBase32With UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32With (const (Left "unsupported encoding")) "KN2W4==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32With     :: (ByteString -> Either err TL.Text)       -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) TL.Text-decodeBase32With f t = case BL32.decodeBase32 t of+decodeBase32With f t = case BL32.decodeBase32Untyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32With #-}@@ -115,33 +130,34 @@ -- >>> encodeBase32Unpadded "Sun" -- "KN2W4" ---encodeBase32Unpadded :: TL.Text -> TL.Text+-- @since 1.0+--+encodeBase32Unpadded :: TL.Text -> Base32 'StdUnpadded TL.Text encodeBase32Unpadded = BL32.encodeBase32Unpadded . TL.encodeUtf8 {-# INLINE encodeBase32Unpadded #-}  -- | Decode an unpadded Base32 encoded 'TL.Text' value. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'TL.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32WUnpaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Unpadded "KN2W4"+-- >>> decodeBase32UnpaddedUntyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32Unpadded "KN2W4==="+-- >>> decodeBase32UnpaddedUntyped "KN2W4===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: TL.Text -> Either T.Text TL.Text-decodeBase32Unpadded = fmap TL.decodeUtf8-    . BL32.decodeBase32Unpadded-    . TL.encodeUtf8-{-# INLINE decodeBase32Unpadded #-}+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: TL.Text -> Either T.Text TL.Text+decodeBase32UnpaddedUntyped value = BL32.decodeBase32UnpaddedUntyped (TL.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . TL.decodeUtf8'+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Attempt to decode an unpadded lazy 'ByteString' value as Base32, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice,@@ -151,45 +167,48 @@ -- -- === __Examples__: ----- @--- 'decodeBase32UnpaddedWith' 'TL.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'TL.Text'--- @+-- >>> decodeBase32UnpaddedWith UTF8.decodeUtf8' "KN2W4"+-- Right "Sun" --+-- >>> decodeBase32UnpaddedWith UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32UnpaddedWith (const (Left "unsupported encoding")) "KN2W4"+-- Left (ConversionError "unsupported encoding")+-- decodeBase32UnpaddedWith     :: (ByteString -> Either err TL.Text)       -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) TL.Text-decodeBase32UnpaddedWith f t = case BL32.decodeBase32Unpadded t of+decodeBase32UnpaddedWith f t = case BL32.decodeBase32UnpaddedUntyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32UnpaddedWith #-}  -- | Decode an padded Base32 encoded 'TL.Text' value ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'TL.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32PaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Padded "KN2W4==="+-- >>> decodeBase32PaddedUntyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32Padded "KN2W4"+-- >>> decodeBase32PaddedUntyped "KN2W4" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: TL.Text -> Either T.Text TL.Text-decodeBase32Padded = fmap TL.decodeUtf8-    . BL32.decodeBase32Padded-    . TL.encodeUtf8-{-# INLINE decodeBase32Padded #-}+-- @since 1.0+--+decodeBase32PaddedUntyped :: TL.Text -> Either T.Text TL.Text+decodeBase32PaddedUntyped value = BL32.decodeBase32PaddedUntyped (TL.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . TL.decodeUtf8'+{-# INLINE decodeBase32PaddedUntyped #-}  -- | Attempt to decode a padded lazy 'ByteString' value as Base32, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice,@@ -199,76 +218,115 @@ -- -- === __Example__: ----- @--- 'decodeBase32PaddedWith' 'TL.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'--- @+-- >>> decodeBase32PaddedWith UTF8.decodeUtf8' "KN2W4==="+-- Right "Sun" --+-- >>> decodeBase32PaddedWith UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32PaddedWith (const (Left "unsupported encoding")) "KN2W4==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32PaddedWith     :: (ByteString -> Either err TL.Text)       -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) TL.Text-decodeBase32PaddedWith f t = case BL32.decodeBase32Padded t of+decodeBase32PaddedWith f t = case BL32.decodeBase32PaddedUntyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32PaddedWith #-} --- -- | Leniently decode an unpadded Base32-encoded 'TL.Text'. This function--- -- will not generate parse errors. If input data contains padding chars,--- -- then the input will be parsed up until the first pad character.--- ----- -- __Note:__ This is not RFC 4648-compliant.--- ----- -- === __Examples__:--- ----- -- >>> decodeBase32Lenient "PDw_Pj4="--- -- "<<?>>"--- ----- -- >>> decodeBase32Lenient "PDw_%%%$}Pj4"--- -- "<<?>>"--- ----- decodeBase32Lenient :: TL.Text -> TL.Text--- decodeBase32Lenient = TL.decodeUtf8---     . BL32.decodeBase32Lenient---     . TL.encodeUtf8--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32-encoded 'TL.Text' value.+--+-- This function is padding-agnostic.+-- The decoded payload must be valid UTF-8.+--+-- >>> decodeBase32 (encodeBase32 "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: StdAlphabet k => Base32 k TL.Text -> TL.Text+decodeBase32 = TL.decodeUtf8 . BL32.decodeBase32 . fmap TL.encodeUtf8+{-# INLINE decodeBase32 #-} --- | Tell whether a 'TL.Text' value is Base32-encoded+-- | Decode a typed, padded Base32-encoded 'TL.Text' value. ----- === __Examples__:+-- The decoded payload must be valid UTF-8. ----- >>> isBase32 "KN2W4"--- True+-- >>> decodeBase32Padded (encodeBase32 "Sun")+-- "Sun" ----- >>> isBase32 "KN2W4==="--- True+-- @since 1.0 ----- >>> isBase32 "KN2W4=="--- False+decodeBase32Padded :: Base32 'StdPadded TL.Text -> TL.Text+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32-encoded value, assuming that it has padding. ---isBase32 :: TL.Text -> Bool-isBase32 = BL32.isBase32 . TL.encodeUtf8-{-# INLINE isBase32 #-}+-- >>> parseBase32Padded "kn2w4==="+-- Right "kn2w4==="+--+-- >>> fmap decodeBase32Padded (parseBase32Padded "KN2W4===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: TL.Text -> Either T.Text (Base32 'StdPadded TL.Text)+parseBase32Padded value = assertBase32 value+  <$ (BL32.decodeBase32PaddedUntyped . TL.encodeUtf8) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'TL.Text' value is a valid Base32 format.+-- | Decode a typed, unpadded Base32-encoded value. ----- This will not tell you whether or not this is a correct Base32 representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base32 encoded 'TL.Text' value, use 'isBase32'.+-- The decoded payload must be valid UTF-8. ----- === __Examples__:+-- >>> decodeBase32Unpadded (encodeBase32Unpadded "Sun")+-- "Sun" ----- >>> isValidBase32 "KN2W4"--- True+-- @since 1.0 ----- >>> isValidBase32 "KN2W4="--- False+decodeBase32Unpadded :: Base32 'StdUnpadded TL.Text -> TL.Text+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32-encoded value, assuming that it is unpadded. ----- >>> isValidBase32 "KN2W4%"--- False+-- >>> parseBase32Unpadded "kn2w4"+-- Right "kn2w4" ---isValidBase32 :: TL.Text -> Bool-isValidBase32 = BL32.isValidBase32 . TL.encodeUtf8-{-# INLINE isValidBase32 #-}+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "KN2W4")+-- Right "Sun"+--+-- >>> parseBase32Unpadded ""+-- Right ""+--+-- >>> parseBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "MZ")+-- True+--+-- @since 1.0+--+parseBase32Unpadded :: TL.Text -> Either T.Text (Base32 'StdUnpadded TL.Text)+parseBase32Unpadded value = assertBase32 value+  <$ (BL32.decodeBase32UnpaddedUntyped . TL.encodeUtf8) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import Data.Either (isLeft)+-- >>> import qualified Data.Text.Lazy.Encoding as UTF8

@@ -1,7 +1,9 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Lazy.Encoding.Base32.Hex--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -18,19 +20,24 @@   encodeBase32 , encodeBase32Unpadded   -- * Decoding-, decodeBase32+, decodeBase32Untyped , decodeBase32With-, decodeBase32Unpadded+, decodeBase32UnpaddedUntyped , decodeBase32UnpaddedWith-, decodeBase32Padded+, decodeBase32PaddedUntyped , decodeBase32PaddedWith---, decodeBase32Lenient   -- * Validation-, isBase32Hex-, isValidBase32Hex+, decodeBase32+, decodeBase32Padded+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  +import Data.Base32.Types+import qualified Data.Text as ErrorText+ import Data.Bifunctor (first) import Data.ByteString.Lazy (ByteString) import qualified Data.ByteString.Lazy.Base32.Hex as BL32H@@ -49,36 +56,39 @@ -- >>> encodeBase32 "Sun" -- "ADQMS===" ---encodeBase32 :: TL.Text -> TL.Text+-- @since 1.0+--+encodeBase32 :: TL.Text -> Base32 'HexPadded TL.Text encodeBase32 = BL32H.encodeBase32 . TL.encodeUtf8 {-# INLINE encodeBase32 #-}  -- | Decode a padded Base32hex-encoded 'TL.Text' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as base32hex encodings are optionally padded.+-- of 8, then padding chars will be added to fill out the input to a multiple of+-- 8 for safe decoding as base32hex encodings are optionally padded. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'TL.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32With`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32 "ADQMS==="+-- >>> decodeBase32Untyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32 "ADQMS"+-- >>> decodeBase32Untyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32 "ADQMS==="+-- >>> decodeBase32Untyped "ADQM===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: TL.Text -> Either T.Text TL.Text-decodeBase32 = fmap TL.decodeUtf8 . BL32H.decodeBase32 . TL.encodeUtf8-{-# INLINE decodeBase32 #-}+-- @since 1.0+--+decodeBase32Untyped :: TL.Text -> Either T.Text TL.Text+decodeBase32Untyped value = BL32H.decodeBase32Untyped (TL.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . TL.decodeUtf8'+{-# INLINE decodeBase32Untyped #-}  -- | Attempt to decode a lazy 'ByteString' value as Base32hex, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice,@@ -88,18 +98,22 @@ -- -- === __Examples__: ----- @--- 'decodeBase32With' 'TL.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'TL.Text'--- @+-- >>> decodeBase32With UTF8.decodeUtf8' "ADQMS==="+-- Right "Sun" --+-- >>> decodeBase32With UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32With (const (Left "unsupported encoding")) "ADQMS==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32With     :: (ByteString -> Either err TL.Text)       -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) TL.Text-decodeBase32With f t = case BL32H.decodeBase32 t of+decodeBase32With f t = case BL32H.decodeBase32Untyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32With #-}@@ -115,33 +129,35 @@ -- >>> encodeBase32Unpadded "Sun" -- "ADQMS" ---encodeBase32Unpadded :: TL.Text -> TL.Text+-- @since 1.0+--+encodeBase32Unpadded :: TL.Text -> Base32 'HexUnpadded TL.Text encodeBase32Unpadded = BL32H.encodeBase32Unpadded . TL.encodeUtf8 {-# INLINE encodeBase32Unpadded #-}  -- | Decode an unpadded Base32hex encoded 'TL.Text' value. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'TL.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32WUnpaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32Unpadded "ADQMS"+-- >>> decodeBase32UnpaddedUntyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32Unpadded "ADQMS==="+-- >>> decodeBase32UnpaddedUntyped "ADQMS===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: TL.Text -> Either T.Text TL.Text-decodeBase32Unpadded = fmap TL.decodeUtf8-    . BL32H.decodeBase32Unpadded-    . TL.encodeUtf8-{-# INLINE decodeBase32Unpadded #-}+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: TL.Text -> Either T.Text TL.Text+decodeBase32UnpaddedUntyped value =+  BL32H.decodeBase32UnpaddedUntyped (TL.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . TL.decodeUtf8'+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Attempt to decode an unpadded lazy 'ByteString' value as Base32hex, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice,@@ -151,45 +167,48 @@ -- -- === __Examples__: ----- @--- 'decodeBase32UnpaddedWith' 'TL.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'TL.Text'--- @+-- >>> decodeBase32UnpaddedWith UTF8.decodeUtf8' "ADQMS"+-- Right "Sun" --+-- >>> decodeBase32UnpaddedWith UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32UnpaddedWith (const (Left "unsupported encoding")) "ADQMS"+-- Left (ConversionError "unsupported encoding")+-- decodeBase32UnpaddedWith     :: (ByteString -> Either err TL.Text)       -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) TL.Text-decodeBase32UnpaddedWith f t = case BL32H.decodeBase32Unpadded t of+decodeBase32UnpaddedWith f t = case BL32H.decodeBase32UnpaddedUntyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32UnpaddedWith #-}  -- | Decode an padded Base32hex encoded 'TL.Text' value ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'TL.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32PaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32Padded "ADQMS==="+-- >>> decodeBase32PaddedUntyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32Padded "ADQMS"+-- >>> decodeBase32PaddedUntyped "ADQMS" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: TL.Text -> Either T.Text TL.Text-decodeBase32Padded = fmap TL.decodeUtf8-    . BL32H.decodeBase32Padded-    . TL.encodeUtf8-{-# INLINE decodeBase32Padded #-}+-- @since 1.0+--+decodeBase32PaddedUntyped :: TL.Text -> Either T.Text TL.Text+decodeBase32PaddedUntyped value = BL32H.decodeBase32PaddedUntyped (TL.encodeUtf8 value)+  >>= first (ErrorText.pack . show) . TL.decodeUtf8'+{-# INLINE decodeBase32PaddedUntyped #-}  -- | Attempt to decode a padded lazy 'ByteString' value as Base32hex, converting from -- 'ByteString' to 'TL.Text' according to some encoding function. In practice,@@ -199,76 +218,115 @@ -- -- === __Example__: ----- @--- 'decodeBase32PaddedWith' 'TL.decodeUtf8''---   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'--- @+-- >>> decodeBase32PaddedWith UTF8.decodeUtf8' "ADQMS==="+-- Right "Sun" --+-- >>> decodeBase32PaddedWith UTF8.decodeUtf8' "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32PaddedWith (const (Left "unsupported encoding")) "ADQMS==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32PaddedWith     :: (ByteString -> Either err TL.Text)       -- ^ convert a bytestring to text (e.g. 'TL.decodeUtf8'')     -> ByteString       -- ^ Input text to decode     -> Either (Base32Error err) TL.Text-decodeBase32PaddedWith f t = case BL32H.decodeBase32Padded t of+decodeBase32PaddedWith f t = case BL32H.decodeBase32PaddedUntyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32PaddedWith #-} --- -- | Leniently decode an unpadded Base32hex-encoded 'TL.Text'. This function--- -- will not generate parse errors. If input data contains padding chars,--- -- then the input will be parsed up until the first pad character.--- ----- -- __Note:__ This is not RFC 4648-compliant.--- ----- -- === __Examples__:--- ----- -- >>> decodeBase32Lenient "PDw_Pj4="--- -- "<<?>>"--- ----- -- >>> decodeBase32Lenient "PDw_%%%$}Pj4"--- -- "<<?>>"--- ----- decodeBase32Lenient :: TL.Text -> TL.Text--- decodeBase32Lenient = TL.decodeUtf8---     . BL32H.decodeBase32Lenient---     . TL.encodeUtf8--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32hex-encoded 'TL.Text' value.+--+-- This function is padding-agnostic.+-- The decoded payload must be valid UTF-8.+--+-- >>> decodeBase32 (encodeBase32 "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: HexAlphabet k => Base32 k TL.Text -> TL.Text+decodeBase32 = TL.decodeUtf8 . BL32H.decodeBase32 . fmap TL.encodeUtf8+{-# INLINE decodeBase32 #-} --- | Tell whether a 'TL.Text' value is Base32hex-encoded+-- | Decode a typed, padded Base32hex-encoded 'TL.Text' value. ----- === __Examples__:+-- The decoded payload must be valid UTF-8. ----- >>> isBase32Hex "ADQMS"--- True+-- >>> decodeBase32Padded (encodeBase32 "Sun")+-- "Sun" ----- >>> isBase32Hex "ADQMS==="--- True+-- @since 1.0 ----- >>> isBase32Hex "ADQMS=="--- False+decodeBase32Padded :: Base32 'HexPadded TL.Text -> TL.Text+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32hex-encoded value, assuming that it has padding. ---isBase32Hex :: TL.Text -> Bool-isBase32Hex = BL32H.isBase32Hex . TL.encodeUtf8-{-# INLINE isBase32Hex #-}+-- >>> parseBase32Padded "adqms==="+-- Right "adqms==="+--+-- >>> fmap decodeBase32Padded (parseBase32Padded "ADQMS===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: TL.Text -> Either T.Text (Base32 'HexPadded TL.Text)+parseBase32Padded value = assertBase32 value+  <$ (BL32H.decodeBase32PaddedUntyped . TL.encodeUtf8) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'TL.Text' value is a valid Base32hex format.+-- | Decode a typed, unpadded Base32hex-encoded value. ----- This will not tell you whether or not this is a correct Base32hex representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base32 encoded 'TL.Text' value, use 'isBase32Hex'.+-- The decoded payload must be valid UTF-8. ----- === __Examples__:+-- >>> decodeBase32Unpadded (encodeBase32Unpadded "Sun")+-- "Sun" ----- >>> isValidBase32Hex "ADQMS"--- True+-- @since 1.0 ----- >>> isValidBase32Hex "ADQMS="--- False+decodeBase32Unpadded :: Base32 'HexUnpadded TL.Text -> TL.Text+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32hex-encoded value, assuming that it is unpadded. ----- >>> isValidBase32Hex "ADQMS%"--- False+-- >>> parseBase32Unpadded "adqms"+-- Right "adqms" ---isValidBase32Hex :: TL.Text -> Bool-isValidBase32Hex = BL32H.isValidBase32Hex . TL.encodeUtf8-{-# INLINE isValidBase32Hex #-}+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "ADQMS")+-- Right "Sun"+--+-- >>> parseBase32Unpadded ""+-- Right ""+--+-- >>> parseBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "CP")+-- True+--+-- @since 1.0+--+parseBase32Unpadded :: TL.Text -> Either T.Text (Base32 'HexUnpadded TL.Text)+parseBase32Unpadded value = assertBase32 value+  <$ (BL32H.decodeBase32UnpaddedUntyped . TL.encodeUtf8) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import Data.Either (isLeft)+-- >>> import qualified Data.Text.Lazy.Encoding as UTF8

@@ -1,7 +1,10 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+ -- | -- Module       : Data.Text.Short.Encoding.Base32--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -18,91 +21,107 @@   encodeBase32 , encodeBase32Unpadded   -- * Decoding-, decodeBase32+, decodeBase32Untyped , decodeBase32With-, decodeBase32Unpadded+, decodeBase32UnpaddedUntyped , decodeBase32UnpaddedWith-, decodeBase32Padded+, decodeBase32PaddedUntyped , decodeBase32PaddedWith---, decodeBase32Lenient   -- * Validation-, isBase32-, isValidBase32+, decodeBase32+, decodeBase32Padded+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  +import Data.Base32.Types+import qualified Data.Text as ErrorText+ import Data.Bifunctor (first)-import qualified Data.ByteString.Base32 as B32 import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as SBS import qualified Data.ByteString.Short.Base32 as BS32 import Data.Text (Text)-import qualified Data.Text.Encoding.Base32 as B32T+import qualified Data.Text.Encoding as TE import Data.Text.Encoding.Base32.Error import Data.Text.Short-import Data.Text.Short.Unsafe + -- | Encode a 'ShortText' value in Base32 with padding. ----- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: -- -- >>> encodeBase32 "Sun" -- "KN2W4===" ---encodeBase32 :: ShortText -> ShortText-encodeBase32 = fromByteStringUnsafe-  . B32.encodeBase32'-  . toByteString+-- @since 1.0+--+encodeBase32 :: ShortText -> Base32 'StdPadded ShortText+encodeBase32 =+  BS32.encodeBase32+    . toShortByteString {-# INLINE encodeBase32 #-} --- | Decode an arbitrarily padded Base32-encoded 'ShortText' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as base32 encodings are optionally padded.+-- | Decode an arbitrarily padded Base32-encoded 'ShortText' value. If its length is not a+-- multiple+-- of 8, then padding chars will be added to fill out the input to a multiple of+-- 8 for safe decoding as base32 encodings are optionally padded. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'Data.Text.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32With`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. ----- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32 "KN2W4==="+-- >>> decodeBase32Untyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32 "KN2W4"+-- >>> decodeBase32Untyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32 "KN2W==="+-- >>> decodeBase32Untyped "KN2W===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: ShortText -> Either Text ShortText-decodeBase32 = fmap fromText . B32T.decodeBase32 . toText-{-# INLINE decodeBase32 #-}+-- @since 1.0+--+decodeBase32Untyped :: ShortText -> Either Text ShortText+decodeBase32Untyped value =+  BS32.decodeBase32Untyped (toShortByteString value)+    >>= maybe (Left (ErrorText.pack "invalid UTF-8 payload")) Right+      . fromShortByteString+{-# INLINE decodeBase32Untyped #-}  -- | Attempt to decode a 'ShortByteString' value as Base32, converting from--- 'ByteString' to 'ShortText' according to some encoding function. In practice,--- This is something like 'decodeUtf8'', which may produce an error.+-- 'ShortByteString' to 'ShortText' according to some encoding function. In practice,+-- The conversion can report a character-encoding error. ----- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- @--- 'decodeBase32With' '(fmap fromText . T.decodeUtf8' . toText)'---   :: 'ShortByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'ShortText'--- @+-- >>> let utf8 = maybe (Left "invalid UTF-8") Right . Text.fromShortByteString+-- >>> decodeBase32With utf8 "KN2W4==="+-- Right "Sun" --+-- >>> decodeBase32With utf8 "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32With (const (Left "unsupported encoding")) "KN2W4==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32With     :: (ShortByteString -> Either err ShortText)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')     -> ShortByteString       -- ^ Input text to decode     -> Either (Base32Error err) ShortText-decodeBase32With f t = case BS32.decodeBase32 t of+decodeBase32With f t = case BS32.decodeBase32Untyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32With #-}@@ -111,163 +130,219 @@ -- padding is optional. If you call this function, you will simply be encoding -- as Base32 and stripping padding chars from the output. ----- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: -- -- >>> encodeBase32Unpadded "Sun" -- "KN2W4" ---encodeBase32Unpadded :: ShortText -> ShortText-encodeBase32Unpadded = fromByteStringUnsafe-  . B32.encodeBase32Unpadded'-  . toByteString+-- @since 1.0+--+encodeBase32Unpadded :: ShortText -> Base32 'StdUnpadded ShortText+encodeBase32Unpadded =+  BS32.encodeBase32Unpadded+    . toShortByteString {-# INLINE encodeBase32Unpadded #-}  -- | Decode an unpadded Base32 encoded 'ShortText' value. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32UnpaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. ----- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Unpadded "KN2W4"+-- >>> decodeBase32UnpaddedUntyped "KN2W4" -- Right "Sun" ----- >>> decodeBase32Unpadded "KN2W4==="+-- >>> decodeBase32UnpaddedUntyped "KN2W4===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: ShortText -> Either Text ShortText-decodeBase32Unpadded = fmap fromText . B32T.decodeBase32Unpadded . toText-{-# INLINE decodeBase32Unpadded #-}+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: ShortText -> Either Text ShortText+decodeBase32UnpaddedUntyped value =+  BS32.decodeBase32UnpaddedUntyped (toShortByteString value)+    >>= maybe (Left (ErrorText.pack "invalid UTF-8 payload")) Right+      . fromShortByteString+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Attempt to decode an unpadded 'ShortByteString' value as Base32, converting from -- 'ShortByteString' to 'ShortText' according to some encoding function. In practice,--- This is something like 'decodeUtf8'', which may produce an error.+-- The conversion can report a character-encoding error. ----- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- @--- 'decodeBase32UnpaddedWith' '(fmap fromText . T.decodeUtf8' . toText)'---   :: 'ShortByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'ShortText'--- @+-- >>> let utf8 = maybe (Left "invalid UTF-8") Right . Text.fromShortByteString+-- >>> decodeBase32UnpaddedWith utf8 "KN2W4"+-- Right "Sun" --+-- >>> decodeBase32UnpaddedWith utf8 "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32UnpaddedWith (const (Left "unsupported encoding")) "KN2W4"+-- Left (ConversionError "unsupported encoding")+-- decodeBase32UnpaddedWith     :: (ShortByteString -> Either err ShortText)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')     -> ShortByteString       -- ^ Input text to decode     -> Either (Base32Error err) ShortText-decodeBase32UnpaddedWith f t = case BS32.decodeBase32Unpadded t of+decodeBase32UnpaddedWith f t = case BS32.decodeBase32UnpaddedUntyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32UnpaddedWith #-}  -- | Decode an padded Base32 encoded 'ShortText' value ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'T.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32PaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. ----- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- >>> decodeBase32Padded "KN2W4==="+-- >>> decodeBase32PaddedUntyped "KN2W4===" -- Right "Sun" ----- >>> decodeBase32Padded "KN2W4"+-- >>> decodeBase32PaddedUntyped "KN2W4" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: ShortText -> Either Text ShortText-decodeBase32Padded = fmap fromText . B32T.decodeBase32Padded . toText-{-# INLINE decodeBase32Padded #-}+-- @since 1.0+--+decodeBase32PaddedUntyped :: ShortText -> Either Text ShortText+decodeBase32PaddedUntyped value =+  BS32.decodeBase32PaddedUntyped (toShortByteString value)+    >>= maybe (Left (ErrorText.pack "invalid UTF-8 payload")) Right+      . fromShortByteString+{-# INLINE decodeBase32PaddedUntyped #-}  -- | Attempt to decode a padded 'ShortByteString' value as Base32, converting from--- 'ByteString' to 'ShortText' according to some encoding function. In practice,--- This is something like 'decodeUtf8'', which may produce an error.+-- 'ShortByteString' to 'ShortText' according to some encoding function. In practice,+-- The conversion can report a character-encoding error. ----- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> -- -- === __Examples__: ----- @--- 'decodeBase32With' '(fmap fromText . T.decodeUtf8' . toText)'---   :: 'ShortByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'ShortText'--- @+-- >>> let utf8 = maybe (Left "invalid UTF-8") Right . Text.fromShortByteString+-- >>> decodeBase32PaddedWith utf8 "KN2W4==="+-- Right "Sun" --+-- >>> decodeBase32PaddedWith utf8 "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32PaddedWith (const (Left "unsupported encoding")) "KN2W4==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32PaddedWith     :: (ShortByteString -> Either err ShortText)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')     -> ShortByteString       -- ^ Input text to decode     -> Either (Base32Error err) ShortText-decodeBase32PaddedWith f t = case BS32.decodeBase32Padded t of+decodeBase32PaddedWith f t = case BS32.decodeBase32PaddedUntyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32PaddedWith #-} --- -- | Leniently decode an unpadded Base32-encoded 'ShortText'. This function--- -- will not generate parse errors. If input data contains padding chars,--- -- then the input will be parsed up until the first pad character.--- ----- -- __Note:__ This is not RFC 4328-compliant.--- ----- -- === __Examples__:--- ----- -- >>> decodeBase32Lenient "PDw_Pj4="--- -- "<<?>>"--- ----- -- >>> decodeBase32Lenient "PDw_%%%$}Pj4"--- -- "<<?>>"--- ----- decodeBase32Lenient :: ShortText -> ShortText--- decodeBase32Lenient = fromText . B32T.decodeBase32Lenient . toText--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32-encoded 'ShortText' value.+--+-- This function is padding-agnostic.+-- The decoded payload must be valid UTF-8.+--+-- >>> decodeBase32 (encodeBase32 "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: StdAlphabet k => Base32 k ShortText -> ShortText+decodeBase32 = fromText . TE.decodeUtf8 . SBS.fromShort+  . BS32.decodeBase32 . fmap toShortByteString+{-# INLINE decodeBase32 #-} --- | Tell whether a 'ShortText' value is Base32-encoded.+-- | Decode a typed, padded Base32-encoded 'ShortText' value. ----- === __Examples__:+-- The decoded payload must be valid UTF-8. ----- >>> isBase32 "KN2W4"--- True+-- >>> decodeBase32Padded (encodeBase32 "Sun")+-- "Sun" ----- >>> isBase32 "KN2W4==="--- True+-- @since 1.0 ----- >>> isBase32 "KN2W4=="--- False+decodeBase32Padded :: Base32 'StdPadded ShortText -> ShortText+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32-encoded value, assuming that it has padding. ---isBase32 :: ShortText -> Bool-isBase32 = B32.isBase32 . toByteString-{-# INLINE isBase32 #-}+-- >>> parseBase32Padded "kn2w4==="+-- Right "kn2w4==="+--+-- >>> fmap decodeBase32Padded (parseBase32Padded "KN2W4===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: ShortText -> Either Text (Base32 'StdPadded ShortText)+parseBase32Padded value = assertBase32 value+  <$ (BS32.decodeBase32PaddedUntyped . toShortByteString) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'ShortText' value is a valid Base32 format.+-- | Decode a typed, unpadded Base32-encoded value. ----- This will not tell you whether or not this is a correct Base32 representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base32 encoded 'ShortText' value, use 'isBase32'.+-- The decoded payload must be valid UTF-8. ----- === __Examples__:+-- >>> decodeBase32Unpadded (encodeBase32Unpadded "Sun")+-- "Sun" ----- >>> isValidBase32 "KN2W4"--- True+-- @since 1.0 ----- >>> isValidBase32 "KN2W4="--- False+decodeBase32Unpadded :: Base32 'StdUnpadded ShortText -> ShortText+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32-encoded value, assuming that it is unpadded. ----- >>> isValidBase32 "KN2W4%"--- False+-- >>> parseBase32Unpadded "kn2w4"+-- Right "kn2w4" ---isValidBase32 :: ShortText -> Bool-isValidBase32 = B32.isValidBase32 . toByteString-{-# INLINE isValidBase32 #-}+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "KN2W4")+-- Right "Sun"+--+-- >>> parseBase32Unpadded ""+-- Right ""+--+-- >>> parseBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "MZ")+-- True+--+-- @since 1.0+--+parseBase32Unpadded :: ShortText -> Either Text (Base32 'StdUnpadded ShortText)+parseBase32Unpadded value = assertBase32 value+  <$ (BS32.decodeBase32UnpaddedUntyped . toShortByteString) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import qualified Data.Text.Short as Text+-- >>> import Data.Either (isLeft)

@@ -1,7 +1,10 @@-{-# LANGUAGE Trustworthy #-}+{-# LANGUAGE Safe #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-}+ -- | -- Module       : Data.Text.Short.Encoding.Base32.Hex--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -18,29 +21,34 @@   encodeBase32 , encodeBase32Unpadded   -- * Decoding-, decodeBase32+, decodeBase32Untyped , decodeBase32With-, decodeBase32Unpadded+, decodeBase32UnpaddedUntyped , decodeBase32UnpaddedWith-, decodeBase32Padded+, decodeBase32PaddedUntyped , decodeBase32PaddedWith---, decodeBase32Lenient   -- * Validation-, isBase32Hex-, isValidBase32Hex+, decodeBase32+, decodeBase32Padded+, decodeBase32Unpadded+, parseBase32Padded+, parseBase32Unpadded ) where  +import Data.Base32.Types+import qualified Data.Text as ErrorText+ import Data.Bifunctor (first)-import qualified Data.ByteString.Base32.Hex as B32H import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short as SBS import qualified Data.ByteString.Short.Base32.Hex as BS32H import Data.Text (Text)-import qualified Data.Text.Encoding.Base32.Hex as B32TH+import qualified Data.Text.Encoding as TE import Data.Text.Encoding.Base32.Error import Data.Text.Short-import Data.Text.Short.Unsafe + -- | Encode a 'ShortText' value in Base32hex with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>@@ -50,59 +58,71 @@ -- >>> encodeBase32 "Sun" -- "ADQMS===" ---encodeBase32 :: ShortText -> ShortText-encodeBase32 = fromByteStringUnsafe-  . B32H.encodeBase32'-  . toByteString+-- @since 1.0+--+encodeBase32 :: ShortText -> Base32 'HexPadded ShortText+encodeBase32 =+  BS32H.encodeBase32+    . toShortByteString {-# INLINE encodeBase32 #-} --- | Decode an arbitrarily padded Base32hex-encoded 'ShortText' value. If its length is not a multiple--- of 4, then padding chars will be added to fill out the input to a multiple of--- 4 for safe decoding as base32hex encodings are optionally padded.+-- | Decode an arbitrarily padded Base32hex-encoded 'ShortText' value. If its length is+-- not a multiple+-- of 8, then padding chars will be added to fill out the input to a multiple of+-- 8 for safe decoding as base32hex encodings are optionally padded. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'Data.Text.Encoding.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32With`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32 "ADQMS==="+-- >>> decodeBase32Untyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32 "ADQMS"+-- >>> decodeBase32Untyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32 "ADQMS==="+-- >>> decodeBase32Untyped "ADQM===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32 :: ShortText -> Either Text ShortText-decodeBase32 = fmap fromText . B32TH.decodeBase32 . toText-{-# INLINE decodeBase32 #-}+-- @since 1.0+--+decodeBase32Untyped :: ShortText -> Either Text ShortText+decodeBase32Untyped value =+  BS32H.decodeBase32Untyped (toShortByteString value)+    >>= maybe (Left (ErrorText.pack "invalid UTF-8 payload")) Right+      . fromShortByteString+{-# INLINE decodeBase32Untyped #-}  -- | Attempt to decode a 'ShortByteString' value as Base32hex, converting from--- 'ByteString' to 'ShortText' according to some encoding function. In practice,--- This is something like 'decodeUtf8'', which may produce an error.+-- 'ShortByteString' to 'ShortText' according to some encoding function. In practice,+-- The conversion can report a character-encoding error. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- @--- 'decodeBase32With' '(fmap fromText . Data.Text.Encoding.decodeUtf8' . toText)'---   :: 'ShortByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'ShortText'--- @+-- >>> let utf8 = maybe (Left "invalid UTF-8") Right . Text.fromShortByteString+-- >>> decodeBase32With utf8 "ADQMS==="+-- Right "Sun" --+-- >>> decodeBase32With utf8 "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32With (const (Left "unsupported encoding")) "ADQMS==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32With     :: (ShortByteString -> Either err ShortText)-      -- ^ convert a bytestring to text (e.g. '(fmap fromText . Data.Text.Encoding.decodeUtf8' . toText)')+      -- ^ convert a bytestring to text (e.g. '(fmap fromText .+      -- Data.Text.Encoding.decodeUtf8' . toText)')     -> ShortByteString       -- ^ Input text to decode     -> Either (Base32Error err) ShortText-decodeBase32With f t = case BS32H.decodeBase32 t of+decodeBase32With f t = case BS32H.decodeBase32Untyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32With #-}@@ -118,156 +138,213 @@ -- >>> encodeBase32Unpadded "Sun" -- "ADQMS" ---encodeBase32Unpadded :: ShortText -> ShortText-encodeBase32Unpadded = fromByteStringUnsafe-  . B32H.encodeBase32Unpadded'-  . toByteString+-- @since 1.0+--+encodeBase32Unpadded :: ShortText -> Base32 'HexUnpadded ShortText+encodeBase32Unpadded =+  BS32H.encodeBase32Unpadded+    . toShortByteString {-# INLINE encodeBase32Unpadded #-}  -- | Decode an unpadded Base32hex encoded 'ShortText' value. ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'Data.Text.Encoding.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32UnpaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32Unpadded "ADQMS"+-- >>> decodeBase32UnpaddedUntyped "ADQMS" -- Right "Sun" ----- >>> decodeBase32Unpadded "ADQMS==="+-- >>> decodeBase32UnpaddedUntyped "ADQMS===" -- Left "Base32-encoded bytestring has invalid padding" ---decodeBase32Unpadded :: ShortText -> Either Text ShortText-decodeBase32Unpadded = fmap fromText . B32TH.decodeBase32Unpadded . toText-{-# INLINE decodeBase32Unpadded #-}+-- @since 1.0+--+decodeBase32UnpaddedUntyped :: ShortText -> Either Text ShortText+decodeBase32UnpaddedUntyped value =+  BS32H.decodeBase32UnpaddedUntyped (toShortByteString value)+    >>= maybe (Left (ErrorText.pack "invalid UTF-8 payload")) Right+      . fromShortByteString+{-# INLINE decodeBase32UnpaddedUntyped #-}  -- | Attempt to decode an unpadded 'ShortByteString' value as Base32hex, converting from -- 'ShortByteString' to 'ShortText' according to some encoding function. In practice,--- This is something like 'decodeUtf8'', which may produce an error.+-- The conversion can report a character-encoding error. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- @--- 'decodeBase32UnpaddedWith' '(fmap fromText . Data.Text.Encoding.decodeUtf8' . toText)'---   :: 'ShortByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'ShortText'--- @+-- >>> let utf8 = maybe (Left "invalid UTF-8") Right . Text.fromShortByteString+-- >>> decodeBase32UnpaddedWith utf8 "ADQMS"+-- Right "Sun" --+-- >>> decodeBase32UnpaddedWith utf8 "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32UnpaddedWith (const (Left "unsupported encoding")) "ADQMS"+-- Left (ConversionError "unsupported encoding")+-- decodeBase32UnpaddedWith     :: (ShortByteString -> Either err ShortText)-      -- ^ convert a bytestring to text (e.g. '(fmap fromText . Data.Text.Encoding.decodeUtf8' . toText)')+      -- ^ convert a bytestring to text (e.g. '(fmap fromText .+      -- Data.Text.Encoding.decodeUtf8' . toText)')     -> ShortByteString       -- ^ Input text to decode     -> Either (Base32Error err) ShortText-decodeBase32UnpaddedWith f t = case BS32H.decodeBase32Unpadded t of+decodeBase32UnpaddedWith f t = case BS32H.decodeBase32UnpaddedUntyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32UnpaddedWith #-}  -- | Decode an padded Base32hex encoded 'ShortText' value ----- /Note:/ This function makes sure that decoding is total by deferring to--- 'Data.Text.Encoding.decodeUtf8'. This will always round trip for any valid Base32-encoded--- text value, but it may not round trip for bad inputs. The onus is on the--- caller to make sure inputs are valid. If unsure, defer to `decodeBase32PaddedWith`--- and pass in a custom decode function.+-- Decoded bytes are interpreted as UTF-8. Invalid Base32 or UTF-8+-- returns 'Left'. Use the corresponding @decode*With@ function+-- to choose a different character encoding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- >>> decodeBase32Padded "ADQMS==="+-- >>> decodeBase32PaddedUntyped "ADQMS===" -- Right "Sun" ----- >>> decodeBase32Padded "ADQMS"+-- >>> decodeBase32PaddedUntyped "ADQMS" -- Left "Base32-encoded bytestring requires padding" ---decodeBase32Padded :: ShortText -> Either Text ShortText-decodeBase32Padded = fmap fromText . B32TH.decodeBase32Padded . toText-{-# INLINE decodeBase32Padded #-}+-- @since 1.0+--+decodeBase32PaddedUntyped :: ShortText -> Either Text ShortText+decodeBase32PaddedUntyped value =+  BS32H.decodeBase32PaddedUntyped (toShortByteString value)+    >>= maybe (Left (ErrorText.pack "invalid UTF-8 payload")) Right+      . fromShortByteString+{-# INLINE decodeBase32PaddedUntyped #-}  -- | Attempt to decode a padded 'ShortByteString' value as Base32hex, converting from--- 'ByteString' to 'ShortText' according to some encoding function. In practice,--- This is something like 'decodeUtf8'', which may produce an error.+-- 'ShortByteString' to 'ShortText' according to some encoding function. In practice,+-- The conversion can report a character-encoding error. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> -- -- === __Examples__: ----- @--- 'decodeBase32With' '(fmap fromText . Data.Text.Encoding.decodeUtf8' . toText)'---   :: 'ShortByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'ShortText'--- @+-- >>> let utf8 = maybe (Left "invalid UTF-8") Right . Text.fromShortByteString+-- >>> decodeBase32PaddedWith utf8 "ADQMS==="+-- Right "Sun" --+-- >>> decodeBase32PaddedWith utf8 "!"+-- Left (DecodeError "Base32-encoded bytestring has invalid size")+--+-- >>> decodeBase32PaddedWith (const (Left "unsupported encoding")) "ADQMS==="+-- Left (ConversionError "unsupported encoding")+-- decodeBase32PaddedWith     :: (ShortByteString -> Either err ShortText)       -- ^ convert a bytestring to text (e.g. 'Data.Text.Encoding.decodeUtf8'')     -> ShortByteString       -- ^ Input text to decode     -> Either (Base32Error err) ShortText-decodeBase32PaddedWith f t = case BS32H.decodeBase32Padded t of+decodeBase32PaddedWith f t = case BS32H.decodeBase32PaddedUntyped t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase32PaddedWith #-} --- -- | Leniently decode an unpadded Base32hex-encoded 'ShortText'. This function--- -- will not generate parse errors. If input data contains padding chars,--- -- then the input will be parsed up until the first pad character.--- ----- -- __Note:__ This is not RFC 4648-compliant.--- ----- -- === __Examples__:--- ----- -- >>> decodeBase32Lenient "PDw_Pj4="--- -- "<<?>>"--- ----- -- >>> decodeBase32Lenient "PDw_%%%$}Pj4"--- -- "<<?>>"--- ----- decodeBase32Lenient :: ShortText -> ShortText--- decodeBase32Lenient = fromText . B32TH.decodeBase32Lenient . toText--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a typed Base32hex-encoded 'ShortText' value.+--+-- This function is padding-agnostic.+-- The decoded payload must be valid UTF-8.+--+-- >>> decodeBase32 (encodeBase32 "Sun")+-- "Sun"+--+-- >>> decodeBase32 (encodeBase32Unpadded "Sun")+-- "Sun"+--+-- @since 1.0+--+decodeBase32 :: HexAlphabet k => Base32 k ShortText -> ShortText+decodeBase32 = fromText . TE.decodeUtf8 . SBS.fromShort+  . BS32H.decodeBase32 . fmap toShortByteString+{-# INLINE decodeBase32 #-} --- | Tell whether a 'ShortText' value is Base32hex-encoded.+-- | Decode a typed, padded Base32hex-encoded 'ShortText' value. ----- === __Examples__:+-- The decoded payload must be valid UTF-8. ----- >>> isBase32Hex "ADQMS"--- True+-- >>> decodeBase32Padded (encodeBase32 "Sun")+-- "Sun" ----- >>> isBase32Hex "ADQMS==="--- True+-- @since 1.0 ----- >>> isBase32Hex "ADQMS=="--- False+decodeBase32Padded :: Base32 'HexPadded ShortText -> ShortText+decodeBase32Padded = decodeBase32+{-# INLINE decodeBase32Padded #-}++-- | Parse and validate a base32hex-encoded value, assuming that it has padding. ---isBase32Hex :: ShortText -> Bool-isBase32Hex = B32H.isBase32Hex . toByteString-{-# INLINE isBase32Hex #-}+-- >>> parseBase32Padded "adqms==="+-- Right "adqms==="+--+-- >>> fmap decodeBase32Padded (parseBase32Padded "ADQMS===")+-- Right "Sun"+--+-- >>> parseBase32Padded ""+-- Right ""+--+-- >>> parseBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+-- @since 1.0+--+parseBase32Padded :: ShortText -> Either Text (Base32 'HexPadded ShortText)+parseBase32Padded value = assertBase32 value+  <$ (BS32H.decodeBase32PaddedUntyped . toShortByteString) value+{-# INLINE parseBase32Padded #-} --- | Tell whether a 'ShortText' value is a valid Base32hex format.+-- | Decode a typed, unpadded Base32hex-encoded value. ----- This will not tell you whether or not this is a correct Base32hex representation,--- only that it conforms to the correct shape. To check whether it is a true--- Base32 encoded 'ShortText' value, use 'isBase32Hex'.+-- The decoded payload must be valid UTF-8. ----- === __Examples__:+-- >>> decodeBase32Unpadded (encodeBase32Unpadded "Sun")+-- "Sun" ----- >>> isValidBase32Hex "ADQMS"--- True+-- @since 1.0 ----- >>> isValidBase32Hex "ADQMS="--- False+decodeBase32Unpadded :: Base32 'HexUnpadded ShortText -> ShortText+decodeBase32Unpadded = decodeBase32+{-# INLINE decodeBase32Unpadded #-}++-- | Parse and validate a base32hex-encoded value, assuming that it is unpadded. ----- >>> isValidBase32Hex "ADQMS%"--- False+-- >>> parseBase32Unpadded "adqms"+-- Right "adqms" ---isValidBase32Hex :: ShortText -> Bool-isValidBase32Hex = B32H.isValidBase32Hex . toByteString-{-# INLINE isValidBase32Hex #-}+-- >>> fmap decodeBase32Unpadded (parseBase32Unpadded "ADQMS")+-- Right "Sun"+--+-- >>> parseBase32Unpadded ""+-- Right ""+--+-- >>> parseBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+-- >>> isLeft (parseBase32Unpadded "CP")+-- True+--+-- @since 1.0+--+parseBase32Unpadded :: ShortText -> Either Text (Base32 'HexUnpadded ShortText)+parseBase32Unpadded value = assertBase32 value+  <$ (BS32H.decodeBase32UnpaddedUntyped . toShortByteString) value+{-# INLINE parseBase32Unpadded #-}++-- $setup+-- >>> :seti -XOverloadedStrings+-- >>> import qualified Data.Text.Short as Text+-- >>> import Data.Either (isLeft)

@@ -2,6 +2,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE EmptyDataDecls #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE KindSignatures #-}@@ -9,7 +10,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module       : Main--- Copyright    : (c) 2019-2023 Emily Pillmore+-- Copyright    : (c) 2019-2026 Emily Pillmore -- License      : BSD-style -- -- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>@@ -33,6 +34,8 @@ ) where  +import Data.Base32.Types (Alphabet(..), Base32, StdAlphabet, HexAlphabet, extractBase32)+import Data.Either (isRight) import Test.QuickCheck hiding (label) import Data.Text import qualified Data.ByteString as BS@@ -69,12 +72,24 @@   , encodeNopad :: bs -> bs   , encodeHex :: bs -> bs   , encodeHexNopad :: bs -> bs+  , decodeTyped :: forall k. StdAlphabet k => Base32 k bs -> bs+  , decodePaddedTyped :: Base32 'StdPadded bs -> bs+  , decodeUnpaddedTyped :: Base32 'StdUnpadded bs -> bs+  , decodeHexTyped :: forall k. HexAlphabet k => Base32 k bs -> bs+  , decodeHexPaddedTyped :: Base32 'HexPadded bs -> bs+  , decodeHexUnpaddedTyped :: Base32 'HexUnpadded bs -> bs   , decode :: bs -> Either Text bs   , decodeHex :: bs -> Either Text bs   , decodePad :: bs -> Either Text bs   , decodeHexPad :: bs -> Either Text bs   , decodeNopad :: bs -> Either Text bs   , decodeHexNopad :: bs -> Either Text bs+  , parseValue :: bs -> Either Text bs+  , parseHexValue :: bs -> Either Text bs+  , parsePaddedValue :: bs -> Either Text bs+  , parseUnpaddedValue :: bs -> Either Text bs+  , parseHexPaddedValue :: bs -> Either Text bs+  , parseHexUnpaddedValue :: bs -> Either Text bs   , correct :: bs -> Bool   , correctHex :: bs -> Bool   , validate :: bs -> Bool@@ -84,115 +99,187 @@ b32 :: Harness BS.ByteString b32 = Harness   { label = "ByteString"-  , encode = B32.encodeBase32'-  , encodeNopad = B32.encodeBase32Unpadded'-  , decode = B32.decodeBase32-  , decodePad = B32.decodeBase32Padded-  , decodeNopad = B32.decodeBase32Unpadded-  , correct = B32.isBase32-  , validate = B32.isValidBase32-  , encodeHex = B32H.encodeBase32'-  , encodeHexNopad = B32H.encodeBase32Unpadded'-  , decodeHex = B32H.decodeBase32-  , decodeHexPad = B32H.decodeBase32Padded-  , decodeHexNopad = B32H.decodeBase32Unpadded-  , correctHex = B32H.isBase32Hex-  , validateHex = B32H.isValidBase32Hex+  , encode = extractBase32 . B32.encodeBase32'+  , encodeNopad = extractBase32 . B32.encodeBase32Unpadded'+  , decodeTyped = B32.decodeBase32+  , decodePaddedTyped = B32.decodeBase32Padded+  , decodeUnpaddedTyped = B32.decodeBase32Unpadded+  , decodeHexTyped = B32H.decodeBase32+  , decodeHexPaddedTyped = B32H.decodeBase32Padded+  , decodeHexUnpaddedTyped = B32H.decodeBase32Unpadded+  , decode = B32.decodeBase32Untyped+  , decodePad = B32.decodeBase32PaddedUntyped+  , decodeNopad = B32.decodeBase32UnpaddedUntyped+  , parseValue = fmap extractBase32 . B32.parseBase32Padded+  , parseHexValue = fmap extractBase32 . B32H.parseBase32Padded+  , parsePaddedValue = fmap extractBase32 . B32.parseBase32Padded+  , parseUnpaddedValue = fmap extractBase32 . B32.parseBase32Unpadded+  , parseHexPaddedValue = fmap extractBase32 . B32H.parseBase32Padded+  , parseHexUnpaddedValue = fmap extractBase32 . B32H.parseBase32Unpadded+  , correct = isRight . B32.decodeBase32Untyped+  , validate = isRight . B32.decodeBase32Untyped+  , encodeHex = extractBase32 . B32H.encodeBase32'+  , encodeHexNopad = extractBase32 . B32H.encodeBase32Unpadded'+  , decodeHex = B32H.decodeBase32Untyped+  , decodeHexPad = B32H.decodeBase32PaddedUntyped+  , decodeHexNopad = B32H.decodeBase32UnpaddedUntyped+  , correctHex = isRight . B32H.decodeBase32Untyped+  , validateHex = isRight . B32H.decodeBase32Untyped   }  lb32 :: Harness LBS.ByteString lb32 = Harness   { label = "Lazy ByteString"-  , encode = BL32.encodeBase32'-  , encodeNopad = BL32.encodeBase32Unpadded'-  , decode = BL32.decodeBase32-  , decodePad = BL32.decodeBase32Padded-  , decodeNopad = BL32.decodeBase32Unpadded-  , correct = BL32.isBase32-  , validate = BL32.isValidBase32-  , encodeHex = BL32H.encodeBase32'-  , encodeHexNopad = BL32H.encodeBase32Unpadded'-  , decodeHex = BL32H.decodeBase32-  , decodeHexPad = BL32H.decodeBase32Padded-  , decodeHexNopad = BL32H.decodeBase32Unpadded-  , correctHex = BL32H.isBase32Hex-  , validateHex = BL32H.isValidBase32Hex+  , encode = extractBase32 . BL32.encodeBase32'+  , encodeNopad = extractBase32 . BL32.encodeBase32Unpadded'+  , decodeTyped = BL32.decodeBase32+  , decodePaddedTyped = BL32.decodeBase32Padded+  , decodeUnpaddedTyped = BL32.decodeBase32Unpadded+  , decodeHexTyped = BL32H.decodeBase32+  , decodeHexPaddedTyped = BL32H.decodeBase32Padded+  , decodeHexUnpaddedTyped = BL32H.decodeBase32Unpadded+  , decode = BL32.decodeBase32Untyped+  , decodePad = BL32.decodeBase32PaddedUntyped+  , decodeNopad = BL32.decodeBase32UnpaddedUntyped+  , parseValue = fmap extractBase32 . BL32.parseBase32Padded+  , parseHexValue = fmap extractBase32 . BL32H.parseBase32Padded+  , parsePaddedValue = fmap extractBase32 . BL32.parseBase32Padded+  , parseUnpaddedValue = fmap extractBase32 . BL32.parseBase32Unpadded+  , parseHexPaddedValue = fmap extractBase32 . BL32H.parseBase32Padded+  , parseHexUnpaddedValue = fmap extractBase32 . BL32H.parseBase32Unpadded+  , correct = isRight . BL32.decodeBase32Untyped+  , validate = isRight . BL32.decodeBase32Untyped+  , encodeHex = extractBase32 . BL32H.encodeBase32'+  , encodeHexNopad = extractBase32 . BL32H.encodeBase32Unpadded'+  , decodeHex = BL32H.decodeBase32Untyped+  , decodeHexPad = BL32H.decodeBase32PaddedUntyped+  , decodeHexNopad = BL32H.decodeBase32UnpaddedUntyped+  , correctHex = isRight . BL32H.decodeBase32Untyped+  , validateHex = isRight . BL32H.decodeBase32Untyped   }  sb32 :: Harness SBS.ShortByteString sb32 = Harness   { label = "Short ByteString"-  , encode = BS32.encodeBase32'-  , encodeNopad = BS32.encodeBase32Unpadded'-  , decode = BS32.decodeBase32-  , decodePad = BS32.decodeBase32Padded-  , decodeNopad = BS32.decodeBase32Unpadded-  , correct = BS32.isBase32-  , validate = BS32.isValidBase32-  , encodeHex = BS32H.encodeBase32'-  , encodeHexNopad = BS32H.encodeBase32Unpadded'-  , decodeHex = BS32H.decodeBase32-  , decodeHexPad = BS32H.decodeBase32Padded-  , decodeHexNopad = BS32H.decodeBase32Unpadded-  , correctHex = BS32H.isBase32Hex-  , validateHex = BS32H.isValidBase32Hex+  , encode = extractBase32 . BS32.encodeBase32'+  , encodeNopad = extractBase32 . BS32.encodeBase32Unpadded'+  , decodeTyped = BS32.decodeBase32+  , decodePaddedTyped = BS32.decodeBase32Padded+  , decodeUnpaddedTyped = BS32.decodeBase32Unpadded+  , decodeHexTyped = BS32H.decodeBase32+  , decodeHexPaddedTyped = BS32H.decodeBase32Padded+  , decodeHexUnpaddedTyped = BS32H.decodeBase32Unpadded+  , decode = BS32.decodeBase32Untyped+  , decodePad = BS32.decodeBase32PaddedUntyped+  , decodeNopad = BS32.decodeBase32UnpaddedUntyped+  , parseValue = fmap extractBase32 . BS32.parseBase32Padded+  , parseHexValue = fmap extractBase32 . BS32H.parseBase32Padded+  , parsePaddedValue = fmap extractBase32 . BS32.parseBase32Padded+  , parseUnpaddedValue = fmap extractBase32 . BS32.parseBase32Unpadded+  , parseHexPaddedValue = fmap extractBase32 . BS32H.parseBase32Padded+  , parseHexUnpaddedValue = fmap extractBase32 . BS32H.parseBase32Unpadded+  , correct = isRight . BS32.decodeBase32Untyped+  , validate = isRight . BS32.decodeBase32Untyped+  , encodeHex = extractBase32 . BS32H.encodeBase32'+  , encodeHexNopad = extractBase32 . BS32H.encodeBase32Unpadded'+  , decodeHex = BS32H.decodeBase32Untyped+  , decodeHexPad = BS32H.decodeBase32PaddedUntyped+  , decodeHexNopad = BS32H.decodeBase32UnpaddedUntyped+  , correctHex = isRight . BS32H.decodeBase32Untyped+  , validateHex = isRight . BS32H.decodeBase32Untyped   }  t32 :: Harness T.Text t32 = Harness   { label = "Text"-  , encode = T32.encodeBase32-  , encodeNopad = T32.encodeBase32Unpadded-  , decode = T32.decodeBase32-  , decodePad = T32.decodeBase32Padded-  , decodeNopad = T32.decodeBase32Unpadded-  , correct = T32.isBase32-  , validate = T32.isValidBase32-  , encodeHex = T32H.encodeBase32-  , encodeHexNopad = T32H.encodeBase32Unpadded-  , decodeHex = T32H.decodeBase32-  , decodeHexPad = T32H.decodeBase32Padded-  , decodeHexNopad = T32H.decodeBase32Unpadded-  , correctHex = T32H.isBase32Hex-  , validateHex = T32H.isValidBase32Hex+  , encode = extractBase32 . T32.encodeBase32+  , encodeNopad = extractBase32 . T32.encodeBase32Unpadded+  , decodeTyped = T32.decodeBase32+  , decodePaddedTyped = T32.decodeBase32Padded+  , decodeUnpaddedTyped = T32.decodeBase32Unpadded+  , decodeHexTyped = T32H.decodeBase32+  , decodeHexPaddedTyped = T32H.decodeBase32Padded+  , decodeHexUnpaddedTyped = T32H.decodeBase32Unpadded+  , decode = T32.decodeBase32Untyped+  , decodePad = T32.decodeBase32PaddedUntyped+  , decodeNopad = T32.decodeBase32UnpaddedUntyped+  , parseValue = fmap extractBase32 . T32.parseBase32Padded+  , parseHexValue = fmap extractBase32 . T32H.parseBase32Padded+  , parsePaddedValue = fmap extractBase32 . T32.parseBase32Padded+  , parseUnpaddedValue = fmap extractBase32 . T32.parseBase32Unpadded+  , parseHexPaddedValue = fmap extractBase32 . T32H.parseBase32Padded+  , parseHexUnpaddedValue = fmap extractBase32 . T32H.parseBase32Unpadded+  , correct = isRight . T32.decodeBase32Untyped+  , validate = isRight . T32.decodeBase32Untyped+  , encodeHex = extractBase32 . T32H.encodeBase32+  , encodeHexNopad = extractBase32 . T32H.encodeBase32Unpadded+  , decodeHex = T32H.decodeBase32Untyped+  , decodeHexPad = T32H.decodeBase32PaddedUntyped+  , decodeHexNopad = T32H.decodeBase32UnpaddedUntyped+  , correctHex = isRight . T32H.decodeBase32Untyped+  , validateHex = isRight . T32H.decodeBase32Untyped   }  tl32 :: Harness TL.Text tl32 = Harness   { label = "Lazy Text"-  , encode = TL32.encodeBase32-  , encodeNopad = TL32.encodeBase32Unpadded-  , decode = TL32.decodeBase32-  , decodePad = TL32.decodeBase32Padded-  , decodeNopad = TL32.decodeBase32Unpadded-  , correct = TL32.isBase32-  , validate = TL32.isValidBase32-  , encodeHex = TL32H.encodeBase32-  , encodeHexNopad = TL32H.encodeBase32Unpadded-  , decodeHex = TL32H.decodeBase32-  , decodeHexPad = TL32H.decodeBase32Padded-  , decodeHexNopad = TL32H.decodeBase32Unpadded-  , correctHex = TL32H.isBase32Hex-  , validateHex = TL32H.isValidBase32Hex+  , encode = extractBase32 . TL32.encodeBase32+  , encodeNopad = extractBase32 . TL32.encodeBase32Unpadded+  , decodeTyped = TL32.decodeBase32+  , decodePaddedTyped = TL32.decodeBase32Padded+  , decodeUnpaddedTyped = TL32.decodeBase32Unpadded+  , decodeHexTyped = TL32H.decodeBase32+  , decodeHexPaddedTyped = TL32H.decodeBase32Padded+  , decodeHexUnpaddedTyped = TL32H.decodeBase32Unpadded+  , decode = TL32.decodeBase32Untyped+  , decodePad = TL32.decodeBase32PaddedUntyped+  , decodeNopad = TL32.decodeBase32UnpaddedUntyped+  , parseValue = fmap extractBase32 . TL32.parseBase32Padded+  , parseHexValue = fmap extractBase32 . TL32H.parseBase32Padded+  , parsePaddedValue = fmap extractBase32 . TL32.parseBase32Padded+  , parseUnpaddedValue = fmap extractBase32 . TL32.parseBase32Unpadded+  , parseHexPaddedValue = fmap extractBase32 . TL32H.parseBase32Padded+  , parseHexUnpaddedValue = fmap extractBase32 . TL32H.parseBase32Unpadded+  , correct = isRight . TL32.decodeBase32Untyped+  , validate = isRight . TL32.decodeBase32Untyped+  , encodeHex = extractBase32 . TL32H.encodeBase32+  , encodeHexNopad = extractBase32 . TL32H.encodeBase32Unpadded+  , decodeHex = TL32H.decodeBase32Untyped+  , decodeHexPad = TL32H.decodeBase32PaddedUntyped+  , decodeHexNopad = TL32H.decodeBase32UnpaddedUntyped+  , correctHex = isRight . TL32H.decodeBase32Untyped+  , validateHex = isRight . TL32H.decodeBase32Untyped   }  ts32 :: Harness TS.ShortText ts32 = Harness   { label = "Short Lazy Text"-  , encode = TS32.encodeBase32-  , encodeNopad = TS32.encodeBase32Unpadded-  , decode = TS32.decodeBase32-  , decodePad = TS32.decodeBase32Padded-  , decodeNopad = TS32.decodeBase32Unpadded-  , correct = TS32.isBase32-  , validate = TS32.isValidBase32-  , encodeHex = TS32H.encodeBase32-  , encodeHexNopad = TS32H.encodeBase32Unpadded-  , decodeHex = TS32H.decodeBase32-  , decodeHexPad = TS32H.decodeBase32Padded-  , decodeHexNopad = TS32H.decodeBase32Unpadded-  , correctHex = TS32H.isBase32Hex-  , validateHex = TS32H.isValidBase32Hex+  , encode = extractBase32 . TS32.encodeBase32+  , encodeNopad = extractBase32 . TS32.encodeBase32Unpadded+  , decodeTyped = TS32.decodeBase32+  , decodePaddedTyped = TS32.decodeBase32Padded+  , decodeUnpaddedTyped = TS32.decodeBase32Unpadded+  , decodeHexTyped = TS32H.decodeBase32+  , decodeHexPaddedTyped = TS32H.decodeBase32Padded+  , decodeHexUnpaddedTyped = TS32H.decodeBase32Unpadded+  , decode = TS32.decodeBase32Untyped+  , decodePad = TS32.decodeBase32PaddedUntyped+  , decodeNopad = TS32.decodeBase32UnpaddedUntyped+  , parseValue = fmap extractBase32 . TS32.parseBase32Padded+  , parseHexValue = fmap extractBase32 . TS32H.parseBase32Padded+  , parsePaddedValue = fmap extractBase32 . TS32.parseBase32Padded+  , parseUnpaddedValue = fmap extractBase32 . TS32.parseBase32Unpadded+  , parseHexPaddedValue = fmap extractBase32 . TS32H.parseBase32Padded+  , parseHexUnpaddedValue = fmap extractBase32 . TS32H.parseBase32Unpadded+  , correct = isRight . TS32.decodeBase32Untyped+  , validate = isRight . TS32.decodeBase32Untyped+  , encodeHex = extractBase32 . TS32H.encodeBase32+  , encodeHexNopad = extractBase32 . TS32H.encodeBase32Unpadded+  , decodeHex = TS32H.decodeBase32Untyped+  , decodeHexPad = TS32H.decodeBase32PaddedUntyped+  , decodeHexNopad = TS32H.decodeBase32UnpaddedUntyped+  , correctHex = isRight . TS32H.decodeBase32Untyped+  , validateHex = isRight . TS32H.decodeBase32Untyped   }  -- -------------------------------------------------------------------- --@@ -200,11 +287,16 @@  data TextHarness bs cs = TextHarness   { decodeWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs-  , decodePaddedWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs-  , decodeUnpaddedWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs-  , decodeHexWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs-  , decodeHexPaddedWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs-  , decodeHexUnpaddedWith_ :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+  , decodePaddedWith_+      :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+  , decodeUnpaddedWith_+      :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+  , decodeHexWith_+      :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+  , decodeHexPaddedWith_+      :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+  , decodeHexUnpaddedWith_+      :: forall err. (bs -> Either err cs) -> bs -> Either (Base32Error err) cs   }  tt32 :: TextHarness BS.ByteString Text