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

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
/= :: 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

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 :: 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 (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