{-# LANGUAGE DerivingVia                #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE StandaloneDeriving         #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Ouroboros.Network.PeerSelection.Cardano.Instances where

import Cardano.Network.ConsensusMode (ConsensusMode (..))
import Cardano.Network.PeerSelection.Bootstrap (UseBootstrapPeers (..))
import Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..))
import Cardano.Network.Types (LedgerStateJudgement (..))
import Test.Ouroboros.Network.PeerSelection.Instances ()
import Test.QuickCheck


--
-- Arbitrary LedgerStateJudgement instance
--

newtype ArbitraryLedgerStateJudgement =
  ArbitraryLedgerStateJudgement {
    ArbitraryLedgerStateJudgement -> LedgerStateJudgement
getArbitraryLedgerStateJudgement :: LedgerStateJudgement
  } deriving Int -> ArbitraryLedgerStateJudgement -> ShowS
[ArbitraryLedgerStateJudgement] -> ShowS
ArbitraryLedgerStateJudgement -> String
(Int -> ArbitraryLedgerStateJudgement -> ShowS)
-> (ArbitraryLedgerStateJudgement -> String)
-> ([ArbitraryLedgerStateJudgement] -> ShowS)
-> Show ArbitraryLedgerStateJudgement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArbitraryLedgerStateJudgement -> ShowS
showsPrec :: Int -> ArbitraryLedgerStateJudgement -> ShowS
$cshow :: ArbitraryLedgerStateJudgement -> String
show :: ArbitraryLedgerStateJudgement -> String
$cshowList :: [ArbitraryLedgerStateJudgement] -> ShowS
showList :: [ArbitraryLedgerStateJudgement] -> ShowS
Show

instance Arbitrary ArbitraryLedgerStateJudgement where
    arbitrary :: Gen ArbitraryLedgerStateJudgement
arbitrary =
      LedgerStateJudgement -> ArbitraryLedgerStateJudgement
ArbitraryLedgerStateJudgement (LedgerStateJudgement -> ArbitraryLedgerStateJudgement)
-> Gen LedgerStateJudgement -> Gen ArbitraryLedgerStateJudgement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        [Gen LedgerStateJudgement] -> Gen LedgerStateJudgement
forall a. [Gen a] -> Gen a
oneof [ LedgerStateJudgement -> Gen LedgerStateJudgement
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LedgerStateJudgement
YoungEnough
              , LedgerStateJudgement -> Gen LedgerStateJudgement
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LedgerStateJudgement
TooOld
              ]
    shrink :: ArbitraryLedgerStateJudgement -> [ArbitraryLedgerStateJudgement]
shrink (ArbitraryLedgerStateJudgement LedgerStateJudgement
YoungEnough) =
      [LedgerStateJudgement -> ArbitraryLedgerStateJudgement
ArbitraryLedgerStateJudgement LedgerStateJudgement
TooOld]
    shrink (ArbitraryLedgerStateJudgement LedgerStateJudgement
TooOld)      =
      []

--
-- Arbitrary PeerTrustable instance
--

instance Arbitrary PeerTrustable where
  arbitrary :: Gen PeerTrustable
arbitrary = [PeerTrustable] -> Gen PeerTrustable
forall a. [a] -> Gen a
elements [ PeerTrustable
IsNotTrustable, PeerTrustable
IsTrustable ]

  shrink :: PeerTrustable -> [PeerTrustable]
shrink PeerTrustable
IsTrustable    = [ PeerTrustable
IsNotTrustable ]
  shrink PeerTrustable
IsNotTrustable = []

--
-- Arbitrary UseBootstrapPeers instance
--

instance Arbitrary UseBootstrapPeers where
  arbitrary :: Gen UseBootstrapPeers
arbitrary = [(Int, Gen UseBootstrapPeers)] -> Gen UseBootstrapPeers
forall a. [(Int, Gen a)] -> Gen a
frequency [ (Int
1, UseBootstrapPeers -> Gen UseBootstrapPeers
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UseBootstrapPeers
DontUseBootstrapPeers)
                        , (Int
1, [RelayAccessPoint] -> UseBootstrapPeers
UseBootstrapPeers ([RelayAccessPoint] -> UseBootstrapPeers)
-> Gen [RelayAccessPoint] -> Gen UseBootstrapPeers
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [RelayAccessPoint]
forall a. Arbitrary a => Gen a
arbitrary)
                        ]

  shrink :: UseBootstrapPeers -> [UseBootstrapPeers]
shrink UseBootstrapPeers
DontUseBootstrapPeers = []
  shrink (UseBootstrapPeers [RelayAccessPoint]
bp) | [] <- [RelayAccessPoint]
bp = [UseBootstrapPeers
DontUseBootstrapPeers]
                                | [RelayAccessPoint
_] <- [RelayAccessPoint]
bp = [UseBootstrapPeers
DontUseBootstrapPeers]
  shrink (UseBootstrapPeers (RelayAccessPoint
hd : [RelayAccessPoint]
_)) = [[RelayAccessPoint] -> UseBootstrapPeers
UseBootstrapPeers [RelayAccessPoint
hd]]

--
-- Arbitrary ConsensusMode instance
--

instance Arbitrary ConsensusMode where
  arbitrary :: Gen ConsensusMode
arbitrary = [ConsensusMode] -> Gen ConsensusMode
forall a. [a] -> Gen a
elements [ConsensusMode
PraosMode, ConsensusMode
GenesisMode]
  shrink :: ConsensusMode -> [ConsensusMode]
shrink ConsensusMode
GenesisMode = [ConsensusMode
PraosMode]
  shrink ConsensusMode
PraosMode   = []