module Hydra.OptionsSpec where

import Hydra.Prelude
import Test.Hydra.Prelude

import Hydra.Cardano.Api (
  ChainPoint (..),
  NetworkId (..),
  serialiseToRawBytesHexText,
 )
import Hydra.Chain (maximumNumberOfParties)
import Hydra.Chain.Direct (NetworkMagic (..))
import Hydra.ContestationPeriod (ContestationPeriod (UnsafeContestationPeriod))
import Hydra.Network (Host (Host))
import Hydra.Options (
  ChainConfig (..),
  Command (..),
  DirectChainConfig (..),
  GenerateKeyPair (GenerateKeyPair),
  InvalidOptions (..),
  LedgerConfig (..),
  OfflineChainConfig (..),
  ParserResult (..),
  PublishOptions (..),
  RunOptions (..),
  defaultDirectChainConfig,
  defaultLedgerConfig,
  defaultOfflineChainConfig,
  defaultRunOptions,
  outputFile,
  parseHydraCommandFromArgs,
  renderFailure,
  toArgs,
  validateRunOptions,
 )
import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)
import Test.QuickCheck (Property, chooseEnum, counterexample, forAll, property, vectorOf, (===))
import Text.Regex.TDFA ((=~))

spec :: Spec
spec :: Spec
spec = Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Hydra Node RunOptions" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    let genKeyString :: Gen String
genKeyString = Int -> Gen Char -> Gen String
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
10 (Gen Char -> Gen String) -> Gen Char -> Gen String
forall a b. (a -> b) -> a -> b
$ (Char, Char) -> Gen Char
forall a. Enum a => (a, a) -> Gen a
chooseEnum (Char
'a', Char
'z')
        genCardanoAndHydraKeys :: (Int -> Int) -> (Int -> Int) -> ([String], [String])
genCardanoAndHydraKeys Int -> Int
f1 Int -> Int
f2 = (Gen ([String], [String]) -> Int -> ([String], [String]))
-> Int -> Gen ([String], [String]) -> ([String], [String])
forall a b c. (a -> b -> c) -> b -> a -> c
flip Gen ([String], [String]) -> Int -> ([String], [String])
forall a. Gen a -> Int -> a
generateWith Int
42 (Gen ([String], [String]) -> ([String], [String]))
-> Gen ([String], [String]) -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ do
          [String]
cks <- Int -> Gen String -> Gen [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int -> Int
f1 Int
maximumNumberOfParties) Gen String
genKeyString
          [String]
hks <- Int -> Gen String -> Gen [String]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int -> Int
f2 Int
maximumNumberOfParties) Gen String
genKeyString
          ([String], [String]) -> Gen ([String], [String])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([String]
cks, [String]
hks)

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it (String
"validateRunOptions: using more than " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall b a. (Show a, IsString b) => a -> b
show Int
maximumNumberOfParties String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" parties should error out") (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      let ([String]
cardanoKeys, [String]
hydraKeys) = (Int -> Int) -> (Int -> Int) -> ([String], [String])
genCardanoAndHydraKeys (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) (Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)
          chainCfg :: ChainConfig
chainCfg = DirectChainConfig -> ChainConfig
Direct DirectChainConfig
defaultDirectChainConfig{cardanoVerificationKeys = cardanoKeys}
      RunOptions -> Either InvalidOptions ()
validateRunOptions (RunOptions
defaultRunOptions{hydraVerificationKeys = hydraKeys, chainConfig = chainCfg})
        Either InvalidOptions () -> Either InvalidOptions () -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` InvalidOptions -> Either InvalidOptions ()
forall a b. a -> Either a b
Left InvalidOptions
MaximumNumberOfPartiesExceeded
    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"validateRunOptions: loaded cardano keys needs to match with the hydra keys length" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      let ([String]
cardanoKeys, [String]
hydraKeys) = (Int -> Int) -> (Int -> Int) -> ([String], [String])
genCardanoAndHydraKeys (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
2) (Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
1)
          chainCfg :: ChainConfig
chainCfg = DirectChainConfig -> ChainConfig
Direct DirectChainConfig
defaultDirectChainConfig{cardanoVerificationKeys = cardanoKeys}
      RunOptions -> Either InvalidOptions ()
validateRunOptions (RunOptions
defaultRunOptions{hydraVerificationKeys = hydraKeys, chainConfig = chainCfg})
        Either InvalidOptions () -> Either InvalidOptions () -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` InvalidOptions -> Either InvalidOptions ()
forall a b. a -> Either a b
Left InvalidOptions
CardanoAndHydraKeysMissmatch

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses with default values" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
      [] HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --host option given valid IPv4 and IPv6 addresses" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      [String
"--host", String
"127.0.0.1"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{host = "127.0.0.1"}
      [String
"--host", String
"2001:db8:11e:c00::101"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{host = "2001:db8:11e:c00::101"}
      [String
"--host", String
"0.0.0.0"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{host = "0.0.0.0"}
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--host", String
"0.0.0"]
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--host", String
"2001:db8:11e:c00:101"]

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --port option given valid port number" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      [String
"--port", String
"12345"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{port = 12345}
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--port", String
"123456"]
      [String
"--port", String
"0"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{port = 0}
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--port", String
"-42"]

    -- TODO(SN): Move these examples rather into a 'instance Read Host' test and
    -- only check for correct format / wiring here using a single test case This
    -- became evident when realizing that the 'hydra-tui' is also relying on this
    -- Read instance for parsing, but in a different command line flag.
    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --peer `<host>:<port>` option" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      [String
