{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Mock implementations of verifiable random functions.
module Cardano.Crypto.VRF.Simple (
  SimpleVRF,
  pointFromMaybe,
)
where

import Cardano.Base.Bytes (splitsAt)
import Cardano.Binary (Encoding, FromCBOR (..), ToCBOR (..))
import Cardano.Crypto.Hash
import Cardano.Crypto.Seed
import Cardano.Crypto.Util
import Cardano.Crypto.VRF.Class
import Control.DeepSeq (NFData, force)
import qualified Crypto.PubKey.ECC.Prim as C
import qualified Crypto.PubKey.ECC.Types as C
import Data.Array.Byte (ByteArray)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import NoThunks.Class (InspectHeap (..), NoThunks)
import Numeric.Natural (Natural)

data SimpleVRF

type H = ShortHash

curve :: C.Curve
curve :: Curve
curve = CurveName -> Curve
C.getCurveByName CurveName
C.SEC_t113r1

-- C.curveSizeBits curve = 113 bits, 15 bytes

q :: Integer
q :: Integer
q = CurveCommon -> Integer
C.ecc_n (CurveCommon -> Integer) -> CurveCommon -> Integer
forall a b. (a -> b) -> a -> b
$ Curve -> CurveCommon
C.common_curve Curve
curve

newtype Point = ThunkyPoint C.Point
  deriving (Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
/= :: Point -> Point -> Bool
Eq, (forall x. Point -> Rep Point x)
-> (forall x. Rep Point x -> Point) -> Generic Point
forall x. Rep Point x -> Point
forall x. Point -> Rep Point x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Point -> Rep Point x
from :: forall x. Point -> Rep Point x
$cto :: forall x. Rep Point x -> Point
to :: forall x. Rep Point x -> Point
Generic)
  deriving (Context -> Point -> IO (Maybe ThunkInfo)
Proxy Point -> String
(Context -> Point -> IO (Maybe ThunkInfo))
-> (Context -> Point -> IO (Maybe ThunkInfo))
-> (Proxy Point -> String)
-> NoThunks Point
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> Point -> IO (Maybe ThunkInfo)
noThunks :: Context -> Point -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Point -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> Point -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy Point -> String
showTypeOf :: Proxy Point -> String
NoThunks) via InspectHeap C.Point
  deriving newtype (Point -> ()
(Point -> ()) -> NFData Point
forall a. (a -> ()) -> NFData a
$crnf :: Point -> ()
rnf :: Point -> ()
NFData)

-- | Smart constructor for @Point@ that evaluates the wrapped 'C.Point' to
-- normal form. This is needed because 'C.Point' has a constructor with two
-- 'Integer' arguments that don't have bangs on them.
pattern Point :: C.Point -> Point
pattern $mPoint :: forall {r}. Point -> (Point -> r) -> ((# #) -> r) -> r
$bPoint :: Point -> Point
Point p <- ThunkyPoint p
  where
    Point Point
p = Point -> Point
ThunkyPoint (Point -> Point
forall a. NFData a => a -> a
force Point
p)

{-# COMPLETE Point #-}

instance Show Point where
  show :: Point -> String
show (Point Point
p) = Point -> String
forall a. Show a => a -> String
show Point
p

instance ToCBOR Point where
  toCBOR :: Point -> Encoding
toCBOR (Point Point
p) = Maybe (Integer, Integer) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Maybe (Integer, Integer) -> Encoding)
-> Maybe (Integer, Integer) -> Encoding
forall a b. (a -> b) -> a -> b
$ Point -> Maybe (Integer, Integer)
pointToMaybe Point
p

instance FromCBOR Point where
  fromCBOR :: forall s. Decoder s Point
fromCBOR = Point -> Point
Point (Point -> Point)
-> (Maybe (Integer, Integer) -> Point)
-> Maybe (Integer, Integer)
-> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Integer, Integer) -> Point
pointFromMaybe (Maybe (Integer, Integer) -> Point)
-> Decoder s (Maybe (Integer, Integer)) -> Decoder s Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Maybe (Integer, Integer))
forall s. Decoder s (Maybe (Integer, Integer))
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Semigroup Point where
  Point Point
p <> :: Point -> Point -> Point
<> Point Point
r = Point -> Point
Point (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Curve -> Point -> Point -> Point
C.pointAdd Curve
curve Point
p Point
r

instance Monoid Point where
  mempty :: Point
mempty = Point -> Point
Point Point
C.PointO
  mappend :: Point -> Point -> Point
mappend = Point -> Point -> Point
forall a. Semigroup a => a -> a -> a
(<>)

pointToMaybe :: C.Point -> Maybe (Integer, Integer)
pointToMaybe :: Point -> Maybe (Integer, Integer)
pointToMaybe Point
C.PointO = Maybe (Integer, Integer)
forall a. Maybe a
Nothing
pointToMaybe (C.Point Integer
x Integer
y) = (Integer, Integer) -> Maybe (Integer, Integer)
forall a. a -> Maybe a
Just (Integer
x, Integer
y)

pointFromMaybe :: Maybe (Integer, Integer) -> C.Point
pointFromMaybe :: Maybe (Integer, Integer) -> Point
pointFromMaybe Maybe (Integer, Integer)
Nothing = Point
C.PointO
pointFromMaybe (Just (Integer
x, Integer
y)) = Integer -> Integer -> Point
C.Point Integer
x Integer
y

pow :: Integer -> Point
pow :: Integer -> Point
pow = Point -> Point
Point (Point -> Point) -> (Integer -> Point) -> Integer -> Point
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Curve -> Integer -> Point
C.pointBaseMul Curve
curve

pow' :: Point -> Integer -> Point
pow' :: Point -> Integer -> Point
pow' (Point Point
p) Integer
n = Point -> Point
Point (Point -> Point) -> Point -> Point
forall a b. (a -> b) -> a -> b
$ Curve -> Integer -> Point -> Point
C.pointMul Curve
curve Integer
n Point
p

h :: Encoding -> ByteString
h :: Encoding -> ByteString
h = Hash H Encoding -> ByteString
forall h a. Hash h a -> ByteString
hashToBytes (Hash H Encoding -> ByteString)
-> (Encoding -> Hash H Encoding) -> Encoding -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
hashWithSerialiser @H Encoding -> Encoding
forall a. a -> a
id

hashedEncodingAsByteArray :: Encoding -> ByteArray
hashedEncodingAsByteArray :: Encoding -> ByteArray
hashedEncodingAsByteArray = Hash H Encoding -> ByteArray
forall h a. Hash h a -> ByteArray
hashToByteArray (Hash H Encoding -> ByteArray)
-> (Encoding -> Hash H Encoding) -> Encoding -> ByteArray
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
hashWithSerialiser @H Encoding -> Encoding
forall a. a -> a
id

h' :: Encoding -> Integer -> Point
h' :: Encoding -> Integer -> Point
h' Encoding
enc Integer
l = Integer -> Point
pow (Integer -> Point) -> Integer -> Point
forall a b. (a -> b) -> a -> b
$ Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod (Integer
l Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (Natural -> Integer)
-> (ByteString -> Natural) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Natural
bytesToNatural (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString
h Encoding
enc)) Integer
q

instance VRFAlgorithm SimpleVRF where
  --
  -- Key and signature types
  --

  newtype VerKeyVRF SimpleVRF = VerKeySimpleVRF Point
    deriving stock (Int -> VerKeyVRF SimpleVRF -> ShowS
[VerKeyVRF SimpleVRF] -> ShowS
VerKeyVRF SimpleVRF -> String
(Int -> VerKeyVRF SimpleVRF -> ShowS)
-> (VerKeyVRF SimpleVRF -> String)
-> ([VerKeyVRF SimpleVRF] -> ShowS)
-> Show (VerKeyVRF SimpleVRF)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> VerKeyVRF SimpleVRF -> ShowS
showsPrec :: Int -> VerKeyVRF SimpleVRF -> ShowS
$cshow :: VerKeyVRF SimpleVRF -> String
show :: VerKeyVRF SimpleVRF -> String
$cshowList :: [VerKeyVRF SimpleVRF] -> ShowS
showList :: [VerKeyVRF SimpleVRF] -> ShowS
Show, VerKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF -> Bool
(VerKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF -> Bool)
-> (VerKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF -> Bool)
-> Eq (VerKeyVRF SimpleVRF)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: VerKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF -> Bool
== :: VerKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF -> Bool
$c/= :: VerKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF -> Bool
/= :: VerKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF -> Bool
Eq, (forall x. VerKeyVRF SimpleVRF -> Rep (VerKeyVRF SimpleVRF) x)
-> (forall x. Rep (VerKeyVRF SimpleVRF) x -> VerKeyVRF SimpleVRF)
-> Generic (VerKeyVRF SimpleVRF)
forall x. Rep (VerKeyVRF SimpleVRF) x -> VerKeyVRF SimpleVRF
forall x. VerKeyVRF SimpleVRF -> Rep (VerKeyVRF SimpleVRF) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. VerKeyVRF SimpleVRF -> Rep (VerKeyVRF SimpleVRF) x
from :: forall x. VerKeyVRF SimpleVRF -> Rep (VerKeyVRF SimpleVRF) x
$cto :: forall x. Rep (VerKeyVRF SimpleVRF) x -> VerKeyVRF SimpleVRF
to :: forall x. Rep (VerKeyVRF SimpleVRF) x -> VerKeyVRF SimpleVRF
Generic)
    deriving newtype (Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
Proxy (VerKeyVRF SimpleVRF) -> String
(Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo))
-> (Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo))
-> (Proxy (VerKeyVRF SimpleVRF) -> String)
-> NoThunks (VerKeyVRF SimpleVRF)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (VerKeyVRF SimpleVRF) -> String
showTypeOf :: Proxy (VerKeyVRF SimpleVRF) -> String
NoThunks)
    deriving anyclass (VerKeyVRF SimpleVRF -> ()
(VerKeyVRF SimpleVRF -> ()) -> NFData (VerKeyVRF SimpleVRF)
forall a. (a -> ()) -> NFData a
$crnf :: VerKeyVRF SimpleVRF -> ()
rnf :: VerKeyVRF SimpleVRF -> ()
NFData)

  newtype SignKeyVRF SimpleVRF = SignKeySimpleVRF C.PrivateNumber
    deriving stock (Int -> SignKeyVRF SimpleVRF -> ShowS
[SignKeyVRF SimpleVRF] -> ShowS
SignKeyVRF SimpleVRF -> String
(Int -> SignKeyVRF SimpleVRF -> ShowS)
-> (SignKeyVRF SimpleVRF -> String)
-> ([SignKeyVRF SimpleVRF] -> ShowS)
-> Show (SignKeyVRF SimpleVRF)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SignKeyVRF SimpleVRF -> ShowS
showsPrec :: Int -> SignKeyVRF SimpleVRF -> ShowS
$cshow :: SignKeyVRF SimpleVRF -> String
show :: SignKeyVRF SimpleVRF -> String
$cshowList :: [SignKeyVRF SimpleVRF] -> ShowS
showList :: [SignKeyVRF SimpleVRF] -> ShowS
Show, SignKeyVRF SimpleVRF -> SignKeyVRF SimpleVRF -> Bool
(SignKeyVRF SimpleVRF -> SignKeyVRF SimpleVRF -> Bool)
-> (SignKeyVRF SimpleVRF -> SignKeyVRF SimpleVRF -> Bool)
-> Eq (SignKeyVRF SimpleVRF)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SignKeyVRF SimpleVRF -> SignKeyVRF SimpleVRF -> Bool
== :: SignKeyVRF SimpleVRF -> SignKeyVRF SimpleVRF -> Bool
$c/= :: SignKeyVRF SimpleVRF -> SignKeyVRF SimpleVRF -> Bool
/= :: SignKeyVRF SimpleVRF -> SignKeyVRF SimpleVRF -> Bool
Eq, (forall x. SignKeyVRF SimpleVRF -> Rep (SignKeyVRF SimpleVRF) x)
-> (forall x. Rep (SignKeyVRF SimpleVRF) x -> SignKeyVRF SimpleVRF)
-> Generic (SignKeyVRF SimpleVRF)
forall x. Rep (SignKeyVRF SimpleVRF) x -> SignKeyVRF SimpleVRF
forall x. SignKeyVRF SimpleVRF -> Rep (SignKeyVRF SimpleVRF) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SignKeyVRF SimpleVRF -> Rep (SignKeyVRF SimpleVRF) x
from :: forall x. SignKeyVRF SimpleVRF -> Rep (SignKeyVRF SimpleVRF) x
$cto :: forall x. Rep (SignKeyVRF SimpleVRF) x -> SignKeyVRF SimpleVRF
to :: forall x. Rep (SignKeyVRF SimpleVRF) x -> SignKeyVRF SimpleVRF
Generic)
    deriving (Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
Proxy (SignKeyVRF SimpleVRF) -> String
(Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo))
-> (Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo))
-> (Proxy (SignKeyVRF SimpleVRF) -> String)
-> NoThunks (SignKeyVRF SimpleVRF)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (SignKeyVRF SimpleVRF) -> String
showTypeOf :: Proxy (SignKeyVRF SimpleVRF) -> String
NoThunks) via InspectHeap C.PrivateNumber
    deriving anyclass (SignKeyVRF SimpleVRF -> ()
(SignKeyVRF SimpleVRF -> ()) -> NFData (SignKeyVRF SimpleVRF)
forall a. (a -> ()) -> NFData a
$crnf :: SignKeyVRF SimpleVRF -> ()
rnf :: SignKeyVRF SimpleVRF -> ()
NFData)

  data CertVRF SimpleVRF = CertSimpleVRF
    { CertVRF SimpleVRF -> Point
certU :: !Point -- 15 byte point numbers, round up to 16
    , CertVRF SimpleVRF -> Natural
certC :: !Natural -- md5 hash, so 16 bytes
    , CertVRF SimpleVRF -> Integer
certS :: !Integer -- at most q, so 15 bytes, round up to 16
    }
    deriving stock (Int -> CertVRF SimpleVRF -> ShowS
[CertVRF SimpleVRF] -> ShowS
CertVRF SimpleVRF -> String
(Int -> CertVRF SimpleVRF -> ShowS)
-> (CertVRF SimpleVRF -> String)
-> ([CertVRF SimpleVRF] -> ShowS)
-> Show (CertVRF SimpleVRF)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertVRF SimpleVRF -> ShowS
showsPrec :: Int -> CertVRF SimpleVRF -> ShowS
$cshow :: CertVRF SimpleVRF -> String
show :: CertVRF SimpleVRF -> String
$cshowList :: [CertVRF SimpleVRF] -> ShowS
showList :: [CertVRF SimpleVRF] -> ShowS
Show, CertVRF SimpleVRF -> CertVRF SimpleVRF -> Bool
(CertVRF SimpleVRF -> CertVRF SimpleVRF -> Bool)
-> (CertVRF SimpleVRF -> CertVRF SimpleVRF -> Bool)
-> Eq (CertVRF SimpleVRF)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertVRF SimpleVRF -> CertVRF SimpleVRF -> Bool
== :: CertVRF SimpleVRF -> CertVRF SimpleVRF -> Bool
$c/= :: CertVRF SimpleVRF -> CertVRF SimpleVRF -> Bool
/= :: CertVRF SimpleVRF -> CertVRF SimpleVRF -> Bool
Eq, (forall x. CertVRF SimpleVRF -> Rep (CertVRF SimpleVRF) x)
-> (forall x. Rep (CertVRF SimpleVRF) x -> CertVRF SimpleVRF)
-> Generic (CertVRF SimpleVRF)
forall x. Rep (CertVRF SimpleVRF) x -> CertVRF SimpleVRF
forall x. CertVRF SimpleVRF -> Rep (CertVRF SimpleVRF) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. CertVRF SimpleVRF -> Rep (CertVRF SimpleVRF) x
from :: forall x. CertVRF SimpleVRF -> Rep (CertVRF SimpleVRF) x
$cto :: forall x. Rep (CertVRF SimpleVRF) x -> CertVRF SimpleVRF
to :: forall x. Rep (CertVRF SimpleVRF) x -> CertVRF SimpleVRF
Generic)
    deriving anyclass (Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo)
