├── .github └── workflows │ └── haskell-ci.yml ├── .gitignore ├── CHANGELOG.md ├── Data └── ByteString │ ├── Base16.hs │ └── Base16 │ ├── Internal.hs │ └── Lazy.hs ├── LICENSE ├── README.md ├── Setup.hs ├── base16-bytestring.cabal ├── benchmarks └── Benchmarks.hs ├── cabal.haskell-ci ├── cabal.project └── tests └── Tests.hs /.github/workflows/haskell-ci.yml: -------------------------------------------------------------------------------- 1 | # This GitHub workflow config has been generated by a script via 2 | # 3 | # haskell-ci 'github' 'base16-bytestring.cabal' 4 | # 5 | # To regenerate the script (for example after adjusting tested-with) run 6 | # 7 | # haskell-ci regenerate 8 | # 9 | # For more information, see https://github.com/andreasabel/haskell-ci 10 | # 11 | # version: 0.17.20230928 12 | # 13 | # REGENDATA ("0.17.20230928",["github","base16-bytestring.cabal"]) 14 | # 15 | name: Haskell-CI 16 | on: 17 | push: 18 | branches: 19 | - master 20 | pull_request: 21 | branches: 22 | - master 23 | jobs: 24 | linux: 25 | name: Haskell-CI - Linux - ${{ matrix.compiler }} 26 | runs-on: ubuntu-20.04 27 | timeout-minutes: 28 | 60 29 | container: 30 | image: buildpack-deps:focal 31 | continue-on-error: ${{ matrix.allow-failure }} 32 | strategy: 33 | matrix: 34 | include: 35 | - compiler: ghc-9.8.0.20230919 36 | compilerKind: ghc 37 | compilerVersion: 9.8.0.20230919 38 | setup-method: ghcup 39 | allow-failure: true 40 | - compiler: ghc-9.6.3 41 | compilerKind: ghc 42 | compilerVersion: 9.6.3 43 | setup-method: ghcup 44 | allow-failure: false 45 | - compiler: ghc-9.4.7 46 | compilerKind: ghc 47 | compilerVersion: 9.4.7 48 | setup-method: ghcup 49 | allow-failure: false 50 | - compiler: ghc-9.2.8 51 | compilerKind: ghc 52 | compilerVersion: 9.2.8 53 | setup-method: ghcup 54 | allow-failure: false 55 | - compiler: ghc-9.0.2 56 | compilerKind: ghc 57 | compilerVersion: 9.0.2 58 | setup-method: ghcup 59 | allow-failure: false 60 | - compiler: ghc-8.10.7 61 | compilerKind: ghc 62 | compilerVersion: 8.10.7 63 | setup-method: ghcup 64 | allow-failure: false 65 | - compiler: ghc-8.8.4 66 | compilerKind: ghc 67 | compilerVersion: 8.8.4 68 | setup-method: hvr-ppa 69 | allow-failure: false 70 | - compiler: ghc-8.6.5 71 | compilerKind: ghc 72 | compilerVersion: 8.6.5 73 | setup-method: hvr-ppa 74 | allow-failure: false 75 | - compiler: ghc-8.4.4 76 | compilerKind: ghc 77 | compilerVersion: 8.4.4 78 | setup-method: hvr-ppa 79 | allow-failure: false 80 | - compiler: ghc-8.2.2 81 | compilerKind: ghc 82 | compilerVersion: 8.2.2 83 | setup-method: hvr-ppa 84 | allow-failure: false 85 | - compiler: ghc-8.0.2 86 | compilerKind: ghc 87 | compilerVersion: 8.0.2 88 | setup-method: hvr-ppa 89 | allow-failure: false 90 | fail-fast: false 91 | steps: 92 | - name: apt 93 | run: | 94 | apt-get update 95 | apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 96 | if [ "${{ matrix.setup-method }}" = ghcup ]; then 97 | mkdir -p "$HOME/.ghcup/bin" 98 | curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" 99 | chmod a+x "$HOME/.ghcup/bin/ghcup" 100 | "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; 101 | "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) 102 | "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 103 | else 104 | apt-add-repository -y 'ppa:hvr/ghc' 105 | apt-get update 106 | apt-get install -y "$HCNAME" 107 | mkdir -p "$HOME/.ghcup/bin" 108 | curl -sL https://downloads.haskell.org/ghcup/0.1.19.5/x86_64-linux-ghcup-0.1.19.5 > "$HOME/.ghcup/bin/ghcup" 109 | chmod a+x "$HOME/.ghcup/bin/ghcup" 110 | "$HOME/.ghcup/bin/ghcup" config add-release-channel https://raw.githubusercontent.com/haskell/ghcup-metadata/master/ghcup-prereleases-0.0.7.yaml; 111 | "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) 112 | fi 113 | env: 114 | HCKIND: ${{ matrix.compilerKind }} 115 | HCNAME: ${{ matrix.compiler }} 116 | HCVER: ${{ matrix.compilerVersion }} 117 | - name: Set PATH and environment variables 118 | run: | 119 | echo "$HOME/.cabal/bin" >> $GITHUB_PATH 120 | echo "LANG=C.UTF-8" >> "$GITHUB_ENV" 121 | echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV" 122 | echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" 123 | HCDIR=/opt/$HCKIND/$HCVER 124 | if [ "${{ matrix.setup-method }}" = ghcup ]; then 125 | HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") 126 | HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') 127 | HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') 128 | echo "HC=$HC" >> "$GITHUB_ENV" 129 | echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" 130 | echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" 131 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 132 | else 133 | HC=$HCDIR/bin/$HCKIND 134 | echo "HC=$HC" >> "$GITHUB_ENV" 135 | echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" 136 | echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" 137 | echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" 138 | fi 139 | 140 | HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') 141 | echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV" 142 | echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV" 143 | echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV" 144 | if [ $((HCNUMVER >= 90800)) -ne 0 ] ; then echo "HEADHACKAGE=true" >> "$GITHUB_ENV" ; else echo "HEADHACKAGE=false" >> "$GITHUB_ENV" ; fi 145 | echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV" 146 | echo "GHCJSARITH=0" >> "$GITHUB_ENV" 147 | env: 148 | HCKIND: ${{ matrix.compilerKind }} 149 | HCNAME: ${{ matrix.compiler }} 150 | HCVER: ${{ matrix.compilerVersion }} 151 | - name: env 152 | run: | 153 | env 154 | - name: write cabal config 155 | run: | 156 | mkdir -p $CABAL_DIR 157 | cat >> $CABAL_CONFIG <> $CABAL_CONFIG <> $CABAL_CONFIG < cabal-plan.xz 202 | echo 'f62ccb2971567a5f638f2005ad3173dba14693a45154c1508645c52289714cb2 cabal-plan.xz' | sha256sum -c - 203 | xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan 204 | rm -f cabal-plan.xz 205 | chmod a+x $HOME/.cabal/bin/cabal-plan 206 | cabal-plan --version 207 | - name: checkout 208 | uses: actions/checkout@v4 209 | with: 210 | path: source 211 | - name: initial cabal.project for sdist 212 | run: | 213 | touch cabal.project 214 | echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project 215 | cat cabal.project 216 | - name: sdist 217 | run: | 218 | mkdir -p sdist 219 | $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist 220 | - name: unpack 221 | run: | 222 | mkdir -p unpacked 223 | find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \; 224 | - name: generate cabal.project 225 | run: | 226 | PKGDIR_base16_bytestring="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/base16-bytestring-[0-9.]*')" 227 | echo "PKGDIR_base16_bytestring=${PKGDIR_base16_bytestring}" >> "$GITHUB_ENV" 228 | rm -f cabal.project cabal.project.local 229 | touch cabal.project 230 | touch cabal.project.local 231 | echo "packages: ${PKGDIR_base16_bytestring}" >> cabal.project 232 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo "package base16-bytestring" >> cabal.project ; fi 233 | if [ $((HCNUMVER >= 80200)) -ne 0 ] ; then echo " ghc-options: -Werror=missing-methods" >> cabal.project ; fi 234 | cat >> cabal.project <> cabal.project 239 | fi 240 | $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(base16-bytestring)$/; }' >> cabal.project.local 241 | cat cabal.project 242 | cat cabal.project.local 243 | - name: dump install plan 244 | run: | 245 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all 246 | cabal-plan 247 | - name: restore cache 248 | uses: actions/cache/restore@v3 249 | with: 250 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 251 | path: ~/.cabal/store 252 | restore-keys: ${{ runner.os }}-${{ matrix.compiler }}- 253 | - name: install dependencies 254 | run: | 255 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all 256 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all 257 | - name: build w/o tests 258 | run: | 259 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 260 | - name: build 261 | run: | 262 | $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always 263 | - name: tests 264 | run: | 265 | $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct 266 | - name: cabal check 267 | run: | 268 | cd ${PKGDIR_base16_bytestring} || false 269 | ${CABAL} -vnormal check 270 | - name: haddock 271 | run: | 272 | $CABAL v2-haddock --disable-documentation --haddock-all $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all 273 | - name: unconstrained build 274 | run: | 275 | rm -f cabal.project.local 276 | $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all 277 | - name: prepare for constraint sets 278 | run: | 279 | rm -f cabal.project.local 280 | - name: constraint set bytestring-0.12 281 | run: | 282 | if [ $((HCNUMVER >= 80200 && HCNUMVER < 90800)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='bytestring >= 0.12' all --dry-run ; fi 283 | if [ $((HCNUMVER >= 80200 && HCNUMVER < 90800)) -ne 0 ] ; then cabal-plan topo | sort ; fi 284 | if [ $((HCNUMVER >= 80200 && HCNUMVER < 90800)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='bytestring >= 0.12' --dependencies-only -j2 all ; fi 285 | if [ $((HCNUMVER >= 80200 && HCNUMVER < 90800)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='bytestring >= 0.12' all ; fi 286 | if [ $((HCNUMVER >= 80200 && HCNUMVER < 90800)) -ne 0 ] ; then $CABAL v2-test $ARG_COMPILER --enable-tests --disable-benchmarks --constraint='bytestring >= 0.12' all ; fi 287 | - name: save cache 288 | uses: actions/cache/save@v3 289 | if: always() 290 | with: 291 | key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }} 292 | path: ~/.cabal/store 293 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | /dist-newstyle/ 2 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # 1.0.2.0 2 | 3 | * Support sized primitive types in GHC 9.2 ([#16](https://github.com/haskell/base16-bytestring/pull/16) - thanks Bodigrim!) 4 | 5 | # 1.0.1.0 6 | 7 | * Backwards-compatible support for `bytestring ^>= 0.11` ([#15](https://github.com/haskell/base16-bytestring/pull/15)) 8 | 9 | # 1.0.0.0 10 | 11 | * Merged omnibus PR doing a variety of things in ([#10](https://github.com/haskell/base16-bytestring/pull/10)): 12 | - Improves performance by 3-4x for encode, 4-5x for decode. 13 | - The `decode` signature returning the tuple and actually returns an error message with offset. The signature will now be `ByteString -> Either String ByteString`. 14 | - Actually tests using the test vectors defined in the RFC, and uses property tests to ensure invariants hold. 15 | - Adds lenient decoders to the API 16 | - Adds `-XTrustworthy` annotations to the relevant exposed modules 17 | - Rewrites the haddocks to be more up to date and fancy-styled. 18 | - Adds benchmarks to the `.cabal` file so they can be run at toplevel, and make them better. 19 | - Bumps the Cabal version to 1.12 20 | 21 | 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`. 22 | 23 | # 0.1.1.7 24 | 25 | * Fix some bugs in lazy decoding 26 | ([#8](https://github.com/haskell/base16-bytestring/pull/8)). 27 | 28 | # 0.1.1.6 29 | 30 | * Changelog not recorded up to this version. 31 | -------------------------------------------------------------------------------- /Data/ByteString/Base16.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE MagicHash #-} 4 | #if __GLASGOW_HASKELL__ >= 702 5 | {-# LANGUAGE Trustworthy #-} 6 | #endif 7 | -- | 8 | -- Module : Data.ByteString.Base16 9 | -- Copyright : (c) 2011 MailRank, Inc. 10 | -- 11 | -- License : BSD 12 | -- Maintainer : Herbert Valerio Riedel , 13 | -- Mikhail Glushenkov , 14 | -- Emily Pillmore 15 | -- Stability : stable 16 | -- Portability : non-portable 17 | -- 18 | -- RFC 4648-compliant Base16 (Hexadecimal) encoding for 'ByteString' values. 19 | -- For a complete Base16 encoding specification, please see . 20 | -- 21 | module Data.ByteString.Base16 22 | ( encode 23 | , decode 24 | , decodeLenient 25 | ) where 26 | 27 | import Data.ByteString (empty) 28 | import Data.ByteString.Base16.Internal (encodeLoop, decodeLoop, lenientLoop, mkBS, withBS) 29 | import Data.ByteString.Internal (ByteString) 30 | 31 | import Foreign.ForeignPtr (withForeignPtr) 32 | import Foreign.Ptr (plusPtr) 33 | 34 | import GHC.ForeignPtr (mallocPlainForeignPtrBytes) 35 | 36 | -- | Encode a 'ByteString' value in base16 (i.e. hexadecimal). 37 | -- Encoded values will always have a length that is a multiple of 2. 38 | -- 39 | -- === __Examples__: 40 | -- 41 | -- > encode "foo" == "666f6f" 42 | -- 43 | encode :: ByteString -> ByteString 44 | encode bs = withBS bs go 45 | where 46 | go !sptr !slen 47 | | slen > maxBound `div` 2 = 48 | error "Data.ByteString.Base16.encode: input too long" 49 | | otherwise = do 50 | let l = slen * 2 51 | dfp <- mallocPlainForeignPtrBytes l 52 | withForeignPtr dfp $ \dptr -> 53 | encodeLoop dptr sptr (sptr `plusPtr` slen) 54 | return $ mkBS dfp l 55 | 56 | -- | Decode a base16-encoded 'ByteString' value. 57 | -- If errors are encountered during the decoding process, 58 | -- then an error message and character offset will be returned in 59 | -- the @Left@ clause of the coproduct. 60 | -- 61 | -- === __Examples__: 62 | -- 63 | -- > decode "666f6f" == Right "foo" 64 | -- > decode "66quux" == Left "invalid character at offset: 2" 65 | -- > decode "666quux" == Left "invalid character at offset: 3" 66 | -- 67 | -- @since 1.0.0.0 68 | -- 69 | decode :: ByteString -> Either String ByteString 70 | decode bs = withBS bs go 71 | where 72 | go !sptr !slen 73 | | slen == 0 = return $ Right empty 74 | | r /= 0 = return $ Left "invalid bytestring size" 75 | | otherwise = do 76 | dfp <- mallocPlainForeignPtrBytes q 77 | withForeignPtr dfp $ \dptr -> 78 | decodeLoop dfp dptr sptr (plusPtr sptr slen) 79 | where 80 | !q = slen `quot` 2 81 | !r = slen `rem` 2 82 | 83 | -- | Decode a Base16-encoded 'ByteString' value leniently, using a 84 | -- strategy that never fails. 85 | -- 86 | -- /N.B./: this is not RFC 4648-compliant 87 | -- 88 | -- === __Examples__: 89 | -- 90 | -- > decodeLenient "666f6f" == "foo" 91 | -- > decodeLenient "66quuxx" == "f" 92 | -- > decodeLenient "666quux" == "f" 93 | -- > decodeLenient "666fquu" -- "fo" 94 | -- 95 | -- @since 1.0.0.0 96 | -- 97 | decodeLenient :: ByteString -> ByteString 98 | decodeLenient bs = withBS bs go 99 | where 100 | go !sptr !slen 101 | | slen == 0 = return empty 102 | | otherwise = do 103 | dfp <- mallocPlainForeignPtrBytes (q * 2) 104 | withForeignPtr dfp $ \dptr -> 105 | lenientLoop dfp dptr sptr (plusPtr sptr slen) 106 | where 107 | !q = slen `quot` 2 108 | -------------------------------------------------------------------------------- /Data/ByteString/Base16/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | {-# LANGUAGE MagicHash #-} 4 | module Data.ByteString.Base16.Internal 5 | ( -- * worker loops 6 | encodeLoop 7 | , decodeLoop 8 | , lenientLoop 9 | -- * utils 10 | , c2w 11 | , aix 12 | , reChunk 13 | , withBS 14 | , mkBS 15 | ) where 16 | 17 | 18 | import Data.Bits ((.&.), (.|.), unsafeShiftR) 19 | import qualified Data.ByteString as B 20 | import Data.ByteString.Internal (ByteString(..)) 21 | import Data.Char (ord) 22 | 23 | import Foreign.ForeignPtr (ForeignPtr, withForeignPtr) 24 | import Foreign.Ptr (Ptr, minusPtr, plusPtr) 25 | import Foreign.Storable (Storable(poke, peek)) 26 | 27 | import GHC.Word (Word8(..)) 28 | import GHC.Exts (Int(I#), Addr#, indexWord8OffAddr#) 29 | 30 | #if __GLASGOW_HASKELL__ >= 702 31 | import System.IO.Unsafe (unsafeDupablePerformIO) 32 | #else 33 | import GHC.IO (unsafeDupablePerformIO) 34 | #endif 35 | 36 | 37 | -- ------------------------------------------------------------------ -- 38 | -- Loops 39 | 40 | encodeLoop 41 | :: Ptr Word8 42 | -> Ptr Word8 43 | -> Ptr Word8 44 | -> IO () 45 | encodeLoop !dptr !sptr !end = go dptr sptr 46 | where 47 | !hex = "0123456789abcdef"# 48 | 49 | go !dst !src 50 | | src == end = return () 51 | | otherwise = do 52 | !t <- peek src 53 | 54 | poke dst (aix (unsafeShiftR t 4) hex) 55 | poke (plusPtr dst 1) (aix (t .&. 0x0f) hex) 56 | 57 | go (plusPtr dst 2) (plusPtr src 1) 58 | {-# INLINE encodeLoop #-} 59 | 60 | decodeLoop 61 | :: ForeignPtr Word8 62 | -> Ptr Word8 63 | -> Ptr Word8 64 | -> Ptr Word8 65 | -> IO (Either String ByteString) 66 | decodeLoop !dfp !dptr !sptr !end = go dptr sptr 67 | where 68 | err !src = return . Left 69 | $ "invalid character at offset: " 70 | ++ show (src `minusPtr` sptr) 71 | 72 | !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"# 73 | 74 | !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"# 75 | 76 | go !dst !src 77 | | src == end = return (Right (mkBS dfp (dst `minusPtr` dptr))) 78 | | otherwise = do 79 | !x <- peek src 80 | !y <- peek (plusPtr src 1) 81 | 82 | let !a = aix x hi 83 | !b = aix y lo 84 | 85 | if a == 0xff 86 | then err src 87 | else 88 | if b == 0xff 89 | then err (plusPtr src 1) 90 | else do 91 | poke dst (a .|. b) 92 | go (plusPtr dst 1) (plusPtr src 2) 93 | {-# INLINE decodeLoop #-} 94 | 95 | lenientLoop 96 | :: ForeignPtr Word8 97 | -> Ptr Word8 98 | -> Ptr Word8 99 | -> Ptr Word8 100 | -> IO ByteString 101 | lenientLoop !dfp !dptr !sptr !end = goHi dptr sptr 0 102 | where 103 | !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"# 104 | 105 | !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"# 106 | 107 | goHi !dst !src !n 108 | | src == end = return (mkBS dfp n) 109 | | otherwise = do 110 | !x <- peek src 111 | 112 | let !a = aix x hi 113 | 114 | if a == 0xff 115 | then goHi dst (plusPtr src 1) n 116 | else goLo dst (plusPtr src 1) a n 117 | 118 | goLo !dst !src !a !n 119 | | src == end = return (mkBS dfp n) 120 | | otherwise = do 121 | !y <- peek src 122 | 123 | let !b = aix y lo 124 | 125 | if b == 0xff 126 | then goLo dst (plusPtr src 1) a n 127 | else do 128 | poke dst (a .|. b) 129 | goHi (plusPtr dst 1) (plusPtr src 1) (n + 1) 130 | {-# INLINE lenientLoop #-} 131 | 132 | 133 | -- ------------------------------------------------------------------ -- 134 | -- Utils 135 | 136 | aix :: Word8 -> Addr# -> Word8 137 | aix w table = W8# (indexWord8OffAddr# table i) 138 | where 139 | !(I# i) = fromIntegral w 140 | {-# INLINE aix #-} 141 | 142 | -- | Form a list of chunks, and rechunk the list of bytestrings 143 | -- into length multiples of 2 144 | -- 145 | reChunk :: [ByteString] -> [ByteString] 146 | reChunk [] = [] 147 | reChunk (c:cs) = case B.length c `divMod` 2 of 148 | (_, 0) -> c : reChunk cs 149 | (n, _) -> case B.splitAt (n * 2) c of 150 | ~(m, q) -> m : cont_ q cs 151 | where 152 | cont_ q [] = [q] 153 | cont_ q (a:as) = case B.splitAt 1 a of 154 | ~(x, y) -> let q' = B.append q x 155 | in if B.length q' == 2 156 | then 157 | let as' = if B.null y then as else y:as 158 | in q' : reChunk as' 159 | else cont_ q' as 160 | 161 | c2w :: Char -> Word8 162 | c2w = fromIntegral . ord 163 | {-# INLINE c2w #-} 164 | 165 | mkBS :: ForeignPtr Word8 -> Int -> ByteString 166 | #if MIN_VERSION_bytestring(0,11,0) 167 | mkBS dfp n = BS dfp n 168 | #else 169 | mkBS dfp n = PS dfp 0 n 170 | #endif 171 | {-# INLINE mkBS #-} 172 | 173 | withBS :: ByteString -> (Ptr Word8 -> Int -> IO a) -> a 174 | #if MIN_VERSION_bytestring(0,11,0) 175 | withBS (BS !sfp !slen) f = unsafeDupablePerformIO $ 176 | withForeignPtr sfp $ \p -> f p slen 177 | #else 178 | withBS (PS !sfp !soff !slen) f = unsafeDupablePerformIO $ 179 | withForeignPtr sfp $ \p -> f (plusPtr p soff) slen 180 | #endif 181 | {-# INLINE withBS #-} 182 | -------------------------------------------------------------------------------- /Data/ByteString/Base16/Lazy.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | #if __GLASGOW_HASKELL__ >= 702 4 | {-# LANGUAGE Trustworthy #-} 5 | #endif 6 | -- | 7 | -- Module : Data.ByteString.Base16.Lazy 8 | -- Copyright : (c) 2011 MailRank, Inc. 9 | -- 10 | -- License : BSD 11 | -- Maintainer : Herbert Valerio Riedel , 12 | -- Mikhail Glushenkov , 13 | -- Emily Pillmore 14 | -- Stability : stable 15 | -- Portability : non-portable 16 | -- 17 | -- RFC 4648-compliant Base16 (Hexadecimal) encoding for lazy 'ByteString' values. 18 | -- For a complete Base16 encoding specification, please see . 19 | -- 20 | module Data.ByteString.Base16.Lazy 21 | ( encode 22 | , decode 23 | , decodeLenient 24 | ) where 25 | 26 | 27 | import qualified Data.ByteString as BS 28 | import qualified Data.ByteString.Lazy as LBS 29 | import qualified Data.ByteString.Base16 as B16 30 | import Data.ByteString.Base16.Internal 31 | import Data.ByteString.Lazy.Internal (ByteString(..)) 32 | 33 | -- | Encode a 'ByteString' value in base16 (i.e. hexadecimal). 34 | -- Encoded values will always have a length that is a multiple of 2. 35 | -- 36 | -- 37 | -- === __Examples__: 38 | -- 39 | -- > encode "foo" == "666f6f" 40 | -- 41 | encode :: ByteString -> ByteString 42 | encode Empty = Empty 43 | encode (Chunk c cs) = Chunk (B16.encode c) (encode cs) 44 | 45 | -- | Decode a base16-encoded 'ByteString' value. 46 | -- If errors are encountered during the decoding process, 47 | -- then an error message and character offset will be returned in 48 | -- the @Left@ clause of the coproduct. 49 | -- 50 | -- === __Examples__: 51 | -- 52 | -- > decode "666f6f" == Right "foo" 53 | -- > decode "66quux" == Left "invalid character at offset: 2" 54 | -- > decode "666quu" == Left "invalid character at offset: 3" 55 | -- 56 | -- @since 1.0.0.0 57 | -- 58 | decode :: ByteString -> Either String ByteString 59 | decode = f . B16.decode . BS.concat . LBS.toChunks 60 | where 61 | f (Left t) = Left t 62 | f (Right bs') = Right (LBS.fromChunks [bs']) 63 | 64 | -- | Decode a Base16-encoded 'ByteString' value leniently, using a 65 | -- strategy that never fails. 66 | -- 67 | -- /N.B./: this is not RFC 4648-compliant 68 | -- 69 | -- === __Examples__: 70 | -- 71 | -- > decodeLenient "666f6f" == "foo" 72 | -- > decodeLenient "66quux" == "f" 73 | -- > decodeLenient "666quu" == "f" 74 | -- > decodeLenient "666fqu" == "fo" 75 | -- 76 | -- @since 1.0.0.0 77 | -- 78 | decodeLenient :: ByteString -> ByteString 79 | decodeLenient = LBS.fromChunks 80 | . fmap B16.decodeLenient 81 | . reChunk 82 | . fmap (BS.filter (flip BS.elem extendedHex)) 83 | . LBS.toChunks 84 | where 85 | extendedHex = BS.pack (fmap c2w "0123456789abcdefABCDEF") 86 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2011 MailRank, Inc. 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 9 | 1. Redistributions of source code must retain the above copyright 10 | notice, this list of conditions and the following disclaimer. 11 | 12 | 2. Redistributions in binary form must reproduce the above copyright 13 | notice, this list of conditions and the following disclaimer in the 14 | documentation and/or other materials provided with the distribution. 15 | 16 | 3. Neither the name of the author nor the names of his contributors 17 | may be used to endorse or promote products derived from this software 18 | without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTORS ``AS IS'' AND ANY EXPRESS 21 | OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED 22 | WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE 23 | DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE FOR 24 | ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 25 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 26 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 27 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, 28 | STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN 29 | ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE 30 | POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # 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) 2 | 3 | **Please refer to the [package description on Hackage](https://hackage.haskell.org/package/base16-bytestring#description) for more information.** 4 | 5 | This package provides a Haskell library for working with base16-encoded 6 | data quickly and efficiently, using the `ByteString` type. 7 | 8 | # Get involved! 9 | 10 | Please report bugs via the 11 | [GitHub issue tracker](http://github.com/haskell/base16-bytestring). 12 | 13 | Master [Git repository](http://github.com/haskell/base16-bytestring): 14 | 15 | * `git clone git://github.com/haskell/base16-bytestring.git` 16 | 17 | 18 | # Authors 19 | 20 | This library is written by [Bryan O'Sullivan](mailto:bos@serpentine.com). 21 | 22 | It is currently maintained by [Emily Pillmore](mailto:emilypi@cohomolo.gy), [Herbert Valerio Riedel](mailto:hvr@gnu.org) and [Mikhail 23 | Glushenkov](mailto:mikhail.glushenkov@gmail.com). 24 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /base16-bytestring.cabal: -------------------------------------------------------------------------------- 1 | cabal-version: 1.12 2 | name: base16-bytestring 3 | version: 1.0.2.0 4 | x-revision: 1 5 | synopsis: RFC 4648-compliant Base16 encodings for ByteStrings 6 | description: 7 | This package provides support for encoding and decoding binary data according 8 | to @base16@ (see also ) for 9 | strict (see "Data.ByteString.Base16") and lazy @ByteString@s (see "Data.ByteString.Base16.Lazy"). 10 | . 11 | 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 12 | provides an uniform API providing conversion paths between more binary and textual types. 13 | 14 | homepage: http://github.com/haskell/base16-bytestring 15 | bug-reports: http://github.com/haskell/base16-bytestring/issues 16 | license: BSD3 17 | license-file: LICENSE 18 | copyright: 19 | Copyright 2011 MailRank, Inc.; 20 | Copyright 2010-2020 Bryan O'Sullivan et al. 21 | 22 | author: Bryan O'Sullivan 23 | maintainer: 24 | Herbert Valerio Riedel , 25 | Mikhail Glushenkov , 26 | Emily Pillmore 27 | 28 | category: Data 29 | build-type: Simple 30 | extra-source-files: 31 | README.md 32 | CHANGELOG.md 33 | 34 | tested-with: 35 | GHC == 9.8.0 36 | GHC == 9.6.3 37 | GHC == 9.4.7 38 | GHC == 9.2.8 39 | GHC == 9.0.2 40 | GHC == 8.10.7 41 | GHC == 8.8.4 42 | GHC == 8.6.5 43 | GHC == 8.4.4 44 | GHC == 8.2.2 45 | GHC == 8.0.2 46 | 47 | source-repository head 48 | type: git 49 | location: http://github.com/haskell/base16-bytestring 50 | 51 | library 52 | other-modules: Data.ByteString.Base16.Internal 53 | exposed-modules: 54 | Data.ByteString.Base16 55 | Data.ByteString.Base16.Lazy 56 | 57 | build-depends: 58 | base >=4.9 && <5 59 | , bytestring >=0.9 && <0.13 60 | 61 | ghc-options: -Wall -funbox-strict-fields 62 | default-language: Haskell2010 63 | 64 | test-suite test 65 | type: exitcode-stdio-1.0 66 | hs-source-dirs: tests 67 | main-is: Tests.hs 68 | build-depends: 69 | base 70 | , base16-bytestring 71 | , bytestring 72 | , HUnit 73 | , QuickCheck 74 | , test-framework 75 | , test-framework-hunit 76 | , test-framework-quickcheck2 77 | 78 | default-language: Haskell2010 79 | 80 | benchmark bench 81 | type: exitcode-stdio-1.0 82 | hs-source-dirs: benchmarks 83 | main-is: Benchmarks.hs 84 | build-depends: 85 | base >=4 && <5 86 | , base16-bytestring 87 | , bytestring 88 | , criterion 89 | , deepseq 90 | 91 | default-language: Haskell2010 92 | -------------------------------------------------------------------------------- /benchmarks/Benchmarks.hs: -------------------------------------------------------------------------------- 1 | module Main 2 | ( main 3 | ) where 4 | 5 | 6 | import Criterion 7 | import Criterion.Main 8 | 9 | import qualified Data.ByteString.Base16 as B16 10 | import qualified Data.ByteString as B 11 | 12 | generate :: Int -> B.ByteString 13 | generate n = B.pack . take n . cycle $ [0..255] 14 | 15 | main = defaultMain 16 | [ case bs of 17 | ~(a,b,c,d,e) -> bgroup "encode" 18 | [ bench "25" $ whnf B16.encode a 19 | , bench "100" $ whnf B16.encode b 20 | , bench "1000" $ whnf B16.encode c 21 | , bench "10000" $ whnf B16.encode d 22 | , bench "100000" $ whnf B16.encode e 23 | ] 24 | , case bs of 25 | ~(a,b,c,d,e) -> bgroup "decode" 26 | [ bench "25" $ whnf B16.decode a 27 | , bench "100" $ whnf B16.decode b 28 | , bench "1000" $ whnf B16.decode c 29 | , bench "10000" $ whnf B16.decode d 30 | , bench "100000" $ whnf B16.decode e 31 | ] 32 | ] 33 | where 34 | bs = 35 | let a = generate 25 36 | b = generate 100 37 | c = generate 1000 38 | d = generate 10000 39 | e = generate 100000 40 | in (a,b,c,d,e) 41 | 42 | bs' = 43 | let a = generate 25 44 | b = generate 100 45 | c = generate 1000 46 | d = generate 10000 47 | e = generate 100000 48 | f = B16.encode 49 | in (f a, f b, f c, f d, f e) 50 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | branches: master 2 | installed: +all 3 | 4 | constraint-set bytestring-0.12 5 | constraints: bytestring >= 0.12 6 | ghc: >= 8.2 && < 9.7 7 | tests: True 8 | run-tests: True 9 | 10 | raw-project 11 | allow-newer: bytestring 12 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | packages: . 2 | -------------------------------------------------------------------------------- /tests/Tests.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Main 3 | ( main 4 | ) where 5 | 6 | 7 | import Control.Monad (liftM) 8 | 9 | import qualified Data.ByteString as BS 10 | import Data.ByteString.Internal (c2w, w2c) 11 | import Data.ByteString.Char8 () 12 | import qualified Data.ByteString.Base16 as B16 13 | import qualified Data.ByteString.Base16.Lazy as LB16 14 | import qualified Data.ByteString.Lazy as LBS 15 | import Data.ByteString.Lazy.Char8 () 16 | import Data.Char (toUpper) 17 | import Data.String 18 | 19 | import Test.Framework (Test, defaultMain, testGroup) 20 | import Test.Framework.Providers.QuickCheck2 (testProperty) 21 | import Test.Framework.Providers.HUnit (testCase) 22 | import Test.HUnit hiding (Test) 23 | import Test.QuickCheck (Arbitrary(..)) 24 | 25 | 26 | 27 | main :: IO () 28 | main = defaultMain tests 29 | 30 | tests = 31 | [ testGroup "property tests" 32 | [ properties b16 33 | , properties lb16 34 | ] 35 | , testGroup "unit tests" 36 | [ units b16 37 | , units lb16 38 | , lenientUnits b16 39 | , lenientUnits lb16 40 | ] 41 | ] 42 | 43 | properties 44 | :: ( IsString bs 45 | , Show bs 46 | , Eq bs 47 | , Arbitrary bs 48 | ) 49 | => Impl bs 50 | -> Test 51 | properties (Impl label e d l _ u) = testGroup label 52 | [ testProperty "decode-encode-lower" $ \a -> Right a == d (e a) 53 | , testProperty "decode-encode-upper" $ \a -> Right a == d (u . e $ a) 54 | , testProperty "lenient-encode-lower" $ \a -> a == l (e a) 55 | , testProperty "lenient-encode-upper" $ \a -> a == l (u . e $ a) 56 | , testProperty "decode-encode-encode" $ \a -> Right (e a) == d (e (e a)) 57 | , testProperty "lenient-encode-encode" $ \a -> e a == l (e (e a)) 58 | ] 59 | 60 | units 61 | :: ( IsString bs 62 | , Show bs 63 | , Eq bs 64 | ) 65 | => Impl bs 66 | -> Test 67 | units (Impl label e d l td u) = testGroup label $ encs ++ decs ++ lens 68 | where 69 | encs = 70 | [ testCase ("encode: " ++ show raw) $ do enc @?= rawEnc 71 | | (raw, rawEnc) <- td 72 | , let enc = e raw 73 | ] 74 | 75 | decs = 76 | [ testCase ("decode: " ++ show rawEnc) $ do dec_enc @?= Right raw; dec_upp @?= Right raw 77 | | (raw, rawEnc) <- td 78 | , let dec_enc = d rawEnc 79 | , let dec_upp = d (u rawEnc) 80 | ] 81 | 82 | lens = 83 | [ testCase ("lenient: " ++ show rawEnc) $ do len_enc @?= raw; len_upp @?= raw 84 | | (raw, rawEnc) <- td 85 | , let len_enc = l rawEnc 86 | , let len_upp = l (u rawEnc) 87 | ] 88 | 89 | lenientUnits :: (IsString bs, Show bs, Eq bs) => Impl bs -> Test 90 | lenientUnits (Impl label e d l _ _) = testGroup (label ++ " lenient unit tests") 91 | [ testCaseB16 "" "" 92 | , testCaseB16 "f" "6+++++++____++++++======*%$@#%#^*$^6" 93 | , testCaseB16 "fo" "6$6+6|f" 94 | , testCaseB16 "foo" "==========6$$66()*f6f" 95 | , testCaseB16 "foob" "66^%$&^6f6f62" 96 | , testCaseB16 "fooba" "666f()*#@6f#)(@*)6()*)2()61" 97 | , testCaseB16 "foobar" "6@6@6@f@6@f@6@2@6@1@7@2++++++++++++++++++++++++" 98 | ] 99 | where 100 | testCaseB16 s t = testCase (show $ if s == "" then "empty" else s) $ do 101 | let t0 = d (e s) 102 | t1 = l t 103 | 104 | (d (e s)) @=? Right (l t) 105 | 106 | -- ------------------------------------------------------------------ -- 107 | -- Test data 108 | 109 | rfcVectors :: IsString bs => [(bs,bs)] 110 | rfcVectors = 111 | [ ("","") 112 | , ("fo", "666f") 113 | , ("foo", "666f6f") 114 | , ("foob", "666f6f62") 115 | , ("fooba", "666f6f6261") 116 | , ("foobar", "666f6f626172") 117 | ] 118 | 119 | data Impl bs = Impl 120 | { _label :: String 121 | , _encode :: bs -> bs 122 | , _decode :: bs -> Either String bs 123 | , _lenient :: bs -> bs 124 | , _data :: [(bs, bs)] 125 | , _upper :: bs -> bs 126 | } 127 | 128 | b16 :: Impl BS.ByteString 129 | b16 = Impl "base16-strict" B16.encode B16.decode B16.decodeLenient rfcVectors (BS.map (c2w . toUpper . w2c)) 130 | 131 | 132 | lb16 :: Impl LBS.ByteString 133 | lb16 = Impl "base16-lazy" LB16.encode LB16.decode LB16.decodeLenient rfcVectors (LBS.map (c2w . toUpper . w2c)) 134 | 135 | instance Arbitrary BS.ByteString where 136 | arbitrary = liftM BS.pack arbitrary 137 | 138 | instance Arbitrary LBS.ByteString where 139 | arbitrary = liftM LBS.pack arbitrary 140 | --------------------------------------------------------------------------------