{-# LANGUAGE OverloadedStrings #-}

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

import Cardano.Binary
  ( Decoder,
    Dropper,
    decodeWord64,
    dropBytes,
    dropList,
    enforceSize,
    fromCBOR,
  )
import Cardano.Chain.Common
  ( ChainDifficulty,
    attrData,
    dropAttributes,
    fromCBORAttributes,
  )
import Cardano.Prelude

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

fromCBORBoundaryConsensusData :: Decoder s (Word64, ChainDifficulty)
fromCBORBoundaryConsensusData :: Decoder s (Word64, ChainDifficulty)
fromCBORBoundaryConsensusData = 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 a s. FromCBOR a => Decoder s a
fromCBOR
  (Word64, ChainDifficulty) -> Decoder s (Word64, ChainDifficulty)
forall (m :: * -> *) a. Monad m => a -> m a
return (Word64
w, ChainDifficulty
cd)

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

dropBoundaryExtraHeaderData :: Dropper s
dropBoundaryExtraHeaderData :: 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 :: 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)
fromCBORAttributes
      Bool
False
      (\Word8
w8 ByteString
bs Bool
t -> Maybe Bool -> Decoder s (Maybe Bool)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Bool -> Decoder s (Maybe Bool))
-> (Bool -> Maybe Bool) -> Bool -> Decoder s (Maybe Bool)
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 :: 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 :: 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