{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | This module implements VRF range extension as described in
-- https://iohk.io/en/research/library/papers/on-uc-secure-range-extension-and-batch-verification-for-ecvrf/
module Ouroboros.Consensus.Protocol.Praos.VRF
  ( InputVRF
  , VRFUsage (..)
  , mkInputVRF
  , vrfLeaderValue
  , vrfNonceValue
  ) where

import Cardano.Binary (ToCBOR)
import Cardano.Crypto.Hash
  ( Blake2b_256
  , Hash
  , castHash
  , hashToBytes
  , hashWith
  , sizeHash
  )
import qualified Cardano.Crypto.Hash as Hash
import Cardano.Crypto.Util
  ( SignableRepresentation (getSignableRepresentation)
  , bytesToNatural
  )
import Cardano.Crypto.VRF
  ( CertifiedVRF (certifiedOutput)
  , OutputVRF (..)
  , getOutputVRFBytes
  )
import Cardano.Ledger.BaseTypes (Nonce (NeutralNonce, Nonce))
import Cardano.Ledger.Binary (runByteBuilder)
import Cardano.Ledger.Hashes (HASH)
import Cardano.Ledger.Slot (SlotNo (SlotNo))
import Cardano.Protocol.Crypto (Crypto (VRF))
import Cardano.Protocol.TPraos.BHeader
  ( BoundedNatural
  , assertBoundedNatural
  )
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Builder.Extra as BS
import Data.Proxy (Proxy (Proxy))
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks)
import Numeric.Natural (Natural)

-- | Input to the verifiable random function. Consists of the hash of the slot
-- and the epoch nonce.
newtype InputVRF = InputVRF {InputVRF -> Hash Blake2b_256 InputVRF
unInputVRF :: Hash Blake2b_256 InputVRF}
  deriving (InputVRF -> InputVRF -> Bool
(InputVRF -> InputVRF -> Bool)
-> (InputVRF -> InputVRF -> Bool) -> Eq InputVRF
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: InputVRF -> InputVRF -> Bool
== :: InputVRF -> InputVRF -> Bool
$c/= :: InputVRF -> InputVRF -> Bool
/= :: InputVRF -> InputVRF -> Bool
Eq, Eq InputVRF
Eq InputVRF =>
(InputVRF -> InputVRF -> Ordering)
-> (InputVRF -> InputVRF -> Bool)
-> (InputVRF -> InputVRF -> Bool)
-> (InputVRF -> InputVRF -> Bool)
-> (InputVRF -> InputVRF -> Bool)
-> (InputVRF -> InputVRF -> InputVRF)
-> (InputVRF -> InputVRF -> InputVRF)
-> Ord InputVRF
InputVRF -> InputVRF -> Bool
InputVRF -> InputVRF -> Ordering
InputVRF -> InputVRF -> InputVRF
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 :: InputVRF -> InputVRF -> Ordering
compare :: InputVRF -> InputVRF -> Ordering
$c< :: InputVRF -> InputVRF -> Bool
< :: InputVRF -> InputVRF -> Bool
$c<= :: InputVRF -> InputVRF -> Bool
<= :: InputVRF -> InputVRF -> Bool
$c> :: InputVRF -> InputVRF -> Bool
> :: InputVRF -> InputVRF -> Bool
$c>= :: InputVRF -> InputVRF -> Bool
>= :: InputVRF -> InputVRF -> Bool
$cmax :: InputVRF -> InputVRF -> InputVRF
max :: InputVRF -> InputVRF -> InputVRF
$cmin :: InputVRF -> InputVRF -> InputVRF
min :: InputVRF -> InputVRF -> InputVRF
Ord, Int -> InputVRF -> ShowS
[InputVRF] -> ShowS
InputVRF -> String
(Int -> InputVRF -> ShowS)
-> (InputVRF -> String) -> ([InputVRF] -> ShowS) -> Show InputVRF
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InputVRF -> ShowS
showsPrec :: Int -> InputVRF -> ShowS
$cshow :: InputVRF -> String
show :: InputVRF -> String
$cshowList :: [InputVRF] -> ShowS
showList :: [InputVRF] -> ShowS
Show, (forall x. InputVRF -> Rep InputVRF x)
-> (forall x. Rep InputVRF x -> InputVRF) -> Generic InputVRF
forall x. Rep InputVRF x -> InputVRF
forall x. InputVRF -> Rep InputVRF x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. InputVRF -> Rep InputVRF x
from :: forall x. InputVRF -> Rep InputVRF x
$cto :: forall x. Rep InputVRF x -> InputVRF
to :: forall x. Rep InputVRF x -> InputVRF
Generic)
  deriving newtype (Context -> InputVRF -> IO (Maybe ThunkInfo)
Proxy InputVRF -> String
(Context -> InputVRF -> IO (Maybe ThunkInfo))
-> (Context -> InputVRF -> IO (Maybe ThunkInfo))
-> (Proxy InputVRF -> String)
-> NoThunks InputVRF
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> InputVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> InputVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> InputVRF -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> InputVRF -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy InputVRF -> String
showTypeOf :: Proxy InputVRF -> String
NoThunks, Typeable InputVRF
Typeable InputVRF =>
(InputVRF -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy InputVRF -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [InputVRF] -> Size)
-> ToCBOR InputVRF
InputVRF -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [InputVRF] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy InputVRF -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: InputVRF -> Encoding
toCBOR :: InputVRF -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy InputVRF -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy InputVRF -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [InputVRF] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [InputVRF] -> Size
ToCBOR)

