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

import           Cardano.Prelude (NFData)
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 = 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
/= :: 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
  deriving newtype Point -> ()
(Point -> ()) -> NFData Point
forall a. (a -> ()) -> NFData a
rnf :: Point -> ()
$crnf :: 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 $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)
    deriving anyclass (VerKeyVRF SimpleVRF -> ()
(VerKeyVRF SimpleVRF -> ()) -> NFData (VerKeyVRF SimpleVRF)
forall a. (a -> ()) -> NFData a
rnf :: VerKeyVRF SimpleVRF -> ()
$crnf :: 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
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
    deriving anyclass (SignKeyVRF SimpleVRF -> ()
(SignKeyVRF SimpleVRF -> ()) -> NFData (SignKeyVRF SimpleVRF)
forall a. (a -> ()) -> NFData a
rnf :: SignKeyVRF SimpleVRF -> ()
$crnf :: 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
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)
    deriving anyclass (CertVRF SimpleVRF -> ()
(CertVRF SimpleVRF -> ()) -> NFData (CertVRF SimpleVRF)
forall a. (a -> ()) -> NFData a
rnf :: CertVRF SimpleVRF -> ()
$crnf :: CertVRF SimpleVRF -> ()
NFData)

  --
  -- 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