{-# LANGUAGE GADTs #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Consensus.Shelley.Serialisation (tests) where

import qualified Codec.CBOR.Write as CBOR
import qualified Data.ByteString.Lazy as Lazy
import           Data.Constraint
import           Data.Proxy (Proxy (..))
import           Data.Word (Word64)
import           Ouroboros.Consensus.Protocol.TPraos (TPraos)
import           Ouroboros.Consensus.Shelley.HFEras ()
import           Ouroboros.Consensus.Shelley.Ledger
import           Ouroboros.Consensus.Shelley.Ledger.SupportsProtocol ()
import           Ouroboros.Consensus.Shelley.Node ()
import           Ouroboros.Consensus.Shelley.Node.Serialisation ()
import           Ouroboros.Consensus.Shelley.Protocol.TPraos ()
import           Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..))
import           Test.Consensus.Cardano.Generators ()
import           Test.Consensus.Shelley.Generators ()
import           Test.Consensus.Shelley.MockCrypto
import           Test.Tasty
import           Test.Tasty.QuickCheck
import           Test.Util.Corruption
import           Test.Util.Orphans.Arbitrary ()
import           Test.Util.Serialisation.Roundtrip

tests :: TestTree
tests :: TestTree
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
"Shelley"
    [ CodecConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> (forall a.
    NestedCtxt_ (ShelleyBlock (TPraos MockCrypto) ShelleyEra) Header a
    -> Dict (Eq a, Show a))
-> TestTree
forall blk.
(SerialiseDiskConstraints blk, SerialiseNodeToNodeConstraints blk,
 SerialiseNodeToClientConstraints blk,
 Show (BlockNodeToNodeVersion blk), StandardHash blk, GetHeader blk,
 Arbitrary' blk, Arbitrary' (Header blk),
 Arbitrary' (HeaderHash blk), Arbitrary' (LedgerState blk EmptyMK),
 Arbitrary' (AnnTip blk),
 Arbitrary' (ChainDepState (BlockProtocol blk)),
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) blk,
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) (Coherent blk),
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) (Header blk),
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) (GenTx blk),
 ArbitraryWithVersion (BlockNodeToNodeVersion blk) (GenTxId blk),
 ArbitraryWithVersion
   (BlockNodeToNodeVersion blk) (SomeSecond (NestedCtxt Header) blk),
 ArbitraryWithVersion (BlockNodeToClientVersion blk) blk,
 ArbitraryWithVersion (BlockNodeToClientVersion blk) (GenTx blk),
 ArbitraryWithVersion
   (BlockNodeToClientVersion blk) (ApplyTxErr blk),
 ArbitraryWithVersion
   (BlockNodeToClientVersion blk) (SomeBlockQuery (BlockQuery blk)),
 ArbitraryWithVersion
   (BlockNodeToClientVersion blk) (SomeResult blk),
 Arbitrary
   (WithVersion (BlockNodeToClientVersion blk) (LedgerConfig blk)),
 ArbitraryWithVersion
   (QueryVersion, BlockNodeToClientVersion blk)
   (SomeSecond Query blk),
 Show (BlockNodeToClientVersion blk),
 BlockSupportsLedgerQuery blk) =>
