{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE TypeApplications           #-}
{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

-- | 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.Crypto (Crypto (HASH, VRF))
import           Cardano.Ledger.Serialization (runByteBuilder)
import           Cardano.Ledger.Slot (SlotNo (SlotNo))
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
/= :: InputVRF -> InputVRF -> Bool
$c/= :: InputVRF -> InputVRF -> Bool
== :: InputVRF -> InputVRF -> Bool
$c== :: 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
min :: InputVRF -> InputVRF -> InputVRF
$cmin :: InputVRF -> InputVRF -> InputVRF
max :: InputVRF -> InputVRF -> InputVRF
$cmax :: InputVRF -> InputVRF -> InputVRF
>= :: InputVRF -> InputVRF -> Bool
$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
compare :: InputVRF -> InputVRF -> Ordering
$ccompare :: InputVRF -> InputVRF -> Ordering
$cp1Ord :: Eq 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
showList :: [InputVRF] -> ShowS
$cshowList :: [InputVRF] -> ShowS
show :: InputVRF -> String
$cshow :: InputVRF -> String
showsPrec :: Int -> InputVRF -> ShowS
$cshowsPrec :: Int -> 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
$cto :: forall x. Rep InputVRF x -> InputVRF
$cfrom :: forall x. InputVRF -> Rep InputVRF x
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
showTypeOf :: Proxy InputVRF -> String
$cshowTypeOf :: Proxy InputVRF -> String
wNoThunks :: Context -> InputVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> InputVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> InputVRF -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> InputVRF -> IO (Maybe ThunkInfo)
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
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [InputVRF] -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [InputVRF] -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy InputVRF -> Size
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy InputVRF -> Size
toCBOR :: InputVRF -> Encoding
$ctoCBOR :: InputVRF -> Encoding
$cp1ToCBOR :: Typeable InputVRF
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.
  (Crypto c) =>
  proxy c ->
  SVRFUsage v ->
  CertifiedVRF (VRF c) InputVRF ->
  Hash (HASH c) (VRFResult v)
hashVRF :: proxy c
-> SVRFUsage v
-> CertifiedVRF (VRF c) InputVRF
-> Hash (HASH c) (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 (HASH c) ByteString -> Hash (HASH c) (VRFResult v)
forall h a b. Hash h a -> Hash h b
castHash (Hash (HASH c) ByteString -> Hash (HASH c) (VRFResult v))
-> Hash (HASH c) ByteString -> Hash (HASH c) (VRFResult v)
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> ByteString -> Hash (HASH c) ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith ByteString -> ByteString
forall a. a -> a
id (ByteString -> Hash (HASH c) ByteString)
-> ByteString -> Hash (HASH c) 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 (HASH c) ByteString -> Hash (HASH c) (VRFResult v)
forall h a b. Hash h a -> Hash h b
castHash (Hash (HASH c) ByteString -> Hash (HASH c) (VRFResult v))
-> Hash (HASH c) ByteString -> Hash (HASH c) (VRFResult v)
forall a b. (a -> b) -> a -> b
$ (ByteString -> ByteString)
-> ByteString -> Hash (HASH c) ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
hashWith ByteString -> ByteString
forall a. a -> a
id (ByteString -> Hash (HASH c) ByteString)
-> ByteString -> Hash (HASH c) 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 2.1 of the linked paper for details.
vrfLeaderValue ::
  forall c proxy.
  Crypto c =>
  proxy c ->
  CertifiedVRF (VRF c) InputVRF ->
  BoundedNatural
vrfLeaderValue :: 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 (HASH c) -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (Proxy (HASH c)
forall k (t :: k). Proxy t
Proxy @(HASH c))))
    (ByteString -> Natural
bytesToNatural (ByteString -> Natural)
-> (Hash (HASH c) (VRFResult 'VRFLeader) -> ByteString)
-> Hash (HASH c) (VRFResult 'VRFLeader)
-> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash (HASH c) (VRFResult 'VRFLeader) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash (HASH c) (VRFResult 'VRFLeader) -> Natural)
-> Hash (HASH c) (VRFResult 'VRFLeader) -> Natural
forall a b. (a -> b) -> a -> b
$ proxy c
-> SVRFUsage 'VRFLeader
-> CertifiedVRF (VRF c) InputVRF
-> Hash (HASH c) (VRFResult 'VRFLeader)
forall (v :: VRFUsage) c (proxy :: * -> *).
Crypto c =>
proxy c
-> SVRFUsage v
-> CertifiedVRF (VRF c) InputVRF
-> Hash (HASH c) (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
-- 2.1 of the linked paper for details.
vrfNonceValue ::
  forall c proxy.
  Crypto c =>
  proxy c ->
  CertifiedVRF (VRF c) InputVRF ->
  Nonce
vrfNonceValue :: 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 (HASH c) (VRFResult 'VRFNonce) -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash (HASH c) (VRFResult 'VRFNonce) -> ByteString)
-> (CertifiedVRF (VRF c) InputVRF
    -> Hash (HASH c) (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 (HASH c) (VRFResult 'VRFNonce)
forall (v :: VRFUsage) c (proxy :: * -> *).
Crypto c =>
proxy c
-> SVRFUsage v
-> CertifiedVRF (VRF c) InputVRF
-> Hash (HASH c) (VRFResult v)
hashVRF proxy c
p SVRFUsage 'VRFNonce
SVRFNonce