{-# 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.Version
import           Ouroboros.Network.NodeToNode.Version

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

-- | Protocol versioning
--
-- IMPORTANT Note that this is entirely independent of the
-- 'Ouroboros.Consensus.Shelley.Node.TPraos.shelleyProtVer' field et al.
--
-- Its primary purpose is to control the details of on-the-wire codecs. And
-- additionally which queries are allowed, in the case of
-- 'BlockNodeToClienVersion' (this use is already handled by
-- 'Ouroboros.Consensus.Shelley.Node.TPraos.shelleyProtVer' in the NTN case).
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.
  --
  -- IMPORTANT Note that this is entirely independent of the
  -- 'Ouroboros.Consensus.Shelley.Node.TPraos.shelleyProtVer' field et al.
  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 :: forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersionDefault Proxy blk
prx =
    ( ((NodeToNodeVersion, BlockNodeToNodeVersion blk)
 -> NodeToNodeVersion)
-> Maybe (NodeToNodeVersion, BlockNodeToNodeVersion blk)
-> Maybe NodeToNodeVersion
forall a b. (a -> b) -> Maybe a -> Maybe b
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 a b. (a -> b) -> Maybe a -> Maybe b
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
    )