CodecConfig blk
-> (forall a. NestedCtxt_ blk Header a -> Dict (Eq a, Show a))
-> TestTree
roundtrip_all CodecConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
testCodecCfg NestedCtxt_ (ShelleyBlock (TPraos MockCrypto) ShelleyEra) Header a
-> Dict (Eq a, Show a)
forall a.
NestedCtxt_ (ShelleyBlock (TPraos MockCrypto) ShelleyEra) Header a
-> Dict (Eq a, Show a)
forall a era proto.
ShelleyCompatible proto era =>
NestedCtxt_ (ShelleyBlock proto era) Header a
-> Dict (Eq a, Show a)
dictNestedHdr

      -- Test for real crypto too
    , TestName -> (ShelleyHash -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"hashSize real crypto"       ((ShelleyHash -> Property) -> TestTree)
-> (ShelleyHash -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ Proxy (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> HeaderHash (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Property
forall blk.
ConvertRawHash blk =>
Proxy blk -> HeaderHash blk -> Property
prop_hashSize Proxy (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
pReal
    , TestName -> (ShelleyHash -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ConvertRawHash real crypto" ((ShelleyHash -> Property) -> TestTree)
-> (ShelleyHash -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ Proxy (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> HeaderHash (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Property
forall blk.
(StandardHash blk, ConvertRawHash blk) =>
Proxy blk -> HeaderHash blk -> Property
roundtrip_ConvertRawHash Proxy (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
pReal

    , TestName
-> (ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"BinaryBlockInfo sanity check" ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Property
prop_shelleyBinaryBlockInfo

    , TestName -> [TestTree] -> TestTree
testGroup TestName
"Integrity"
        [ TestName
-> (Coherent (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"generate non-corrupt blocks"  Coherent (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> Bool
prop_blockIntegrity
        , TestName
-> (Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> Bool)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"generate non-corrupt headers" Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> Bool
prop_headerIntegrity
        , TestName
-> (Coherent (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
    -> Corruption -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"detect corruption in blocks"  Coherent (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Corruption -> Property
prop_detectCorruption_Block
        , TestName
-> (Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
    -> Corruption -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"detect corruption in headers" Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Corruption -> Property
prop_detectCorruption_Header
        ]
    ]
  where
    pReal :: Proxy Block
    pReal :: Proxy (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
pReal = Proxy (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
forall {k} (t :: k). Proxy t
Proxy

    testCodecCfg :: CodecConfig Block
    testCodecCfg :: CodecConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
testCodecCfg = CodecConfig (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
forall proto era. CodecConfig (ShelleyBlock proto era)
ShelleyCodecConfig

    dictNestedHdr ::
         forall a era proto. ShelleyCompatible proto era
      => NestedCtxt_ (ShelleyBlock proto era) Header a -> Dict (Eq a, Show a)
    dictNestedHdr :: forall a era proto.
ShelleyCompatible proto era =>
NestedCtxt_ (ShelleyBlock proto era) Header a
-> Dict (Eq a, Show a)
dictNestedHdr NestedCtxt_ (ShelleyBlock proto era) Header a
R:NestedCtxt_ShelleyBlockfa proto era Header a
CtxtShelley = Dict (Eq a, Show a)
forall (a :: Constraint). a => Dict a
Dict

{-------------------------------------------------------------------------------
  BinaryBlockInfo
-------------------------------------------------------------------------------}

prop_shelleyBinaryBlockInfo :: Block -> Property
prop_shelleyBinaryBlockInfo :: ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Property
prop_shelleyBinaryBlockInfo ShelleyBlock (TPraos MockCrypto) ShelleyEra
blk =
    ByteString
encodedHeader ByteString -> ByteString -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== ByteString
extractedHeader
  where
    BinaryBlockInfo { Word16
headerOffset :: Word16
headerOffset :: BinaryBlockInfo -> Word16
headerOffset, Word16
headerSize :: Word16
headerSize :: BinaryBlockInfo -> Word16
headerSize } =
      ShelleyBlock (TPraos MockCrypto) ShelleyEra -> BinaryBlockInfo
forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> BinaryBlockInfo
shelleyBinaryBlockInfo ShelleyBlock (TPraos MockCrypto) ShelleyEra
blk

    extractedHeader :: Lazy.ByteString
    extractedHeader :: ByteString
extractedHeader =
        Int64 -> ByteString -> ByteString
Lazy.take (Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
headerSize)   (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
        Int64 -> ByteString -> ByteString
Lazy.drop (Word16 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
headerOffset) (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$
        Encoding -> ByteString
CBOR.toLazyByteString (ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Encoding
forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> Encoding
encodeShelleyBlock ShelleyBlock (TPraos MockCrypto) ShelleyEra
blk)

    encodedHeader :: Lazy.ByteString
    encodedHeader :: ByteString
encodedHeader = Encoding -> ByteString
CBOR.toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> Encoding
forall proto era.
ShelleyCompatible proto era =>
Header (ShelleyBlock proto era) -> Encoding
encodeShelleyHeader (ShelleyBlock (TPraos MockCrypto) ShelleyEra
-> Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock (TPraos MockCrypto) ShelleyEra
blk)

{-------------------------------------------------------------------------------
  Integrity
-------------------------------------------------------------------------------}

-- TODO test with real crypto

testTPraosSlotsPerKESPeriod :: Word64
testTPraosSlotsPerKESPeriod :: Word64
testTPraosSlotsPerKESPeriod = Word64
forall a. Bounded a => a
maxBound

-- | Test that the block we generate pass the 'verifyBlockIntegrity' check
prop_blockIntegrity :: Coherent Block -> Bool
prop_blockIntegrity :: Coherent (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> Bool
prop_blockIntegrity =
    Word64 -> ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Bool
forall proto era.
ShelleyCompatible proto era =>
Word64 -> ShelleyBlock proto era -> Bool
verifyBlockIntegrity Word64
testTPraosSlotsPerKESPeriod (ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Bool)
-> (Coherent (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
    -> ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Coherent (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coherent (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> ShelleyBlock (TPraos MockCrypto) ShelleyEra
forall a. Coherent a -> a
getCoherent

-- | Test that the block we generate pass the 'verifyHeaderIntegrity' check
prop_headerIntegrity :: Header Block -> Bool
prop_headerIntegrity :: Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> Bool
prop_headerIntegrity =
  forall proto.
ProtocolHeaderSupportsKES proto =>
Word64 -> ShelleyProtocolHeader proto -> Bool
verifyHeaderIntegrity @(TPraos MockCrypto) Word64
testTPraosSlotsPerKESPeriod
    (BHeader MockCrypto -> Bool)
-> (Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
    -> BHeader MockCrypto)
-> Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> BHeader MockCrypto
Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> ShelleyProtocolHeader (TPraos MockCrypto)
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw

-- | Test that we can detect random bitflips in blocks.
prop_detectCorruption_Block :: Coherent Block -> Corruption -> Property
prop_detectCorruption_Block :: Coherent (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Corruption -> Property
prop_detectCorruption_Block (Coherent ShelleyBlock (TPraos MockCrypto) ShelleyEra
blk) =
    (ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Encoding)
-> (forall s.
    Decoder
      s (ByteString -> ShelleyBlock (TPraos MockCrypto) ShelleyEra))
-> (ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Bool)
-> ShelleyBlock (TPraos MockCrypto) ShelleyEra
-> Corruption
-> Property
forall a.
Show a =>
(a -> Encoding)
-> (forall s. Decoder s (ByteString -> a))
-> (a -> Bool)
-> a
-> Corruption
-> Property
detectCorruption
      ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Encoding
forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> Encoding
encodeShelleyBlock
      Decoder
  s (ByteString -> ShelleyBlock (TPraos MockCrypto) ShelleyEra)
forall s.
Decoder
  s (ByteString -> ShelleyBlock (TPraos MockCrypto) ShelleyEra)
forall proto era s.
ShelleyCompatible proto era =>
Decoder s (ByteString -> ShelleyBlock proto era)
decodeShelleyBlock
      (Word64 -> ShelleyBlock (TPraos MockCrypto) ShelleyEra -> Bool
forall proto era.
ShelleyCompatible proto era =>
Word64 -> ShelleyBlock proto era -> Bool
verifyBlockIntegrity Word64
testTPraosSlotsPerKESPeriod)
      ShelleyBlock (TPraos MockCrypto) ShelleyEra
blk

-- | Test that we can detect random bitflips in blocks.
prop_detectCorruption_Header :: Header Block -> Corruption -> Property
prop_detectCorruption_Header :: Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Corruption -> Property
prop_detectCorruption_Header =
    (Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> Encoding)
-> (forall s.
    Decoder
      s
      (ByteString
       -> Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)))
-> (Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> Bool)
-> Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Corruption
-> Property
forall a.
Show a =>
(a -> Encoding)
-> (forall s. Decoder s (ByteString -> a))
-> (a -> Bool)
-> a
-> Corruption
-> Property
detectCorruption
      Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra) -> Encoding
forall proto era.
ShelleyCompatible proto era =>
Header (ShelleyBlock proto era) -> Encoding
encodeShelleyHeader
      Decoder
  s
  (ByteString
   -> Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
forall s.
Decoder
  s
  (ByteString
   -> Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra))
forall proto era s.
ShelleyCompatible proto era =>
Decoder s (ByteString -> Header (ShelleyBlock proto era))
decodeShelleyHeader
      (forall proto.
ProtocolHeaderSupportsKES proto =>
Word64 -> ShelleyProtocolHeader proto -> Bool
verifyHeaderIntegrity @(TPraos MockCrypto) Word64
testTPraosSlotsPerKESPeriod
        (BHeader MockCrypto -> Bool)
-> (Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
    -> BHeader MockCrypto)
-> Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> BHeader MockCrypto
Header (ShelleyBlock (TPraos MockCrypto) ShelleyEra)
-> ShelleyProtocolHeader (TPraos MockCrypto)
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw)