{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Fake implementation of VRF, where the random value isn't random but given
-- by the creator.
module Test.Cardano.Protocol.Crypto.VRF.Fake (
  NatNonce (..),
  FakeVRF,
  VerKeyVRF (..),
  SignKeyVRF (..),
  WithResult (..),
) where

import Cardano.Crypto.Hash
import Cardano.Crypto.Seed (runMonadRandomWithSeed)
import Cardano.Crypto.Util
import Cardano.Crypto.VRF.Class hiding (
  decodeCertVRF,
  decodeSignKeyVRF,
  decodeVerKeyVRF,
  encodeCertVRF,
  encodeSignKeyVRF,
  encodeVerKeyVRF,
 )
import Cardano.Ledger.BaseTypes (Seed, shelleyProtVer)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), hashWithEncoder)
import Cardano.Ledger.Binary.Crypto (
  decodeCertVRF,
  decodeSignKeyVRF,
  decodeVerKeyVRF,
  encodeCertVRF,
  encodeSignKeyVRF,
  encodeVerKeyVRF,
 )
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Proxy (Proxy (..))
import Data.Word (Word16, Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural

-- | We provide our own nonces to 'mkBlock', which we then wish to recover as
-- the output of the VRF functions. In general, however, we just derive them
-- from a natural. Since the nonce is a hash, we do not want to recover it to
-- find a preimage. In testing, therefore, we just wrap the raw natural, which
-- we then encode into the fake VRF implementation.
newtype NatNonce = NatNonce Natural

data FakeVRF

-- | A class for seeds which sneakily contain the certified output we wish to
-- "randomly" derive from them.
class EncCBOR (Payload a) => SneakilyContainResult a where
  type Payload a
  sneakilyExtractResult :: a -> SignKeyVRF FakeVRF -> OutputVRF FakeVRF
  unsneakilyExtractPayload :: a -> Payload a

data WithResult a = WithResult !a !Word64
  deriving (WithResult a -> WithResult a -> Bool
(WithResult a -> WithResult a -> Bool)
-> (WithResult a -> WithResult a -> Bool) -> Eq (WithResult a)
forall a. Eq a => WithResult a -> WithResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => WithResult a -> WithResult a -> Bool
== :: WithResult a -> WithResult a -> Bool
$c/= :: forall a. Eq a => WithResult a -> WithResult a -> Bool
/= :: WithResult a -> WithResult a -> Bool
Eq, Int -> WithResult a -> ShowS
[WithResult a] -> ShowS
WithResult a -> String
(Int -> WithResult a -> ShowS)
-> (WithResult a -> String)
-> ([WithResult a] -> ShowS)
-> Show (WithResult a)
forall a. Show a => Int -> WithResult a -> ShowS
forall a. Show a => [WithResult a] -> ShowS
forall a. Show a => WithResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> WithResult a -> ShowS
showsPrec :: Int -> WithResult a -> ShowS
$cshow :: forall a. Show a => WithResult a -> String
show :: WithResult a -> String
$cshowList :: forall a. Show a => [WithResult a] -> ShowS
showList :: [WithResult a] -> ShowS
Show)

instance EncCBOR a => SneakilyContainResult (WithResult a) where
  type Payload (WithResult a) = a

  -- Note that this instance completely ignores the key.
  sneakilyExtractResult :: WithResult a -> SignKeyVRF FakeVRF -> OutputVRF FakeVRF
sneakilyExtractResult (WithResult a
_ Word64
nat) SignKeyVRF FakeVRF
_ =
    -- Fill in the word64 as the low 8 bytes of a 16 byte string
    ByteString -> OutputVRF FakeVRF
forall v. ByteString -> OutputVRF v
OutputVRF (Builder -> ByteString
toBytes (Word64 -> Builder
BS.word64BE Word64
0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BS.word64BE Word64
nat))
    where
      toBytes :: Builder -> ByteString
toBytes = ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BS.toLazyByteString

  unsneakilyExtractPayload :: WithResult a -> Payload (WithResult a)
unsneakilyExtractPayload (WithResult a
p Word64
_) = a
Payload (WithResult a)
p

-- | An instance to allow this to be used in the way of `Mock` where no result
-- has been provided.
instance SneakilyContainResult Seed where
  type Payload Seed = Seed
  sneakilyExtractResult :: Seed -> SignKeyVRF FakeVRF -> OutputVRF FakeVRF
sneakilyExtractResult Seed
s SignKeyVRF FakeVRF
sk =
    ByteString -> OutputVRF FakeVRF
forall v. ByteString -> OutputVRF v
OutputVRF
      (ByteString -> OutputVRF FakeVRF)
-> (Encoding -> ByteString) -> Encoding -> OutputVRF FakeVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 Encoding -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes
      (Hash Blake2b_224 Encoding -> ByteString)
-> (Encoding -> Hash Blake2b_224 Encoding)
-> Encoding
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder @Blake2b_224 Version
shelleyProtVer Encoding -> Encoding
forall a. a -> a
id
      (Encoding -> OutputVRF FakeVRF) -> Encoding -> OutputVRF FakeVRF
forall a b. (a -> b) -> a -> b
$ Seed -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Seed
s Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SignKeyVRF FakeVRF -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR SignKeyVRF FakeVRF
sk
  unsneakilyExtractPayload :: Seed -> Payload Seed
unsneakilyExtractPayload = Seed -> Seed
Seed -> Payload Seed
forall a. a -> a
id

instance VRFAlgorithm FakeVRF where
  algorithmNameVRF :: forall (proxy :: * -> *). proxy FakeVRF -> String
algorithmNameVRF proxy FakeVRF
_ = String
"fakeVRF"
  seedSizeVRF :: forall (proxy :: * -> *). proxy FakeVRF -> Word
seedSizeVRF proxy FakeVRF
_ = Word
8

  type Signable FakeVRF = SneakilyContainResult

  newtype VerKeyVRF FakeVRF = VerKeyFakeVRF Word64
    deriving stock (Int -> VerKeyVRF FakeVRF -> ShowS
[VerKeyVRF FakeVRF] -> ShowS
VerKeyVRF FakeVRF -> String
(Int -> VerKeyVRF FakeVRF -> ShowS)
-> (VerKeyVRF FakeVRF -> String)
-> ([VerKeyVRF FakeVRF] -> ShowS)
-> Show (VerKeyVRF FakeVRF)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerKeyVRF FakeVRF -> ShowS
showsPrec :: Int -> VerKeyVRF FakeVRF -> ShowS
$cshow :: VerKeyVRF FakeVRF -> String
show :: VerKeyVRF FakeVRF -> String
$cshowList :: [VerKeyVRF FakeVRF] -> ShowS
showList :: [VerKeyVRF FakeVRF] -> ShowS
Show, (forall x. VerKeyVRF FakeVRF -> Rep (VerKeyVRF FakeVRF) x)
-> (forall x. Rep (VerKeyVRF FakeVRF) x -> VerKeyVRF FakeVRF)
-> Generic (VerKeyVRF FakeVRF)
forall x. Rep (VerKeyVRF FakeVRF) x -> VerKeyVRF FakeVRF
forall x. VerKeyVRF FakeVRF -> Rep (VerKeyVRF FakeVRF) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VerKeyVRF FakeVRF -> Rep (VerKeyVRF FakeVRF) x
from :: forall x. VerKeyVRF FakeVRF -> Rep (VerKeyVRF FakeVRF) x
$cto :: forall x. Rep (VerKeyVRF FakeVRF) x -> VerKeyVRF FakeVRF
to :: forall x. Rep (VerKeyVRF FakeVRF) x -> VerKeyVRF FakeVRF
Generic)
    deriving newtype (VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
(VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool)
-> (VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool)
-> Eq (VerKeyVRF FakeVRF)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
== :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$c/= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
/= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
Eq, Eq (VerKeyVRF FakeVRF)
Eq (VerKeyVRF FakeVRF) =>
(VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Ordering)
-> (VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool)
-> (VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool)
-> (VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool)
-> (VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool)
-> (VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF)
-> (VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF)
-> Ord (VerKeyVRF FakeVRF)
VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Ordering
VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Ordering
compare :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Ordering
$c< :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
< :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$c<= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
<= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$c> :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
> :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$c>= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
>= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$cmax :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF
max :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF
$cmin :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF
min :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF
Ord, Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
Proxy (VerKeyVRF FakeVRF) -> String
(Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo))
-> (Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo))
-> (Proxy (VerKeyVRF FakeVRF) -> String)
-> NoThunks (VerKeyVRF FakeVRF)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (VerKeyVRF FakeVRF) -> String
showTypeOf :: Proxy (VerKeyVRF FakeVRF) -> String
NoThunks)
  newtype SignKeyVRF FakeVRF = SignKeyFakeVRF Word64
    deriving stock (Int -> SignKeyVRF FakeVRF -> ShowS
[SignKeyVRF FakeVRF] -> ShowS
SignKeyVRF FakeVRF -> String
(Int -> SignKeyVRF FakeVRF -> ShowS)
-> (SignKeyVRF FakeVRF -> String)
-> ([SignKeyVRF FakeVRF] -> ShowS)
-> Show (SignKeyVRF FakeVRF)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignKeyVRF FakeVRF -> ShowS
showsPrec :: Int -> SignKeyVRF FakeVRF -> ShowS
$cshow :: SignKeyVRF FakeVRF -> String
show :: SignKeyVRF FakeVRF -> String
$cshowList :: [SignKeyVRF FakeVRF] -> ShowS
showList :: [SignKeyVRF FakeVRF] -> ShowS
Show, (forall x. SignKeyVRF FakeVRF -> Rep (SignKeyVRF FakeVRF) x)
-> (forall x. Rep (SignKeyVRF FakeVRF) x -> SignKeyVRF FakeVRF)
-> Generic (SignKeyVRF FakeVRF)
forall x. Rep (SignKeyVRF FakeVRF) x -> SignKeyVRF FakeVRF
forall x. SignKeyVRF FakeVRF -> Rep (SignKeyVRF FakeVRF) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SignKeyVRF FakeVRF -> Rep (SignKeyVRF FakeVRF) x
from :: forall x. SignKeyVRF FakeVRF -> Rep (SignKeyVRF FakeVRF) x
$cto :: forall x. Rep (SignKeyVRF FakeVRF) x -> SignKeyVRF FakeVRF
to :: forall x. Rep (SignKeyVRF FakeVRF) x -> SignKeyVRF FakeVRF
Generic)
    deriving newtype (SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
(SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool)
-> (SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool)
-> Eq (SignKeyVRF FakeVRF)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
== :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$c/= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
/= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
Eq, Eq (SignKeyVRF FakeVRF)
Eq (SignKeyVRF FakeVRF) =>
(SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Ordering)
-> (SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool)
-> (SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool)
-> (SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool)
-> (SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool)
-> (SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF)
-> (SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF)
-> Ord (SignKeyVRF FakeVRF)
SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Ordering
SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Ordering
compare :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Ordering
$c< :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
< :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$c<= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
<= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$c> :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
> :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$c>= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
>= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$cmax :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF
max :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF
$cmin :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF
min :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF
Ord, Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
Proxy (SignKeyVRF FakeVRF) -> String
(Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo))
-> (Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo))
-> (Proxy (SignKeyVRF FakeVRF) -> String)
-> NoThunks (SignKeyVRF FakeVRF)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (SignKeyVRF FakeVRF) -> String
showTypeOf :: Proxy (SignKeyVRF FakeVRF) -> String
NoThunks)

  data CertVRF FakeVRF = CertFakeVRF !Word64 !Word16 !(OutputVRF FakeVRF)
    deriving stock (Int -> CertVRF FakeVRF -> ShowS
[CertVRF FakeVRF] -> ShowS
CertVRF FakeVRF -> String
(Int -> CertVRF FakeVRF -> ShowS)
-> (CertVRF FakeVRF -> String)
-> ([CertVRF FakeVRF] -> ShowS)
-> Show (CertVRF FakeVRF)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertVRF FakeVRF -> ShowS
showsPrec :: Int -> CertVRF FakeVRF -> ShowS
$cshow :: CertVRF FakeVRF -> String
show :: CertVRF FakeVRF -> String
$cshowList :: [CertVRF FakeVRF] -> ShowS
showList :: [CertVRF FakeVRF] -> ShowS
Show, CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
(CertVRF FakeVRF -> CertVRF FakeVRF -> Bool)
-> (CertVRF FakeVRF -> CertVRF FakeVRF -> Bool)
-> Eq (CertVRF FakeVRF)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
== :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$c/= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
/= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
Eq, Eq (CertVRF FakeVRF)
Eq (CertVRF FakeVRF) =>
(CertVRF FakeVRF -> CertVRF FakeVRF -> Ordering)
-> (CertVRF FakeVRF -> CertVRF FakeVRF -> Bool)
-> (CertVRF FakeVRF -> CertVRF FakeVRF -> Bool)
-> (CertVRF FakeVRF -> CertVRF FakeVRF -> Bool)
-> (CertVRF FakeVRF -> CertVRF FakeVRF -> Bool)
-> (CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF)
-> (CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF)
-> Ord (CertVRF FakeVRF)
CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
CertVRF FakeVRF -> CertVRF FakeVRF -> Ordering
CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: CertVRF FakeVRF -> CertVRF FakeVRF -> Ordering
compare :: CertVRF FakeVRF -> CertVRF FakeVRF -> Ordering
$c< :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
< :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$c<= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
<= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$c> :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
> :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$c>= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
>= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$cmax :: CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF
max :: CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF
$cmin :: CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF
min :: CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF
Ord, (forall x. CertVRF FakeVRF -> Rep (CertVRF FakeVRF) x)
-> (forall x. Rep (CertVRF FakeVRF) x -> CertVRF FakeVRF)
-> Generic (CertVRF FakeVRF)
forall x. Rep (CertVRF FakeVRF) x -> CertVRF FakeVRF
forall x. CertVRF FakeVRF -> Rep (CertVRF FakeVRF) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CertVRF FakeVRF -> Rep (CertVRF FakeVRF) x
from :: forall x. CertVRF FakeVRF -> Rep (CertVRF FakeVRF) x
$cto :: forall x. Rep (CertVRF FakeVRF) x -> CertVRF FakeVRF
to :: forall x. Rep (CertVRF FakeVRF) x -> CertVRF FakeVRF
Generic)
    deriving anyclass (Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo)
