{-# OPTIONS_GHC -Wno-deprecations #-}

module Test.Util where

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

import Cardano.Api qualified as CApi
import Cardano.Api.UTxO qualified as UTxO
import Control.Concurrent.Class.MonadSTM (modifyTVar', readTVarIO)
import Control.Monad.IOSim (
  Failure (FailureException),
  IOSim,
  SimTrace,
  runSimTrace,
  selectTraceEventsDynamic',
  traceM,
  traceResult,
 )
import Control.Tracer (Tracer (Tracer))
import Data.Aeson (encode)
import Data.Aeson qualified as Aeson
import Data.Text qualified as Text
import Hydra.Cardano.Api (CtxUTxO, TxOut, UTxO)
import Hydra.Ledger.Simple (SimpleTx)
import Hydra.Logging (Envelope (..), traceInTVar)
import Hydra.Network (NetworkCallback (..))
import Hydra.Node (HydraNodeLog)
import NoThunks.Class (InspectHeap (..), ThunkInfo, allNoThunks, noThunks)
import System.IO.Temp (writeSystemTempFile)
import Test.HUnit.Lang (FailureReason (ExpectedButGot))
import Test.QuickCheck (forAll, withMaxSuccess)

noopCallback :: Applicative m => NetworkCallback msg m
noopCallback :: forall (m :: * -> *) msg. Applicative m => NetworkCallback msg m
noopCallback =
  NetworkCallback
    { $sel:deliver:NetworkCallback :: msg -> m ()
deliver = \msg
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    , $sel:onConnectivity:NetworkCallback :: Connectivity -> m ()
onConnectivity = m () -> Connectivity -> m ()
forall a b. a -> b -> a
const (m () -> Connectivity -> m ()) -> m () -> Connectivity -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    }

-- | Run given 'action' in 'IOSim' and rethrow any exceptions.
shouldRunInSim ::
  (forall s. IOSim s a) ->
  IO a
shouldRunInSim :: forall a. (forall s. IOSim s a) -> IO a
shouldRunInSim forall s. IOSim s a
action =
  case Bool -> SimTrace a -> Either Failure a
forall a. Bool -> SimTrace a -> Either Failure a
traceResult Bool
False SimTrace a
tr of
    Right a
x -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
    Left (FailureException (SomeException e
ex)) -> do
      IO ()
dumpTrace
      e -> IO a
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO e
ex
    Left Failure
ex -> do
      IO ()
dumpTrace
      Failure -> IO a
forall e a. Exception e => e -> IO a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO Failure
ex
 where
  tr :: SimTrace a
tr = (forall s. IOSim s a) -> SimTrace a
forall a. (forall s. IOSim s a) -> SimTrace a
runSimTrace IOSim s a
forall s. IOSim s a
action
  dumpTrace :: IO ()
dumpTrace = do
    String
fp <- String -> String -> IO String
writeSystemTempFile String
"io-sim-trace" (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Proxy (HydraNodeLog SimpleTx) -> SimTrace a -> Text
forall log a.
(Typeable log, ToJSON log) =>
Proxy log -> SimTrace a -> Text
printTrace (Proxy (HydraNodeLog SimpleTx)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (HydraNodeLog SimpleTx)) SimTrace a
tr
    String -> IO ()
forall (m :: * -> *). MonadIO m => String -> m ()
putStrLn (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"IOSim trace written to: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
fp

-- | Utility function to dump logs given a `SimTrace`.
printTrace :: forall log a. (Typeable log, ToJSON log) => Proxy log -> SimTrace a -> Text
printTrace :: forall log a.
(Typeable log, ToJSON log) =>
Proxy log -> SimTrace a -> Text
printTrace Proxy log
_ SimTrace a
tr =
  [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines ([Text] -> Text) -> ([log] -> [Text]) -> [log] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (log -> Text) -> [log] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> (log -> ByteString) -> log -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. log -> ByteString
forall a. ToJSON a => a -> ByteString
Aeson.encode) ([log] -> Text) -> [log] -> Text
forall a b. (a -> b) -> a -> b
$
    forall a b. Typeable b => Trace a SimEvent -> [b]
selectTraceEventsDynamic' @_ @log SimTrace a
tr

-- | Lifted variant of Hspec's 'shouldBe'.
shouldBe :: (HasCallStack, MonadThrow m, Eq a, Show a) => a -> a -> m ()
shouldBe :: forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Eq a, Show a) =>
a -> a -> m ()
shouldBe a
actual a
expected =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a
actual a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    HUnitFailure -> m ()
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (HUnitFailure -> m ()) -> HUnitFailure -> m ()
forall a b. (a -> b) -> a -> b
$
      Maybe SrcLoc -> FailureReason -> HUnitFailure
HUnitFailure Maybe SrcLoc
HasCallStack => Maybe SrcLoc
location FailureReason
reason
 where
  reason :: FailureReason
reason = Maybe String -> String -> String -> FailureReason
ExpectedButGot Maybe String
forall a. Maybe a
Nothing (a -> String
forall b a. (Show a, IsString b) => a -> b
show a
expected) (a -> String
forall b a. (Show a, IsString b) => a -> b
show a
actual)

-- | Lifted variant of Hspec's 'shouldSatisfy'.
shouldSatisfy :: (HasCallStack, MonadThrow m, Show a) => a -> (a -> Bool) -> m ()
a
v shouldSatisfy :: forall (m :: * -> *) a.
(HasCallStack, MonadThrow m, Show a) =>
a -> (a -> Bool) -> m ()
`shouldSatisfy` a -> Bool
p =
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (a -> Bool
p a
v) (m () -> m ()) -> (String -> m ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m ()
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$ String
"predicate failed on: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ a -> String
forall b a. (Show a, IsString b) => a -> b
show a
v

-- | A 'Tracer' that works in 'IOSim' monad.
-- This tracer uses the 'Output' event which uses converts value traced to 'Dynamic'
-- which requires 'Typeable' constraint. To retrieve the trace use 'selectTraceEventsDynamic'
-- applied to the correct type.
traceInIOSim :: Typeable a => Tracer (IOSim s) a
traceInIOSim :: forall a s. Typeable a => Tracer (IOSim s) a
traceInIOSim = (a -> IOSim s ()) -> Tracer (IOSim s) a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer a -> IOSim s ()
forall a s. Typeable a => a -> IOSim s ()
traceM

-- | Useful when one needs to /also/ trace logs to `stderr`.
-- Thanks to the monoidal nature of `Tracer` it's straightforward to add this to
-- any existing tracer:
--
-- @@
-- someCode tracer = do
--   foo <- makeFoo
--   withTracer (tr <> traceDebug) SomeTraceFoo
-- ...
-- @@
traceDebug :: (Applicative m, ToJSON a) => Tracer m a
traceDebug :: forall (m :: * -> *) a. (Applicative m, ToJSON a) => Tracer m a
traceDebug = (a -> m ()) -> Tracer m a
forall (m :: * -> *) a. (a -> m ()) -> Tracer m a
Tracer (\a
a -> String -> m () -> m ()
forall a. String -> a -> a
trace (ByteString -> String
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ a -> ByteString
forall a. ToJSON a => a -> ByteString
encode a
a) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())

-- | This creates an hspec test case about a property which ensures the given generator
-- does not produce equals values within a reasonable number of generated values.
propCollisionResistant :: (Show a, Eq a) => String -> Gen a -> Spec
propCollisionResistant :: forall a. (Show a, Eq a) => String -> Gen a -> Spec
propCollisionResistant String
name Gen a
gen =
  String -> Property -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" is reasonably collision resistant") (Property -> Spec) -> Property -> Spec
forall a b. (a -> b) -> a -> b
$
    Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
100_000 (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
      Gen a -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a ->
        Gen a -> (a -> Bool) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> Bool) -> Property) -> (a -> Bool) -> Property
forall a b. (a -> b) -> a -> b
$ \a
b ->
          a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
b

-- | Predicate which decides whether given list is continuous.
isContinuous :: (Eq a, Enum a) => [a] -> Bool
isContinuous :: forall a. (Eq a, Enum a) => [a] -> Bool
isContinuous = \case
  [] -> Bool
True
  [a
_] -> Bool
True
  (a
a : a
b : [a]
as) -> a -> a
forall a. Enum a => a -> a
succ a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
b Bool -> Bool -> Bool
&& [a] -> Bool
forall a. (Eq a, Enum a) => [a] -> Bool
isContinuous (a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)

-- | Predicate which decides whether given list is strictly monotonic.
isStrictlyMonotonic :: Ord a => [a] -> Bool
isStrictlyMonotonic :: forall a. Ord a => [a] -> Bool
isStrictlyMonotonic = \case
  [] -> Bool
True
  [a
_] -> Bool
True
  (a
a : a
b : [a]
as) -> a
a a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
b Bool -> Bool -> Bool
&& [a] -> Bool
forall a. Ord a => [a] -> Bool
isStrictlyMonotonic (a
b a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as)

-- | Wait up to some time for a function to yield an equal value.
waitEq :: (HasCallStack, Eq a, Show a) => IO a -> NominalDiffTime -> a -> IO ()
waitEq :: forall a.
(HasCallStack, Eq a, Show a) =>
IO a -> NominalDiffTime -> a -> IO ()
waitEq IO a
waitNext NominalDiffTime
delay a
expected =
  IO a -> NominalDiffTime -> (a -> Maybe ()) -> IO ()
forall a b.
(HasCallStack, Show a) =>
IO a -> NominalDiffTime -> (a -> Maybe b) -> IO b
waitMatch IO a
waitNext NominalDiffTime
delay (Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Maybe ()) -> (a -> Bool) -> a -> Maybe ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
expected))

