packages feed

base16 0.2.1.0 → 0.3.0.0

raw patch · 17 files changed

+1012/−472 lines, 17 filesdep +QuickCheckdep +tasty-quickcheckdep −memorydep ~basedep ~bytestringdep ~deepseqPVP ok

version bump matches the API change (PVP)

Dependencies added: QuickCheck, tasty-quickcheck

Dependencies removed: memory

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

API changes (from Hackage documentation)

+ Data.Text.Encoding.Base16.Error: instance Control.DeepSeq.NFData e => Control.DeepSeq.NFData (Data.Text.Encoding.Base16.Error.Base16Error e)
+ Data.Text.Encoding.Base16.Error: instance GHC.Exception.Type.Exception e => GHC.Exception.Type.Exception (Data.Text.Encoding.Base16.Error.Base16Error e)
+ Data.Text.Encoding.Base16.Error: instance GHC.Generics.Generic (Data.Text.Encoding.Base16.Error.Base16Error e)
- Data.ByteString.Short.Base16: encodeBase16 :: ShortByteString -> Text
+ Data.ByteString.Short.Base16: encodeBase16 :: ShortByteString -> ShortText
- Data.Text.Encoding.Base16: decodeBase16With :: (ByteString -> Either err Text) -> Text -> Either (Base16Error err) Text
+ Data.Text.Encoding.Base16: decodeBase16With :: (ByteString -> Either err Text) -> ByteString -> Either (Base16Error err) Text
- Data.Text.Lazy.Encoding.Base16: decodeBase16With :: (ByteString -> Either err Text) -> Text -> Either (Base16Error err) Text
+ Data.Text.Lazy.Encoding.Base16: decodeBase16With :: (ByteString -> Either err Text) -> ByteString -> Either (Base16Error err) Text
- Data.Text.Short.Encoding.Base16: decodeBase16With :: (ShortByteString -> Either err ShortText) -> ShortText -> Either (Base16Error err) ShortText
+ Data.Text.Short.Encoding.Base16: decodeBase16With :: (ShortByteString -> Either err ShortText) -> ShortByteString -> Either (Base16Error err) ShortText

Files

