{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeApplications #-}

-- | The allocation-free @Eq@\/@Ord@ instances for 'OneEraGenTxId' must agree
-- with the raw-hash reference: order by hash bytes, ignore the era.
--
-- The comparison distinguishes four classes of input:
--
--   * same era, equal hashes
--   * same era, unequal hashes
--   * different eras, equal hashes
--   * different eras, unequal hashes
--
-- For Cardano, same-era comparisons use the era's own Eq/Ord and cross-era
-- comparisons go through PackedBytes; neither is the raw-hash reference, so
-- every class is a real check. The cross-era cells in particular check that
-- packed-word order agrees with raw-byte order across the Byron and Shelley
-- representations.
--
-- The test builds a txid in every era for each probe hash, then compares every
-- id with every other and checks the result against the reference. The probe
-- hashes (see 'hashes') put a single 1 at each byte in turn, so a wrong byte
-- order anywhere makes the era's 'Ord' disagree with the reference.
module Test.Consensus.Cardano.TxId (tests) where

import Cardano.Protocol.Crypto (StandardCrypto)
import Data.ByteString.Short (ShortByteString)
import qualified Data.ByteString.Short as SBS
import Data.SOP (Proxy (..), lengthSList)
import Data.Word (Word8)
import Ouroboros.Consensus.Cardano.Block (CardanoEras)
import Ouroboros.Consensus.Cardano.Node ()
import Ouroboros.Consensus.HardFork.Combinator.Abstract (CanHardFork, rawHashNS)
import Ouroboros.Consensus.HardFork.Combinator.AcrossEras (OneEraGenTxId (..))
import Ouroboros.Consensus.Shelley.HFEras ()
import Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import Test.Consensus.Cardano.GenTxIdBuilders (oneEraGenTxIds)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, assertEqual, testCase)
import Test.Tasty.QuickCheck
  ( Gen
  , Property
  , arbitrary
  , chooseInt
  , forAll
  , frequency
  , testProperty
  , vectorOf
  , (.&&.)
  , (===)
  )

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"TxIdEqOrd"
    [ TestName -> Assertion -> TestTree
testCase TestName
"Eq/Ord agree with the raw-hash reference" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        ((Int, Int, ShortByteString, ShortByteString) -> Assertion)
-> [(Int, Int, ShortByteString, ShortByteString)] -> Assertion
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Int, Int, ShortByteString, ShortByteString) -> Assertion
check [(Int
i, Int
j, ShortByteString
h1, ShortByteString
h2) | Int
i <- [Int]
eras, Int
j <- [Int]
eras, ShortByteString
h1 <- [ShortByteString]
hashes, ShortByteString
h2 <- [ShortByteString]
hashes]
    , TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty
        TestName
"Eq/Ord agree with the raw-hash reference on random hashes"
        Property
prop_agreeWithReference
    ]

-- | The reference semantics for the txid @Eq@\/@Ord@ instances: the raw hash
-- bytes, era ignored. Imported from the combinator, not copied, so the test and
-- the non-optimizing instances share one reference.
refRawHash :: CanHardFork xs => OneEraGenTxId xs -> ShortByteString
refRawHash :: forall (xs :: [*]).
CanHardFork xs =>
OneEraGenTxId xs -> ShortByteString
refRawHash = NS WrapGenTxId xs -> ShortByteString
forall (xs :: [*]).
All SingleEraBlock xs =>
NS WrapGenTxId xs -> ShortByteString
rawHashNS (NS WrapGenTxId xs -> ShortByteString)
-> (OneEraGenTxId xs -> NS WrapGenTxId xs)
-> OneEraGenTxId xs
-> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OneEraGenTxId xs -> NS WrapGenTxId xs
forall (xs :: [*]). OneEraGenTxId xs -> NS WrapGenTxId xs
getOneEraGenTxId

-- | The txid built in era position @e@ from hash bytes @bs@.
mkAt :: Int -> ShortByteString -> OneEraGenTxId (CardanoEras StandardCrypto)
mkAt :: Int
-> ShortByteString -> OneEraGenTxId (CardanoEras StandardCrypto)
mkAt Int
e ShortByteString
bs = ShortByteString -> [OneEraGenTxId (CardanoEras StandardCrypto)]
forall (xs :: [*]).
All BuildGenTxId xs =>
ShortByteString -> [OneEraGenTxId xs]
oneEraGenTxIds ShortByteString
bs [OneEraGenTxId (CardanoEras StandardCrypto)]
-> Int -> OneEraGenTxId (CardanoEras StandardCrypto)
forall a. HasCallStack => [a] -> Int -> a
!! Int
e

