diff --git a/base16.cabal b/base16.cabal --- a/base16.cabal +++ b/base16.cabal @@ -1,6 +1,6 @@ cabal-version: 2.0 name: base16 -version: 0.1.2.1 +version: 0.1.3.0 synopsis: RFC 4648-compliant Base16 encodings/decodings description: RFC 4648-compliant Base16 encodings and decodings. @@ -29,10 +29,11 @@ library exposed-modules: Data.ByteString.Base16 + Data.ByteString.Lazy.Base16 Data.Text.Encoding.Base16 + Data.Text.Lazy.Encoding.Base16 other-modules: - Data.ByteString.Base16.Internal Data.ByteString.Base16.Internal.Head Data.ByteString.Base16.Internal.Tables Data.ByteString.Base16.Internal.Utils diff --git a/benchmarks/Base16Bench.hs b/benchmarks/Base16Bench.hs --- a/benchmarks/Base16Bench.hs +++ b/benchmarks/Base16Bench.hs @@ -7,80 +7,81 @@ import Criterion import Criterion.Main +import Data.ByteString.Lazy (fromStrict) import "memory" Data.ByteArray.Encoding as Mem import Data.ByteString -import "base16" Data.ByteString.Base16 as B16 -import "base16-bytestring" Data.ByteString.Base16 as Bos +import "base16" Data.ByteString.Lazy.Base16 as B16 +import "base16-bytestring" Data.ByteString.Base16.Lazy as Bos import Data.ByteString.Random (random) main :: IO () main = defaultMain - [ env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) -> + [ 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-bytestring" $ whnf Bos.encode bs25 - , bench "base16" $ whnf B16.encodeBase16' bs25 + , bench "base16-bytestring" $ whnf Bos.encode bs25L + , bench "base16" $ whnf B16.encodeBase16' bs25L ] , bgroup "100" [ bench "memory" $ whnf ctob bs100 - , bench "base16-bytestring" $ whnf Bos.encode bs100 - , bench "base16" $ whnf B16.encodeBase16' bs100 + , bench "base16-bytestring" $ whnf Bos.encode bs100L + , bench "base16" $ whnf B16.encodeBase16' bs100L ] , bgroup "1k" [ bench "memory" $ whnf ctob bs1k - , bench "base16-bytestring" $ whnf Bos.encode bs1k - , bench "base16" $ whnf B16.encodeBase16' bs1k + , bench "base16-bytestring" $ whnf Bos.encode bs1kL + , bench "base16" $ whnf B16.encodeBase16' bs1kL ] , bgroup "10k" [ bench "memory" $ whnf ctob bs10k - , bench "base16-bytestring" $ whnf Bos.encode bs10k - , bench "base16" $ whnf B16.encodeBase16' bs10k + , bench "base16-bytestring" $ whnf Bos.encode bs10kL + , bench "base16" $ whnf B16.encodeBase16' bs10kL ] , bgroup "100k" [ bench "memory" $ whnf ctob bs100k - , bench "base16-bytestring" $ whnf Bos.encode bs100k - , bench "base16" $ whnf B16.encodeBase16' bs100k + , bench "base16-bytestring" $ whnf Bos.encode bs100kL + , bench "base16" $ whnf B16.encodeBase16' bs100kL ] , bgroup "1mm" [ bench "memory" $ whnf ctob bs1mm - , bench "base16-bytestring" $ whnf Bos.encode bs1mm - , bench "base16" $ whnf B16.encodeBase16' bs1mm + , bench "base16-bytestring" $ whnf Bos.encode bs1mmL + , bench "base16" $ whnf B16.encodeBase16' bs1mmL ] ] - , env bs $ \ ~(bs25,bs100,bs1k,bs10k,bs100k,bs1mm) -> + , 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-bytestring" $ whnf Bos.decode bs25 - , bench "base16" $ whnf B16.decodeBase16 bs25 + , bench "base16-bytestring" $ whnf Bos.decode bs25L + , bench "base16" $ whnf B16.decodeBase16 bs25L ] , bgroup "100" [ bench "memory" $ whnf cfob bs100 - , bench "base16-bytestring" $ whnf Bos.decode bs100 - , bench "base16" $ whnf B16.decodeBase16 bs100 + , bench "base16-bytestring" $ whnf Bos.decode bs100L + , bench "base16" $ whnf B16.decodeBase16 bs100L ] , bgroup "1k" [ bench "memory" $ whnf cfob bs1k - , bench "base16-bytestring" $ whnf Bos.decode bs1k - , bench "base16" $ whnf B16.decodeBase16 bs1k + , bench "base16-bytestring" $ whnf Bos.decode bs1kL + , bench "base16" $ whnf B16.decodeBase16 bs1kL ] , bgroup "10k" [ bench "memory" $ whnf cfob bs10k - , bench "base16-bytestring" $ whnf Bos.decode bs10k - , bench "base16" $ whnf B16.decodeBase16 bs10k + , bench "base16-bytestring" $ whnf Bos.decode bs10kL + , bench "base16" $ whnf B16.decodeBase16 bs10kL ] , bgroup "100k" [ bench "memory" $ whnf cfob bs100k - , bench "base16-bytestring" $ whnf Bos.decode bs100k - , bench "base16" $ whnf B16.decodeBase16 bs100k + , bench "base16-bytestring" $ whnf Bos.decode bs100kL + , bench "base16" $ whnf B16.decodeBase16 bs100kL ] , bgroup "1mm" [ bench "memory" $ whnf cfob bs1mm - , bench "base16-bytestring" $ whnf Bos.decode bs1mm - , bench "base16" $ whnf B16.decodeBase16 bs1mm + , bench "base16-bytestring" $ whnf Bos.decode bs1mmL + , bench "base16" $ whnf B16.decodeBase16 bs1mmL ] ] ] @@ -98,4 +99,13 @@ d <- random 10000 e <- random 100000 f <- random 1000000 - return (a,b,c,d,e,f) + return ((a,b,c,d,e,f),(fromStrict a,fromStrict b,fromStrict c,fromStrict d,fromStrict e,fromStrict 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)) diff --git a/src/Data/ByteString/Base16.hs b/src/Data/ByteString/Base16.hs --- a/src/Data/ByteString/Base16.hs +++ b/src/Data/ByteString/Base16.hs @@ -12,7 +12,7 @@ -- -- This module contains the combinators implementing the -- RFC 4648 specification for the Base16 encoding including --- unpadded and lenient variants +-- unpadded and lenient variants for bytestrings -- module Data.ByteString.Base16 ( encodeBase16 @@ -23,8 +23,9 @@ ) where -import Data.ByteString (ByteString) -import Data.ByteString.Base16.Internal +import Prelude hiding (all, elem) + +import Data.ByteString (ByteString, all, elem) import Data.ByteString.Base16.Internal.Head import Data.Either import Data.Text (Text) @@ -57,6 +58,20 @@ -- | 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. +-- +-- >>> 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 :: ByteString -> Bool isBase16 bs = isValidBase16 bs && isRight (decodeBase16 bs) {-# INLINE isBase16 #-} @@ -64,9 +79,24 @@ -- | Tell whether a 'ByteString' value is a valid Base16 format. -- -- This will not tell you whether or not this is a correct Base16 representation, --- only that it conforms to the correct shape. To check whether it is a true +-- 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. +-- +-- >>> 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 +-- isValidBase16 :: ByteString -> Bool -isValidBase16 = validateBase16 "0123456789abcdef" +isValidBase16 = all (flip elem "0123456789abcdef") {-# INLINE isValidBase16 #-} diff --git a/src/Data/ByteString/Base16/Internal.hs b/src/Data/ByteString/Base16/Internal.hs deleted file mode 100644 --- a/src/Data/ByteString/Base16/Internal.hs +++ /dev/null @@ -1,46 +0,0 @@ -{-# LANGUAGE BangPatterns #-} -{-# LANGUAGE CPP #-} -{-# LANGUAGE MagicHash #-} -{-# LANGUAGE MultiWayIf #-} -{-# LANGUAGE OverloadedStrings #-} -{-# LANGUAGE TypeApplications #-} --- | --- Module : Data.ByteString.Base16.Internal --- Copyright : (c) 2020 Emily Pillmore --- License : BSD-style --- --- Maintainer : Emily Pillmore --- Stability : Experimental --- Portability : portable --- --- Internal module defining the encoding and decoding --- processes and tables. --- -module Data.ByteString.Base16.Internal -( validateBase16 -) where - - -import qualified Data.ByteString as BS -import Data.ByteString.Internal - -import Foreign.ForeignPtr -import Foreign.Ptr -import Foreign.Storable - --- -------------------------------------------------------------------------- -- --- Validating Base16 - -validateBase16 :: ByteString -> ByteString -> Bool -validateBase16 !alphabet (PS fp off l) = - accursedUnutterablePerformIO $ withForeignPtr fp $ \p -> - go (plusPtr p off) (plusPtr p (l + off)) - where - go !p !end - | p == end = return True - | otherwise = do - w <- peek p - if BS.elem w alphabet - then go (plusPtr p 1) end - else return False -{-# INLINE validateBase16 #-} diff --git a/src/Data/ByteString/Base16/Internal/W32/Loop.hs b/src/Data/ByteString/Base16/Internal/W32/Loop.hs --- a/src/Data/ByteString/Base16/Internal/W32/Loop.hs +++ b/src/Data/ByteString/Base16/Internal/W32/Loop.hs @@ -118,8 +118,9 @@ ++ show (src `minusPtr` sptr) else do poke @Word8 dst (a .|. b) - go (plusPtr dst 1) (plusPtr src 2) (n + 1) + return (Right (PS dfp 0 (n + 1))) + go !dst !src !n | plusPtr src 3 >= end = tailRound16 (castPtr dst) (castPtr src) n | otherwise = do @@ -148,3 +149,4 @@ | otherwise -> do poke @Word16 dst zz go (plusPtr dst 2) (plusPtr src 4) (n + 2) +{-# INLINE decodeLoop #-} diff --git a/src/Data/ByteString/Base16/Internal/W64/Loop.hs b/src/Data/ByteString/Base16/Internal/W64/Loop.hs --- a/src/Data/ByteString/Base16/Internal/W64/Loop.hs +++ b/src/Data/ByteString/Base16/Internal/W64/Loop.hs @@ -160,7 +160,7 @@ | b == 0xff -> err (plusPtr src 1) | otherwise -> do poke dst (a .|. b) - go (plusPtr dst 1) (plusPtr src 2) (n + 1) + return (Right (PS dfp 0 (n + 1))) tailRound32 !dst !src !n | plusPtr src 3 >= end = tailRound16 (castPtr dst) (castPtr src) n @@ -190,7 +190,7 @@ | d == 0xff -> err (plusPtr src 3) | otherwise -> do poke @Word16 dst zz - go (plusPtr dst 2) (plusPtr src 4) (n + 2) + tailRound16 (plusPtr dst 2) (plusPtr src 4) (n + 2) go !dst !src !n | plusPtr src 7 >= end = tailRound32 (castPtr dst) (castPtr src) n @@ -235,3 +235,4 @@ | otherwise -> do poke @Word32 dst zz go (plusPtr dst 4) (plusPtr src 8) (n + 4) +{-# INLINE decodeLoop #-} diff --git a/src/Data/ByteString/Lazy/Base16.hs b/src/Data/ByteString/Lazy/Base16.hs new file mode 100644 --- /dev/null +++ b/src/Data/ByteString/Lazy/Base16.hs @@ -0,0 +1,104 @@ +{-# LANGUAGE OverloadedStrings #-} +-- | +-- Module : Data.ByteString.Base16.Lazy +-- Copyright : (c) 2020 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : portable +-- +-- This module contains the combinators implementing the +-- RFC 4648 specification for the Base16 encoding including +-- unpadded and lenient variants for lazy bytestrings +-- +module Data.ByteString.Lazy.Base16 +( encodeBase16 +, encodeBase16' +, decodeBase16 +, isBase16 +, isValidBase16 +) where + + +import Prelude hiding (all, elem) + +import Data.ByteString.Lazy (all, elem) +import Data.ByteString.Lazy.Internal (ByteString(..)) +import qualified Data.ByteString.Base16.Internal.Head as B16 +import Data.Either +import qualified Data.Text as T +import Data.Text.Lazy (Text) +import qualified Data.Text.Lazy.Encoding as TL + + +-- | Encode a lazy 'ByteString' value as Base16 'Text' with padding. +-- +-- See: +-- +encodeBase16 :: ByteString -> Text +encodeBase16 = TL.decodeUtf8 . encodeBase16' +{-# INLINE encodeBase16 #-} + +-- | Encode a lazy 'ByteString' value as a Base16 'ByteString' value with padding. +-- +-- See: +-- +encodeBase16' :: ByteString -> ByteString +encodeBase16' Empty = Empty +encodeBase16' (Chunk b bs) = Chunk (B16.encodeBase16_ b) (encodeBase16' bs) +{-# INLINE encodeBase16' #-} + +-- | Decode a padded Base16-encoded lazy 'ByteString' value. +-- +-- See: +-- +decodeBase16 :: ByteString -> Either T.Text ByteString +decodeBase16 Empty = Right Empty +decodeBase16 (Chunk b bs) = Chunk <$> B16.decodeBase16_ b <*> decodeBase16 bs +{-# INLINE decodeBase16 #-} + +-- | 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. +-- +-- >>> 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 :: ByteString -> Bool +isBase16 bs = isValidBase16 bs && isRight (decodeBase16 bs) +{-# INLINE isBase16 #-} + +-- | Tell whether a lazy 'ByteString' value is a valid Base16 format. +-- +-- This will not tell you whether or not this is a correct Base16 representation, +-- 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. +-- +-- >>> 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 +-- +isValidBase16 :: ByteString -> Bool +isValidBase16 = all (flip elem "0123456789abcdef") +{-# INLINE isValidBase16 #-} diff --git a/src/Data/Text/Encoding/Base16.hs b/src/Data/Text/Encoding/Base16.hs --- a/src/Data/Text/Encoding/Base16.hs +++ b/src/Data/Text/Encoding/Base16.hs @@ -9,7 +9,7 @@ -- -- This module contains the combinators implementing the -- RFC 4648 specification for the Base16 encoding including --- unpadded and lenient variants +-- unpadded and lenient variants for text values -- module Data.Text.Encoding.Base16 ( encodeBase16 @@ -42,6 +42,20 @@ -- | 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. +-- +-- >>> 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 = B16.isBase16 . T.encodeUtf8 {-# INLINE isBase16 #-} @@ -51,6 +65,21 @@ -- This will not tell you whether or not this is a correct Base16 representation, -- 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. +-- +-- >>> 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 -- isValidBase16 :: Text -> Bool isValidBase16 = B16.isValidBase16 . T.encodeUtf8 diff --git a/src/Data/Text/Lazy/Encoding/Base16.hs b/src/Data/Text/Lazy/Encoding/Base16.hs new file mode 100644 --- /dev/null +++ b/src/Data/Text/Lazy/Encoding/Base16.hs @@ -0,0 +1,87 @@ +-- | +-- Module : Data.Text.Encoding.Base16.Lazy +-- Copyright : (c) 2019 Emily Pillmore +-- License : BSD-style +-- +-- Maintainer : Emily Pillmore +-- Stability : Experimental +-- Portability : portable +-- +-- This module contains the combinators implementing the +-- RFC 4648 specification for the Base16 encoding including +-- unpadded and lenient variants for lazy textual values +-- +module Data.Text.Lazy.Encoding.Base16 +( encodeBase16 +, decodeBase16 +, isBase16 +, isValidBase16 +) where + + +import qualified Data.ByteString.Lazy.Base16 as B16L + +import qualified Data.Text as T +import Data.Text.Lazy (Text) +import qualified Data.Text.Lazy.Encoding as TL + +-- | Encode a lazy 'Text' value in Base16 with padding. +-- +-- See: +-- +encodeBase16 :: Text -> Text +encodeBase16 = B16L.encodeBase16 . TL.encodeUtf8 +{-# INLINE encodeBase16 #-} + +-- | Decode a padded Base16-encoded lazy 'Text' value +-- +-- See: +-- +decodeBase16 :: Text -> Either T.Text Text +decodeBase16 = fmap TL.decodeUtf8 . B16L.decodeBase16 . TL.encodeUtf8 +{-# INLINE decodeBase16 #-} + +-- | 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. +-- +-- >>> 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. +-- +-- This will not tell you whether or not this is a correct Base16 representation, +-- 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. +-- +-- >>> 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 +-- +isValidBase16 :: Text -> Bool +isValidBase16 = B16L.isValidBase16 . TL.encodeUtf8 +{-# INLINE isValidBase16 #-} diff --git a/test/Base16Tests.hs b/test/Base16Tests.hs --- a/test/Base16Tests.hs +++ b/test/Base16Tests.hs @@ -9,7 +9,9 @@ import Data.Bifunctor import Data.ByteString (ByteString) +import Data.ByteString.Lazy (fromStrict) 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) @@ -32,7 +34,7 @@ testVectors :: TestTree testVectors = testGroup "RFC 4648 Test Vectors" - [ testGroup "encode/decode" + [ testGroup "strict encode/decode" [ testCaseB16 "" "" , testCaseB16 "f" "66" , testCaseB16 "fo" "666f" @@ -41,6 +43,15 @@ , 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 = @@ -54,53 +65,115 @@ 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 "very large bytestrings don't segfault" + [ testGroup "strict" + [ 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 "`memory` sanity checks" + [ compare 3 + , compare 4 + , compare 5 + , compare 6 + , compare 1000 + , compare 100000 ] - , testGroup "roundtrip encode/decode" + , 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 - compare32 n = testCase ("Testing " ++ show n ++ "-sized bytestrings") $ do + 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" - [ base16Tests 0 - , base16Tests 4 - , base16Tests 5 - , base16Tests 6 + [ testGroup "Strict" + [ conforms 0 + , conforms 4 + , conforms 5 + , conforms 6 + ] + , testGroup "Lazy" + [ conformsL 0 + , conformsL 4 + , conformsL 5 + , conformsL 6 + ] ] where - base16Tests n = testCase ("Conforms to Base16 alphabet: " ++ show n) $ do + 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