Main.hs (1660B)
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 13 newtype BS = BS BS.ByteString 14 deriving (Eq, Show) 15 16 bytes :: Int -> Q.Gen BS.ByteString 17 bytes k = do 18 l <- Q.chooseInt (0, k) 19 v <- Q.vectorOf l Q.arbitrary 20 pure (BS.pack v) 21 22 instance Q.Arbitrary BS where 23 arbitrary = do 24 b <- bytes 1024 25 pure (BS b) 26 27 decode_inverts_encode :: BS -> Bool 28 decode_inverts_encode (BS bs) = case B16.decode (B16.encode bs) of 29 Nothing -> False 30 Just b -> b == bs 31 32 encode_matches_reference :: BS -> Bool 33 encode_matches_reference (BS bs) = 34 let us = B16.encode bs 35 r0 = R0.encode bs 36 in us == r0 37 38 decode_matches_reference :: BS -> Bool 39 decode_matches_reference (BS bs) = 40 let enc = R0.encode bs 41 us = B16.decode enc 42 r0 = R0.decode enc 43 in case us of 44 Nothing -> case r0 of 45 Left _ -> True 46 _ -> False 47 Just du -> case r0 of 48 Left _ -> False 49 Right d0 -> du == d0 50 51 main :: IO () 52 main = defaultMain $ 53 testGroup "ppad-base16" [ 54 testGroup "property tests" [ 55 Q.testProperty "decode . encode ~ id" $ 56 Q.withMaxSuccess 5000 decode_inverts_encode 57 , Q.testProperty "encode matches reference" $ 58 Q.withMaxSuccess 5000 encode_matches_reference 59 , Q.testProperty "decode matches reference" $ 60 Q.withMaxSuccess 5000 decode_matches_reference 61 ] 62 ] 63