{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts  #-}
{-# LANGUAGE TypeFamilies      #-}

module Ouroboros.Consensus.Node.NetworkProtocolVersion (
    HasNetworkProtocolVersion (..)
  , SupportedNetworkProtocolVersion (..)
  , latestReleasedNodeVersionDefault
    -- * Re-exports
  , NodeToClientVersion (..)
  , NodeToNodeVersion (..)
  ) where

import           Data.Kind (Type)
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Proxy

import           Ouroboros.Network.NodeToClient
import           Ouroboros.Network.NodeToNode

{-------------------------------------------------------------------------------
  Protocol versioning
-------------------------------------------------------------------------------}

-- | Protocol versioning
class ( Show (BlockNodeToNodeVersion   blk)
      , Show (BlockNodeToClientVersion blk)
      , Eq   (BlockNodeToNodeVersion   blk)
      , Eq   (BlockNodeToClientVersion blk)
      ) => HasNetworkProtocolVersion blk where
  type BlockNodeToNodeVersion   blk :: Type
  type BlockNodeToClientVersion blk :: Type

  -- Defaults

  type BlockNodeToNodeVersion   blk = ()
  type BlockNodeToClientVersion blk = ()

class HasNetworkProtocolVersion blk => SupportedNetworkProtocolVersion blk where
  -- | Enumerate all supported node-to-node versions
  supportedNodeToNodeVersions
    :: Proxy blk -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)

  -- | Enumerate all supported node-to-client versions
  supportedNodeToClientVersions
    :: Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)

  -- | The latest released version
  --
  -- This is the latest version intended for deployment.
  latestReleasedNodeVersion
    :: Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)

-- | A default for 'latestReleasedNodeVersion'
--
-- Chooses the greatest in 'supportedNodeToNodeVersions' and
-- 'supportedNodeToClientVersions'.
latestReleasedNodeVersionDefault
  :: SupportedNetworkProtocolVersion blk
  => Proxy blk
  -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersionDefault :: Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersionDefault Proxy blk
prx =
    ( ((NodeToNodeVersion, BlockNodeToNodeVersion blk)
 -> NodeToNodeVersion)
-> Maybe (NodeToNodeVersion, BlockNodeToNodeVersion blk)
-> Maybe NodeToNodeVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeToNodeVersion, BlockNodeToNodeVersion blk)
-> NodeToNodeVersion
forall a b. (a, b) -> a
fst (Maybe (NodeToNodeVersion, BlockNodeToNodeVersion blk)
 -> Maybe NodeToNodeVersion)
-> Maybe (NodeToNodeVersion, BlockNodeToNodeVersion blk)
-> Maybe NodeToNodeVersion
forall a b. (a -> b) -> a -> b
$ Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> Maybe (NodeToNodeVersion, BlockNodeToNodeVersion blk)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax (Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
 -> Maybe (NodeToNodeVersion, BlockNodeToNodeVersion blk))
-> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
-> Maybe (NodeToNodeVersion, BlockNodeToNodeVersion blk)
forall a b. (a -> b) -> a -> b
$ Proxy blk -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions   Proxy blk
prx
    , ((NodeToClientVersion, BlockNodeToClientVersion blk)
 -> NodeToClientVersion)
-> Maybe (NodeToClientVersion, BlockNodeToClientVersion blk)
-> Maybe NodeToClientVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeToClientVersion, BlockNodeToClientVersion blk)
-> NodeToClientVersion
forall a b. (a, b) -> a
fst (Maybe (NodeToClientVersion, BlockNodeToClientVersion blk)
 -> Maybe NodeToClientVersion)
-> Maybe (NodeToClientVersion, BlockNodeToClientVersion blk)
-> Maybe NodeToClientVersion
forall a b. (a -> b) -> a -> b
$ Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> Maybe (NodeToClientVersion, BlockNodeToClientVersion blk)
forall k a. Map k a -> Maybe (k, a)
Map.lookupMax (Map NodeToClientVersion (BlockNodeToClientVersion blk)
 -> Maybe (NodeToClientVersion, BlockNodeToClientVersion blk))
-> Map NodeToClientVersion (BlockNodeToClientVersion blk)
-> Maybe (NodeToClientVersion, BlockNodeToClientVersion blk)
forall a b. (a -> b) -> a -> b
$ Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions Proxy blk
prx
    )