module Hydra.Chain.ScriptRegistrySpec where

import Hydra.Prelude
import Test.Hydra.Prelude hiding (HydraTestnet (..))

import Hydra.Chain.ScriptRegistry (PublishScriptException (..), publishHydraScripts)
import Hydra.Tx.Secret (mkSecret)

import Hydra.Cardano.Api (
  Address,
  CardanoSigningKey (..),
  NetworkId (..),
  PaymentKey,
  ShelleyAddr,
  SystemStart (..),
  UTxO,
  VerificationKey,
  lovelaceToValue,
  mkVkAddress,
  pattern ByronAddressInEra,
  pattern ReferenceScriptNone,
  pattern ShelleyAddressInEra,
  pattern TxOut,
  pattern TxOutDatumNone,
 )
import Hydra.Chain.Backend (ChainBackend (..))
import Hydra.Chain.Blockfrost.Client (
  APIBlockfrostError (..),
  BlockfrostException (..),
 )
import Test.Hydra.Tx.Gen (genKeyPair)
import Test.QuickCheck (generate)

import Cardano.Api.UTxO qualified as UTxO
import Cardano.Ledger.Api.PParams (emptyPParams)
import Test.Hydra.Ledger.Cardano.Fixtures (eraHistoryWithoutHorizon)

spec :: Spec
spec :: Spec
spec = String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"publishHydraScripts" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"returns a list of TxIds when publishing is successful" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (VerificationKey PaymentKey
vk, SigningKey PaymentKey
sk) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
    TxIn
txIn <- Gen TxIn -> IO TxIn
forall a. Gen a -> IO a
generate Gen TxIn
forall a. Arbitrary a => Gen a
arbitrary
    let utxo :: UTxO Era
utxo =
          TxIn -> TxOut CtxUTxO Era -> UTxO Era
forall era. TxIn -> TxOut CtxUTxO era -> UTxO era
UTxO.singleton
            TxIn
txIn
            ( AddressInEra
-> Value
-> TxOutDatum CtxUTxO
-> ReferenceScript
-> TxOut CtxUTxO Era
forall ctx.
AddressInEra
-> Value -> TxOutDatum ctx -> ReferenceScript -> TxOut ctx
TxOut
                (NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
Mainnet VerificationKey PaymentKey
vk)
                (Lovelace -> Value
lovelaceToValue Lovelace
100_000_000)
                TxOutDatum CtxUTxO
forall ctx. TxOutDatum ctx
TxOutDatumNone
                ReferenceScript
ReferenceScriptNone
            )
    [TxId]
txIds <- (VerificationKey PaymentKey, UTxO Era)
-> SuccessfulBackend [TxId] -> IO [TxId]
forall a.
(VerificationKey PaymentKey, UTxO Era)
-> SuccessfulBackend a -> IO a
runSuccessfulBackend (VerificationKey PaymentKey
vk, UTxO Era
utxo) (SuccessfulBackend [TxId] -> IO [TxId])
-> SuccessfulBackend [TxId] -> IO [TxId]
forall a b. (a -> b) -> a -> b
$ Secret CardanoSigningKey -> SuccessfulBackend [TxId]
forall (m :: * -> *).
(ChainBackend m, MonadIO m, MonadCatch m) =>
Secret CardanoSigningKey -> m [TxId]
publishHydraScripts (CardanoSigningKey -> Secret CardanoSigningKey
forall a. a -> Secret a
mkSecret (SigningKey PaymentKey -> CardanoSigningKey
CardanoSigningKey SigningKey PaymentKey
sk))
    [TxId] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TxId]
