base32 0.1.1.2 → 0.2.0.0

raw patch · 26 files changed

+3916/−533 lines, 26 filesdep +QuickCheckdep +ghc-byteorderdep +tasty-quickcheckdep ~bytestringdep ~deepseqPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, ghc-byteorder, tasty-quickcheck, text-short

Dependency ranges changed: bytestring, deepseq

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• README.md +13/−8
• base32.cabal +22/−6
• benchmarks/Base32Bench.hs +44/−6
• src/Data/ByteString/Base32.hs +139/−25
• src/Data/ByteString/Base32/Hex.hs +141/−35
• src/Data/ByteString/Base32/Internal.hs +70/−6
• src/Data/ByteString/Base32/Internal/Head.hs +33/−48
• src/Data/ByteString/Base32/Internal/Loop.hs +148/−100
• src/Data/ByteString/Base32/Internal/Tables.hs +2/−2
• src/Data/ByteString/Base32/Internal/Tail.hs +18/−104
• src/Data/ByteString/Base32/Internal/Utils.hs +53/−0
• src/Data/ByteString/Lazy/Base32.hs +244/−0
• src/Data/ByteString/Lazy/Base32/Hex.hs +245/−0
• src/Data/ByteString/Short/Base32.hs +212/−0
• src/Data/ByteString/Short/Base32/Hex.hs +210/−0
• src/Data/Text/Encoding/Base32.hs +188/−18
• src/Data/Text/Encoding/Base32/Error.hs +56/−0
• src/Data/Text/Encoding/Base32/Hex.hs +201/−27
• src/Data/Text/Lazy/Encoding/Base32.hs +274/−0
• src/Data/Text/Lazy/Encoding/Base32/Hex.hs +274/−0
• src/Data/Text/Short/Encoding/Base32.hs +273/−0
• src/Data/Text/Short/Encoding/Base32/Hex.hs +273/−0
• test/Base32Tests.hs +0/−148
• test/Internal.hs +308/−0
• test/Main.hs +465/−0

@@ -1,5 +1,15 @@ # Revision history for base32 +## 0.2.0.0++* Bugfix: fix unpadded base32 encoding ([#4](https://github.com/emilypi/Base32/pull/4))+* Bugfix: Use `decodeLatin1` when decoding, defer to `decodeWith*` primitives for finer-grained+          `Text` to `ByteString` conversions. ([#5](https://github.com/emilypi/Base32/pull/5))+* Add short and lazy variants for `Text` and `ByteString` ([#6](https://github.com/emilypi/Base32/pull/6))+* Expanded test coverage to 96% ([#7](https://github.com/emilypi/Base32/pull/7))+* Improved performance and better error reporting in final quanta ([#9](https://github.com/emilypi/Base32/pull/9))+* Improved docs + trustworthy/safe annotations ([#10](https://github.com/emilypi/Base32/pull/10))+ ## 0.1.1.1 -- 2020-02-16  * Documentation now references correct RFC section

