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

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

import           Cardano.Crypto.Hash (ShortHash)
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.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 ShortHash)) (MockShelley ShortHash))
-> (forall a.
    NestedCtxt_
      (ShelleyBlock
         (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
      Header
      a
    -> Dict (Eq a, Show a))
-> TestTree
forall blk.
(SerialiseDiskConstraints blk, SerialiseNodeToNodeConstraints blk,
 SerialiseNodeToClientConstraints blk,
 Show (BlockNodeToNodeVersion blk),
 Show (BlockNodeToClientVersion blk), StandardHash blk,
 GetHeader blk, Arbitrary' blk, Arbitrary' (Header blk),
 Arbitrary' (HeaderHash blk), Arbitrary' (LedgerState blk),
 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) (SomeSecond BlockQuery blk),
 ArbitraryWithVersion
   (BlockNodeToClientVersion blk) (SomeResult blk),
 ArbitraryWithVersion
   (QueryVersion, BlockNodeToClientVersion blk)
   (SomeSecond Query blk)) =>
CodecConfig blk
-> (forall a. NestedCtxt_ blk Header a -> Dict (Eq a, Show a))
-> TestTree
roundtrip_all CodecConfig
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
testCodecCfg NestedCtxt_
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
  Header
  a
-> Dict (Eq a, Show a)
forall a.
NestedCtxt_
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
  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 (MockCrypto ShortHash) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"hashSize real crypto"       ((ShelleyHash (MockCrypto ShortHash) -> Property) -> TestTree)
-> (ShelleyHash (MockCrypto ShortHash) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ Proxy
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> HeaderHash
     (ShelleyBlock
        (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> Property
forall blk.
ConvertRawHash blk =>
Proxy blk -> HeaderHash blk -> Property
prop_hashSize Proxy
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
pReal
    , TestName
-> (ShelleyHash (MockCrypto ShortHash) -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ConvertRawHash real crypto" ((ShelleyHash (MockCrypto ShortHash) -> Property) -> TestTree)
-> (ShelleyHash (MockCrypto ShortHash) -> Property) -> TestTree
forall a b. (a -> b) -> a -> b
$ Proxy
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> HeaderHash
     (ShelleyBlock
        (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> Property
forall blk.
(StandardHash blk, ConvertRawHash blk) =>
Proxy blk -> HeaderHash blk -> Property
roundtrip_ConvertRawHash Proxy
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
pReal

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

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

    testCodecCfg :: CodecConfig (Block ShortHash)
    testCodecCfg :: CodecConfig
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
testCodecCfg = CodecConfig
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
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 ShortHash -> Property
prop_shelleyBinaryBlockInfo :: ShelleyBlock
  (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)
-> Property
prop_shelleyBinaryBlockInfo ShelleyBlock
  (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)
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 ShortHash)) (MockShelley ShortHash)
-> BinaryBlockInfo
forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> BinaryBlockInfo
shelleyBinaryBlockInfo ShelleyBlock
  (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)
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 ShortHash)) (MockShelley ShortHash)
-> Encoding
forall proto era.
ShelleyCompatible proto era =>
ShelleyBlock proto era -> Encoding
encodeShelleyBlock ShelleyBlock
  (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)
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 ShortHash)) (MockShelley ShortHash))
-> Encoding
forall proto era.
ShelleyCompatible proto era =>
Header (ShelleyBlock proto era) -> Encoding
encodeShelleyHeader (ShelleyBlock
  (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)
-> Header
     (ShelleyBlock
        (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
forall blk. GetHeader blk => blk -> Header blk
getHeader ShelleyBlock
  (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)
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 ShortHash) -> Bool
prop_blockIntegrity :: Coherent
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> Bool
prop_blockIntegrity =
    Word64
-> ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)
-> Bool
forall proto era.
ShelleyCompatible proto era =>
Word64 -> ShelleyBlock proto era -> Bool
verifyBlockIntegrity Word64
testTPraosSlotsPerKESPeriod (ShelleyBlock
   (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)
 -> Bool)
-> (Coherent
      (ShelleyBlock
         (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
    -> ShelleyBlock
         (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> Coherent
     (ShelleyBlock
        (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Coherent
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)
forall a. Coherent a -> a
getCoherent

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

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

-- | Test that we can detect random bitflips in blocks.
prop_detectCorruption_Header :: Header (Block ShortHash) -> Corruption -> Property
prop_detectCorruption_Header :: Header
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> Corruption -> Property
prop_detectCorruption_Header =
    (Header
   (ShelleyBlock
      (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
 -> Encoding)
-> (forall s.
    Decoder
      s
      (ByteString
       -> Header
            (ShelleyBlock
               (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))))
-> (Header
      (ShelleyBlock
         (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
    -> Bool)
-> Header
     (ShelleyBlock
        (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> Corruption
-> Property
forall a.
Show a =>
(a -> Encoding)
-> (forall s. Decoder s (ByteString -> a))
-> (a -> Bool)
-> a
-> Corruption
-> Property
detectCorruption
      Header
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> Encoding
forall proto era.
ShelleyCompatible proto era =>
Header (ShelleyBlock proto era) -> Encoding
encodeShelleyHeader
      Decoder
  s
  (ByteString
   -> Header
        (ShelleyBlock
           (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)))
forall s.
Decoder
  s
  (ByteString
   -> Header
        (ShelleyBlock
           (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash)))
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 ShortHash)) Word64
testTPraosSlotsPerKESPeriod
        (BHeader (MockCrypto ShortHash) -> Bool)
-> (Header
      (ShelleyBlock
         (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
    -> BHeader (MockCrypto ShortHash))
-> Header
     (ShelleyBlock
        (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Header
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> BHeader (MockCrypto ShortHash)
Header
  (ShelleyBlock
     (TPraos (MockCrypto ShortHash)) (MockShelley ShortHash))
-> ShelleyProtocolHeader (TPraos (MockCrypto ShortHash))
forall proto era.
Header (ShelleyBlock proto era) -> ShelleyProtocolHeader proto
shelleyHeaderRaw)