Proxy (CertVRF SimpleVRF) -> String
(Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo))
-> (Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo))
-> (Proxy (CertVRF SimpleVRF) -> String)
-> NoThunks (CertVRF SimpleVRF)
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
$cnoThunks :: Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy (CertVRF SimpleVRF) -> String
showTypeOf :: Proxy (CertVRF SimpleVRF) -> String
NoThunks)
    deriving anyclass (CertVRF SimpleVRF -> ()
(CertVRF SimpleVRF -> ()) -> NFData (CertVRF SimpleVRF)
forall a. (a -> ()) -> NFData a
$crnf :: CertVRF SimpleVRF -> ()
rnf :: CertVRF SimpleVRF -> ()
NFData)

  --
  -- Metadata and basic key operations
  --

  algorithmNameVRF :: forall (proxy :: * -> *). proxy SimpleVRF -> String
algorithmNameVRF proxy SimpleVRF
_ = String
"simple"

  deriveVerKeyVRF :: SignKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF
deriveVerKeyVRF (SignKeySimpleVRF Integer
k) =
    Point -> VerKeyVRF SimpleVRF
VerKeySimpleVRF (Point -> VerKeyVRF SimpleVRF) -> Point -> VerKeyVRF SimpleVRF
forall a b. (a -> b) -> a -> b
$ Integer -> Point
pow Integer
k

  sizeVerKeyVRF :: forall (proxy :: * -> *). proxy SimpleVRF -> Word
sizeVerKeyVRF proxy SimpleVRF
_ = Word
32
  sizeSignKeyVRF :: forall (proxy :: * -> *). proxy SimpleVRF -> Word
sizeSignKeyVRF proxy SimpleVRF
_ = Word
16
  sizeCertVRF :: forall (proxy :: * -> *). proxy SimpleVRF -> Word
sizeCertVRF proxy SimpleVRF
_ = Word
64

  --
  -- Core algorithm operations
  --

  type Signable SimpleVRF = SignableRepresentation

  evalVRF :: forall a.
(HasCallStack, Signable SimpleVRF a) =>
ContextVRF SimpleVRF
-> a
-> SignKeyVRF SimpleVRF
-> (OutputVRF SimpleVRF, CertVRF SimpleVRF)
evalVRF () a
a' sk :: SignKeyVRF SimpleVRF
sk@(SignKeySimpleVRF Integer
k) =
    let a :: ByteString
a = a -> ByteString
forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a'
        u :: Point
u = Encoding -> Integer -> Point
h' (ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a) Integer
k
        y :: ByteArray
y = Encoding -> ByteArray
hashedEncodingAsByteArray (Encoding -> ByteArray) -> Encoding -> ByteArray
forall a b. (a -> b) -> a -> b
$ ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Point
u
        VerKeySimpleVRF Point
v = SignKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF SignKeyVRF SimpleVRF
sk

        r :: Integer
r = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteArray -> Natural
byteArrayToNatural ByteArray
y) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
q
        c :: ByteString
c = Encoding -> ByteString
h (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Point
v Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Integer -> Point
pow Integer
r) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Encoding -> Integer -> Point
h' (ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a) Integer
r)
        s :: Integer
s = Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
mod (Integer
r Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
k Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Natural
bytesToNatural ByteString
c)) Integer
q
     in (ByteArray -> OutputVRF SimpleVRF
forall v. ByteArray -> OutputVRF v
OutputVRF ByteArray
y, Point -> Natural -> Integer -> CertVRF SimpleVRF
CertSimpleVRF Point
u (ByteString -> Natural
bytesToNatural ByteString
c) Integer
s)

  verifyVRF :: forall a.
(HasCallStack, Signable SimpleVRF a) =>
ContextVRF SimpleVRF
-> VerKeyVRF SimpleVRF
-> a
-> CertVRF SimpleVRF
-> Maybe (OutputVRF SimpleVRF)
verifyVRF () (VerKeySimpleVRF Point
v) a
a' CertVRF SimpleVRF
cert =
    let a :: ByteString
a = a -> ByteString
forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a'
        u :: Point
u = CertVRF SimpleVRF -> Point
certU CertVRF SimpleVRF
cert
        c :: Natural
