{-# 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.Ledger.Binary (
  DecCBOR (..),
  DecoderError (..),
  Dropper,
  EncCBOR (..),
  FromCBOR (..),
  ToCBOR (..),
  cborError,
  decodeListLen,
  dropBytes,
  dropList,
  dropMap,
  dropSet,
  dropTriple,
  dropWord64,
  encodeListLen,
  enforceSize,
  fromByronCBOR,
  matchSize,
  toByronCBOR,
 )
import Cardano.Prelude hiding (cborError)
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
$c== :: SscPayload -> SscPayload -> Bool
== :: SscPayload -> SscPayload -> Bool
$c/= :: SscPayload -> SscPayload -> Bool
/= :: 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
$cshowsPrec :: Int -> SscPayload -> ShowS
showsPrec :: Int -> SscPayload -> ShowS
$cshow :: SscPayload -> String
show :: SscPayload -> String
$cshowList :: [SscPayload] -> ShowS
showList :: [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
$cfrom :: forall x. SscPayload -> Rep SscPayload x
from :: forall x. SscPayload -> Rep SscPayload x
$cto :: forall x. Rep SscPayload x -> SscPayload
to :: forall x. Rep SscPayload x -> SscPayload
Generic, SscPayload -> ()
(SscPayload -> ()) -> NFData SscPayload
forall a. (a -> ()) -> NFData a
$crnf :: SscPayload -> ()
rnf :: SscPayload -> ()
NFData)

instance ToCBOR SscPayload where
  toCBOR :: SscPayload -> Encoding
toCBOR = SscPayload -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR SscPayload where
  fromCBOR :: forall s. Decoder s SscPayload
fromCBOR = Decoder s SscPayload
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- Used for debugging purposes only
instance ToJSON SscPayload

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

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

dropSscPayload :: Dropper s
dropSscPayload :: forall s. Dropper s
dropSscPayload = do
  Int
actualLen <- Decoder s Int
forall s. Decoder s Int
decodeListLen
  Decoder s Word8
forall s. Decoder s Word8
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s Word8 -> (Word8 -> Dropper s) -> Dropper s
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
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 (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m 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
$c== :: SscProof -> SscProof -> Bool
== :: SscProof -> SscProof -> Bool
$c/= :: SscProof -> SscProof -> Bool
/= :: 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
$cshowsPrec :: Int -> SscProof -> ShowS
showsPrec :: Int -> SscProof -> ShowS
$cshow :: SscProof -> String
show :: SscProof -> String
$cshowList :: [SscProof] -> ShowS
showList :: [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
$cfrom :: forall x. SscProof -> Rep SscProof x
from :: forall x. SscProof -> Rep SscProof x
$cto :: forall x. Rep SscProof x -> SscProof
to :: forall x. Rep SscProof x -> SscProof
Generic, SscProof -> ()
(SscProof -> ()) -> NFData SscProof
forall a. (a -> ()) -> NFData a
$crnf :: SscProof -> ()
rnf :: 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
$cnoThunks :: Context -> SscProof -> IO (Maybe ThunkInfo)
noThunks :: Context -> SscProof -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> SscProof -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> SscProof -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy SscProof -> String
showTypeOf :: Proxy SscProof -> String
NoThunks)

instance ToCBOR SscProof where
  toCBOR :: SscProof -> Encoding
toCBOR = SscProof -> Encoding
forall a. EncCBOR a => a -> Encoding
toByronCBOR

instance FromCBOR SscProof where
  fromCBOR :: forall s. Decoder s SscProof
fromCBOR = Decoder s SscProof
forall a s. DecCBOR a => Decoder s a
fromByronCBOR

-- Used for debugging purposes only
instance ToJSON SscProof

instance EncCBOR SscProof where
  encCBOR :: SscProof -> Encoding
encCBOR SscProof
_ =
    Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
3 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR 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. EncCBOR t => Proxy t -> Size) -> Proxy SscProof -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size Proxy SscProof
_ =
    Size
1
      Size -> Size -> Size
forall a. Num a => a -> a -> a
+ (forall t. EncCBOR t => Proxy t -> Size) -> Proxy Word8 -> Size
forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr Proxy t -> Size
forall t. EncCBOR 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 DecCBOR SscProof where
  decCBOR :: forall s. Decoder s SscProof
decCBOR = do
    Dropper s
forall s. Dropper s
dropSscProof
    SscProof -> Decoder s SscProof
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure SscProof
SscProof

dropSscProof :: Dropper s
dropSscProof :: forall s. Dropper s
dropSscProof = do
  Int
actualLen <- Decoder s Int
forall s. Decoder s Int
decodeListLen
  Decoder s Word8
forall s. Decoder s Word8
forall a s. DecCBOR a => Decoder s a
decCBOR Decoder s Word8 -> (Word8 -> Dropper s) -> Dropper s
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
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 (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m 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 :: forall s. 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 :: forall s. 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 :: forall s. 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 :: forall s. 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 :: forall s. 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 :: forall s. 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 :: forall s. 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 :: forall s. 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 :: forall s. 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