Skip to content
Permalink
Browse files

Clean: Remove 'Serialise' from VRF functions.

  • Loading branch information...
nc6 committed Apr 15, 2019
1 parent 69189f2 commit 2e76347fd6bfff6655cb63a33653988ebb30a853
@@ -13,17 +13,16 @@ module Ouroboros.Consensus.Crypto.VRF.Class
, verifyCertified
) where

import Codec.Serialise (Serialise)
import Codec.Serialise (Serialise(..))
import Codec.Serialise.Encoding (Encoding)
import Crypto.Random (MonadRandom)
import GHC.Generics (Generic)
import Numeric.Natural

class ( Show (VerKeyVRF v)
, Ord (VerKeyVRF v)
, Serialise (VerKeyVRF v)
, Show (SignKeyVRF v)
, Ord (SignKeyVRF v)
, Serialise (SignKeyVRF v)
, Show (CertVRF v)
, Ord (CertVRF v)
, Serialise (CertVRF v)
@@ -37,8 +36,8 @@ class ( Show (VerKeyVRF v)
maxVRF :: proxy v -> Natural
genKeyVRF :: MonadRandom m => m (SignKeyVRF v)
deriveVerKeyVRF :: SignKeyVRF v -> VerKeyVRF v
evalVRF :: (MonadRandom m, Serialise a) => a -> SignKeyVRF v -> m (Natural, CertVRF v)
verifyVRF :: Serialise a => VerKeyVRF v -> a -> (Natural, CertVRF v) -> Bool
evalVRF :: (MonadRandom m) => (a -> Encoding) -> a -> SignKeyVRF v -> m (Natural, CertVRF v)
verifyVRF :: (a -> Encoding) -> VerKeyVRF v -> a -> (Natural, CertVRF v) -> Bool

data CertifiedVRF v a = CertifiedVRF {
certifiedNatural :: Natural
@@ -51,12 +50,12 @@ deriving instance VRFAlgorithm v => Eq (CertifiedVRF v a)
deriving instance VRFAlgorithm v => Ord (CertifiedVRF v a)

instance VRFAlgorithm v => Serialise (CertifiedVRF v a) where
-- use generic instance for now
-- Use generic instance for now

evalCertified :: (VRFAlgorithm v, MonadRandom m, Serialise a)
=> a -> SignKeyVRF v -> m (CertifiedVRF v a)
evalCertified a key = uncurry CertifiedVRF <$> evalVRF a key
evalCertified :: (VRFAlgorithm v, MonadRandom m)
=> (a -> Encoding) -> a -> SignKeyVRF v -> m (CertifiedVRF v a)
evalCertified toEnc a key = uncurry CertifiedVRF <$> evalVRF toEnc a key

verifyCertified :: (VRFAlgorithm v, Serialise a)
=> VerKeyVRF v -> a -> CertifiedVRF v a -> Bool
verifyCertified vk a CertifiedVRF{..} = verifyVRF vk a (certifiedNatural, certifiedProof)
verifyCertified :: (VRFAlgorithm v)
=> (a -> Encoding) -> VerKeyVRF v -> a -> CertifiedVRF v a -> Bool
verifyCertified toEnc vk a CertifiedVRF{..} = verifyVRF toEnc vk a (certifiedNatural, certifiedProof)
@@ -10,7 +10,8 @@ module Ouroboros.Consensus.Crypto.VRF.Mock
, SignKeyVRF (..)
) where

import Codec.Serialise (Serialise)
import Codec.Serialise (Serialise(..), encode)
import Codec.Serialise.Encoding (Encoding)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
@@ -39,15 +40,14 @@ instance VRFAlgorithm MockVRF where

deriveVerKeyVRF (SignKeyMockVRF n) = VerKeyMockVRF n

evalVRF a sk = return $ evalVRF' a sk
evalVRF toEnc a sk = return $ evalVRF' toEnc a sk

verifyVRF (VerKeyMockVRF n) a c = evalVRF' a (SignKeyMockVRF n) == c
verifyVRF toEnc (VerKeyMockVRF n) a c = evalVRF' toEnc a (SignKeyMockVRF n) == c

evalVRF' :: Serialise a => a -> SignKeyVRF MockVRF -> (Natural, CertVRF MockVRF)
evalVRF' a sk@(SignKeyMockVRF n) =
let y = fromHash $ hash @MD5 $ a :* sk :* Nil
evalVRF' :: (a -> Encoding) -> a -> SignKeyVRF MockVRF -> (Natural, CertVRF MockVRF)
evalVRF' toEnc a sk@(SignKeyMockVRF n) =
let y = fromHash $ hashWithSerialiser @MD5 id $ (toEnc a) <> (encode $ sk :* Nil)
in (y, CertMockVRF n)

instance Serialise (VerKeyVRF MockVRF)
instance Serialise (SignKeyVRF MockVRF)
instance Serialise (CertVRF MockVRF)
@@ -19,7 +19,8 @@ import Data.Function (on)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import Numeric.Natural (Natural)
import Codec.Serialise (Serialise (..))
import Codec.Serialise (Serialise(..))
import Codec.Serialise.Encoding (Encoding)

import Ouroboros.Consensus.Crypto.Hash
import Ouroboros.Consensus.Crypto.VRF.Class
@@ -69,11 +70,11 @@ pow = Point . C.pointBaseMul curve
pow' :: Point -> Integer -> Point
pow' (Point p) n = Point $ C.pointMul curve n p

h :: Serialise a => a -> Natural
h = fromHash . hash @H
h :: Encoding -> Natural
h = fromHash . hashWithSerialiser @H id

h' :: Serialise a => a -> Integer -> Point
h' a l = pow $ mod (l * (fromIntegral $ h a)) q
h' :: Encoding -> Integer -> Point
h' enc l = pow $ mod (l * (fromIntegral $ h enc)) q

getR :: MonadRandom m => m Integer
getR = generateBetween 0 (q - 1)
@@ -99,26 +100,28 @@ instance VRFAlgorithm SimpleVRF where
deriveVerKeyVRF (SignKeySimpleVRF k) =
VerKeySimpleVRF $ pow k

evalVRF a sk@(SignKeySimpleVRF k) = do
let u = h' a k
y = h $ a :* u :* Nil
evalVRF toEnc a sk@(SignKeySimpleVRF k) = do
let u = h' (toEnc a) k
y = h $ (toEnc a) <> (encode $ u :* Nil)
VerKeySimpleVRF v = deriveVerKeyVRF sk
r <- getR
let c = h $ a :* v :* pow r :* h' a r :* Nil
let c = h $ (toEnc a) <> (encode $ v :* pow r :* h' (toEnc a) r :* Nil)
s = mod (r + k * fromIntegral c) q
return (y, CertSimpleVRF u c s)

verifyVRF (VerKeySimpleVRF v) a (y, cert) =
verifyVRF toEnc (VerKeySimpleVRF v) a (y, cert) =
let u = certU cert
c = certC cert
c' = - fromIntegral c
s = certS cert
b1 = y == h (a :* u :* Nil)
rhs = h $ a
:* v
:* (pow s <> pow' v c')
:* (h' a s <> pow' u c')
:* Nil
b1 = y == (h $ (toEnc a) <> (encode $ u :* Nil))
rhs = h $ (toEnc a)
<> (encode
$ v
:* (pow s <> pow' v c')
:* (h' (toEnc a) s <> pow' u c')
:* Nil
)
in b1 && c == rhs

instance Serialise (SignKeyVRF SimpleVRF)
@@ -80,9 +80,6 @@ deriving instance PraosCrypto c => Show (PraosExtraFields c)
deriving instance PraosCrypto c => Eq (PraosExtraFields c)
deriving instance PraosCrypto c => Ord (PraosExtraFields c)

instance VRFAlgorithm (PraosVRF c) => Serialise (PraosExtraFields c)
-- use Generic instance for now

data PraosProof c = PraosProof {
praosProofRho :: CertifiedVRF (PraosVRF c) (HList [Natural, SlotNo, VRFType])
, praosProofY :: CertifiedVRF (PraosVRF c) (HList [Natural, SlotNo, VRFType])
@@ -127,7 +124,7 @@ data PraosParams = PraosParams {
, praosLifetimeKES :: Natural
}

instance PraosCrypto c => OuroborosTag (Praos c) where
instance (Serialise (PraosExtraFields c), PraosCrypto c) => OuroborosTag (Praos c) where

data Payload (Praos c) ph = PraosPayload {
praosSignature :: SignedKES (PraosKES c) (ph, PraosExtraFields c)
@@ -179,8 +176,8 @@ instance PraosCrypto c => OuroborosTag (Praos c) where
RelayId _ -> return Nothing
CoreId nid -> do
let (rho', y', t) = rhoYT cfg cs slot nid
rho <- evalCertified rho' praosSignKeyVRF
y <- evalCertified y' praosSignKeyVRF
rho <- evalCertified encode rho' praosSignKeyVRF
y <- evalCertified encode y' praosSignKeyVRF
return $ if fromIntegral (certifiedNatural y) < t
then Just PraosProof {
praosProofRho = rho
@@ -221,15 +218,15 @@ instance PraosCrypto c => OuroborosTag (Praos c) where
y = praosY praosExtraFields

-- verify rho proof
unless (verifyCertified vkVRF rho' rho) $
unless (verifyCertified encode vkVRF rho' rho) $
throwError $ PraosInvalidCert
vkVRF
(encode rho')
(certifiedNatural rho)
(certifiedProof rho)

-- verify y proof
unless (verifyCertified vkVRF y' y) $
unless (verifyCertified encode vkVRF y' y) $
throwError $ PraosInvalidCert
vkVRF
(encode y')
@@ -285,7 +282,7 @@ infosSlice :: SlotNo -> SlotNo -> [BlockInfo c] -> [BlockInfo c]
infosSlice from to xs = takeWhile (\b -> biSlot b >= from)
$ dropWhile (\b -> biSlot b > to) xs

infosEta :: forall c. PraosCrypto c
infosEta :: forall c. (PraosCrypto c)
=> NodeConfig (Praos c)
-> [BlockInfo c]
-> EpochNo

0 comments on commit 2e76347

Please sign in to comment.
You can’t perform that action at this time.