c = CertVRF SimpleVRF -> Natural
certC CertVRF SimpleVRF
cert
        c' :: Integer
c' = -Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
c
        s :: Integer
s = CertVRF SimpleVRF -> Integer
certS CertVRF SimpleVRF
cert
        o :: ByteArray
o = Encoding -> ByteArray
hashedEncodingAsByteArray (ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Point
u)
        rhs :: ByteString
rhs =
          Encoding -> ByteString
h (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
            ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a
              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Point
v
              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Integer -> Point
pow Integer
s Point -> Point -> Point
forall a. Semigroup a => a -> a -> a
<> Point -> Integer -> Point
pow' Point
v Integer
c')
              Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Point -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Encoding -> Integer -> Point
h' (ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a) Integer
s Point -> Point -> Point
forall a. Semigroup a => a -> a -> a
<> Point -> Integer -> Point
pow' Point
u Integer
c')
     in if Natural
c Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Natural
bytesToNatural ByteString
rhs
          then OutputVRF SimpleVRF -> Maybe (OutputVRF SimpleVRF)
forall a. a -> Maybe a
Just (ByteArray -> OutputVRF SimpleVRF
forall v. ByteArray -> OutputVRF v
OutputVRF ByteArray
o)
          else Maybe (OutputVRF SimpleVRF)
forall a. Maybe a
Nothing

  sizeOutputVRF :: forall (proxy :: * -> *). proxy SimpleVRF -> Word
sizeOutputVRF proxy SimpleVRF
_ = Proxy H -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
hashSize (Proxy H
forall {k} (t :: k). Proxy t
Proxy :: Proxy H)

  --
  -- Key generation
  --

  seedSizeVRF :: forall (proxy :: * -> *). proxy SimpleVRF -> Word
seedSizeVRF proxy SimpleVRF
_ = Word
16 Word -> Word -> Word
forall a. Num a => a -> a -> a
* Word
100 -- size of SEC_t113r1 * up to 100 iterations
  genKeyVRF :: Seed -> SignKeyVRF SimpleVRF
genKeyVRF Seed
seed =
    Integer -> SignKeyVRF SimpleVRF
SignKeySimpleVRF
      (Seed
-> (forall (m :: * -> *). MonadRandom m => m Integer) -> Integer
forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
runMonadRandomWithSeed Seed
seed (Curve -> m Integer
forall (randomly :: * -> *).
MonadRandom randomly =>
Curve -> randomly Integer
C.scalarGenerate Curve
curve))

  --
  -- raw serialise/deserialise
  --

  -- All the integers here are 15 or 16 bytes big, we round up to 16.

  rawSerialiseVerKeyVRF :: VerKeyVRF SimpleVRF -> ByteString
rawSerialiseVerKeyVRF (VerKeySimpleVRF (Point Point
C.PointO)) =
    String -> ByteString
forall a. HasCallStack => String -> a
error String
"rawSerialiseVerKeyVRF: Point at infinity"
  rawSerialiseVerKeyVRF (VerKeySimpleVRF (Point (C.Point Integer
p1 Integer
p2))) =
    Int -> Natural -> ByteString
writeBinaryNatural Int
16 (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
p1)
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Natural -> ByteString
writeBinaryNatural Int
16 (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
p2)

  rawSerialiseSignKeyVRF :: SignKeyVRF SimpleVRF -> ByteString
rawSerialiseSignKeyVRF (SignKeySimpleVRF Integer
sk) =
    Int -> Natural -> ByteString
writeBinaryNatural Int
16 (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
sk)

  rawSerialiseCertVRF :: CertVRF SimpleVRF -> ByteString
rawSerialiseCertVRF (CertSimpleVRF (Point Point
C.PointO) Natural
_ Integer
_) =
    String -> ByteString
forall a. HasCallStack => String -> a
error String
"rawSerialiseCertVRF: Point at infinity"
  rawSerialiseCertVRF (CertSimpleVRF (Point (C.Point Integer
p1 Integer
p2)) Natural
c Integer
s) =
    Int -> Natural -> ByteString
writeBinaryNatural Int
16 (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
p1)
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Natural -> ByteString
writeBinaryNatural Int
16 (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
p2)
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Natural -> ByteString
writeBinaryNatural Int
16 Natural
c
      ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> Int -> Natural -> ByteString
writeBinaryNatural Int
16 (Integer -> Natural
forall a. Num a => Integer -> a
fromInteger Integer
s)

  rawDeserialiseVerKeyVRF :: ByteString -> Maybe (VerKeyVRF SimpleVRF)
rawDeserialiseVerKeyVRF ByteString
bs
    | [ByteString
p1b, ByteString
p2b] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
16, Int
16] ByteString
bs
    , let p1 :: Integer
