base16-bytestring-1.0.2.0/0000755000000000000000000000000007346545000013312 5ustar0000000000000000base16-bytestring-1.0.2.0/CHANGELOG.md0000644000000000000000000000247307346545000015131 0ustar0000000000000000# 1.0.2.0 * Support sized primitive types in GHC 9.2 ([#16](https://github.com/haskell/base16-bytestring/pull/16) - thanks Bodigrim!) # 1.0.1.0 * Backwards-compatible support for `bytestring ^>= 0.11` ([#15](https://github.com/haskell/base16-bytestring/pull/15)) # 1.0.0.0 * Merged omnibus PR doing a variety of things in ([#10](https://github.com/haskell/base16-bytestring/pull/10)): - Improves performance by 3-4x for encode, 4-5x for decode. - The `decode` signature returning the tuple and actually returns an error message with offset. The signature will now be `ByteString -> Either String ByteString`. - Actually tests using the test vectors defined in the RFC, and uses property tests to ensure invariants hold. - Adds lenient decoders to the API - Adds `-XTrustworthy` annotations to the relevant exposed modules - Rewrites the haddocks to be more up to date and fancy-styled. - Adds benchmarks to the `.cabal` file so they can be run at toplevel, and make them better. - Bumps the Cabal version to 1.12 Because of the breadth of this change, we are calling this a new epoch for the `base16-bytestring` library. Hence, the version `1.0.0.0`. # 0.1.1.7 * Fix some bugs in lazy decoding ([#8](https://github.com/haskell/base16-bytestring/pull/8)). # 0.1.1.6 * Changelog not recorded up to this version. base16-bytestring-1.0.2.0/Data/ByteString/0000755000000000000000000000000007346545000016255 5ustar0000000000000000base16-bytestring-1.0.2.0/Data/ByteString/Base16.hs0000644000000000000000000000617007346545000017636 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- | -- Module : Data.ByteString.Base16 -- Copyright : (c) 2011 MailRank, Inc. -- -- License : BSD -- Maintainer : Herbert Valerio Riedel , -- Mikhail Glushenkov , -- Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- RFC 4648-compliant Base16 (Hexadecimal) encoding for 'ByteString' values. -- For a complete Base16 encoding specification, please see . -- module Data.ByteString.Base16 ( encode , decode , decodeLenient ) where import Data.ByteString (empty) import Data.ByteString.Base16.Internal (encodeLoop, decodeLoop, lenientLoop, mkBS, withBS) import Data.ByteString.Internal (ByteString) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Ptr (plusPtr) import GHC.ForeignPtr (mallocPlainForeignPtrBytes) -- | Encode a 'ByteString' value in base16 (i.e. hexadecimal). -- Encoded values will always have a length that is a multiple of 2. -- -- === __Examples__: -- -- > encode "foo" == "666f6f" -- encode :: ByteString -> ByteString encode bs = withBS bs go where go !sptr !slen | slen > maxBound `div` 2 = error "Data.ByteString.Base16.encode: input too long" | otherwise = do let l = slen * 2 dfp <- mallocPlainForeignPtrBytes l withForeignPtr dfp $ \dptr -> encodeLoop dptr sptr (sptr `plusPtr` slen) return $ mkBS dfp l -- | Decode a base16-encoded 'ByteString' value. -- If errors are encountered during the decoding process, -- then an error message and character offset will be returned in -- the @Left@ clause of the coproduct. -- -- === __Examples__: -- -- > decode "666f6f" == Right "foo" -- > decode "66quux" == Left "invalid character at offset: 2" -- > decode "666quux" == Left "invalid character at offset: 3" -- -- @since 1.0.0.0 -- decode :: ByteString -> Either String ByteString decode bs = withBS bs go where go !sptr !slen | slen == 0 = return $ Right empty | r /= 0 = return $ Left "invalid bytestring size" | otherwise = do dfp <- mallocPlainForeignPtrBytes q withForeignPtr dfp $ \dptr -> decodeLoop dfp dptr sptr (plusPtr sptr slen) where !q = slen `quot` 2 !r = slen `rem` 2 -- | Decode a Base16-encoded 'ByteString' value leniently, using a -- strategy that never fails. -- -- /N.B./: this is not RFC 4648-compliant -- -- === __Examples__: -- -- > decodeLenient "666f6f" == "foo" -- > decodeLenient "66quuxx" == "f" -- > decodeLenient "666quux" == "f" -- > decodeLenient "666fquu" -- "fo" -- -- @since 1.0.0.0 -- decodeLenient :: ByteString -> ByteString decodeLenient bs = withBS bs go where go !sptr !slen | slen == 0 = return empty | otherwise = do dfp <- mallocPlainForeignPtrBytes (q * 2) withForeignPtr dfp $ \dptr -> lenientLoop dfp dptr sptr (plusPtr sptr slen) where !q = slen `quot` 2 base16-bytestring-1.0.2.0/Data/ByteString/Base16/0000755000000000000000000000000007346545000017276 5ustar0000000000000000base16-bytestring-1.0.2.0/Data/ByteString/Base16/Internal.hs0000644000000000000000000002004307346545000021405 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE MagicHash #-} module Data.ByteString.Base16.Internal ( -- * worker loops encodeLoop , decodeLoop , lenientLoop -- * utils , c2w , aix , reChunk , withBS , mkBS ) where import Data.Bits ((.&.), (.|.), unsafeShiftR) import qualified Data.ByteString as B import Data.ByteString.Internal (ByteString(..)) import Data.Char (ord) import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) import Foreign.Ptr (Ptr, minusPtr, plusPtr) import Foreign.Storable (Storable(poke, peek)) import GHC.Word (Word8(..)) import GHC.Exts (Int(I#), Addr#, indexWord8OffAddr#) #if __GLASGOW_HASKELL__ >= 702 import System.IO.Unsafe (unsafeDupablePerformIO) #else import GHC.IO (unsafeDupablePerformIO) #endif -- ------------------------------------------------------------------ -- -- Loops encodeLoop :: Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO () encodeLoop !dptr !sptr !end = go dptr sptr where !hex = "0123456789abcdef"# go !dst !src | src == end = return () | otherwise = do !t <- peek src poke dst (aix (unsafeShiftR t 4) hex) poke (plusPtr dst 1) (aix (t .&. 0x0f) hex) go (plusPtr dst 2) (plusPtr src 1) {-# INLINE encodeLoop #-} decodeLoop :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO (Either String ByteString) decodeLoop !dfp !dptr !sptr !end = go dptr sptr where err !src = return . Left $ "invalid character at offset: " ++ show (src `minusPtr` sptr) !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 !dst !src | src == end = return (Right (mkBS dfp (dst `minusPtr` dptr))) | otherwise = do !x <- peek src !y <- peek (plusPtr src 1) let !a = aix x hi !b = aix y lo if a == 0xff then err src else if b == 0xff then err (plusPtr src 1) else do poke dst (a .|. b) go (plusPtr dst 1) (plusPtr src 2) {-# INLINE decodeLoop #-} lenientLoop :: ForeignPtr Word8 -> Ptr Word8 -> Ptr Word8 -> Ptr Word8 -> IO ByteString lenientLoop !dfp !dptr !sptr !end = goHi dptr sptr 0 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 !dst !src !n | src == end = return (mkBS dfp n) | otherwise = do !x <- peek src let !a = aix x hi if a == 0xff then goHi dst (plusPtr src 1) n else goLo dst (plusPtr src 1) a n goLo !dst !src !a !n | src == end = return (mkBS dfp n) | otherwise = do !y <- peek src let !b = aix y lo if b == 0xff then goLo dst (plusPtr src 1) a n else do poke dst (a .|. b) goHi (plusPtr dst 1) (plusPtr src 1) (n + 1) {-# INLINE lenientLoop #-} -- ------------------------------------------------------------------ -- -- Utils aix :: Word8 -> Addr# -> Word8 aix w table = W8# (indexWord8OffAddr# table i) where !(I# i) = fromIntegral w {-# INLINE aix #-} -- | Form a list of chunks, and rechunk the list of bytestrings -- into length multiples of 2 -- reChunk :: [ByteString] -> [ByteString] reChunk [] = [] reChunk (c:cs) = case B.length c `divMod` 2 of (_, 0) -> c : reChunk cs (n, _) -> case B.splitAt (n * 2) c of ~(m, q) -> m : cont_ q cs where cont_ q [] = [q] cont_ q (a:as) = case B.splitAt 1 a of ~(x, y) -> let q' = B.append q x in if B.length q' == 2 then let as' = if B.null y then as else y:as in q' : reChunk as' else cont_ q' as c2w :: Char -> Word8 c2w = fromIntegral . ord {-# INLINE c2w #-} mkBS :: ForeignPtr Word8 -> Int -> ByteString #if MIN_VERSION_bytestring(0,11,0) mkBS dfp n = BS dfp n #else mkBS dfp n = PS dfp 0 n #endif {-# INLINE mkBS #-} withBS :: ByteString -> (Ptr Word8 -> Int -> IO a) -> a #if MIN_VERSION_bytestring(0,11,0) withBS (BS !sfp !slen) f = unsafeDupablePerformIO $ withForeignPtr sfp $ \p -> f p slen #else withBS (PS !sfp !soff !slen) f = unsafeDupablePerformIO $ withForeignPtr sfp $ \p -> f (plusPtr p soff) slen #endif {-# INLINE withBS #-} base16-bytestring-1.0.2.0/Data/ByteString/Base16/Lazy.hs0000644000000000000000000000467507346545000020565 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif -- | -- Module : Data.ByteString.Base16.Lazy -- Copyright : (c) 2011 MailRank, Inc. -- -- License : BSD -- Maintainer : Herbert Valerio Riedel , -- Mikhail Glushenkov , -- Emily Pillmore -- Stability : stable -- Portability : non-portable -- -- RFC 4648-compliant Base16 (Hexadecimal) encoding for lazy 'ByteString' values. -- For a complete Base16 encoding specification, please see . -- module Data.ByteString.Base16.Lazy ( encode , decode , decodeLenient ) where import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Base16 as B16 import Data.ByteString.Base16.Internal import Data.ByteString.Lazy.Internal (ByteString(..)) -- | Encode a 'ByteString' value in base16 (i.e. hexadecimal). -- Encoded values will always have a length that is a multiple of 2. -- -- -- === __Examples__: -- -- > encode "foo" == "666f6f" -- encode :: ByteString -> ByteString encode Empty = Empty encode (Chunk c cs) = Chunk (B16.encode c) (encode cs) -- | Decode a base16-encoded 'ByteString' value. -- If errors are encountered during the decoding process, -- then an error message and character offset will be returned in -- the @Left@ clause of the coproduct. -- -- === __Examples__: -- -- > decode "666f6f" == Right "foo" -- > decode "66quux" == Left "invalid character at offset: 2" -- > decode "666quu" == Left "invalid character at offset: 3" -- -- @since 1.0.0.0 -- decode :: ByteString -> Either String ByteString decode = f . B16.decode . BS.concat . LBS.toChunks where f (Left t) = Left t f (Right bs') = Right (LBS.fromChunks [bs']) -- | Decode a Base16-encoded 'ByteString' value leniently, using a -- strategy that never fails. -- -- /N.B./: this is not RFC 4648-compliant -- -- === __Examples__: -- -- > decodeLenient "666f6f" == "foo" -- > decodeLenient "66quux" == "f" -- > decodeLenient "666quu" == "f" -- > decodeLenient "666fqu" == "fo" -- -- @since 1.0.0.0 -- decodeLenient :: ByteString -> ByteString decodeLenient = LBS.fromChunks . fmap B16.decodeLenient . reChunk . fmap (BS.filter (flip BS.elem extendedHex)) . LBS.toChunks where extendedHex = BS.pack (fmap c2w "0123456789abcdefABCDEF") base16-bytestring-1.0.2.0/LICENSE0000644000000000000000000000266607346545000014331 0ustar0000000000000000Copyright (c) 2011 MailRank, Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. base16-bytestring-1.0.2.0/README.md0000644000000000000000000000235207346545000014573 0ustar0000000000000000# Fast base16 support [![Hackage version](https://img.shields.io/hackage/v/base16-bytestring.svg?label=Hackage)](https://hackage.haskell.org/package/base16-bytestring) [![Stackage version](https://www.stackage.org/package/base16-bytestring/badge/lts?label=Stackage)](https://www.stackage.org/package/base16-bytestring) [![Build Status](https://secure.travis-ci.org/haskell/base16-bytestring.svg?branch=master)](http://travis-ci.org/haskell/base16-bytestring) **Please refer to the [package description on Hackage](https://hackage.haskell.org/package/base16-bytestring#description) for more information.** This package provides a Haskell library for working with base16-encoded data quickly and efficiently, using the `ByteString` type. # Get involved! Please report bugs via the [GitHub issue tracker](http://github.com/haskell/base16-bytestring). Master [Git repository](http://github.com/haskell/base16-bytestring): * `git clone git://github.com/haskell/base16-bytestring.git` # Authors This library is written by [Bryan O'Sullivan](mailto:bos@serpentine.com). It is currently maintained by [Emily Pillmore](mailto:emilypi@cohomolo.gy), [Herbert Valerio Riedel](mailto:hvr@gnu.org) and [Mikhail Glushenkov](mailto:mikhail.glushenkov@gmail.com). base16-bytestring-1.0.2.0/Setup.hs0000644000000000000000000000005607346545000014747 0ustar0000000000000000import Distribution.Simple main = defaultMain base16-bytestring-1.0.2.0/base16-bytestring.cabal0000644000000000000000000000475507346545000017562 0ustar0000000000000000cabal-version: 1.12 name: base16-bytestring version: 1.0.2.0 synopsis: RFC 4648-compliant Base16 encodings for ByteStrings description: This package provides support for encoding and decoding binary data according to @base16@ (see also ) for strict (see "Data.ByteString.Base16") and lazy @ByteString@s (see "Data.ByteString.Base16.Lazy"). . See the package which provides superior encoding and decoding performance as well as support for lazy, short, and strict variants of 'Text' and 'ByteString' values. Additionally, see the package which provides an uniform API providing conversion paths between more binary and textual types. homepage: http://github.com/haskell/base16-bytestring bug-reports: http://github.com/haskell/base16-bytestring/issues license: BSD3 license-file: LICENSE copyright: Copyright 2011 MailRank, Inc.; Copyright 2010-2020 Bryan O'Sullivan et al. author: Bryan O'Sullivan maintainer: Herbert Valerio Riedel , Mikhail Glushenkov , Emily Pillmore category: Data build-type: Simple extra-source-files: README.md CHANGELOG.md tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.4 || ==9.0.1 source-repository head type: git location: http://github.com/haskell/base16-bytestring library other-modules: Data.ByteString.Base16.Internal exposed-modules: Data.ByteString.Base16 Data.ByteString.Base16.Lazy build-depends: base >=4.9 && <5 , bytestring >=0.9 && <0.12 ghc-options: -Wall -funbox-strict-fields default-language: Haskell2010 test-suite test type: exitcode-stdio-1.0 hs-source-dirs: tests main-is: Tests.hs build-depends: base , base16-bytestring , bytestring , HUnit , QuickCheck , test-framework , test-framework-hunit , test-framework-quickcheck2 default-language: Haskell2010 benchmark bench type: exitcode-stdio-1.0 hs-source-dirs: benchmarks main-is: Benchmarks.hs build-depends: base >=4 && <5 , base16-bytestring , bytestring , criterion , deepseq default-language: Haskell2010 base16-bytestring-1.0.2.0/benchmarks/0000755000000000000000000000000007346545000015427 5ustar0000000000000000base16-bytestring-1.0.2.0/benchmarks/Benchmarks.hs0000644000000000000000000000226407346545000020044 0ustar0000000000000000module Main ( main ) where import Criterion import Criterion.Main import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString as B generate :: Int -> B.ByteString generate n = B.pack . take n . cycle $ [0..255] main = defaultMain [ case bs of ~(a,b,c,d,e) -> bgroup "encode" [ bench "25" $ whnf B16.encode a , bench "100" $ whnf B16.encode b , bench "1000" $ whnf B16.encode c , bench "10000" $ whnf B16.encode d , bench "100000" $ whnf B16.encode e ] , case bs of ~(a,b,c,d,e) -> bgroup "decode" [ bench "25" $ whnf B16.decode a , bench "100" $ whnf B16.decode b , bench "1000" $ whnf B16.decode c , bench "10000" $ whnf B16.decode d , bench "100000" $ whnf B16.decode e ] ] where bs = let a = generate 25 b = generate 100 c = generate 1000 d = generate 10000 e = generate 100000 in (a,b,c,d,e) bs' = let a = generate 25 b = generate 100 c = generate 1000 d = generate 10000 e = generate 100000 f = B16.encode in (f a, f b, f c, f d, f e) base16-bytestring-1.0.2.0/tests/0000755000000000000000000000000007346545000014454 5ustar0000000000000000base16-bytestring-1.0.2.0/tests/Tests.hs0000644000000000000000000000721707346545000016121 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} module Main ( main ) where import Control.Monad (liftM) import qualified Data.ByteString as BS import Data.ByteString.Internal (c2w, w2c) import Data.ByteString.Char8 () import qualified Data.ByteString.Base16 as B16 import qualified Data.ByteString.Base16.Lazy as LB16 import qualified Data.ByteString.Lazy as LBS import Data.ByteString.Lazy.Char8 () import Data.Char (toUpper) import Data.String import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.Framework.Providers.HUnit (testCase) import Test.HUnit hiding (Test) import Test.QuickCheck (Arbitrary(..)) main :: IO () main = defaultMain tests tests = [ testGroup "property tests" [ properties b16 , properties lb16 ] , testGroup "unit tests" [ units b16 , units lb16 , lenientUnits b16 , lenientUnits lb16 ] ] properties :: ( IsString bs , Show bs , Eq bs , Arbitrary bs ) => Impl bs -> Test properties (Impl label e d l _ u) = testGroup label [ testProperty "decode-encode-lower" $ \a -> Right a == d (e a) , testProperty "decode-encode-upper" $ \a -> Right a == d (u . e $ a) , testProperty "lenient-encode-lower" $ \a -> a == l (e a) , testProperty "lenient-encode-upper" $ \a -> a == l (u . e $ a) , testProperty "decode-encode-encode" $ \a -> Right (e a) == d (e (e a)) , testProperty "lenient-encode-encode" $ \a -> e a == l (e (e a)) ] units :: ( IsString bs , Show bs , Eq bs ) => Impl bs -> Test units (Impl label e d l td u) = testGroup label $ encs ++ decs ++ lens where encs = [ testCase ("encode: " ++ show raw) $ do enc @?= rawEnc | (raw, rawEnc) <- td , let enc = e raw ] decs = [ testCase ("decode: " ++ show rawEnc) $ do dec_enc @?= Right raw; dec_upp @?= Right raw | (raw, rawEnc) <- td , let dec_enc = d rawEnc , let dec_upp = d (u rawEnc) ] lens = [ testCase ("lenient: " ++ show rawEnc) $ do len_enc @?= raw; len_upp @?= raw | (raw, rawEnc) <- td , let len_enc = l rawEnc , let len_upp = l (u rawEnc) ] lenientUnits :: (IsString bs, Show bs, Eq bs) => Impl bs -> Test lenientUnits (Impl label e d l _ _) = testGroup (label ++ " lenient unit 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 = testCase (show $ if s == "" then "empty" else s) $ do let t0 = d (e s) t1 = l t (d (e s)) @=? Right (l t) -- ------------------------------------------------------------------ -- -- Test data rfcVectors :: IsString bs => [(bs,bs)] rfcVectors = [ ("","") , ("fo", "666f") , ("foo", "666f6f") , ("foob", "666f6f62") , ("fooba", "666f6f6261") , ("foobar", "666f6f626172") ] data Impl bs = Impl { _label :: String , _encode :: bs -> bs , _decode :: bs -> Either String bs , _lenient :: bs -> bs , _data :: [(bs, bs)] , _upper :: bs -> bs } b16 :: Impl BS.ByteString b16 = Impl "base16-strict" B16.encode B16.decode B16.decodeLenient rfcVectors (BS.map (c2w . toUpper . w2c)) lb16 :: Impl LBS.ByteString lb16 = Impl "base16-lazy" LB16.encode LB16.decode LB16.decodeLenient rfcVectors (LBS.map (c2w . toUpper . w2c)) instance Arbitrary BS.ByteString where arbitrary = liftM BS.pack arbitrary instance Arbitrary LBS.ByteString where arbitrary = liftM LBS.pack arbitrary