{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Fake implementation of VRF, where the random value isn't random but given
-- by the creator.
module Test.Cardano.Protocol.Crypto.VRF.Fake (
  NatNonce (..),
  FakeVRF,
  VerKeyVRF (..),
  SignKeyVRF (..),
  WithResult (..),
)
where

import Cardano.Crypto.Hash
import Cardano.Crypto.Seed (runMonadRandomWithSeed)
import Cardano.Crypto.Util
import Cardano.Crypto.VRF.Class hiding (
  decodeCertVRF,
  decodeSignKeyVRF,
  decodeVerKeyVRF,
  encodeCertVRF,
  encodeSignKeyVRF,
  encodeVerKeyVRF,
 )
import Cardano.Ledger.BaseTypes (Seed, shelleyProtVer)
import Cardano.Ledger.Binary (DecCBOR (..), EncCBOR (..), hashWithEncoder)
import Cardano.Ledger.Binary.Crypto (
  decodeCertVRF,
  decodeSignKeyVRF,
  decodeVerKeyVRF,
  encodeCertVRF,
  encodeSignKeyVRF,
  encodeVerKeyVRF,
 )
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BS
import qualified Data.ByteString.Lazy as LBS
import Data.Proxy (Proxy (..))
import Data.Word (Word16, Word64)
import GHC.Generics (Generic)
import NoThunks.Class (NoThunks (..))
import Numeric.Natural

-- | We provide our own nonces to 'mkBlock', which we then wish to recover as
-- the output of the VRF functions. In general, however, we just derive them
-- from a natural. Since the nonce is a hash, we do not want to recover it to
-- find a preimage. In testing, therefore, we just wrap the raw natural, which
-- we then encode into the fake VRF implementation.
newtype NatNonce = NatNonce Natural

data FakeVRF

-- | A class for seeds which sneakily contain the certified output we wish to
-- "randomly" derive from them.
class EncCBOR (Payload a) => SneakilyContainResult a where
  type Payload a
  sneakilyExtractResult :: a -> SignKeyVRF FakeVRF -> OutputVRF FakeVRF
  unsneakilyExtractPayload :: a -> Payload a

data WithResult a = WithResult !a !Word64
  deriving (WithResult a -> WithResult a -> Bool
forall a. Eq a => WithResult a -> WithResult a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WithResult a -> WithResult a -> Bool
$c/= :: forall a. Eq a => WithResult a -> WithResult a -> Bool
== :: WithResult a -> WithResult a -> Bool
$c== :: forall a. Eq a => WithResult a -> WithResult a -> Bool
Eq, Int -> WithResult a -> ShowS
forall a. Show a => Int -> WithResult a -> ShowS
forall a. Show a => [WithResult a] -> ShowS
forall a. Show a => WithResult a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WithResult a] -> ShowS
$cshowList :: forall a. Show a => [WithResult a] -> ShowS
show :: WithResult a -> String
$cshow :: forall a. Show a => WithResult a -> String
showsPrec :: Int -> WithResult a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> WithResult a -> ShowS
Show)

instance EncCBOR a => SneakilyContainResult (WithResult a) where
  type Payload (WithResult a) = a

  -- Note that this instance completely ignores the key.
  sneakilyExtractResult :: WithResult a -> SignKeyVRF FakeVRF -> OutputVRF FakeVRF
sneakilyExtractResult (WithResult a
_ Word64
nat) SignKeyVRF FakeVRF
_ =
    -- Fill in the word64 as the low 8 bytes of a 16 byte string
    forall v. ByteString -> OutputVRF v
OutputVRF (Builder -> ByteString
toBytes (Word64 -> Builder
BS.word64BE Word64
0 forall a. Semigroup a => a -> a -> a
<> Word64 -> Builder
BS.word64BE Word64
nat))
    where
      toBytes :: Builder -> ByteString
toBytes = ByteString -> ByteString
LBS.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BS.toLazyByteString

  unsneakilyExtractPayload :: WithResult a -> Payload (WithResult a)
unsneakilyExtractPayload (WithResult a
p Word64
_) = a
p

-- | An instance to allow this to be used in the way of `Mock` where no result
-- has been provided.
instance SneakilyContainResult Seed where
  type Payload Seed = Seed
  sneakilyExtractResult :: Seed -> SignKeyVRF FakeVRF -> OutputVRF FakeVRF
