base16

Pure Haskell base16 encoding/decoding (docs.ppad.tech/base16).
git clone git://git.ppad.tech/base16.git
Log | Files | Refs | README | LICENSE

Main.hs (2024B)

      1 {-# OPTIONS_GHC -fno-warn-missing-signatures #-}
      2 {-# LANGUAGE OverloadedStrings #-}
      3 {-# LANGUAGE PackageImports #-}
      4 
      5 module Main where
      6 
      7 import qualified Data.ByteString as BS
      8 import qualified "ppad-base16" Data.ByteString.Base16 as B16
      9 import qualified "base16-bytestring" Data.ByteString.Base16 as R0
     10 import Test.Tasty
     11 import qualified Test.Tasty.QuickCheck as Q
     12 import qualified Test.Tasty.HUnit as H
     13 
     14 newtype BS = BS BS.ByteString
     15   deriving (Eq, Show)
     16 
     17 bytes :: Int -> Q.Gen BS.ByteString
     18 bytes k = do
     19   l <- Q.chooseInt (0, k)
     20   v <- Q.vectorOf l Q.arbitrary
     21   pure (BS.pack v)
     22 
     23 instance Q.Arbitrary BS where
     24   arbitrary = do
     25     b <- bytes 1024
     26     pure (BS b)
     27 
     28 decode_inverts_encode :: BS -> Bool
     29 decode_inverts_encode (BS bs) = case B16.decode (B16.encode bs) of
     30   Nothing -> False
     31   Just b  -> b == bs
     32 
     33 encode_matches_reference :: BS -> Bool
     34 encode_matches_reference (BS bs) =
     35   let us = B16.encode bs
     36       r0 = R0.encode bs
     37   in  us == r0
     38 
     39 decode_matches_reference :: BS -> Bool
     40 decode_matches_reference (BS bs) =
     41   let enc = R0.encode bs
     42       us  = B16.decode enc
     43       r0  = R0.decode enc
     44   in  case us of
     45         Nothing -> case r0 of
     46           Left _ -> True
     47           _ -> False
     48         Just du -> case r0 of
     49           Left _ -> False
     50           Right d0 -> du == d0
     51 
     52 case_handled :: TestTree
     53 case_handled = H.testCase "decodes uppercase hex" $ do
     54   let lhex = "deadbeef"
     55       uhex = "DEADBEEF"
     56   case liftA2 (,) (B16.decode lhex) (B16.decode uhex) of
     57     Nothing -> H.assertBool mempty False
     58     Just (a, b) -> H.assertEqual mempty a b
     59 
     60 main :: IO ()
     61 main = defaultMain $
     62   testGroup "ppad-base16" [
     63     testGroup "property tests" [
     64       Q.testProperty "decode . encode ~ id" $
     65         Q.withMaxSuccess 5000 decode_inverts_encode
     66     , Q.testProperty "encode matches reference" $
     67         Q.withMaxSuccess 5000 encode_matches_reference
     68     , Q.testProperty "decode matches reference" $
     69         Q.withMaxSuccess 5000 decode_matches_reference
     70     ]
     71   , testGroup "unit tests" [
     72       case_handled
     73     ]
     74   ]
     75