base64

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

Main.hs (2326B)

      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-base64" Data.ByteString.Base64 as B64
      9 import qualified "base64-bytestring" Data.ByteString.Base64 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 B64.decode (B64.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 = B64.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  = B64.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_rfc_vectors :: TestTree
     53 case_rfc_vectors = H.testCase "RFC 4648 \167 10 vectors" $ do
     54   let vectors = [
     55           ("",       "")
     56         , ("f",      "Zg==")
     57         , ("fo",     "Zm8=")
     58         , ("foo",    "Zm9v")
     59         , ("foob",   "Zm9vYg==")
     60         , ("fooba",  "Zm9vYmE=")
     61         , ("foobar", "Zm9vYmFy")
     62         ]
     63       check (input, expected) = do
     64         H.assertEqual ("encode " <> show input)
     65           expected (B64.encode input)
     66         H.assertEqual ("decode " <> show expected)
     67           (Just input) (B64.decode expected)
     68   mapM_ check vectors
     69 
     70 main :: IO ()
     71 main = defaultMain $
     72   testGroup "ppad-base64" [
     73     testGroup "property tests" [
     74       Q.testProperty "decode . encode ~ id" $
     75         Q.withMaxSuccess 5000 decode_inverts_encode
     76     , Q.testProperty "encode matches reference" $
     77         Q.withMaxSuccess 5000 encode_matches_reference
     78     , Q.testProperty "decode matches reference" $
     79         Q.withMaxSuccess 5000 decode_matches_reference
     80     ]
     81   , testGroup "unit tests" [
     82       case_rfc_vectors
     83     ]
     84   ]