{-# 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
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: SscPayload -> ()
$crnf :: SscPayload -> ()
NFData)

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

instance FromCBOR SscPayload where
  fromCBOR :: forall s. Decoder s SscPayload
fromCBOR = 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
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
3 :: Word8)
      forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (forall a. Monoid a => a
mempty :: Set ())

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

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

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

data SscProof
  = SscProof
  deriving (SscProof -> SscProof -> Bool
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
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. 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 -> ()
forall a. (a -> ()) -> NFData a
rnf :: SscProof -> ()
$crnf :: SscProof -> ()
NFData, Context -> SscProof -> IO (Maybe ThunkInfo)
Proxy SscProof -> String
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)

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

instance FromCBOR SscProof where
  fromCBOR :: forall s. Decoder s SscProof
fromCBOR = 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 forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
3 :: Word8) forall a. Semigroup a => a -> a -> a
<> 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
      forall a. Num a => a -> a -> a
+ forall a.
EncCBOR a =>
(forall t. EncCBOR t => Proxy t -> Size) -> Proxy a -> Size
encodedSizeExpr forall t. EncCBOR t => Proxy t -> Size
size (forall {k} (t :: k). Proxy t
Proxy :: Proxy Word8)
      forall a. Num a => a -> a -> a
+ Size
34

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

dropSscProof :: Dropper s
dropSscProof :: forall s. Dropper s
dropSscProof = do
  Int
actualLen <- forall s. Decoder s Int
decodeListLen
  forall a s. DecCBOR a => Decoder s a
decCBOR forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Word8
0 -> do
      forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"CommitmentsProof" Int
3 Int
actualLen
      forall s. Dropper s
dropBytes
      forall s. Dropper s
dropBytes
    Word8
1 -> do
      forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"OpeningsProof" Int
3 Int
actualLen
      forall s. Dropper s
dropBytes
      forall s. Dropper s
dropBytes
    Word8
2 -> do
      forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"SharesProof" Int
3 Int
actualLen
      forall s. Dropper s
dropBytes
      forall s. Dropper s
dropBytes
    Word8
3 -> do
      forall s. Text -> Int -> Int -> Decoder s ()
matchSize Text
"CertificatesProof" Int
2 Int
actualLen
      forall s. Dropper s
dropBytes
    Word8
t -> forall (m :: * -> *) e a. (MonadFail m, Buildable e) => e -> m a
cborError 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 = forall s. Dropper s -> Dropper s
dropSet forall s. Dropper s
dropSignedCommitment

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

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

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

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

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

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

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

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

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

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

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