CHANGELOG.md view
@@ -1,5 +1,19 @@ # Revision history for base16 +## 0.3.0.0++* API for `decodeBase16With` has changed to require `ByteString` instead of `Text`. This is in alignment with work done on `base64`, which reflects+  the same API. This will be the final design for these types of conversions.+* Test coverage now at 94%+* Add NFData, Exception, and Generic instances for Base16Error + @since annotations for new instances. ([#5](https://github.com/emilypi/Base16/pull/5))+* Doc improvements and add -XTrustworty and -XSafe annotations where needed. ([#5](https://github.com/emilypi/Base16/pull/5))+* Optimized inner loop for short text and bytestrings ([#4](https://github.com/emilypi/Base16/pull/4))+* Changed `encodeBase16` in `ByteString.Short` to produce `ShortText`, instead of `Text`.++## 0.2.1++* Added support for `Text.Short` and `ByteString.Short` values+ ## 0.2.0.1  * Improved performance. Decode and encode are now 3.5x-5x the next best lib.
README.md view
@@ -21,7 +21,7 @@ Additionally this library has  - Much better performance than `base16-bytestring` for encode and decode, with a more conventional api.-- Optics for handling more complex structures with Base64 representations via the `base16-lens` package+- Optics for handling more complex structures with Base16 representations via the `base16-lens` package - Checks for both validity and correctness of Base16 encodings.  There are no dependencies aside from those bundled with GHC.
base16.cabal view
@@ -1,26 +1,30 @@-cabal-version:      2.0-name:               base16-version:            0.2.1.0-synopsis:           RFC 4648-compliant Base16 encodings/decodings+cabal-version:   2.0+name:            base16+version:         0.3.0.0+synopsis:        Fast RFC 4648-compliant Base16 encoding description:   RFC 4648-compliant Base16 encodings and decodings.   This library provides performant encoding and decoding primitives, as well as support for textual values. -homepage:           https://github.com/emilypi/base16-bug-reports:        https://github.com/emilypi/base16/issues-license:            BSD3-license-file:       LICENSE-author:             Emily Pillmore-maintainer:         emilypi@cohomolo.gy-copyright:          (c) 2020 Emily Pillmore-category:           Data-build-type:         Simple-extra-source-files:+homepage:        https://github.com/emilypi/base16+bug-reports:     https://github.com/emilypi/base16/issues+license:         BSD3+license-file:    LICENSE+author:          Emily Pillmore+maintainer:      emilypi@cohomolo.gy+copyright:       (c) 2020 Emily Pillmore+category:        Data+build-type:      Simple+extra-doc-files:   CHANGELOG.md   README.md  tested-with:-  GHC ==8.2.2 || ==8.4.3 || ==8.4.4 || ==8.6.3 || ==8.6.5 || ==8.8.1+  GHC ==8.2.2+   || ==8.4.4+   || ==8.6.5+   || ==8.8.3+   || ==8.10.1  source-repository head   type:     git@@ -40,11 +44,13 @@     Data.ByteString.Base16.Internal.Head     Data.ByteString.Base16.Internal.Utils     Data.ByteString.Base16.Internal.W16.Loop+    Data.ByteString.Base16.Internal.W16.ShortLoop    build-depends:-      base        >=4.10 && <5+      base        >=4.10    && <5     , bytestring  ^>=0.10-    , primitive+    , deepseq     >=1.4.3.0 && <1.4.5.0+    , primitive   >=0.6     && <0.8     , text        ^>=1.2     , text-short  ^>=0.1 @@ -53,20 +59,23 @@   ghc-options:      -Wall  test-suite tasty+  other-modules:    Internal   default-language: Haskell2010   type:             exitcode-stdio-1.0   hs-source-dirs:   test-  main-is:          Base16Tests.hs+  main-is:          Main.hs   build-depends:       base               >=4.10 && <5     , base16     , base16-bytestring     , bytestring-    , memory+    , QuickCheck     , random-bytestring     , tasty     , tasty-hunit+    , tasty-quickcheck     , text+    , text-short  benchmark bench   default-language: Haskell2010@@ -80,6 +89,5 @@     , bytestring     , criterion     , deepseq-    , memory     , random-bytestring     , text
benchmarks/Base16Bench.hs view
@@ -7,10 +7,10 @@ import Criterion import Criterion.Main -import Data.ByteString.Lazy (fromStrict)-import "memory" Data.ByteArray.Encoding as Mem import Data.ByteString+import Data.ByteString.Short import "base16" Data.ByteString.Base16 as B16+import "base16" Data.ByteString.Short.Base16 as BS16 import "base16-bytestring" Data.ByteString.Base16 as Bos import Data.ByteString.Random (random) @@ -21,32 +21,32 @@     [ env bs $ \ ~((bs25,bs100,bs1k,bs10k,bs100k,bs1mm),(bs25L,bs100L,bs1kL,bs10kL,bs100kL,bs1mmL)) ->       bgroup "encode"       [ bgroup "25"-        [ bench "memory" $ whnf ctob bs25+        [ bench "base16-short" $ whnf BS16.encodeBase16' bs25L         , bench "base16-bytestring" $ whnf Bos.encode bs25         , bench "base16" $ whnf B16.encodeBase16' bs25         ]       , bgroup "100"-        [ bench "memory" $ whnf ctob bs100+        [ bench "base16-short" $ whnf BS16.encodeBase16' bs100L         , bench "base16-bytestring" $ whnf Bos.encode bs100         , bench "base16" $ whnf B16.encodeBase16' bs100         ]       , bgroup "1k"-        [ bench "memory" $ whnf ctob bs1k+        [ bench "base16-short" $ whnf BS16.encodeBase16' bs1kL         , bench "base16-bytestring" $ whnf Bos.encode bs1k         , bench "base16" $ whnf B16.encodeBase16' bs1k         ]       , bgroup "10k"-        [ bench "memory" $ whnf ctob bs10k+        [ bench "base16-short" $ whnf BS16.encodeBase16' bs10kL         , bench "base16-bytestring" $ whnf Bos.encode bs10k         , bench "base16" $ whnf B16.encodeBase16' bs10k         ]       , bgroup "100k"-        [ bench "memory" $ whnf ctob bs100k+        [ bench "base16-short" $ whnf BS16.encodeBase16' bs100kL         , bench "base16-bytestring" $ whnf Bos.encode bs100k         , bench "base16" $ whnf B16.encodeBase16' bs100k         ]       , bgroup "1mm"-        [ bench "memory" $ whnf ctob bs1mm+        [ bench "base16-short" $ whnf BS16.encodeBase16' bs1mmL         , bench "base16-bytestring" $ whnf Bos.encode bs1mm         , bench "base16" $ whnf B16.encodeBase16' bs1mm         ]@@ -54,44 +54,38 @@     , env bs' $ \ ~((bs25,bs100,bs1k,bs10k,bs100k,bs1mm),(bs25L,bs100L,bs1kL,bs10kL,bs100kL,bs1mmL)) ->       bgroup "decode"       [ bgroup "25"-        [ bench "memory" $ whnf cfob bs25+        [ bench "base16-short" $ whnf BS16.decodeBase16 bs25L         , bench "base16-bytestring" $ whnf Bos.decode bs25-        , bench "base16" $ whnf B16.decodeBase16Lenient bs25+        , bench "base16" $ whnf B16.decodeBase16 bs25         ]       , bgroup "100"-        [ bench "memory" $ whnf cfob bs100+        [ bench "base16-short" $ whnf BS16.decodeBase16 bs100L         , bench "base16-bytestring" $ whnf Bos.decode bs100-        , bench "base16" $ whnf B16.decodeBase16Lenient bs100+        , bench "base16" $ whnf B16.decodeBase16 bs100         ]       , bgroup "1k"-        [ bench "memory" $ whnf cfob bs1k+        [ bench "base16-short" $ whnf BS16.decodeBase16 bs1kL         , bench "base16-bytestring" $ whnf Bos.decode bs1k-        , bench "base16" $ whnf B16.decodeBase16Lenient bs1k+        , bench "base16" $ whnf B16.decodeBase16 bs1k         ]       , bgroup "10k"-        [ bench "memory" $ whnf cfob bs10k+        [ bench "base16-short" $ whnf BS16.decodeBase16 bs10kL         , bench "base16-bytestring" $ whnf Bos.decode bs10k-        , bench "base16" $ whnf B16.decodeBase16Lenient bs10k+        , bench "base16" $ whnf B16.decodeBase16 bs10k         ]       , bgroup "100k"-        [ bench "memory" $ whnf cfob bs100k+        [ bench "base16-short" $ whnf BS16.decodeBase16 bs100kL         , bench "base16-bytestring" $ whnf Bos.decode bs100k-        , bench "base16" $ whnf B16.decodeBase16Lenient bs100k+        , bench "base16" $ whnf B16.decodeBase16 bs100k         ]       , bgroup "1mm"-        [ bench "memory" $ whnf cfob bs1mm+        [ bench "base16-short" $ whnf BS16.decodeBase16 bs1mmL         , bench "base16-bytestring" $ whnf Bos.decode bs1mm-        , bench "base16" $ whnf B16.decodeBase16Lenient bs1mm+        , bench "base16" $ whnf B16.decodeBase16 bs1mm         ]       ]     ]   where-    ctob :: ByteString -> ByteString-    ctob = Mem.convertToBase Mem.Base16--    cfob :: ByteString -> Either String ByteString-    cfob = Mem.convertFromBase Mem.Base16-     bs = do       a <- random 25       b <- random 100@@ -99,13 +93,13 @@       d <- random 10000       e <- random 100000       f <- random 1000000-      return ((a,b,c,d,e,f),(fromStrict a,fromStrict b,fromStrict c,fromStrict d,fromStrict e,fromStrict f))+      return ((a,b,c,d,e,f),(toShort a,toShort b,toShort c,toShort d,toShort e,toShort f))      bs' = do-      a <- ctob <$> random 25-      b <- ctob <$> random 100-      c <- ctob <$> random 1000-      d <- ctob <$> random 10000-      e <- ctob <$> random 100000-      f <- ctob <$> random 1000000-      return ((a,b,c,d,e,f),(fromStrict a,fromStrict b,fromStrict c,fromStrict d,fromStrict e,fromStrict f))+      a <- B16.encodeBase16' <$> random 25+      b <- B16.encodeBase16' <$> random 100+      c <- B16.encodeBase16' <$> random 1000+      d <- B16.encodeBase16' <$> random 10000+      e <- B16.encodeBase16' <$> random 100000+      f <- B16.encodeBase16' <$> random 1000000+      return ((a,b,c,d,e,f),(toShort a,toShort b,toShort c,toShort d,toShort e,toShort f))
src/Data/ByteString/Base16.hs view
@@ -1,18 +1,18 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Base16--- Copyright 	: (c) 2020 Emily Pillmore--- License	: BSD-style+-- Copyright    : (c) 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 Base16 encoding including--- unpadded and lenient variants for bytestrings+-- This module contains 'Data.ByteString.ByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.ByteString.Base16 ( encodeBase16@@ -37,6 +37,11 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+-- encodeBase16 :: ByteString -> Text encodeBase16 = T.decodeUtf8 . encodeBase16' {-# INLINE encodeBase16 #-}@@ -45,6 +50,11 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16' "Sun"+-- "53756e"+-- encodeBase16' :: ByteString -> ByteString encodeBase16' = encodeBase16_ {-# INLINE encodeBase16' #-}@@ -53,6 +63,14 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: ByteString -> Either Text ByteString decodeBase16 = decodeBase16_ {-# INLINE decodeBase16 #-}@@ -62,23 +80,25 @@ -- -- N.B.: this is not RFC 4648-compliant --+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: ByteString -> ByteString decodeBase16Lenient = decodeBase16Lenient_ {-# INLINE decodeBase16Lenient #-}  -- | Tell whether a 'ByteString' value is base16 encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True --@@ -92,17 +112,10 @@ -- only that it conforms to the correct alphabet. To check whether it is a true -- Base16 encoded 'ByteString' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
src/Data/ByteString/Base16/Internal/Head.hs view
@@ -7,19 +7,28 @@ ( encodeBase16_ , decodeBase16_ , decodeBase16Lenient_+, encodeBase16Short_+, decodeBase16Short_+, decodeBase16ShortLenient_ ) where   #include "MachDeps.h" -import Data.ByteString (empty)+import qualified Data.ByteString as BS (empty) import Data.ByteString.Internal+import qualified Data.ByteString.Short as SBS (empty)+import Data.ByteString.Base16.Internal.Utils import Data.ByteString.Base16.Internal.W16.Loop+import qualified Data.ByteString.Base16.Internal.W16.ShortLoop as Short+import Data.ByteString.Short.Internal (ShortByteString(..))+import Data.Primitive.ByteArray import Data.Text (Text)  import Foreign.Ptr import Foreign.ForeignPtr +import GHC.Exts import GHC.ForeignPtr  import System.IO.Unsafe@@ -37,10 +46,11 @@           (plusPtr sptr (soff + slen))   where     !dlen = 2 * slen+{-# INLINE encodeBase16_ #-}  decodeBase16_ :: ByteString -> Either Text ByteString decodeBase16_ (PS !sfp !soff !slen)-  | slen == 0 = Right ""+  | slen == 0 = Right BS.empty   | r /= 0 = Left "invalid bytestring size"   | otherwise = unsafeDupablePerformIO $ do     dfp <- mallocPlainForeignPtrBytes q@@ -53,13 +63,15 @@           (plusPtr sptr (soff + slen))           0   where-    (!q, !r) = slen `divMod` 2+    !q = slen `quot` 2+    !r = slen `rem` 2+{-# INLINE decodeBase16_ #-}  decodeBase16Lenient_ :: ByteString -> ByteString decodeBase16Lenient_ (PS !sfp !soff !slen)-  | slen == 0 = empty+  | slen == 0 = BS.empty   | otherwise = unsafeDupablePerformIO $ do-    dfp <- mallocPlainForeignPtrBytes dlen+    dfp <- mallocPlainForeignPtrBytes q     withForeignPtr dfp $ \dptr ->       withForeignPtr sfp $ \sptr ->         lenientLoop@@ -69,5 +81,44 @@           (plusPtr sptr (soff + slen))           0   where-    (!q, _) = slen `divMod` 2-    !dlen = q * 2+    !q = slen `quot` 2+{-# INLINE decodeBase16Lenient_ #-}++-- ---------------------------------------------------------------- --+-- Short encode/decode++encodeBase16Short_ :: ShortByteString -> ShortByteString+encodeBase16Short_ (SBS !ba#) = runShortST $ do+    dst <- newByteArray l'+    Short.innerLoop l dst (MutableByteArray (unsafeCoerce# ba#))+    unsafeFreezeByteArray dst+  where+    !l = I# (sizeofByteArray# ba#)+    !l' = l * 2+{-# INLINE encodeBase16Short_ #-}++decodeBase16Short_ :: ShortByteString -> Either Text ShortByteString+decodeBase16Short_ (SBS !ba#)+    | l == 0 = Right SBS.empty+    | r /= 0 = Left "invalid bytestring size"+    | otherwise = runDecodeST $ do+      dst <- newByteArray q+      Short.decodeLoop l dst (MutableByteArray (unsafeCoerce# ba#))+  where+    !l = I# (sizeofByteArray# ba#)+    !q = l `quot` 2+    !r = l `rem` 2+{-# INLINE decodeBase16Short_ #-}++decodeBase16ShortLenient_ :: ShortByteString -> ShortByteString+decodeBase16ShortLenient_ (SBS !ba#)+    | l == 0 = SBS.empty+    | otherwise = runShortST $ do+      dst <- newByteArray q+      q' <- Short.lenientLoop l dst (MutableByteArray (unsafeCoerce# ba#))+      !_ <- resizeMutableByteArray dst q'+      unsafeFreezeByteArray dst+  where+    !l = I# (sizeofByteArray# ba#)+    !q = l `quot` 2+{-# INLINE decodeBase16ShortLenient_ #-}
src/Data/ByteString/Base16/Internal/Utils.hs view
@@ -1,15 +1,24 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE MagicHash #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE UnboxedTuples #-} module Data.ByteString.Base16.Internal.Utils ( aix , reChunk+, runShortST+, runDecodeST ) where + import Data.ByteString (ByteString) import qualified Data.ByteString as B+import Data.ByteString.Short.Internal+import Data.Primitive.ByteArray+import Data.Text (Text)  import GHC.Exts import GHC.Word+import GHC.ST (ST(..))   -- | Read 'Word8' index off alphabet addr@@ -36,3 +45,27 @@             let as' = if B.null y then as else y:as             in q' : reChunk as'           else cont_ q' as++-- | Write a byte array directly to Short bytestring+--+runShortST :: (forall s. ST s ByteArray) -> ShortByteString+runShortST enc = runRW# $ \s0 -> case enc of+  { ST g -> case g s0 of+    { (# _, ByteArray r #) -> SBS r+    }+  }+{-# INLINE runShortST #-}++-- | Used for writing 'ByteArray#'-based encodes+--+runDecodeST+    :: (forall s. ST s (Either Text ByteArray))+    -> Either Text ShortByteString+runDecodeST dec = runRW# $ \s0 -> case dec of+  { ST g -> case g s0 of+    { (# _, e #) -> case e of+      Left t -> Left t+      Right (ByteArray r) -> Right (SBS r)+    }+  }+{-# INLINE runDecodeST #-}
+ src/Data/ByteString/Base16/Internal/W16/ShortLoop.hs view
@@ -0,0 +1,105 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE MagicHash #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+module Data.ByteString.Base16.Internal.W16.ShortLoop+( innerLoop+, decodeLoop+, lenientLoop+) where+++import Control.Monad.ST++import Data.Bits+import Data.ByteString.Base16.Internal.Utils+import Data.Primitive.ByteArray+import Data.Text (Text)+import qualified Data.Text as T+++innerLoop+    :: Int+    -> MutableByteArray s+    -> MutableByteArray s+    -> ST s ()+innerLoop !slen !dst !src = go (0 :: Int) (0 :: Int)+  where+    !hex = "0123456789abcdef"#++    go !doff !soff+      | soff == slen = return ()+      | otherwise = do+        x <- readByteArray src soff+        writeByteArray dst doff (aix (unsafeShiftR x 4) hex)+        writeByteArray dst (doff + 1) (aix (x .&. 0x0f) hex)+        go (doff + 2) (soff + 1)+{-# inline innerLoop #-}++decodeLoop+    :: Int+    -> MutableByteArray s+    -> MutableByteArray s+    -> ST s (Either Text ByteArray)+decodeLoop !slen !dst !src = go (0 :: Int) (0 :: Int)+  where+    err i = return . Left . T.pack+      $ "invalid character at offset: "+      ++ show i++    !lo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++    !hi = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++    go !doff !soff+      | soff == slen = Right <$> unsafeFreezeByteArray dst+      | otherwise = do+        x <- readByteArray src soff+        y <- readByteArray src (soff + 1)++        let !a = aix x hi+            !b = aix y lo++        if+          | a == 0xff -> err soff+          | b == 0xff -> err (soff + 1)+          | otherwise -> do+            writeByteArray dst doff (a .|. b)+            go (doff + 1) (soff + 2)+{-# inline decodeLoop #-}++lenientLoop+    :: Int+    -> MutableByteArray s+    -> MutableByteArray s+    -> ST s Int+lenientLoop !slen !dst !src = goHi (0 :: Int) (0 :: Int)+  where+    !lo = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x01\x02\x03\x04\x05\x06\x07\x08\x09\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x0a\x0b\x0c\x0d\x0e\x0f\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++    !hi = "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\x00\x10\x20\x30\x40\x50\x60\x70\x80\x90\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xa0\xb0\xc0\xd0\xe0\xf0\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"#++    goHi !doff !soff+      | soff == slen = return doff+      | otherwise = do+        x <- readByteArray src soff++        let !a = aix x hi++        if a == 0xff+        then goHi doff (soff + 1)+        else goLo doff (soff + 1) a++    goLo !doff !soff !a+      | soff == slen = return doff+      | otherwise = do+        y <- readByteArray src soff++        let !b = aix y lo++        if b == 0xff+        then goLo doff (soff + 1) a+        else do+          writeByteArray dst doff (a .|. b)+          goHi (doff + 1) (soff + 1)+{-# inline lenientLoop #-}
src/Data/ByteString/Lazy/Base16.hs view
@@ -1,16 +1,18 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-} -- |--- Module       : Data.ByteString.Base16.Lazy--- Copyright 	: (c) 2020 Emily Pillmore--- License	: BSD-style+-- Module       : Data.ByteString.Lazy.Base16+-- Copyright    : (c) 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 Base16 encoding including--- unpadded and lenient variants for lazy bytestrings+-- This module contains 'Data.ByteString.Lazy.ByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.ByteString.Lazy.Base16 ( encodeBase16@@ -40,6 +42,11 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+-- encodeBase16 :: ByteString -> Text encodeBase16 = TL.decodeUtf8 . encodeBase16' {-# INLINE encodeBase16 #-}@@ -48,6 +55,11 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16' "Sun"+-- "53756e"+-- encodeBase16' :: ByteString -> ByteString encodeBase16' Empty = Empty encodeBase16' (Chunk b bs) = Chunk (B16.encodeBase16_ b) (encodeBase16' bs)@@ -57,6 +69,14 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: ByteString -> Either T.Text ByteString decodeBase16 Empty = Right Empty decodeBase16 (Chunk b bs) = Chunk <$> B16.decodeBase16_ b <*> decodeBase16 bs@@ -67,6 +87,14 @@ -- -- N.B.: this is not RFC 4648-compliant. It may give you garbage if you're not careful! --+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: ByteString -> ByteString decodeBase16Lenient = fromChunks   . fmap B16.decodeBase16Lenient_@@ -77,17 +105,11 @@  -- | Tell whether a lazy 'ByteString' value is base16 encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True --@@ -101,17 +123,10 @@ -- only that it conforms to the correct alphabet. To check whether it is a true -- Base16 encoded 'ByteString' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
src/Data/ByteString/Short/Base16.hs view
@@ -1,18 +1,18 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE MagicHash #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.ByteString.Short.Base16--- Copyright 	: (c) 2020 Emily Pillmore--- License	: BSD-style+-- Copyright    : (c) 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 Base16 encoding including--- unpadded and lenient variants for bytestrings+-- This module contains 'Data.ByteString.Short.ShortByteString'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.ByteString.Short.Base16 ( encodeBase16@@ -24,35 +24,56 @@ ) where  -import Prelude hiding (all, elem)--import Data.ByteString.Short (ShortByteString, toShort, fromShort)+import Data.ByteString.Short (ShortByteString, fromShort)+import Data.ByteString.Base16.Internal.Head import qualified Data.ByteString.Base16 as B16 import Data.Text (Text)+import Data.Text.Short (ShortText)+import Data.Text.Short.Unsafe  --- | Encode a 'ShortByteString' value as Base16 'Text' with padding.+-- | Encode a 'ShortByteString' value as Base16 'ShortText' with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> ---encodeBase16 :: ShortByteString -> Text-encodeBase16 = B16.encodeBase16 . fromShort+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+--+-- @since 0.3.0.0+--+encodeBase16 :: ShortByteString -> ShortText+encodeBase16 = fromShortByteStringUnsafe . decodeBase16ShortLenient_ {-# INLINE encodeBase16 #-}  -- | Encode a 'ShortByteString' value as a Base16 'ShortByteString'  value with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16' "Sun"+-- "53756e"+-- encodeBase16' :: ShortByteString -> ShortByteString-encodeBase16' = toShort . B16.encodeBase16' . fromShort+encodeBase16' = encodeBase16Short_ {-# INLINE encodeBase16' #-}  -- | Decode a Base16-encoded 'ShortByteString' value. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: ShortByteString -> Either Text ShortByteString-decodeBase16 = fmap toShort . B16.decodeBase16 . fromShort+decodeBase16 = decodeBase16Short_ {-# INLINE decodeBase16 #-}  -- | Decode a Base16-encoded 'ShortByteString' value leniently, using a@@ -60,23 +81,26 @@ -- -- N.B.: this is not RFC 4648-compliant --+--+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: ShortByteString -> ShortByteString-decodeBase16Lenient = toShort . B16.decodeBase16Lenient . fromShort+decodeBase16Lenient = decodeBase16ShortLenient_ {-# INLINE decodeBase16Lenient #-}  -- | Tell whether a 'ShortByteString' value is base16 encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True --@@ -90,17 +114,10 @@ -- only that it conforms to the correct alphabet. To check whether it is a true -- Base16 encoded 'ShortByteString' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
src/Data/Text/Encoding/Base16.hs view
@@ -1,15 +1,17 @@+{-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base16--- Copyright 	: (c) 2019 Emily Pillmore--- License	: BSD-style+-- Copyright    : (c) 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 Base16 encoding including--- unpadded and lenient variants for text values+-- This module contains 'Data.Text.Text'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.Text.Encoding.Base16 ( encodeBase16@@ -29,10 +31,16 @@ import Data.Text.Encoding.Base16.Error (Base16Error(..)) import qualified Data.Text.Encoding as T + -- | Encode a 'Text' value in Base16 with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+-- encodeBase16 :: Text -> Text encodeBase16 = B16.encodeBase16 . T.encodeUtf8 {-# INLINE encodeBase16 #-}@@ -41,6 +49,14 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: Text -> Either T.Text Text decodeBase16 = fmap T.decodeLatin1 . B16.decodeBase16 . T.encodeUtf8 {-# INLINE decodeBase16 #-}@@ -51,20 +67,22 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> ----- Example:+-- === __Example__: -- -- @ -- 'decodeBase16With' 'T.decodeUtf8''---   :: 'Text' -> 'Either' ('Base16Error' 'UnicodeException') 'Text'+--   :: 'ByteString' -> 'Either' ('Base16Error' 'UnicodeException') 'Text' -- @ --+-- @since 0.3.0.0+-- decodeBase16With     :: (ByteString -> Either err Text)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')-    -> Text-      -- ^ Input text to decode+    -> ByteString+      -- ^ Input to decode     -> Either (Base16Error err) Text-decodeBase16With f t = case B16.decodeBase16 $ T.encodeUtf8 t of+decodeBase16With f t = case B16.decodeBase16 t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase16With #-}@@ -75,23 +93,25 @@ -- -- N.B.: this is not RFC 4648-compliant. --+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: Text -> Text decodeBase16Lenient = T.decodeLatin1 . B16.decodeBase16Lenient . T.encodeUtf8 {-# INLINE decodeBase16Lenient #-}  -- | Tell whether a 'Text' value is Base16-encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True --@@ -105,17 +125,10 @@ -- only that it conforms to the correct shape. To check whether it is a true -- Base16 encoded 'Text' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
src/Data/Text/Encoding/Base16/Error.hs view
@@ -1,13 +1,15 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base16.Error--- Copyright 	: (c) 2019 Emily Pillmore--- License	: BSD-style+-- Copyright    : (c) 2019 Emily Pillmore+-- License      : BSD-style ----- Maintainer	: Emily Pillmore <emilypi@cohomolo.gy>--- Stability	: Experimental--- Portability	: portable+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable ----- This module contains the error types raised (not as exceptions!)+-- This module contains the error types raised -- in the decoding process. -- module Data.Text.Encoding.Base16.Error@@ -15,8 +17,14 @@ ) 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@@ -29,4 +37,21 @@   | ConversionError e     -- ^ The error associated with the decoding failure     -- as a result of the conversion process-  deriving (Eq, Show)+  deriving+    ( Eq, Show+    , Generic+      -- ^ @since 0.3.0.0+    )++-- |+--+-- @since 0.3.0.0+--+instance Exception e => Exception (Base16Error e)+++-- |+--+-- @since 0.3.0.0+--+instance NFData e => NFData (Base16Error e)
src/Data/Text/Lazy/Encoding/Base16.hs view
@@ -1,15 +1,17 @@+{-# LANGUAGE Safe #-} -- | -- Module       : Data.Text.Encoding.Base16.Lazy--- Copyright 	: (c) 2019 Emily Pillmore--- License	: BSD-style+-- Copyright    : (c) 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 Base16 encoding including--- unpadded and lenient variants for lazy textual values+-- This module contains 'Data.Text.Lazy.Text'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.Text.Lazy.Encoding.Base16 ( encodeBase16@@ -29,10 +31,16 @@ import Data.Text.Lazy (Text) import qualified Data.Text.Lazy.Encoding as TL + -- | Encode a lazy 'Text' value in Base16 with padding. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+-- encodeBase16 :: Text -> Text encodeBase16 = B16L.encodeBase16 . TL.encodeUtf8 {-# INLINE encodeBase16 #-}@@ -41,6 +49,14 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: Text -> Either T.Text Text decodeBase16 = fmap TL.decodeLatin1 . B16L.decodeBase16 . TL.encodeUtf8 {-# INLINE decodeBase16 #-}@@ -51,20 +67,20 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> ----- Example:--- -- @--- 'decodeBase16With' 'T.decodeUtf8''---   :: 'Text' -> 'Either' ('Base16Error' 'UnicodeException') 'Text'+-- 'decodeBase16With' 'TL.decodeUtf8''+--   :: 'ByteString' -> 'Either' ('Base16Error' 'UnicodeException') 'Text' -- @ --+-- @since 0.3.0.0+-- decodeBase16With     :: (ByteString -> Either err Text)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')-    -> Text-      -- ^ Input text to decode+    -> ByteString+      -- ^ Input to decode     -> Either (Base16Error err) Text-decodeBase16With f t = case B16L.decodeBase16 $ TL.encodeUtf8 t of+decodeBase16With f t = case B16L.decodeBase16 t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase16With #-}@@ -78,28 +94,31 @@ -- -- N.B.: this is not RFC 4648-compliant. It may give you garbage if you're not careful! --+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: Text -> Text decodeBase16Lenient = TL.decodeLatin1 . B16L.decodeBase16Lenient . TL.encodeUtf8 {-# INLINE decodeBase16Lenient #-}  -- | Tell whether a lazy 'Text' value is Base16-encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True -- isBase16 :: Text -> Bool isBase16 = B16L.isBase16 . TL.encodeUtf8+ {-# INLINE isBase16 #-}  -- | Tell whether a lazy 'Text' value is a valid Base16 format.@@ -108,17 +127,10 @@ -- only that it conforms to the correct shape. To check whether it is a true -- Base16 encoded 'Text' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
src/Data/Text/Short/Encoding/Base16.hs view
@@ -1,15 +1,17 @@+{-# LANGUAGE Trustworthy #-} -- | -- Module       : Data.Text.Short.Encoding.Base16--- Copyright 	: (c) 2019 Emily Pillmore--- License	: BSD-style+-- Copyright    : (c) 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 Base16 encoding including--- unpadded and lenient variants for text values+-- This module contains 'Data.Text.Short.ShortText'-valued combinators for+-- implementing the RFC 4648 specification of the Base16+-- encoding format. This includes lenient decoding variants, as well as+-- internal and external validation for canonicity. -- module Data.Text.Short.Encoding.Base16 ( encodeBase16@@ -23,10 +25,9 @@  import Data.Bifunctor (first) import qualified Data.ByteString.Base16 as B16-import Data.ByteString.Short (ShortByteString)+import Data.ByteString.Short import qualified Data.ByteString.Short.Base16 as BS16 import Data.Text (Text)-import qualified Data.Text.Encoding.Base16 as B16T import Data.Text.Encoding.Base16.Error import Data.Text.Short import Data.Text.Short.Unsafe@@ -36,65 +37,88 @@ -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> encodeBase16 "Sun"+-- "53756e"+-- encodeBase16 :: ShortText -> ShortText-encodeBase16 = fromByteStringUnsafe . B16.encodeBase16' . toByteString+encodeBase16 = fromShortByteStringUnsafe+  . BS16.encodeBase16'+  . toShortByteString {-# INLINE encodeBase16 #-} --- | Decode a Base16-encoded lazy 'ShortText' value.+-- | Decode a Base16-encoded 'ShortText' value. -- -- See: <https://tools.ietf.org/html/rfc4648#section-8 RFC-4648 section 8> --+-- === __Examples__:+--+-- >>> decodeBase16 "53756e"+-- Right "Sun"+--+-- >>> decodeBase16 "6x"+-- Left "invalid character at offset: 1"+-- decodeBase16 :: ShortText -> Either Text ShortText-decodeBase16 = fmap fromText . B16T.decodeBase16 . toText+decodeBase16 =  fmap fromShortByteStringUnsafe+  . BS16.decodeBase16+  . toShortByteString {-# INLINE decodeBase16 #-} --- | Attempt to decode a lazy 'ShortText' value as Base16, converting from+-- | Attempt to decode a 'ShortText' value as Base16, 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-8 RFC-4648 section 8> ----- Example:+-- === __Example__: -- -- @--- 'decodeBase16With' 'T.decodeUtf8''---   :: 'ShortText' -> 'Either' ('Base16Error' 'UnicodeException') 'ShortText'+-- 'decodeBase16With' (fmap 'fromText' . 'Data.Text.Encoding.decodeUtf8'' . 'fromShort')+--   :: 'ShortByteString' -> 'Either' ('Base16Error' 'UnicodeException') 'ShortText' -- @ --+-- @since 0.3.0.0+-- decodeBase16With     :: (ShortByteString -> Either err ShortText)       -- ^ convert a bytestring to text (e.g. 'T.decodeUtf8'')-    -> ShortText-      -- ^ Input text to decode+    -> ShortByteString+      -- ^ Input to decode     -> Either (Base16Error err) ShortText-decodeBase16With f t = case BS16.decodeBase16 (toShortByteString t) of+decodeBase16With f t = case BS16.decodeBase16 t of   Left de -> Left $ DecodeError de   Right a -> first ConversionError (f a) {-# INLINE decodeBase16With #-} --- | Decode a Base16-encoded lazy 'ShortText' value leniently, using a+-- | Decode a Base16-encoded 'ShortText' value leniently, using a -- strategy that never fails, catching unicode exceptions raised in the -- process of converting to text values. -- -- N.B.: this is not RFC 4648-compliant. --+-- === __Examples__:+--+-- >>> decodeBase16Lenient "53756e"+-- "Sun"+--+-- >>> decodeBase16Lenient "6x6x"+-- "f"+-- decodeBase16Lenient :: ShortText -> ShortText-decodeBase16Lenient = fromText . B16T.decodeBase16Lenient . toText+decodeBase16Lenient = fromShortByteStringUnsafe+  . BS16.decodeBase16Lenient+  . toShortByteString {-# INLINE decodeBase16Lenient #-}  -- | Tell whether a 'ShortText' value is Base16-encoded. ----- Examples:------ This example will fail. It conforms to the alphabet, but--- is not valid because it has an incorrect (odd) length.+-- === __Examples__: -- -- >>> isBase16 "666f6" -- False ----- This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape).--- -- >>> isBase16 "666f" -- True --@@ -108,17 +132,10 @@ -- only that it conforms to the correct shape. To check whether it is a true -- Base16 encoded 'ShortText' value, use 'isBase16'. ----- Examples:------ This example will fail because it does not conform to the Hex--- alphabet.+-- === __Examples__: -- -- >>> isValidBase16 "666f+/6" -- False------ This example will succeed because it satisfies the alphabet--- and is considered "valid" (i.e. of the correct size and shape), but--- is not correct base16 because it is the wrong shape. -- -- >>> isValidBase16 "666f6" -- True
− test/Base16Tests.hs
@@ -1,225 +0,0 @@-{-# LANGUAGE BangPatterns #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE PackageImports #-}-{-# LANGUAGE TypeApplications #-}-module Main-( main-, tests-) where---import Data.Bifunctor-import Data.ByteString (ByteString)-import Data.ByteString.Lazy (fromStrict, toStrict)-import "base16" Data.ByteString.Base16 as B16-import "base16" Data.ByteString.Lazy.Base16 as B16L-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 "Base16 Tests"-    [ testVectors-    , sanityTests-    , alphabetTests-    , lenientTests-    ]--testVectors :: TestTree-testVectors = testGroup "RFC 4648 Test Vectors"-    [ testGroup "strict encode/decode"-      [ testCaseB16 "" ""-      , testCaseB16 "f" "66"-      , testCaseB16 "fo" "666f"-      , testCaseB16 "foo" "666f6f"-      , testCaseB16 "foob" "666f6f62"-      , testCaseB16 "fooba" "666f6f6261"-      , testCaseB16 "foobar" "666f6f626172"-      ]-    , testGroup "lazy encode/decode"-      [ testCaseB16L "" ""-      , testCaseB16L "f" "66"-      , testCaseB16L "fo" "666f"-      , testCaseB16L "foo" "666f6f"-      , testCaseB16L "foob" "666f6f62"-      , testCaseB16L "fooba" "666f6f6261"-      , testCaseB16L "foobar" "666f6f626172"-      ]-    ]-  where-    testCaseB16 s t =-      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do-        let t' = B16.encodeBase16' s-            s' = B16.decodeBase16 t'--        step "compare encoding"-        t @=? t'--        step "compare decoding"-        Right s @=? s'--    testCaseB16L s t =-      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do-        let t' = B16L.encodeBase16' s-            s' = B16L.decodeBase16 t'--        step "compare encoding"-        t @=? t'--        step "compare decoding"-        Right s @=? s'--sanityTests :: TestTree-sanityTests = testGroup "Sanity tests"-    [ testGroup "strict"-      [ testGroup "very large bytestrings don't segfault"-        [ chonk-        ]-      , testGroup "`memory` sanity checks"-        [ compare 3-        , compare 4-        , compare 5-        , compare 6-        , compare 1000-        , compare 100000-        ]-      , testGroup "roundtrip encode/decode"-        [ roundtrip 3-        , roundtrip 4-        , roundtrip 5-        , roundtrip 1000-        , roundtrip 100000-        ]-      ]-    , testGroup "lazy"-      [ testGroup "very large bytestrings don't segfault"-        [ chonkL-        ]-      , testGroup "`memory` sanity checks"-        [ compareL 3-        , compareL 4-        , compareL 5-        , compareL 6-        , compareL 1000-        , compareL 100000-        ]-      , testGroup "roundtrip encode/decode"-        [ roundtripL 3-        , roundtripL 4-        , roundtripL 5-        , roundtripL 1000-        , roundtripL 100000-        ]-      ]-    ]-  where-    chonk = testCase ("Encoding huge bytestrings doesn't result in OOM or segfault") $ do-      bs <- random 1000000-      void $ return $ B16.encodeBase16' bs--    chonkL = testCase ("Encoding huge bytestrings doesn't result in OOM or segfault") $ do-      bs <- fromStrict <$> random 1000000-      void $ return $ B16L.encodeBase16' bs--    compare n = testCase ("Testing " ++ show n ++ "-sized bytestrings") $ do-      bs <- random n-      B16.encodeBase16' bs @=? Mem.convertToBase Mem.Base16 bs--      B16.decodeBase16 (B16.encodeBase16' bs) @=?-        first pack (Mem.convertFromBase @ByteString Mem.Base16 (Mem.convertToBase Mem.Base16 bs))--    compareL n = testCase ("Testing " ++ show n ++ "-sized bytestrings") $ do-      bs <- random n-      B16L.encodeBase16' (fromStrict bs) @=? fromStrict (Mem.convertToBase Mem.Base16 bs)--      B16L.decodeBase16 (B16L.encodeBase16' (fromStrict bs)) @=?-        bimap pack fromStrict (Mem.convertFromBase @ByteString Mem.Base16 (Mem.convertToBase Mem.Base16 bs))--    roundtrip n = testCase ("Roundtrip encode/decode for " ++ show n ++ "-sized bytestrings") $ do-      bs <- random n-      B16.decodeBase16 (B16.encodeBase16' bs) @=? Right bs--    roundtripL n = testCase ("Roundtrip encode/decode for " ++ show n ++ "-sized bytestrings") $ do-      bs <- fromStrict <$> random n-      B16L.decodeBase16 (B16L.encodeBase16' bs) @=? Right bs--alphabetTests :: TestTree-alphabetTests = testGroup "Alphabet tests"-    [ testGroup "Strict"-      [ conforms 0-      , conforms 4-      , conforms 5-      , conforms 6-      , conforms 32-      , conforms 33-      , conforms 1001-      ]-    , testGroup "Lazy"-      [ conformsL 0-      , conformsL 4-      , conformsL 5-      , conformsL 6-      , conformsL 32-      , conformsL 33-      , conformsL 1001-      ]-    ]-  where-    conforms n = testCase ("Conforms to Base16 alphabet: " ++ show n) $ do-      bs <- random n-      let b = B16.encodeBase16' bs-      assertBool ("failed validity: " ++ show b) $ B16.isValidBase16 b-      assertBool ("failed correctness: " ++ show b) $ B16.isBase16 b--    conformsL n = testCase ("Conforms to Base16 alphabet: " ++ show n) $ do-      bs <- fromStrict <$> random n-      let b = B16L.encodeBase16' bs-      assertBool ("failed validity: " ++ show b) $ B16L.isValidBase16 b-      assertBool ("failed correctness: " ++ show b) $ B16L.isBase16 b--lenientTests :: TestTree-lenientTests = testGroup "Lenient Tests"-    [ testGroup "strict encode/lenient decode"-      [ testCaseB16 "" ""-      , testCaseB16 "f" "6+6"-      , testCaseB16 "fo" "6$6+6|f"-      , testCaseB16 "foo" "==========6$$66()*f6f"-      , testCaseB16 "foob" "66^%$&^6f6f62"-      , testCaseB16 "fooba" "666f()*#@6f#)(@*)6()*)2()61"-      , testCaseB16 "foobar" "6@6@6@f@6@f@6@2@6@1@7@2++++++++++++++++++++++++"-      ]-    , testGroup "lazy encode/decode"-      [ testCaseB16L "" ""-      , testCaseB16L "f" "6+++++++____++++++======*%$@#%#^*$^6"-      , testCaseB16L "fo" "6$6+6|f"-      , testCaseB16L "foo" "==========6$$66()*f6f"-      , testCaseB16L "foob" "66^%$&^6f6f62"-      , testCaseB16L "fooba" "666f()*#@6f#)(@*)6()*)2()61"-      , testCaseB16L "foobar" "6@6@6@f@6@f@6@2@6@1@7@2++++++++++++++++++++++++"-      ]-    ]-  where-    testCaseB16 s t =-      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do-        let t0 = B16.decodeBase16 (B16.encodeBase16' s)-            t1 = B16.decodeBase16Lenient t--        step "compare decoding"-        t0 @=? Right t1--    testCaseB16L s t =-      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do-        let t0 = fmap toStrict $ B16L.decodeBase16 (B16L.encodeBase16' s)-            t1 = Right . toStrict $ B16L.decodeBase16Lenient t--        step "compare decoding"-        t0 @=? t1
+ test/Internal.hs view
@@ -0,0 +1,203 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE EmptyDataDecls #-}+{-# LANGUAGE FunctionalDependencies #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PackageImports #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+-- |+-- Module       : Main+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains internal test harnesses for `base16`+--+module Internal where+++import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Short as SBS+import "base16" Data.ByteString.Base16 as B16+import "base16" Data.ByteString.Lazy.Base16 as LB16+import "base16" Data.ByteString.Short.Base16 as SB16+import Data.Proxy+import Data.String+import Data.Text (Text)+import qualified Data.Text as T+import "base16" Data.Text.Encoding.Base16 as T16+import Data.Text.Encoding.Base16.Error (Base16Error(..))+import qualified Data.Text.Lazy as TL+import "base16" Data.Text.Lazy.Encoding.Base16 as TL16+import qualified Data.Text.Short as TS+import "base16" Data.Text.Short.Encoding.Base16 as TS16++import Test.QuickCheck hiding (label)++-- ------------------------------------------------------------------ --+-- Test Harnesses++data Impl+  = B16+  | LB16+  | SB16+  | T16+  | TL16+  | TS16++b16 :: Proxy 'B16+b16 = Proxy++lb16 :: Proxy 'LB16+lb16 = Proxy++sb16 :: Proxy 'SB16+sb16 = Proxy++t16 :: Proxy 'T16+t16 = Proxy++tl16 :: Proxy 'TL16+tl16 = Proxy++ts16 :: Proxy 'TS16+ts16 = Proxy++-- | This class provides the generic API definition for+-- the base16 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+  decode :: bs -> Either Text bs+  lenient :: bs -> bs++  correct :: bs -> Bool+  validate :: bs -> Bool+++instance Harness 'B16 BS.ByteString where+  label = "ByteString"++  encode = B16.encodeBase16'+  decode = B16.decodeBase16+  lenient = B16.decodeBase16Lenient+  correct = B16.isBase16+  validate = B16.isValidBase16++instance Harness 'LB16 LBS.ByteString where+  label = "Lazy ByteString"++  encode = LB16.encodeBase16'+  decode = LB16.decodeBase16+  lenient = LB16.decodeBase16Lenient+  correct = LB16.isBase16+  validate = LB16.isValidBase16++instance Harness 'SB16 SBS.ShortByteString where+  label = "Short ByteString"++  encode = SB16.encodeBase16'+  decode = SB16.decodeBase16+  lenient = SB16.decodeBase16Lenient+  correct = SB16.isBase16+  validate = SB16.isValidBase16++instance Harness 'T16 Text where+  label = "Text"++  encode = T16.encodeBase16+  decode = T16.decodeBase16+  lenient = T16.decodeBase16Lenient+  correct = T16.isBase16+  validate = T16.isValidBase16++instance Harness 'TL16 TL.Text where+  label = "Lazy Text"++  encode = TL16.encodeBase16+  decode = TL16.decodeBase16+  lenient = TL16.decodeBase16Lenient+  correct = TL16.isBase16+  validate = TL16.isValidBase16++instance Harness 'TS16 TS.ShortText where+  label = "Short Text"++  encode = TS16.encodeBase16+  decode = TS16.decodeBase16+  lenient = TS16.decodeBase16Lenient+  correct = TS16.isBase16+  validate = TS16.isValidBase16++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 (Base16Error err) cs++instance TextHarness 'T16 Text BS.ByteString where+  decodeWith_ = T16.decodeBase16With++instance TextHarness 'TL16 TL.Text LBS.ByteString where+  decodeWith_ = TL16.decodeBase16With++instance TextHarness 'TS16 TS.ShortText SBS.ShortByteString where+  decodeWith_ = TS16.decodeBase16With++-- ------------------------------------------------------------------ --+-- 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
+ test/Main.hs view
@@ -0,0 +1,245 @@+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+-- |+-- Module       : Main+-- Copyright    : (c) 2020 Emily Pillmore+-- License      : BSD-style+--+-- Maintainer   : Emily Pillmore <emilypi@cohomolo.gy>+-- Stability    : Experimental+-- Portability  : portable+--+-- This module contains the test implementation for the `base16` package+--+module Main+( main+, tests+) where+++import Data.Bifunctor (second)+import qualified Data.ByteString as BS+import Data.ByteString.Internal (c2w)+import qualified Data.ByteString.Lazy as LBS+import qualified Data.ByteString.Short as SBS+import "base16" Data.ByteString.Base16 as B16+import qualified "base16-bytestring" Data.ByteString.Base16 as Bos+import qualified Data.Text as T+import qualified Data.Text.Encoding as T+import Data.Text.Encoding.Base16.Error (Base16Error(..))+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 "Base16 Tests"+  [ mkTree b16+    [ mkPropTree+    , mkUnitTree+    ]+  , mkTree lb16+    [ mkPropTree+    , mkUnitTree+    ]+  , mkTree sb16+    [ mkPropTree+    , mkUnitTree+    ]+  , mkTree t16+    [ mkPropTree+    , mkUnitTree+    , mkDecodeTree T.decodeUtf8' b16+    ]+  , mkTree tl16+    [ mkPropTree+    , mkUnitTree+    , mkDecodeTree TL.decodeUtf8' lb16+    ]+  , mkTree ts16+    [ mkPropTree+    , mkUnitTree+    , mkDecodeTree+      (second TS.fromText . T.decodeUtf8' . SBS.fromShort) sb16+    ]+  ]++-- ---------------------------------------------------------------- --+-- 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+  , const prop_bos_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+  , lenientTests+  ]++-- | 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_std_lenient_roundtrip" $ \(bs :: b) ->+      encode bs == lenient (encode (encode 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_std_correct" $ \(bs :: b) ->+    correct (encode bs)+  ]++-- | just a sanity check against `base16-bytestring`+--+prop_bos_coherence :: TestTree+prop_bos_coherence = testGroup "prop_bos_coherence"+  [ testProperty "prop_std_bos_coherence" $ \bs ->+      Right bs == B16.decodeBase16 (B16.encodeBase16' bs)+      && Right bs == (Right (fst $ Bos.decode $ Bos.encode bs) :: Either T.Text BS.ByteString)+  ]++-- ---------------------------------------------------------------- --+-- Unit tests++rfcVectors :: forall a b proxy. Harness a b => proxy a -> TestTree+rfcVectors _ = testGroup "RFC 4648 Test Vectors"+    [ testCaseB16 "" ""+    , testCaseB16 "f" "66"+    , testCaseB16 "fo" "666f"+    , testCaseB16 "foo" "666f6f"+    , testCaseB16 "foob" "666f6f62"+    , testCaseB16 "fooba" "666f6f6261"+    , testCaseB16 "foobar" "666f6f626172"+    ]+  where+    testCaseB16 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)++-- | 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"+    ]+  , testGroup "decodeWith positive tests"+    [ testCase "decodeWith utf8 inputs on decodeUtf8" $ do+      a <- either (assertFailure . show) pure $ decode @a "666f6f626172"+      b <- either (assertFailure . show) pure $ decodeWith_ @a utf8 "666f6f626172"+      a @=? b+    ]+  ]++lenientTests :: forall a b proxy. Harness a b => proxy a -> TestTree+lenientTests _ = testGroup "Lenient Tests"+    [ testCaseB16 "" ""+    , testCaseB16 "f" "6+6"+    , testCaseB16 "fo" "6$6+6|f"+    , testCaseB16 "foo" "==========6$$66()*f6f"+    , testCaseB16 "foob" "66^%$&^6f6f62"+    , testCaseB16 "fooba" "666f()*#@6f#)(@*)6()*)2()61"+    , testCaseB16 "foobar" "6@6@6@f@6@f@6@2@6@1@7@2++++++++++++++++++++++++"+    ]+  where+    testCaseB16 s t =+      testCaseSteps (show $ if s == "" then "empty" else s) $ \step -> do+        let t0 = decode (encode @a s)+            t1 = lenient @a t++        step "compare decoding"+        t0 @=? Right t1