p1 = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Natural
readBinaryNatural ByteString
p1b)
          p2 :: Integer
p2 = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Natural
readBinaryNatural ByteString
p2b) =
        VerKeyVRF SimpleVRF -> Maybe (VerKeyVRF SimpleVRF)
forall a. a -> Maybe a
Just (VerKeyVRF SimpleVRF -> Maybe (VerKeyVRF SimpleVRF))
-> VerKeyVRF SimpleVRF -> Maybe (VerKeyVRF SimpleVRF)
forall a b. (a -> b) -> a -> b
$! Point -> VerKeyVRF SimpleVRF
VerKeySimpleVRF (Point -> Point
Point (Integer -> Integer -> Point
C.Point Integer
p1 Integer
p2))
    | Bool
otherwise =
        Maybe (VerKeyVRF SimpleVRF)
forall a. Maybe a
Nothing

  rawDeserialiseSignKeyVRF :: ByteString -> Maybe (SignKeyVRF SimpleVRF)
rawDeserialiseSignKeyVRF ByteString
bs
    | [ByteString
skb] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
16] ByteString
bs
    , let sk :: Integer
sk = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Natural
readBinaryNatural ByteString
skb) =
        SignKeyVRF SimpleVRF -> Maybe (SignKeyVRF SimpleVRF)