Proxy (CertVRF FakeVRF) -> String
(Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo))
-> (Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo))
-> (Proxy (CertVRF FakeVRF) -> String)
-> NoThunks (CertVRF FakeVRF)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (CertVRF FakeVRF) -> String
showTypeOf :: Proxy (CertVRF FakeVRF) -> String
NoThunks)

  genKeyVRF :: Seed -> SignKeyVRF FakeVRF
genKeyVRF Seed
seed = Word64 -> SignKeyVRF FakeVRF
SignKeyFakeVRF (Word64 -> SignKeyVRF FakeVRF) -> Word64 -> SignKeyVRF FakeVRF
forall a b. (a -> b) -> a -> b
$ Seed -> (forall (m :: * -> *). MonadRandom m => m Word64) -> Word64
forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
runMonadRandomWithSeed Seed
seed m Word64
forall (m :: * -> *). MonadRandom m => m Word64
getRandomWord64
  deriveVerKeyVRF :: SignKeyVRF FakeVRF -> VerKeyVRF FakeVRF
deriveVerKeyVRF (SignKeyFakeVRF Word64
n) = Word64 -> VerKeyVRF FakeVRF
VerKeyFakeVRF Word64
n
  evalVRF :: forall a.
(HasCallStack, Signable FakeVRF a) =>
ContextVRF FakeVRF
-> a -> SignKeyVRF FakeVRF -> (OutputVRF FakeVRF, CertVRF FakeVRF)
evalVRF () a
a SignKeyVRF FakeVRF
sk = a -> SignKeyVRF FakeVRF -> (OutputVRF FakeVRF, CertVRF FakeVRF)
forall a.
SneakilyContainResult a =>
a -> SignKeyVRF FakeVRF -> (OutputVRF FakeVRF, CertVRF FakeVRF)
evalFakeVRF a
a SignKeyVRF FakeVRF
sk

  -- This implementation of 'verifyVRF' checks the real proof, which is contained
  -- in the certificate, but ignores the produced value, and insteads returns
  -- the output which is stored in the 'CertFakeVRF'.
  verifyVRF :: forall a.
