module Test.Cardano.Tools.Headers (tests) where

import           Cardano.Tools.Headers (ValidationResult (..), validate)
import qualified Data.Aeson as Json
import           Data.Function ((&))
import qualified Data.Text.Lazy as LT
import           Data.Text.Lazy.Encoding (decodeUtf8)
import           Test.Ouroboros.Consensus.Protocol.Praos.Header (genContext,
                     genMutatedHeader, genSample)
import           Test.QuickCheck (Property, counterexample, forAll, forAllBlind,
                     label, property, (===))
import           Test.Tasty (TestTree, testGroup)
import           Test.Tasty.QuickCheck (testProperty)

tests :: TestTree
tests :: TestTree
tests =
    String -> [TestTree] -> TestTree
testGroup
        String
"HeaderValidation"
        [ String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"roundtrip To/FromJSON samples" Property
prop_roundtrip_json_samples
        , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty String
"validate legit header" Property
prop_validate_legit_header
        ]

prop_roundtrip_json_samples :: Property
prop_roundtrip_json_samples :: Property
prop_roundtrip_json_samples =
    Gen Sample -> (Sample -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Sample
genSample ((Sample -> Property) -> Property)
-> (Sample -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Sample
sample ->
        let encoded :: ByteString
encoded = Sample -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encode Sample
sample
            decoded :: Either String Sample
decoded = ByteString -> Either String Sample
forall a. FromJSON a => ByteString -> Either String a
Json.eitherDecode ByteString
encoded
         in Either String Sample
decoded Either String Sample -> Either String Sample -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Sample -> Either String Sample
forall a b. b -> Either a b
Right Sample
sample

prop_validate_legit_header :: Property
prop_validate_legit_header :: Property
prop_validate_legit_header =
    Gen GeneratorContext -> (GeneratorContext -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind Gen GeneratorContext
genContext ((GeneratorContext -> Property) -> Property)
-> (GeneratorContext -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \GeneratorContext
context ->
        Gen (GeneratorContext, MutatedHeader)
-> ((GeneratorContext, MutatedHeader) -> Property) -> Property
forall prop a. Testable prop => Gen a -> (a -> prop) -> Property
forAllBlind (GeneratorContext -> Gen (GeneratorContext, MutatedHeader)
genMutatedHeader GeneratorContext
context) (((GeneratorContext, MutatedHeader) -> Property) -> Property)
-> ((GeneratorContext, MutatedHeader) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(GeneratorContext
context', MutatedHeader
header) ->
            GeneratorContext -> MutatedHeader -> Property -> Property
forall {prop} {a} {a}.
(Testable prop, ToJSON a, Show a) =>
a -> a -> prop -> Property
annotate GeneratorContext
context' MutatedHeader
header (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                case GeneratorContext -> MutatedHeader -> ValidationResult
validate GeneratorContext
context' MutatedHeader
header of
                    Valid Mutation
mut -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
label (Mutation -> String
forall a. Show a => a -> String
show Mutation
mut)
                    Invalid Mutation
mut String
err -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Expected: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Mutation -> String
forall a. Show a => a -> String
show Mutation
mut String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\nError: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
err)
  where
    annotate :: a -> a -> prop -> Property
annotate a
context a
header =
        String -> prop -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
            ( [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$
                [ String
"context:"
                , a -> String
forall a. ToJSON a => a -> String
asJson a
context
                , String
"header:"
                , a -> String
forall a. Show a => a -> String
show a
header
                ]
            )

    asJson :: (Json.ToJSON a) => a -> String
    asJson :: forall a. ToJSON a => a -> String
asJson = Text -> String
LT.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (a -> ByteString) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> ByteString
forall a. ToJSON a => a -> ByteString
Json.encode