From 6c2dfa02fa8a6be6975ecfc8ed0a730b5e57e81c Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 8 Mar 2024 12:44:10 -0600
Subject: [PATCH] Implement QuickCheck tests for Orchard components

---
 src/ZcashHaskell/Types.hs |  1 +
 test/Spec.hs              | 60 +++++++++++++++++++++++++++++++--------
 zcash-haskell.cabal       |  2 ++
 3 files changed, 51 insertions(+), 12 deletions(-)

diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs
index 38d190f..4bd0cd9 100644
--- a/src/ZcashHaskell/Types.hs
+++ b/src/ZcashHaskell/Types.hs
@@ -81,6 +81,7 @@ data CoinType
   = MainNetCoin
   | TestNetCoin
   | RegTestNetCoin
+  deriving (Eq, Prelude.Show, Ord)
 
 getValue :: CoinType -> Word32
 getValue c =
diff --git a/test/Spec.hs b/test/Spec.hs
index c06a689..a4abbf2 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -17,6 +17,7 @@
 
 -}
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeSynonymInstances #-}
 
 import C.Zcash (rustWrapperUADecode)
 import Control.Monad.IO.Class (liftIO)
@@ -34,6 +35,8 @@ import qualified Data.Text.Lazy.IO as LTIO
 import Data.Word
 import GHC.Float.RealFracMethods (properFractionDoubleInteger)
 import Test.Hspec
+import Test.Hspec.QuickCheck
+import Test.QuickCheck
 import ZcashHaskell.Keys (generateWalletSeedPhrase, getWalletSeed)
 import ZcashHaskell.Orchard
 import ZcashHaskell.Sapling
@@ -49,6 +52,7 @@ import ZcashHaskell.Types
   , CoinType(..)
   , DecodedNote(..)
   , OrchardAction(..)
+  , Phrase(..)
   , RawData(..)
   , RawTxResponse(..)
   , ShieldedOutput(..)
@@ -448,18 +452,12 @@ main = do
           msg `shouldBe`
             "Hello World!\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
     describe "Wallet seed phrase" $ do
-      it "Generate phrase" $ do
-        p <- generateWalletSeedPhrase
-        BS.length p `shouldNotBe` 0
-      it "Derive seed" $ do
-        p <- generateWalletSeedPhrase
-        let s = getWalletSeed p
-        maybe 0 BS.length s `shouldBe` 64
-      it "Generate Orchard spending key" $ do
-        p <- generateWalletSeedPhrase
-        let s = getWalletSeed p
-        genOrchardSpendingKey (fromMaybe "" s) MainNetCoin 1 `shouldNotBe`
-          Nothing
+      prop "Generated phrases are valid" prop_PhraseLength
+      prop "Derived seeds are valid" prop_SeedLength
+      prop "Orchard spending keys are valid" $
+        forAll genOrcArgs $ \(c, i, _) -> prop_OrchardSpendingKey c i
+      prop "Orchard receivers are valid" $
+        forAll genOrcArgs $ \(c, i, j) -> prop_OrchardReceiver c i j
     describe "Address tests" $ do
       it "Encode transparent" $ do
         let ua =
@@ -469,3 +467,41 @@ main = do
                 Nothing -> "Bad UA"
                 Just u -> maybe "No transparent" encodeTransparent $ t_rec u
         msg `shouldBe` "t1LPWuQnjCRH7JAeEErSXKixcUteLJRJjKD"
+
+-- | Properties
+prop_PhraseLength :: Int -> Property
+prop_PhraseLength i =
+  ioProperty $ do
+    p <- generateWalletSeedPhrase
+    return $ BS.length p >= 95
+
+prop_SeedLength :: Int -> Property
+prop_SeedLength i =
+  ioProperty $ do
+    p <- generateWalletSeedPhrase
+    let s = getWalletSeed p
+    return $ maybe 0 BS.length s === 64
+
+prop_OrchardSpendingKey :: CoinType -> Int -> Property
+prop_OrchardSpendingKey c i =
+  ioProperty $ do
+    p <- generateWalletSeedPhrase
+    let s = getWalletSeed p
+    return $ genOrchardSpendingKey (fromMaybe "" s) c i =/= Nothing
+
+prop_OrchardReceiver :: CoinType -> Int -> Int -> Property
+prop_OrchardReceiver c i j =
+  ioProperty $ do
+    p <- generateWalletSeedPhrase
+    let s = getWalletSeed p
+    let sk = genOrchardSpendingKey (fromMaybe "" s) c i
+    return $ genOrchardReceiver j (fromMaybe "" sk) =/= Nothing
+
+-- | Generators
+genOrcArgs :: Gen (CoinType, Int, Int)
+genOrcArgs = do
+  i <- arbitrarySizedNatural
+  j <- arbitrarySizedNatural
+  c <- elements [MainNetCoin, TestNetCoin, RegTestNetCoin]
+  return (c, i, j)
+-- | Arbitrary instances
diff --git a/zcash-haskell.cabal b/zcash-haskell.cabal
index b6675d1..435f12f 100644
--- a/zcash-haskell.cabal
+++ b/zcash-haskell.cabal
@@ -72,6 +72,8 @@ test-suite zcash-haskell-test
     , haskoin-core
     , hexstring
     , hspec
+    , QuickCheck
+    , quickcheck-transformer
     , text
     , zcash-haskell
   pkgconfig-depends: rustzcash_wrapper