{-# LANGUAGE NumDecimals #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}
module Main where
import Control.DeepSeq
import qualified Data.ByteString.Lazy as BSL
import Test.Tasty
import qualified Test.Tasty.HUnit as HU
import qualified Test.Tasty.QuickCheck as QC
import Text.Printf
import Data.Text.PgpWordlist.Internal.Convert
import Data.Text.PgpWordlist.Internal.Types
main :: IO ()
main = defaultMain tree
tree :: TestTree
tree = testGroup "Tests"
[ allBytesConvertible
, examplesBackAndForth
, randomRoundtrips
]
allBytesConvertible :: TestTree
allBytesConvertible = HU.testCase description test
where
description = "All bytes have a corresponding even/odd word"
assertNoBottoms x = x `deepseq` HU.assertBool "" True
test = assertNoBottoms (do
byte <- [minBound ..]
convert <- [unEvenWord . toEvenWord, unOddWord . toOddWord]
return $! convert byte )
examplesBackAndForth :: TestTree
examplesBackAndForth = testGroup "Explicit example conversions" tests
where
tests = concat
[ [ HU.testCase (printf "#%d: Bytes to PGP words" i)
(HU.assertEqual "" (toText bytes) pgpWords)
, HU.testCase (printf "#%d: PGP words to bytes" i)
(HU.assertEqual "" (Right bytes) (fromText pgpWords))
]
| (bytes, pgpWords) <- testCases
| i <- [0..] :: [Int]
]
first f (a,b) = (f a, b) -- Bifunctor came into Base in 7.10 only
testCases = map (first BSL.pack)
[ ( [ 0xce, 0xe7, 0x1c, 0xbf, 0xe6, 0x59, 0x49, 0x48
, 0x06, 0x7a, 0xd2, 0xfc, 0xb7, 0x74, 0x48, 0x18 ]
, "spyglass truncated befriend rebellion tracker examine deckhand \
\dictator afflict infancy standard wilmington seabird hydraulic \
\deadbolt borderline"
)
, ( [ 0xb3, 0xc6, 0x75, 0x64, 0xa7, 0x9e, 0x0a, 0xbb
, 0x84, 0x98, 0xd3, 0x33, 0xf1, 0xe4, 0x2a, 0x92 ]
, "scallion responsive indulge getaway repay onlooker allow \
\publisher mural narrative stapler concurrent unwind tradition \
\brickyard misnomer"
)
, ( [ 0xb2, 0x8d, 0x47, 0xf8, 0x8c, 0x57, 0xb5, 0x09
, 0x2e, 0x26, 0xf1, 0x24, 0x65, 0xb9, 0xae, 0xd7 ]
, "sawdust microscope dashboard warranty offload eskimo scorecard \
\applicant buzzard caretaker unwind capricorn fracture proximate \
\robust stethoscope"
)
, ( [ 0x72, 0x19, 0x07, 0xf2, 0xca, 0x6f, 0xe4, 0xee
, 0x52, 0x8f, 0x47, 0x3a, 0xbd, 0xf3, 0x64, 0x5b ]
, "highchair bottomless ahead vagabond spellbind hemisphere tonic \
\universe dupont midsummer dashboard corrosion skullcap vertigo \
\flytrap exodus"
)
, ( [ 0xe9, 0x75, 0x73, 0x8c, 0x03, 0xc1, 0x49, 0x7f
, 0xfd, 0xce, 0xd3, 0x8f, 0xfa, 0x3d, 0xd8, 0xf2 ]
, "treadmill impartial hockey megaton acme recover deckhand \
\integrate willow sardonic stapler midsummer wallet crucifix \
\stormy vagabond"
)
, ( [ 0x2d, 0x56, 0x8c, 0x11, 0x95, 0x47, 0x4f, 0x6f
, 0xe4, 0x05, 0x46, 0xfe, 0xc9, 0xf4, 0x41, 0x9a ]
, "button escapade offload babylon preclude determine dropper \
\hemisphere tonic almighty cubic yesteryear spearhead virginia \
\cranky newsletter"
)
, ( [ 0xb2, 0x68, 0xfc, 0xe4, 0x2c, 0xf5, 0xe5, 0x04
, 0xb4, 0xfb, 0xec, 0xe3, 0xc8, 0xe4, 0x29, 0xa5 ]
, "sawdust gravity wayside tradition burbank visitor topmost alkali \
\scenic wichita tumor torpedo spaniel tradition breakup paperweight"
)
, ( [ 0xbb, 0x96, 0x68, 0xc6, 0x33, 0x11, 0x4f, 0x7c
, 0x51, 0x5e, 0x7f, 0xe3, 0x1b, 0xc0, 0x6f, 0xc7 ]
, "shamrock monument frighten responsive chisel babylon dropper \
\informant drunken finicky lockup torpedo beeswax recipe gremlin \
\retraction"
)
]
randomRoundtrips :: TestTree
randomRoundtrips = makeGroup tests
where
makeGroup = localOption (QC.QuickCheckMaxSize 1024)
. localOption (QC.QuickCheckTests 1e3)
. testGroup "Random roundtrips"
tests = [ QC.testProperty "Bytes -> PGP words -> Bytes" $
\bytes -> let bs = BSL.pack bytes
in length bytes > 10
QC.==>
fromText (toText bs) == Right bs
]