(HasCallStack, Signable FakeVRF a) =>
ContextVRF FakeVRF
-> VerKeyVRF FakeVRF
-> a
-> CertVRF FakeVRF
-> Maybe (OutputVRF FakeVRF)
verifyVRF () (VerKeyFakeVRF Word64
n) a
a (CertFakeVRF Word64
_ Word16
proof OutputVRF FakeVRF
o)
    | Word16
proof Word16 -> Word16 -> Bool
forall a. Eq a => a -> a -> Bool
== Word16
recomputedProof = OutputVRF FakeVRF -> Maybe (OutputVRF FakeVRF)
forall a. a -> Maybe a
Just OutputVRF FakeVRF
o
    | Bool
otherwise = Maybe (OutputVRF FakeVRF)
forall a. Maybe a
Nothing
    where
      (OutputVRF ByteString
recomputedProofBytes, CertVRF FakeVRF
_) = a -> SignKeyVRF FakeVRF -> (OutputVRF FakeVRF, CertVRF FakeVRF)
forall a.
SneakilyContainResult a =>
a -> SignKeyVRF FakeVRF -> (OutputVRF FakeVRF, CertVRF FakeVRF)
evalFakeVRF a
a (Word64 -> SignKeyVRF FakeVRF
SignKeyFakeVRF Word64
n)
      recomputedProof :: Word16