@@ -7,16 +7,21 @@  For the companion optics and pattern synonyms, see [base32-lens](https://hackage.haskell.org/package/base32-lens). - ### Summary -What does this library provide? Here is the summary:+The following types are supported for both padded and unpadded std and extended hex alphabets: -- Support for padded and unpadded Base32 and Base32hex-- Support for `Text` encodings and decodings-- Optics for handling more complex structures with Base32 representations via the `base32-lens` package-- Checks for both valid Base32 and correct Base32 and Base32hex encodings+- `Data.ByteString`+- `Data.ByteString.Lazy`+- `Data.ByteString.Short`+- `Data.Text`+- `Data.Text.Lazy`+- `Data.Text.Short` -There are no dependencies aside from those bundled with GHC:+Additionally this library has -![base32 dependencies](https://i.imgur.com/8CdVsey.png)+- 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++There are no dependencies aside from those bundled with GHC, `text-short`, and the `ghc-byteorder` re-export.

@@ -1,7 +1,7 @@ cabal-version:      2.0 name:               base32-version:            0.1.1.2-synopsis:           RFC 4648-compliant Base32 encodings/decodings+version:            0.2.0.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.@@ -30,8 +30,17 @@   exposed-modules:     Data.ByteString.Base32     Data.ByteString.Base32.Hex+    Data.ByteString.Lazy.Base32+    Data.ByteString.Lazy.Base32.Hex+    Data.ByteString.Short.Base32+    Data.ByteString.Short.Base32.Hex     Data.Text.Encoding.Base32+    Data.Text.Encoding.Base32.Error     Data.Text.Encoding.Base32.Hex+    Data.Text.Lazy.Encoding.Base32+    Data.Text.Lazy.Encoding.Base32.Hex+    Data.Text.Short.Encoding.Base32+    Data.Text.Short.Encoding.Base32.Hex    other-modules:     Data.ByteString.Base32.Internal@@ -42,9 +51,12 @@     Data.ByteString.Base32.Internal.Utils    build-depends:-      base        >=4.10 && <5-    , bytestring  ^>=0.10-    , text        ^>=1.2+      base           >=4.10     && <5+    , bytestring     ^>=0.10+    , deepseq        >=1.4.3.0  && <1.4.5.0+    , ghc-byteorder  ^>=4.11.0.0+    , text           ^>=1.2+    , text-short     ^>=0.1    hs-source-dirs:   src   default-language: Haskell2010@@ -54,16 +66,20 @@   default-language: Haskell2010   type:             exitcode-stdio-1.0   hs-source-dirs:   test-  main-is:          Base32Tests.hs+  other-modules:    Internal+  main-is:          Main.hs   build-depends:       base               >=4.10 && <5     , base32     , bytestring     , memory+    , QuickCheck     , random-bytestring     , tasty     , tasty-hunit+    , tasty-quickcheck     , text+    , text-short  benchmark bench   default-language: Haskell2010

@@ -20,33 +20,62 @@       bgroup "encode"       [ bgroup "25"         [ bench "memory" $ whnf ctob bs25-        , bench "base64" $ whnf B32.encodeBase32' bs25+        , bench "base32" $ whnf B32.encodeBase32' bs25         ]       , bgroup "100"         [ bench "memory" $ whnf ctob bs100-        , bench "base64" $ whnf B32.encodeBase32' bs100+        , bench "base32" $ whnf B32.encodeBase32' bs100         ]       , bgroup "1k"         [ bench "memory" $ whnf ctob bs1k-        , bench "base64" $ whnf B32.encodeBase32' bs1k+        , bench "base32" $ whnf B32.encodeBase32' bs1k         ]       , bgroup "10k"         [ bench "memory" $ whnf ctob bs10k-        , bench "base64" $ whnf B32.encodeBase32' bs10k+        , bench "base32" $ whnf B32.encodeBase32' bs10k         ]       , bgroup "100k"         [ bench "memory" $ whnf ctob bs100k-        , bench "base64" $ whnf B32.encodeBase32' bs100k+        , bench "base32" $ whnf B32.encodeBase32' bs100k         ]       , bgroup "1mm"         [ bench "memory" $ whnf ctob bs1mm-        , bench "base64" $ whnf B32.encodeBase32' 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+        ]+      ]     ]   where     ctob :: ByteString -> ByteString     ctob = Mem.convertToBase Mem.Base32+    btoc :: ByteString -> Either String ByteString+    btoc = Mem.convertFromBase Mem.Base32      bs = do       a <- random 25@@ -55,4 +84,13 @@       d <- random 10000       e <- random 100000       f <- random 1000000+      return (a,b,c,d,e,f)++    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)

@@ -1,18 +1,20 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Base32--- Copyright 	: (c) 2020 Emily Pillmore--- License	: BSD-style+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style ----- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>--- Stability	: Experimental--- Portability	: portable+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable ----- This module contains the combinators implementing the--- RFC 4648 specification for the Base32 encoding including--- unpadded and lenient variants+-- This module contains 'Data.ByteString.ByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base32+-- encoding format. This includes padded and unpadded decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.ByteString.Base32 ( encodeBase32@@ -21,13 +23,15 @@ , encodeBase32Unpadded , encodeBase32Unpadded' , decodeBase32Unpadded+, decodeBase32Padded -- , decodeBase32Lenient , isBase32 , isValidBase32 ) where  -import Data.ByteString (ByteString)+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@@ -35,59 +39,147 @@ import Data.Text (Text) import qualified Data.Text.Encoding as T +import System.IO.Unsafe (unsafeDupablePerformIO) --- | Encode a 'ByteString' value as Base32 'Text' with padding.++-- | Encode a 'ByteString' value as a Base32 'Text' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "KN2W4==="+-- encodeBase32 :: ByteString -> Text encodeBase32 = T.decodeUtf8 . encodeBase32' {-# INLINE encodeBase32 #-} --- | Encode a 'ByteString' value as a Base32 'ByteString'  value with padding.+-- | Encode a 'ByteString' value as a Base32 'ByteString' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --+-- === __Examples__:+--+-- >>> encodeBase32' "Sun"+-- "KN2W4==="+-- encodeBase32' :: ByteString -> ByteString encodeBase32' = encodeBase32_ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"# {-# INLINE encodeBase32' #-} --- | Decode a padded Base32-encoded 'ByteString' value.+-- | Decode an arbitrarily padded Base32-encoded 'ByteString' value. If its length+-- is not a multiple of 8, then padding characters 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==="+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W==="+-- Left "Base32-encoded bytestring has invalid padding"+-- decodeBase32 :: ByteString -> Either Text ByteString-decodeBase32 = decodeBase32_ False stdDecodeTable+decodeBase32 bs@(PS _ _ !l)+    | l == 0 = Right bs+    | r == 0 = unsafeDupablePerformIO $ decodeBase32_ dlen stdDecodeTable bs+    | r == 2 = unsafeDupablePerformIO $ decodeBase32_ dlen stdDecodeTable (BS.append bs "======")+    | r == 4 = validateLastNPads 2 bs $ decodeBase32_ dlen stdDecodeTable (BS.append bs "====")+    | r == 5 = validateLastNPads 3 bs $ decodeBase32_ dlen stdDecodeTable (BS.append bs "===")+    | r == 7 = validateLastNPads 5 bs $ decodeBase32_ dlen stdDecodeTable (BS.append bs "=")+    | otherwise = Left "Base32-encoded bytestring has invalid size"+  where+    !r = l `rem` 8+    !q = l `quot` 8+    !dlen = q * 5 {-# INLINE decodeBase32 #-}  -- | Encode a 'ByteString' value as a Base32 'Text' value without padding. ----- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>,---      <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --+-- === __Examples__: --+-- >>> encodeBase32Unpadded "Sun"+-- "KN2W4"+-- encodeBase32Unpadded :: ByteString -> Text encodeBase32Unpadded = T.decodeUtf8 . encodeBase32Unpadded' {-# INLINE encodeBase32Unpadded #-} --- | Encode a 'ByteString' value as a Base32 'ByteString'  value with padding.+-- | Encode a 'ByteString' value as a Base32 'ByteString' value without padding. ----- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>,---      <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --+-- === __Examples__:+--+-- >>> encodeBase32Unpadded' "Sun"+-- "KN2W4"+-- encodeBase32Unpadded' :: ByteString -> ByteString encodeBase32Unpadded' = encodeBase32NoPad_ "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"# {-# INLINE encodeBase32Unpadded' #-} --- | Decode an arbitarily padded Base32-encoded 'ByteString' value.+-- | Decode an unpadded Base32-encoded 'ByteString' value. ----- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>,---      <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+-- decodeBase32Unpadded :: ByteString -> Either Text ByteString-decodeBase32Unpadded = decodeBase32_ True stdDecodeTable+decodeBase32Unpadded bs@(PS _ _ !l)+    | l == 0 = Right bs+    | r == 0 = validateLastNPads 1 bs $ decodeBase32_ dlen stdDecodeTable bs+    | r == 2 = unsafeDupablePerformIO $ decodeBase32_ dlen stdDecodeTable (BS.append bs "======")+    | r == 4 = validateLastNPads 1 bs $ decodeBase32_ dlen stdDecodeTable (BS.append bs "====")+    | r == 5 = validateLastNPads 1 bs $ decodeBase32_ dlen stdDecodeTable (BS.append bs "===")+    | r == 7 = validateLastNPads 1 bs $ decodeBase32_ dlen stdDecodeTable (BS.append bs "=")+    | otherwise = Left "Base32-encoded bytestring has invalid size"+  where+    !q = l `quot` 8+    !r = l `rem` 8+    !dlen = q * 5 {-# INLINE decodeBase32Unpadded #-} +-- | Decode a padded Base32-encoded 'ByteString' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: ByteString -> Either Text ByteString+decodeBase32Padded bs@(PS _ _ !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"+    | otherwise = unsafeDupablePerformIO $ decodeBase32_ dlen stdDecodeTable bs+  where+    !q = l `quot` 8+    !r = l `rem` 8+    !dlen = q * 5+{-# INLINE decodeBase32Padded #-}+ -- -- | 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.@@ -98,8 +190,19 @@ -- decodeBase32Lenient = decodeBase32Lenient_ decodeB32Table -- {-# INLINE decodeBase32Lenient #-} --- | Tell whether a 'ByteString' value is base32 encoded.+-- | Tell whether a 'ByteString' value is encoded in padded or unpadded Base32 format --+-- === __Examples__:+--+-- >>> isBase32 "KN2W4"+-- True+--+-- >>> isBase32 "KN2W4==="+-- True+--+-- >>> isBase32 "KN2W4=="+-- False+-- isBase32 :: ByteString -> Bool isBase32 bs = isValidBase32 bs && isRight (decodeBase32 bs) {-# INLINE isBase32 #-}@@ -107,8 +210,19 @@ -- | Tell whether a 'ByteString' value is a valid Base32 format. -- -- 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'.+-- 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'.+--+-- === __Examples__:+--+-- >>> isValidBase32 "KN2W4"+-- True+--+-- >>> isValidBase32 "KN2W4="+-- False+--+-- >>> isValidBase32 "KN2W4%"+-- False -- isValidBase32 :: ByteString -> Bool isValidBase32 = validateBase32 "ABCDEFGHIJKLMNOPQRSTUVWXYZ234567"

@@ -1,18 +1,20 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Base32.Hex--- Copyright 	: (c) 2020 Emily Pillmore--- License	: BSD-style+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style ----- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>--- Stability	: Experimental--- Portability	: portable+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable ----- This module contains the combinators implementing the--- RFC 4648 specification for the Base32-Hex encoding including--- unpadded and lenient variants+-- This module contains 'Data.ByteString.ByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base32hex+-- encoding format. This includes padded and unpadded decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.ByteString.Base32.Hex ( encodeBase32@@ -21,12 +23,15 @@ , encodeBase32Unpadded , encodeBase32Unpadded' , decodeBase32Unpadded+, decodeBase32Padded -- , decodeBase32Lenient , isBase32Hex , isValidBase32Hex ) where -import Data.ByteString (ByteString)++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@@ -34,79 +39,180 @@ import Data.Text (Text) import qualified Data.Text.Encoding as T +import System.IO.Unsafe (unsafeDupablePerformIO) + -- | Encode a 'ByteString' value as a Base32hex 'Text' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> --+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "ADQMS==="+-- encodeBase32 :: ByteString -> Text encodeBase32 = T.decodeUtf8 . encodeBase32' {-# INLINE encodeBase32 #-} --- | Encode a 'ByteString' as a Base32hex 'ByteString' value with padding.+-- | Encode a 'ByteString' value as a Base32hex 'ByteString' value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> --+-- === __Examples__:+--+-- >>> encodeBase32' "Sun"+-- "ADQMS==="+-- encodeBase32' :: ByteString -> ByteString encodeBase32' = encodeBase32_ "0123456789ABCDEFGHIJKLMNOPQRSTUV"# {-# INLINE encodeBase32' #-} --- | Decode a padded Base32hex encoded 'ByteString' value.+-- | Decode an arbitrarily padded Base32hex-encoded 'ByteString' value. If its length+-- is not a multiple of 8, then padding characters 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==="+-- Right "Sun"+--+-- >>> decodeBase32 "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32 "ADQM==="+-- Left "Base32-encoded bytestring has invalid padding"+-- decodeBase32 :: ByteString -> Either Text ByteString-decodeBase32 = decodeBase32_ False hexDecodeTable+decodeBase32 bs@(PS _ _ !l)+    | l == 0 = Right bs+    | r == 0 = unsafeDupablePerformIO $ decodeBase32_ dlen hexDecodeTable bs+    | r == 2 = unsafeDupablePerformIO $ decodeBase32_ dlen hexDecodeTable (BS.append bs "======")+    | r == 4 = validateLastNPads 2 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "====")+    | r == 5 = validateLastNPads 3 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "===")+    | r == 7 = validateLastNPads 5 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "=")+    | otherwise = Left "Base32-encoded bytestring has invalid size"+  where+    !r = l `rem` 8+    !q = l `quot` 8+    !dlen = q * 8 {-# INLINE decodeBase32 #-} --- | Encode a 'ByteString' as a Base32hex 'Text' value without padding.+-- | Encode a 'ByteString' value as a Base32hex 'Text' value without padding. ----- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>,---      <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> --+-- === __Examples__:+--+-- >>> encodeBase32Unpadded' "Sun"+-- "ADQMS"+-- encodeBase32Unpadded :: ByteString -> Text encodeBase32Unpadded = T.decodeUtf8 . encodeBase32Unpadded' {-# INLINE encodeBase32Unpadded #-} --- | Encode a 'ByteString' as a Base32hex 'ByteString' value without padding.+-- | Encode a 'ByteString' value as a Base32hex 'ByteString' value without padding. ----- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>,---      <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> --+-- === __Examples__:+--+-- >>> encodeBase32Unpadded' "Sun"+-- "ADQMS"+-- encodeBase32Unpadded' :: ByteString -> ByteString encodeBase32Unpadded' = encodeBase32NoPad_ "0123456789ABCDEFGHIJKLMNOPQRSTUV"# {-# INLINE encodeBase32Unpadded' #-} --- | Decode an arbitrarily padded Base32hex encoded 'ByteString' value.+-- | Decode an unpadded Base32hex-encoded 'ByteString' value. ----- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>,---      <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7> --+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+-- decodeBase32Unpadded :: ByteString -> Either Text ByteString-decodeBase32Unpadded = decodeBase32_ True hexDecodeTable+decodeBase32Unpadded bs@(PS _ _ !l)+    | l == 0 = Right bs+    | r == 0 = validateLastNPads 1 bs $ decodeBase32_ dlen hexDecodeTable bs+    | r == 2 = unsafeDupablePerformIO $ decodeBase32_ dlen hexDecodeTable (BS.append bs "======")+    | r == 4 = validateLastNPads 1 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "====")+    | r == 5 = validateLastNPads 1 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "===")+    | r == 7 = validateLastNPads 1 bs $ decodeBase32_ dlen hexDecodeTable (BS.append bs "=")+    | otherwise = Left "Base32-encoded bytestring has invalid size"+  where+    !q = l `quot` 8+    !r = l `rem` 8+    !dlen = q * 5 {-# INLINE decodeBase32Unpadded #-} --- -- | 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.--- ----- decodeBase32Lenient :: ByteString -> ByteString--- decodeBase32Lenient = decodeBase32Lenient_ decodeB32HexTable--- {-# INLINE decodeBase32Lenient #-}+-- | Decode a padded Base32hex-encoded 'ByteString' value.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: ByteString -> Either Text ByteString+decodeBase32Padded bs@(PS _ _ !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"+    | otherwise = unsafeDupablePerformIO $ decodeBase32_ dlen hexDecodeTable bs+  where+    !q = l `quot` 8+    !r = l `rem` 8+    !dlen = q * 5+{-# INLINE decodeBase32Padded #-} --- | Tell whether a 'ByteString' is Base32hex-encoded.+-- | Tell whether a 'ByteString' value is encoded in padded or unpadded Base32hex format --+-- === __Examples__:+--+-- >>> isBase32Hex "ADQMS"+-- True+--+-- >>> isBase32Hex "ADQMS==="+-- True+--+-- >>> isBase32Hex "ADQMS=="+-- False+-- isBase32Hex :: ByteString -> Bool isBase32Hex bs = isValidBase32Hex bs && isRight (decodeBase32 bs) {-# INLINE isBase32Hex #-} --- | Tell whether a 'ByteString' is a valid Base32hex format.+-- | Tell whether a 'ByteString' value is a valid Base32hex format. -- -- 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 'ByteString' value, use 'isBase32Hex'.+-- 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'.+--+-- === __Examples__:+--+-- >>> isValidBase32Hex "ADQMS"+-- True+--+-- >>> isValidBase32Hex "ADQMS="+-- False+--+-- >>> isValidBase32Hex "ADQMS%"+-- False -- isValidBase32Hex :: ByteString -> Bool isValidBase32Hex = validateBase32 "0123456789ABCDEFGHIJKLMNOPQRSTUV"

@@ -18,30 +18,46 @@ -- module Data.ByteString.Base32.Internal ( validateBase32+, validateLastNPads ) where   import qualified Data.ByteString as BS import Data.ByteString.Internal+import Data.Text (Text)  import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable +import GHC.Word++import System.IO.Unsafe+ -- -------------------------------------------------------------------------- ----- Validating Base64+-- Validating Base32  validateBase32 :: ByteString -> ByteString -> Bool-validateBase32 !alphabet (PS fp off l) =-    accursedUnutterablePerformIO $ withForeignPtr fp $ \p ->-      go (plusPtr p off) (plusPtr p (l + off))+validateBase32 !alphabet bs@(PS _ _ 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 (PS fp o l') = accursedUnutterablePerformIO $ withForeignPtr fp $ \p ->+      go (plusPtr p o) (plusPtr p (l' + o))+     go !p !end       | p == end = return True       | otherwise = do         w <- peek p -        let f a+        let check a               | a == 0x3d, plusPtr p 1 == end = True               | a == 0x3d, plusPtr p 2 == end = True               | a == 0x3d, plusPtr p 3 == end = True@@ -51,5 +67,53 @@               | a == 0x3d = False               | otherwise = BS.elem a alphabet -        if f w then go (plusPtr p 1) end else return False+        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 (PS !fp !o !l) io+    | not valid = Left "Base32-encoded bytestring has invalid padding"+    | otherwise = unsafeDupablePerformIO io+  where+    !lo = l + o+    valid = accursedUnutterablePerformIO $ withForeignPtr fp $ \p -> do+      let end = plusPtr p lo++      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 (lo - n))+{-# INLINE validateLastNPads #-}

@@ -9,10 +9,10 @@ ) where  -import qualified Data.ByteString as BS import Data.ByteString.Internal import Data.ByteString.Base32.Internal.Loop import Data.ByteString.Base32.Internal.Tail+import Data.ByteString.Base32.Internal.Utils import Data.Text (Text)  import Foreign.Ptr@@ -28,64 +28,49 @@ -- | Head of the base32 encoding loop - marshal data, assemble loops -- encodeBase32_ :: Addr# -> ByteString -> ByteString-encodeBase32_ !lut (PS !sfp !soff !slen) =-    unsafeCreate dlen $ \dptr ->-      withForeignPtr sfp $ \sptr -> do-        let !end = plusPtr sptr (soff + slen)-        innerLoop-          lut-          (castPtr dptr)-          (plusPtr sptr soff)-          end-          (loopTail lut end)+encodeBase32_ !lut (PS !sfp !o !l) =+    unsafeDupablePerformIO $ do+      dfp <- mallocPlainForeignPtrBytes dlen+      withForeignPtr dfp $ \dptr ->+        withForeignPtr sfp $ \sptr -> do+          let !end = plusPtr sptr (l + o)+          innerLoop+            lut+            (castPtr dptr)+            (plusPtr sptr o)+            end+            (loopTail lut dfp dptr end)   where-    !dlen = 8 * ((slen + 4) `div` 5)+    !q = (l * 8) `quot` 5+    !r = (l * 8) `rem` 5+    !dlen = padCeilN 8 (q + if r == 0 then 0 else 1)  -- | Head of the unpadded base32 encoding loop - marshal data, assemble loops -- encodeBase32NoPad_ :: Addr# -> ByteString -> ByteString-encodeBase32NoPad_ !lut (PS !sfp !soff !slen)-    = unsafeDupablePerformIO $ do+encodeBase32NoPad_ !lut (PS !sfp !o !l) =+    unsafeDupablePerformIO $ do       !dfp <- mallocPlainForeignPtrBytes dlen       withForeignPtr dfp $ \dptr ->         withForeignPtr sfp $ \sptr -> do-          let !end = plusPtr sptr (soff + slen)-          innerLoopNoPad-            lut+          let !end = plusPtr sptr (l + o)+          innerLoop lut             (castPtr dptr)-            (plusPtr sptr soff)+            (plusPtr sptr o)             end-            (loopTailNoPad lut dfp end)+            (loopTailNoPad lut dfp dptr end)   where-    !dlen = 8 * ((slen + 4) `div` 5)+    !q = (l * 8) `quot` 5+    !r = (l * 8) `rem` 5+    !dlen = padCeilN 8 (q + if r == 0 then 0 else 1)  -- | Head of the base32 decoding loop - marshal data, assemble loops ---decodeBase32_ :: Bool -> ForeignPtr Word8 -> ByteString -> Either Text ByteString-decodeBase32_ !pad !alphabet bs@(PS _ _ !l)-    | l == 0 = Right ""-    | r /= 0, pad =-      if-        | r == 2 -> go (BS.append bs (BS.replicate 6 0x3d))-        | r == 4 -> go (BS.append bs (BS.replicate 4 0x3d))-        | r == 5 -> go (BS.append bs (BS.replicate 3 0x3d))-        | r == 7 -> go (BS.append bs (BS.replicate 1 0x3d))-        | otherwise -> Left "invalid bytestring size"-    | r /= 0, not pad = Left "invalid padding"-    | otherwise = go bs-  where-    (!q, !r) = l `divMod` 8-    !dlen = q * 8--    go (PS !sfp !soff !slen) = unsafeDupablePerformIO $ do-      !dfp <- mallocPlainForeignPtrBytes dlen-      withForeignPtr dfp $ \dptr ->-        withForeignPtr alphabet $ \(Ptr lut) ->-        withForeignPtr sfp $ \sptr -> do-          let !end = plusPtr sptr (soff + slen)-          decodeLoop-            lut-            (castPtr dptr)-            (plusPtr sptr soff)-            end-            (decodeTail lut dfp end)+decodeBase32_ :: Int -> ForeignPtr Word8 -> ByteString -> IO (Either Text ByteString)+decodeBase32_ !dlen !dtfp (PS !sfp !soff !slen) =+    withForeignPtr dtfp $ \(Ptr dtable) ->+    withForeignPtr sfp $ \sptr -> do+      dfp <- mallocPlainForeignPtrBytes dlen+      withForeignPtr dfp $ \dptr -> do+        let !end = plusPtr sptr (soff + slen)+        decodeLoop dtable dfp dptr (plusPtr sptr soff) end

@@ -1,20 +1,21 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiWayIf #-} {-# LANGUAGE TypeApplications #-} module Data.ByteString.Base32.Internal.Loop ( innerLoop-, innerLoopNoPad , decodeLoop ) where  import Data.Bits-import Data.ByteString (ByteString)+import Data.ByteString.Internal (ByteString(..)) import Data.ByteString.Base32.Internal.Utils import Data.Text (Text) import qualified Data.Text as T  import Foreign.Ptr+import Foreign.ForeignPtr import Foreign.Storable  import GHC.Exts@@ -29,132 +30,179 @@     -> Ptr Word64     -> Ptr Word8     -> Ptr Word8-    -> (Ptr Word8 -> Ptr Word8 -> IO ())-    -> IO ()+    -> (Ptr Word8 -> Ptr Word8 -> IO ByteString)+    -> IO ByteString innerLoop !lut !dptr !sptr !end finish = go dptr sptr   where-    lix a = return $ w64 (aix (fromIntegral a .&. 0x1f) lut)+    lix a = w64 (aix (fromIntegral a .&. 0x1f) lut)     {-# INLINE lix #-}      go !dst !src       | plusPtr src 4 >= end = finish (castPtr dst) src       | otherwise = do-#ifdef WORDS_BIGENDIAN-        !t <- peek @Word32 (castPtr src)-#else-        !t <- byteSwap32 <$> peek @Word32 (castPtr src)-#endif+        !t <- peekWord32BE (castPtr src)         !u <- w32 <$> peek (plusPtr src 4) -        !a <- lix (unsafeShiftR t 27)-        !b <- lix (unsafeShiftR t 22)-        !c <- lix (unsafeShiftR t 17)-        !d <- lix (unsafeShiftR t 12)-        !e <- lix (unsafeShiftR t 7)-        !f <- lix (unsafeShiftR t 2)-        !g <- lix ((unsafeShiftL t 3) .|. (unsafeShiftR u 5))-        !h <- lix u+        let !a = lix (unsafeShiftR t 27)+            !b = lix (unsafeShiftR t 22)+            !c = lix (unsafeShiftR t 17)+            !d = lix (unsafeShiftR t 12)+            !e = lix (unsafeShiftR t 7)+            !f = lix (unsafeShiftR t 2)+            !g = lix ((unsafeShiftL t 3) .|. (unsafeShiftR u 5))+            !h = lix u -        w <- return $ a-          .|. (unsafeShiftL b 8)-          .|. (unsafeShiftL c 16)-          .|. (unsafeShiftL d 24)-          .|. (unsafeShiftL e 32)-          .|. (unsafeShiftL f 40)-          .|. (unsafeShiftL g 48)-          .|. (unsafeShiftL h 56)+        let !w = a+             .|. (unsafeShiftL b 8)+             .|. (unsafeShiftL c 16)+             .|. (unsafeShiftL d 24)+             .|. (unsafeShiftL e 32)+             .|. (unsafeShiftL f 40)+             .|. (unsafeShiftL g 48)+             .|. (unsafeShiftL h 56)          poke dst w-         go (plusPtr dst 8) (plusPtr src 5) {-# INLINE innerLoop #-} -innerLoopNoPad-    :: Addr#-    -> Ptr Word64-    -> Ptr Word8-    -> Ptr Word8-    -> (Ptr Word8 -> Ptr Word8 -> Int -> IO ByteString)-    -> IO ByteString-innerLoopNoPad !lut !dptr !sptr !end finish = go dptr sptr 0-  where-    lix a = return $ w64 (aix (fromIntegral a .&. 0x1f) lut)--    go !dst !src !n-      | plusPtr src 4 >= end = finish (castPtr dptr) src n-      | otherwise = do-#ifdef WORDS_BIGENDIAN-        !t <- peek @Word32 (castPtr src)-#else-        !t <- byteSwap32 <$> peek @Word32 (castPtr src)-#endif-        !u <- w32 <$> peek (plusPtr src 4)--        !a <- lix (unsafeShiftR t 27)-        !b <- lix (unsafeShiftR t 22)-        !c <- lix (unsafeShiftR t 17)-        !d <- lix (unsafeShiftR t 12)-        !e <- lix (unsafeShiftR t 7)-        !f <- lix (unsafeShiftR t 2)-        !g <- lix ((unsafeShiftL t 3) .|. (unsafeShiftR u 5))-        !h <- lix u--        !w <- return $ a-          .|. (unsafeShiftL b 8)-          .|. (unsafeShiftL c 16)-          .|. (unsafeShiftL d 24)-          .|. (unsafeShiftL e 32)-          .|. (unsafeShiftL f 40)-          .|. (unsafeShiftL g 48)-          .|. (unsafeShiftL h 56)--        poke dst w--        go (plusPtr dst 8) (plusPtr src 5) (n + 8)-{-# INLINE innerLoopNoPad #-}- -- ------------------------------------------------------------------------ -- -- Decoding loops  decodeLoop     :: Addr#+    -> ForeignPtr Word8     -> Ptr Word8     -> Ptr Word64     -> Ptr Word8-    -> (Ptr Word8 -> Ptr Word8 -> Int -> IO (Either Text ByteString))     -> IO (Either Text ByteString)-decodeLoop !lut !dptr !sptr !end finish = go dptr sptr 0+decodeLoop !lut !dfp !dptr !sptr !end = go dptr sptr   where     lix a = w64 (aix (fromIntegral a) lut) -    roll !w !acc = (acc `unsafeShiftL` 5) .|. lix w+    err :: Ptr Word64 -> IO (Either Text ByteString)+    err p = return . Left . T.pack+      $ "invalid character at offset: "+      ++ show (p `minusPtr` sptr) -    err = return . Left . T.pack+    padErr :: Ptr Word64 -> IO (Either Text ByteString)+    padErr p =  return . Left . T.pack+      $ "invalid padding at offset: "+      ++ show (p `minusPtr` sptr) -    go !dst !src !n-      | plusPtr src 8 == end = finish dst (castPtr src) n+    look :: Ptr Word8 -> IO Word64+    look !p = lix . w64 <$> peek @Word8 p++    go !dst !src+      | plusPtr src 8 >= end = do++        let src' = castPtr src++        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-#ifdef WORDS_BIGENDIAN-        !t <- peek src-#else-        !t <- byteSwap64 <$> peek src-#endif-        !w <- return-          $ roll (unsafeShiftR t 0)-          $ roll (unsafeShiftR t 8)-          $ roll (unsafeShiftR t 16)-          $ roll (unsafeShiftR t 24)-          $ roll (unsafeShiftR t 32)-          $ roll (unsafeShiftR t 40)-          $ roll (unsafeShiftR t 48)-          $ roll (unsafeShiftR t 56)-          0+        !t <- peekWord64BE src -        if w /= 0xff-        then do-          poke @Word8 dst (fromIntegral (w `unsafeShiftR` 32))-          poke @Word32 (castPtr (plusPtr dst 1)) (byteSwap32 (fromIntegral w))-          go (plusPtr dst 5) (plusPtr src 8) (n + 5)-        else err-          $ "invalid character at offset: "-          ++ show (src `minusPtr` sptr)+        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 (PS dfp 0 (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 (PS dfp 0 (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 (PS dfp 0 (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 (PS dfp 0 (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 (PS dfp 0 (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)+      | otherwise = do++        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++        poke @Word32 (castPtr dst) (byteSwap32 (fromIntegral (unsafeShiftR w 8)))+        poke @Word8 (plusPtr dst 4) (fromIntegral w)+        go (plusPtr dst 5) (plusPtr src 8)

@@ -18,7 +18,7 @@     [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff     , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff     , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-    , 0xff,0xff,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff+    , 0xff,0xff,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0xff,0xff,0xff,0xff,0xff,0x63,0xff,0xff     , 0xff,0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0x0c,0x0d,0x0e     , 0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18,0x19,0xff,0xff,0xff,0xff,0xff     , 0xff,0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0x0a,0x0b,0x0c,0x0d,0x0e@@ -39,7 +39,7 @@     [ 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff     , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff     , 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff-    , 0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0xff,0xff,0xff,0xff,0xff,0xff+    , 0x00,0x01,0x02,0x03,0x04,0x05,0x06,0x07,0x08,0x09,0xff,0xff,0xff,0x63,0xff,0xff     , 0xff,0x0a,0x0b,0x0c,0x0d,0x0e,0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18     , 0x19,0x1a,0x1b,0x1c,0x1d,0x1e,0x1f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff     , 0xff,0x0a,0x0b,0x0c,0x0d,0x0e,0x0f,0x10,0x11,0x12,0x13,0x14,0x15,0x16,0x17,0x18

@@ -7,15 +7,12 @@ module Data.ByteString.Base32.Internal.Tail ( loopTail , loopTailNoPad-, decodeTail ) where   import Data.Bits import Data.ByteString.Internal import Data.ByteString.Base32.Internal.Utils-import Data.Text (Text)-import qualified Data.Text as T  import Foreign.Ptr import Foreign.ForeignPtr@@ -29,11 +26,14 @@ -- loopTail     :: Addr#+    -> ForeignPtr Word8     -> Ptr Word8     -> Ptr Word8     -> Ptr Word8-    -> IO ()-loopTail !lut !end !dst !src+    -> Ptr Word8+    -> IO ByteString+loopTail !lut !dfp !dptr !end !dst !src+    | src == end = return (PS dfp 0 (minusPtr dst dptr))     | plusPtr src 1 == end = do -- 2 6       !a <- peek src @@ -44,6 +44,7 @@       poke (plusPtr dst 1) u       padN (plusPtr dst 2) 6 +      return (PS dfp 0 (8 + minusPtr dst dptr))     | plusPtr src 2 == end = do -- 4 4       !a <- peek src       !b <- peek (plusPtr src 1)@@ -59,6 +60,7 @@       poke (plusPtr dst 3) w       padN (plusPtr dst 4) 4 +      return (PS dfp 0 (8 + minusPtr dst dptr))     | plusPtr src 3 == end = do -- 5 3       !a <- peek src       !b <- peek (plusPtr src 1)@@ -76,8 +78,9 @@       poke (plusPtr dst 3) w       poke (plusPtr dst 4) x       padN (plusPtr dst 5) 3+      return (PS dfp 0 (8 + minusPtr dst dptr)) -    | plusPtr src 4 == end = do -- 7 1+    | otherwise = do -- 7 1       !a <- peek src       !b <- peek (plusPtr src 1)       !c <- peek (plusPtr src 2)@@ -99,8 +102,7 @@       poke (plusPtr dst 5) y       poke (plusPtr dst 6) z       padN (plusPtr dst 7) 1--    | otherwise = return ()+      return (PS dfp 0 (8 + minusPtr dst dptr))   where     look !n = aix n lut @@ -117,9 +119,10 @@     -> Ptr Word8     -> Ptr Word8     -> Ptr Word8-    -> Int+    -> Ptr Word8     -> IO ByteString-loopTailNoPad !lut !dfp !end !dst !src !n+loopTailNoPad !lut !dfp !dptr !end !dst !src+  | src == end = return (PS dfp 0 (minusPtr dst dptr))   | plusPtr src 1 == end = do -- 2 6       !a <- peek src @@ -129,7 +132,7 @@       poke dst t       poke (plusPtr dst 1) u -      return (PS dfp 0 (n + 2))+      return (PS dfp 0 (2 + minusPtr dst dptr))      | plusPtr src 2 == end = do -- 4 4       !a <- peek src@@ -145,7 +148,7 @@       poke (plusPtr dst 2) v       poke (plusPtr dst 3) w -      return (PS dfp 0 (n + 4))+      return (PS dfp 0 (4 + minusPtr dst dptr))      | plusPtr src 3 == end = do -- 5 3       !a <- peek src@@ -163,9 +166,9 @@       poke (plusPtr dst 2) v       poke (plusPtr dst 3) w       poke (plusPtr dst 4) x-      return (PS dfp 0 (n + 5))+      return (PS dfp 0 (5 + minusPtr dst dptr)) -    | plusPtr src 4 == end = do -- 7 1+    | otherwise = do -- 7 1       !a <- peek src       !b <- peek (plusPtr src 1)       !c <- peek (plusPtr src 2)@@ -186,96 +189,7 @@       poke (plusPtr dst 4) x       poke (plusPtr dst 5) y       poke (plusPtr dst 6) z-      return (PS dfp 0 (n + 7))--    | otherwise = return (PS dfp 0 n)+      return (PS dfp 0 (7 + minusPtr dst dptr))   where     look !i = aix i lut {-# INLINE loopTailNoPad #-}---- ------------------------------------------------------------------------ ----- Decoding loops--decodeTail-    :: Addr#-    -> ForeignPtr Word8-    -> Ptr Word8-    -> Ptr Word8-    -> Ptr Word8-    -> Int-    -> IO (Either Text ByteString)-decodeTail !lut !dfp !end !dptr !sptr !n = go dptr sptr-  where-    lix a = aix a lut-    {-# INLINE lix #-}--    ps !m = return (Right (PS dfp 0 m))-    {-# INLINE ps #-}--    err = return . Left . T.pack-    {-# INLINE err #-}--    decodeOctet (!a,!b,!c,!d,!e,!f,!g,!h) =-      case (lix a, lix b, lix c, lix d, lix e, lix f, lix g, lix h) of-        (0xff,_,_,_,_,_,_,_) -> Left (0 :: Int)-        (_,0xff,_,_,_,_,_,_) -> Left 1-        (_,_,0xff,_,_,_,_,_) -> Left 2-        (_,_,_,0xff,_,_,_,_) -> Left 3-        (_,_,_,_,0xff,_,_,_) -> Left 4-        (_,_,_,_,_,0xff,_,_) -> Left 5-        (_,_,_,_,_,_,0xff,_) -> Left 6-        (_,_,_,_,_,_,_,0xff) -> Left 7-        (ri1,ri2,ri3,ri4,ri5,ri6,ri7,ri8) ->-            let !o1 = (ri1 `unsafeShiftL` 3) .|. (ri2 `unsafeShiftR` 2)-                !o2 = (ri2 `unsafeShiftL` 6) .|. (ri3 `unsafeShiftL` 1) .|. (ri4 `unsafeShiftR` 4)-                !o3 = (ri4 `unsafeShiftL` 4) .|. (ri5 `unsafeShiftR` 1)-                !o4 = (ri5 `unsafeShiftL` 7) .|. (ri6 `unsafeShiftL` 2) .|. (ri7 `unsafeShiftR` 3)-                !o5 = (ri7 `unsafeShiftL` 5) .|. ri8-             in Right (o1, o2, o3, o4, o5)--    go !dst !src-      | src == end = ps n-      | otherwise = do-        !a <- peek @Word8 src-        !b <- peek @Word8 (plusPtr src 1)-        !c <- peek @Word8 (plusPtr src 2)-        !d <- peek @Word8 (plusPtr src 3)-        !e <- peek @Word8 (plusPtr src 4)-        !f <- peek @Word8 (plusPtr src 5)-        !g <- peek @Word8 (plusPtr src 6)-        !h <- peek @Word8 (plusPtr src 7)--        let (!m, !c', !d', !e', !f', !g', !h') = case (c,d,e,f,g,h) of-              (0x3d,0x3d,0x3d,0x3d,0x3d,0x3d) -> (6,0x41,0x41,0x41,0x41,0x41,0x41)-              (_,0x3d,0x3d,0x3d,0x3d,0x3d) -> (5,c,0x41,0x41,0x41,0x41,0x41)-              (_,_,0x3d,0x3d,0x3d,0x3d) -> (4,c,d,0x41,0x41,0x41,0x41)-              (_,_,_,0x3d,0x3d,0x3d) -> (3,c,d,e,0x41,0x41,0x41)-              (_,_,_,_,0x3d,0x3d) -> (2,c,d,e,f,0x41,0x41)-              (_,_,_,_,_,0x3d) -> (1,c,d,e,f,g,0x41)-              _ -> (0 :: Int,c,d,e,f,g,h)--        case decodeOctet (a,b,c',d',e',f',g',h') of-          Left ofs -> err $ "invalid character at offset: " ++ show (n + ofs)-          Right (!v,!w,!x,!y,!z) -> do-            poke dst v-            poke (plusPtr dst 1) w--            if-              | m == 0 -> do-                poke (plusPtr dst 2) x-                poke (plusPtr dst 3) y-                poke (plusPtr dst 4) z-                ps (n + 5)-              | m == 1 -> do-                poke (plusPtr dst 2) x-                poke (plusPtr dst 3) y-                poke (plusPtr dst 4) z-                ps (n + 4)-              | m < 4 -> do-                poke (plusPtr dst 2) x-                poke (plusPtr dst 3) y-                ps (n + 3)-              | m < 5 -> do-                poke (plusPtr dst 2) x-                ps (n + 2)-              | otherwise -> ps (n + 1)

@@ -2,16 +2,26 @@ {-# LANGUAGE MagicHash #-} module Data.ByteString.Base32.Internal.Utils ( aix+, padCeilN+, peekWord32BE+, peekWord64BE+, reChunkN , w32 , w64 , w64_32 , writeNPlainForeignPtrBytes ) where ++import Data.Bits+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+ import Foreign.Ptr import Foreign.ForeignPtr import Foreign.Storable +import GHC.ByteOrder import GHC.Exts import GHC.ForeignPtr import GHC.Word@@ -37,6 +47,14 @@ w64 = fromIntegral {-# INLINE w64 #-} +padCeilN :: Int -> Int -> Int+padCeilN !n !x+    | r == 0 = x+    | otherwise = (x - r) + n+  where+    r = x .&. (n - 1)+{-# INLINE padCeilN #-}+ -- | Allocate and fill @n@ bytes with some data -- writeNPlainForeignPtrBytes@@ -54,3 +72,38 @@     go !_ [] = return ()     go !p (x:xs) = poke p x >> go (plusPtr p 1) xs {-# INLINE writeNPlainForeignPtrBytes #-}++peekWord32BE :: Ptr Word32 -> IO Word32+peekWord32BE p = case targetByteOrder of+  LittleEndian -> byteSwap32 <$> peek p+  BigEndian    -> peek p+{-# inline peekWord32BE #-}++peekWord64BE :: Ptr Word64 -> IO Word64+peekWord64BE p = case targetByteOrder of+  LittleEndian -> byteSwap64 <$> peek p+  BigEndian    -> peek p+{-# inline peekWord64BE #-}++-- | Rechunk a list of bytestrings in multiples of @n@+--+reChunkN :: Int -> [ByteString] -> [ByteString]+reChunkN n = go+  where+    go [] = []+    go (b:bs) = case divMod (BS.length b) n of+      (_, 0) -> b : go bs+      (d, _) -> case BS.splitAt (d * n) b of+        ~(h, t) -> h : accum t bs++    accum acc [] = [acc]+    accum acc (c:cs) =+      case BS.splitAt (n - BS.length acc) c of+        ~(h, t) ->+          let acc' = BS.append acc h+          in if BS.length acc' == n+             then+               let cs' = if BS.null t then cs else t : cs+               in acc' : go cs'+             else accum acc' cs+{-# INLINE reChunkN #-}

@@ -0,0 +1,244 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-}+-- |+-- Module       : Data.ByteString.Lazy.Base32+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains 'Data.ByteString.Lazy.ByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base32+-- encoding format. This includes strictly padded/unpadded+-- decoding variants, as well as internal and external validation for canonicity.+--+module Data.ByteString.Lazy.Base32+( -- * Encoding+  encodeBase32+, encodeBase32'+, encodeBase32Unpadded+, encodeBase32Unpadded'+  -- * Decoding+, decodeBase32+, decodeBase32Unpadded+, decodeBase32Padded+--, decodeBase32Lenient+  -- * Validation+, isBase32+, isValidBase32+) where+++import Prelude hiding (all, elem)++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.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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "KN2W4==="+--+encodeBase32 :: ByteString -> TL.Text+encodeBase32 = TL.decodeUtf8 . encodeBase32'+{-# INLINE encodeBase32 #-}++-- | Encode a 'ByteString' as a Base32 'ByteString' value with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "KN2W4==="+--+encodeBase32' :: ByteString -> ByteString+encodeBase32' = fromChunks+  . fmap 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32 "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32 :: ByteString -> Either T.Text ByteString+decodeBase32 = fmap (fromChunks . (:[]))+  . B32.decodeBase32+  . BS.concat+  . toChunks+{-# INLINE decodeBase32 #-}++-- | Encode a 'ByteString' 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded "Sun"+-- "KN2W4"+--+encodeBase32Unpadded :: ByteString -> TL.Text+encodeBase32Unpadded = TL.decodeUtf8 . encodeBase32Unpadded'+{-# INLINE encodeBase32Unpadded #-}++-- | Encode a 'ByteString' value as Base32 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded' "Sun"+-- "KN2W4"+--+encodeBase32Unpadded' :: ByteString -> ByteString+encodeBase32Unpadded' = fromChunks+  . fmap B32.encodeBase32Unpadded'+  . reChunkN 5+  . toChunks++-- | Decode an unpadded Base32-encoded 'ByteString' 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'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32Unpadded :: ByteString -> Either T.Text ByteString+decodeBase32Unpadded = fmap (fromChunks . (:[]))+  . B32.decodeBase32Unpadded+  . BS.concat+  . toChunks+{-# INLINE decodeBase32Unpadded #-}++-- | 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'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: ByteString -> Either T.Text ByteString+decodeBase32Padded = fmap (fromChunks . (:[]))+  . B32.decodeBase32Padded+  . BS.concat+  . toChunks+{-# INLINE decodeBase32Padded #-}++-- -- | 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 #-}++-- | Tell whether a 'ByteString' is Base32-encoded.+--+-- === __Examples__:+--+-- >>> isBase32 "KN2W4"+-- True+--+-- >>> isBase32 "KN2W4==="+-- True+--+-- >>> isBase32 "KN2W4=="+-- False+--+isBase32 :: ByteString -> Bool+isBase32 bs = isValidBase32 bs && isRight (decodeBase32 bs)+{-# INLINE isBase32 #-}++-- | Tell whether a 'ByteString' is a valid Base32 format.+--+-- 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'.+--+-- === __Examples__:+--+-- >>> isValidBase32 "KN2W4"+-- True+--+-- >>> isValidBase32 "KN2W4="+-- False+--+-- >>> isValidBase32 "KN2W4%"+-- False+--+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 #-}

@@ -0,0 +1,245 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-}+-- |+-- Module       : Data.ByteString.Lazy.Base32.Hex+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains 'Data.ByteString.Lazy.ByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base32hex+-- encoding format. This includes strictly padded/unpadded+-- decoding variants, as well as internal and external validation for canonicity.+--+module Data.ByteString.Lazy.Base32.Hex+( -- * Encoding+  encodeBase32+, encodeBase32'+, encodeBase32Unpadded+, encodeBase32Unpadded'+  -- * Decoding+, decodeBase32+, decodeBase32Unpadded+, decodeBase32Padded+--, decodeBase32Lenient+  -- * Validation+, isBase32Hex+, isValidBase32Hex+) where+++import Prelude hiding (all, elem)++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.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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "ADQMS==="+--+encodeBase32 :: ByteString -> TL.Text+encodeBase32 = TL.decodeUtf8 . encodeBase32'+{-# INLINE encodeBase32 #-}++-- | Encode a 'ByteString' as a Base32hex 'ByteString' value with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32' "Sun"+-- "ADQMS==="+--+encodeBase32' :: ByteString -> ByteString+encodeBase32' = fromChunks+    . fmap 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32 "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32 "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32 "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32 :: ByteString -> Either T.Text ByteString+decodeBase32 = fmap (fromChunks . (:[]))+    . B32H.decodeBase32+    . BS.concat+    . toChunks+{-# INLINE decodeBase32 #-}++-- | Encode a 'ByteString' 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded "Sun"+-- "ADQMS"+--+encodeBase32Unpadded :: ByteString -> TL.Text+encodeBase32Unpadded = TL.decodeUtf8 . encodeBase32Unpadded'+{-# INLINE encodeBase32Unpadded #-}++-- | Encode a 'ByteString' 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded' "Sun"+-- "ADQMS"+--+encodeBase32Unpadded' :: ByteString -> ByteString+encodeBase32Unpadded' = fromChunks+    . fmap B32H.encodeBase32Unpadded'+    . reChunkN 5+    . toChunks++-- | Decode an unpadded Base32hex-encoded 'ByteString' 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'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32Unpadded :: ByteString -> Either T.Text ByteString+decodeBase32Unpadded = fmap (fromChunks . (:[]))+    . B32H.decodeBase32Unpadded+    . BS.concat+    . toChunks+{-# INLINE decodeBase32Unpadded #-}++-- | 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'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: ByteString -> Either T.Text ByteString+decodeBase32Padded = fmap (fromChunks . (:[]))+    . B32H.decodeBase32Padded+    . BS.concat+    . toChunks+{-# INLINE decodeBase32Padded #-}++-- -- | 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 #-}++-- | Tell whether a 'ByteString' is Base32hex-encoded.+--+-- === __Examples__:+--+-- >>> isBase32Hex "ADQMS"+-- True+--+-- >>> isBase32Hex "ADQMS==="+-- True+--+-- >>> isBase32Hex "ADQMS=="+-- False+--+isBase32Hex :: ByteString -> Bool+isBase32Hex bs = isValidBase32Hex bs && isRight (decodeBase32 bs)+{-# INLINE isBase32Hex #-}++-- | Tell whether a 'ByteString' is a valid Base32hex format.+--+-- 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'.+--+-- === __Examples__:+--+--+-- >>> isValidBase32Hex "ADQMS"+-- True+--+-- >>> isValidBase32Hex "ADQMS="+-- False+--+-- >>> isValidBase32Hex "ADQMS%"+-- False+--+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 #-}

@@ -0,0 +1,212 @@+{-# LANGUAGE Trustworthy #-}+-- |+-- Module       : Data.ByteString.Short.Base32+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains 'Data.ByteString.Short.ShortByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base32+-- encoding format. This includes strictly padded/unpadded decoding+-- variants, as well as internal and external validation for canonicity.+--+module Data.ByteString.Short.Base32+( -- * Encoding+  encodeBase32+, encodeBase32'+, encodeBase32Unpadded+, encodeBase32Unpadded'+  -- * Decoding+, decodeBase32+, decodeBase32Unpadded+, decodeBase32Padded+--, decodeBase32Lenient+  -- * Validation+, isBase32+, isValidBase32+) where+++import qualified Data.ByteString.Base32 as B32+import Data.ByteString.Short (ShortByteString, fromShort, toShort)+import Data.Text (Text)+import Data.Text.Short (ShortText)+import Data.Text.Short.Unsafe (fromShortByteStringUnsafe)+++-- | Encode a 'ShortByteString' value as a Base32 'Text' value with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "KN2W4==="+--+encodeBase32 :: ShortByteString -> ShortText+encodeBase32 = fromShortByteStringUnsafe . encodeBase32'+{-# INLINE encodeBase32 #-}++-- | Encode a 'ShortByteString' as a Base32 'ShortByteString' value with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32' "Sun"+-- "KN2W4==="+--+encodeBase32' :: ShortByteString -> ShortByteString+encodeBase32' = toShort . B32.encodeBase32' . fromShort++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32 "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32 :: ShortByteString -> Either Text ShortByteString+decodeBase32 = fmap toShort . B32.decodeBase32 . fromShort++{-# INLINE decodeBase32 #-}++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded "Sun"+-- "KN2W4"+--+encodeBase32Unpadded :: ShortByteString -> ShortText+encodeBase32Unpadded = fromShortByteStringUnsafe . encodeBase32Unpadded'+{-# INLINE encodeBase32Unpadded #-}++-- | Encode a 'ShortByteString' value as Base32 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded' "Sun"+-- "KN2W4"+--+encodeBase32Unpadded' :: ShortByteString -> ShortByteString+encodeBase32Unpadded' = toShort . B32.encodeBase32Unpadded' . fromShort++-- | 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'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32Unpadded :: ShortByteString -> Either Text ShortByteString+decodeBase32Unpadded = fmap toShort . B32.decodeBase32Unpadded . fromShort+{-# INLINE decodeBase32Unpadded #-}++-- | 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'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: ShortByteString -> Either Text ShortByteString+decodeBase32Padded = fmap toShort . B32.decodeBase32Padded . fromShort+{-# INLINE decodeBase32Padded #-}++-- -- | 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 #-}++-- | Tell whether a 'ShortByteString' is Base32-encoded.+--+-- === __Examples__:+--+-- >>> isBase32 "KN2W4"+-- True+--+-- >>> isBase32 "KN2W4==="+-- True+--+-- >>> isBase32 "KN2W4=="+-- False+--+isBase32 :: ShortByteString -> Bool+isBase32 = B32.isBase32 . fromShort+{-# INLINE isBase32 #-}++-- | Tell whether a 'ShortByteString' is a valid Base32 format.+--+-- 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'.+--+-- === __Examples__:+--+-- >>> isValidBase32 "KN2W4"+-- True+--+-- >>> isValidBase32 "KN2W4="+-- False+--+-- >>> isValidBase32 "KN2W4%"+-- False+--+isValidBase32 :: ShortByteString -> Bool+isValidBase32 = B32.isValidBase32 . fromShort+{-# INLINE isValidBase32 #-}

@@ -0,0 +1,210 @@+{-# LANGUAGE Trustworthy #-}+-- |+-- Module       : Data.ByteString.Short.Base32.Hex+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains 'Data.ByteString.Short.ShortByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base32hex+-- encoding format. This includes strictly padded/unpadded and decoding+-- variants, as well as internal and external validation for canonicity.+--+module Data.ByteString.Short.Base32.Hex+( -- * Encoding+  encodeBase32+, encodeBase32'+, encodeBase32Unpadded+, encodeBase32Unpadded'+  -- * Decoding+, decodeBase32+, decodeBase32Unpadded+, decodeBase32Padded+--, decodeBase32Lenient+  -- * Validation+, isBase32Hex+, isValidBase32Hex+) where+++import qualified Data.ByteString.Base32.Hex as B32H+import Data.ByteString.Short (ShortByteString, fromShort, toShort)+import Data.Text (Text)+import Data.Text.Short (ShortText)+import Data.Text.Short.Unsafe (fromShortByteStringUnsafe)++-- | Encode a 'ShortByteString' value as a Base32hex 'Text' value with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "ADQMS==="+--+encodeBase32 :: ShortByteString -> ShortText+encodeBase32 = fromShortByteStringUnsafe . encodeBase32'+{-# INLINE encodeBase32 #-}++-- | Encode a 'ShortByteString' as a Base32hex 'ShortByteString' value with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32' "Sun"+-- "ADQMS==="+--+encodeBase32' :: ShortByteString -> ShortByteString+encodeBase32' = toShort . B32H.encodeBase32' . fromShort++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32 "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32 "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32 "ADQM==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32 :: ShortByteString -> Either Text ShortByteString+decodeBase32 = fmap toShort . B32H.decodeBase32 . fromShort+{-# INLINE decodeBase32 #-}++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded' "Sun"+-- "ADQMS"+--+encodeBase32Unpadded :: ShortByteString -> ShortText+encodeBase32Unpadded = fromShortByteStringUnsafe . encodeBase32Unpadded'+{-# INLINE encodeBase32Unpadded #-}++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded' "Sun"+-- "ADQMS"+--+encodeBase32Unpadded' :: ShortByteString -> ShortByteString+encodeBase32Unpadded' = toShort . B32H.encodeBase32Unpadded' . fromShort++-- | 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'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32Unpadded :: ShortByteString -> Either Text ShortByteString+decodeBase32Unpadded = fmap toShort . B32H.decodeBase32Unpadded . fromShort+{-# INLINE decodeBase32Unpadded #-}++-- | 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'.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: ShortByteString -> Either Text ShortByteString+decodeBase32Padded = fmap toShort . B32H.decodeBase32Padded . fromShort+{-# INLINE decodeBase32Padded #-}++-- -- | 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 #-}++-- | Tell whether a 'ShortByteString' is Base32hex-encoded.+--+-- === __Examples__:+--+-- >>> isBase32Hex "ADQMS"+-- True+--+-- >>> isBase32Hex "ADQMS==="+-- True+--+-- >>> isBase32Hex "ADQMS=="+-- False+--+isBase32Hex :: ShortByteString -> Bool+isBase32Hex = B32H.isBase32Hex . fromShort+{-# INLINE isBase32Hex #-}++-- | Tell whether a 'ShortByteString' is a valid Base32hex format.+--+-- 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'.+--+-- === __Examples__:+--+-- >>> isValidBase32Hex "ADQMS"+-- True+--+-- >>> isValidBase32Hex "ADQMS="+-- False+--+-- >>> isValidBase32Hex "ADQMS%"+-- False+--+isValidBase32Hex :: ShortByteString -> Bool+isValidBase32Hex = B32H.isValidBase32Hex . fromShort+{-# INLINE isValidBase32Hex #-}

@@ -1,69 +1,217 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base32--- Copyright 	: (c) 2019 Emily Pillmore--- License	: BSD-style+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style ----- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>--- Stability	: Experimental--- Portability	: portable+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable ----- This module contains the combinators implementing the--- RFC 4648 specification for the Base32 encoding including--- unpadded and lenient variants+-- This module contains 'Data.Text.Text'-valued combinators for+-- implementing the RFC 4648 specification of the Base32+-- encoding format. This includes strictly padded/unpadded decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.Text.Encoding.Base32 ( encodeBase32 , decodeBase32+, decodeBase32With , encodeBase32Unpadded , decodeBase32Unpadded+, decodeBase32UnpaddedWith+, decodeBase32Padded+, decodeBase32PaddedWith -- , decodeBase32Lenient , isBase32 , isValidBase32 ) where  +import Data.Bifunctor (first)+import Data.ByteString (ByteString) import qualified Data.ByteString.Base32 as B32  import Data.Text (Text) import qualified Data.Text.Encoding as T+import Data.Text.Encoding.Base32.Error (Base32Error(..))  -- | Encode a 'Text' value in Base32 with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "KN2W4==="+-- encodeBase32 :: Text -> Text encodeBase32 = B32.encodeBase32 . T.encodeUtf8 {-# INLINE encodeBase32 #-} --- | Decode a padded Base32-encoded 'Text' value+-- | 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. --+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. 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.+-- -- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --+-- === __Examples__:+--+-- >>> decodeBase32 "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W==="+-- Left "Base32-encoded bytestring has invalid padding"+-- decodeBase32 :: Text -> Either Text Text-decodeBase32 = fmap T.decodeUtf8 . B32.decodeBase32 . T.encodeUtf8+decodeBase32 = fmap T.decodeLatin1+    . B32.decodeBase32+    . T.encodeUtf8 {-# INLINE decodeBase32 #-} +-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Example__:+--+-- @+-- 'decodeBase32With' 'T.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'+-- @+--+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+    Left de -> Left $ DecodeError de+    Right a -> first ConversionError (f a)+{-# INLINE decodeBase32With #-}+ -- | Encode a 'Text' value in Base32 without padding. ----- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>,---      <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --+-- === __Examples__:+--+-- >>> encodeBase32Unpadded "Sun"+-- "KN2W4"+-- encodeBase32Unpadded :: Text -> Text encodeBase32Unpadded = B32.encodeBase32Unpadded . T.encodeUtf8 {-# INLINE encodeBase32Unpadded #-} --- | Decode an arbitrarily padded Base32-encoded 'Text'+-- | Decode an unpadded Base32 encoded 'Text' value. ----- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>,---      <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. 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. --+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+-- decodeBase32Unpadded :: Text -> Either Text Text-decodeBase32Unpadded = fmap T.decodeUtf8+decodeBase32Unpadded = fmap T.decodeLatin1     . B32.decodeBase32Unpadded     . T.encodeUtf8 {-# INLINE decodeBase32Unpadded #-} +-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Example__:+--+-- @+-- 'decodeBase32UnpaddedWith' 'T.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'+-- @+--+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+    Left de -> Left $ DecodeError de+    Right a -> first ConversionError (f a)+{-# INLINE decodeBase32UnpaddedWith #-}+++-- | Decode an padded Base32 encoded 'Text' value+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: Text -> Either Text Text+decodeBase32Padded = fmap T.decodeLatin1+    . B32.decodeBase32Padded+    . T.encodeUtf8+{-# INLINE decodeBase32Padded #-}++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Example__:+--+-- @+-- 'decodeBase32PaddedWith' 'T.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'+-- @+--+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+    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.@@ -76,8 +224,19 @@ --     . T.encodeUtf8 -- {-# INLINE decodeBase32Lenient #-} --- | Tell whether a 'Text' value is Base32-encoded.+-- | Tell whether a 'Text' value is Base32-encoded --+-- === __Examples__:+--+-- >>> isBase32 "KN2W4"+-- True+--+-- >>> isBase32 "KN2W4==="+-- True+--+-- >>> isBase32 "KN2W4=="+-- False+-- isBase32 :: Text -> Bool isBase32 = B32.isBase32 . T.encodeUtf8 {-# INLINE isBase32 #-}@@ -87,6 +246,17 @@ -- 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'.+--+-- === __Examples__:+--+-- >>> isValidBase32 "KN2W4"+-- True+--+-- >>> isValidBase32 "KN2W4="+-- False+--+-- >>> isValidBase32 "KN2W4%"+-- False -- isValidBase32 :: Text -> Bool isValidBase32 = B32.isValidBase32 . T.encodeUtf8

@@ -0,0 +1,56 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE Safe #-}+-- |+-- Module       : Data.Text.Encoding.Base32.Error+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains the error types raised (not as exceptions!)+-- in the decoding process.+--+module Data.Text.Encoding.Base32.Error+( Base32Error(..)+) where+++import Control.DeepSeq (NFData(..))+import Control.Exception (Exception(..))++import Data.Text (Text)++import GHC.Generics++-- | This data type represents the type of decoding errors of+-- various kinds as they pertain to decoding 'Text' values.+-- Namely, to distinguish between decoding errors from opaque+-- unicode exceptions caught in the unicode decoding process.+--+data Base32Error e+  = DecodeError Text+    -- ^ The error associated with decoding failure+    -- as a result of the Base32 decoding process+  | ConversionError e+    -- ^ The error associated with the decoding failure+    -- as a result of the conversion process+  deriving+    ( Eq, Show+    , Generic+      -- ^ @since 0.2.0.0+    )++-- |+--+-- @since 0.2.0.0+--+instance Exception e => Exception (Base32Error e)+++-- |+--+-- @since 0.2.0.0+--+instance NFData e => NFData (Base32Error e)

@@ -1,68 +1,220 @@-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base32.Hex--- Copyright 	: (c) 2019 Emily Pillmore--- License	: BSD-style+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style ----- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>--- Stability	: Experimental--- Portability	: portable+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable ----- This module contains the combinators implementing the--- RFC 4648 specification for the Base32-Hex encoding including--- unpadded and lenient variants+-- This module contains 'Data.Text.Text'-valued combinators for+-- implementing the RFC 4648 specification of the Base32hex+-- encoding format. This includes strictly padded and unpadded+-- decoding variants, as well as internal and external validation+-- for canonicity.+-- module Data.Text.Encoding.Base32.Hex ( encodeBase32 , decodeBase32+, decodeBase32With , encodeBase32Unpadded , decodeBase32Unpadded+, decodeBase32UnpaddedWith+, decodeBase32Padded+, decodeBase32PaddedWith -- , decodeBase32Lenient , isBase32Hex , isValidBase32Hex ) where  -import qualified Data.ByteString.Base32.Hex as B32U+import Data.Bifunctor (first)+import Data.ByteString (ByteString)+import qualified Data.ByteString.Base32.Hex as B32H  import Data.Text (Text) import qualified Data.Text.Encoding as T+import Data.Text.Encoding.Base32.Error (Base32Error(..))  -- | Encode a 'Text' value in Base32hex with padding. ----- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "ADQMS==="+-- encodeBase32 :: Text -> Text-encodeBase32 = B32U.encodeBase32 . T.encodeUtf8+encodeBase32 = B32H.encodeBase32 . T.encodeUtf8 {-# INLINE encodeBase32 #-} --- | Decode a padded Base32hex-encoded 'Text' value.+-- | 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. ----- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. 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. --+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32 "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32 "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32 "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+-- decodeBase32 :: Text -> Either Text Text-decodeBase32 = fmap T.decodeUtf8 . B32U.decodeBase32 . T.encodeUtf8+decodeBase32 = fmap T.decodeLatin1 . B32H.decodeBase32 . T.encodeUtf8 {-# INLINE decodeBase32 #-} --- | Encode a 'Text' value in Base32hex without padding.+-- | Attempt to decode a 'ByteString' value as Base32hex, converting from+-- 'ByteString' to 'Text' according to some encoding function. In practice,+-- This is something like 'T.decodeUtf8'', which may produce an error. ----- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>,---      <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6> --+-- === __Examples__:+--+-- @+-- 'decodeBase32With' 'T.decodeUtf8''+--   :: 'Text' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'+-- @+--+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+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase32With #-}++-- | Encode a 'Text' value in 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded "Sun"+-- "ADQMS"+-- encodeBase32Unpadded :: Text -> Text-encodeBase32Unpadded = B32U.encodeBase32Unpadded . T.encodeUtf8+encodeBase32Unpadded = B32H.encodeBase32Unpadded . T.encodeUtf8 {-# INLINE encodeBase32Unpadded #-} --- | Decode an arbitrarily padded Base32hex encoded 'Text' value++-- | Decode an unpadded Base32hex encoded 'Text' value. ----- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>,---      <https://tools.ietf.org/html/rfc4648#section-3.2 RFC-4648 section 3.2>+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. 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. --+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+-- decodeBase32Unpadded :: Text -> Either Text Text-decodeBase32Unpadded = fmap T.decodeUtf8-    . B32U.decodeBase32Unpadded+decodeBase32Unpadded = fmap T.decodeLatin1+    . B32H.decodeBase32Unpadded     . T.encodeUtf8 {-# INLINE decodeBase32Unpadded #-} ++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Example__:+--+-- @+-- 'decodeBase32UnpaddedWith' 'T.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'+-- @+--+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+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase32UnpaddedWith #-}+++-- | Decode an padded Base32hex encoded 'Text' value+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: Text -> Either Text Text+decodeBase32Padded = fmap T.decodeLatin1+    . B32H.decodeBase32Padded+    . T.encodeUtf8+{-# INLINE decodeBase32Padded #-}++-- | Attempt to decode a padded 'ByteString' value as Base32hex, converting from+-- 'ByteString' to 'Text' according to some encoding function. In practice,+-- 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+    :: (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+  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.@@ -71,14 +223,25 @@ -- -- -- -- -- decodeBase32Lenient :: Text -> Text -- -- decodeBase32Lenient = T.decodeUtf8--- --     . B32U.decodeBase32Lenient+-- --     . B32H.decodeBase32Lenient -- --     . T.encodeUtf8 -- -- {-# INLINE decodeBase32Lenient #-}  -- | Tell whether a 'Text' value is Base32hex-encoded. --+-- === __Examples__:+--+-- >>> isBase32Hex "ADQMS"+-- True+--+-- >>> isBase32Hex "ADQMS==="+-- True+--+-- >>> isBase32Hex "ADQMS=="+-- False+-- isBase32Hex :: Text -> Bool-isBase32Hex = B32U.isBase32Hex . T.encodeUtf8+isBase32Hex = B32H.isBase32Hex . T.encodeUtf8 {-# INLINE isBase32Hex #-}  -- | Tell whether a 'Text' value is a valid Base32hex format.@@ -87,6 +250,17 @@ -- only that it conforms to the correct shape. To check whether it is a true -- Base32 encoded 'Text' value, use 'isBase32Hex'. --+-- === __Examples__:+--+-- >>> isValidBase32Hex "ADQMS"+-- True+--+-- >>> isValidBase32Hex "ADQMS="+-- False+--+-- >>> isValidBase32Hex "ADQMS%"+-- False+-- isValidBase32Hex :: Text -> Bool-isValidBase32Hex = B32U.isValidBase32Hex . T.encodeUtf8+isValidBase32Hex = B32H.isValidBase32Hex . T.encodeUtf8 {-# INLINE isValidBase32Hex #-}

@@ -0,0 +1,274 @@+{-# LANGUAGE Safe #-}+-- |+-- Module       : Data.Text.Lazy.Encoding.Base32+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains 'Data.Text.Lazy.Text'-valued combinators for+-- implementing the RFC 4648 specification of the Base32+-- encoding format. This includes strictly padded/unpadded decoding+-- variants, as well as internal and external validation for canonicity.+--+module Data.Text.Lazy.Encoding.Base32+( -- * Encoding+  encodeBase32+, encodeBase32Unpadded+  -- * Decoding+, decodeBase32+, decodeBase32With+, decodeBase32Unpadded+, decodeBase32UnpaddedWith+, decodeBase32Padded+, decodeBase32PaddedWith+--, decodeBase32Lenient+  -- * Validation+, isBase32+, isValidBase32+) where+++import Data.Bifunctor (first)+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy.Base32 as BL32++import qualified Data.Text as T+import Data.Text.Encoding.Base32.Error+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++-- | Encode a 'TL.Text' value in Base32 with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "KN2W4==="+--+encodeBase32 :: TL.Text -> 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.+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'TL.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32 "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32 :: TL.Text -> Either T.Text TL.Text+decodeBase32 = fmap TL.decodeLatin1 . BL32.decodeBase32 . TL.encodeUtf8+{-# INLINE decodeBase32 #-}++-- | Attempt to decode a lazy 'ByteString' value as Base32, converting from+-- 'ByteString' to 'TL.Text' according to some encoding function. In practice,+-- This is something like 'TL.decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- @+-- 'decodeBase32With' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'TL.Text'+-- @+--+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+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase32With #-}++-- | Encode a 'TL.Text' value in Base32 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded "Sun"+-- "KN2W4"+--+encodeBase32Unpadded :: TL.Text -> 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.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32Unpadded :: TL.Text -> Either T.Text TL.Text+decodeBase32Unpadded = fmap TL.decodeLatin1+    . BL32.decodeBase32Unpadded+    . TL.encodeUtf8+{-# INLINE decodeBase32Unpadded #-}++-- | Attempt to decode an unpadded lazy 'ByteString' value as Base32, converting from+-- 'ByteString' to 'TL.Text' according to some encoding function. In practice,+-- This is something like 'TL.decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- @+-- 'decodeBase32UnpaddedWith' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'TL.Text'+-- @+--+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+  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.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: TL.Text -> Either T.Text TL.Text+decodeBase32Padded = fmap TL.decodeLatin1+    . BL32.decodeBase32Padded+    . TL.encodeUtf8+{-# INLINE decodeBase32Padded #-}++-- | Attempt to decode a padded lazy 'ByteString' value as Base32, converting from+-- 'ByteString' to 'TL.Text' according to some encoding function. In practice,+-- This is something like 'TL.decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-6 RFC-4648 section 6>+--+-- === __Example__:+--+-- @+-- 'decodeBase32PaddedWith' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'+-- @+--+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+  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.decodeLatin1+--     . BL32.decodeBase32Lenient+--     . TL.encodeUtf8+-- {-# INLINE decodeBase32Lenient #-}++-- | Tell whether a 'TL.Text' value is Base32-encoded+--+-- === __Examples__:+--+-- >>> isBase32 "KN2W4"+-- True+--+-- >>> isBase32 "KN2W4==="+-- True+--+-- >>> isBase32 "KN2W4=="+-- False+--+isBase32 :: TL.Text -> Bool+isBase32 = BL32.isBase32 . TL.encodeUtf8+{-# INLINE isBase32 #-}++-- | Tell whether a 'TL.Text' value is a valid Base32 format.+--+-- 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'.+--+-- === __Examples__:+--+-- >>> isValidBase32 "KN2W4"+-- True+--+-- >>> isValidBase32 "KN2W4="+-- False+--+-- >>> isValidBase32 "KN2W4%"+-- False+--+isValidBase32 :: TL.Text -> Bool+isValidBase32 = BL32.isValidBase32 . TL.encodeUtf8+{-# INLINE isValidBase32 #-}

@@ -0,0 +1,274 @@+{-# LANGUAGE Safe #-}+-- |+-- Module       : Data.Text.Lazy.Encoding.Base32.Hex+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains 'Data.Text.Lazy.Text'-valued combinators for+-- implementing the RFC 4648 specification of the Base32hex+-- encoding format. This includes strictly padded/unpadded decoding+-- variants, as well as internal and external validation for canonicity.+--+module Data.Text.Lazy.Encoding.Base32.Hex+( -- * Encoding+  encodeBase32+, encodeBase32Unpadded+  -- * Decoding+, decodeBase32+, decodeBase32With+, decodeBase32Unpadded+, decodeBase32UnpaddedWith+, decodeBase32Padded+, decodeBase32PaddedWith+--, decodeBase32Lenient+  -- * Validation+, isBase32Hex+, isValidBase32Hex+) where+++import Data.Bifunctor (first)+import Data.ByteString.Lazy (ByteString)+import qualified Data.ByteString.Lazy.Base32.Hex as BL32H++import qualified Data.Text as T+import Data.Text.Encoding.Base32.Error+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL++-- | Encode a 'TL.Text' value in Base32hex with padding.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7  RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "ADQMS==="+--+encodeBase32 :: TL.Text -> 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.+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'TL.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32 "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32 "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32 "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32 :: TL.Text -> Either T.Text TL.Text+decodeBase32 = fmap TL.decodeLatin1 . BL32H.decodeBase32 . TL.encodeUtf8+{-# INLINE decodeBase32 #-}++-- | Attempt to decode a lazy 'ByteString' value as Base32hex, converting from+-- 'ByteString' to 'TL.Text' according to some encoding function. In practice,+-- This is something like 'TL.decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- @+-- 'decodeBase32With' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'TL.Text'+-- @+--+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+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase32With #-}++-- | Encode a 'TL.Text' value in 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded "Sun"+-- "ADQMS"+--+encodeBase32Unpadded :: TL.Text -> 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.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32Unpadded :: TL.Text -> Either T.Text TL.Text+decodeBase32Unpadded = fmap TL.decodeLatin1+    . BL32H.decodeBase32Unpadded+    . TL.encodeUtf8+{-# INLINE decodeBase32Unpadded #-}++-- | Attempt to decode an unpadded lazy 'ByteString' value as Base32hex, converting from+-- 'ByteString' to 'TL.Text' according to some encoding function. In practice,+-- This is something like 'TL.decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- @+-- 'decodeBase32UnpaddedWith' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'TL.Text'+-- @+--+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+  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.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: TL.Text -> Either T.Text TL.Text+decodeBase32Padded = fmap TL.decodeLatin1+    . BL32H.decodeBase32Padded+    . TL.encodeUtf8+{-# INLINE decodeBase32Padded #-}++-- | Attempt to decode a padded lazy 'ByteString' value as Base32hex, converting from+-- 'ByteString' to 'TL.Text' according to some encoding function. In practice,+-- This is something like 'TL.decodeUtf8'', which may produce an error.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Example__:+--+-- @+-- 'decodeBase32PaddedWith' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'Text'+-- @+--+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+  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.decodeLatin1+--     . BL32H.decodeBase32Lenient+--     . TL.encodeUtf8+-- {-# INLINE decodeBase32Lenient #-}++-- | Tell whether a 'TL.Text' value is Base32hex-encoded+--+-- === __Examples__:+--+-- >>> isBase32Hex "ADQMS"+-- True+--+-- >>> isBase32Hex "ADQMS==="+-- True+--+-- >>> isBase32Hex "ADQMS=="+-- False+--+isBase32Hex :: TL.Text -> Bool+isBase32Hex = BL32H.isBase32Hex . TL.encodeUtf8+{-# INLINE isBase32Hex #-}++-- | Tell whether a 'TL.Text' value is a valid Base32hex format.+--+-- 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'.+--+-- === __Examples__:+--+-- >>> isValidBase32Hex "ADQMS"+-- True+--+-- >>> isValidBase32Hex "ADQMS="+-- False+--+-- >>> isValidBase32Hex "ADQMS%"+-- False+--+isValidBase32Hex :: TL.Text -> Bool+isValidBase32Hex = BL32H.isValidBase32Hex . TL.encodeUtf8+{-# INLINE isValidBase32Hex #-}

@@ -0,0 +1,273 @@+{-# LANGUAGE Trustworthy #-}+-- |+-- Module       : Data.Text.Short.Encoding.Base32+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains 'Data.Text.Short.ShortText'-valued combinators+-- implementing the RFC 4648 specification for the Base32+-- encoding format. This includes strictly padded/unpadded decoding+-- variants, and external + internal validations for canonicity.+--+module Data.Text.Short.Encoding.Base32+( -- * Encoding+  encodeBase32+, encodeBase32Unpadded+  -- * Decoding+, decodeBase32+, decodeBase32With+, decodeBase32Unpadded+, decodeBase32UnpaddedWith+, decodeBase32Padded+, decodeBase32PaddedWith+--, decodeBase32Lenient+  -- * Validation+, isBase32+, isValidBase32+) where+++import Data.Bifunctor (first)+import qualified Data.ByteString.Base32 as B32+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short.Base32 as BS32+import Data.Text (Text)+import qualified Data.Text.Encoding.Base32 as B32T+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>+--+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "KN2W4==="+--+encodeBase32 :: ShortText -> ShortText+encodeBase32 = fromByteStringUnsafe+  . B32.encodeBase32'+  . toByteString+{-# 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.+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'Data.Text.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32 "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32 "KN2W==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32 :: ShortText -> Either Text ShortText+decodeBase32 = fmap fromText . B32T.decodeBase32 . toText+{-# INLINE decodeBase32 #-}++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+--+-- === __Examples__:+--+-- @+-- 'decodeBase32With' '(fmap fromText . T.decodeUtf8' . toText)'+--   :: 'ShortByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'ShortText'+-- @+--+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+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase32With #-}++-- | Encode a 'ShortText' value in Base32 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.+--+-- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded "Sun"+-- "KN2W4"+--+encodeBase32Unpadded :: ShortText -> ShortText+encodeBase32Unpadded = fromByteStringUnsafe+  . B32.encodeBase32Unpadded'+  . toByteString+{-# INLINE encodeBase32Unpadded #-}++-- | Decode an unpadded Base32 encoded 'ShortText' value.+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'T.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "KN2W4"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "KN2W4==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32Unpadded :: ShortText -> Either Text ShortText+decodeBase32Unpadded = fmap fromText . B32T.decodeBase32Unpadded . toText+{-# INLINE decodeBase32Unpadded #-}++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+--+-- === __Examples__:+--+-- @+-- 'decodeBase32UnpaddedWith' '(fmap fromText . T.decodeUtf8' . toText)'+--   :: 'ShortByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'ShortText'+-- @+--+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+  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.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "KN2W4==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "KN2W4"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: ShortText -> Either Text ShortText+decodeBase32Padded = fmap fromText . B32T.decodeBase32Padded . toText+{-# INLINE decodeBase32Padded #-}++-- | 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.+--+-- See: <https://tools.ietf.org/html/rfc4328#section-6 RFC-4328 section 6>+--+-- === __Examples__:+--+-- @+-- 'decodeBase32With' '(fmap fromText . T.decodeUtf8' . toText)'+--   :: 'ShortByteString' -> 'Either' ('Base32Error' 'UnicodeException') 'ShortText'+-- @+--+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+  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 #-}++-- | Tell whether a 'ShortText' value is Base32-encoded.+--+-- === __Examples__:+--+-- >>> isBase32 "KN2W4"+-- True+--+-- >>> isBase32 "KN2W4==="+-- True+--+-- >>> isBase32 "KN2W4=="+-- False+--+isBase32 :: ShortText -> Bool+isBase32 = B32.isBase32 . toByteString+{-# INLINE isBase32 #-}++-- | Tell whether a 'ShortText' value is a valid Base32 format.+--+-- 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'.+--+-- === __Examples__:+--+-- >>> isValidBase32 "KN2W4"+-- True+--+-- >>> isValidBase32 "KN2W4="+-- False+--+-- >>> isValidBase32 "KN2W4%"+-- False+--+isValidBase32 :: ShortText -> Bool+isValidBase32 = B32.isValidBase32 . toByteString+{-# INLINE isValidBase32 #-}

@@ -0,0 +1,273 @@+{-# LANGUAGE Trustworthy #-}+-- |+-- Module       : Data.Text.Short.Encoding.Base32.Hex+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : stable+-- Portability  : non-portable+--+-- This module contains 'Data.Text.Short.ShortText'-valued combinators+-- implementing the RFC 4648 specification for the Base32hex+-- encoding format. This includes strictly padded/unpadded+-- decoding variants, and external + internal validations for canonicity.+--+module Data.Text.Short.Encoding.Base32.Hex+( -- * Encoding+  encodeBase32+, encodeBase32Unpadded+  -- * Decoding+, decodeBase32+, decodeBase32With+, decodeBase32Unpadded+, decodeBase32UnpaddedWith+, decodeBase32Padded+, decodeBase32PaddedWith+--, decodeBase32Lenient+  -- * Validation+, isBase32Hex+, isValidBase32Hex+) where+++import Data.Bifunctor (first)+import qualified Data.ByteString.Base32.Hex as B32H+import Data.ByteString.Short (ShortByteString)+import qualified Data.ByteString.Short.Base32.Hex as BS32H+import Data.Text (Text)+import qualified Data.Text.Encoding.Base32.Hex as B32TH+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>+--+-- === __Examples__:+--+-- >>> encodeBase32 "Sun"+-- "ADQMS==="+--+encodeBase32 :: ShortText -> ShortText+encodeBase32 = fromByteStringUnsafe+  . B32H.encodeBase32'+  . toByteString+{-# 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.+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'Data.Text.Encoding.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32 "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32 "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32 "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32 :: ShortText -> Either Text ShortText+decodeBase32 = fmap fromText . B32TH.decodeBase32 . toText+{-# INLINE decodeBase32 #-}++-- | 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.+--+-- 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'+-- @+--+decodeBase32With+    :: (ShortByteString -> Either err ShortText)+      -- ^ 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+  Left de -> Left $ DecodeError de+  Right a -> first ConversionError (f a)+{-# INLINE decodeBase32With #-}++-- | Encode a 'ShortText' value in 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> encodeBase32Unpadded "Sun"+-- "ADQMS"+--+encodeBase32Unpadded :: ShortText -> ShortText+encodeBase32Unpadded = fromByteStringUnsafe+  . B32H.encodeBase32Unpadded'+  . toByteString+{-# INLINE encodeBase32Unpadded #-}++-- | Decode an unpadded Base32hex encoded 'ShortText' value.+--+-- /Note:/ This function makes sure that decoding is total by deferring to+-- 'Data.Text.Encoding.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32Unpadded "ADQMS"+-- Right "Sun"+--+-- >>> decodeBase32Unpadded "ADQMS==="+-- Left "Base32-encoded bytestring has invalid padding"+--+decodeBase32Unpadded :: ShortText -> Either Text ShortText+decodeBase32Unpadded = fmap fromText . B32TH.decodeBase32Unpadded . toText+{-# INLINE decodeBase32Unpadded #-}++-- | 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.+--+-- 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'+-- @+--+decodeBase32UnpaddedWith+    :: (ShortByteString -> Either err ShortText)+      -- ^ 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+  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.decodeLatin1'. 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.+--+-- See: <https://tools.ietf.org/html/rfc4648#section-7 RFC-4648 section 7>+--+-- === __Examples__:+--+-- >>> decodeBase32Padded "ADQMS==="+-- Right "Sun"+--+-- >>> decodeBase32Padded "ADQMS"+-- Left "Base32-encoded bytestring requires padding"+--+decodeBase32Padded :: ShortText -> Either Text ShortText+decodeBase32Padded = fmap fromText . B32TH.decodeBase32Padded . toText+{-# INLINE decodeBase32Padded #-}++-- | 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.+--+-- 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'+-- @+--+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+  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 #-}++-- | Tell whether a 'ShortText' value is Base32hex-encoded.+--+-- === __Examples__:+--+-- >>> isBase32Hex "ADQMS"+-- True+--+-- >>> isBase32Hex "ADQMS==="+-- True+--+-- >>> isBase32Hex "ADQMS=="+-- False+--+isBase32Hex :: ShortText -> Bool+isBase32Hex = B32H.isBase32Hex . toByteString+{-# INLINE isBase32Hex #-}++-- | Tell whether a 'ShortText' value is a valid Base32hex format.+--+-- 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'.+--+-- === __Examples__:+--+-- >>> isValidBase32Hex "ADQMS"+-- True+--+-- >>> isValidBase32Hex "ADQMS="+-- False+--+-- >>> isValidBase32Hex "ADQMS%"+-- False+--+isValidBase32Hex :: ShortText -> Bool+isValidBase32Hex = B32H.isValidBase32Hex . toByteString+{-# INLINE isValidBase32Hex #-}

@@ -1,148 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE TypeApplications #-}-module Main-( main-, tests-) where---import Data.Bifunctor-import Data.ByteString (ByteString)-import "base32" Data.ByteString.Base32 as B32-import "base32" Data.ByteString.Base32.Hex as B32H-import "memory" Data.ByteArray.Encoding as Mem-import Data.ByteString.Random (random)-import Data.Functor (void)-import Data.Text (pack)--import Test.Tasty-import Test.Tasty.HUnit---main :: IO ()-main = defaultMain tests---tests :: TestTree-tests = testGroup "Base32 Tests"-    [ testVectors-    , sanityTests-    , alphabetTests-    ]--testVectors :: TestTree-testVectors = testGroup "RFC 4648 Test Vectors"-    [ testGroup "encode/decode"-      [ testCaseB32 "" ""-      , testCaseB32 "f" "MY======"-      , testCaseB32 "fo" "MZXQ===="-      , testCaseB32 "foo" "MZXW6==="-      , testCaseB32 "foob" "MZXW6YQ="-      , testCaseB32 "fooba" "MZXW6YTB"-      , testCaseB32 "foobar" "MZXW6YTBOI======"-      ]-    , testGroup "encode/decode hex"-      [ testCaseB32' "" ""-      , testCaseB32' "f" "CO======"-      , testCaseB32' "fo" "CPNG===="-      , testCaseB32' "foo" "CPNMU==="-      , testCaseB32' "foob" "CPNMUOG="-      , testCaseB32' "fooba" "CPNMUOJ1"-      , testCaseB32' "foobar" "CPNMUOJ1E8======"-      ]-    ]-  where-    testCaseB32 s t =-      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do-        let t' = B32.encodeBase32' s-            s' = B32.decodeBase32 t'--        step "compare encoding + decoding w/ padding"-        t @=? t'--        step "compare decoding w/ padding"-        Right s @=? s'--    testCaseB32' s t =-      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do-        let t' = B32H.encodeBase32' s-            s' = B32H.decodeBase32 t'-            u = B32H.encodeBase32' s-            v = B32H.decodeBase32 u--        step "compare hex encoding w/ padding"-        t @=? t'--        step "compare hex decoding w/ padding"-        Right s @=? s'--        step "compare hex encoding w/o padding"-        t @=? t'--        step "compare hex decoding w/o padding"-        Right s @=? v--sanityTests :: TestTree-sanityTests = testGroup "Sanity tests"-    [ testGroup "very large bytestrings don't segfault"-        [ chonk-        ]-    , testGroup "`memory` sanity checks"-        [ compare32 3-        , compare32 4-        , compare32 5-        , compare32 6-        , compare32 1000-        , compare32 100000-        ]-    , testGroup "roundtrip encode/decode"-        [ roundtrip 3-        , roundtrip 4-        , roundtrip 5-        , roundtrip 1000-        , roundtrip 100000-        ]-    ]-  where-    chonk = testCase ("Encoding huge bytestrings doesn't result in OOM or segfault") $ do-      bs <- random 1000000-      void $ return $ B32.encodeBase32' bs-      void $ return $ B32H.encodeBase32' bs--    compare32 n = testCase ("Testing " ++ show n ++ "-sized bytestrings") $ do-      bs <- random n-      B32.encodeBase32' bs @=? Mem.convertToBase Mem.Base32 bs-      B32.decodeBase32 (B32.encodeBase32' bs) @=?-        first pack (Mem.convertFromBase @ByteString Mem.Base32 (Mem.convertToBase Mem.Base32 bs))--    roundtrip n = testCase ("Roundtrip encode/decode for " ++ show n ++ "-sized bytestrings") $ do-      bs <- random n-      B32.decodeBase32 (B32.encodeBase32' bs) @=? Right bs-      B32H.decodeBase32 (B32H.encodeBase32' bs) @=? Right bs--alphabetTests :: TestTree-alphabetTests = testGroup "Alphabet tests"-    [ base32Tests 0-    , base32Tests 4-    , base32Tests 5-    , base32Tests 6-    , base32Tests 100-    , base32HexTests 0-    , base32HexTests 4-    , base32HexTests 5-    , base32HexTests 6-    , base32HexTests 100-    ]-  where-    base32Tests n = testCase ("Conforms to Base32 alphabet: " ++ show n) $ do-      bs <- random n-      let b = B32.encodeBase32' bs-      assertBool ("failed validity: " ++ show b) $ B32.isValidBase32 b-      assertBool ("failed correctness: " ++ show b) $ B32.isBase32 b--    base32HexTests n = testCase ("Conforms to Base32hex alphabet: " ++ show n) $ do-      bs <- random n-      let b = B32H.encodeBase32' bs-      assertBool ("failed validity: " ++ show b) $ B32H.isValidBase32Hex b-      assertBool ("failed correctness: " ++ show b) $ B32H.isBase32Hex b

@@ -0,0 +1,308 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module       : Main+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains internal test harnesses for `base32`+--+module Internal where+++import qualified Data.ByteString as BS+import "base32" Data.ByteString.Base32 as B32+import "base32" Data.ByteString.Base32.Hex as B32H+import qualified Data.ByteString.Lazy as LBS+import "base32" Data.ByteString.Lazy.Base32 as BL32+import "base32" Data.ByteString.Lazy.Base32.Hex as BL32H+import qualified Data.ByteString.Short as SBS+import "base32" Data.ByteString.Short.Base32 as BS32+import "base32" Data.ByteString.Short.Base32.Hex as BS32H+import Data.Proxy+import Data.String+import Data.Text (Text)+import qualified Data.Text as T+import "base32" Data.Text.Encoding.Base32 as T32+import "base32" Data.Text.Encoding.Base32.Error (Base32Error)+import "base32" Data.Text.Encoding.Base32.Hex as T32H+import qualified Data.Text.Lazy as TL+import "base32" Data.Text.Lazy.Encoding.Base32 as TL32+import "base32" Data.Text.Lazy.Encoding.Base32.Hex as TL32H+import qualified Data.Text.Short as TS+import "base32" Data.Text.Short.Encoding.Base32 as TS32+import "base32" Data.Text.Short.Encoding.Base32.Hex as TS32H++import Test.QuickCheck hiding (label)++-- ------------------------------------------------------------------ --+-- Test Harnesses++data Impl+  = B32+  | BL32+  | BS32+  | T32+  | TL32+  | TS32++b32 :: Proxy 'B32+b32 = Proxy++bl32 :: Proxy 'BL32+bl32 = Proxy++bs32 :: Proxy 'BS32+bs32 = Proxy++t32 :: Proxy 'T32+t32 = Proxy++tl32 :: Proxy 'TL32+tl32 = Proxy++ts32 :: Proxy 'TS32+ts32 = Proxy++-- | This class provides the generic API definition for+-- the base32 std alphabet+--+class+  ( Eq bs+  , Show bs+  , Arbitrary bs+  , CoArbitrary bs+  , IsString bs+  ) => Harness (a :: Impl) bs | a -> bs, bs -> a+  where++  label :: String++  encode :: bs -> bs+  encodeNopad :: bs -> bs+  encodeHex :: bs -> bs+  encodeHexNopad :: 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++  correct :: bs -> Bool+  correctHex :: bs -> Bool++  validate :: bs -> Bool+  validateHex :: bs -> Bool+++instance Harness 'B32 BS.ByteString where+  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++instance Harness 'BL32 LBS.ByteString where+  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++instance Harness 'BS32 SBS.ShortByteString where+  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++instance Harness 'T32 T.Text where+  label = "Text"++  encode = T32.encodeBase32+  encodeNopad = T32.encodeBase32Unpadded+  decode = T32.decodeBase32+  decodeNopad = T32.decodeBase32Unpadded+  decodePad = T32.decodeBase32Padded+  correct = T32.isBase32++  encodeHex = T32H.encodeBase32+  encodeHexNopad = T32H.encodeBase32Unpadded+  decodeHex = T32H.decodeBase32+  decodeHexPad = T32H.decodeBase32Padded+  decodeHexNopad = T32H.decodeBase32Unpadded++  correctHex = T32H.isBase32Hex+  validateHex = T32H.isValidBase32Hex+  validate = T32.isValidBase32++instance Harness 'TL32 TL.Text where+  label = "Lazy Text"++  encode = TL32.encodeBase32+  encodeNopad = TL32.encodeBase32Unpadded+  decode = TL32.decodeBase32+  decodeNopad = TL32.decodeBase32Unpadded+  decodePad = TL32.decodeBase32Padded+  correct = TL32.isBase32++  encodeHex = TL32H.encodeBase32+  encodeHexNopad = TL32H.encodeBase32Unpadded+  decodeHex = TL32H.decodeBase32+  decodeHexPad = TL32H.decodeBase32Padded+  decodeHexNopad = TL32H.decodeBase32Unpadded++  correctHex = TL32H.isBase32Hex+  validateHex = TL32H.isValidBase32Hex+  validate = TL32.isValidBase32++instance Harness 'TS32 TS.ShortText where+  label = "Short Text"++  encode = TS32.encodeBase32+  encodeNopad = TS32.encodeBase32Unpadded+  decode = TS32.decodeBase32+  decodeNopad = TS32.decodeBase32Unpadded+  decodePad = TS32.decodeBase32Padded+  correct = TS32.isBase32++  encodeHex = TS32H.encodeBase32+  encodeHexNopad = TS32H.encodeBase32Unpadded+  decodeHex = TS32H.decodeBase32+  decodeHexPad = TS32H.decodeBase32Padded+  decodeHexNopad = TS32H.decodeBase32Unpadded++  correctHex = TS32H.isBase32Hex+  validateHex = TS32H.isValidBase32Hex+  validate = TS32.isValidBase32++class Harness a cs+  => TextHarness (a :: Impl) cs bs+  | a -> cs, bs -> cs, cs -> a, cs -> bs where+  decodeWith_ :: (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+  decodePaddedWith_ :: (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+  decodeUnpaddedWith_ :: (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+  decodeHexWith_ :: (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+  decodeHexPaddedWith_ :: (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+  decodeHexUnpaddedWith_ :: (bs -> Either err cs) -> bs -> Either (Base32Error err) cs+++instance TextHarness 'T32 Text BS.ByteString where+  decodeWith_ = T32.decodeBase32With+  decodePaddedWith_ = T32.decodeBase32PaddedWith+  decodeUnpaddedWith_ = T32.decodeBase32UnpaddedWith+  decodeHexWith_ = T32H.decodeBase32With+  decodeHexPaddedWith_ = T32H.decodeBase32PaddedWith+  decodeHexUnpaddedWith_ = T32H.decodeBase32UnpaddedWith++instance TextHarness 'TL32 TL.Text LBS.ByteString where+  decodeWith_ = TL32.decodeBase32With+  decodePaddedWith_ = TL32.decodeBase32PaddedWith+  decodeUnpaddedWith_ = TL32.decodeBase32UnpaddedWith+  decodeHexWith_ = TL32H.decodeBase32With+  decodeHexPaddedWith_ = TL32H.decodeBase32PaddedWith+  decodeHexUnpaddedWith_ = TL32H.decodeBase32UnpaddedWith++instance TextHarness 'TS32 TS.ShortText SBS.ShortByteString where+  decodeWith_ = TS32.decodeBase32With+  decodePaddedWith_ = TS32.decodeBase32PaddedWith+  decodeUnpaddedWith_ = TS32.decodeBase32UnpaddedWith+  decodeHexWith_ = TS32H.decodeBase32With+  decodeHexPaddedWith_ = TS32H.decodeBase32PaddedWith+  decodeHexUnpaddedWith_ = TS32H.decodeBase32UnpaddedWith++-- ------------------------------------------------------------------ --+-- Quickcheck instances++instance Arbitrary BS.ByteString where+    arbitrary = BS.pack <$> arbitrary+    shrink xs = BS.pack <$> shrink (BS.unpack xs)++instance CoArbitrary BS.ByteString where+    coarbitrary = coarbitrary . BS.unpack++instance Arbitrary LBS.ByteString where+    arbitrary = LBS.pack <$> arbitrary+    shrink xs = LBS.pack <$> shrink (LBS.unpack xs)++instance CoArbitrary LBS.ByteString where+    coarbitrary = coarbitrary . LBS.unpack++instance Arbitrary SBS.ShortByteString where+    arbitrary = SBS.pack <$> arbitrary+    shrink xs = SBS.pack <$> shrink (SBS.unpack xs)++instance CoArbitrary SBS.ShortByteString where+    coarbitrary = coarbitrary . SBS.unpack++instance Arbitrary T.Text where+    arbitrary = T.pack <$> arbitrary+    shrink xs = T.pack <$> shrink (T.unpack xs)++instance Arbitrary TL.Text where+    arbitrary = TL.pack <$> arbitrary+    shrink xs = TL.pack <$> shrink (TL.unpack xs)++instance CoArbitrary T.Text where+    coarbitrary = coarbitrary . T.unpack++instance CoArbitrary TL.Text where+    coarbitrary = coarbitrary . TL.unpack++instance Arbitrary TS.ShortText where+  arbitrary = TS.fromText <$> arbitrary+  shrink xs = fmap TS.fromText $ shrink (TS.toText xs)++instance CoArbitrary TS.ShortText where+  coarbitrary = coarbitrary . TS.toText

@@ -0,0 +1,465 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module       : Main+-- Copyright    : (c) 2019-2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains the test implementation for the `base32` package+--+module Main+( main+) where+++import Prelude hiding (length)++import Data.Bifunctor (second)+import qualified "memory" Data.ByteArray.Encoding as Mem+import qualified Data.ByteString as BS+import Data.ByteString.Internal (c2w)+import "base32" Data.ByteString.Base32 as B32+import "base32" Data.ByteString.Base32.Hex as B32H+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Short as SBS+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Text.Encoding.Base32.Error (Base32Error(..))+import qualified Data.Text.Lazy as TL+import qualified Data.Text.Lazy.Encoding as TL+import qualified Data.Text.Short as TS+import Data.Word++import Internal++import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck (testProperty)+++main :: IO ()+main = defaultMain tests+++tests :: TestTree+tests = testGroup "Base32 Tests"+  [ mkTree b32+    [ mkPropTree+    , mkUnitTree+    ]+  , mkTree bl32+    [ mkPropTree+    , mkUnitTree+    ]+  , mkTree bs32+    [ mkPropTree+    , mkUnitTree+    ]+  , mkTree t32+    [ mkPropTree+    , mkUnitTree+    , mkDecodeTree T.decodeUtf8' b32+    ]+  , mkTree tl32+    [ mkPropTree+    , mkUnitTree+    , mkDecodeTree TL.decodeUtf8' bl32+    ]+  , mkTree ts32+    [ mkPropTree+    , mkUnitTree+    , mkDecodeTree+      (second TS.fromText . T.decodeUtf8' . SBS.fromShort) bs32+    ]+  ]++-- ---------------------------------------------------------------- --+-- Test tree generation++-- | Make a test tree for a given label+--+mkTree+  :: forall a b proxy+  . Harness a b+  => proxy a+  -> [proxy a -> TestTree]+  -> TestTree+mkTree a = testGroup (label @a) . fmap ($ a)++-- | Make a test group with some name, lifting a test tree up to the correct+-- type information via some Harness+--+mkTests+  :: forall a b proxy+  . Harness a b+  => String+  -> [proxy a -> TestTree]+  -> proxy a+  -> TestTree+mkTests context ts = testGroup context . (<*>) ts . pure++-- | Make property tests for a given harness instance+--+mkPropTree :: forall a b proxy. Harness a b => proxy a -> TestTree+mkPropTree = mkTests "Property Tests"+  [ prop_roundtrip+  , prop_correctness+  , prop_padding_invariants+  , const prop_mem_coherence+  ]++-- | Make unit tests for a given harness instance+--+mkUnitTree+  :: forall a b proxy+  . Harness a b+  => proxy a+  -> TestTree+mkUnitTree = mkTests "Unit tests"+  [ rfcVectors+  , offsetVectors+  , validityTests+  ]++-- | Make unit tests for textual 'decode*With' functions+--+mkDecodeTree+  :: forall t a b c e proxy+  . ( TextHarness a b c+    , Harness t c+    , Show e+    )+  => (c -> Either e b)+  -> proxy t+  -> proxy a+  -> TestTree+mkDecodeTree utf8 t = mkTests "Decoding tests"+  [ decodeWithVectors utf8 t+  ]++-- ---------------------------------------------------------------- --+-- Property tests++prop_roundtrip :: forall a b proxy. Harness a b => proxy a -> TestTree+prop_roundtrip _ = testGroup "prop_roundtrip"+  [ testProperty "prop_std_roundtrip" $ \(bs :: b) ->+      Right (encode bs) == decode (encode (encode bs))+  , testProperty "prop_hex_roundtrip" $ \(bs :: b) ->+      Right (encodeHex bs) == decodeHex (encodeHex (encodeHex bs))+  , testProperty "prop_hex_roundtrip_nopad" $ \(bs :: b) ->+      Right (encodeHexNopad bs)+        == decodeHexNopad (encodeHexNopad (encodeHexNopad bs))+  ]++prop_correctness :: forall a b proxy. Harness a b => proxy a -> TestTree+prop_correctness _ = testGroup "prop_validity"+  [ testProperty "prop_std_valid" $ \(bs :: b) ->+    validate (encode bs)+  , testProperty "prop_hex_valid" $ \(bs :: b) ->+    validateHex (encodeHex bs)+  , testProperty "prop_std_correct" $ \(bs :: b) ->+    correct (encode bs)+  , testProperty "prop_hex_correct" $ \(bs :: b) ->+    correctHex (encodeHex bs)+  ]++prop_padding_invariants :: forall a b proxy. Harness a b => proxy a -> TestTree+prop_padding_invariants _ = testGroup "prop_padding_invariants"+  [ testProperty "prop_hex_nopad_roundtrip" $ \(bs :: b) ->+      Right (encodeHexNopad bs)+        == decodeHexNopad (encodeHexNopad (encodeHexNopad bs))++  , testProperty "prop_hex_pad_roundtrip" $ \(bs :: b) ->+      Right (encodeHex bs) == decodeHexPad (encodeHex (encodeHex bs))++  , testProperty "prop_hex_decode_invariant" $ \(bs :: b) ->+      ( decodeHexNopad (encodeHexNopad (encodeHex bs))+      == decodeHex (encodeHex (encodeHex bs))+      ) ||+      ( decodeHexPad (encodeHex (encodeHex bs))+      == decodeHex (encodeHex (encodeHex bs))+      )++  , testProperty "prop_std_decode_invariant" $ \(bs :: b) ->+      ( decodeNopad (encodeNopad (encode bs))+      == decode (encode (encode bs))+      ) ||+      ( decodePad (encode (encode bs))+      == decode (encode (encode bs))+      )++  , testProperty "prop_hex_padding_coherence" $ \(bs :: b) ->+      Right (encodeHex bs) == decodeHex (encodeHex (encodeHex bs))+      && Right (encodeHex bs) == decodeHexPad (encodeHex (encodeHex bs))++  , testProperty "prop_hex_nopadding_coherence" $ \(bs :: b) ->+      Right (encodeHexNopad bs) == decodeHexNopad (encodeHexNopad (encodeHexNopad bs))+      && Right (encodeHexNopad bs) == decodeHex (encodeHexNopad (encodeHexNopad bs))+  ]++-- | just a sanity check against `memory`+--+prop_mem_coherence :: TestTree+prop_mem_coherence = testGroup "prop_mem_coherence"+  [ testProperty "prop_std_mem_coherence" $ \bs ->+      Right bs == B32.decodeBase32 (B32.encodeBase32' bs)+      && Right bs == Mem.convertFromBase Mem.Base32 (Mem.convertToBase @BS.ByteString @BS.ByteString Mem.Base32 bs)+  ]++-- ---------------------------------------------------------------- --+-- Unit tests++-- | RFC 4328 test vectors+--+rfcVectors :: forall a b proxy. Harness a b => proxy a -> TestTree+rfcVectors _ = testGroup "RFC 4648 Test Vectors"+    [ testGroup "std alphabet"+      [ testCaseStd "" ""+      , testCaseStd "f" "MY======"+      , testCaseStd "fo" "MZXQ===="+      , testCaseStd "foo" "MZXW6==="+      , testCaseStd "foob" "MZXW6YQ="+      , testCaseStd "fooba" "MZXW6YTB"+      , testCaseStd "foobar" "MZXW6YTBOI======"+      ]+    , testGroup "hex alphabet"+      [ testCaseHex "" ""+      , testCaseHex "f" "CO======"+      , testCaseHex "fo" "CPNG===="+      , testCaseHex "foo" "CPNMU==="+      , testCaseHex "foob" "CPNMUOG="+      , testCaseHex "fooba" "CPNMUOJ1"+      , testCaseHex "foobar" "CPNMUOJ1E8======"+      ]+    ]+  where+    testCaseStd s t =+      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do+        step "encode is sound"+        t @=? encode @a s++        step "decode is sound"+        Right s @=? decode (encode s)++    testCaseHex s t =+      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do+        step "encode is sound"+        t @=? encodeHex @a s++        step "decode is sound"+        Right s @=? decodeHexPad t++-- | Unit test trees for the `decode*With` family of text-valued functions+--+decodeWithVectors+  :: forall t a b c e proxy+  . ( TextHarness a c b+    , Harness t b+    , Show e+    )+  => (b -> Either e c)+    -- ^ utf8+  -> proxy t+    -- ^ witness to the bytestring-ey dictionaries+  -> proxy a+    -- ^ witness to the text dictionaries+  -> TestTree+decodeWithVectors utf8 _ _ = testGroup "DecodeWith* unit tests"+  [ testGroup "decodeWith negative tests"+    [ testCase "decodeWith non-utf8 inputs on decodeUtf8" $ do+      case decodeWith_ @a utf8 "\1079743" of+        Left (DecodeError _) -> return ()+        _ -> assertFailure "decoding phase"+    , testCase "decodeWith valid utf8 inputs on decodeUtf8" $ do+      case decodeWith_ @a utf8 (encode @t "\1079743") of+        Left (ConversionError _) -> return ()+        _ -> assertFailure "conversion phase"+    , testCase "decodeHexWith non-utf8 inputs on decodeUtf8" $ do+      case decodeHexWith_ @a utf8 "\1079743" of+        Left (DecodeError _) -> return ()+        _ -> assertFailure "decoding phase"+    , testCase "decodePaddedWith non-utf8 inputs on decodeUtf8" $ do+      case decodePaddedWith_ @a utf8 "\1079743" of+        Left (DecodeError _) -> return ()+        _ -> assertFailure "decoding phase"+    , testCase "decodePaddedWith valid utf8 inputs on decodeUtf8" $ do+      case decodePaddedWith_ @a utf8 (encode @t "\1079743") of+        Left (ConversionError _) -> return ()+        _ -> assertFailure "conversion phase"+    , testCase "decodeUnpaddedWith non-utf8 inputs on decodeUtf8" $ do+      case decodeUnpaddedWith_ @a utf8 "\1079743" of+        Left (DecodeError _) -> return ()+        _ -> assertFailure "decoding phase"+    , testCase "decodeUnpaddedWith valid utf8 inputs on decodeUtf8" $ do+      case decodeUnpaddedWith_ @a utf8 (encodeNopad @t "\1079743") of+        Left (ConversionError _) -> return ()+        _ -> assertFailure "conversion phase"+    , testCase "decodeHexWith valid utf8 inputs on decodeUtf8" $ do+      case decodeHexWith_ @a utf8 (encodeHex @t "\1079743") of+        Left (ConversionError _) -> return ()+        _ -> assertFailure "conversion phase"+    , testCase "decodeHexPaddedWith non-utf8 inputs on decodeUtf8" $ do+      case decodeHexPaddedWith_ @a utf8 "\1079743" of+        Left (DecodeError _) -> return ()+        _ -> assertFailure "decoding phase"+    , testCase "decodeHexPaddedWith valid utf8 inputs on decodeUtf8" $ do+      case decodeHexPaddedWith_ @a utf8 (encodeHex @t "\1079743") of+        Left (ConversionError _) -> return ()+        _ -> assertFailure "conversion phase"+    , testCase "decodeHexUnpaddedWith non-utf8 inputs on decodeUtf8" $ do+      case decodeHexUnpaddedWith_ @a utf8 "\1079743" of+        Left (DecodeError _) -> return ()+        _ -> assertFailure "decoding phase"+    , testCase "decodeHexUnpaddedWith valid utf8 inputs on decodeUtf8" $ do+      case decodeHexUnpaddedWith_ @a utf8 (encodeHexNopad @t "\1079743") of+        Left (ConversionError _) -> return ()+        _ -> assertFailure "conversion phase"+    ]+  , testGroup "decodeWith positive tests"+    [ testCase "decodeWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decode @a "MZXW6YTBOI======"+      b <- either (assertFailure . show) pure $ decodeWith_ @a utf8 "MZXW6YTBOI======"+      a @=? b+    , testCase "decodePaddedWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decodePad @a "MZXW6YTBOI======"+      b <- either (assertFailure . show) pure $ decodePaddedWith_ @a utf8 "MZXW6YTBOI======"+      a @=? b+    , testCase "decodeUnpaddedWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decodeNopad @a "MZXW6YTBOI"+      b <- either (assertFailure . show) pure $ decodeUnpaddedWith_ @a utf8 "MZXW6YTBOI"+      a @=? b+    , testCase "decodeHexWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decodeHex @a "CPNMUOJ1E8======"+      b <- either (assertFailure . show) pure $ decodeHexWith_ @a utf8 "CPNMUOJ1E8======"+      a @=? b+    , testCase "decodeHexPaddedWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decodeHexPad @a "CPNMUOJ1E8======"+      b <- either (assertFailure . show) pure $ decodeHexPaddedWith_ @a utf8 "CPNMUOJ1E8======"+      a @=? b+    , testCase "decodeHexUnpaddedWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decodeHexNopad @a "CPNMUOJ1"+      b <- either (assertFailure . show) pure $ decodeHexUnpaddedWith_ @a utf8 "CPNMUOJ1"+      a @=? b+    ]+  ]++-- | Validity unit tests for the URL workflow+--+validityTests :: forall a b proxy. Harness a b => proxy a -> TestTree+validityTests _ = testGroup "Validity and correctness unit tests"+  [ testGroup "Validity unit tests"+    [ testCase "Hex padding tests" $ do+      not (validateHex @a "C") @? "C"+      validateHex @a "CO" @? "CO"+      validateHex @a "CPNG" @? "CPNG"+      validateHex @a "CPNMU" @? "CPNMU"+      validateHex @a "CPNMUOG" @? "CPNMUOG"+      validateHex @a "CPNMUOJ1" @? "CPNMUOJ1"+      validateHex @a "CPNMUOJ1E8" @? "CPNMUOJ1E8"+      validateHex @a "CO======" @? "CO======"+      validateHex @a "CPNG====" @? "CPNG===="+      validateHex @a "CPNMU===" @? "CPNMU==="+      validateHex @a "CPNMUOG=" @? "CPNMUOG="+      validateHex @a "CPNMUOJ1" @? "CPNMUOJ1"+      validateHex @a "CPNMUOJ1E8======" @? "CPNMUOJ1E8======"+    , testCase "Std padding tests" $ do+      not (validate @a "M") @? "M"+      validate @a "MY" @? "MY"+      validate @a "MZXQ" @? "MZXQ"+      validate @a "MZXW6" @? "MZXW6"+      validate @a "MZXW6YQ" @? "MZXW6YQ"+      validate @a "MZXW6YTB" @? "MZXW6YTB"+      validate @a "MZXW6YTBOI" @? "MZXW6YTBOI"+      validate @a "MY======" @? "MY======"+      validate @a "MZXQ====" @? "MZXQ===="+      validate @a "MZXW6===" @? "MZXW6==="+      validate @a "MZXW6YQ=" @? "MZXW6YQ="+      validate @a "MZXW6YTB" @? "MZXW6YTB"+      validate @a "MZXW6YTBOI======" @? "MZXW6YTBOI======"+    ]+  , testGroup "Correctness unit tests"+    [ testCase "Hex tests" $ do+      not (correctHex @a "C") @? "C"+      correctHex @a "CO" @? "CO"+      correctHex @a "CPNG" @? "CPNG"+      correctHex @a "CPNMU" @? "CPNMU"+      correctHex @a "CPNMUOG" @? "CPNMUOG"+      correctHex @a "CPNMUOJ1" @? "CPNMUOJ1"+      correctHex @a "CPNMUOJ1E8" @? "CPNMUOJ1E8"+      correctHex @a "CO======" @? "CO======"+      correctHex @a "CPNG====" @? "CPNG===="+      correctHex @a "CPNMU===" @? "CPNMU==="+      correctHex @a "CPNMUOG=" @? "CPNMUOG="+      correctHex @a "CPNMUOJ1" @? "CPNMUOJ1"+      correctHex @a "CPNMUOJ1E8======" @? "CPNMUOJ1E8======"+    , testCase "Std tests" $ do+      not (correct @a "M") @? "M"+      correct @a "MY" @? "MY"+      correct @a "MZXQ" @? "MZXQ"+      correct @a "MZXW6" @? "MZXW6"+      correct @a "MZXW6YQ" @? "MZXW6YQ"+      correct @a "MZXW6YTB" @? "MZXW6YTB"+      correct @a "MZXW6YTBOI" @? "MZXW6YTBOI"+      correct @a "MY======" @? "MY======"+      correct @a "MZXQ====" @? "MZXQ===="+      correct @a "MZXW6===" @? "MZXW6==="+      correct @a "MZXW6YQ=" @? "MZXW6YQ="+      correct @a "MZXW6YTB" @? "MZXW6YTB"+      correct @a "MZXW6YTBOI======" @? "MZXW6YTBOI======"+    ]+  ]++-- | Offset test vectors. This stresses the invalid char + incorrect padding+-- offset error messages+--+offsetVectors :: forall a b proxy. Harness a b => proxy a -> TestTree+offsetVectors _ = testGroup "Offset tests"+  [ testGroup "Hex - Invalid padding"+    [ testCase "Invalid staggered padding" $ do+      decodeHex @a "=PNMUOJ1E8======" @?= Left "invalid padding at offset: 0"+      decodeHex @a "C=NMUOJ1E8======" @?= Left "invalid padding at offset: 1"+      decodeHex @a "CP=MUOJ1E8======" @?= Left "invalid padding at offset: 2"+      decodeHex @a "CPN=UOJ1E8======" @?= Left "invalid padding at offset: 3"+      decodeHex @a "CPNM=OJ1E8======" @?= Left "invalid padding at offset: 4"+      decodeHex @a "CPNMU=J1E8======" @?= Left "invalid padding at offset: 5"+      decodeHex @a "CPNMUO=1E8======" @?= Left "invalid padding at offset: 6"+      decodeHex @a "CPNMUOJ=E8======" @?= Left "invalid padding at offset: 7"+    , testCase "Invalid character coverage" $ do+      decodeHex @a "%PNMUOJ1E8======" @?= Left "invalid character at offset: 0"+      decodeHex @a "C%NMUOJ1E8======" @?= Left "invalid character at offset: 1"+      decodeHex @a "CP%MUOJ1E8======" @?= Left "invalid character at offset: 2"+      decodeHex @a "CPN%UOJ1E8======" @?= Left "invalid character at offset: 3"+      decodeHex @a "CPNM%OJ1E8======" @?= Left "invalid character at offset: 4"+      decodeHex @a "CPNMU%J1E8======" @?= Left "invalid character at offset: 5"+      decodeHex @a "CPNMUO%1E8======" @?= Left "invalid character at offset: 6"+      decodeHex @a "CPNMUOJ%E8======" @?= Left "invalid character at offset: 7"+    ]+  , testGroup "Std - Invalid padding"+    [ testCase "Invalid staggered padding" $ do+      decode @a "=ZXW6YTBOI======" @?= Left "invalid padding at offset: 0"+      decode @a "M=XW6YTBOI======" @?= Left "invalid padding at offset: 1"+      decode @a "MZ=W6YTBOI======" @?= Left "invalid padding at offset: 2"+      decode @a "MZX=6YTBOI======" @?= Left "invalid padding at offset: 3"+      decode @a "MZXW=YTBOI======" @?= Left "invalid padding at offset: 4"+      decode @a "MZXW6=TBOI======" @?= Left "invalid padding at offset: 5"+      decode @a "MZXW6Y=BOI======" @?= Left "invalid padding at offset: 6"+      decode @a "MZXW6YT=OI======" @?= Left "invalid padding at offset: 7"+    , testCase "Invalid character coverage" $ do+      decode @a "%ZXW6YTBOI======" @?= Left "invalid character at offset: 0"+      decode @a "M%XW6YTBOI======" @?= Left "invalid character at offset: 1"+      decode @a "MZ%W6YTBOI======" @?= Left "invalid character at offset: 2"+      decode @a "MZX%6YTBOI======" @?= Left "invalid character at offset: 3"+      decode @a "MZXW%YTBOI======" @?= Left "invalid character at offset: 4"+      decode @a "MZXW6%TBOI======" @?= Left "invalid character at offset: 5"+      decode @a "MZXW6Y%BOI======" @?= Left "invalid character at offset: 6"+      decode @a "MZXW6YT%OI======" @?= Left "invalid character at offset: 7"+    ]+  ]