forall a. a -> Maybe a
Just (SignKeyVRF SimpleVRF -> Maybe (SignKeyVRF SimpleVRF))
-> SignKeyVRF SimpleVRF -> Maybe (SignKeyVRF SimpleVRF)
forall a b. (a -> b) -> a -> b
$! Integer -> SignKeyVRF SimpleVRF
SignKeySimpleVRF Integer
sk
    | Bool
otherwise =
        Maybe (SignKeyVRF SimpleVRF)
forall a. Maybe a
Nothing

  rawDeserialiseCertVRF :: ByteString -> Maybe (CertVRF SimpleVRF)
rawDeserialiseCertVRF ByteString
bs
    | [ByteString
p1b, ByteString
p2b, ByteString
cb, ByteString
sb] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
16, Int
16, Int
16, Int
16] ByteString
bs
    , let p1 :: Integer
p1 = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Natural
readBinaryNatural ByteString
p1b)
          p2 :: Integer
p2 = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Natural
readBinaryNatural ByteString
p2b)
          c :: Natural
c = ByteString -> Natural
readBinaryNatural ByteString
cb
          s :: Integer
s = Natural -> Integer
forall a. Integral a => a -> Integer
toInteger (ByteString -> Natural
readBinaryNatural ByteString
sb) =
        CertVRF SimpleVRF -> Maybe (CertVRF SimpleVRF)