recomputedProof = Natural -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Word16)
-> (ByteString -> Natural) -> ByteString -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Natural
bytesToNatural (ByteString -> Word16) -> ByteString -> Word16
forall a b. (a -> b) -> a -> b
$ ByteString
recomputedProofBytes

  sizeVerKeyVRF :: forall (proxy :: * -> *). proxy FakeVRF -> Word
sizeVerKeyVRF proxy FakeVRF
_ = Word
8
  sizeSignKeyVRF :: forall (proxy :: * -> *). proxy FakeVRF -> Word
sizeSignKeyVRF proxy FakeVRF
_ = Word
8
  sizeCertVRF :: forall (proxy :: * -> *). proxy FakeVRF -> Word
sizeCertVRF proxy FakeVRF
_ = Word
26
  sizeOutputVRF :: forall (proxy :: * -> *). proxy FakeVRF -> Word
sizeOutputVRF proxy FakeVRF
_ = Proxy Blake2b_224 -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy Blake2b_224
forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b_224)

  rawSerialiseVerKeyVRF :: VerKeyVRF FakeVRF -> ByteString
rawSerialiseVerKeyVRF (VerKeyFakeVRF Word64
k) = Word64 -> ByteString
writeBinaryWord64 Word64
k
  rawSerialiseSignKeyVRF :: SignKeyVRF FakeVRF -> ByteString
