-- | QuickCheck generators and shrinkers for 'NodeToNodeVersion' and
-- 'NodeToNodeVersionData', including helpers for generating valid and invalid
-- version + data combinations.
module Cardano.Network.NodeToNode.Version.TestUtils
  ( genNodeToNodeVersion
  , shrinkNodeToNodeVersion
  , genNodeToNodeVersionData
  , shrinkNodeToNodeVersionData
  , genValidNtnVersionDataForVersion
  , genInvalidNtnVersionAndDataPair
  , fixNtnVersionDataForVersion
  ) where

import Cardano.Network.NodeToNode.Version
import Ouroboros.Network.Magic (NetworkMagic (..))
import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing (..))
import Test.QuickCheck (Gen, arbitrary, arbitraryBoundedEnum, elements, oneof,
           shrink)


-- | Generator for 'NodeToNodeVersion'.
genNodeToNodeVersion :: Gen NodeToNodeVersion
genNodeToNodeVersion :: Gen NodeToNodeVersion
genNodeToNodeVersion = Gen NodeToNodeVersion
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

-- | Shrinker for 'NodeToNodeVersion'.
shrinkNodeToNodeVersion :: NodeToNodeVersion -> [NodeToNodeVersion]
shrinkNodeToNodeVersion :: NodeToNodeVersion -> [NodeToNodeVersion]
shrinkNodeToNodeVersion NodeToNodeVersion
v
  | NodeToNodeVersion
v NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Eq a => a -> a -> Bool
== NodeToNodeVersion
forall a. Bounded a => a
minBound = []
  | Bool
otherwise     = [NodeToNodeVersion -> NodeToNodeVersion
forall a. Enum a => a -> a
pred NodeToNodeVersion
v]

-- | Generator for 'NodeToNodeVersionData'.
genNodeToNodeVersionData :: Gen NodeToNodeVersionData
genNodeToNodeVersionData :: Gen NodeToNodeVersionData
genNodeToNodeVersionData =
      NetworkMagic
-> DiffusionMode
-> PeerSharing
-> Bool
-> PerasSupport
-> NodeToNodeVersionData
NodeToNodeVersionData
  (NetworkMagic
 -> DiffusionMode
 -> PeerSharing
 -> Bool
 -> PerasSupport
 -> NodeToNodeVersionData)
-> Gen NetworkMagic
-> Gen
     (DiffusionMode
      -> PeerSharing -> Bool -> PerasSupport -> NodeToNodeVersionData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> Gen Word32 -> Gen NetworkMagic
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary)
  Gen
  (DiffusionMode
   -> PeerSharing -> Bool -> PerasSupport -> NodeToNodeVersionData)
-> Gen DiffusionMode
-> Gen
     (PeerSharing -> Bool -> PerasSupport -> NodeToNodeVersionData)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [Gen DiffusionMode] -> Gen DiffusionMode
forall a. HasCallStack => [Gen a] -> Gen a
oneof [ DiffusionMode -> Gen DiffusionMode
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiffusionMode
InitiatorOnlyDiffusionMode
            , DiffusionMode -> Gen DiffusionMode
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DiffusionMode
InitiatorAndResponderDiffusionMode
            ]
  Gen (PeerSharing -> Bool -> PerasSupport -> NodeToNodeVersionData)
-> Gen PeerSharing
-> Gen (Bool -> PerasSupport -> NodeToNodeVersionData)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PeerSharing] -> Gen PeerSharing
forall a. HasCallStack => [a] -> Gen a
elements [ PeerSharing
PeerSharingDisabled
               , PeerSharing
PeerSharingEnabled
               ]
  Gen (Bool -> PerasSupport -> NodeToNodeVersionData)
-> Gen Bool -> Gen (PerasSupport -> NodeToNodeVersionData)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
  Gen (PerasSupport -> NodeToNodeVersionData)
-> Gen PerasSupport -> Gen NodeToNodeVersionData
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> [PerasSupport] -> Gen PerasSupport
forall a. HasCallStack => [a] -> Gen a
elements [ PerasSupport
PerasUnsupported
               , PerasSupport
PerasSupported
               ]

-- | Shrinker for 'NodeToNodeVersionData'.
shrinkNodeToNodeVersionData :: NodeToNodeVersionData -> [NodeToNodeVersionData]
shrinkNodeToNodeVersionData :: NodeToNodeVersionData -> [NodeToNodeVersionData]
shrinkNodeToNodeVersionData (NodeToNodeVersionData NetworkMagic
magic DiffusionMode
mode PeerSharing
ps Bool
qry PerasSupport
psup) =
       [ NetworkMagic
-> DiffusionMode
-> PeerSharing
-> Bool
-> PerasSupport
-> NodeToNodeVersionData
NodeToNodeVersionData NetworkMagic
magic' DiffusionMode
mode    PeerSharing
ps  Bool
qry  PerasSupport
psup  | NetworkMagic
magic'        <- NetworkMagic -> [NetworkMagic]
shrinkNetworkMagic NetworkMagic
magic ]
    [NodeToNodeVersionData]
-> [NodeToNodeVersionData] -> [NodeToNodeVersionData]
forall a. [a] -> [a] -> [a]
++ [ NetworkMagic
-> DiffusionMode
-> PeerSharing
-> Bool
-> PerasSupport
-> NodeToNodeVersionData
NodeToNodeVersionData NetworkMagic
magic  DiffusionMode
mode'   PeerSharing
ps  Bool
qry  PerasSupport
psup  | DiffusionMode
mode'         <- DiffusionMode -> [DiffusionMode]
shrinkDiffusionMode DiffusionMode
mode ]
    [NodeToNodeVersionData]