instance SignableRepresentation InputVRF where
  getSignableRepresentation :: InputVRF -> ByteString
getSignableRepresentation (InputVRF Hash Blake2b_256 InputVRF
x) = Hash Blake2b_256 InputVRF -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes Hash Blake2b_256 InputVRF
x

-- | Construct a unified VRF value
mkInputVRF ::
  SlotNo ->
  -- | Epoch nonce
  Nonce ->
  InputVRF
mkInputVRF :: SlotNo -> Nonce -> InputVRF
mkInputVRF (SlotNo Word64
slot) Nonce
eNonce =
  Hash Blake2b_256 InputVRF -> InputVRF
InputVRF
    (Hash Blake2b_256 InputVRF -> InputVRF)
-> (Builder -> Hash Blake2b_256 InputVRF) -> Builder -> InputVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 ByteString -> Hash Blake2b_256 InputVRF
forall h a b. Hash h a -> Hash h b
Hash.castHash
    (Hash Blake2b_256 ByteString -> Hash Blake2b_256 InputVRF)
-> (Builder -> Hash Blake2b_256 ByteString)
-> Builder
-> Hash Blake2b_256 InputVRF
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Hash.hashWith ByteString -> ByteString
forall a. a -> a
id
    (ByteString -> Hash Blake2b_256 ByteString)
-> (Builder -> ByteString)
-> Builder
-> Hash Blake2b_256 ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder -> ByteString
runByteBuilder (Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32)
    (Builder -> InputVRF) -> Builder -> InputVRF
forall a b. (a -> b) -> a -> b
$ Word64 -> Builder
BS.word64BE Word64
slot
      Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ( case Nonce
eNonce of
             Nonce
NeutralNonce -> Builder
forall a. Monoid a => a
mempty
             Nonce Hash Blake2b_256 Nonce
h -> ByteString -> Builder
BS.byteStringCopy (Hash Blake2b_256 Nonce -> ByteString
forall h a. Hash h a -> ByteString
Hash.hashToBytes Hash Blake2b_256 Nonce
h)
         )

-- | Indicate the usage of the VRF result.
data VRFUsage
  = -- | The VRF value will be used to establish whether the issuing node is
    -- indeed a leader for this slot.
    VRFLeader
  | -- | The VRF value will be used to contribute to the evolving nonce.
    VRFNonce

-- | Singleton VRF usage
data SVRFUsage a where
  SVRFLeader :: SVRFUsage VRFLeader
  SVRFNonce :: SVRFUsage VRFNonce

-- | Indicate the result of the VRF evaluation.
data VRFResult (v :: VRFUsage)

-- | Compute a hash of the unified VRF output appropriate to its usage.
hashVRF ::
  forall (v :: VRFUsage) c proxy.
  proxy c ->
  SVRFUsage v ->
  CertifiedVRF (VRF c) InputVRF ->
  Hash HASH (VRFResult v)
hashVRF :: forall (v :: VRFUsage) c (proxy :: * -> *).
proxy c
-> SVRFUsage v
-> CertifiedVRF (VRF c) InputVRF
-> Hash Blake2b_256 (VRFResult v)
hashVRF proxy c
_ SVRFUsage v
use CertifiedVRF (VRF c) InputVRF
certVRF =
  let vrfOutputAsBytes :: ByteString
vrfOutputAsBytes = OutputVRF (VRF c) -> ByteString
forall v. OutputVRF v -> ByteString
getOutputVRFBytes (OutputVRF (VRF c) -> ByteString)
-> OutputVRF (VRF c) -> ByteString
forall a b. (a -> b) -> a -> b
$ CertifiedVRF (VRF c) InputVRF -> OutputVRF (VRF c)
forall v a. CertifiedVRF v a -> OutputVRF v
certifiedOutput CertifiedVRF (VRF c) InputVRF
certVRF
   in case SVRFUsage v
use of
        SVRFUsage v
