{-# 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
  Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BoundaryConsensusData" Int
2
  Word64
w <- Decoder s Word64
forall s. Decoder s Word64
decodeWord64
  ChainDifficulty
cd <- Decoder s ChainDifficulty
forall s. Decoder s ChainDifficulty
forall a s. DecCBOR a => Decoder s a
decCBOR
  (Word64, ChainDifficulty) -> Decoder s (Word64, ChainDifficulty)
forall a. a -> Decoder s a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
w, ChainDifficulty
cd)

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

dropBoundaryExtraHeaderData :: Dropper s
dropBoundaryExtraHeaderData :: forall s. Dropper s
dropBoundaryExtraHeaderData = do
  Text -> Int -> Dropper s
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BoundaryExtraHeaderData" Int
1
  Dropper s
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
  Text -> Int -> Decoder s ()
forall s. Text -> Int -> Decoder s ()
enforceSize Text
"BoundaryExtraHeaderData" Int
1
  Attributes Bool -> Bool
forall h. Attributes h -> h
attrData
    (Attributes Bool -> Bool)
-> Decoder s (Attributes Bool) -> Decoder s Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool
-> (Word8 -> ByteString -> Bool -> Decoder s (Maybe Bool))
-> Decoder s (Attributes Bool)
forall t s.
t
-> (Word8 -> ByteString -> t -> Decoder s (Maybe t))
-> Decoder s (Attributes t)
decCBORAttributes
      Bool
False
      (\Word8
w8 ByteString
bs Bool
t -> Maybe Bool -> Decoder s (Maybe Bool)
forall a. a -> Decoder s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> Decoder s (Maybe Bool))
-> (Bool -> Maybe Bool) -> Bool -> Decoder s (Maybe Bool)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Bool -> Maybe Bool
forall a. a -> Maybe a
Just (Bool -> Decoder s (Maybe Bool)) -> Bool -> Decoder s (Maybe Bool)
forall a b. (a -> b) -> a -> b
$ Bool
t Bool -> Bool -> Bool
|| Word8
w8 Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
255 Bool -> Bool -> Bool
&& ByteString
bs ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"Genesis")

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

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

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

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