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

module Test.Consensus.Ledger.Mock (tests) where

import           Codec.CBOR.Write (toLazyByteString)
import           Codec.Serialise (Serialise, encode)
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Short as Short
import           Data.Proxy
import           Data.Typeable
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.Mock.Ledger.Block
import           Ouroboros.Consensus.Storage.Common (BinaryBlockInfo (..))
import           Test.Consensus.Ledger.Mock.Generators ()
import           Test.QuickCheck
import           Test.Tasty
import           Test.Tasty.QuickCheck

tests :: TestTree
tests :: TestTree
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
"Mock"
    [ Proxy SimpleStandardCrypto -> TestName -> TestTree
forall c (proxy :: * -> *).
(SimpleCrypto c, Arbitrary (HeaderHash (SimpleBlock c ()))) =>
proxy c -> TestName -> TestTree
props (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SimpleStandardCrypto) TestName
"SimpleStandardCrypto"
    , Proxy SimpleMockCrypto -> TestName -> TestTree
forall c (proxy :: * -> *).
(SimpleCrypto c, Arbitrary (HeaderHash (SimpleBlock c ()))) =>
proxy c -> TestName -> TestTree
props (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @SimpleMockCrypto)     TestName
"SimpleMockCrypto"
    ]
  where
    props :: forall c proxy.
             ( SimpleCrypto c
             , Arbitrary (HeaderHash (SimpleBlock c ()))
             )
          => proxy c -> String -> TestTree
    props :: forall c (proxy :: * -> *).
(SimpleCrypto c, Arbitrary (HeaderHash (SimpleBlock c ()))) =>
proxy c -> TestName -> TestTree
props proxy c
_ TestName
title = TestName -> [TestTree] -> TestTree
testGroup TestName
title
      [ TestName -> (SimpleBlock c () -> Property) -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"BinaryBlockInfo sanity check" (forall c ext.
(SimpleCrypto c, Serialise ext, Typeable ext) =>
SimpleBlock c ext -> Property
prop_simpleBlockBinaryBlockInfo @c @())
      , TestName -> [TestTree] -> TestTree
testGroup TestName
"ConvertRawHash sanity check"
          [ TestName
-> (Hash (SimpleHash c) (Header (SimpleBlock c ())) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"ConvertRawHash roundtrip" (forall c ext.
SimpleCrypto c =>
HeaderHash (SimpleBlock c ext) -> Property
prop_simpleBlock_roundtrip_ConvertRawHash @c @())
          , TestName
-> (Hash (SimpleHash c) (Header (SimpleBlock c ())) -> Property)
-> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"hashSize sanity check" (forall c ext.
SimpleCrypto c =>
HeaderHash (SimpleBlock c ext) -> Property
prop_simpleBlock_hashSize @c @())
          ]
      ]

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

prop_simpleBlockBinaryBlockInfo
  :: (SimpleCrypto c, Serialise ext, Typeable ext)
  => SimpleBlock c ext -> Property
prop_simpleBlockBinaryBlockInfo :: forall c ext.
(SimpleCrypto c, Serialise ext, Typeable ext) =>
SimpleBlock c ext -> Property
prop_simpleBlockBinaryBlockInfo SimpleBlock' c ext ext
blk =
    ByteString
serialisedHeader 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 } =
      SimpleBlock' c ext ext -> BinaryBlockInfo
forall c ext' ext.
(SimpleCrypto c, Serialise ext', Typeable ext, Typeable ext') =>
SimpleBlock' c ext ext' -> BinaryBlockInfo
simpleBlockBinaryBlockInfo SimpleBlock' c ext ext
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
toLazyByteString (SimpleBlock' c ext ext -> Encoding
forall a. Serialise a => a -> Encoding
encode SimpleBlock' c ext ext
blk)

    serialisedHeader :: Lazy.ByteString
    serialisedHeader :: ByteString