-> [NodeToNodeVersionData] -> [NodeToNodeVersionData]
forall a. [a] -> [a] -> [a]
++ [ NetworkMagic
-> DiffusionMode
-> PeerSharing
-> Bool
-> PerasSupport
-> NodeToNodeVersionData
NodeToNodeVersionData NetworkMagic
magic  DiffusionMode
mode    PeerSharing
ps' Bool
qry  PerasSupport
psup  | PeerSharing
ps'           <- PeerSharing -> [PeerSharing]
shrinkPeerSharing PeerSharing
ps ]
    [NodeToNodeVersionData]
-> [NodeToNodeVersionData] -> [NodeToNodeVersionData]
forall a. [a] -> [a] -> [a]
++ [ NetworkMagic
-> DiffusionMode
-> PeerSharing
-> Bool
-> PerasSupport
-> NodeToNodeVersionData
NodeToNodeVersionData NetworkMagic
magic  DiffusionMode
mode    PeerSharing
ps  Bool
qry' PerasSupport
psup  | Bool
qry'        <- Bool -> [Bool]
forall a. Arbitrary a => a -> [a]
shrink Bool
qry ]
    [NodeToNodeVersionData]
-> [NodeToNodeVersionData] -> [NodeToNodeVersionData]
forall a. [a] -> [a] -> [a]
++ [ NetworkMagic
-> DiffusionMode
-> PeerSharing
-> Bool
-> PerasSupport
-> NodeToNodeVersionData
NodeToNodeVersionData NetworkMagic
magic  DiffusionMode
mode    PeerSharing
ps  Bool
qry  PerasSupport
psup' | PerasSupport
psup' <- PerasSupport -> [PerasSupport]
shrinkPerasSupport PerasSupport
psup ]
  where
    shrinkNetworkMagic :: NetworkMagic -> [NetworkMagic]
    shrinkNetworkMagic :: NetworkMagic -> [NetworkMagic]
shrinkNetworkMagic (NetworkMagic Word32
nm) = Word32 -> NetworkMagic
NetworkMagic (Word32 -> NetworkMagic) -> [Word32] -> [NetworkMagic]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Word32 -> [Word32]
forall a. Arbitrary a => a -> [a]
shrink Word32
nm

    shrinkDiffusionMode :: DiffusionMode -> [DiffusionMode]
    shrinkDiffusionMode :: DiffusionMode -> [DiffusionMode]
shrinkDiffusionMode DiffusionMode
InitiatorOnlyDiffusionMode           = []
    shrinkDiffusionMode DiffusionMode
InitiatorAndResponderDiffusionMode   = [DiffusionMode
InitiatorOnlyDiffusionMode]

    shrinkPeerSharing :: PeerSharing -> [PeerSharing]
    shrinkPeerSharing :: PeerSharing -> [PeerSharing]
shrinkPeerSharing PeerSharing
PeerSharingDisabled = []
    shrinkPeerSharing PeerSharing
PeerSharingEnabled  = [PeerSharing
PeerSharingDisabled]

    shrinkPerasSupport :: PerasSupport -> [PerasSupport]
    shrinkPerasSupport :: PerasSupport -> [PerasSupport]
shrinkPerasSupport PerasSupport
PerasUnsupported = []
    shrinkPerasSupport PerasSupport
PerasSupported   = [PerasSupport
PerasUnsupported]

-- | Generate valid 'NodeToNodeVersionData' for a given version.
-- For versions before 'NodeToNodeV_16', 'perasSupport' is set to 'PerasUnsupported'.
genValidNtnVersionDataForVersion :: NodeToNodeVersion -> Gen NodeToNodeVersionData
genValidNtnVersionDataForVersion :: NodeToNodeVersion -> Gen NodeToNodeVersionData
genValidNtnVersionDataForVersion NodeToNodeVersion
version =
  NodeToNodeVersion -> NodeToNodeVersionData -> NodeToNodeVersionData
fixNtnVersionDataForVersion NodeToNodeVersion
version (NodeToNodeVersionData -> NodeToNodeVersionData)
-> Gen NodeToNodeVersionData -> Gen NodeToNodeVersionData
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NodeToNodeVersionData
genNodeToNodeVersionData

-- | For versions before 'NodeToNodeV_16', set 'perasSupport' to 'PerasUnsupported'
-- to ensure the data is valid for the version.
fixNtnVersionDataForVersion :: NodeToNodeVersion -> NodeToNodeVersionData -> NodeToNodeVersionData
fixNtnVersionDataForVersion :: NodeToNodeVersion -> NodeToNodeVersionData -> NodeToNodeVersionData
fixNtnVersionDataForVersion NodeToNodeVersion
version NodeToNodeVersionData
ntnData =
  if NodeToNodeVersion
version NodeToNodeVersion -> NodeToNodeVersion -> Bool
forall a. Ord a => a -> a -> Bool
< NodeToNodeVersion
NodeToNodeV_16
    then NodeToNodeVersionData
ntnData { perasSupport = PerasUnsupported }
    else NodeToNodeVersionData
ntnData

-- | Generate an invalid (version, data) pair.
--
-- So far only Peras support can generate an invalid case, so this function
-- returns a pair where 'PerasSupported' is used in the data with a version
-- that doesn't support it.
genInvalidNtnVersionAndDataPair :: Gen (NodeToNodeVersion, NodeToNodeVersionData)
genInvalidNtnVersionAndDataPair :: Gen (NodeToNodeVersion, NodeToNodeVersionData)
genInvalidNtnVersionAndDataPair = do
  rawNtnData <- Gen NodeToNodeVersionData
genNodeToNodeVersionData
  v <- elements [minBound .. pred NodeToNodeV_16]
  pure (v, rawNtnData { perasSupport = PerasSupported })