"--peer", String
"1.2.3.4:4567"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{peers = [Host "1.2.3.4" 4567]}
      [String
"--peer", String
"1.2.3.4:4567", String
"--peer", String
"1.2.3.5:4568"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{peers = [Host "1.2.3.4" 4567, Host "1.2.3.5" 4568]}
      [String
"--peer", String
"foo.com:4567"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{peers = [Host "foo.com" 4567]}
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--peer", String
"foo.com:456789"]
    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does parse --peer given ipv6 addresses" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => String -> Expectation
String -> Expectation
pendingWith String
"we do not support it"
      [String
"--peer", String
":::1:4567"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{peers = [Host ":::1" 4567]}

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --monitoring-port option given valid port number" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      []
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{monitoringPort = Nothing}
      [String
"--monitoring-port", String
"12345"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{monitoringPort = Just 12345}
      [String
"--monitoring-port", String
"65535"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{monitoringPort = Just 65535}

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"flag --version returns version with base version from cabal" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      case [String] -> ParserResult Command
parseHydraCommandFromArgs [String
"--version"] of
        Failure ParserFailure ParserHelp
theFailure ->
          let (String
v, ExitCode
_ExitCode) = ParserFailure ParserHelp -> String -> (String, ExitCode)
renderFailure ParserFailure ParserHelp
theFailure String
"test"
           in String
v
                String -> (String -> Bool) -> Expectation
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> Expectation
`shouldSatisfy` (String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ (String
"[0-9]+\\.[0-9]+\\.[0-9]+(:?-[a-zA-Z0-9]+)" :: String))
        ParserResult Command
_ -> String -> Expectation
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure String
"expected a version but did get something else"
    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --hydra-verification-key option as a filepath" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      [String
"--hydra-verification-key", String
"./alice.vk"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{hydraVerificationKeys = ["./alice.vk"]}
      [String
"--hydra-verification-key", String
"/foo"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{hydraVerificationKeys = ["/foo"]}
      [String
"--hydra-verification-key", String
"bar"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{hydraVerificationKeys = ["bar"]}
      [String
"--hydra-verification-key", String
"alice.vk", String
"--hydra-verification-key", String
"bob.vk"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{hydraVerificationKeys = ["alice.vk", "bob.vk"]}

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --hydra-signing-key option as a filepath" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
      [String
"--hydra-signing-key", String
"./alice.sk"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{hydraSigningKey = "./alice.sk"}

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --testnet-magic option as a number" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--testnet-magic", String
"abc"]
      [String
"--testnet-magic", String
"0"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { networkId = Testnet (NetworkMagic 0)
                    }
            }
      [String
"--testnet-magic", String
"-1"] -- Word32 overflow expected
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { networkId = Testnet (NetworkMagic 4294967295)
                    }
            }
      [String
"--testnet-magic", String
"123"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { networkId = Testnet (NetworkMagic 123)
                    }
            }

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --mainnet option" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      [String
"--node-id", String
"hydra-node-1", String
"--mainnet"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { networkId = Mainnet
                    }
            }

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --contestation-period option as a number of seconds" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--contestation-period", String
"abc"]
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--contestation-period", String
"s"]
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--contestation-period", String
"-1"]
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--contestation-period", String
"0s"]
      HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse [String
"--contestation-period", String
"00s"]
      [String
"--contestation-period", String
"1s"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { contestationPeriod = UnsafeContestationPeriod 1
                    }
            }
      [String
"--contestation-period", String
"300s"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { contestationPeriod = UnsafeContestationPeriod 300
                    }
            }

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --mainnet flag" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      [String
"--mainnet"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { networkId = Mainnet
                    }
            }

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --node-socket as a filepath" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
      [String
"--node-socket", String
"foo.sock"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { nodeSocket = "foo.sock"
                    }
            }

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --cardano-signing-key option as a filepath" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
      [String
"--cardano-signing-key", String
"./alice-cardano.sk"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { cardanoSigningKey = "./alice-cardano.sk"
                    }
            }

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --cardano-verification-key option as a filepath" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
      [String
"--cardano-verification-key", String
"./alice-cardano.vk"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { cardanoVerificationKeys = ["./alice-cardano.vk"]
                    }
            }

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --ledger-protocol-parameters-file as a filepath" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
      [String
"--ledger-protocol-parameters", String
"my-custom-protocol-parameters.json"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { ledgerConfig =
                defaultLedgerConfig
                  { cardanoLedgerProtocolParametersFile = "my-custom-protocol-parameters.json"
                  }
            }

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --start-chain-from as a pair of slot number and block header hash" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
      [String
"--start-chain-from", String
"1000.0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig =
                Direct
                  defaultDirectChainConfig
                    { startChainFrom =
                        Just $
                          ChainPoint 1000 $
                            fromString "0123456789abcdef0123456789abcdef0123456789abcdef0123456789abcdef"
                    }
            }

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"parses --start-chain-from 0 as starting from genesis" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
      [String
"--start-chain-from", String
"0"]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig = Direct defaultDirectChainConfig{startChainFrom = Just ChainPointAtGenesis}
            }

    String -> (TxId -> Expectation) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"parses --hydra-scripts-tx-id as a tx id" ((TxId -> Expectation) -> Spec) -> (TxId -> Expectation) -> Spec