sneakilyExtractResult Seed
s SignKeyVRF FakeVRF
sk =
    forall v. ByteString -> OutputVRF v
OutputVRF
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. Hash h a -> ByteString
hashToBytes
      forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder @Blake2b_224 Version
shelleyProtVer forall a. a -> a
id
      forall a b. (a -> b) -> a -> b
$ forall a. EncCBOR a => a -> Encoding
encCBOR Seed
s forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR SignKeyVRF FakeVRF
sk
  unsneakilyExtractPayload :: Seed -> Payload Seed
unsneakilyExtractPayload = forall a. a -> a
id

instance VRFAlgorithm FakeVRF where
  algorithmNameVRF :: forall (proxy :: * -> *). proxy FakeVRF -> String
algorithmNameVRF proxy FakeVRF
_ = String
"fakeVRF"
  seedSizeVRF :: forall (proxy :: * -> *). proxy FakeVRF -> Word
seedSizeVRF proxy FakeVRF
_ = Word
8

  type Signable FakeVRF = SneakilyContainResult

  newtype VerKeyVRF FakeVRF = VerKeyFakeVRF Word64
    deriving stock (Int -> VerKeyVRF FakeVRF -> ShowS
[VerKeyVRF FakeVRF] -> ShowS
VerKeyVRF FakeVRF -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [VerKeyVRF FakeVRF] -> ShowS
$cshowList :: [VerKeyVRF FakeVRF] -> ShowS
show :: VerKeyVRF FakeVRF -> String
$cshow :: VerKeyVRF FakeVRF -> String
showsPrec :: Int -> VerKeyVRF FakeVRF -> ShowS
$cshowsPrec :: Int -> VerKeyVRF FakeVRF -> ShowS
Show, forall x. Rep (VerKeyVRF FakeVRF) x -> VerKeyVRF FakeVRF
forall x. VerKeyVRF FakeVRF -> Rep (VerKeyVRF FakeVRF) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (VerKeyVRF FakeVRF) x -> VerKeyVRF FakeVRF
$cfrom :: forall x. VerKeyVRF FakeVRF -> Rep (VerKeyVRF FakeVRF) x
Generic)
    deriving newtype (VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$c/= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
== :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$c== :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
Eq, Eq (VerKeyVRF FakeVRF)
VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Ordering
VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF
$cmin :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF
max :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF
$cmax :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF
>= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$c>= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
> :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$c> :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
<= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$c<= :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
< :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
$c< :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Bool
compare :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Ordering
$ccompare :: VerKeyVRF FakeVRF -> VerKeyVRF FakeVRF -> Ordering
Ord, Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
Proxy (VerKeyVRF FakeVRF) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (VerKeyVRF FakeVRF) -> String
$cshowTypeOf :: Proxy (VerKeyVRF FakeVRF) -> String
wNoThunks :: Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> VerKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
NoThunks)
  newtype SignKeyVRF FakeVRF = SignKeyFakeVRF Word64
    deriving stock (Int -> SignKeyVRF FakeVRF -> ShowS
[SignKeyVRF FakeVRF] -> ShowS
SignKeyVRF FakeVRF -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SignKeyVRF FakeVRF] -> ShowS
$cshowList :: [SignKeyVRF FakeVRF] -> ShowS
show :: SignKeyVRF FakeVRF -> String
$cshow :: SignKeyVRF FakeVRF -> String
showsPrec :: Int -> SignKeyVRF FakeVRF -> ShowS
$cshowsPrec :: Int -> SignKeyVRF FakeVRF -> ShowS
Show, forall x. Rep (SignKeyVRF FakeVRF) x -> SignKeyVRF FakeVRF
forall x. SignKeyVRF FakeVRF -> Rep (SignKeyVRF FakeVRF) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (SignKeyVRF FakeVRF) x -> SignKeyVRF FakeVRF
$cfrom :: forall x. SignKeyVRF FakeVRF -> Rep (SignKeyVRF FakeVRF) x
Generic)
    deriving newtype (SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$c/= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
== :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$c== :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
Eq, Eq (SignKeyVRF FakeVRF)
SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Ordering
SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF
$cmin :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF
max :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF
$cmax :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF
>= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$c>= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
> :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$c> :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
<= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$c<= :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
< :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
$c< :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Bool
compare :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Ordering
$ccompare :: SignKeyVRF FakeVRF -> SignKeyVRF FakeVRF -> Ordering
Ord, Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
Proxy (SignKeyVRF FakeVRF) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (SignKeyVRF FakeVRF) -> String
$cshowTypeOf :: Proxy (SignKeyVRF FakeVRF) -> String
wNoThunks :: Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> SignKeyVRF FakeVRF -> IO (Maybe ThunkInfo)
NoThunks)

  data CertVRF FakeVRF = CertFakeVRF !Word64 !Word16 !(OutputVRF FakeVRF)
    deriving stock (Int -> CertVRF FakeVRF -> ShowS
[CertVRF FakeVRF] -> ShowS
CertVRF FakeVRF -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertVRF FakeVRF] -> ShowS
$cshowList :: [CertVRF FakeVRF] -> ShowS
show :: CertVRF FakeVRF -> String
$cshow :: CertVRF FakeVRF -> String
showsPrec :: Int -> CertVRF FakeVRF -> ShowS
$cshowsPrec :: Int -> CertVRF FakeVRF -> ShowS
Show, CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$c/= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
== :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$c== :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
Eq, Eq (CertVRF FakeVRF)
CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
CertVRF FakeVRF -> CertVRF FakeVRF -> Ordering
CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF
$cmin :: CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF
max :: CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF
$cmax :: CertVRF FakeVRF -> CertVRF FakeVRF -> CertVRF FakeVRF
>= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$c>= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
> :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$c> :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
<= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$c<= :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
< :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
$c< :: CertVRF FakeVRF -> CertVRF FakeVRF -> Bool
compare :: CertVRF FakeVRF -> CertVRF FakeVRF -> Ordering
$ccompare :: CertVRF FakeVRF -> CertVRF FakeVRF -> Ordering
Ord, forall x. Rep (CertVRF FakeVRF) x -> CertVRF FakeVRF
forall x. CertVRF FakeVRF -> Rep (CertVRF FakeVRF) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep (CertVRF FakeVRF) x -> CertVRF FakeVRF
$cfrom :: forall x. CertVRF FakeVRF -> Rep (CertVRF FakeVRF) x
Generic)
    deriving anyclass (Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo)
