{-# 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.Prelude

import Data.Aeson (ToJSON)
import NoThunks.Class (NoThunks (..))

import Cardano.Binary
  ( DecoderError(..)
  , Dropper
  , FromCBOR(..)
  , ToCBOR(..)
  , decodeListLen
  , dropBytes
  , dropList
  , dropMap
  , dropSet
  , dropTriple
  , dropWord64
  , encodeListLen
  , enforceSize
  , matchSize
  )

import qualified Data.ByteString as ByteString (pack)

--------------------------------------------------------------------------------
-- 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 where

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 where

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