{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# 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           Control.DeepSeq (force)
import           Data.Proxy (Proxy (..))
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks, InspectHeap(..))
import           Numeric.Natural (Natural)

import           Cardano.Binary (Encoding, FromCBOR (..), ToCBOR (..))

import qualified Crypto.PubKey.ECC.Prim as C
import qualified Crypto.PubKey.ECC.Types as C

import           Cardano.Crypto.Hash
import           Cardano.Crypto.Seed
import           Cardano.Crypto.Util
import           Cardano.Crypto.VRF.Class

data SimpleVRF

type H = MD5

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
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: 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
$cto :: forall x. Rep Point x -> Point
$cfrom :: forall x. Point -> Rep Point x
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
showTypeOf :: Proxy Point -> String
$cshowTypeOf :: Proxy Point -> String
wNoThunks :: Context -> Point -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> Point -> IO (Maybe ThunkInfo)
noThunks :: Context -> Point -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> Point -> IO (Maybe ThunkInfo)
NoThunks via InspectHeap C.Point

-- | 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 $bPoint :: Point -> Point
$mPoint :: forall r. Point -> (Point -> r) -> (Void# -> r) -> r
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 :: 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 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
. (Encoding -> Encoding) -> Encoding -> Hash H Encoding
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 b. (Integral a, Num b) => a -> b
fromIntegral (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
showList :: [VerKeyVRF SimpleVRF] -> ShowS
$cshowList :: [VerKeyVRF SimpleVRF] -> ShowS
show :: VerKeyVRF SimpleVRF -> String
$cshow :: VerKeyVRF SimpleVRF -> String
showsPrec :: Int -> VerKeyVRF SimpleVRF -> ShowS
$cshowsPrec :: Int -> 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
/= :: VerKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF -> Bool
$c/= :: VerKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF -> Bool
== :: VerKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF -> Bool
$c== :: 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
$cto :: forall x. Rep (VerKeyVRF SimpleVRF) x -> VerKeyVRF SimpleVRF
$cfrom :: forall x. VerKeyVRF SimpleVRF -> Rep (VerKeyVRF SimpleVRF) x
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
showTypeOf :: Proxy (VerKeyVRF SimpleVRF) -> String
$cshowTypeOf :: Proxy (VerKeyVRF SimpleVRF) -> String
wNoThunks :: Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> VerKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
NoThunks)

  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
showList :: [SignKeyVRF SimpleVRF] -> ShowS
$cshowList :: [SignKeyVRF SimpleVRF] -> ShowS
show :: SignKeyVRF SimpleVRF -> String
$cshow :: SignKeyVRF SimpleVRF -> String
showsPrec :: Int -> SignKeyVRF SimpleVRF -> ShowS
$cshowsPrec :: Int -> 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
/= :: SignKeyVRF SimpleVRF -> SignKeyVRF SimpleVRF -> Bool
$c/= :: SignKeyVRF SimpleVRF -> SignKeyVRF SimpleVRF -> Bool
== :: SignKeyVRF SimpleVRF -> SignKeyVRF SimpleVRF -> Bool
$c== :: 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
$cto :: forall x. Rep (SignKeyVRF SimpleVRF) x -> SignKeyVRF SimpleVRF
$cfrom :: forall x. SignKeyVRF SimpleVRF -> Rep (SignKeyVRF SimpleVRF) x
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
showTypeOf :: Proxy (SignKeyVRF SimpleVRF) -> String
$cshowTypeOf :: Proxy (SignKeyVRF SimpleVRF) -> String
wNoThunks :: Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> SignKeyVRF SimpleVRF -> IO (Maybe ThunkInfo)
NoThunks via InspectHeap C.PrivateNumber

  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
showList :: [CertVRF SimpleVRF] -> ShowS
$cshowList :: [CertVRF SimpleVRF] -> ShowS
show :: CertVRF SimpleVRF -> String
$cshow :: CertVRF SimpleVRF -> String
showsPrec :: Int -> CertVRF SimpleVRF -> ShowS
$cshowsPrec :: Int -> 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
/= :: CertVRF SimpleVRF -> CertVRF SimpleVRF -> Bool
$c/= :: CertVRF SimpleVRF -> CertVRF SimpleVRF -> Bool
== :: CertVRF SimpleVRF -> CertVRF SimpleVRF -> Bool
$c== :: 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
$cto :: forall x. Rep (CertVRF SimpleVRF) x -> CertVRF SimpleVRF
$cfrom :: forall x. CertVRF SimpleVRF -> Rep (CertVRF SimpleVRF) x
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
showTypeOf :: Proxy (CertVRF SimpleVRF) -> String
$cshowTypeOf :: Proxy (CertVRF SimpleVRF) -> String
wNoThunks :: Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CertVRF SimpleVRF -> IO (Maybe ThunkInfo)
NoThunks)

  --
  -- Metadata and basic key operations
  --

  algorithmNameVRF :: proxy SimpleVRF -> String
