{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Cardano.Chain.Ssc
  ( SscPayload (..),
    dropSscPayload,
    SscProof (..),
    dropSscProof,
    dropCommitmentsMap,
    dropSignedCommitment,
    dropCommitment,
    dropOpeningsMap,
    dropSharesMap,
    dropInnerSharesMap,
    dropVssCertificatesMap,
    dropVssCertificate,
  )
where

import Cardano.Binary
  ( DecoderError (..),
    Dropper,
    FromCBOR (..),
    ToCBOR (..),
    decodeListLen,
    dropBytes,
    dropList,
    dropMap,
    dropSet,
    dropTriple,
    dropWord64,
    encodeListLen,
    enforceSize,
    matchSize,
  )
import Cardano.Prelude
import Data.Aeson (ToJSON)
import qualified Data.ByteString as ByteString (pack)
import NoThunks.Class (NoThunks (..))

--------------------------------------------------------------------------------
-- SscPayload
--------------------------------------------------------------------------------

data SscPayload
  = SscPayload
  deriving (SscPayload -> SscPayload -> Bool
(SscPayload -> SscPayload -> Bool)
-> (SscPayload -> SscPayload -> Bool) -> Eq SscPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SscPayload -> SscPayload -> Bool
$c/= :: SscPayload -> SscPayload -> Bool
== :: SscPayload -> SscPayload -> Bool
$c== :: SscPayload -> SscPayload -> Bool
Eq, Int -> SscPayload -> ShowS
[SscPayload] -> ShowS
SscPayload -> String
(Int -> SscPayload -> ShowS)
-> (SscPayload -> String)
-> ([SscPayload] -> ShowS)
-> Show SscPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SscPayload] -> ShowS
$cshowList :: [SscPayload] -> ShowS
show :: SscPayload -> String
$cshow :: SscPayload -> String
showsPrec :: Int -> SscPayload -> ShowS
$cshowsPrec :: Int -> SscPayload -> ShowS
Show, (forall x. SscPayload -> Rep SscPayload x)
-> (forall x. Rep SscPayload x -> SscPayload) -> Generic SscPayload
forall x. Rep SscPayload x -> SscPayload
forall x. SscPayload -> Rep SscPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SscPayload x -> SscPayload
$cfrom :: forall x. SscPayload -> Rep SscPayload x
Generic, SscPayload -> ()
(SscPayload -> ()) -> NFData SscPayload
forall a. (a -> ()) -> NFData a
rnf :: SscPayload -> ()
$crnf :: SscPayload -> ()
NFData)

-- Used for debugging purposes only
instance ToJSON SscPayload

instance ToCBOR SscPayload where
  toCBOR :: SscPayload -> Encoding
toCBOR SscPayload
_ =
    Word -> Encoding
encodeListLen Word
2
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
3 :: Word8)
      Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Set () -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Set ()
forall a. Monoid a => a
mempty :: Set ())

instance FromCBOR SscPayload where
  fromCBOR :: Decoder s SscPayload
fromCBOR = do
    Dropper s
forall s. Dropper s
dropSscPayload
    SscPayload -> Decoder s SscPayload
forall (f :: * -> *) a. Applicative f => a -> f a
pure SscPayload
SscPayload

dropSscPayload :: Dropper s
dropSscPayload :: Dropper s
dropSscPayload = do
  Int
actualLen <- Decoder s Int
forall s. Decoder s Int
decodeListLen
  Decoder s Word8
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Word8 -> (Word8 -> Dropper s) -> Dropper s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0 -> do
      Text -> Int -> Int -> Dropper s
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"CommitmentsPayload" Int
3 Int
actualLen
      Dropper s
forall s. Dropper s
dropCommitmentsMap
      Dropper s
forall s. Dropper s
dropVssCertificatesMap
    Word8
1 -> do
      Text -> Int -> Int -> Dropper s
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"OpeningsPayload" Int
3 Int
actualLen
      Dropper s
forall s. Dropper s
dropOpeningsMap
      Dropper s
forall s. Dropper s
dropVssCertificatesMap
    Word8
2 -> do
      Text -> Int -> Int -> Dropper s
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"SharesPayload" Int
3 Int
actualLen
      Dropper s
forall s. Dropper s
dropSharesMap
      Dropper s
forall s. Dropper s
dropVssCertificatesMap
    Word8
3 -> do
      Text -> Int -> Int -> Dropper s
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"CertificatesPayload" Int
2 Int
actualLen
      Dropper s
forall s. Dropper s
dropVssCertificatesMap
    Word8
t -> DecoderError -> Dropper s
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Dropper s) -> DecoderError -> Dropper s
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"SscPayload" Word8
t

--------------------------------------------------------------------------------
-- SscProof
--------------------------------------------------------------------------------