serialisedHeader = Encoding -> ByteString
toLazyByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
      (ext -> Encoding) -> Header (SimpleBlock' c ext ext) -> Encoding
forall ext' c ext.
(ext' -> Encoding) -> Header (SimpleBlock' c ext ext') -> Encoding
encodeSimpleHeader ext -> Encoding
forall a. Serialise a => a -> Encoding
encode (SimpleBlock' c ext ext -> Header (SimpleBlock' c ext ext)
forall blk. GetHeader blk => blk -> Header blk
getHeader SimpleBlock' c ext ext
blk)

{-------------------------------------------------------------------------------
  ConvertRawHash
-------------------------------------------------------------------------------}

prop_simpleBlock_roundtrip_ConvertRawHash
  :: forall c ext. SimpleCrypto c
  => HeaderHash (SimpleBlock c ext) -> Property
prop_simpleBlock_roundtrip_ConvertRawHash :: forall c ext.
SimpleCrypto c =>
HeaderHash (SimpleBlock c ext) -> Property
prop_simpleBlock_roundtrip_ConvertRawHash HeaderHash (SimpleBlock' c ext ext)
h =
    Hash (SimpleHash c) (Header (SimpleBlock' c ext ext))
HeaderHash (SimpleBlock' c ext ext)
h Hash (SimpleHash c) (Header (SimpleBlock' c ext ext))
-> Hash (SimpleHash c) (Header (SimpleBlock' c ext ext))
-> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Proxy (SimpleBlock' c ext ext)
-> ShortByteString -> HeaderHash (SimpleBlock' c ext ext)
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> ShortByteString -> HeaderHash blk
forall (proxy :: * -> *).
proxy (SimpleBlock' c ext ext)
-> ShortByteString -> HeaderHash (SimpleBlock' c ext ext)
fromShortRawHash Proxy (SimpleBlock' c ext ext)
p (Proxy (SimpleBlock' c ext ext)
-> HeaderHash (SimpleBlock' c ext ext) -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy (SimpleBlock' c ext ext)
-> HeaderHash (SimpleBlock' c ext ext) -> ShortByteString
toShortRawHash Proxy (SimpleBlock' c ext ext)
p HeaderHash (SimpleBlock' c ext ext)
h)
  where
    p :: Proxy (SimpleBlock' c ext ext)
p = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SimpleBlock c ext)

prop_simpleBlock_hashSize
  :: forall c ext. SimpleCrypto c
  => HeaderHash (SimpleBlock c ext) -> Property
prop_simpleBlock_hashSize :: forall c ext.
SimpleCrypto c =>
HeaderHash (SimpleBlock c ext) -> Property
prop_simpleBlock_hashSize HeaderHash (SimpleBlock c ext)
h =
      TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample (TestName
"rawHash: " TestName -> TestName -> TestName
forall a. [a] -> [a] -> [a]
++ ShortByteString -> TestName
forall a. Show a => a -> TestName
show (Proxy (SimpleBlock c ext)
-> HeaderHash (SimpleBlock c ext) -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy (SimpleBlock c ext)
-> HeaderHash (SimpleBlock c ext) -> ShortByteString
toShortRawHash Proxy (SimpleBlock c ext)
p HeaderHash (SimpleBlock c ext)
h))
    (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Proxy (SimpleBlock c ext) -> Word32
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> Word32
forall (proxy :: * -> *). proxy (SimpleBlock c ext) -> Word32
hashSize Proxy (SimpleBlock c ext)
p Word32 -> Word32 -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ShortByteString -> Int
Short.length (Proxy (SimpleBlock c ext)
-> HeaderHash (SimpleBlock c ext) -> ShortByteString
forall blk (proxy :: * -> *).
ConvertRawHash blk =>
proxy blk -> HeaderHash blk -> ShortByteString
forall (proxy :: * -> *).
proxy (SimpleBlock c ext)
-> HeaderHash (SimpleBlock c ext) -> ShortByteString
toShortRawHash Proxy (SimpleBlock c ext)
p HeaderHash (SimpleBlock c ext)
h))
  where
    p :: Proxy (SimpleBlock c ext)
p = forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(SimpleBlock c ext)