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

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

import qualified Codec.CBOR.Decoding as CBOR
import qualified Codec.CBOR.Encoding as CBOR
import           Codec.Serialise (Serialise)
import           Data.Hashable
import           Data.Word
import           GHC.Generics (Generic)
import           NoThunks.Class (NoThunks)
import           Ouroboros.Consensus.Util.Condense (Condense (..))
import           Ouroboros.Network.Util.ShowProxy (ShowProxy (..))
import           Quiet

{-------------------------------------------------------------------------------
  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
$c== :: NodeId -> NodeId -> Bool
== :: NodeId -> NodeId -> Bool
$c/= :: NodeId -> NodeId -> Bool
/= :: 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
$ccompare :: NodeId -> NodeId -> Ordering
compare :: NodeId -> NodeId -> Ordering
$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
>= :: NodeId -> NodeId -> Bool
$cmax :: NodeId -> NodeId -> NodeId
max :: NodeId -> NodeId -> NodeId
$cmin :: NodeId -> NodeId -> NodeId
min :: NodeId -> NodeId -> 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
$cshowsPrec :: Int -> NodeId -> ShowS
showsPrec :: Int -> NodeId -> ShowS
$cshow :: NodeId -> String
show :: NodeId -> String
$cshowList :: [NodeId] -> ShowS
showList :: [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
$cfrom :: forall x. NodeId -> Rep NodeId x
from :: forall x. NodeId -> Rep NodeId x
$cto :: forall x. Rep NodeId x -> NodeId
to :: forall x. Rep NodeId x -> NodeId
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
$cnoThunks :: Context -> NodeId -> IO (Maybe ThunkInfo)
noThunks :: Context -> NodeId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> NodeId -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> NodeId -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy NodeId -> String
showTypeOf :: Proxy NodeId -> String
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
$c== :: CoreNodeId -> CoreNodeId -> Bool
== :: CoreNodeId -> CoreNodeId -> Bool
$c/= :: CoreNodeId -> CoreNodeId -> Bool
/= :: 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
$ccompare :: CoreNodeId -> CoreNodeId -> Ordering
compare :: CoreNodeId -> CoreNodeId -> Ordering
$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
>= :: CoreNodeId -> CoreNodeId -> Bool
$cmax :: CoreNodeId -> CoreNodeId -> CoreNodeId
max :: CoreNodeId -> CoreNodeId -> CoreNodeId
$cmin :: CoreNodeId -> CoreNodeId -> CoreNodeId
min :: CoreNodeId -> CoreNodeId -> 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
$cfrom :: forall x. CoreNodeId -> Rep CoreNodeId x
from :: forall x. CoreNodeId -> Rep CoreNodeId x
$cto :: forall x. Rep CoreNodeId x -> CoreNodeId
to :: forall x. Rep CoreNodeId x -> CoreNodeId
Generic)
  deriving newtype (CoreNodeId -> String
(CoreNodeId -> String) -> Condense CoreNodeId
forall a. (a -> String) -> Condense a
$ccondense :: CoreNodeId -> String
condense :: CoreNodeId -> String
Condense, [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
$cencode :: CoreNodeId -> Encoding
encode :: CoreNodeId -> Encoding
$cdecode :: forall s. Decoder s CoreNodeId
decode :: forall s. Decoder s CoreNodeId
$cencodeList :: [CoreNodeId] -> Encoding
encodeList :: [CoreNodeId] -> Encoding
$cdecodeList :: forall s. Decoder s [CoreNodeId]
decodeList :: forall s. Decoder s [CoreNodeId]
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
$cnoThunks :: Context -> CoreNodeId -> IO (Maybe ThunkInfo)
noThunks :: Context -> CoreNodeId -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> CoreNodeId -> IO (Maybe ThunkInfo)
wNoThunks :: Context -> CoreNodeId -> IO (Maybe ThunkInfo)
$cshowTypeOf :: Proxy CoreNodeId -> String
showTypeOf :: Proxy CoreNodeId -> String
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
$cshowsPrec :: Int -> CoreNodeId -> ShowS
showsPrec :: Int -> CoreNodeId -> ShowS
$cshow :: CoreNodeId -> String
show :: CoreNodeId -> String
$cshowList :: [CoreNodeId] -> ShowS
showList :: [CoreNodeId] -> ShowS
Show via Quiet CoreNodeId

instance Hashable CoreNodeId

instance ShowProxy NodeId where
  showProxy :: Proxy NodeId -> String
showProxy Proxy NodeId
_ = String
"NodeId"

encodeNodeId :: NodeId -> CBOR.Encoding
encodeNodeId :: NodeId -> Encoding
encodeNodeId (CoreId (CoreNodeId Word64
wo)) = Word -> Encoding
CBOR.encodeListLen Word
2
                                     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
0
                                     Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
CBOR.encodeWord64 Word64
wo
encodeNodeId (RelayId Word64
wo) = Word -> Encoding
CBOR.encodeListLen Word
2
                         Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word -> Encoding
CBOR.encodeWord Word
1
                         Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word64 -> Encoding
CBOR.encodeWord64 Word64
wo

decodeNodeId :: CBOR.Decoder s NodeId
decodeNodeId :: forall s. Decoder s NodeId
decodeNodeId = do
  Int
_ <- Decoder s Int
forall s. Decoder s Int
CBOR.decodeListLen
  Word
tok <- Decoder s Word
forall s. Decoder s Word
CBOR.decodeWord
  case Word
tok of
    Word
0 -> (CoreNodeId -> NodeId
CoreId (CoreNodeId -> NodeId)
-> (Word64 -> CoreNodeId) -> Word64 -> NodeId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> CoreNodeId
CoreNodeId) (Word64 -> NodeId) -> Decoder s Word64 -> Decoder s NodeId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
CBOR.decodeWord64
    Word
1 -> Word64 -> NodeId
RelayId (Word64 -> NodeId) -> Decoder s Word64 -> Decoder s NodeId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s Word64
forall s. Decoder s Word64
CBOR.decodeWord64
    Word
_ -> String -> Decoder s NodeId
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"decodeNodeId: unknown tok:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Word -> String
forall a. Show a => a -> String
show Word
tok)

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