{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}

module Test.Consensus.PointSchedule.NodeState (
    NodeState (..)
  , genesisNodeState
  , nsTipTip
  ) where

import           Ouroboros.Consensus.Block.Abstract (WithOrigin (..))
import           Ouroboros.Consensus.Util.Condense (Condense (..),
                     CondenseList (..), PaddingDirection (..), padListWith)
import qualified Ouroboros.Network.AnchoredFragment as AF
import           Ouroboros.Network.Block (Tip (..), tipFromHeader)
import           Ouroboros.Network.Point (withOrigin)
import           Test.Util.TersePrinting (terseBlock, terseWithOrigin)
import           Test.Util.TestBlock (TestBlock)

-- | The state of a peer at a given point in time.
data NodeState blk =
  NodeState {
    forall blk. NodeState blk -> WithOrigin blk
nsTip    :: WithOrigin blk,
    forall blk. NodeState blk -> WithOrigin blk
nsHeader :: WithOrigin blk,
    forall blk. NodeState blk -> WithOrigin blk
nsBlock  :: WithOrigin blk
  }
  deriving (NodeState blk -> NodeState blk -> Bool
(NodeState blk -> NodeState blk -> Bool)
-> (NodeState blk -> NodeState blk -> Bool) -> Eq (NodeState blk)
forall blk. Eq blk => NodeState blk -> NodeState blk -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall blk. Eq blk => NodeState blk -> NodeState blk -> Bool
== :: NodeState blk -> NodeState blk -> Bool
$c/= :: forall blk. Eq blk => NodeState blk -> NodeState blk -> Bool
/= :: NodeState blk -> NodeState blk -> Bool
Eq, Int -> NodeState blk -> ShowS
[NodeState blk] -> ShowS
NodeState blk -> String
(Int -> NodeState blk -> ShowS)
-> (NodeState blk -> String)
-> ([NodeState blk] -> ShowS)
-> Show (NodeState blk)
forall blk. Show blk => Int -> NodeState blk -> ShowS
forall blk. Show blk => [NodeState blk] -> ShowS
forall blk. Show blk => NodeState blk -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall blk. Show blk => Int -> NodeState blk -> ShowS
showsPrec :: Int -> NodeState blk -> ShowS
$cshow :: forall blk. Show blk => NodeState blk -> String
show :: NodeState blk -> String
$cshowList :: forall blk. Show blk => [NodeState blk] -> ShowS
showList :: [NodeState blk] -> ShowS
Show)

nsTipTip :: AF.HasHeader blk => NodeState blk -> Tip blk
nsTipTip :: forall blk. HasHeader blk => NodeState blk -> Tip blk
nsTipTip = Tip blk -> (blk -> Tip blk) -> WithOrigin blk -> Tip blk
forall b t. b -> (t -> b) -> WithOrigin t -> b
withOrigin Tip blk
forall {k} (b :: k). Tip b
TipGenesis blk -> Tip blk
forall a. HasHeader a => a -> Tip a
tipFromHeader (WithOrigin blk -> Tip blk)
-> (NodeState blk -> WithOrigin blk) -> NodeState blk -> Tip blk
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeState blk -> WithOrigin blk
forall blk. NodeState blk -> WithOrigin blk
nsTip

instance Condense (NodeState TestBlock) where
  condense :: NodeState TestBlock -> String
condense NodeState {WithOrigin TestBlock
nsTip :: forall blk. NodeState blk -> WithOrigin blk
nsTip :: WithOrigin TestBlock
nsTip, WithOrigin TestBlock
nsHeader :: forall blk. NodeState blk -> WithOrigin blk
nsHeader :: WithOrigin TestBlock
nsHeader, WithOrigin TestBlock
nsBlock :: forall blk. NodeState blk -> WithOrigin blk
nsBlock :: WithOrigin TestBlock
nsBlock} =
    String
"TP " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (TestBlock -> String) -> WithOrigin TestBlock -> String
forall a. (a -> String) -> WithOrigin a -> String
terseWithOrigin TestBlock -> String
terseBlock WithOrigin TestBlock
nsTip String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" | HP " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (TestBlock -> String) -> WithOrigin TestBlock -> String
forall a. (a -> String) -> WithOrigin a -> String
terseWithOrigin TestBlock -> String
terseBlock WithOrigin TestBlock
nsHeader String -> ShowS
forall a. [a] -> [a] -> [a]
++
    String
" | BP " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (TestBlock -> String) -> WithOrigin TestBlock -> String
forall a. (a -> String) -> WithOrigin a -> String
terseWithOrigin TestBlock -> String
terseBlock WithOrigin TestBlock
nsBlock

instance CondenseList (NodeState TestBlock) where
  condenseList :: [NodeState TestBlock] -> [String]
condenseList [NodeState TestBlock]
points =
    (String -> String -> ShowS)
-> [String] -> [String] -> [String] -> [String]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3
      (\String
tip String
header String
block ->
        String
"TP " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tip String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
" | HP " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
header String -> ShowS
forall a. [a] -> [a] -> [a]
++
          String
" | BP " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
block
      )
      (PaddingDirection -> [String] -> [String]
padListWith PaddingDirection
PadRight ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (NodeState TestBlock -> String)
-> [NodeState TestBlock] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((TestBlock -> String) -> WithOrigin TestBlock -> String
forall a. (a -> String) -> WithOrigin a -> String
terseWithOrigin TestBlock -> String
terseBlock (WithOrigin TestBlock -> String)
-> (NodeState TestBlock -> WithOrigin TestBlock)
-> NodeState TestBlock
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeState TestBlock -> WithOrigin TestBlock
forall blk. NodeState blk -> WithOrigin blk
nsTip) [NodeState TestBlock]
points)
      (PaddingDirection -> [String] -> [String]
padListWith PaddingDirection
PadRight ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (NodeState TestBlock -> String)
-> [NodeState TestBlock] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((TestBlock -> String) -> WithOrigin TestBlock -> String
forall a. (a -> String) -> WithOrigin a -> String
terseWithOrigin TestBlock -> String
terseBlock (WithOrigin TestBlock -> String)
-> (NodeState TestBlock -> WithOrigin TestBlock)
-> NodeState TestBlock
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeState TestBlock -> WithOrigin TestBlock
forall blk. NodeState blk -> WithOrigin blk
nsHeader) [NodeState TestBlock]
points)
      (PaddingDirection -> [String] -> [String]
padListWith PaddingDirection
PadRight ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (NodeState TestBlock -> String)
-> [NodeState TestBlock] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((TestBlock -> String) -> WithOrigin TestBlock -> String
forall a. (a -> String) -> WithOrigin a -> String
terseWithOrigin TestBlock -> String
terseBlock (WithOrigin TestBlock -> String)
-> (NodeState TestBlock -> WithOrigin TestBlock)
-> NodeState TestBlock
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeState TestBlock -> WithOrigin TestBlock
forall blk. NodeState blk -> WithOrigin blk
nsBlock) [NodeState TestBlock]
points)

genesisNodeState :: NodeState blk
genesisNodeState :: forall blk. NodeState blk
genesisNodeState =
  NodeState {
    nsTip :: WithOrigin blk
nsTip = WithOrigin blk
forall t. WithOrigin t
Origin,
    nsHeader :: WithOrigin blk
nsHeader = WithOrigin blk
forall t. WithOrigin t
Origin,
    nsBlock :: WithOrigin blk
nsBlock = WithOrigin blk
forall t. WithOrigin t
Origin
  }