{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Crypto.VRF (
  tests,
)
where

import Cardano.Crypto.Util
import Cardano.Crypto.VRF
import Cardano.Crypto.VRF.Praos
import Cardano.Crypto.VRF.PraosBatchCompat

import qualified Data.ByteString as BS
import Data.Proxy (Proxy (..))
import Data.Word (Word64, Word8)

import Test.Crypto.Util
import Test.QuickCheck (
  Arbitrary (..),
  Gen,
  NonNegative (..),
  Property,
  counterexample,
  (===),
  (==>),
 )
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty, vectorOf)

{- HLINT IGNORE "Use <$>" -}
--
-- The list of all tests
--
tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Crypto.VRF"
    [ forall (proxy :: * -> *) v.
(VRFAlgorithm v, ToCBOR (VerKeyVRF v), FromCBOR (VerKeyVRF v),
 ToCBOR (SignKeyVRF v), FromCBOR (SignKeyVRF v), ToCBOR (CertVRF v),
 FromCBOR (CertVRF v), Eq (SignKeyVRF v), ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
proxy v -> TestName -> TestTree
testVRFAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy MockVRF) TestName
"MockVRF"
    , forall (proxy :: * -> *) v.
(VRFAlgorithm v, ToCBOR (VerKeyVRF v), FromCBOR (VerKeyVRF v),
 ToCBOR (SignKeyVRF v), FromCBOR (SignKeyVRF v), ToCBOR (CertVRF v),
 FromCBOR (CertVRF v), Eq (SignKeyVRF v), ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
proxy v -> TestName -> TestTree
testVRFAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy SimpleVRF) TestName
"SimpleVRF"
    , forall (proxy :: * -> *) v.
(VRFAlgorithm v, ToCBOR (VerKeyVRF v), FromCBOR (VerKeyVRF v),
 ToCBOR (SignKeyVRF v), FromCBOR (SignKeyVRF v), ToCBOR (CertVRF v),
 FromCBOR (CertVRF v), Eq (SignKeyVRF v), ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
proxy v -> TestName -> TestTree
testVRFAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy PraosVRF) TestName
"PraosVRF"
    , forall (proxy :: * -> *) v.
(VRFAlgorithm v, ToCBOR (VerKeyVRF v), FromCBOR (VerKeyVRF v),
 ToCBOR (SignKeyVRF v), FromCBOR (SignKeyVRF v), ToCBOR (CertVRF v),
 FromCBOR (CertVRF v), Eq (SignKeyVRF v), ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
proxy v -> TestName -> TestTree
testVRFAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy PraosBatchCompatVRF) TestName
"PraosBatchCompatVRF"
    , TestName -> [TestTree] -> TestTree
testGroup
        TestName
"OutputVRF"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"bytesToNatural" [Word8] -> Bool
prop_bytesToNatural
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"naturalToBytes" NonNegative Int -> Word64 -> Property
prop_naturalToBytes
        ]
    , TestName -> [TestTree] -> TestTree
testGroup
        TestName
"ConvertingTypes"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"pubKeyToBatchCompat" VerKeyVRF PraosVRF -> Property
prop_pubKeyToBatchComopat
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"signKeyToBatchCompat" SignKeyVRF PraosVRF -> Property
prop_signKeyToBatchCompat
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"outputToBatchCompat" OutputVRF PraosVRF -> Property
prop_outputToBatchComat
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"compatibleVerKeyConversion" SizedSeed 32 -> Message -> Bool
prop_verKeyValidConversion
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"compatibleSignKeyConversion" SizedSeed 32 -> Bool
prop_signKeyValidConversion
        ]
    ]

testVRFAlgorithm ::
  forall proxy v.
  ( VRFAlgorithm v
  , ToCBOR (VerKeyVRF v)
  , FromCBOR (VerKeyVRF v)
  , ToCBOR (SignKeyVRF v)
  , FromCBOR (SignKeyVRF v)
  , ToCBOR (CertVRF v)
  , FromCBOR (CertVRF v)
  , Eq (SignKeyVRF v) -- no Eq for signing keys normally
  , ContextVRF v ~ ()
  , Signable v ~ SignableRepresentation
  ) =>
  proxy v ->
  String ->
  TestTree
