{-# 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 (NFData, force)
import Data.Proxy (Proxy (..))
import GHC.Generics (Generic)
import NoThunks.Class (InspectHeap (..), NoThunks)
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 = 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 :: PrivateNumber
q = CurveCommon -> PrivateNumber
C.ecc_n forall a b. (a -> b) -> a -> b
$ Curve -> CurveCommon
C.common_curve Curve
curve

newtype Point = ThunkyPoint C.Point
  deriving (Point -> Point -> Bool
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. 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
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 -> ()
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) -> ((# #) -> r) -> r
Point p <- ThunkyPoint p
  where
    Point Point
p = Point -> Point
ThunkyPoint (forall a. NFData a => a -> a
force Point
p)

{-# COMPLETE Point #-}

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

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

instance FromCBOR Point where
  fromCBOR :: forall s. Decoder s Point
fromCBOR = Point -> Point
Point forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (PrivateNumber, PrivateNumber) -> Point
pointFromMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 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 = forall a. Semigroup a => a -> a -> a
(<>)

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

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

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

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

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

h' :: Encoding -> Integer -> Point
h' :: Encoding -> PrivateNumber -> Point
h' Encoding
enc PrivateNumber
l = PrivateNumber -> Point
pow forall a b. (a -> b) -> a -> b
$ forall a. Integral a => a -> a -> a
mod (PrivateNumber
l forall a. Num a => a -> a -> a
* (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Natural
bytesToNatural forall a b. (a -> b) -> a -> b
$ Encoding -> ByteString
h Encoding
enc)) PrivateNumber
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
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
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. 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
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 -> ()
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
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
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. 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
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 -> ()
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 -> PrivateNumber
certS :: !Integer -- at most q, so 15 bytes, round up to 16
    }
    deriving stock (Int -> CertVRF SimpleVRF -> ShowS
[CertVRF SimpleVRF] -> ShowS
CertVRF SimpleVRF -> String
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
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. 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
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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: CertVRF SimpleVRF -> ()
$crnf :: 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 PrivateNumber
k) =
    Point -> VerKeyVRF SimpleVRF
VerKeySimpleVRF forall a b. (a -> b) -> a -> b
$ PrivateNumber -> Point
pow PrivateNumber
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 PrivateNumber
k) =
    let a :: ByteString
a = forall a. SignableRepresentation a => a -> ByteString
getSignableRepresentation a
a'
        u :: Point
u = Encoding -> PrivateNumber -> Point
h' (forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a) PrivateNumber
k
        y :: ByteString
y = Encoding -> ByteString
h forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR Point
u
        VerKeySimpleVRF Point
v = forall v. VRFAlgorithm v => SignKeyVRF v -> VerKeyVRF v
deriveVerKeyVRF SignKeyVRF SimpleVRF
sk

        r :: PrivateNumber
r = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Natural
bytesToNatural ByteString
y) forall a. Integral a => a -> a -> a
`mod` PrivateNumber
q
        c :: ByteString
c = Encoding -> ByteString
h forall a b. (a -> b) -> a -> b
$ forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR Point
v forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR (PrivateNumber -> Point
pow PrivateNumber
r) forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR (Encoding -> PrivateNumber -> Point
h' (forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a) PrivateNumber
r)
        s :: PrivateNumber
s = forall a. Integral a => a -> a -> a
mod (PrivateNumber
r forall a. Num a => a -> a -> a
+ PrivateNumber
k forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Natural
bytesToNatural ByteString
c)) PrivateNumber
q
     in (forall v. ByteString -> OutputVRF v
OutputVRF ByteString
y, Point -> Natural -> PrivateNumber -> CertVRF SimpleVRF
CertSimpleVRF Point
u (ByteString -> Natural
bytesToNatural ByteString
c) PrivateNumber
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 = 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' :: PrivateNumber
c' = -forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
c
        s :: PrivateNumber
s = CertVRF SimpleVRF -> PrivateNumber
certS CertVRF SimpleVRF
cert
        o :: ByteString
o = Encoding -> ByteString
h (forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR Point
u)
        rhs :: ByteString
rhs =
          Encoding -> ByteString
h forall a b. (a -> b) -> a -> b
$
            forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a
              forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR Point
v
              forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR (PrivateNumber -> Point
pow PrivateNumber
s forall a. Semigroup a => a -> a -> a
<> Point -> PrivateNumber -> Point
pow' Point
v PrivateNumber
c')
              forall a. Semigroup a => a -> a -> a
<> forall a. ToCBOR a => a -> Encoding
toCBOR (Encoding -> PrivateNumber -> Point
h' (forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
a) PrivateNumber
s forall a. Semigroup a => a -> a -> a
<> Point -> PrivateNumber -> Point
pow' Point
u PrivateNumber
c')
     in if Natural
c forall a. Eq a => a -> a -> Bool
== ByteString -> Natural
bytesToNatural ByteString
rhs
          then forall a. a -> Maybe a
Just (forall v. ByteString -> OutputVRF v
OutputVRF ByteString
o)
          else forall a. Maybe a
Nothing

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

  --
  -- Key generation
  --

  seedSizeVRF :: forall (proxy :: * -> *). proxy SimpleVRF -> Word
seedSizeVRF proxy SimpleVRF
_ = Word
16 forall a. Num a => a -> a -> a
* Word
100 -- size of SEC_t113r1 * up to 100 iterations
  genKeyVRF :: Seed -> SignKeyVRF SimpleVRF
genKeyVRF Seed
seed =
    PrivateNumber -> SignKeyVRF SimpleVRF
SignKeySimpleVRF
      (forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
runMonadRandomWithSeed Seed
seed (forall (randomly :: * -> *).
MonadRandom randomly =>
Curve -> randomly PrivateNumber
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)) =
    forall a. HasCallStack => String -> a
error String
"rawSerialiseVerKeyVRF: Point at infinity"
  rawSerialiseVerKeyVRF (VerKeySimpleVRF (Point (C.Point PrivateNumber
p1 PrivateNumber
p2))) =
    Int -> Natural -> ByteString
writeBinaryNatural Int
16 (forall a. Num a => PrivateNumber -> a
fromInteger PrivateNumber
p1)
      forall a. Semigroup a => a -> a -> a
<> Int -> Natural -> ByteString
writeBinaryNatural Int
16 (forall a. Num a => PrivateNumber -> a
fromInteger PrivateNumber
p2)

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

  rawSerialiseCertVRF :: CertVRF SimpleVRF -> ByteString
rawSerialiseCertVRF (CertSimpleVRF (Point Point
C.PointO) Natural
_ PrivateNumber
_) =
    forall a. HasCallStack => String -> a
error String
"rawSerialiseCertVRF: Point at infinity"
  rawSerialiseCertVRF (CertSimpleVRF (Point (C.Point PrivateNumber
p1 PrivateNumber
p2)) Natural
c PrivateNumber
s) =
    Int -> Natural -> ByteString
writeBinaryNatural Int
16 (forall a. Num a => PrivateNumber -> a
fromInteger PrivateNumber
p1)
      forall a. Semigroup a => a -> a -> a
<> Int -> Natural -> ByteString
writeBinaryNatural Int
16 (forall a. Num a => PrivateNumber -> a
fromInteger PrivateNumber
p2)
      forall a. Semigroup a => a -> a -> a
<> Int -> Natural -> ByteString
writeBinaryNatural Int
16 Natural
c
      forall a. Semigroup a => a -> a -> a
<> Int -> Natural -> ByteString
writeBinaryNatural Int
16 (forall a. Num a => PrivateNumber -> a
fromInteger PrivateNumber
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 :: PrivateNumber
p1 = forall a. Integral a => a -> PrivateNumber
toInteger (ByteString -> Natural
readBinaryNatural ByteString
p1b)
          p2 :: PrivateNumber
p2 = forall a. Integral a => a -> PrivateNumber
toInteger (ByteString -> Natural
readBinaryNatural ByteString
p2b) =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Point -> VerKeyVRF SimpleVRF
VerKeySimpleVRF (Point -> Point
Point (PrivateNumber -> PrivateNumber -> Point
C.Point PrivateNumber
p1 PrivateNumber
p2))
    | Bool
otherwise =
        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 :: PrivateNumber
sk = forall a. Integral a => a -> PrivateNumber
toInteger (ByteString -> Natural
readBinaryNatural ByteString
skb) =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! PrivateNumber -> SignKeyVRF SimpleVRF
SignKeySimpleVRF PrivateNumber
sk
    | Bool
otherwise =
        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 :: PrivateNumber
p1 = forall a. Integral a => a -> PrivateNumber
toInteger (ByteString -> Natural
readBinaryNatural ByteString
p1b)
          p2 :: PrivateNumber
p2 = forall a. Integral a => a -> PrivateNumber
toInteger (ByteString -> Natural
readBinaryNatural ByteString
p2b)
          c :: Natural
c = ByteString -> Natural
readBinaryNatural ByteString
cb
          s :: PrivateNumber
s = forall a. Integral a => a -> PrivateNumber
toInteger (ByteString -> Natural
readBinaryNatural ByteString
sb) =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Point -> Natural -> PrivateNumber -> CertVRF SimpleVRF
CertSimpleVRF (Point -> Point
Point (PrivateNumber -> PrivateNumber -> Point
C.Point PrivateNumber
p1 PrivateNumber
p2)) Natural
c PrivateNumber
s
    | Bool
otherwise =
        forall a. Maybe a
Nothing

instance ToCBOR (VerKeyVRF SimpleVRF) where
  toCBOR :: VerKeyVRF SimpleVRF -> Encoding
toCBOR = 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 = forall v. VRFAlgorithm v => Proxy (VerKeyVRF v) -> Size
encodedVerKeyVRFSizeExpr

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

instance ToCBOR (SignKeyVRF SimpleVRF) where
  toCBOR :: SignKeyVRF SimpleVRF -> Encoding
toCBOR = 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 = forall v. VRFAlgorithm v => Proxy (SignKeyVRF v) -> Size
encodedSignKeyVRFSizeExpr

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

instance ToCBOR (CertVRF SimpleVRF) where
  toCBOR :: CertVRF SimpleVRF -> Encoding
toCBOR = 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 = forall v. VRFAlgorithm v => Proxy (CertVRF v) -> Size
encodedCertVRFSizeExpr

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