txIds Int -> Int -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` Int
2

  String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"throws PublishingFundsMissing error if no UTxO is found for the given address" (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    (VerificationKey PaymentKey
vk, SigningKey PaymentKey
sk) <- Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
-> IO (VerificationKey PaymentKey, SigningKey PaymentKey)
forall a. Gen a -> IO a
generate Gen (VerificationKey PaymentKey, SigningKey PaymentKey)
genKeyPair
    VerificationKey PaymentKey -> ATestBackend [TxId] -> IO [TxId]
forall a. VerificationKey PaymentKey -> ATestBackend a -> IO a
runATestBackend VerificationKey PaymentKey
vk (Secret CardanoSigningKey -> ATestBackend [TxId]
forall (m :: * -> *).
(ChainBackend m, MonadIO m, MonadCatch m) =>
Secret CardanoSigningKey -> m [TxId]
publishHydraScripts (CardanoSigningKey -> Secret CardanoSigningKey
forall a. a -> Secret a
mkSecret (SigningKey PaymentKey -> CardanoSigningKey
CardanoSigningKey SigningKey PaymentKey
sk))) IO [TxId] -> Selector PublishScriptException -> IO ()
forall e a.
(HasCallStack, Exception e) =>
IO a -> Selector e -> IO ()
`shouldThrow` \case
      PublishingFundsMissing{} -> Bool
True
      PublishScriptException
_ -> Bool
False

-- | A test backend that will throw 'NoUTxOFound' on 'queryUTxOFor' call.
newtype ATestBackend a = ATestBackend (ReaderT (VerificationKey PaymentKey) IO a)
  deriving newtype ((forall a b. (a -> b) -> ATestBackend a -> ATestBackend b)
-> (forall a b. a -> ATestBackend b -> ATestBackend a)
-> Functor ATestBackend
forall a b. a -> ATestBackend b -> ATestBackend a
forall a b. (a -> b) -> ATestBackend a -> ATestBackend b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ATestBackend a -> ATestBackend b
fmap :: forall a b. (a -> b) -> ATestBackend a -> ATestBackend b
$c<$ :: forall a b. a -> ATestBackend b -> ATestBackend a
<$ :: forall a b. a -> ATestBackend b -> ATestBackend a
Functor, Functor ATestBackend
Functor ATestBackend =>
(forall a. a -> ATestBackend a)
-> (forall a b.
    ATestBackend (a -> b) -> ATestBackend a -> ATestBackend b)
-> (forall a b c.
    (a -> b -> c)
    -> ATestBackend a -> ATestBackend b -> ATestBackend c)
-> (forall a b. ATestBackend a -> ATestBackend b -> ATestBackend b)
-> (forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a)
-> Applicative ATestBackend
forall a. a -> ATestBackend a
forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a
forall a b. ATestBackend a -> ATestBackend b -> ATestBackend b
forall a b.
ATestBackend (a -> b) -> ATestBackend a -> ATestBackend b
forall a b c.
(a -> b -> c) -> ATestBackend a -> ATestBackend b -> ATestBackend c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ATestBackend a
pure :: forall a. a -> ATestBackend a
$c<*> :: forall a b.
ATestBackend (a -> b) -> ATestBackend a -> ATestBackend b
<*> :: forall a b.
ATestBackend (a -> b) -> ATestBackend a -> ATestBackend b
$cliftA2 :: forall a b c.
(a -> b -> c) -> ATestBackend a -> ATestBackend b -> ATestBackend c
liftA2 :: forall a b c.
(a -> b -> c) -> ATestBackend a -> ATestBackend b -> ATestBackend c
$c*> :: forall a b. ATestBackend a -> ATestBackend b -> ATestBackend b
*> :: forall a b. ATestBackend a -> ATestBackend b -> ATestBackend b
$c<* :: forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a
<* :: forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a
Applicative, Applicative ATestBackend
Applicative ATestBackend =>
(forall a b.
 ATestBackend a -> (a -> ATestBackend b) -> ATestBackend b)
-> (forall a b. ATestBackend a -> ATestBackend b -> ATestBackend b)
-> (forall a. a -> ATestBackend a)
-> Monad ATestBackend
forall a. a -> ATestBackend a
forall a b. ATestBackend a -> ATestBackend b -> ATestBackend b
forall a b.
ATestBackend a -> (a -> ATestBackend b) -> ATestBackend b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b.
ATestBackend a -> (a -> ATestBackend b) -> ATestBackend b
>>= :: forall a b.
ATestBackend a -> (a -> ATestBackend b) -> ATestBackend b
$c>> :: forall a b. ATestBackend a -> ATestBackend b -> ATestBackend b
>> :: forall a b. ATestBackend a -> ATestBackend b -> ATestBackend b
$creturn :: forall a. a -> ATestBackend a
return :: forall a. a -> ATestBackend a
Monad, Monad ATestBackend
Monad ATestBackend =>
(forall a. IO a -> ATestBackend a) -> MonadIO ATestBackend
forall a. IO a -> ATestBackend a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> ATestBackend a
liftIO :: forall a. IO a -> ATestBackend a
MonadIO, Monad ATestBackend
Monad ATestBackend =>
(forall e a. Exception e => e -> ATestBackend a)
-> (forall a b c.
    ATestBackend a
    -> (a -> ATestBackend b)
    -> (a -> ATestBackend c)
    -> ATestBackend c)
-> (forall a b c.
    ATestBackend a
    -> ATestBackend b -> ATestBackend c -> ATestBackend c)
-> (forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a)
-> MonadThrow ATestBackend
forall e a. Exception e => e -> ATestBackend a
forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a
forall a b c.
ATestBackend a
-> ATestBackend b -> ATestBackend c -> ATestBackend c
forall a b c.
ATestBackend a
-> (a -> ATestBackend b) -> (a -> ATestBackend c) -> ATestBackend c
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a)
-> (forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c)
-> (forall a b c. m a -> m b -> m c -> m c)
-> (forall a b. m a -> m b -> m a)
-> MonadThrow m
$cthrowIO :: forall e a. Exception e => e -> ATestBackend a
throwIO :: forall e a. Exception e => e -> ATestBackend a
$cbracket :: forall a b c.
ATestBackend a
-> (a -> ATestBackend b) -> (a -> ATestBackend c) -> ATestBackend c
bracket :: forall a b c.
ATestBackend a
-> (a -> ATestBackend b) -> (a -> ATestBackend c) -> ATestBackend c
$cbracket_ :: forall a b c.
ATestBackend a
-> ATestBackend b -> ATestBackend c -> ATestBackend c
bracket_ :: forall a b c.
ATestBackend a
-> ATestBackend b -> ATestBackend c -> ATestBackend c
$cfinally :: forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a
finally :: forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a
MonadThrow, MonadThrow ATestBackend
MonadThrow ATestBackend =>
(forall e a.
 Exception e =>
 ATestBackend a -> (e -> ATestBackend a) -> ATestBackend a)
-> (forall e b a.
    Exception e =>
    (e -> Maybe b)
    -> ATestBackend a -> (b -> ATestBackend a) -> ATestBackend a)
-> (forall e a.
    Exception e =>
    ATestBackend a -> ATestBackend (Either e a))
-> (forall e b a.
    Exception e =>
    (e -> Maybe b) -> ATestBackend a -> ATestBackend (Either b a))
-> (forall e a.
    Exception e =>
    (e -> ATestBackend a) -> ATestBackend a -> ATestBackend a)
-> (forall e b a.
    Exception e =>
    (e -> Maybe b)
    -> (b -> ATestBackend a) -> ATestBackend a -> ATestBackend a)
-> (forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a)
-> (forall a b c.
    ATestBackend a
    -> (a -> ATestBackend b)
    -> (a -> ATestBackend c)
    -> ATestBackend c)
-> (forall a b c.
    ATestBackend a
    -> (a -> ExitCase b -> ATestBackend c)
    -> (a -> ATestBackend b)
    -> ATestBackend (b, c))
-> MonadCatch ATestBackend
forall e a.
Exception e =>
ATestBackend a -> ATestBackend (Either e a)
forall e a.
Exception e =>
ATestBackend a -> (e -> ATestBackend a) -> ATestBackend a
forall e a.
Exception e =>
(e -> ATestBackend a) -> ATestBackend a -> ATestBackend a
forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a
forall e b a.
Exception e =>
(e -> Maybe b) -> ATestBackend a -> ATestBackend (Either b a)
forall e b a.
Exception e =>
(e -> Maybe b)
-> ATestBackend a -> (b -> ATestBackend a) -> ATestBackend a
forall e b a.
Exception e =>
(e -> Maybe b)
-> (b -> ATestBackend a) -> ATestBackend a -> ATestBackend a
forall a b c.
ATestBackend a
-> (a -> ATestBackend b) -> (a -> ATestBackend c) -> ATestBackend c
forall a b c.
ATestBackend a
-> (a -> ExitCase b -> ATestBackend c)
-> (a -> ATestBackend b)
-> ATestBackend (b, c)
forall (m :: * -> *).
MonadThrow m =>
(forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall e b a.
    Exception e =>
    (e -> Maybe b) -> m a -> (b -> m a) -> m a)
-> (forall e a. Exception e => m a -> m (Either e a))
-> (forall e b a.
    Exception e =>
    (e -> Maybe b) -> m a -> m (Either b a))
-> (forall e a. Exception e => (e -> m a) -> m a -> m a)
-> (forall e b a.
    Exception e =>
    (e -> Maybe b) -> (b -> m a) -> m a -> m a)
-> (forall a b. m a -> m b -> m a)
-> (forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadCatch m
$ccatch :: forall e a.
Exception e =>
ATestBackend a -> (e -> ATestBackend a) -> ATestBackend a
catch :: forall e a.
Exception e =>
ATestBackend a -> (e -> ATestBackend a) -> ATestBackend a
$ccatchJust :: forall e b a.
Exception e =>
(e -> Maybe b)
-> ATestBackend a -> (b -> ATestBackend a) -> ATestBackend a
catchJust :: forall e b a.
Exception e =>
(e -> Maybe b)
-> ATestBackend a -> (b -> ATestBackend a) -> ATestBackend a
$ctry :: forall e a.
Exception e =>
ATestBackend a -> ATestBackend (Either e a)
try :: forall e a.
Exception e =>
ATestBackend a -> ATestBackend (Either e a)
$ctryJust :: forall e b a.
Exception e =>
(e -> Maybe b) -> ATestBackend a -> ATestBackend (Either b a)
tryJust :: forall e b a.
Exception e =>
(e -> Maybe b) -> ATestBackend a -> ATestBackend (Either b a)
$chandle :: forall e a.
Exception e =>
(e -> ATestBackend a) -> ATestBackend a -> ATestBackend a
handle :: forall e a.
Exception e =>
(e -> ATestBackend a) -> ATestBackend a -> ATestBackend a
$chandleJust :: forall e b a.
Exception e =>
(e -> Maybe b)
-> (b -> ATestBackend a) -> ATestBackend a -> ATestBackend a
handleJust :: forall e b a.
Exception e =>
(e -> Maybe b)
-> (b -> ATestBackend a) -> ATestBackend a -> ATestBackend a
$conException :: forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a
onException :: forall a b. ATestBackend a -> ATestBackend b -> ATestBackend a
$cbracketOnError :: forall a b c.
ATestBackend a
-> (a -> ATestBackend b) -> (a -> ATestBackend c) -> ATestBackend c
bracketOnError :: forall a b c.
ATestBackend a
-> (a -> ATestBackend b) -> (a -> ATestBackend c) -> ATestBackend c
$cgeneralBracket :: forall a b c.
ATestBackend a
-> (a -> ExitCase b -> ATestBackend c)
-> (a -> ATestBackend b)
-> ATestBackend (b, c)
generalBracket :: forall a b c.
ATestBackend a
-> (a -> ExitCase b -> ATestBackend c)
-> (a -> ATestBackend b)
-> ATestBackend (b, c)
MonadCatch)

runATestBackend :: VerificationKey PaymentKey -> ATestBackend a -> IO a
runATestBackend :: forall a. VerificationKey PaymentKey -> ATestBackend a -> IO a
runATestBackend VerificationKey PaymentKey
vk (ATestBackend ReaderT (VerificationKey PaymentKey) IO a
m) = ReaderT (VerificationKey PaymentKey) IO a
-> VerificationKey PaymentKey -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (VerificationKey PaymentKey) IO a
m VerificationKey PaymentKey
vk

instance ChainBackend ATestBackend where
  queryUTxOFor :: QueryPoint -> VerificationKey PaymentKey -> ATestBackend (UTxO Era)
queryUTxOFor QueryPoint
_ VerificationKey PaymentKey
vk' = ReaderT (VerificationKey PaymentKey) IO (UTxO Era)
-> ATestBackend (UTxO Era)
forall a.
ReaderT (VerificationKey PaymentKey) IO a -> ATestBackend a
ATestBackend (ReaderT (VerificationKey PaymentKey) IO (UTxO Era)
 -> ATestBackend (UTxO Era))
-> ReaderT (VerificationKey PaymentKey) IO (UTxO Era)
-> ATestBackend (UTxO Era)
forall a b. (a -> b) -> a -> b
$ do
    VerificationKey PaymentKey
vk <- ReaderT
  (VerificationKey PaymentKey) IO (VerificationKey PaymentKey)
forall r (m :: * -> *). MonadReader r m => m r
ask
    if VerificationKey PaymentKey
vk VerificationKey PaymentKey -> VerificationKey PaymentKey -> Bool
forall a. Eq a => a -> a -> Bool
== VerificationKey PaymentKey
vk'
      then APIBlockfrostError
-> ReaderT (VerificationKey PaymentKey) IO (UTxO Era)
forall e a.
Exception e =>
e -> ReaderT (VerificationKey PaymentKey) IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (APIBlockfrostError
 -> ReaderT (VerificationKey PaymentKey) IO (UTxO Era))
-> APIBlockfrostError
-> ReaderT (VerificationKey PaymentKey) IO (UTxO Era)
forall a b. (a -> b) -> a -> b
$ BlockfrostException -> APIBlockfrostError
BlockfrostClientError (Address ShelleyAddr -> BlockfrostException
NoUTxOFound (VerificationKey PaymentKey -> Address ShelleyAddr
toAddress VerificationKey PaymentKey
vk))
      else String -> ReaderT (VerificationKey PaymentKey) IO (UTxO Era)
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> ReaderT (VerificationKey PaymentKey) IO (UTxO Era))
-> String -> ReaderT (VerificationKey PaymentKey) IO (UTxO Era)
forall a b. (a -> b) -> a -> b
$ String
"queryUTxOFor received unexpected VerificationKey: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> VerificationKey PaymentKey -> String
forall b a. (Show a, IsString b) => a -> b
show VerificationKey PaymentKey
vk'

  -- Other methods are not needed for this test.
  queryGenesisParameters :: ATestBackend (GenesisParameters ShelleyEra)
queryGenesisParameters = Text -> ATestBackend (GenesisParameters ShelleyEra)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"queryGenesisParameters"
  queryScriptRegistry :: [TxId] -> ATestBackend ScriptRegistry
queryScriptRegistry [TxId]
_ = Text -> ATestBackend ScriptRegistry
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"queryScriptRegistry"
  queryUTxO :: [Address ShelleyAddr] -> ATestBackend (UTxO Era)
queryUTxO [Address ShelleyAddr]
_ = Text -> ATestBackend (UTxO Era)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"queryUTxO"
  queryUTxOByTxIn :: [TxIn] -> ATestBackend (UTxO Era)
queryUTxOByTxIn [TxIn]
_ = Text -> ATestBackend (UTxO Era)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"queryUTxOByTxIn"
  queryTip :: ATestBackend ChainPoint
queryTip = Text -> ATestBackend ChainPoint
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"queryTip"
  submitTransaction :: Tx -> ATestBackend ()
submitTransaction Tx
_ = Text -> ATestBackend ()
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"submitTransaction"
  awaitTransaction :: Tx -> VerificationKey PaymentKey -> ATestBackend (UTxO Era)
awaitTransaction Tx
_ VerificationKey PaymentKey
_ = Text -> ATestBackend (UTxO Era)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"awaitTransaction"
  getBlockTime :: ATestBackend NominalDiffTime
getBlockTime = Text -> ATestBackend NominalDiffTime
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"getBlockTime"
  queryNetworkId :: ATestBackend NetworkId
queryNetworkId = NetworkId -> ATestBackend NetworkId
forall a. a -> ATestBackend a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NetworkId
Mainnet
  queryProtocolParameters :: QueryPoint -> ATestBackend (PParams LedgerEra)
queryProtocolParameters QueryPoint
_ = PParams ConwayEra -> ATestBackend (PParams ConwayEra)
forall a. a -> ATestBackend a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams ConwayEra
forall era. EraPParams era => PParams era
emptyPParams
  querySystemStart :: QueryPoint -> ATestBackend SystemStart
querySystemStart QueryPoint
_ = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart)
-> ATestBackend UTCTime -> ATestBackend SystemStart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> ATestBackend UTCTime
forall a. IO a -> ATestBackend a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
  queryEraHistory :: QueryPoint -> ATestBackend EraHistory
queryEraHistory QueryPoint
_ = EraHistory -> ATestBackend EraHistory
forall a. a -> ATestBackend a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EraHistory
eraHistoryWithoutHorizon
  queryStakePools :: QueryPoint -> ATestBackend (Set PoolId)
queryStakePools QueryPoint
_ = Set PoolId -> ATestBackend (Set PoolId)
forall a. a -> ATestBackend a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set PoolId
forall a. Monoid a => a
mempty

-- | A test backend that simulates a successful script publishing.
newtype SuccessfulBackend a = SuccessfulBackend (ReaderT (VerificationKey PaymentKey, UTxO) IO a)
  deriving newtype ((forall a b.
 (a -> b) -> SuccessfulBackend a -> SuccessfulBackend b)
-> (forall a b. a -> SuccessfulBackend b -> SuccessfulBackend a)
-> Functor SuccessfulBackend
forall a b. a -> SuccessfulBackend b -> SuccessfulBackend a
forall a b. (a -> b) -> SuccessfulBackend a -> SuccessfulBackend b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> SuccessfulBackend a -> SuccessfulBackend b
fmap :: forall a b. (a -> b) -> SuccessfulBackend a -> SuccessfulBackend b
$c<$ :: forall a b. a -> SuccessfulBackend b -> SuccessfulBackend a
<$ :: forall a b. a -> SuccessfulBackend b -> SuccessfulBackend a
Functor, Functor SuccessfulBackend
Functor SuccessfulBackend =>
(forall a. a -> SuccessfulBackend a)
-> (forall a b.
    SuccessfulBackend (a -> b)
    -> SuccessfulBackend a -> SuccessfulBackend b)
-> (forall a b c.
    (a -> b -> c)
    -> SuccessfulBackend a
    -> SuccessfulBackend b
    -> SuccessfulBackend c)
-> (forall a b.
    SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend b)
-> (forall a b.
    SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a)
-> Applicative SuccessfulBackend
forall a. a -> SuccessfulBackend a
forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a
forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend b
forall a b.
SuccessfulBackend (a -> b)
-> SuccessfulBackend a -> SuccessfulBackend b
forall a b c.
(a -> b -> c)
-> SuccessfulBackend a
-> SuccessfulBackend b
-> SuccessfulBackend c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> SuccessfulBackend a
pure :: forall a. a -> SuccessfulBackend a
$c<*> :: forall a b.
SuccessfulBackend (a -> b)
-> SuccessfulBackend a -> SuccessfulBackend b
<*> :: forall a b.
SuccessfulBackend (a -> b)
-> SuccessfulBackend a -> SuccessfulBackend b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> SuccessfulBackend a
-> SuccessfulBackend b
-> SuccessfulBackend c
liftA2 :: forall a b c.
(a -> b -> c)
-> SuccessfulBackend a
-> SuccessfulBackend b
-> SuccessfulBackend c
$c*> :: forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend b
*> :: forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend b
$c<* :: forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a
<* :: forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a
Applicative, Applicative SuccessfulBackend
Applicative SuccessfulBackend =>
(forall a b.
 SuccessfulBackend a
 -> (a -> SuccessfulBackend b) -> SuccessfulBackend b)
-> (forall a b.
    SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend b)
-> (forall a. a -> SuccessfulBackend a)
-> Monad SuccessfulBackend
forall a. a -> SuccessfulBackend a
forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend b
forall a b.
SuccessfulBackend a
-> (a -> SuccessfulBackend b) -> SuccessfulBackend b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b.
SuccessfulBackend a
-> (a -> SuccessfulBackend b) -> SuccessfulBackend b
>>= :: forall a b.
SuccessfulBackend a
-> (a -> SuccessfulBackend b) -> SuccessfulBackend b
$c>> :: forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend b
>> :: forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend b
$creturn :: forall a. a -> SuccessfulBackend a
return :: forall a. a -> SuccessfulBackend a
Monad, Monad SuccessfulBackend
Monad SuccessfulBackend =>
(forall a. IO a -> SuccessfulBackend a)
-> MonadIO SuccessfulBackend
forall a. IO a -> SuccessfulBackend a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall a. IO a -> SuccessfulBackend a
liftIO :: forall a. IO a -> SuccessfulBackend a
MonadIO, Monad SuccessfulBackend
Monad SuccessfulBackend =>
(forall e a. Exception e => e -> SuccessfulBackend a)
-> (forall a b c.
    SuccessfulBackend a
    -> (a -> SuccessfulBackend b)
    -> (a -> SuccessfulBackend c)
    -> SuccessfulBackend c)
-> (forall a b c.
    SuccessfulBackend a
    -> SuccessfulBackend b
    -> SuccessfulBackend c
    -> SuccessfulBackend c)
-> (forall a b.
    SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a)
-> MonadThrow SuccessfulBackend
forall e a. Exception e => e -> SuccessfulBackend a
forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a
forall a b c.
SuccessfulBackend a
-> SuccessfulBackend b
-> SuccessfulBackend c
-> SuccessfulBackend c
forall a b c.
SuccessfulBackend a
-> (a -> SuccessfulBackend b)
-> (a -> SuccessfulBackend c)
-> SuccessfulBackend c
forall (m :: * -> *).
Monad m =>
(forall e a. Exception e => e -> m a)
-> (forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c)
-> (forall a b c. m a -> m b -> m c -> m c)
-> (forall a b. m a -> m b -> m a)
-> MonadThrow m
$cthrowIO :: forall e a. Exception e => e -> SuccessfulBackend a
throwIO :: forall e a. Exception e => e -> SuccessfulBackend a
$cbracket :: forall a b c.
SuccessfulBackend a
-> (a -> SuccessfulBackend b)
-> (a -> SuccessfulBackend c)
-> SuccessfulBackend c
bracket :: forall a b c.
SuccessfulBackend a
-> (a -> SuccessfulBackend b)
-> (a -> SuccessfulBackend c)
-> SuccessfulBackend c
$cbracket_ :: forall a b c.
SuccessfulBackend a
-> SuccessfulBackend b
-> SuccessfulBackend c
-> SuccessfulBackend c
bracket_ :: forall a b c.
SuccessfulBackend a
-> SuccessfulBackend b
-> SuccessfulBackend c
-> SuccessfulBackend c
$cfinally :: forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a
finally :: forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a
MonadThrow, MonadThrow SuccessfulBackend
MonadThrow SuccessfulBackend =>
(forall e a.
 Exception e =>
 SuccessfulBackend a
 -> (e -> SuccessfulBackend a) -> SuccessfulBackend a)
-> (forall e b a.
    Exception e =>
    (e -> Maybe b)
    -> SuccessfulBackend a
    -> (b -> SuccessfulBackend a)
    -> SuccessfulBackend a)
-> (forall e a.
    Exception e =>
    SuccessfulBackend a -> SuccessfulBackend (Either e a))
-> (forall e b a.
    Exception e =>
    (e -> Maybe b)
    -> SuccessfulBackend a -> SuccessfulBackend (Either b a))
-> (forall e a.
    Exception e =>
    (e -> SuccessfulBackend a)
    -> SuccessfulBackend a -> SuccessfulBackend a)
-> (forall e b a.
    Exception e =>
    (e -> Maybe b)
    -> (b -> SuccessfulBackend a)
    -> SuccessfulBackend a
    -> SuccessfulBackend a)
-> (forall a b.
    SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a)
-> (forall a b c.
    SuccessfulBackend a
    -> (a -> SuccessfulBackend b)
    -> (a -> SuccessfulBackend c)
    -> SuccessfulBackend c)
-> (forall a b c.
    SuccessfulBackend a
    -> (a -> ExitCase b -> SuccessfulBackend c)
    -> (a -> SuccessfulBackend b)
    -> SuccessfulBackend (b, c))
-> MonadCatch SuccessfulBackend
forall e a.
Exception e =>
SuccessfulBackend a -> SuccessfulBackend (Either e a)
forall e a.
Exception e =>
SuccessfulBackend a
-> (e -> SuccessfulBackend a) -> SuccessfulBackend a
forall e a.
Exception e =>
(e -> SuccessfulBackend a)
-> SuccessfulBackend a -> SuccessfulBackend a
forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a
forall e b a.
Exception e =>
(e -> Maybe b)
-> SuccessfulBackend a -> SuccessfulBackend (Either b a)
forall e b a.
Exception e =>
(e -> Maybe b)
-> SuccessfulBackend a
-> (b -> SuccessfulBackend a)
-> SuccessfulBackend a
forall e b a.
Exception e =>
(e -> Maybe b)
-> (b -> SuccessfulBackend a)
-> SuccessfulBackend a
-> SuccessfulBackend a
forall a b c.
SuccessfulBackend a
-> (a -> SuccessfulBackend b)
-> (a -> SuccessfulBackend c)
-> SuccessfulBackend c
forall a b c.
SuccessfulBackend a
-> (a -> ExitCase b -> SuccessfulBackend c)
-> (a -> SuccessfulBackend b)
-> SuccessfulBackend (b, c)
forall (m :: * -> *).
MonadThrow m =>
(forall e a. Exception e => m a -> (e -> m a) -> m a)
-> (forall e b a.
    Exception e =>
    (e -> Maybe b) -> m a -> (b -> m a) -> m a)
-> (forall e a. Exception e => m a -> m (Either e a))
-> (forall e b a.
    Exception e =>
    (e -> Maybe b) -> m a -> m (Either b a))
-> (forall e a. Exception e => (e -> m a) -> m a -> m a)
-> (forall e b a.
    Exception e =>
    (e -> Maybe b) -> (b -> m a) -> m a -> m a)
-> (forall a b. m a -> m b -> m a)
-> (forall a b c. m a -> (a -> m b) -> (a -> m c) -> m c)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadCatch m
$ccatch :: forall e a.
Exception e =>
SuccessfulBackend a
-> (e -> SuccessfulBackend a) -> SuccessfulBackend a
catch :: forall e a.
Exception e =>
SuccessfulBackend a
-> (e -> SuccessfulBackend a) -> SuccessfulBackend a
$ccatchJust :: forall e b a.
Exception e =>
(e -> Maybe b)
-> SuccessfulBackend a
-> (b -> SuccessfulBackend a)
-> SuccessfulBackend a
catchJust :: forall e b a.
Exception e =>
(e -> Maybe b)
-> SuccessfulBackend a
-> (b -> SuccessfulBackend a)
-> SuccessfulBackend a
$ctry :: forall e a.
Exception e =>
SuccessfulBackend a -> SuccessfulBackend (Either e a)
try :: forall e a.
Exception e =>
SuccessfulBackend a -> SuccessfulBackend (Either e a)
$ctryJust :: forall e b a.
Exception e =>
(e -> Maybe b)
-> SuccessfulBackend a -> SuccessfulBackend (Either b a)
tryJust :: forall e b a.
Exception e =>
(e -> Maybe b)
-> SuccessfulBackend a -> SuccessfulBackend (Either b a)
$chandle :: forall e a.
Exception e =>
(e -> SuccessfulBackend a)
-> SuccessfulBackend a -> SuccessfulBackend a
handle :: forall e a.
Exception e =>
(e -> SuccessfulBackend a)
-> SuccessfulBackend a -> SuccessfulBackend a
$chandleJust :: forall e b a.
Exception e =>
(e -> Maybe b)
-> (b -> SuccessfulBackend a)
-> SuccessfulBackend a
-> SuccessfulBackend a
handleJust :: forall e b a.
Exception e =>
(e -> Maybe b)
-> (b -> SuccessfulBackend a)
-> SuccessfulBackend a
-> SuccessfulBackend a
$conException :: forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a
onException :: forall a b.
SuccessfulBackend a -> SuccessfulBackend b -> SuccessfulBackend a
$cbracketOnError :: forall a b c.
SuccessfulBackend a
-> (a -> SuccessfulBackend b)
-> (a -> SuccessfulBackend c)
-> SuccessfulBackend c
bracketOnError :: forall a b c.
SuccessfulBackend a
-> (a -> SuccessfulBackend b)
-> (a -> SuccessfulBackend c)
-> SuccessfulBackend c
$cgeneralBracket :: forall a b c.
SuccessfulBackend a
-> (a -> ExitCase b -> SuccessfulBackend c)
-> (a -> SuccessfulBackend b)
-> SuccessfulBackend (b, c)
generalBracket :: forall a b c.
SuccessfulBackend a
-> (a -> ExitCase b -> SuccessfulBackend c)
-> (a -> SuccessfulBackend b)
-> SuccessfulBackend (b, c)
MonadCatch)

runSuccessfulBackend :: (VerificationKey PaymentKey, UTxO) -> SuccessfulBackend a -> IO a
runSuccessfulBackend :: forall a.
(VerificationKey PaymentKey, UTxO Era)
-> SuccessfulBackend a -> IO a
runSuccessfulBackend (VerificationKey PaymentKey, UTxO Era)
env (SuccessfulBackend ReaderT (VerificationKey PaymentKey, UTxO Era) IO a
m) = ReaderT (VerificationKey PaymentKey, UTxO Era) IO a
-> (VerificationKey PaymentKey, UTxO Era) -> IO a
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT ReaderT (VerificationKey PaymentKey, UTxO Era) IO a
m (VerificationKey PaymentKey, UTxO Era)
env

instance ChainBackend SuccessfulBackend where
  queryUTxOFor :: QueryPoint
-> VerificationKey PaymentKey -> SuccessfulBackend (UTxO Era)
queryUTxOFor QueryPoint
_ VerificationKey PaymentKey
vk' = ReaderT (VerificationKey PaymentKey, UTxO Era) IO (UTxO Era)
-> SuccessfulBackend (UTxO Era)
forall a.
ReaderT (VerificationKey PaymentKey, UTxO Era) IO a
-> SuccessfulBackend a
SuccessfulBackend (ReaderT (VerificationKey PaymentKey, UTxO Era) IO (UTxO Era)
 -> SuccessfulBackend (UTxO Era))
-> ReaderT (VerificationKey PaymentKey, UTxO Era) IO (UTxO Era)
-> SuccessfulBackend (UTxO Era)
forall a b. (a -> b) -> a -> b
$ do
    (VerificationKey PaymentKey
vk, UTxO Era
u) <- ReaderT
  (VerificationKey PaymentKey, UTxO Era)
  IO
  (VerificationKey PaymentKey, UTxO Era)
forall r (m :: * -> *). MonadReader r m => m r
ask
    if VerificationKey PaymentKey
vk VerificationKey PaymentKey -> VerificationKey PaymentKey -> Bool
forall a. Eq a => a -> a -> Bool
== VerificationKey PaymentKey
vk'
      then UTxO Era
-> ReaderT (VerificationKey PaymentKey, UTxO Era) IO (UTxO Era)
forall a. a -> ReaderT (VerificationKey PaymentKey, UTxO Era) IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTxO Era
u
      else String
-> ReaderT (VerificationKey PaymentKey, UTxO Era) IO (UTxO Era)
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String
 -> ReaderT (VerificationKey PaymentKey, UTxO Era) IO (UTxO Era))
-> String
-> ReaderT (VerificationKey PaymentKey, UTxO Era) IO (UTxO Era)
forall a b. (a -> b) -> a -> b
$ String
"queryUTxOFor received unexpected VerificationKey: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> VerificationKey PaymentKey -> String
forall b a. (Show a, IsString b) => a -> b
show VerificationKey PaymentKey
vk'

  submitTransaction :: Tx -> SuccessfulBackend ()
submitTransaction Tx
_ = () -> SuccessfulBackend ()
forall a. a -> SuccessfulBackend a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

  awaitTransaction :: Tx -> VerificationKey PaymentKey -> SuccessfulBackend (UTxO Era)
awaitTransaction Tx
_ VerificationKey PaymentKey
_ = UTxO Era -> SuccessfulBackend (UTxO Era)
forall a. a -> SuccessfulBackend a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UTxO Era
forall a. Monoid a => a
mempty

  queryNetworkId :: SuccessfulBackend NetworkId
queryNetworkId = NetworkId -> SuccessfulBackend NetworkId
forall a. a -> SuccessfulBackend a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NetworkId
Mainnet
  queryProtocolParameters :: QueryPoint -> SuccessfulBackend (PParams LedgerEra)
queryProtocolParameters QueryPoint
_ = PParams ConwayEra -> SuccessfulBackend (PParams ConwayEra)
forall a. a -> SuccessfulBackend a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PParams ConwayEra
forall era. EraPParams era => PParams era
emptyPParams
  querySystemStart :: QueryPoint -> SuccessfulBackend SystemStart
querySystemStart QueryPoint
_ = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart)
-> SuccessfulBackend UTCTime -> SuccessfulBackend SystemStart
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO UTCTime -> SuccessfulBackend UTCTime
forall a. IO a -> SuccessfulBackend a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO UTCTime
forall (m :: * -> *). MonadTime m => m UTCTime
getCurrentTime
  queryEraHistory :: QueryPoint -> SuccessfulBackend EraHistory
queryEraHistory QueryPoint
_ = EraHistory -> SuccessfulBackend EraHistory
forall a. a -> SuccessfulBackend a
forall (f :: * -> *) a. Applicative f => a -> f a
pure EraHistory
eraHistoryWithoutHorizon
  queryStakePools :: QueryPoint -> SuccessfulBackend (Set PoolId)
queryStakePools QueryPoint
_ = Set PoolId -> SuccessfulBackend (Set PoolId)
forall a. a -> SuccessfulBackend a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set PoolId
forall a. Monoid a => a
mempty

  -- Other methods are not needed for this test.
  queryGenesisParameters :: SuccessfulBackend (GenesisParameters ShelleyEra)
queryGenesisParameters = Text -> SuccessfulBackend (GenesisParameters ShelleyEra)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"queryGenesisParameters"
  queryScriptRegistry :: [TxId] -> SuccessfulBackend ScriptRegistry
queryScriptRegistry [TxId]
_ = Text -> SuccessfulBackend ScriptRegistry
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"queryScriptRegistry"
  queryUTxO :: [Address ShelleyAddr] -> SuccessfulBackend (UTxO Era)
queryUTxO [Address ShelleyAddr]
_ = Text -> SuccessfulBackend (UTxO Era)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"queryUTxO"
  queryUTxOByTxIn :: [TxIn] -> SuccessfulBackend (UTxO Era)
queryUTxOByTxIn [TxIn]
_ = Text -> SuccessfulBackend (UTxO Era)
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"queryUTxOByTxIn"
  queryTip :: SuccessfulBackend ChainPoint
queryTip = Text -> SuccessfulBackend ChainPoint
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"queryTip"
  getBlockTime :: SuccessfulBackend NominalDiffTime
getBlockTime = Text -> SuccessfulBackend NominalDiffTime
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"getBlockTime"

toAddress :: VerificationKey PaymentKey -> Address ShelleyAddr
toAddress :: VerificationKey PaymentKey -> Address ShelleyAddr
toAddress VerificationKey PaymentKey
vk =
  case NetworkId -> VerificationKey PaymentKey -> AddressInEra
forall era.
IsShelleyBasedEra era =>
NetworkId -> VerificationKey PaymentKey -> AddressInEra era
mkVkAddress NetworkId
Mainnet VerificationKey PaymentKey
vk of
    ShelleyAddressInEra Address ShelleyAddr
addr -> Address ShelleyAddr
addr
    ByronAddressInEra{} -> Text -> Address ShelleyAddr
forall a t. (HasCallStack, IsText t) => t -> a
error Text
"toAddress: Byron address not supported"