{-# LANGUAGE ScopedTypeVariables #-}

module Test.Util.SupportedNetworkProtocolVersion (contiguousSupportedNetworkProtocolVersions) where

import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Proxy
import qualified Data.Set as Set
import Data.Typeable
import Ouroboros.Consensus.Node.NetworkProtocolVersion
import Test.Tasty.HUnit

-- | Make sure that 'supportedNodeToNodeVersions' and
-- 'supportedNodeToClientVersions' each map a contiguous range of versions
-- ending at 'maxBound'.
--
-- We deliberately do /not/ require every version of the network layer's enum to
-- be mapped. Dropping the oldest versions once no client still negotiates them
-- is a recurring, intentional operation, and the network layer keeps the
-- constructors around for longer than we keep supporting them.
--
-- What must hold is that the supported versions are a suffix without holes:
--
--  * ending at 'maxBound', so that adding a version to the network layer's enum
--    and forgetting to map it here is a build-time-visible failure, which is
--    the mistake this test was originally written to catch;
--
--  * without holes, since the handshake picks the highest version both sides
--    know, and a gap in the middle only makes the negotiated version harder to
--    reason about for no benefit;
--
--  * containing 'latestReleasedNodeVersion', which caps how far the oldest
--    supported version can rise. The diffusion layer truncates the advertised
--    map at the released version, so a released version below the run leaves
--    nothing to advertise.
contiguousSupportedNetworkProtocolVersions ::
  forall blk.
  (Typeable blk, SupportedNetworkProtocolVersion blk) =>
  Proxy blk ->
  Assertion
contiguousSupportedNetworkProtocolVersions :: forall blk.
(Typeable blk, SupportedNetworkProtocolVersion blk) =>
Proxy blk -> Assertion
contiguousSupportedNetworkProtocolVersions Proxy blk
p = do
  ((Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
 -> Maybe NodeToNodeVersion)
-> (Proxy blk
    -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk))
-> Assertion
forall v a.
(Show v, Ord v, Enum v, Bounded v) =>
((Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe v)
-> (Proxy blk -> Map v a) -> Assertion
testVersions (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
-> Maybe NodeToNodeVersion
forall a b. (a, b) -> a
fst Proxy blk -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToNodeVersion (BlockNodeToNodeVersion blk)
supportedNodeToNodeVersions
  ((Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
 -> Maybe NodeToClientVersion)
-> (Proxy blk
    -> Map NodeToClientVersion (BlockNodeToClientVersion blk))
-> Assertion
forall v a.
(Show v, Ord v, Enum v, Bounded v) =>
((Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe v)
-> (Proxy blk -> Map v a) -> Assertion
testVersions (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
-> Maybe NodeToClientVersion
forall a b. (a, b) -> b
snd Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> Map NodeToClientVersion (BlockNodeToClientVersion blk)
supportedNodeToClientVersions
 where
  testVersions ::
    (Show v, Ord v, Enum v, Bounded v) =>
    ((Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe v) ->
    (Proxy blk -> Map v a) ->
    Assertion
  testVersions :: forall v a.
(Show v, Ord v, Enum v, Bounded v) =>
((Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe v)
-> (Proxy blk -> Map v a) -> Assertion
testVersions (Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe v
prj Proxy blk -> Map v a
f = do
    HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool
      ([Char]
"no supported versions for " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
blkName)
      (Bool -> Bool
not (Set v -> Bool
forall a. Set a -> Bool
Set.null Set v
mappedVersions))
    HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool
      ( [Char]
"the newest version is not supported by "
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
blkName
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
": "
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [v] -> [Char]
forall a. Show a => a -> [Char]
show (Set v -> [v]
forall a. Set a -> [a]
Set.toList Set v
unsupportedNewerVersions)
      )
      (Set v -> Bool
forall a. Set a -> Bool
Set.null Set v
unsupportedNewerVersions)
    HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool
      ( [Char]
"holes in the supported versions of "
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
blkName
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
": "
          [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [v] -> [Char]
forall a. Show a => a -> [Char]
show (Set v -> [v]
forall a. Set a -> [a]
Set.toList Set v
holes)
      )
      (Set v -> Bool
forall a. Set a -> Bool
Set.null Set v
holes)
    HasCallStack => [Char] -> Bool -> Assertion
[Char] -> Bool -> Assertion
assertBool
      ([Char]
"the latest released version is not supported by " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
blkName)
      (Bool -> (v -> Bool) -> Maybe v -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
True (v -> Set v -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set v
mappedVersions) ((Maybe NodeToNodeVersion, Maybe NodeToClientVersion) -> Maybe v
prj (Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
forall blk.
SupportedNetworkProtocolVersion blk =>
Proxy blk -> (Maybe NodeToNodeVersion, Maybe NodeToClientVersion)
latestReleasedNodeVersion Proxy blk
p)))
   where
    blkName :: [Char]
blkName = SomeTypeRep -> [Char]
forall a. Show a => a -> [Char]
show (Proxy blk -> SomeTypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> SomeTypeRep
typeRep Proxy blk
p)
    mappedVersions :: Set v
mappedVersions = Map v a -> Set v
forall k a. Map k a -> Set k
Map.keysSet (Map v a -> Set v) -> Map v a -> Set v
forall a b. (a -> b) -> a -> b
$ Proxy blk -> Map v a
f Proxy blk
p
    -- Versions newer than the newest one we support. Empty iff we support
    -- 'maxBound'. Note we cannot use @succ (Set.findMax mappedVersions)@ here,
    -- as that throws when the newest version is already 'maxBound'.
    unsupportedNewerVersions :: Set v
unsupportedNewerVersions
      | Set v -> Bool
forall a. Set a -> Bool
Set.null Set v
mappedVersions = Set v
forall a. Set a
Set.empty
      | Bool
otherwise =
          [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [Set v -> v
forall a. Set a -> a
Set.findMax Set v
mappedVersions .. v
forall a. Bounded a => a
maxBound]
            Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set v
mappedVersions
    holes :: Set v
holes
      | Set v -> Bool
forall a. Set a -> Bool
Set.null Set v
mappedVersions = Set v
forall a. Set a
Set.empty
      | Bool
otherwise =
          [v] -> Set v
forall a. Ord a => [a] -> Set a
Set.fromList [Set v -> v
forall a. Set a -> a
Set.findMin Set v
mappedVersions .. Set v -> v
forall a. Set a -> a
Set.findMax Set v
mappedVersions]
            Set v -> Set v -> Set v
forall a. Ord a => Set a -> Set a -> Set a
Set.\\ Set v
mappedVersions