data SscProof
  = SscProof
  deriving (SscProof -> SscProof -> Bool
(SscProof -> SscProof -> Bool)
-> (SscProof -> SscProof -> Bool) -> Eq SscProof
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SscProof -> SscProof -> Bool
$c/= :: SscProof -> SscProof -> Bool
== :: SscProof -> SscProof -> Bool
$c== :: SscProof -> SscProof -> Bool
Eq, Int -> SscProof -> ShowS
[SscProof] -> ShowS
SscProof -> String
(Int -> SscProof -> ShowS)
-> (SscProof -> String) -> ([SscProof] -> ShowS) -> Show SscProof
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SscProof] -> ShowS
$cshowList :: [SscProof] -> ShowS
show :: SscProof -> String
$cshow :: SscProof -> String
showsPrec :: Int -> SscProof -> ShowS
$cshowsPrec :: Int -> SscProof -> ShowS
Show, (forall x. SscProof -> Rep SscProof x)
-> (forall x. Rep SscProof x -> SscProof) -> Generic SscProof
forall x. Rep SscProof x -> SscProof
forall x. SscProof -> Rep SscProof x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SscProof x -> SscProof
$cfrom :: forall x. SscProof -> Rep SscProof x
Generic, SscProof -> ()
(SscProof -> ()) -> NFData SscProof
forall a. (a -> ()) -> NFData a
rnf :: SscProof -> ()
$crnf :: SscProof -> ()
NFData, Context -> SscProof -> IO (Maybe ThunkInfo)
Proxy SscProof -> String
(Context -> SscProof -> IO (Maybe ThunkInfo))
-> (Context -> SscProof -> IO (Maybe ThunkInfo))
-> (Proxy SscProof -> String)
-> NoThunks SscProof
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy SscProof -> String
$cshowTypeOf :: Proxy SscProof -> String
wNoThunks :: Context -> SscProof -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SscProof -> IO (Maybe ThunkInfo)
noThunks :: Context -> SscProof -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> SscProof -> IO (Maybe ThunkInfo)
NoThunks)

-- Used for debugging purposes only
instance ToJSON SscProof

instance ToCBOR SscProof where
  toCBOR :: SscProof -> Encoding
toCBOR SscProof
_ =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Word8
3 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR ByteString
hashBytes
    where
      -- The VssCertificatesMap is encoded as a HashSet, so you'd think we want
      -- the hash of the encoding of an empty HashSet. BUT NO! For the calculation
      -- of the hashes in the header, it uses the encoding of the underlying
      -- HashMap. The hash of the encoded empty HashMap is
      --   d36a2619a672494604e11bb447cbcf5231e9f2ba25c2169177edc941bd50ad6c
      hashBytes :: ByteString
      hashBytes :: ByteString
hashBytes =
        [Word8] -> ByteString
ByteString.pack
          [ Word8
0xd3,
            Word8
0x6a,
            Word8
0x26,
            Word8
0x19,
            Word8
0xa6,
            Word8
0x72,
            Word8
0x49,
            Word8
0x46,
            Word8
0x04,
            Word8
0xe1,
            Word8
0x1b,
            Word8
0xb4,
            Word8
0x47,
            Word8
0xcb,
            Word8
0xcf,
            Word8
0x52,
            Word8
0x31,
            Word8
0xe9,
            Word8
0xf2,
            Word8
0xba,
            Word8
0x25,
            Word8
0xc2,
            Word8
0x16,
            Word8
0x91,
            Word8
0x77,
            Word8
0xed,
            Word8
0xc9,
            Word8
0x41,
            Word8
0xbd,
            Word8
0x50,
            Word8
0xad,
            Word8
0x6c
          ]

  encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy SscProof -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size Proxy SscProof
_ =
    Size
1
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Word8 -> Size
forall a.
ToCBOR a =>
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. ToCBOR t => Proxy t -> Size
size (Proxy Word8
forall k (t :: k). Proxy t
Proxy :: Proxy Word8)
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ Size
34

instance FromCBOR SscProof where
  fromCBOR :: Decoder s SscProof
fromCBOR = do
    Dropper s
forall s. Dropper s
dropSscProof
    SscProof -> Decoder s SscProof
forall (f :: * -> *) a. Applicative f => a -> f a
pure SscProof
SscProof

dropSscProof :: Dropper s
dropSscProof :: Dropper s
dropSscProof = do
  Int
actualLen <- Decoder s Int
forall s. Decoder s Int
decodeListLen
  Decoder s Word8
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Word8 -> (Word8 -> Dropper s) -> Dropper s
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0 -> do
      Text -> Int -> Int -> Dropper s
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"CommitmentsProof" Int
3 Int
actualLen
      Dropper s
forall s. Dropper s
dropBytes
      Dropper s
forall s. Dropper s
dropBytes
    Word8
1 -> do
      Text -> Int -> Int -> Dropper s
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"OpeningsProof" Int
3 Int
actualLen
      Dropper s
forall s. Dropper s
dropBytes
      Dropper s
forall s. Dropper s
dropBytes
    Word8
2 -> do
      Text -> Int -> Int -> Dropper s
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"SharesProof" Int
3 Int
actualLen
      Dropper s
