{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ParallelListComp #-}

module Main where



import           Data.Text.PgpWordlist.Internal.Tables

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



main :: IO ()
main = defaultMain tree



tree :: TestTree
tree = testGroup "Tests"
    [ allBytesConvertible
    , examplesBackAndForth
    , randomRoundtrips
    ]



allBytesConvertible :: TestTree
allBytesConvertible = testGroup "All bytes have a corresponding word" tests
  where
    tests = map evenTest [0..] ++ map oddTest [0..]
    evenTest i = HU.testCase (printf "%02x is convertible to an even word" i)
                             (evenTestAssertion i)
    oddTest  i = HU.testCase (printf "%02x is convertible to an odd word" i)
                             (oddTestAssertion i)
    evenTestAssertion i = HU.assertBool "" (toEvenWord i `seq` True)
    oddTestAssertion  i = HU.assertBool "" (toOddWord  i `seq` True)



examplesBackAndForth :: TestTree
examplesBackAndForth = testGroup "Conversion beween various examples" tests
  where
    tests = concat
        [ [ HU.testCase (printf "#%2d: %s -> PGP words" i (bsToHex bytes))
                        (HU.assertEqual "" (toText bytes) pgpWords)
          , HU.testCase (printf "#%2d: PGP words -> %s" i (bsToHex bytes))
                        (HU.assertEqual "" (Right bytes) (fromText pgpWords))
          ]
        | (bytes, pgpWords) <- testCases
        | i <- [0..] :: [Int]
        ]
    bsToHex :: BSL.ByteString -> String
    bsToHex = concatMap (printf "%02x") . BSL.unpack

    testCases = map (\(x,y) -> (BSL.pack x, y))
        [ ( [0xce, 0xe7, 0x1c, 0xbf, 0xe6, 0x59, 0x49, 0x48]
          , "spyglass truncated befriend rebellion tracker examine deckhand dictator"
          )
        , ( [0x06, 0x7a, 0xd2, 0xfc, 0xb7, 0x74, 0x48, 0x18]
          , "afflict infancy standard wilmington seabird hydraulic deadbolt borderline"
          )
        , ( [0xb3, 0xc6, 0x75, 0x64, 0xa7, 0x9e, 0x0a, 0xbb]
          , "scallion responsive indulge getaway repay onlooker allow publisher"
          )
        , ( [0x84, 0x98, 0xd3, 0x33, 0xf1, 0xe4, 0x2a, 0x92]
          , "mural narrative stapler concurrent unwind tradition brickyard misnomer"
          )
        , ( [0xb2, 0x8d, 0x47, 0xf8, 0x8c, 0x57, 0xb5, 0x09]
          , "sawdust microscope dashboard warranty offload eskimo scorecard applicant"
          )
        , ( [0x2e, 0x26, 0xf1, 0x24, 0x65, 0xb9, 0xae, 0xd7]
          , "buzzard caretaker unwind capricorn fracture proximate robust stethoscope"
          )
        , ( [0x72, 0x19, 0x07, 0xf2, 0xca, 0x6f, 0xe4, 0xee]
          , "highchair bottomless ahead vagabond spellbind hemisphere tonic universe"
          )
        , ( [0x52, 0x8f, 0x47, 0x3a, 0xbd, 0xf3, 0x64, 0x5b]
          , "dupont midsummer dashboard corrosion skullcap vertigo flytrap exodus"
          )
        , ( [0xe9, 0x75, 0x73, 0x8c, 0x03, 0xc1, 0x49, 0x7f]
          , "treadmill impartial hockey megaton acme recover deckhand integrate"
          )
        , ( [0xfd, 0xce, 0xd3, 0x8f, 0xfa, 0x3d, 0xd8, 0xf2]
          , "willow sardonic stapler midsummer wallet crucifix stormy vagabond"
          )
        , ( [0x2d, 0x56, 0x8c, 0x11, 0x95, 0x47, 0x4f, 0x6f]
          , "button escapade offload babylon preclude determine dropper hemisphere"
          )
        , ( [0xe4, 0x05, 0x46, 0xfe, 0xc9, 0xf4, 0x41, 0x9a]
          , "tonic almighty cubic yesteryear spearhead virginia cranky newsletter"
          )
        , ( [0xb2, 0x68, 0xfc, 0xe4, 0x2c, 0xf5, 0xe5, 0x04]
          , "sawdust gravity wayside tradition burbank visitor topmost alkali"
          )
        , ( [0xb4, 0xfb, 0xec, 0xe3, 0xc8, 0xe4, 0x29, 0xa5]
          , "scenic wichita tumor torpedo spaniel tradition breakup paperweight"
          )
        , ( [0xbb, 0x96, 0x68, 0xc6, 0x33, 0x11, 0x4f, 0x7c]
          , "shamrock monument frighten responsive chisel babylon dropper informant"
          )
        , ( [0x51, 0x5e, 0x7f, 0xe3, 0x1b, 0xc0, 0x6f, 0xc7]
          , "drunken finicky lockup torpedo beeswax recipe gremlin retraction"
          )
        ]

randomRoundtrips :: TestTree
randomRoundtrips = makeGroup tests
  where
    makeGroup = localOption (QC.QuickCheckMaxSize 1024)
              . testGroup "Random roundtrips"
    tests = [ QC.testProperty "Bytes -> PGP words -> Bytes" $
                \bytes -> let bs = BSL.pack bytes
                          in  fromText (toText bs) == Right bs
            ]