{-# 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 (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 = 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
-> (OutputVRF SimpleVRF, CertVRF SimpleVRF)
-> Bool
verifyVRF () (VerKeySimpleVRF Point
v) a
a' (OutputVRF ByteString
y, 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
        b1 :: Bool
b1 = ByteString
y forall a. Eq a => a -> a -> Bool
== 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 Bool
b1 Bool -> Bool -> Bool
&& Natural
c forall a. Eq a => a -> a -> Bool
== ByteString -> Natural
bytesToNatural ByteString
rhs

  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