rawSerialiseSignKeyVRF (SignKeyFakeVRF Word64
k) = Word64 -> ByteString
writeBinaryWord64 Word64
k
  rawSerialiseCertVRF :: CertVRF FakeVRF -> ByteString
rawSerialiseCertVRF (CertFakeVRF Word64
k Word16
s (OutputVRF ByteString
b)) =
    Word64 -> ByteString
writeBinaryWord64 Word64
k ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Word16 -> ByteString
writeBinaryWord16 Word16
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
b

  rawDeserialiseVerKeyVRF :: ByteString -> Maybe (VerKeyVRF FakeVRF)
rawDeserialiseVerKeyVRF ByteString
bs
    | [ByteString
kb] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
8] ByteString
bs
    , let k :: Word64
k = ByteString -> Word64
readBinaryWord64 ByteString
kb =
        VerKeyVRF FakeVRF -> Maybe (VerKeyVRF FakeVRF)
forall a. a -> Maybe a
Just (VerKeyVRF FakeVRF -> Maybe (VerKeyVRF FakeVRF))
-> VerKeyVRF FakeVRF -> Maybe (VerKeyVRF FakeVRF)
forall a b. (a -> b) -> a -> b
$! Word64 -> VerKeyVRF FakeVRF
VerKeyFakeVRF Word64
k
    | Bool
