{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}
{-# 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 qualified Cardano.Crypto.VRF.Praos as Ver03
import Cardano.Crypto.VRF.PraosBatchCompat
import qualified Cardano.Crypto.VRF.PraosBatchCompat as Ver13

import qualified Data.ByteString as BS
import qualified Data.Char as Char
import Data.Proxy (Proxy (..))
import Data.Word (Word64, Word8)
import qualified Text.ParserCombinators.ReadP as Parse
import qualified Text.Read as Read

import Paths_cardano_crypto_tests (getDataFileName)
import Test.Crypto.Util
import Test.QuickCheck (
  Arbitrary (..),
  Gen,
  NonNegative (..),
  Property,
  counterexample,
  (===),
  (==>),
 )
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, HasCallStack, assertBool, assertFailure, testCase, (@?=))
import Test.Tasty.QuickCheck (testProperty, vectorOf)

{- HLINT IGNORE "Use <$>" -}
--
-- The list of all tests
--
tests :: TestTree
tests :: TestTree
tests =
  String -> [TestTree] -> TestTree
testGroup
    String
"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 -> String -> TestTree
testVRFAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy MockVRF) String
"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 -> String -> TestTree
testVRFAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy SimpleVRF) String
"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 -> String -> TestTree
testVRFAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy PraosVRF) String
"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 -> String -> TestTree
testVRFAlgorithm (forall {k} (t :: k). Proxy t
Proxy :: Proxy PraosBatchCompatVRF) String
"PraosBatchCompatVRF"
    , String -> [TestTree] -> TestTree
testGroup
        String
