{-# 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
    }