otherwise =
        Maybe (VerKeyVRF FakeVRF)
forall a. Maybe a
Nothing

  rawDeserialiseSignKeyVRF :: ByteString -> Maybe (SignKeyVRF FakeVRF)
rawDeserialiseSignKeyVRF ByteString
bs
    | [ByteString
kb] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
8] ByteString
bs
    , let k :: Word64
k = ByteString -> Word64
readBinaryWord64 ByteString
kb =
        SignKeyVRF FakeVRF -> Maybe (SignKeyVRF FakeVRF)
forall a. a -> Maybe a
Just (SignKeyVRF FakeVRF -> Maybe (SignKeyVRF FakeVRF))
-> SignKeyVRF FakeVRF -> Maybe (SignKeyVRF FakeVRF)
forall a b. (a -> b) -> a -> b
$! Word64 -> SignKeyVRF FakeVRF
SignKeyFakeVRF Word64
k
    | Bool
otherwise =
        Maybe (SignKeyVRF FakeVRF)
forall a. Maybe a
Nothing

  rawDeserialiseCertVRF :: ByteString -> Maybe (CertVRF FakeVRF)
rawDeserialiseCertVRF ByteString
bs
    | [ByteString
kb, ByteString
smb, ByteString
xs] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
8, Int
2, Int
16] ByteString
bs
    , let k :: Word64
k = ByteString -> Word64
readBinaryWord64 ByteString
kb
    , let s :: Word16
s = ByteString -> Word16
readBinaryWord16 ByteString
smb =
        CertVRF FakeVRF -> Maybe (CertVRF FakeVRF)
forall a. a -> Maybe a
Just (CertVRF FakeVRF -> Maybe (CertVRF FakeVRF))
-> CertVRF FakeVRF -> Maybe (CertVRF FakeVRF)
forall a b. (a -> b) -> a -> b
$! Word64 -> Word16 -> OutputVRF FakeVRF -> CertVRF FakeVRF
CertFakeVRF Word64
k Word16
s (ByteString -> OutputVRF FakeVRF
forall v. ByteString -> OutputVRF v
OutputVRF ByteString
xs)
    | Bool
otherwise =
        Maybe (CertVRF FakeVRF)
forall a. Maybe a
Nothing

evalFakeVRF ::
  SneakilyContainResult a =>
  a ->
  SignKeyVRF FakeVRF ->
  (OutputVRF FakeVRF, CertVRF FakeVRF)
evalFakeVRF :: forall a.
SneakilyContainResult a =>
a -> SignKeyVRF FakeVRF -> (OutputVRF FakeVRF, CertVRF FakeVRF)
evalFakeVRF a
a sk :: SignKeyVRF FakeVRF
sk@(SignKeyFakeVRF Word64
n) =
  let y :: OutputVRF FakeVRF
y = a -> SignKeyVRF FakeVRF -> OutputVRF FakeVRF
forall a.
SneakilyContainResult a =>
a -> SignKeyVRF FakeVRF -> OutputVRF FakeVRF
sneakilyExtractResult a
a SignKeyVRF FakeVRF
sk
      p :: Payload a
p = a -> Payload a
forall a. SneakilyContainResult a => a -> Payload a
unsneakilyExtractPayload a
a
      proof :: Word16
proof =
        Natural -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral
          (Natural -> Word16) -> (Encoding -> Natural) -> Encoding -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Natural
