{-# LANGUAGE OverloadedStrings #-}

-- | Boundary blocks have been deprecated, but we keep functions to decode them
module Cardano.Chain.Block.Boundary (
  decCBORBoundaryConsensusData,
  dropBoundaryExtraHeaderData,
  dropBoundaryExtraHeaderDataRetainGenesisTag,
  dropBoundaryBody,
  dropBoundaryExtraBodyData,
)
where

import Cardano.Chain.Common (
  ChainDifficulty,
  attrData,
  decCBORAttributes,
  dropAttributes,
 )
import Cardano.Ledger.Binary (
  Decoder,
  Dropper,
  decCBOR,
  decodeWord64,
  dropBytes,
  dropList,
  enforceSize,
 )
import Cardano.Prelude

--------------------------------------------------------------------------------
-- BoundaryConsensusData
--------------------------------------------------------------------------------

decCBORBoundaryConsensusData :: Decoder s (Word64, ChainDifficulty)
decCBORBoundaryConsensusData :: forall s. Decoder s (Word64, ChainDifficulty)
decCBORBoundaryConsensusData = do
  forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BoundaryConsensusData" Int
2
  Word64
w <- forall s. Decoder s Word64
decodeWord64
  ChainDifficulty
cd <- forall a s. DecCBOR a => Decoder s a
decCBOR
  forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
w, ChainDifficulty
cd)

--------------------------------------------------------------------------------
-- BoundaryExtraHeaderData
--------------------------------------------------------------------------------

dropBoundaryExtraHeaderData :: Dropper s
dropBoundaryExtraHeaderData :: forall s. Dropper s
dropBoundaryExtraHeaderData = do
  forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BoundaryExtraHeaderData" Int
1
  forall s. Dropper s
dropAttributes

-- | When starting a new chain in ourorobos-consensus, we often start from a
--   non-zero epoch. This is done in order to ensure synchronisation between
--   nodes - we assume that the chain started at some fixed point in the past
--   (e.g. midnight) which all nodes can agree on despite different node start
--   times. However, the standard deserialisation assumes that the genesis EBB
--   is precisely that in epoch zero.
--
--   In order to successfully round-trip a genesis EBB in a non-zero epoch,
--   then, we add a "magic" tag which indicates the presense of the genesis
--   hash. The choice of 255 and the word "Genesis" is completely arbitrary, and
--   only done to correspond with the matching encoder. This encoding will only
--   ever be seen when processing blocks from a demo.
dropBoundaryExtraHeaderDataRetainGenesisTag :: Decoder s Bool
dropBoundaryExtraHeaderDataRetainGenesisTag :: forall s. Decoder s Bool
dropBoundaryExtraHeaderDataRetainGenesisTag = do
  forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BoundaryExtraHeaderData" Int
1
  forall h. Attributes h -> h
attrData
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t s.
t
-> (Word8 -> ByteString -> t -> Decoder s (Maybe t))
-> Decoder s (Attributes t)
decCBORAttributes
      Bool
False
      (\Word8
w8 ByteString
bs Bool
t -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Bool
t Bool -> Bool -> Bool
|| Word8
w8 forall a. Eq a => a -> a -> Bool
== Word8
255 Bool -> Bool -> Bool
&& ByteString
bs forall a. Eq a => a -> a -> Bool
== ByteString
"Genesis")

--------------------------------------------------------------------------------
-- BoundaryBody
--------------------------------------------------------------------------------

dropBoundaryBody :: Dropper s
dropBoundaryBody :: forall s. Dropper s
dropBoundaryBody = forall s. Dropper s -> Dropper s
dropList forall s. Dropper s
dropBytes

--------------------------------------------------------------------------------
-- BoundaryExtraBodyData
--------------------------------------------------------------------------------

dropBoundaryExtraBodyData :: Dropper s
dropBoundaryExtraBodyData :: forall s. Dropper s
dropBoundaryExtraBodyData = do
  forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BoundaryExtraBodyData" Int
1
  forall s. Dropper s
dropAttributes