-- | Wait up to some time for a function to return a value that satisfies given predicate.
waitMatch :: (HasCallStack, Show a) => IO a -> NominalDiffTime -> (a -> Maybe b) -> IO b
waitMatch :: forall a b.
(HasCallStack, Show a) =>
IO a -> NominalDiffTime -> (a -> Maybe b) -> IO b
waitMatch IO a
waitNext NominalDiffTime
delay a -> Maybe b
match = do
  TVar [a]
seenMsgs <- String -> [a] -> IO (TVar IO [a])
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> a -> m (TVar m a)
newLabelledTVarIO String
"wait-match-seen-msgs" []
  DiffTime -> IO b -> IO (Maybe b)
forall a. DiffTime -> IO a -> IO (Maybe a)
forall (m :: * -> *) a.
MonadTimer m =>
DiffTime -> m a -> m (Maybe a)
timeout (NominalDiffTime -> DiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac NominalDiffTime
delay) (TVar [a] -> IO b
go TVar [a]
seenMsgs) IO (Maybe b) -> (Maybe b -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just b
x -> b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x
    Maybe b
Nothing -> do
      [a]
msgs <- TVar IO [a] -> IO [a]
forall a. TVar IO a -> IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar [a]
TVar IO [a]
seenMsgs
      String -> IO b
forall (m :: * -> *) a.
(HasCallStack, MonadThrow m) =>
String -> m a
failure (String -> IO b) -> String -> IO b
forall a b. (a -> b) -> a -> b
$
        Text -> String
forall a. ToString a => a -> String
toString (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
          [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines
            [ Text
"waitMatch did not match a message within " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NominalDiffTime -> Text
forall b a. (Show a, IsString b) => a -> b
show NominalDiffTime
delay
            , Char -> Int -> Text -> Text
padRight Char
' ' Int
20 Text
"  seen messages:"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines (Int -> [Text] -> [Text]
align Int
20 (a -> Text
forall b a. (Show a, IsString b) => a -> b
show (a -> Text) -> [a] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [a]
msgs))
            ]
 where
  go :: TVar [a] -> IO b
go TVar [a]
seenMsgs = do
    a
msg <- IO a
waitNext
    STM IO () -> IO ()
forall a. HasCallStack => STM IO a -> IO a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (TVar IO [a] -> ([a] -> [a]) -> STM IO ()
forall a. TVar IO a -> (a -> a) -> STM IO ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar' TVar [a]
TVar IO [a]
seenMsgs (a
msg :))
    IO b -> (b -> IO b) -> Maybe b -> IO b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (TVar [a] -> IO b
go TVar [a]
seenMsgs) b -> IO b
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe b
match a
msg)

  align :: Int -> [Text] -> [Text]
align Int
_ [] = []
  align Int
n (Text
h : [Text]
q) = Text
h Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
Text.replicate Int
n Text
" " <>) [Text]
q

-- | Create a tracer that captures all messages and a function to retrieve all
-- traces captured.
-- XXX: This is duplicated in MithrilSpec in hydra-cluster, but can't (easily)
-- be moved to the Test Prelude because of the dependency on Hydra.Logging.
captureTracer :: Text -> IO (Tracer IO a, IO [Envelope a])
captureTracer :: forall a. Text -> IO (Tracer IO a, IO [Envelope a])
captureTracer Text
namespace = do
  TVar [Envelope a]
traces <- String -> [Envelope a] -> IO (TVar IO [Envelope a])
forall (m :: * -> *) a.
MonadLabelledSTM m =>
String -> a -> m (TVar m a)
newLabelledTVarIO String
"capture-tracer" []
  let tracer :: Tracer IO a
tracer = TVar IO [Envelope a] -> Text -> Tracer IO a
forall (m :: * -> *) msg.
(MonadFork m, MonadTime m, MonadSTM m) =>
TVar m [Envelope msg] -> Text -> Tracer m msg
traceInTVar TVar [Envelope a]
TVar IO [Envelope a]
traces Text
namespace
  (Tracer IO a, IO [Envelope a]) -> IO (Tracer IO a, IO [Envelope a])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Tracer IO a
tracer, TVar IO [Envelope a] -> IO [Envelope a]
forall a. TVar IO a -> IO a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar [Envelope a]
TVar IO [Envelope a]
traces)