forall a b. (a -> b) -> a -> b
$ \TxId
txId ->
      [String
"--hydra-scripts-tx-id", Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ TxId -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText TxId
txId]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig = Direct defaultDirectChainConfig{hydraScriptsTxId = txId}
            }

    String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"switches to offline chain when using --initial-utxo" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
      [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
        [ [String
"--initial-utxo", String
"some-file"]
        ]
        HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
          RunOptions
defaultRunOptions
            { chainConfig = Offline defaultOfflineChainConfig{initialUTxOFile = "some-file"}
            }

    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"publish-scripts sub-command" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
xit String
"does not parse without any options" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse
          [ String
"publish-scripts"
          ]

      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
xit String
"does not parse with some missing option (1)" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse ([String] -> Expectation) -> [String] -> Expectation
forall a b. (a -> b) -> a -> b
$
          [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
            [ [String
"publish-scripts"]
            , [String
"--node-socket", String
"foo"]
            , [String
"--mainnet"]
            ]

      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
xit String
"does not parse with some missing option (2)" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse ([String] -> Expectation) -> [String] -> Expectation
forall a b. (a -> b) -> a -> b
$
          [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
            [ [String
"publish-scripts"]
            , [String
"--testnet-magic", String
"42"]
            , [String
"--cardano-signing-key", String
"foo"]
            ]

      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
xit String
"does not parse with some missing option (3)" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        HasCallStack => [String] -> Expectation
[String] -> Expectation
shouldNotParse ([String] -> Expectation) -> [String] -> Expectation
forall a b. (a -> b) -> a -> b
$
          [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
            [ [String
"publish-scripts"]
            , [String
"--node-socket", String
"foo"]
            , [String
"--cardano-signing-key", String
"foo"]
            ]

      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"should parse using testnet and all options" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
          [ [String
"publish-scripts"]
          , [String
"--node-socket", String
"foo"]
          , [String
"--testnet-magic", String
"42"]
          , [String
"--cardano-signing-key", String
"bar"]
          ]
          HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` PublishOptions -> Command
Publish
            PublishOptions
              { $sel:publishNodeSocket:PublishOptions :: SocketPath
publishNodeSocket = SocketPath
"foo"
              , $sel:publishNetworkId:PublishOptions :: NetworkId
publishNetworkId = NetworkMagic -> NetworkId
Testnet (Word32 -> NetworkMagic
NetworkMagic Word32
42)
              , $sel:publishSigningKey:PublishOptions :: String
publishSigningKey = String
"bar"
              }
      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"should parse using mainnet and all options" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
          [ [String
"publish-scripts"]
          , [String
"--node-socket", String
"baz"]
          , [String
"--mainnet"]
          , [String
"--cardano-signing-key", String
"crux"]
          ]
          HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` PublishOptions -> Command
Publish
            PublishOptions
              { $sel:publishNodeSocket:PublishOptions :: SocketPath
publishNodeSocket = SocketPath
"baz"
              , $sel:publishNetworkId:PublishOptions :: NetworkId
publishNetworkId = NetworkId
Mainnet
              , $sel:publishSigningKey:PublishOptions :: String
publishSigningKey = String
"crux"
              }

    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"offline sub-command" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does parse with defaults" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        [String
"offline"]
          HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run RunOptions
defaultRunOptions{chainConfig = Offline defaultOfflineChainConfig}

      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does parse --ledger-genesis" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
          [ [String
"offline"]
          , [String
"--ledger-genesis", String
"some-file"]
          ]
          HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
            RunOptions
defaultRunOptions
              { chainConfig =
                  Offline
                    defaultOfflineChainConfig{ledgerGenesisFile = Just "some-file"}
              }

      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"does parse --initial-utxo" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
          [ [String
"offline"]
          , [String
"--initial-utxo", String
"some-file"]
          ]
          HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` RunOptions -> Command
Run
            RunOptions
defaultRunOptions
              { chainConfig =
                  Offline
                    defaultOfflineChainConfig{initialUTxOFile = "some-file"}
              }

    String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"gen-hydra-keys sub-command" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"should be able to parse gen-hydra-keys sub-command" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat
          [ [String
"gen-hydra-key"]
          , [String
"--output-file", String
"foo"]
          ]
          HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` GenerateKeyPair -> Command
GenHydraKey GenerateKeyPair{$sel:outputFile:GenerateKeyPair :: String
outputFile = String
"foo"}

      String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"should parse gen-hydra-keys without the output-file flag using default file name" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$
        [String
"gen-hydra-key"] HasCallStack => [String] -> Command -> Expectation
[String] -> Command -> Expectation
`shouldParse` GenerateKeyPair -> Command
GenHydraKey GenerateKeyPair{$sel:outputFile:GenerateKeyPair :: String
outputFile = String
"hydra-key"}

    Proxy RunOptions -> Spec
forall a.
(Arbitrary a, ToJSON a, FromJSON a, Typeable a) =>
Proxy a -> Spec
roundtripAndGoldenSpecs (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @RunOptions)

    String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"roundtrip parsing & printing" (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
      Gen RunOptions -> (RunOptions -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen RunOptions
forall a. Arbitrary a => Gen a
arbitrary RunOptions -> Property
canRoundtripRunOptionsAndPrettyPrinting

canRoundtripRunOptionsAndPrettyPrinting :: RunOptions -> Property
canRoundtripRunOptionsAndPrettyPrinting :: RunOptions -> Property
canRoundtripRunOptionsAndPrettyPrinting RunOptions
opts =
  let args :: [String]
args = RunOptions -> [String]
toArgs RunOptions
opts
   in String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"args:  " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall b a. (Show a, IsString b) => a -> b
show [String]
args) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
        case [String] -> ParserResult Command
parseHydraCommandFromArgs [String]
args of
          Success Command
cmd -> Command
cmd Command -> Command -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== RunOptions -> Command
Run RunOptions
opts
          ParserResult Command
err -> Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False Property -> (Property -> Property) -> Property
forall a b. a -> (a -> b) -> b
& String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"error : " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ParserResult Command -> String
forall b a. (Show a, IsString b) => a -> b
show ParserResult Command
err)

shouldParse :: HasCallStack => [String] -> Command -> Expectation
shouldParse :: HasCallStack => [String] -> Command -> Expectation
shouldParse [String]
args Command
cmd =
  case [String] -> ParserResult Command
parseHydraCommandFromArgs [String]
args of
    Success Command
a -> Command
a Command -> Command -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` Command
cmd
    ParserResult Command
err -> String -> Expectation
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (ParserResult Command -> String
forall b a. (Show a, IsString b) => a -> b
show ParserResult Command
err)

shouldNotParse :: HasCallStack => [String] -> Expectation
shouldNotParse :: HasCallStack => [String] -> Expectation
shouldNotParse [String]
args =
  case [String] -> ParserResult Command
parseHydraCommandFromArgs [String]
args of
    Success Command
a -> String -> Expectation
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> Expectation) -> String -> Expectation
forall a b. (a -> b) -> a -> b
$ String
"Unexpected successful parse to " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Command -> String
forall b a. (Show a, IsString b) => a -> b
show Command
a
    Failure ParserFailure ParserHelp
_ -> () -> Expectation
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    CompletionInvoked CompletionResult
_ -> String -> Expectation
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure String
"Unexpected completion invocation"