{-# LANGUAGE DeriveAnyClass             #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DerivingStrategies         #-}
{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Ouroboros.Consensus.NodeId (
    -- * Node IDs
    CoreNodeId (..)
  , NodeId (..)
  , fromCoreNodeId
  ) where

import           Codec.Serialise (Serialise)
import           Data.Hashable
import           Data.Word
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Quiet

import           Ouroboros.Consensus.Util.Condense (Condense (..))

{-------------------------------------------------------------------------------
  Node IDs
-------------------------------------------------------------------------------}

-- TODO: It is not at all clear that this makes any sense anymore. The network
-- layer does not use or provide node ids (it uses addresses).
data NodeId = CoreId !CoreNodeId
            | RelayId !Word64
  deriving (NodeId -> NodeId -> Bool
(NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool) -> Eq NodeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NodeId -> NodeId -> Bool
$c/= :: NodeId -> NodeId -> Bool
== :: NodeId -> NodeId -> Bool
$c== :: NodeId -> NodeId -> Bool
Eq, Eq NodeId
Eq NodeId
-> (NodeId -> NodeId -> Ordering)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> Bool)
-> (NodeId -> NodeId -> NodeId)
-> (NodeId -> NodeId -> NodeId)
-> Ord NodeId
NodeId -> NodeId -> Bool
NodeId -> NodeId -> Ordering
NodeId -> NodeId -> NodeId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: NodeId -> NodeId -> NodeId
$cmin :: NodeId -> NodeId -> NodeId
max :: NodeId -> NodeId -> NodeId
$cmax :: NodeId -> NodeId -> NodeId
>= :: NodeId -> NodeId -> Bool
$c>= :: NodeId -> NodeId -> Bool
> :: NodeId -> NodeId -> Bool
$c> :: NodeId -> NodeId -> Bool
<= :: NodeId -> NodeId -> Bool
$c<= :: NodeId -> NodeId -> Bool
< :: NodeId -> NodeId -> Bool
$c< :: NodeId -> NodeId -> Bool
compare :: NodeId -> NodeId -> Ordering
$ccompare :: NodeId -> NodeId -> Ordering
$cp1Ord :: Eq NodeId
Ord, Int -> NodeId -> ShowS
[NodeId] -> ShowS
NodeId -> String
(Int -> NodeId -> ShowS)
-> (NodeId -> String) -> ([NodeId] -> ShowS) -> Show NodeId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NodeId] -> ShowS
$cshowList :: [NodeId] -> ShowS
show :: NodeId -> String
$cshow :: NodeId -> String
showsPrec :: Int -> NodeId -> ShowS
$cshowsPrec :: Int -> NodeId -> ShowS
Show, (forall x. NodeId -> Rep NodeId x)
-> (forall x. Rep NodeId x -> NodeId) -> Generic NodeId
forall x. Rep NodeId x -> NodeId
forall x. NodeId -> Rep NodeId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NodeId x -> NodeId
$cfrom :: forall x. NodeId -> Rep NodeId x
Generic, Context -> NodeId -> IO (Maybe ThunkInfo)
Proxy NodeId -> String
(Context -> NodeId -> IO (Maybe ThunkInfo))
-> (Context -> NodeId -> IO (Maybe ThunkInfo))
-> (Proxy NodeId -> String)
-> NoThunks NodeId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy NodeId -> String
$cshowTypeOf :: Proxy NodeId -> String
wNoThunks :: Context -> NodeId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> NodeId -> IO (Maybe ThunkInfo)
noThunks :: Context -> NodeId -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> NodeId -> IO (Maybe ThunkInfo)
NoThunks)

instance Condense NodeId where
  condense :: NodeId -> String
condense (CoreId (CoreNodeId Word64
i)) = String
"c" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
i
  condense (RelayId            Word64
i ) = String
"r" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
i

instance Hashable NodeId