-- | Check a UTxO for thunks, descending via constructors so that GADT
-- dictionary fields (e.g. the Eq/Show context stored inside
-- 'TxOutValueShelleyBased') are not reported as false positives, as they
-- would be by a whole-value 'InspectHeap' probe.
utxoNoThunks :: UTxO -> IO (Maybe ThunkInfo)
utxoNoThunks :: UTxO -> IO (Maybe ThunkInfo)
utxoNoThunks UTxO
utxo =
  [IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
allNoThunks ([IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo))
-> [IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
forall a b. (a -> b) -> a -> b
$
    ((TxIn, TxOut CtxUTxO) -> [IO (Maybe ThunkInfo)])
-> [(TxIn, TxOut CtxUTxO)] -> [IO (Maybe ThunkInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap
      (\(TxIn
i, TxOut CtxUTxO
o) -> [Context -> InspectHeap TxIn -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks [String
"TxIn"] (TxIn -> InspectHeap TxIn
forall a. a -> InspectHeap a
InspectHeap TxIn
i), TxOut CtxUTxO -> IO (Maybe ThunkInfo)
txOutNoThunks TxOut CtxUTxO
o])
      (UTxO -> [(TxIn, TxOut CtxUTxO)]
forall era. UTxO era -> [(TxIn, TxOut CtxUTxO era)]
UTxO.toList UTxO
utxo)

txOutNoThunks :: TxOut CtxUTxO -> IO (Maybe ThunkInfo)
txOutNoThunks :: TxOut CtxUTxO -> IO (Maybe ThunkInfo)
txOutNoThunks (CApi.TxOut AddressInEra Era
addr TxOutValue Era
val TxOutDatum CtxUTxO Era
datum ReferenceScript Era
refScript) =
  [IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
allNoThunks
    [ Context -> InspectHeap (AddressInEra Era) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks [String
"address"] (AddressInEra Era -> InspectHeap (AddressInEra Era)
forall a. a -> InspectHeap a
InspectHeap AddressInEra Era
addr)
    , case TxOutValue Era
val of
        CApi.TxOutValueShelleyBased ShelleyBasedEra Era
sbe Value (ShelleyLedgerEra Era)
v ->
          [IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
allNoThunks
            [ Context
-> InspectHeap (ShelleyBasedEra Era) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks [String
"value.era"] (ShelleyBasedEra Era -> InspectHeap (ShelleyBasedEra Era)
forall a. a -> InspectHeap a
InspectHeap ShelleyBasedEra Era
sbe)
            , Context -> InspectHeap MaryValue -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks [String
"value"] (MaryValue -> InspectHeap MaryValue
forall a. a -> InspectHeap a
InspectHeap Value (ShelleyLedgerEra Era)
MaryValue
v)
            ]
    , Context
-> InspectHeap (TxOutDatum CtxUTxO Era) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks [String
"datum"] (TxOutDatum CtxUTxO Era -> InspectHeap (TxOutDatum CtxUTxO Era)
forall a. a -> InspectHeap a
InspectHeap TxOutDatum CtxUTxO Era
datum)
    , case ReferenceScript Era
refScript of
        ReferenceScript Era
CApi.ReferenceScriptNone -> Maybe ThunkInfo -> IO (Maybe ThunkInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ThunkInfo
forall a. Maybe a
Nothing
        CApi.ReferenceScript BabbageEraOnwards Era
w (CApi.ScriptInAnyLang ScriptLanguage lang
lang Script lang
script) ->
          [IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
allNoThunks
            [ Context
-> InspectHeap (BabbageEraOnwards Era) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks [String
"refScript.era"] (BabbageEraOnwards Era -> InspectHeap (BabbageEraOnwards Era)
forall a. a -> InspectHeap a
InspectHeap BabbageEraOnwards Era
w)
            , ScriptLanguage lang -> IO (Maybe ThunkInfo)
forall lang. ScriptLanguage lang -> IO (Maybe ThunkInfo)
scriptLanguageNoThunks ScriptLanguage lang
lang
            , Script lang -> IO (Maybe ThunkInfo)
forall lang. Script lang -> IO (Maybe ThunkInfo)
scriptNoThunks Script lang
script
            ]
    ]

scriptLanguageNoThunks :: CApi.ScriptLanguage lang -> IO (Maybe ThunkInfo)
scriptLanguageNoThunks :: forall lang. ScriptLanguage lang -> IO (Maybe ThunkInfo)
scriptLanguageNoThunks = \case
  ScriptLanguage lang
CApi.SimpleScriptLanguage -> Maybe ThunkInfo -> IO (Maybe ThunkInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ThunkInfo
forall a. Maybe a
Nothing
  CApi.PlutusScriptLanguage PlutusScriptVersion lang
v -> Context
-> InspectHeap (PlutusScriptVersion lang) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks [String
"refScript.lang"] (PlutusScriptVersion lang -> InspectHeap (PlutusScriptVersion lang)
forall a. a -> InspectHeap a
InspectHeap PlutusScriptVersion lang
v)

scriptNoThunks :: CApi.Script lang -> IO (Maybe ThunkInfo)
scriptNoThunks :: forall lang. Script lang -> IO (Maybe ThunkInfo)
scriptNoThunks = \case
  CApi.SimpleScript SimpleScript
ss -> Context -> InspectHeap SimpleScript -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks [String
"refScript.simple"] (SimpleScript -> InspectHeap SimpleScript
forall a. a -> InspectHeap a
InspectHeap SimpleScript
ss)
  CApi.PlutusScript PlutusScriptVersion lang
v PlutusScript lang
ps ->
    [IO (Maybe ThunkInfo)] -> IO (Maybe ThunkInfo)
allNoThunks
      [ Context
-> InspectHeap (PlutusScriptVersion lang) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks [String
"refScript.version"] (PlutusScriptVersion lang -> InspectHeap (PlutusScriptVersion lang)
forall a. a -> InspectHeap a
InspectHeap PlutusScriptVersion lang
v)
      , Context -> InspectHeap (PlutusScript lang) -> IO (Maybe ThunkInfo)
forall a. NoThunks a => Context -> a -> IO (Maybe ThunkInfo)
noThunks [String
"refScript.plutus"] (PlutusScript lang -> InspectHeap (PlutusScript lang)
forall a. a -> InspectHeap a
InspectHeap PlutusScript lang
ps)
      ]