"OutputVRF"
        [ forall a. Testable a => String -> a -> TestTree
testProperty String
"bytesToNatural" [Word8] -> Bool
prop_bytesToNatural
        , forall a. Testable a => String -> a -> TestTree
testProperty String
"naturalToBytes" NonNegative Int -> Word64 -> Property
prop_naturalToBytes
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"ConvertingTypes"
        [ forall a. Testable a => String -> a -> TestTree
testProperty String
"pubKeyToBatchCompat" VerKeyVRF PraosVRF -> Property
prop_pubKeyToBatchComopat
        , forall a. Testable a => String -> a -> TestTree
testProperty String
"signKeyToBatchCompat" SignKeyVRF PraosVRF -> Property
prop_signKeyToBatchCompat
        , forall a. Testable a => String -> a -> TestTree
testProperty String
"outputToBatchCompat" OutputVRF PraosVRF -> Property
prop_outputToBatchComat
        , forall a. Testable a => String -> a -> TestTree
testProperty String
"compatibleVerKeyConversion" SizedSeed 32 -> Message -> Bool
prop_verKeyValidConversion
        , forall a. Testable a => String -> a -> TestTree
testProperty String
"compatibleSignKeyConversion" SizedSeed 32 -> Bool
prop_signKeyValidConversion
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"test vectors for Praos"
        [ String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver03_generated_1" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer03TestVector String
"vrf_ver03_generated_1"
        , String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver03_generated_2" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer03TestVector String
"vrf_ver03_generated_2"
        , String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver03_generated_3" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer03TestVector String
"vrf_ver03_generated_3"
        , String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver03_generated_4" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer03TestVector String
"vrf_ver03_generated_4"
        , -- https://datatracker.ietf.org/doc/draft-irtf-cfrg-vrf/03/ - Section A.4.
          String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver03_standard_10" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer03TestVector String
"vrf_ver03_standard_10"
        , -- https://datatracker.ietf.org/doc/draft-irtf-cfrg-vrf/03/ - Section A.4.
          String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver03_standard_11" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer03TestVector String
"vrf_ver03_standard_11"
        , -- https://datatracker.ietf.org/doc/draft-irtf-cfrg-vrf/03/ - Section A.4.
          String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver03_standard_12" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer03TestVector String
"vrf_ver03_standard_12"
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"test vectors for PraosBatchCompat"
        [ String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver13_generated_1" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer13TestVector String
"vrf_ver13_generated_1"
        , String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver13_generated_2" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer13TestVector String
"vrf_ver13_generated_2"
        , String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver13_generated_3" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer13TestVector String
"vrf_ver13_generated_3"
        , String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver13_generated_4" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer13TestVector String
"vrf_ver13_generated_4"
        , -- https://datatracker.ietf.org/doc/draft-irtf-cfrg-vrf/13/ - example 10
          -- pi = 7d9c633ffeee27349264cf5c667579fc583b4bda63ab71d001f89c10003ab46f14adf9a3cd8b8412d9038531e865c341cafa73589b023d14311c331a9ad15ff2fb37831e00f0acaa6d73bc9997b06501
          String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver13_standard_10" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer13TestVector String
"vrf_ver13_standard_10"
        , -- https://datatracker.ietf.org/doc/draft-irtf-cfrg-vrf/13/ - example 11
          -- pi = 47b327393ff2dd81336f8a2ef10339112401253b3c714eeda879f12c509072ef055b48372bb82efbdce8e10c8cb9a2f9d60e93908f93df1623ad78a86a028d6bc064dbfc75a6a57379ef855dc6733801
          String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver13_standard_11" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer13TestVector String
"vrf_ver13_standard_11"
        , -- https://datatracker.ietf.org/doc/draft-irtf-cfrg-vrf/13/ - example 12
          -- pi = 926e895d308f5e328e7aa159c06eddbe56d06846abf5d98c2512235eaa57fdce35b46edfc655bc828d44ad09d1150f31374e7ef73027e14760d42e77341fe05467bb286cc2c9d7fde29120a0b2320d04
          String -> Assertion -> TestTree
testCase String
"generated golden test vector: vrf_ver13_standard_12" forall a b. (a -> b) -> a -> b
$
            String -> Assertion
checkVer13TestVector String
"vrf_ver13_standard_12"
        ]
    ]

bytesEq :: HasCallStack => (a -> BS.ByteString) -> Maybe a -> a -> Assertion
bytesEq :: forall a.
HasCallStack =>
(a -> ByteString) -> Maybe a -> a -> Assertion
bytesEq a -> ByteString
outputToBytes Maybe a
suppliedM a
expected = case Maybe a
suppliedM of
  Just a
supplied ->
    a -> ByteString
outputToBytes a
supplied forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= a -> ByteString
outputToBytes a
expected
  Maybe a
Nothing ->
    HasCallStack => String -> Bool -> Assertion
assertBool (String
"suppliedM in byteEq gave Nothing") Bool
False

checkVer03TestVector :: FilePath -> Assertion
checkVer03TestVector :: String -> Assertion
checkVer03TestVector String
file = do
  String
filename <- String -> IO String
getDataFileName forall a b. (a -> b) -> a -> b
$ String
"test_vectors/" forall a. Semigroup a => a -> a -> a
<> String
file
  String
str <- String -> IO String
readFile String
filename
  let testVectorE :: Maybe VRFTestVector
testVectorE = forall a. Read a => String -> Maybe a
Read.readMaybe @VRFTestVector String
str
  VRFTestVector {String
ByteString
testVectorHash :: VRFTestVector -> ByteString
testVectorProof :: VRFTestVector -> ByteString
testVectorMessage :: VRFTestVector -> ByteString
testVectorVerifyingKey :: VRFTestVector -> ByteString
testVectorSigningKey :: VRFTestVector -> ByteString
testVectorCipherSuite :: VRFTestVector -> String
testVectorVersion :: VRFTestVector -> String
testVectorName :: VRFTestVector -> String
testVectorHash :: ByteString
testVectorProof :: ByteString
testVectorMessage :: ByteString
testVectorVerifyingKey :: ByteString
testVectorSigningKey :: ByteString
testVectorCipherSuite :: String
testVectorVersion :: String
testVectorName :: String
..} <-
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (forall a. HasCallStack => String -> IO a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"parsing test vector: " forall a. Semigroup a => a -> a -> a
<> String
file forall a. Semigroup a => a -> a -> a
<> String
" not successful")
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
      Maybe VRFTestVector
testVectorE
  SignKey
signKey <- forall (m :: * -> *). MonadFail m => ByteString -> m SignKey
Ver03.skFromBytes ByteString
testVectorSigningKey
  VerKey
verKey <- forall (m :: * -> *). MonadFail m => ByteString -> m VerKey
Ver03.vkFromBytes ByteString
testVectorVerifyingKey
  String
testVectorName forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> String
algorithmNameVRF (forall {k} (t :: k). Proxy t
Proxy :: Proxy PraosVRF)
  String
testVectorVersion forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= String
"ietfdraft03"
  String
testVectorCipherSuite forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= String
"ECVRF-ED25519-SHA512-Elligator2"
  Proof
proof' <- forall (m :: * -> *). MonadFail m => ByteString -> m Proof
Ver03.proofFromBytes ByteString
testVectorProof
  Output
hash' <- forall (m :: * -> *). MonadFail m => ByteString -> m Output
Ver03.outputFromBytes ByteString
testVectorHash
  -- prove signKey msg -> proof
  SignKey -> ByteString -> Maybe Proof
Ver03.prove SignKey
signKey ByteString
testVectorMessage forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a. a -> Maybe a
Just Proof
proof'
  -- signKey -> verKey
  SignKey -> VerKey
Ver03.skToVerKey SignKey
signKey forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= VerKey
verKey
  -- proof -> hashed msg
  forall a.
HasCallStack =>
(a -> ByteString) -> Maybe a -> a -> Assertion
bytesEq Output -> ByteString
Ver03.outputBytes (Proof -> Maybe Output
Ver03.outputFromProof Proof
proof') Output
hash'
  -- verify verKey proof msg -> hashed msg
  forall a.
HasCallStack =>
(a -> ByteString) -> Maybe a -> a -> Assertion
bytesEq Output -> ByteString
Ver03.outputBytes (VerKey -> Proof -> ByteString -> Maybe Output
Ver03.verify VerKey
verKey Proof
proof' ByteString
testVectorMessage) Output
hash'

checkVer13TestVector :: FilePath -> Assertion
checkVer13TestVector :: String -> Assertion
checkVer13TestVector String
file = do
  String
filename <- String -> IO String
getDataFileName forall a b. (a -> b) -> a -> b
$ String
"test_vectors/" forall a. Semigroup a => a -> a -> a
<> String
file
  String
str <- String -> IO String
readFile String
filename
  let testVectorE :: Maybe VRFTestVector
testVectorE = forall a. Read a => String -> Maybe a
Read.readMaybe @VRFTestVector String
str
  VRFTestVector {String
ByteString
testVectorHash :: ByteString
testVectorProof :: ByteString
testVectorMessage :: ByteString
testVectorVerifyingKey :: ByteString
testVectorSigningKey :: ByteString
testVectorCipherSuite :: String
testVectorVersion :: String
testVectorName :: String
testVectorHash :: VRFTestVector -> ByteString
testVectorProof :: VRFTestVector -> ByteString
testVectorMessage :: VRFTestVector -> ByteString
testVectorVerifyingKey :: VRFTestVector -> ByteString
testVectorSigningKey :: VRFTestVector -> ByteString
testVectorCipherSuite :: VRFTestVector -> String
testVectorVersion :: VRFTestVector -> String
testVectorName :: VRFTestVector -> String
..} <-
    forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (forall a. HasCallStack => String -> IO a
assertFailure forall a b. (a -> b) -> a -> b
$ String
"parsing test vector: " forall a. Semigroup a => a -> a -> a
<> String
file forall a. Semigroup a => a -> a -> a
<> String
" not successful")
      forall (f :: * -> *) a. Applicative f => a -> f a
pure
      Maybe VRFTestVector
testVectorE
  let signKey :: SignKey
signKey = ByteString -> SignKey
Ver13.skFromBytes ByteString
testVectorSigningKey
  let verKey :: VerKey
verKey = ByteString -> VerKey
Ver13.vkFromBytes ByteString
testVectorVerifyingKey
  String
testVectorName forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall v (proxy :: * -> *). VRFAlgorithm v => proxy v -> String
algorithmNameVRF (forall {k} (t :: k). Proxy t
Proxy :: Proxy PraosBatchCompatVRF)
  String
testVectorVersion forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= String
"ietfdraft13"
  String
testVectorCipherSuite forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= String
"ECVRF-ED25519-SHA512-Elligator2"
  -- prove signKey msg -> proof
  let proof' :: Proof
proof' = ByteString -> Proof
Ver13.proofFromBytes ByteString
testVectorProof
  Output
hash' <- forall (m :: * -> *). MonadFail m => ByteString -> m Output
Ver13.outputFromBytes ByteString
testVectorHash
  SignKey -> ByteString -> Maybe Proof
Ver13.prove SignKey
signKey ByteString
testVectorMessage forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= forall a. a -> Maybe a
Just Proof
proof'
  -- signKey -> verKey
  SignKey -> VerKey
Ver13.skToVerKey SignKey
signKey forall a. (Eq a, Show a, HasCallStack) => a -> a -> Assertion
@?= VerKey
verKey
  -- proof -> hashed msg
  forall a.
HasCallStack =>
(a -> ByteString) -> Maybe a -> a -> Assertion
bytesEq Output -> ByteString
Ver13.outputBytes (Proof -> Maybe Output
Ver13.outputFromProof Proof
proof') Output
hash'
  -- verify verKey proof msg -> hashed msg
  forall a.
HasCallStack =>
(a -> ByteString) -> Maybe a -> a -> Assertion
bytesEq Output -> ByteString
Ver13.outputBytes (VerKey -> Proof -> ByteString -> Maybe Output
Ver13.verify VerKey
verKey Proof
proof' ByteString
testVectorMessage) Output
hash'

data VRFTestVector = VRFTestVector
  { VRFTestVector -> String
testVectorName :: String
  , VRFTestVector -> String
testVectorVersion :: String
  , VRFTestVector -> String
testVectorCipherSuite :: String
  , VRFTestVector -> ByteString
testVectorSigningKey :: BS.ByteString
  , VRFTestVector -> ByteString
testVectorVerifyingKey :: BS.ByteString
  , VRFTestVector -> ByteString
testVectorMessage :: BS.ByteString
  , VRFTestVector -> ByteString
testVectorProof :: BS.ByteString
  , VRFTestVector -> ByteString
testVectorHash :: BS.ByteString
  }

data HexStringWithLength = HexStringWithLength
  { HexStringWithLength -> String
hswlPayload :: String
  , HexStringWithLength -> Int
hswExpectedLength :: Int
  }
  deriving (Int -> HexStringWithLength -> ShowS
[HexStringWithLength] -> ShowS
HexStringWithLength -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [HexStringWithLength] -> ShowS
$cshowList :: [HexStringWithLength] -> ShowS
show :: HexStringWithLength -> String
$cshow :: HexStringWithLength -> String
showsPrec :: Int -> HexStringWithLength -> ShowS
$cshowsPrec :: Int -> HexStringWithLength -> ShowS
Show, HexStringWithLength -> HexStringWithLength -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HexStringWithLength -> HexStringWithLength -> Bool
$c/= :: HexStringWithLength -> HexStringWithLength -> Bool
== :: HexStringWithLength -> HexStringWithLength -> Bool
$c== :: HexStringWithLength -> HexStringWithLength -> Bool
Eq)

parserHex :: Maybe Int -> Parse.ReadP BS.ByteString
parserHex :: Maybe Int -> ReadP ByteString
parserHex Maybe Int
lenM = do
  String
str <- ReadP String
parseString
  if String
str forall a. Eq a => a -> a -> Bool
== String
"empty"
    then
      forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
BS.empty
    else case Maybe Int
lenM of
      Just Int
len -> forall {f :: * -> *}.
Applicative f =>
String -> Int -> f ByteString
handleDecode String
str Int
len
      Maybe Int
Nothing -> forall {f :: * -> *}.
Applicative f =>
String -> Int -> f ByteString
handleDecode String
str (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
str forall a. Integral a => a -> a -> a
`div` Int
2)
  where
    handleDecode :: String -> Int -> f ByteString
handleDecode String
str Int
size = case String -> Int -> Either String ByteString
decodeHexString String
str Int
size of
      Right ByteString
bs -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
bs
      Left String
err -> forall a. HasCallStack => String -> a
error String
err

parseKey :: String -> Parse.ReadP String
parseKey :: String -> ReadP String
parseKey String
key = do
  String
key' <- String -> ReadP String
Parse.string String
key
  ReadP ()
Parse.skipSpaces
  String
_ <- String -> ReadP String
Parse.string String
":"
  ReadP ()
Parse.skipSpaces
  forall (f :: * -> *) a. Applicative f => a -> f a
pure String
key'

parseEOL :: Parse.ReadP ()
parseEOL :: ReadP ()
parseEOL =
  forall a. [ReadP a] -> ReadP a
Parse.choice
    [ Char -> ReadP Char
Parse.char Char
'\n' forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    , ReadP ()
Parse.eof
    ]

parseContent :: String -> Parse.ReadP a -> Parse.ReadP a
parseContent :: forall a. String -> ReadP a -> ReadP a
parseContent String
key ReadP a
parser =
  forall open close a.
ReadP open -> ReadP close -> ReadP a -> ReadP a
Parse.between (String -> ReadP String
parseKey String
key) ReadP ()
parseEOL ReadP a
parser

parseString :: Parse.ReadP String
parseString :: ReadP String
parseString = (Char -> Bool) -> ReadP String
Parse.munch1 (\Char
c -> Char -> Bool
Char.isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-')

parserVRFTestVector :: Parse.ReadP VRFTestVector
parserVRFTestVector :: ReadP VRFTestVector
parserVRFTestVector = do
  String
testVectorName <- forall a. String -> ReadP a -> ReadP a
parseContent String
"vrf" ReadP String
parseString
  String
testVectorVersion <- forall a. String -> ReadP a -> ReadP a
parseContent String
"ver" ReadP String
parseString
  String
testVectorCipherSuite <- forall a. String -> ReadP a -> ReadP a
parseContent String
"ciphersuite" ReadP String
parseString
  ByteString
sk <- forall a. String -> ReadP a -> ReadP a
parseContent String
"sk" forall a b. (a -> b) -> a -> b
$ Maybe Int -> ReadP ByteString
parserHex (forall a. a -> Maybe a
Just Int
32)
  ByteString
testVectorVerifyingKey <- forall a. String -> ReadP a -> ReadP a
parseContent String
"pk" forall a b. (a -> b) -> a -> b
$ Maybe Int -> ReadP ByteString
parserHex (forall a. a -> Maybe a
Just Int
32)
  let testVectorSigningKey :: ByteString
testVectorSigningKey = ByteString
sk forall a. Semigroup a => a -> a -> a
<> ByteString
testVectorVerifyingKey
  ByteString
testVectorMessage <- forall a. String -> ReadP a -> ReadP a
parseContent String
"alpha" (Maybe Int -> ReadP ByteString
parserHex forall a. Maybe a
Nothing)
  ByteString
testVectorProof <-
    if String
testVectorName forall a. Eq a => a -> a -> Bool
== String
"PraosVRF"
      then
        forall a. String -> ReadP a -> ReadP a
parseContent String
"pi" (Maybe Int -> ReadP ByteString
parserHex (forall a. a -> Maybe a
Just Int
80))
      else
        forall a. String -> ReadP a -> ReadP a
parseContent String
"pi" (Maybe Int -> ReadP ByteString
parserHex (forall a. a -> Maybe a
Just Int
128))
  ByteString
testVectorHash <- forall a. String -> ReadP a -> ReadP a
parseContent String
"beta" (Maybe Int -> ReadP ByteString
parserHex (forall a. a -> Maybe a
Just Int
64))
  forall (f :: * -> *) a. Applicative f => a -> f a
pure VRFTestVector {String
ByteString
testVectorHash :: ByteString
testVectorProof :: ByteString
testVectorMessage :: ByteString
testVectorSigningKey :: ByteString
testVectorVerifyingKey :: ByteString
testVectorCipherSuite :: String
testVectorVersion :: String
testVectorName :: String
testVectorHash :: ByteString
testVectorProof :: ByteString
testVectorMessage :: ByteString
testVectorVerifyingKey :: ByteString
testVectorSigningKey :: ByteString
testVectorCipherSuite :: String
testVectorVersion :: String
testVectorName :: String
..}

instance Read VRFTestVector where
  readsPrec :: Int -> ReadS VRFTestVector
readsPrec Int
_ = forall a. ReadP a -> ReadS a
Parse.readP_to_S ReadP VRFTestVector
parserVRFTestVector

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 -> String -> TestTree
testVRFAlgorithm proxy v
_ String
n =
  String -> [TestTree] -> TestTree
testGroup
    String
n
    [ String -> [TestTree] -> TestTree
testGroup
        String
"serialisation"
        [ String -> [TestTree] -> TestTree
testGroup
            String
"raw"
            [ forall a. Testable a => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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
            ]
        , String -> [TestTree] -> TestTree
testGroup
            String
"size"
            [ forall a. Testable a => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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))
            ]
        , String -> [TestTree] -> TestTree
testGroup
            String
"direct CBOR"
            [ forall a. Testable a => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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
            ]
        , String -> [TestTree] -> TestTree
testGroup
            String
"To/FromCBOR class"
            [ forall a. Testable a => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"Cert" forall a b. (a -> b) -> a -> b
$ forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_cbor @(CertVRF v)
            ]
        , String -> [TestTree] -> TestTree
testGroup
            String
"ToCBOR size"
            [ forall a. Testable a => String -> a -> TestTree
testProperty String
"VerKey" forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size @(VerKeyVRF v)
            , forall a. Testable a => String -> a -> TestTree
testProperty String
"SignKey" forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size @(SignKeyVRF v)
            , forall a. Testable a => String -> a -> TestTree
testProperty String
"Sig" forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Property
prop_cbor_size @(CertVRF v)
            ]
        , String -> [TestTree] -> TestTree
testGroup
            String
"direct matches class"
            [ forall a. Testable a => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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
            ]
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"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 => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"output"
        [ forall a. Testable a => String -> a -> TestTree
testProperty String
"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 => String -> a -> TestTree
testProperty String
"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
        ]
    , String -> [TestTree] -> TestTree
testGroup
        String
"NoThunks"
        [ forall a. Testable a => String -> a -> TestTree
testProperty String
"VerKey" forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => a -> Property
prop_no_thunks @(VerKeyVRF v)
        , forall a. Testable a => String -> a -> TestTree
testProperty String
"SignKey" forall a b. (a -> b) -> a -> b
$ forall a. NoThunks a => a -> Property
prop_no_thunks @(SignKeyVRF v)
        , forall a. Testable a => String -> a -> TestTree
testProperty String
"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 => String -> prop -> Property
counterexample (forall a. Show a => a -> String
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