content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE Rank2Types #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE FlexibleContexts #-}
  
  module Test.Crypto.Encoding.BIP39
      ( tests
      ) where
  
  import Foundation
  import Foundation.Check
  import Basement.Nat
  import Basement.Types.OffsetSize (Offset(..))
  
  import Data.ByteString (ByteString)
  import qualified Data.ByteString as BS
  
  import Crypto.Encoding.BIP39
  import Crypto.Encoding.BIP39.English (english)
  
  import Cardano.Internal.Compat (fromRight)
  
  tests :: Test
  tests = Group "BIP39"
      [ testsP @96  @9  @3 Proxy
      , testsP @128 @12 @4 Proxy
      , testsP @160 @15 @5 Proxy
      , testsP @192 @18 @6 Proxy
      , testsP @224 @21 @7 Proxy
      , testsP @256 @24 @8 Proxy
      , testsVector
      ]
  
  testsP :: forall ent mw csz . (Arbitrary (Entropy ent), ConsistentEntropy ent mw csz)
         => Proxy ent
         -> Test
  testsP _ = Group (show (natVal (Proxy @ent)))
      [ Property "wordsToEntropy . entropyToWords == id" $ \(e :: Entropy ent) ->
          (fromRight undefined . wordsToEntropy @ent) (entropyToWords e) === e
      ]
  
  testsVector :: Test
  testsVector = Group "Test Vector" $ runTest <$> testVectors
  
  data TestVector = TestVector
      { testVectorInput  :: ByteString
      , testVectorWords  :: String
      , testVectorWIndex :: [Offset String]
      , testVectorSeed   :: Seed
      }
  
  runTest :: TestVector -> Test
  runTest tv =
      case BS.length (testVectorInput tv) * 8 of
          96  -> go (Proxy @96)
          128 -> go (Proxy @128)
          160 -> go (Proxy @160)
          192 -> go (Proxy @192)
          224 -> go (Proxy @224)
          256 -> go (Proxy @256)
          _   -> error "invalid size"
    where
      testVectorWIndex' = fmap wordIndex . testVectorWIndex
  
      go :: forall n csz mw . ConsistentEntropy n mw csz
         => Proxy n -> Test
      go proxyN = CheckPlan ("test " <> show (natVal proxyN)) $
          case toEntropy @n (testVectorInput tv) of
              Left err -> error $ show err
              Right e -> do
                  let w = entropyToWords e
                      e' = fromRight undefined $ wordsToEntropy @n w
                      seed = sentenceToSeed w english "TREZOR"
                      words = mnemonicSentenceToString @mw english w
                  validate "phrases are equal" (words === testVectorWords tv)
                  validate "words equal" (toList w === testVectorWIndex' tv)
                  validate "seed equal" (seed === testVectorSeed tv)
                  validate "entropy equal" (e === e')
  
  testVectors :: [TestVector]
  testVectors =
      [ TestVector
          "\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f"
          "legal winner thank year wave sausage worth useful legal winner thank yellow"
          [1019,2015,1790,2039,1983,1533,2031,1919,1019,2015,1790,2040]
          "\x2e\x89\x05\x81\x9b\x87\x23\xfe\x2c\x1d\x16\x18\x60\xe5\xee\x18\x30\x31\x8d\xbf\x49\xa8\x3b\xd4\x51\xcf\xb8\x44\x0c\x28\xbd\x6f\xa4\x57\xfe\x12\x96\x10\x65\x59\xa3\xc8\x09\x37\xa1\xc1\x06\x9b\xe3\xa3\xa5\xbd\x38\x1e\xe6\x26\x0e\x8d\x97\x39\xfc\xe1\xf6\x07"
      , TestVector
          "\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80\x80"
          "letter advice cage absurd amount doctor acoustic avoid letter advice cage above"
          [1028,32,257,8,64,514,16,128,1028,32,257,4]
          "\xd7\x1d\xe8\x56\xf8\x1a\x8a\xcc\x65\xe6\xfc\x85\x1a\x38\xd4\xd7\xec\x21\x6f\xd0\x79\x6d\x0a\x68\x27\xa3\xad\x6e\xd5\x51\x1a\x30\xfa\x28\x0f\x12\xeb\x2e\x47\xed\x2a\xc0\x3b\x5c\x46\x2a\x03\x58\xd1\x8d\x69\xfe\x4f\x98\x5e\xc8\x17\x78\xc1\xb3\x70\xb6\x52\xa8"
      , TestVector
          "\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff\xff"
          "zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo zoo wrong"
          [2047,2047,2047,2047,2047,2047,2047,2047,2047,2047,2047,2037]
          "\xac\x27\x49\x54\x80\x22\x52\x22\x07\x9d\x7b\xe1\x81\x58\x37\x51\xe8\x6f\x57\x10\x27\xb0\x49\x7b\x5b\x5d\x11\x21\x8e\x0a\x8a\x13\x33\x25\x72\x91\x7f\x0f\x8e\x5a\x58\x96\x20\xc6\xf1\x5b\x11\xc6\x1d\xee\x32\x76\x51\xa1\x4c\x34\xe1\x82\x31\x05\x2e\x48\xc0\x69"
      , TestVector
          "\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f\x7f"
          "legal winner thank year wave sausage worth useful legal winner thank year wave sausage worth useful legal will"
          [1019,2015,1790,2039,1983,1533,2031,1919,1019,2015,1790,2039,1983,1533,2031,1919,1019,2009]
          "\xf2\xb9\x45\x08\x73\x2b\xcb\xac\xbc\xc0\x20\xfa\xef\xec\xfc\x89\xfe\xaf\xa6\x64\x9a\x54\x91\xb8\xc9\x52\xce\xde\x49\x6c\x21\x4a\x0c\x7b\x3c\x39\x2d\x16\x87\x48\xf2\xd4\xa6\x12\xba\xda\x07\x53\xb5\x2a\x1c\x7a\xc5\x3c\x1e\x93\xab\xd5\xc6\x32\x0b\x9e\x95\xdd"
      , TestVector
          "\xf5\x85\xc1\x1a\xec\x52\x0d\xb5\x7d\xd3\x53\xc6\x95\x54\xb2\x1a\x89\xb2\x0f\xb0\x65\x09\x66\xfa\x0a\x9d\x6f\x74\xfd\x98\x9d\x8f"
          "void come effort suffer camp survey warrior heavy shoot primary clutch crush open amazing screen patrol group space point ten exist slush involve unfold"
          [1964,368,565,1733,262,1749,1978,851,1588,1365,356,424,1241,62,1548,1289,823,1666,1338,1783,638,1634,945,1897]
          "\x01\xf5\xbc\xed\x59\xde\xc4\x8e\x36\x2f\x2c\x45\xb5\xde\x68\xb9\xfd\x6c\x92\xc6\x63\x4f\x44\xd6\xd4\x0a\xab\x69\x05\x65\x06\xf0\xe3\x55\x24\xa5\x18\x03\x4d\xdc\x11\x92\xe1\xda\xcd\x32\xc1\xed\x3e\xaa\x3c\x3b\x13\x1c\x88\xed\x8e\x7e\x54\xc4\x9a\x5d\x09\x98"
      ]
  