-- | Core node ID
newtype CoreNodeId = CoreNodeId {
      CoreNodeId -> Word64
unCoreNodeId :: Word64
    }
  deriving stock   (CoreNodeId -> CoreNodeId -> Bool
(CoreNodeId -> CoreNodeId -> Bool)
-> (CoreNodeId -> CoreNodeId -> Bool) -> Eq CoreNodeId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoreNodeId -> CoreNodeId -> Bool
$c/= :: CoreNodeId -> CoreNodeId -> Bool
== :: CoreNodeId -> CoreNodeId -> Bool
$c== :: CoreNodeId -> CoreNodeId -> Bool
Eq, Eq CoreNodeId
Eq CoreNodeId
-> (CoreNodeId -> CoreNodeId -> Ordering)
-> (CoreNodeId -> CoreNodeId -> Bool)
-> (CoreNodeId -> CoreNodeId -> Bool)
-> (CoreNodeId -> CoreNodeId -> Bool)
-> (CoreNodeId -> CoreNodeId -> Bool)
-> (CoreNodeId -> CoreNodeId -> CoreNodeId)
-> (CoreNodeId -> CoreNodeId -> CoreNodeId)
-> Ord CoreNodeId
CoreNodeId -> CoreNodeId -> Bool
CoreNodeId -> CoreNodeId -> Ordering
CoreNodeId -> CoreNodeId -> CoreNodeId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CoreNodeId -> CoreNodeId -> CoreNodeId
$cmin :: CoreNodeId -> CoreNodeId -> CoreNodeId
max :: CoreNodeId -> CoreNodeId -> CoreNodeId
$cmax :: CoreNodeId -> CoreNodeId -> CoreNodeId
>= :: CoreNodeId -> CoreNodeId -> Bool
$c>= :: CoreNodeId -> CoreNodeId -> Bool
> :: CoreNodeId -> CoreNodeId -> Bool
$c> :: CoreNodeId -> CoreNodeId -> Bool
<= :: CoreNodeId -> CoreNodeId -> Bool
$c<= :: CoreNodeId -> CoreNodeId -> Bool
< :: CoreNodeId -> CoreNodeId -> Bool
$c< :: CoreNodeId -> CoreNodeId -> Bool
compare :: CoreNodeId -> CoreNodeId -> Ordering
$ccompare :: CoreNodeId -> CoreNodeId -> Ordering
$cp1Ord :: Eq CoreNodeId
Ord, (forall x. CoreNodeId -> Rep CoreNodeId x)
-> (forall x. Rep CoreNodeId x -> CoreNodeId) -> Generic CoreNodeId
forall x. Rep CoreNodeId x -> CoreNodeId
forall x. CoreNodeId -> Rep CoreNodeId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CoreNodeId x -> CoreNodeId
$cfrom :: forall x. CoreNodeId -> Rep CoreNodeId x
Generic)
  deriving newtype (CoreNodeId -> String
(CoreNodeId -> String) -> Condense CoreNodeId
forall a. (a -> String) -> Condense a
condense :: CoreNodeId -> String
$ccondense :: CoreNodeId -> String
Condense, Decoder s CoreNodeId
Decoder s [CoreNodeId]
[CoreNodeId] -> Encoding
CoreNodeId -> Encoding
(CoreNodeId -> Encoding)
-> (forall s. Decoder s CoreNodeId)
-> ([CoreNodeId] -> Encoding)
-> (forall s. Decoder s [CoreNodeId])
-> Serialise CoreNodeId
forall s. Decoder s [CoreNodeId]
forall s. Decoder s CoreNodeId
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [CoreNodeId]
$cdecodeList :: forall s. Decoder s [CoreNodeId]
encodeList :: [CoreNodeId] -> Encoding
$cencodeList :: [CoreNodeId] -> Encoding
decode :: Decoder s CoreNodeId
$cdecode :: forall s. Decoder s CoreNodeId
encode :: CoreNodeId -> Encoding
$cencode :: CoreNodeId -> Encoding
Serialise, Context -> CoreNodeId -> IO (Maybe ThunkInfo)
Proxy CoreNodeId -> String
(Context -> CoreNodeId -> IO (Maybe ThunkInfo))
-> (Context -> CoreNodeId -> IO (Maybe ThunkInfo))
-> (Proxy CoreNodeId -> String)
-> NoThunks CoreNodeId
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy CoreNodeId -> String
$cshowTypeOf :: Proxy CoreNodeId -> String
wNoThunks :: Context -> CoreNodeId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CoreNodeId -> IO (Maybe ThunkInfo)
noThunks :: Context -> CoreNodeId -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> CoreNodeId -> IO (Maybe ThunkInfo)
NoThunks)
  deriving Int -> CoreNodeId -> ShowS
[CoreNodeId] -> ShowS
CoreNodeId -> String
(Int -> CoreNodeId -> ShowS)
-> (CoreNodeId -> String)
-> ([CoreNodeId] -> ShowS)
-> Show CoreNodeId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CoreNodeId] -> ShowS
$cshowList :: [CoreNodeId] -> ShowS
show :: CoreNodeId -> String
$cshow :: CoreNodeId -> String
showsPrec :: Int -> CoreNodeId -> ShowS
$cshowsPrec :: Int -> CoreNodeId -> ShowS
Show via Quiet CoreNodeId

instance Hashable CoreNodeId

fromCoreNodeId :: CoreNodeId -> NodeId
fromCoreNodeId :: CoreNodeId -> NodeId
fromCoreNodeId = CoreNodeId -> NodeId
CoreId