bytesToNatural
          (ByteString -> Natural)
-> (Encoding -> ByteString) -> Encoding -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_224 Encoding -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes
          (Hash Blake2b_224 Encoding -> ByteString)
-> (Encoding -> Hash Blake2b_224 Encoding)
-> Encoding
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder @Blake2b_224 Version
shelleyProtVer Encoding -> Encoding
forall a. a -> a
id
          (Encoding -> Word16) -> Encoding -> Word16
forall a b. (a -> b) -> a -> b
$ Payload a -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Payload a
p Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SignKeyVRF FakeVRF -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR SignKeyVRF FakeVRF
sk
   in (OutputVRF FakeVRF
y, Word64 -> Word16 -> OutputVRF FakeVRF -> CertVRF FakeVRF
CertFakeVRF Word64
n Word16
proof OutputVRF FakeVRF
y)

instance DecCBOR (VerKeyVRF FakeVRF) where
  decCBOR :: forall s. Decoder s (VerKeyVRF FakeVRF)
decCBOR = Decoder s (VerKeyVRF FakeVRF)
forall v s. VRFAlgorithm v => Decoder s (VerKeyVRF v)
decodeVerKeyVRF

instance EncCBOR (VerKeyVRF FakeVRF) where
  encCBOR :: VerKeyVRF FakeVRF -> Encoding
encCBOR = VerKeyVRF FakeVRF -> Encoding
forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF

instance DecCBOR (SignKeyVRF FakeVRF) where
  decCBOR :: forall s. Decoder s (SignKeyVRF FakeVRF)
decCBOR = Decoder s (SignKeyVRF FakeVRF)
forall v s. VRFAlgorithm v => Decoder s (SignKeyVRF v)
decodeSignKeyVRF

instance EncCBOR (SignKeyVRF FakeVRF) where
  encCBOR :: SignKeyVRF FakeVRF -> Encoding
encCBOR = SignKeyVRF FakeVRF -> Encoding
forall v. VRFAlgorithm v => SignKeyVRF v -> Encoding
encodeSignKeyVRF

instance DecCBOR (CertVRF FakeVRF) where
  decCBOR :: forall s. Decoder s (CertVRF FakeVRF)
decCBOR = Decoder s (CertVRF FakeVRF)
forall v s. VRFAlgorithm v => Decoder s (CertVRF v)
decodeCertVRF

instance EncCBOR (CertVRF FakeVRF) where
  encCBOR :: CertVRF FakeVRF -> Encoding
encCBOR = CertVRF FakeVRF -> Encoding
forall v. VRFAlgorithm v => CertVRF v -> Encoding
encodeCertVRF

readBinaryWord16 :: ByteString -> Word16
readBinaryWord16 :: ByteString -> Word16
readBinaryWord16 =
  (Word16 -> Word8 -> Word16) -> Word16 -> ByteString -> Word16
forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\Word16
acc Word8
w8 -> Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
unsafeShiftL Word16
acc Int
8 Word16 -> Word16 -> Word16
forall a. Num a => a -> a -> a
+ Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8) Word16
0

writeBinaryWord16 :: Word16 -> ByteString
writeBinaryWord16 :: Word16 -> ByteString
writeBinaryWord16 =
  ByteString -> ByteString
BS.reverse
    (ByteString -> ByteString)
-> (Word16 -> ByteString) -> Word16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString, Maybe Word16) -> ByteString
forall a b. (a, b) -> a
fst
    ((ByteString, Maybe Word16) -> ByteString)
-> (Word16 -> (ByteString, Maybe Word16)) -> Word16 -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int
-> (Word16 -> Maybe (Word8, Word16))
-> Word16
-> (ByteString, Maybe Word16)
forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN Int
2 (\Word16
w -> (Word8, Word16) -> Maybe (Word8, Word16)
forall a. a -> Maybe a
Just (Word16 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w, Word16 -> Int -> Word16
forall a. Bits a => a -> Int -> a
unsafeShiftR Word16
w Int
8))