algorithmNameVRF proxy SimpleVRF
_ = String
"simple"

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

  sizeVerKeyVRF :: proxy SimpleVRF -> Word
sizeVerKeyVRF  proxy SimpleVRF
_ = Word
32
  sizeSignKeyVRF :: proxy SimpleVRF -> Word
sizeSignKeyVRF proxy SimpleVRF
_ = Word
16
  sizeCertVRF :: proxy SimpleVRF -> Word
sizeCertVRF    proxy SimpleVRF
_ = Word
64


  --
  -- Core algorithm operations
  --

  type Signable SimpleVRF = SignableRepresentation

  evalVRF :: ContextVRF SimpleVRF
-> a
-> SignKeyVRF SimpleVRF
-> (OutputVRF SimpleVRF, CertVRF SimpleVRF)
evalVRF () a
a' sk :: SignKeyVRF SimpleVRF
sk@(SignKeySimpleVRF 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 :: ByteString
y = 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
u
        VerKeySimpleVRF v = SignKeyVRF SimpleVRF -> VerKeyVRF SimpleVRF
forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF SignKeyVRF SimpleVRF
sk

        r :: Integer
r = Natural -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Natural
bytesToNatural ByteString
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 b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Natural
bytesToNatural ByteString
c)) Integer
q
    in (ByteString -> OutputVRF SimpleVRF
forall v. ByteString -> OutputVRF v
OutputVRF ByteString
y, Point -> Natural -> Integer -> CertVRF SimpleVRF
CertSimpleVRF Point
u (ByteString -> Natural
bytesToNatural ByteString
c) Integer
s)

  verifyVRF :: ContextVRF SimpleVRF
-> VerKeyVRF SimpleVRF
-> a
-> (OutputVRF SimpleVRF, CertVRF SimpleVRF)
-> Bool
verifyVRF () (VerKeySimpleVRF v) a
a' (OutputVRF ByteString
y, 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 b. (Integral a, Num b) => a -> b
fromIntegral Natural
c
        s :: Integer
s = CertVRF SimpleVRF -> Integer
certS CertVRF SimpleVRF
cert
        b1 :: Bool
b1 = ByteString
y ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Encoding -> ByteString
h (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 Bool
b1 Bool -> Bool -> Bool
&& Natural
c Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Natural
bytesToNatural ByteString
rhs

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


  --
  -- Key generation
  --

  seedSizeVRF :: 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 C.PointO)) =
      String -> ByteString
forall a. HasCallStack => String -> a
error String
"rawSerialiseVerKeyVRF: Point at infinity"
  rawSerialiseVerKeyVRF (VerKeySimpleVRF (Point (C.Point p1 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 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 C.PointO) _ _) =
      String -> ByteString
forall a. HasCallStack => String -> a
error String
"rawSerialiseCertVRF: Point at infinity"
  rawSerialiseCertVRF (CertSimpleVRF (Point (C.Point p1 p2)) c 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 :: 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 :: 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 :: Decoder s (CertVRF SimpleVRF)
fromCBOR = Decoder s (CertVRF SimpleVRF)
forall v s. VRFAlgorithm v => Decoder s (CertVRF v)
decodeCertVRF