forall a. a -> Maybe a
Just (CertVRF SimpleVRF -> Maybe (CertVRF SimpleVRF))
-> CertVRF SimpleVRF -> Maybe (CertVRF SimpleVRF)
forall a b. (a -> b) -> a -> b
$! Point -> Natural -> Integer -> CertVRF SimpleVRF
CertSimpleVRF (Point -> Point
Point (Integer -> Integer -> Point
C.Point Integer
p1 Integer
p2)) Natural
c Integer
s
    | Bool
otherwise =
        Maybe (CertVRF SimpleVRF)
forall a. Maybe a
Nothing

instance ToCBOR (VerKeyVRF SimpleVRF) where
  toCBOR :: VerKeyVRF SimpleVRF -> Encoding
toCBOR = VerKeyVRF SimpleVRF -> Encoding
forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (VerKeyVRF SimpleVRF) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (VerKeyVRF SimpleVRF) -> Size
forall v. VRFAlgorithm v => Proxy (VerKeyVRF v) -> Size
encodedVerKeyVRFSizeExpr

instance FromCBOR (VerKeyVRF SimpleVRF) where
  fromCBOR :: forall s. Decoder s (VerKeyVRF SimpleVRF)
fromCBOR = Decoder s (VerKeyVRF SimpleVRF)
forall v s. VRFAlgorithm v => Decoder s (VerKeyVRF v)
decodeVerKeyVRF

instance ToCBOR (SignKeyVRF SimpleVRF) where
  toCBOR :: SignKeyVRF SimpleVRF -> Encoding
toCBOR = SignKeyVRF SimpleVRF -> Encoding
forall v. VRFAlgorithm v => SignKeyVRF v -> Encoding
encodeSignKeyVRF
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (SignKeyVRF SimpleVRF) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (SignKeyVRF SimpleVRF) -> Size
forall v. VRFAlgorithm v => Proxy (SignKeyVRF v) -> Size
encodedSignKeyVRFSizeExpr

instance FromCBOR (SignKeyVRF SimpleVRF) where
  fromCBOR :: forall s. Decoder s (SignKeyVRF SimpleVRF)
fromCBOR = Decoder s (SignKeyVRF SimpleVRF)
forall v s. VRFAlgorithm v => Decoder s (SignKeyVRF v)
decodeSignKeyVRF

instance ToCBOR (CertVRF SimpleVRF) where
  toCBOR :: CertVRF SimpleVRF -> Encoding
toCBOR = CertVRF SimpleVRF -> Encoding
forall v. VRFAlgorithm v => CertVRF v -> Encoding
encodeCertVRF
  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size)
-> Proxy (CertVRF SimpleVRF) -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
_size = Proxy (CertVRF SimpleVRF) -> Size
forall v. VRFAlgorithm v => Proxy (CertVRF v) -> Size
encodedCertVRFSizeExpr

instance FromCBOR (CertVRF SimpleVRF) where
  fromCBOR :: forall s. Decoder s (CertVRF SimpleVRF)
fromCBOR = Decoder s (CertVRF SimpleVRF)
forall v s. VRFAlgorithm v => Decoder s (CertVRF v)
decodeCertVRF