forall s. Dropper s
dropBytes
      Dropper s
forall s. Dropper s
dropBytes
    Word8
3 -> do
      Text -> Int -> Int -> Dropper s
forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"CertificatesProof" Int
2 Int
actualLen
      Dropper s
forall s. Dropper s
dropBytes
    Word8
t -> DecoderError -> Dropper s
forall e s a. Buildable e => e -> Decoder s a
cborError (DecoderError -> Dropper s) -> DecoderError -> Dropper s
forall a b. (a -> b) -> a -> b
$ Text -> Word8 -> DecoderError
DecoderErrorUnknownTag Text
"SscProof" Word8
t

--------------------------------------------------------------------------------
-- CommitmentsMap
--------------------------------------------------------------------------------

dropCommitmentsMap :: Dropper s
dropCommitmentsMap :: Dropper s
dropCommitmentsMap = Dropper s -> Dropper s
forall s. Dropper s -> Dropper s
dropSet Dropper s
forall s. Dropper s
dropSignedCommitment

dropSignedCommitment :: Dropper s
dropSignedCommitment :: Dropper s
dropSignedCommitment = Dropper s -> Dropper s -> Dropper s -> Dropper s
forall s. Dropper s -> Dropper s -> Dropper s -> Dropper s
dropTriple Dropper s
forall s. Dropper s
dropBytes Dropper s
forall s. Dropper s
dropCommitment Dropper s
forall s. Dropper s
dropBytes

dropCommitment :: Dropper s
dropCommitment :: Dropper s
dropCommitment = do
  Text -> Int -> Dropper s
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"Commitment" Int
2
  -- Map (AsBinary VssVerificationKey) (NonEmpty (AsBinary EncShare))
  Dropper s -> Dropper s -> Dropper s
forall s. Dropper s -> Dropper s -> Dropper s
dropMap Dropper s
forall s. Dropper s
dropBytes (Dropper s -> Dropper s
forall s. Dropper s -> Dropper s
dropList Dropper s
forall s. Dropper s
dropBytes)
  Dropper s
forall s. Dropper s
dropSecretProof

dropSecretProof :: Dropper s
dropSecretProof :: Dropper s
dropSecretProof = do
  Text -> Int -> Dropper s
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"SecretProof" Int
4
  -- Scrape.ExtraGen
  Dropper s
forall s. Dropper s
dropBytes
  -- Scrape.Proof
  Dropper s
forall s. Dropper s
dropBytes
  -- Scrape.ParallelProofs
  Dropper s
forall s. Dropper s
dropBytes
  -- [Scrape.Commitment]
  Dropper s -> Dropper s
forall s. Dropper s -> Dropper s
dropList Dropper s
forall s. Dropper s
dropBytes

--------------------------------------------------------------------------------
-- OpeningsMap
--------------------------------------------------------------------------------

dropOpeningsMap :: Dropper s
dropOpeningsMap :: Dropper s
dropOpeningsMap = Dropper s -> Dropper s -> Dropper s
forall s. Dropper s -> Dropper s -> Dropper s
dropMap Dropper s
forall s. Dropper s
dropBytes Dropper s
forall s. Dropper s
dropBytes

--------------------------------------------------------------------------------
-- SharesMap
--------------------------------------------------------------------------------

dropSharesMap :: Dropper s
dropSharesMap :: Dropper s
dropSharesMap = Dropper s -> Dropper s -> Dropper s
forall s. Dropper s -> Dropper s -> Dropper s
dropMap Dropper s
forall s. Dropper s
dropBytes Dropper s
forall s. Dropper s
dropInnerSharesMap

dropInnerSharesMap :: Dropper s
dropInnerSharesMap :: Dropper s
dropInnerSharesMap = Dropper s -> Dropper s -> Dropper s
forall s. Dropper s -> Dropper s -> Dropper s
dropMap Dropper s
forall s. Dropper s
dropBytes (Dropper s -> Dropper s
forall s. Dropper s -> Dropper s
dropList Dropper s
forall s. Dropper s
dropBytes)

--------------------------------------------------------------------------------
-- VssCertificatesMap
--------------------------------------------------------------------------------

dropVssCertificatesMap :: Dropper s
dropVssCertificatesMap :: Dropper s
dropVssCertificatesMap = Dropper s -> Dropper s
forall s. Dropper s -> Dropper s
dropSet Dropper s
forall s. Dropper s
dropVssCertificate

dropVssCertificate :: Dropper s
dropVssCertificate :: Dropper s
dropVssCertificate = do
  Text -> Int -> Dropper s
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"VssCertificate" Int
4
  -- AsBinary VssVerificationKey
  Dropper s
forall s. Dropper s
dropBytes
  -- EpochNumber
  Dropper s
forall s. Dropper s
dropWord64
  -- Signature (AsBinary VssVerificationKey, EpochNumber)
  Dropper s
forall s. Dropper s
dropBytes
  -- VerificationKey
  Dropper s
forall s. Dropper s
dropBytes