Proxy (CertVRF FakeVRF) -> String
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy (CertVRF FakeVRF) -> String
$cshowTypeOf :: Proxy (CertVRF FakeVRF) -> String
wNoThunks :: Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo)
noThunks :: Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CertVRF FakeVRF -> IO (Maybe ThunkInfo)
NoThunks)

  genKeyVRF :: Seed -> SignKeyVRF FakeVRF
genKeyVRF Seed
seed = Word64 -> SignKeyVRF FakeVRF
SignKeyFakeVRF forall a b. (a -> b) -> a -> b
$ forall a. Seed -> (forall (m :: * -> *). MonadRandom m => m a) -> a
runMonadRandomWithSeed Seed
seed forall (m :: * -> *). MonadRandom m => m Word64
getRandomWord64
  deriveVerKeyVRF :: SignKeyVRF FakeVRF -> VerKeyVRF FakeVRF
deriveVerKeyVRF (SignKeyFakeVRF Word64
n) = Word64 -> VerKeyVRF FakeVRF
VerKeyFakeVRF Word64
n
  evalVRF :: forall a.
(HasCallStack, Signable FakeVRF a) =>
ContextVRF FakeVRF
-> a -> SignKeyVRF FakeVRF -> (OutputVRF FakeVRF, CertVRF FakeVRF)
evalVRF () a
a SignKeyVRF FakeVRF
sk = forall a.
SneakilyContainResult a =>
a -> SignKeyVRF FakeVRF -> (OutputVRF FakeVRF, CertVRF FakeVRF)
evalFakeVRF a
a SignKeyVRF FakeVRF
sk

  -- This implementation of 'verifyVRF' checks the real proof, which is contained
  -- in the certificate, but ignores the produced value, and insteads returns
  -- the output which is stored in the 'CertFakeVRF'.
  verifyVRF :: forall a.
(HasCallStack, Signable FakeVRF a) =>
ContextVRF FakeVRF
-> VerKeyVRF FakeVRF
-> a
-> CertVRF FakeVRF
-> Maybe (OutputVRF FakeVRF)
verifyVRF () (VerKeyFakeVRF Word64
n) a
a (CertFakeVRF Word64
_ Word16
proof OutputVRF FakeVRF
o)
    | Word16