-- | Check one era/hash combination against the reference, for @compare@ and
-- @==@. The tuple is shown verbatim in the failure message.
check :: (Int, Int, ShortByteString, ShortByteString) -> Assertion
check :: (Int, Int, ShortByteString, ShortByteString) -> Assertion
check c :: (Int, Int, ShortByteString, ShortByteString)
c@(Int
i, Int
j, ShortByteString
h1, ShortByteString
h2) = do
  TestName -> Ordering -> Ordering -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual ((Int, Int, ShortByteString, ShortByteString) -> TestName
forall a. Show a => a -> TestName
show (Int, Int, ShortByteString, ShortByteString)
c TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
" [compare]") (ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OneEraGenTxId (CardanoEras StandardCrypto) -> ShortByteString
forall (xs :: [*]).
CanHardFork xs =>
OneEraGenTxId xs -> ShortByteString
refRawHash OneEraGenTxId (CardanoEras StandardCrypto)
a) (OneEraGenTxId (CardanoEras StandardCrypto) -> ShortByteString
forall (xs :: [*]).
CanHardFork xs =>
OneEraGenTxId xs -> ShortByteString
refRawHash OneEraGenTxId (CardanoEras StandardCrypto)
b)) (OneEraGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare OneEraGenTxId (CardanoEras StandardCrypto)
a OneEraGenTxId (CardanoEras StandardCrypto)
b)
  TestName -> Bool -> Bool -> Assertion
forall a.
(Eq a, Show a, HasCallStack) =>
TestName -> a -> a -> Assertion
assertEqual ((Int, Int, ShortByteString, ShortByteString) -> TestName
forall a. Show a => a -> TestName
show (Int, Int, ShortByteString, ShortByteString)
c TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ TestName
" [==]") (OneEraGenTxId (CardanoEras StandardCrypto) -> ShortByteString
forall (xs :: [*]).
CanHardFork xs =>
OneEraGenTxId xs -> ShortByteString
refRawHash OneEraGenTxId (CardanoEras StandardCrypto)
a ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
== OneEraGenTxId (CardanoEras StandardCrypto) -> ShortByteString
forall (xs :: [*]).
CanHardFork xs =>
OneEraGenTxId xs -> ShortByteString
refRawHash OneEraGenTxId (CardanoEras StandardCrypto)
b) (OneEraGenTxId (CardanoEras StandardCrypto)
a OneEraGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto) -> Bool
forall a. Eq a => a -> a -> Bool
== OneEraGenTxId (CardanoEras StandardCrypto)
b)
 where
  a :: OneEraGenTxId (CardanoEras StandardCrypto)
a = Int
-> ShortByteString -> OneEraGenTxId (CardanoEras StandardCrypto)
mkAt Int
i ShortByteString
h1
  b :: OneEraGenTxId (CardanoEras StandardCrypto)
b = Int
-> ShortByteString -> OneEraGenTxId (CardanoEras StandardCrypto)
mkAt Int
j ShortByteString
h2

-- | 'compare' and '==' on random era/hash pairs must agree with the raw-hash
-- reference.
prop_agreeWithReference :: Property
prop_agreeWithReference :: Property
prop_agreeWithReference =
  Gen Int -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Int
genEra ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
i ->
    Gen Int -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Int