SVRFLeader -> Hash Blake2b_256 ByteString -> Hash Blake2b_256 (VRFResult v)
forall h a b. Hash h a -> Hash h b
castHash (Hash Blake2b_256 ByteString -> Hash Blake2b_256 (VRFResult v))
-> Hash Blake2b_256 ByteString -> Hash Blake2b_256 (VRFResult v)
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith ByteString -> ByteString
forall a. a -> a
id (ByteString -> Hash Blake2b_256 ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
"L" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
vrfOutputAsBytes
        SVRFUsage v
SVRFNonce -> Hash Blake2b_256 ByteString -> Hash Blake2b_256 (VRFResult v)
forall h a b. Hash h a -> Hash h b
castHash (Hash Blake2b_256 ByteString -> Hash Blake2b_256 (VRFResult v))
-> Hash Blake2b_256 ByteString -> Hash Blake2b_256 (VRFResult v)
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith ByteString -> ByteString
forall a. a -> a
id (ByteString -> Hash Blake2b_256 ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall a b. (a -> b) -> a -> b
$ ByteString
"N" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
vrfOutputAsBytes

-- | Range-extend a VRF output to be used for leader checks from the relevant
-- hash. See section 4.1 of the linked paper for details.
vrfLeaderValue ::
  forall c proxy.
  proxy c ->
  CertifiedVRF (VRF c) InputVRF ->
  BoundedNatural
vrfLeaderValue :: forall c (proxy :: * -> *).
proxy c -> CertifiedVRF (VRF c) InputVRF -> BoundedNatural
vrfLeaderValue proxy c
p CertifiedVRF (VRF c) InputVRF
cvrf =
  Natural -> Natural -> BoundedNatural
assertBoundedNatural
    ((Natural
2 :: Natural) Natural -> Word -> Natural
forall a b. (Num a, Integral b) => a -> b -> a
^ (Word
8 Word -> Word -> Word
forall a. Num a => a -> a -> a
* Proxy Blake2b_256 -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @HASH)))
    (ByteString -> Natural
bytesToNatural (ByteString -> Natural)
-> (Hash Blake2b_256 (VRFResult 'VRFLeader) -> ByteString)
-> Hash Blake2b_256 (VRFResult 'VRFLeader)
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 (VRFResult 'VRFLeader) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash Blake2b_256 (VRFResult 'VRFLeader) -> Natural)
-> Hash Blake2b_256 (VRFResult 'VRFLeader) -> Natural
forall a b. (a -> b) -> a -> b
$ proxy c
-> SVRFUsage 'VRFLeader
-> CertifiedVRF (VRF c) InputVRF
-> Hash Blake2b_256 (VRFResult 'VRFLeader)
forall (v :: VRFUsage) c (proxy :: * -> *).
proxy c
-> SVRFUsage v
-> CertifiedVRF (VRF c) InputVRF
-> Hash Blake2b_256 (VRFResult v)
hashVRF proxy c
p SVRFUsage 'VRFLeader
SVRFLeader CertifiedVRF (VRF c) InputVRF
cvrf)

-- | Range-extend a VRF output to be used for the evolving nonce. See section
-- 4.1 of the linked paper for details.
vrfNonceValue ::
  forall c proxy.
  proxy c ->
  CertifiedVRF (VRF c) InputVRF ->
  Nonce
vrfNonceValue :: forall c (proxy :: * -> *).
proxy c -> CertifiedVRF (VRF c) InputVRF -> Nonce
vrfNonceValue proxy c
p =
  -- The double hashing below is perhaps a little confusing. The first hash is
  -- how we do range extension as per the VRF paper. The second hash is how we
  -- generate a nonce value from a VRF output. However, that "VRF output" is now
  -- itself a hash.
  --
  -- However, while the VRF hash is crypto-dependent, for the nonce we use a
  -- fixed `Blake2b_256` hashing function. So this double hashing is still
  -- needed.
  Hash Blake2b_256 Nonce -> Nonce
Nonce (Hash Blake2b_256 Nonce -> Nonce)
-> (CertifiedVRF (VRF c) InputVRF -> Hash Blake2b_256 Nonce)
-> CertifiedVRF (VRF c) InputVRF
-> Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 ByteString -> Hash Blake2b_256 Nonce
forall h a b. Hash h a -> Hash h b
castHash (Hash Blake2b_256 ByteString -> Hash Blake2b_256 Nonce)
-> (CertifiedVRF (VRF c) InputVRF -> Hash Blake2b_256 ByteString)
-> CertifiedVRF (VRF c) InputVRF
-> Hash Blake2b_256 Nonce
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> ByteString -> Hash Blake2b_256 ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith ByteString -> ByteString
forall a. a -> a
id (ByteString -> Hash Blake2b_256 ByteString)
-> (CertifiedVRF (VRF c) InputVRF -> ByteString)
-> CertifiedVRF (VRF c) InputVRF
-> Hash Blake2b_256 ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash Blake2b_256 (VRFResult 'VRFNonce) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash Blake2b_256 (VRFResult 'VRFNonce) -> ByteString)
-> (CertifiedVRF (VRF c) InputVRF
    -> Hash Blake2b_256 (VRFResult 'VRFNonce))
-> CertifiedVRF (VRF c) InputVRF
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. proxy c
-> SVRFUsage 'VRFNonce
-> CertifiedVRF (VRF c) InputVRF
-> Hash Blake2b_256 (VRFResult 'VRFNonce)
forall (v :: VRFUsage) c (proxy :: * -> *).
proxy c
-> SVRFUsage v
-> CertifiedVRF (VRF c) InputVRF
-> Hash Blake2b_256 (VRFResult v)
hashVRF proxy c
p SVRFUsage 'VRFNonce
SVRFNonce