proof forall a. Eq a => a -> a -> Bool
== Word16
recomputedProof = forall a. a -> Maybe a
Just OutputVRF FakeVRF
o
    | Bool
otherwise = forall a. Maybe a
Nothing
    where
      (OutputVRF ByteString
recomputedProofBytes, CertVRF FakeVRF
_) = forall a.
SneakilyContainResult a =>
a -> SignKeyVRF FakeVRF -> (OutputVRF FakeVRF, CertVRF FakeVRF)
evalFakeVRF a
a (Word64 -> SignKeyVRF FakeVRF
SignKeyFakeVRF Word64
n)
      recomputedProof :: Word16
recomputedProof = 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
$ ByteString
recomputedProofBytes

  sizeVerKeyVRF :: forall (proxy :: * -> *). proxy FakeVRF -> Word
sizeVerKeyVRF proxy FakeVRF
_ = Word
8
  sizeSignKeyVRF :: forall (proxy :: * -> *). proxy FakeVRF -> Word
sizeSignKeyVRF proxy FakeVRF
_ = Word
8
  sizeCertVRF :: forall (proxy :: * -> *). proxy FakeVRF -> Word
sizeCertVRF proxy FakeVRF
_ = Word
26
  sizeOutputVRF :: forall (proxy :: * -> *). proxy FakeVRF -> Word
sizeOutputVRF proxy FakeVRF
_ = forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash (forall {k} (t :: k). Proxy t
Proxy :: Proxy Blake2b_224)

  rawSerialiseVerKeyVRF :: VerKeyVRF FakeVRF -> ByteString
rawSerialiseVerKeyVRF (VerKeyFakeVRF Word64
k) = Word64 -> ByteString
writeBinaryWord64 Word64
k
  rawSerialiseSignKeyVRF :: SignKeyVRF FakeVRF -> ByteString
rawSerialiseSignKeyVRF (SignKeyFakeVRF Word64
k) = Word64 -> ByteString
writeBinaryWord64 Word64
k
  rawSerialiseCertVRF :: CertVRF FakeVRF -> ByteString
rawSerialiseCertVRF (CertFakeVRF Word64
k Word16
s (OutputVRF ByteString
b)) =
    Word64 -> ByteString
writeBinaryWord64 Word64
k forall a. Semigroup a => a -> a -> a
<> Word16 -> ByteString
writeBinaryWord16 Word16
s forall a. Semigroup a => a -> a -> a
<> ByteString
b

  rawDeserialiseVerKeyVRF :: ByteString -> Maybe (VerKeyVRF FakeVRF)
rawDeserialiseVerKeyVRF ByteString
bs
    | [ByteString
kb] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
8] ByteString
bs
    , let k :: Word64
k = ByteString -> Word64
readBinaryWord64 ByteString
kb =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Word64 -> VerKeyVRF FakeVRF
VerKeyFakeVRF Word64
k
    | Bool
otherwise =
        forall a. Maybe a
Nothing

  rawDeserialiseSignKeyVRF :: ByteString -> Maybe (SignKeyVRF FakeVRF)
rawDeserialiseSignKeyVRF ByteString
bs
    | [ByteString
kb] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
8] ByteString
bs
    , let k :: Word64
k = ByteString -> Word64
readBinaryWord64 ByteString
kb =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Word64 -> SignKeyVRF FakeVRF
SignKeyFakeVRF Word64
k
    | Bool
otherwise =
        forall a. Maybe a
Nothing

  rawDeserialiseCertVRF :: ByteString -> Maybe (CertVRF FakeVRF)
rawDeserialiseCertVRF ByteString
bs
    | [ByteString
kb, ByteString
smb, ByteString
xs] <- [Int] -> ByteString -> [ByteString]
splitsAt [Int
8, Int
2, Int
16] ByteString
bs
    , let k :: Word64
k = ByteString -> Word64
readBinaryWord64 ByteString
kb
    , let s :: Word16
s = ByteString -> Word16
readBinaryWord16 ByteString
smb =
        forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$! Word64 -> Word16 -> OutputVRF FakeVRF -> CertVRF FakeVRF
CertFakeVRF Word64
k Word16
s (forall v. ByteString -> OutputVRF v
OutputVRF ByteString
xs)
    | Bool