genEra ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
j ->
      Gen ShortByteString -> (ShortByteString -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen ShortByteString
genHash ((ShortByteString -> Property) -> Property)
-> (ShortByteString -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ShortByteString
h1 ->
        -- @h2@ equals @h1@ 1 time in 5; independent random hashes are almost
        -- never equal, so otherwise '==' would never be tested against True.
        Gen ShortByteString -> (ShortByteString -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ([(Int, Gen ShortByteString)] -> Gen ShortByteString
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
1, ShortByteString -> Gen ShortByteString
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortByteString
h1), (Int
4, Gen ShortByteString
genHash)]) ((ShortByteString -> Property) -> Property)
-> (ShortByteString -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \ShortByteString
h2 ->
          let a :: OneEraGenTxId (CardanoEras StandardCrypto)
a = Int
-> ShortByteString -> OneEraGenTxId (CardanoEras StandardCrypto)
mkAt Int
i ShortByteString
h1
              b :: OneEraGenTxId (CardanoEras StandardCrypto)
b = Int
-> ShortByteString -> OneEraGenTxId (CardanoEras StandardCrypto)
mkAt Int
j ShortByteString
h2
           in OneEraGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare OneEraGenTxId (CardanoEras StandardCrypto)
a OneEraGenTxId (CardanoEras StandardCrypto)
b Ordering -> Ordering -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ShortByteString -> ShortByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (OneEraGenTxId (CardanoEras StandardCrypto) -> ShortByteString
forall (xs :: [*]).
CanHardFork xs =>
OneEraGenTxId xs -> ShortByteString
refRawHash OneEraGenTxId (CardanoEras StandardCrypto)
a) (OneEraGenTxId (CardanoEras StandardCrypto) -> ShortByteString
forall (xs :: [*]).
CanHardFork xs =>
OneEraGenTxId xs -> ShortByteString
refRawHash OneEraGenTxId (CardanoEras StandardCrypto)
b)
                Property -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.&&. (OneEraGenTxId (CardanoEras StandardCrypto)
a OneEraGenTxId (CardanoEras StandardCrypto)
-> OneEraGenTxId (CardanoEras StandardCrypto) -> Bool
forall a. Eq a => a -> a -> Bool
== OneEraGenTxId (CardanoEras StandardCrypto)
b) Bool -> Bool -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== (OneEraGenTxId (CardanoEras StandardCrypto) -> ShortByteString
forall (xs :: [*]).
CanHardFork xs =>
OneEraGenTxId xs -> ShortByteString
refRawHash OneEraGenTxId (CardanoEras StandardCrypto)
a ShortByteString -> ShortByteString -> Bool
forall a. Eq a => a -> a -> Bool
== OneEraGenTxId (CardanoEras StandardCrypto) -> ShortByteString
forall (xs :: [*]).
CanHardFork xs =>
OneEraGenTxId xs -> ShortByteString
refRawHash OneEraGenTxId (CardanoEras StandardCrypto)
b)

-- | A random 32-byte hash.
genHash :: Gen ShortByteString
genHash :: Gen ShortByteString
genHash = [Word8] -> ShortByteString
SBS.pack ([Word8] -> ShortByteString) -> Gen [Word8] -> Gen ShortByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | A random era position.
genEra :: Gen Int
genEra :: Gen Int
genEra = (Int, Int) -> Gen Int
chooseInt (Int
0, Proxy (CardanoEras StandardCrypto) -> Int
forall k (xs :: [k]) (proxy :: [k] -> *).
SListI xs =>
proxy xs -> Int
lengthSList (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(CardanoEras StandardCrypto)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1)

-- | The probe hashes: the all-zero hash, plus one hash per byte position, each
-- 0 everywhere except a 1 at that byte. Probing every byte checks that a wrong
-- byte order anywhere makes the era's 'Ord' disagree with the raw-byte
-- reference.
hashes :: [ShortByteString]
hashes :: [ShortByteString]
hashes = ShortByteString
zeros ShortByteString -> [ShortByteString] -> [ShortByteString]
forall a. a -> [a] -> [a]
: [Int -> Word8 -> ShortByteString
byteAt Int
p Word8
1 | Int
p <- [Int
0 .. Int
31]]

eras :: [Int]
eras :: [Int]
eras = [Int
0 .. Proxy (CardanoEras StandardCrypto) -> Int
forall k (xs :: [k]) (proxy :: [k] -> *).
SListI xs =>
proxy xs -> Int
lengthSList (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @(CardanoEras StandardCrypto)) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]

zeros :: ShortByteString
zeros :: ShortByteString
zeros = [Word8] -> ShortByteString
SBS.pack (Int -> Word8 -> [Word8]
forall a. Int -> a -> [a]
replicate Int
32 Word8
0)

-- | 32 bytes, all zero except position @p@ set to @v@.
byteAt :: Int -> Word8 -> ShortByteString
byteAt :: Int -> Word8 -> ShortByteString
byteAt Int
p Word8
v = [Word8] -> ShortByteString
SBS.pack [if Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
p then Word8
v else Word8
0 | Int
i <- [Int
0 .. Int
31]]