testVRFAlgorithm :: forall (proxy :: * -> *) v.
(VRFAlgorithm v, ToCBOR (VerKeyVRF v), FromCBOR (VerKeyVRF v),
 ToCBOR (SignKeyVRF v), FromCBOR (SignKeyVRF v), ToCBOR (CertVRF v),
 FromCBOR (CertVRF v), Eq (SignKeyVRF v), ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
proxy v -> TestName -> TestTree
testVRFAlgorithm proxy v
_ TestName
n =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
n
    [ TestName -> [TestTree] -> TestTree
testGroup
        TestName
"serialisation"
        [ TestName -> [TestTree] -> TestTree
testGroup
            TestName
"raw"
            [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
                forall a.
(Eq a, Show a) =>
(a -> ByteString) -> (ByteString -> Maybe a) -> a -> Property
prop_raw_serialise @(VerKeyVRF v)
                  forall v. VRFAlgorithm v => VerKeyVRF v -> ByteString
rawSerialiseVerKeyVRF
                  forall v. VRFAlgorithm v => ByteString -> Maybe (VerKeyVRF v)
rawDeserialiseVerKeyVRF
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$
                forall a.
(Eq a, Show a) =>
(a -> ByteString) -> (ByteString -> Maybe a) -> a -> Property
prop_raw_serialise @(SignKeyVRF v)
                  forall v. VRFAlgorithm v => SignKeyVRF v -> ByteString
rawSerialiseSignKeyVRF
                  forall v. VRFAlgorithm v => ByteString -> Maybe (SignKeyVRF v)
rawDeserialiseSignKeyVRF
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Cert" forall a b. (a -> b) -> a -> b
$
                forall a.
(Eq a, Show a) =>
(a -> ByteString) -> (ByteString -> Maybe a) -> a -> Property
prop_raw_serialise @(CertVRF v)
                  forall v. VRFAlgorithm v => CertVRF v -> ByteString
rawSerialiseCertVRF
                  forall v. VRFAlgorithm v => ByteString -> Maybe (CertVRF v)
rawDeserialiseCertVRF
            ]
        , TestName -> [TestTree] -> TestTree
testGroup
            TestName
"size"
            [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
                forall a. (a -> ByteString) -> Word -> a -> Property
prop_size_serialise @(VerKeyVRF v)
                  forall v. VRFAlgorithm v => VerKeyVRF v -> ByteString
rawSerialiseVerKeyVRF
                  (forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
sizeVerKeyVRF (forall {k} (t :: k). Proxy t
Proxy @v))
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$
                forall a. (a -> ByteString) -> Word -> a -> Property
prop_size_serialise @(SignKeyVRF v)
                  forall v. VRFAlgorithm v => SignKeyVRF v -> ByteString
rawSerialiseSignKeyVRF
                  (forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
sizeSignKeyVRF (forall {k} (t :: k). Proxy t
Proxy @v))
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Cert" forall a b. (a -> b) -> a -> b
$
                forall a. (a -> ByteString) -> Word -> a -> Property
prop_size_serialise @(CertVRF v)
                  forall v. VRFAlgorithm v => CertVRF v -> ByteString
rawSerialiseCertVRF
                  (forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
sizeCertVRF (forall {k} (t :: k). Proxy t
Proxy @v))
            ]
        , TestName -> [TestTree] -> TestTree
testGroup
            TestName
"direct CBOR"
            [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
                forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with @(VerKeyVRF v)
                  forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF
                  forall v s. VRFAlgorithm v => Decoder s (VerKeyVRF v)
decodeVerKeyVRF
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$
                forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with @(SignKeyVRF v)
                  forall v. VRFAlgorithm v => SignKeyVRF v -> Encoding
encodeSignKeyVRF
                  forall v s. VRFAlgorithm v => Decoder s (SignKeyVRF v)
decodeSignKeyVRF
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Cert" forall a b. (a -> b) -> a -> b
$
                forall a.
(Eq a, Show a) =>
(a -> Encoding) -> (forall s. Decoder s a) -> a -> Property
prop_cbor_with @(CertVRF v)
                  forall v. VRFAlgorithm v => CertVRF v -> Encoding
encodeCertVRF
                  forall v s. VRFAlgorithm v => Decoder s (CertVRF v)
decodeCertVRF
            ]
        , TestName -> [TestTree] -> TestTree
testGroup
            TestName
"To/FromCBOR class"
            [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$ forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor @(VerKeyVRF v)
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$ forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor @(SignKeyVRF v)
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Cert" forall a b. (a -> b) -> a -> b
$ forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor @(CertVRF v)
            ]
        , TestName -> [TestTree] -> TestTree
testGroup
            TestName
"ToCBOR size"
            [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size @(VerKeyVRF v)
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size @(SignKeyVRF v)
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Sig" forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size @(CertVRF v)
            ]
        , TestName -> [TestTree] -> TestTree
testGroup
            TestName
"direct matches class"
            [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$
                forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class @(VerKeyVRF v)
                  forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$
                forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class @(SignKeyVRF v)
                  forall v. VRFAlgorithm v => SignKeyVRF v -> Encoding
encodeSignKeyVRF
            , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Cert" forall a b. (a -> b) -> a -> b
$
                forall a. ToCBOR a => (a -> Encoding) -> a -> Property
prop_cbor_direct_vs_class @(CertVRF v)
                  forall v. VRFAlgorithm v => CertVRF v -> Encoding
encodeCertVRF
            ]
        ]
    , TestName -> [TestTree] -> TestTree
testGroup
        TestName
"verify"
        [ -- NOTE: we no longer test against maxVRF, because the maximum numeric
          -- value isn't actually what we're interested in, as long as all
          -- keys/hashes have the correct sizes, which 'prop_size_serialise'
          -- tests already.
          forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"verify positive" forall a b. (a -> b) -> a -> b
$ forall v.
(VRFAlgorithm v, ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
Message -> SignKeyVRF v -> Bool
prop_vrf_verify_pos @v
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"verify negative" forall a b. (a -> b) -> a -> b
$ forall v.
(VRFAlgorithm v, Eq (SignKeyVRF v), ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
Message -> SignKeyVRF v -> SignKeyVRF v -> Property
prop_vrf_verify_neg @v
        ]
    , TestName -> [TestTree] -> TestTree
testGroup
        TestName
"output"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"sizeOutputVRF" forall a b. (a -> b) -> a -> b
$ forall v.
(VRFAlgorithm v, ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
Message -> SignKeyVRF v -> Property
prop_vrf_output_size @v
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"mkTestOutputVRF" forall a b. (a -> b) -> a -> b
$ forall v.
(VRFAlgorithm v, ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
Message -> SignKeyVRF v -> Property
prop_vrf_output_natural @v
        ]
    , TestName -> [TestTree] -> TestTree
testGroup
        TestName
"NoThunks"
        [ forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"VerKey" forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => a -> Property
prop_no_thunks @(VerKeyVRF v)
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"SignKey" forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => a -> Property
prop_no_thunks @(SignKeyVRF v)
        , forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Cert" forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => a -> Property
prop_no_thunks @(CertVRF v)
        ]
    ]

prop_vrf_verify_pos ::
  forall v.
  ( VRFAlgorithm v
  , ContextVRF v ~ ()
  , Signable v ~ SignableRepresentation
  ) =>
  Message ->
  SignKeyVRF v ->
  Bool
prop_vrf_verify_pos :: forall v.
(VRFAlgorithm v, ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
Message -> SignKeyVRF v -> Bool
prop_vrf_verify_pos Message
a SignKeyVRF v
sk =
  let (OutputVRF v
y, CertVRF v
c) = forall v a.
(VRFAlgorithm v, HasCallStack, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> (OutputVRF v, CertVRF v)
evalVRF () Message
a SignKeyVRF v
sk
      vk :: VerKeyVRF v
vk = forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF SignKeyVRF v
sk
   in forall v a.
(VRFAlgorithm v, HasCallStack, Signable v a) =>
ContextVRF v
-> VerKeyVRF v -> a -> CertVRF v -> Maybe (OutputVRF v)
verifyVRF () VerKeyVRF v
vk Message
a CertVRF v
c forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just OutputVRF v
y

prop_vrf_verify_neg ::
  forall v.
  ( VRFAlgorithm v
  , Eq (SignKeyVRF v)
  , ContextVRF v ~ ()
  , Signable v ~ SignableRepresentation
  ) =>
  Message ->
  SignKeyVRF v ->
  SignKeyVRF v ->
  Property
prop_vrf_verify_neg :: forall v.
(VRFAlgorithm v, Eq (SignKeyVRF v), ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
Message -> SignKeyVRF v -> SignKeyVRF v -> Property
prop_vrf_verify_neg Message
a SignKeyVRF v
sk SignKeyVRF v
sk' =
  SignKeyVRF v
sk
    forall a. Eq a => a -> a -> Bool
/= SignKeyVRF v
sk'
    forall prop. Testable prop => Bool -> prop -> Property
==> let (OutputVRF v
_y, CertVRF v
c) = forall v a.
(VRFAlgorithm v, HasCallStack, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> (OutputVRF v, CertVRF v)
evalVRF () Message
a SignKeyVRF v
sk'
            vk :: VerKeyVRF v
vk = forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF SignKeyVRF v
sk
         in forall v a.
(VRFAlgorithm v, HasCallStack, Signable v a) =>
ContextVRF v
-> VerKeyVRF v -> a -> CertVRF v -> Maybe (OutputVRF v)
verifyVRF () VerKeyVRF v
vk Message
a CertVRF v
c forall a. Eq a => a -> a -> Bool
== forall a. Maybe a
Nothing

prop_vrf_output_size ::
  forall v.
  ( VRFAlgorithm v
  , ContextVRF v ~ ()
  , Signable v ~ SignableRepresentation
  ) =>
  Message ->
  SignKeyVRF v ->
  Property
prop_vrf_output_size :: forall v.
(VRFAlgorithm v, ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
Message -> SignKeyVRF v -> Property
prop_vrf_output_size Message
a SignKeyVRF v
sk =
  let (OutputVRF v
out, CertVRF v
_c) = forall v a.
(VRFAlgorithm v, HasCallStack, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> (OutputVRF v, CertVRF v)
evalVRF () Message
a SignKeyVRF v
sk
   in ByteString -> Int
BS.length (forall v. OutputVRF v -> ByteString
getOutputVRFBytes OutputVRF v
out)
        forall a. (Eq a, Show a) => a -> a -> Property
=== forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
sizeOutputVRF (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))

prop_vrf_output_natural ::
  forall v.
  ( VRFAlgorithm v
  , ContextVRF v ~ ()
  , Signable v ~ SignableRepresentation
  ) =>
  Message ->
  SignKeyVRF v ->
  Property
prop_vrf_output_natural :: forall v.
(VRFAlgorithm v, ContextVRF v ~ (),
 Signable v ~ SignableRepresentation) =>
Message -> SignKeyVRF v -> Property
prop_vrf_output_natural Message
a SignKeyVRF v
sk =
  let (OutputVRF v
out, CertVRF v
_c) = forall v a.
(VRFAlgorithm v, HasCallStack, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> (OutputVRF v, CertVRF v)
evalVRF () Message
a SignKeyVRF v
sk
      n :: Natural
n = forall v. OutputVRF v -> Natural
getOutputVRFNatural OutputVRF v
out
   in forall prop. Testable prop => TestName -> prop -> Property
counterexample (forall a. Show a => a -> TestName
show Natural
n) forall a b. (a -> b) -> a -> b
$
        forall v. VRFAlgorithm v => Natural -> OutputVRF v
mkTestOutputVRF Natural
n forall a. (Eq a, Show a) => a -> a -> Property
=== OutputVRF v
out

--
-- Natural <-> bytes conversion
--

prop_bytesToNatural :: [Word8] -> Bool
prop_bytesToNatural :: [Word8] -> Bool
prop_bytesToNatural [Word8]
ws =
  Int -> Natural -> ByteString
naturalToBytes (ByteString -> Int
BS.length ByteString
bs) (ByteString -> Natural
bytesToNatural ByteString
bs) forall a. Eq a => a -> a -> Bool
== ByteString
bs
  where
    bs :: ByteString
bs = [Word8] -> ByteString
BS.pack [Word8]
ws

prop_naturalToBytes :: NonNegative Int -> Word64 -> Property
prop_naturalToBytes :: NonNegative Int -> Word64 -> Property
prop_naturalToBytes (NonNegative Int
sz) Word64
n =
  Int
sz forall a. Ord a => a -> a -> Bool
>= Int
8 forall prop. Testable prop => Bool -> prop -> Property
==>
    ByteString -> Natural
bytesToNatural (Int -> Natural -> ByteString
naturalToBytes Int
sz (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n)) forall a. Eq a => a -> a -> Bool
== forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
n

--
-- Praos <-> BatchCompatPraos VerKey conversion
--
prop_pubKeyToBatchComopat :: VerKeyVRF PraosVRF -> Property
prop_pubKeyToBatchComopat :: VerKeyVRF PraosVRF -> Property
prop_pubKeyToBatchComopat VerKeyVRF PraosVRF
vk =
  forall v. VRFAlgorithm v => VerKeyVRF v -> ByteString
rawSerialiseVerKeyVRF (VerKeyVRF PraosVRF -> VerKeyVRF PraosBatchCompatVRF
vkToBatchCompat VerKeyVRF PraosVRF
vk) forall a. (Eq a, Show a) => a -> a -> Property
=== forall v. VRFAlgorithm v => VerKeyVRF v -> ByteString
rawSerialiseVerKeyVRF VerKeyVRF PraosVRF
vk

--
-- Praos <-> BatchCompatPraos SignKey conversion
--
prop_signKeyToBatchCompat :: SignKeyVRF PraosVRF -> Property
prop_signKeyToBatchCompat :: SignKeyVRF PraosVRF -> Property
prop_signKeyToBatchCompat SignKeyVRF PraosVRF
sk =
  forall v. VRFAlgorithm v => SignKeyVRF v -> ByteString
rawSerialiseSignKeyVRF (SignKeyVRF PraosVRF -> SignKeyVRF PraosBatchCompatVRF
skToBatchCompat SignKeyVRF PraosVRF
sk) forall a. (Eq a, Show a) => a -> a -> Property
=== forall v. VRFAlgorithm v => SignKeyVRF v -> ByteString
rawSerialiseSignKeyVRF SignKeyVRF PraosVRF
sk

--
-- Praos <-> BatchCompatPraos Output conversion
--
prop_outputToBatchComat :: OutputVRF PraosVRF -> Property
prop_outputToBatchComat :: OutputVRF PraosVRF -> Property
prop_outputToBatchComat OutputVRF PraosVRF
output =
  forall v. OutputVRF v -> ByteString
getOutputVRFBytes (OutputVRF PraosVRF -> OutputVRF PraosBatchCompatVRF
outputToBatchCompat OutputVRF PraosVRF
output) forall a. (Eq a, Show a) => a -> a -> Property
=== forall v. OutputVRF v -> ByteString
getOutputVRFBytes OutputVRF PraosVRF
output

--
-- Praos <-> BatchCompatPraos VerKey compatibility. We check that a proof is validated with a
-- transformed key
--
prop_verKeyValidConversion :: SizedSeed 32 -> Message -> Bool
prop_verKeyValidConversion :: SizedSeed 32 -> Message -> Bool
prop_verKeyValidConversion SizedSeed 32
sharedBytes Message
msg =
  let
    vkPraos :: VerKeyVRF PraosVRF
vkPraos = forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall v. VRFAlgorithm v => Seed -> SignKeyVRF v
genKeyVRF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Natural). SizedSeed n -> Seed
unSizedSeed forall a b. (a -> b) -> a -> b
$ SizedSeed 32
sharedBytes
    skBatchCompat :: SignKeyVRF PraosBatchCompatVRF
skBatchCompat = forall v. VRFAlgorithm v => Seed -> SignKeyVRF v
genKeyVRF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Natural). SizedSeed n -> Seed
unSizedSeed forall a b. (a -> b) -> a -> b
$ SizedSeed 32
sharedBytes
    vkBatchCompat :: VerKeyVRF PraosBatchCompatVRF
vkBatchCompat = VerKeyVRF PraosVRF -> VerKeyVRF PraosBatchCompatVRF
vkToBatchCompat VerKeyVRF PraosVRF
vkPraos
    (OutputVRF PraosBatchCompatVRF
y, CertVRF PraosBatchCompatVRF
c) = forall v a.
(VRFAlgorithm v, HasCallStack, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> (OutputVRF v, CertVRF v)
evalVRF () Message
msg SignKeyVRF PraosBatchCompatVRF
skBatchCompat
   in
    forall v a.
(VRFAlgorithm v, HasCallStack, Signable v a) =>
ContextVRF v
-> VerKeyVRF v -> a -> CertVRF v -> Maybe (OutputVRF v)
verifyVRF () VerKeyVRF PraosBatchCompatVRF
vkBatchCompat Message
msg CertVRF PraosBatchCompatVRF
c forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just OutputVRF PraosBatchCompatVRF
y

--
-- Praos <-> BatchCompatPraos SignKey compatibility. We check that a proof is validated with a
-- transformed key
--
prop_signKeyValidConversion :: SizedSeed 32 -> Bool
prop_signKeyValidConversion :: SizedSeed 32 -> Bool
prop_signKeyValidConversion SizedSeed 32
sharedBytes =
  let
    skPraos :: SignKeyVRF PraosVRF
skPraos = forall v. VRFAlgorithm v => Seed -> SignKeyVRF v
genKeyVRF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Natural). SizedSeed n -> Seed
unSizedSeed forall a b. (a -> b) -> a -> b
$ SizedSeed 32
sharedBytes
    skBatchCompat :: SignKeyVRF PraosBatchCompatVRF
skBatchCompat = forall v. VRFAlgorithm v => Seed -> SignKeyVRF v
genKeyVRF forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (n :: Natural). SizedSeed n -> Seed
unSizedSeed forall a b. (a -> b) -> a -> b
$ SizedSeed 32
sharedBytes
   in
    SignKeyVRF PraosBatchCompatVRF
skBatchCompat forall a. Eq a => a -> a -> Bool
== SignKeyVRF PraosVRF -> SignKeyVRF PraosBatchCompatVRF
skToBatchCompat SignKeyVRF PraosVRF
skPraos

--
-- Arbitrary instances
--

instance VRFAlgorithm v => Arbitrary (VerKeyVRF v) where
  arbitrary :: Gen (VerKeyVRF v)
arbitrary = forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: VerKeyVRF v -> [VerKeyVRF v]
shrink = forall a b. a -> b -> a
const []

instance VRFAlgorithm v => Arbitrary (SignKeyVRF v) where
  arbitrary :: Gen (SignKeyVRF v)
arbitrary = forall v. VRFAlgorithm v => Seed -> SignKeyVRF v
genKeyVRF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word -> Gen Seed
arbitrarySeedOfSize Word
seedSize
    where
      seedSize :: Word
seedSize = forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
seedSizeVRF (forall {k} (t :: k). Proxy t
Proxy :: Proxy v)
  shrink :: SignKeyVRF v -> [SignKeyVRF v]
shrink = forall a b. a -> b -> a
const []

instance
  ( VRFAlgorithm v
  , ContextVRF v ~ ()
  , Signable v ~ SignableRepresentation
  ) =>
  Arbitrary (CertVRF v)
  where
  arbitrary :: Gen (CertVRF v)
arbitrary = do
    Message
a <- forall a. Arbitrary a => Gen a
arbitrary :: Gen Message
    SignKeyVRF v
sk <- forall a. Arbitrary a => Gen a
arbitrary
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd forall a b. (a -> b) -> a -> b
$ forall v a.
(VRFAlgorithm v, HasCallStack, Signable v a) =>
ContextVRF v -> a -> SignKeyVRF v -> (OutputVRF v, CertVRF v)
evalVRF () Message
a SignKeyVRF v
sk
  shrink :: CertVRF v -> [CertVRF v]
shrink = forall a b. a -> b -> a
const []

instance VRFAlgorithm v => Arbitrary (OutputVRF v) where
  arbitrary :: Gen (OutputVRF v)
arbitrary = do
    ByteString
bytes <- [Word8] -> ByteString
BS.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Int -> Gen a -> Gen [a]
vectorOf (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> Word
sizeOutputVRF (forall {k} (t :: k). Proxy t
Proxy :: Proxy v))) forall a. Arbitrary a => Gen a
arbitrary
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall v. ByteString -> OutputVRF v
OutputVRF ByteString
bytes