otherwise =
        forall a. Maybe a
Nothing

evalFakeVRF ::
  SneakilyContainResult a =>
  a ->
  SignKeyVRF FakeVRF ->
  (OutputVRF FakeVRF, CertVRF FakeVRF)
evalFakeVRF :: forall a.
SneakilyContainResult a =>
a -> SignKeyVRF FakeVRF -> (OutputVRF FakeVRF, CertVRF FakeVRF)
evalFakeVRF a
a sk :: SignKeyVRF FakeVRF
sk@(SignKeyFakeVRF Word64
n) =
  let y :: OutputVRF FakeVRF
y = forall a.
SneakilyContainResult a =>
a -> SignKeyVRF FakeVRF -> OutputVRF FakeVRF
sneakilyExtractResult a
a SignKeyVRF FakeVRF
sk
      p :: Payload a
p = forall a. SneakilyContainResult a => a -> Payload a
unsneakilyExtractPayload a
a
      proof :: Word16
proof =
        forall a b. (Integral a, Num b) => a -> b
fromIntegral
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Natural
bytesToNatural
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a. Hash h a -> ByteString
hashToBytes
          forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a.
HashAlgorithm h =>
Version -> (a -> Encoding) -> a -> Hash h a
hashWithEncoder @Blake2b_224 Version
shelleyProtVer forall a. a -> a
id
          forall a b. (a -> b) -> a -> b
$ forall a. EncCBOR a => a -> Encoding
encCBOR Payload a
p forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR SignKeyVRF FakeVRF
sk
   in (OutputVRF FakeVRF
y, Word64 -> Word16 -> OutputVRF FakeVRF -> CertVRF FakeVRF
CertFakeVRF Word64
n Word16
proof OutputVRF FakeVRF
y)

instance DecCBOR (VerKeyVRF FakeVRF) where
  decCBOR :: forall s. Decoder s (VerKeyVRF FakeVRF)
decCBOR = forall v s. VRFAlgorithm v => Decoder s (VerKeyVRF v)
decodeVerKeyVRF

instance EncCBOR (VerKeyVRF FakeVRF) where
  encCBOR :: VerKeyVRF FakeVRF -> Encoding
encCBOR = forall v. VRFAlgorithm v => VerKeyVRF v -> Encoding
encodeVerKeyVRF

instance DecCBOR (SignKeyVRF FakeVRF) where
  decCBOR :: forall s. Decoder s (SignKeyVRF FakeVRF)
decCBOR = forall v s. VRFAlgorithm v => Decoder s (SignKeyVRF v)
decodeSignKeyVRF

instance EncCBOR (SignKeyVRF FakeVRF) where
  encCBOR :: SignKeyVRF FakeVRF -> Encoding
encCBOR = forall v. VRFAlgorithm v => SignKeyVRF v -> Encoding
encodeSignKeyVRF

instance DecCBOR (CertVRF FakeVRF) where
  decCBOR :: forall s. Decoder s (CertVRF FakeVRF)
decCBOR = forall v s. VRFAlgorithm v => Decoder s (CertVRF v)
decodeCertVRF

instance EncCBOR (CertVRF FakeVRF) where
  encCBOR :: CertVRF FakeVRF -> Encoding
encCBOR = forall v. VRFAlgorithm v => CertVRF v -> Encoding
encodeCertVRF

readBinaryWord16 :: ByteString -> Word16
readBinaryWord16 :: ByteString -> Word16
readBinaryWord16 =
  forall a. (a -> Word8 -> a) -> a -> ByteString -> a
BS.foldl' (\Word16
acc Word8
w8 -> forall a. Bits a => a -> Int -> a
unsafeShiftL Word16
acc Int
8 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
w8) Word16
0

writeBinaryWord16 :: Word16 -> ByteString
writeBinaryWord16 :: Word16 -> ByteString
writeBinaryWord16 =
  ByteString -> ByteString
BS.reverse
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
Int -> (a -> Maybe (Word8, a)) -> a -> (ByteString, Maybe a)
BS.unfoldrN Int
2 (\Word16
w -> forall a. a -> Maybe a
Just (forall a b. (Integral a, Num b) => a -> b
fromIntegral Word16
w, forall a. Bits a => a -> Int -> a
unsafeShiftR Word16
w Int
8))