module Hydra.Node.RunSpec where

import Hydra.Prelude
import Test.Hydra.Prelude

import Cardano.Ledger.BaseTypes (Globals (..))
import Cardano.Slotting.EpochInfo (epochInfoEpoch, epochInfoSlotToUTCTime)
import Hydra.Cardano.Api (SlotNo (..))
import Hydra.Chain.Offline (loadGenesisFile)
import Hydra.Node.Run (ConfigurationException, newGlobalsWithEraHistory, run)
import Hydra.Options (
  CardanoChainConfig (..),
  ChainConfig (..),
  RunOptions (..),
  defaultCardanoChainConfig,
  defaultRunOptions,
 )
import Test.Hydra.Ledger.Cardano.Fixtures (eraHistoryWithHorizonAt)
import Test.Hydra.Options (genFilePath)
import Test.QuickCheck (generate)

spec :: Spec
spec :: Spec
spec = do
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"throws exception given options are invalid" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    [String]
cardanoKeys <- Gen [String] -> IO [String]
forall a. Gen a -> IO a
generate (Gen [String] -> IO [String]) -> Gen [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ Int -> Gen String -> Gen [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
1 (String -> Gen String
genFilePath String
"vk")
    [String]
hydraVerificationKeys <- Gen [String] -> IO [String]
forall a. Gen a -> IO a
generate (Gen [String] -> IO [String]) -> Gen [String] -> IO [String]
forall a b. (a -> b) -> a -> b
$ Int -> Gen String -> Gen [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
2 (String -> Gen String
genFilePath String
"vk")
    RunOptions -> IO ()
run
      RunOptions
defaultRunOptions
        { chainConfig = Cardano defaultCardanoChainConfig{cardanoVerificationKeys = cardanoKeys}
        , hydraVerificationKeys
        }
      IO () -> Selector ConfigurationException -> IO ()
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> IO ()
`shouldThrow` Selector ConfigurationException
aConfigurationException

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"newGlobalsWithEraHistory" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
    String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"converts slots beyond the queried era history horizon" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
      GenesisParameters ShelleyEra
genesisParameters <- Maybe String -> IO (GenesisParameters ShelleyEra)
loadGenesisFile Maybe String
forall a. Maybe a
Nothing
      Globals
globals <- GenesisParameters ShelleyEra -> EraHistory -> IO Globals
forall (m :: * -> *).
MonadThrow m =>
GenesisParameters ShelleyEra -> EraHistory -> m Globals
newGlobalsWithEraHistory GenesisParameters ShelleyEra
genesisParameters (SlotNo -> EraHistory
eraHistoryWithHorizonAt (Word64 -> SlotNo
SlotNo Word64
100))
      let beyondHorizon :: SlotNo
beyondHorizon = Word64 -> SlotNo
SlotNo Word64
101
      EpochInfo (Either Text)
-> SystemStart -> SlotNo -> Either Text UTCTime
forall (m :: * -> *).
(HasCallStack, Monad m) =>
EpochInfo m -> SystemStart -> SlotNo -> m UTCTime
epochInfoSlotToUTCTime (Globals -> EpochInfo (Either Text)
epochInfo Globals
globals) (Globals -> SystemStart
systemStart Globals
globals) SlotNo
beyondHorizon
        Either Text UTCTime -> (Either Text UTCTime -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` Either Text UTCTime -> Bool
forall a b. Either a b -> Bool
isRight
      EpochInfo (Either Text) -> SlotNo -> Either Text EpochNo
forall (m :: * -> *).
HasCallStack =>
EpochInfo m -> SlotNo -> m EpochNo
epochInfoEpoch (Globals -> EpochInfo (Either Text)
epochInfo Globals
globals) SlotNo
beyondHorizon
        Either Text EpochNo -> (Either Text EpochNo -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` Either Text EpochNo -> Bool
forall a b. Either a b -> Bool
isRight

aConfigurationException :: Selector ConfigurationException
aConfigurationException :: Selector ConfigurationException
aConfigurationException = Bool -> Selector ConfigurationException
forall a b. a -> b -> a
const Bool
True