{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}

-- | Types that are used when writing to standard output or to files.
-- These types (and their encodings) are typically consumed by users of @cardano-cli@.
module Cardano.CLI.Types.Output
  ( PlutusScriptCostError
  , QueryDRepStateOutput (..)
  , QueryKesPeriodInfoOutput (..)
  , QueryTipLocalState (..)
  , QueryTipLocalStateOutput (..)
  , ScriptCostOutput (..)
  , createOpCertIntervalInfo
  , renderScriptCosts
  )
where

import           Cardano.Api
import qualified Cardano.Api.Ledger as L
import           Cardano.Api.Shelley

import           Cardano.CLI.Types.Common

import           Prelude

import           Data.Aeson
import qualified Data.Aeson.Key as Aeson
import qualified Data.List as List
import           Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import           Data.Text (Text)
import qualified Data.Text as Text
import           Data.Time.Clock (UTCTime)
import           Data.Word

data QueryKesPeriodInfoOutput
  = QueryKesPeriodInfoOutput
  { QueryKesPeriodInfoOutput -> OpCertIntervalInformation
qKesOpCertIntervalInformation :: OpCertIntervalInformation
  , QueryKesPeriodInfoOutput -> Maybe UTCTime
qKesInfoKesKeyExpiry :: Maybe UTCTime
  -- ^ Date of KES key expiry.
  , QueryKesPeriodInfoOutput -> Maybe OpCertNodeStateCounter
qKesInfoNodeStateOperationalCertNo :: Maybe OpCertNodeStateCounter
  -- ^ The latest operational certificate number in the node's state
  -- i.e how many times a new KES key has been generated.
  , QueryKesPeriodInfoOutput -> OpCertOnDiskCounter
qKesInfoOnDiskOperationalCertNo :: OpCertOnDiskCounter
  -- ^ The on disk operational certificate number.
  , QueryKesPeriodInfoOutput -> Word64
qKesInfoMaxKesKeyEvolutions :: Word64
  -- ^ The maximum number of KES key evolutions permitted per KES period.
  , QueryKesPeriodInfoOutput -> Word64
qKesInfoSlotsPerKesPeriod :: Word64
  }
  deriving (QueryKesPeriodInfoOutput -> QueryKesPeriodInfoOutput -> Bool
(QueryKesPeriodInfoOutput -> QueryKesPeriodInfoOutput -> Bool)
-> (QueryKesPeriodInfoOutput -> QueryKesPeriodInfoOutput -> Bool)
-> Eq QueryKesPeriodInfoOutput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: QueryKesPeriodInfoOutput -> QueryKesPeriodInfoOutput -> Bool
== :: QueryKesPeriodInfoOutput -> QueryKesPeriodInfoOutput -> Bool
$c/= :: QueryKesPeriodInfoOutput -> QueryKesPeriodInfoOutput -> Bool
/= :: QueryKesPeriodInfoOutput -> QueryKesPeriodInfoOutput -> Bool
Eq, Int -> QueryKesPeriodInfoOutput -> ShowS
[QueryKesPeriodInfoOutput] -> ShowS
QueryKesPeriodInfoOutput -> String
(Int -> QueryKesPeriodInfoOutput -> ShowS)
-> (QueryKesPeriodInfoOutput -> String)
-> ([QueryKesPeriodInfoOutput] -> ShowS)
-> Show QueryKesPeriodInfoOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryKesPeriodInfoOutput -> ShowS
showsPrec :: Int -> QueryKesPeriodInfoOutput -> ShowS
$cshow :: QueryKesPeriodInfoOutput -> String
show :: QueryKesPeriodInfoOutput -> String
$cshowList :: [QueryKesPeriodInfoOutput] -> ShowS
showList :: [QueryKesPeriodInfoOutput] -> ShowS
Show)

instance ToJSON QueryKesPeriodInfoOutput where
  toJSON :: QueryKesPeriodInfoOutput -> Value
toJSON
    ( QueryKesPeriodInfoOutput
        OpCertIntervalInformation
opCertIntervalInfo
        Maybe UTCTime
kesKeyExpiryTime
        Maybe OpCertNodeStateCounter
nodeStateOpCertNo
        (OpCertOnDiskCounter Word64
onDiskOpCertNo)
        Word64
maxKesKeyOps
        Word64
slotsPerKesPeriod
      ) = do
      let (Word64
sKes, Word64
eKes, Word64
cKes, Maybe SlotsTillKesKeyExpiry
slotsTillExp) =
            case OpCertIntervalInformation
opCertIntervalInfo of
              OpCertWithinInterval OpCertStartingKesPeriod
startKes OpCertEndingKesPeriod
endKes CurrentKesPeriod
currKes SlotsTillKesKeyExpiry
sUntilExp ->
                ( OpCertStartingKesPeriod -> Word64
unOpCertStartingKesPeriod OpCertStartingKesPeriod
startKes
                , OpCertEndingKesPeriod -> Word64
unOpCertEndingKesPeriod OpCertEndingKesPeriod
endKes
                , CurrentKesPeriod -> Word64
unCurrentKesPeriod CurrentKesPeriod
currKes
                , SlotsTillKesKeyExpiry -> Maybe SlotsTillKesKeyExpiry
forall a. a -> Maybe a
Just SlotsTillKesKeyExpiry
sUntilExp
                )
              OpCertStartingKesPeriodIsInTheFuture OpCertStartingKesPeriod
startKes OpCertEndingKesPeriod
endKes CurrentKesPeriod
currKes ->
                ( OpCertStartingKesPeriod -> Word64
unOpCertStartingKesPeriod OpCertStartingKesPeriod
startKes
                , OpCertEndingKesPeriod -> Word64
unOpCertEndingKesPeriod OpCertEndingKesPeriod
endKes
                , CurrentKesPeriod -> Word64
unCurrentKesPeriod CurrentKesPeriod
currKes
                , Maybe SlotsTillKesKeyExpiry
forall a. Maybe a
Nothing
                )
              OpCertExpired OpCertStartingKesPeriod
startKes OpCertEndingKesPeriod
endKes CurrentKesPeriod
currKes ->
                ( OpCertStartingKesPeriod -> Word64
unOpCertStartingKesPeriod OpCertStartingKesPeriod
startKes
                , OpCertEndingKesPeriod -> Word64
unOpCertEndingKesPeriod OpCertEndingKesPeriod
endKes
                , CurrentKesPeriod -> Word64
unCurrentKesPeriod CurrentKesPeriod
currKes
                , Maybe SlotsTillKesKeyExpiry
forall a. Maybe a
Nothing
                )
              OpCertSomeOtherError OpCertStartingKesPeriod
startKes OpCertEndingKesPeriod
endKes CurrentKesPeriod
currKes ->
                ( OpCertStartingKesPeriod -> Word64
unOpCertStartingKesPeriod OpCertStartingKesPeriod
startKes
                , OpCertEndingKesPeriod -> Word64
unOpCertEndingKesPeriod OpCertEndingKesPeriod
endKes
                , CurrentKesPeriod -> Word64
unCurrentKesPeriod CurrentKesPeriod
currKes
                , Maybe SlotsTillKesKeyExpiry
forall a. Maybe a
Nothing
                )

      [Pair] -> Value
object
        [ Key
"qKesCurrentKesPeriod" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
cKes
        , Key
"qKesStartKesInterval" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
sKes
        , Key
"qKesEndKesInterval" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
eKes
        , Key
"qKesRemainingSlotsInKesPeriod" Key -> Maybe SlotsTillKesKeyExpiry -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe SlotsTillKesKeyExpiry
slotsTillExp
        , Key
"qKesOnDiskOperationalCertificateNumber" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
onDiskOpCertNo
        , Key
"qKesNodeStateOperationalCertificateNumber" Key -> Maybe OpCertNodeStateCounter -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe OpCertNodeStateCounter
nodeStateOpCertNo
        , Key
"qKesMaxKESEvolutions" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
maxKesKeyOps
        , Key
"qKesSlotsPerKesPeriod" Key -> Word64 -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Word64
slotsPerKesPeriod
        , Key
"qKesKesKeyExpiry" Key -> Maybe UTCTime -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe UTCTime
kesKeyExpiryTime
        ]

instance FromJSON QueryKesPeriodInfoOutput where
  parseJSON :: Value -> Parser QueryKesPeriodInfoOutput
parseJSON = String
-> (Object -> Parser QueryKesPeriodInfoOutput)
-> Value
-> Parser QueryKesPeriodInfoOutput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"QueryKesPeriodInfoOutput" ((Object -> Parser QueryKesPeriodInfoOutput)
 -> Value -> Parser QueryKesPeriodInfoOutput)
-> (Object -> Parser QueryKesPeriodInfoOutput)
-> Value
-> Parser QueryKesPeriodInfoOutput
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    CurrentKesPeriod
currentKesPeriod <- Object
o Object -> Key -> Parser CurrentKesPeriod
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qKesCurrentKesPeriod"
    OpCertStartingKesPeriod
startKesInterval <- Object
o Object -> Key -> Parser OpCertStartingKesPeriod
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qKesStartKesInterval"
    OpCertEndingKesPeriod
endKesInterval <- Object
o Object -> Key -> Parser OpCertEndingKesPeriod
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qKesEndKesInterval"
    Maybe SlotsTillKesKeyExpiry
remainingSlotsInKesPeriod <- Object
o Object -> Key -> Parser (Maybe SlotsTillKesKeyExpiry)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qKesRemainingSlotsInKesPeriod"
    OpCertOnDiskCounter
onDiskOperationalCertificateNumber <- Object
o Object -> Key -> Parser OpCertOnDiskCounter
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qKesOnDiskOperationalCertificateNumber"
    Maybe OpCertNodeStateCounter
nodeStateOperationalCertificateNumber <- Object
o Object -> Key -> Parser (Maybe OpCertNodeStateCounter)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qKesNodeStateOperationalCertificateNumber"
    Word64
maxKESEvolutions <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qKesMaxKESEvolutions"
    Word64
slotsPerKesPeriod <- Object
o Object -> Key -> Parser Word64
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qKesSlotsPerKesPeriod"
    Maybe UTCTime
kesKeyExpiry <- Object
o Object -> Key -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"qKesKesKeyExpiry"
    let opCertIntervalInfo :: OpCertIntervalInformation
opCertIntervalInfo =
          CurrentKesPeriod
-> OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> Maybe SlotsTillKesKeyExpiry
-> OpCertIntervalInformation
createOpCertIntervalInfo
            CurrentKesPeriod
currentKesPeriod
            OpCertStartingKesPeriod
startKesInterval
            OpCertEndingKesPeriod
endKesInterval
            Maybe SlotsTillKesKeyExpiry
remainingSlotsInKesPeriod
    QueryKesPeriodInfoOutput -> Parser QueryKesPeriodInfoOutput
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (QueryKesPeriodInfoOutput -> Parser QueryKesPeriodInfoOutput)
-> QueryKesPeriodInfoOutput -> Parser QueryKesPeriodInfoOutput
forall a b. (a -> b) -> a -> b
$
      QueryKesPeriodInfoOutput
        { qKesOpCertIntervalInformation :: OpCertIntervalInformation
qKesOpCertIntervalInformation = OpCertIntervalInformation
opCertIntervalInfo
        , qKesInfoKesKeyExpiry :: Maybe UTCTime
qKesInfoKesKeyExpiry = Maybe UTCTime
kesKeyExpiry
        , qKesInfoNodeStateOperationalCertNo :: Maybe OpCertNodeStateCounter
qKesInfoNodeStateOperationalCertNo = Maybe OpCertNodeStateCounter
nodeStateOperationalCertificateNumber
        , qKesInfoOnDiskOperationalCertNo :: OpCertOnDiskCounter
qKesInfoOnDiskOperationalCertNo = OpCertOnDiskCounter
onDiskOperationalCertificateNumber
        , qKesInfoMaxKesKeyEvolutions :: Word64
qKesInfoMaxKesKeyEvolutions = Word64
maxKESEvolutions
        , qKesInfoSlotsPerKesPeriod :: Word64
qKesInfoSlotsPerKesPeriod = Word64
slotsPerKesPeriod
        }

createOpCertIntervalInfo
  :: CurrentKesPeriod
  -> OpCertStartingKesPeriod
  -> OpCertEndingKesPeriod
  -> Maybe SlotsTillKesKeyExpiry
  -> OpCertIntervalInformation
createOpCertIntervalInfo :: CurrentKesPeriod
-> OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> Maybe SlotsTillKesKeyExpiry
-> OpCertIntervalInformation
createOpCertIntervalInfo
  c :: CurrentKesPeriod
c@(CurrentKesPeriod Word64
cKesPeriod)
  s :: OpCertStartingKesPeriod
s@(OpCertStartingKesPeriod Word64
oCertStart)
  e :: OpCertEndingKesPeriod
e@(OpCertEndingKesPeriod Word64
oCertEnd)
  (Just SlotsTillKesKeyExpiry
tillExp)
    | Word64
oCertStart Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word64
cKesPeriod Bool -> Bool -> Bool
&& Word64
cKesPeriod Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
oCertEnd =
        OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> CurrentKesPeriod
-> SlotsTillKesKeyExpiry
-> OpCertIntervalInformation
OpCertWithinInterval OpCertStartingKesPeriod
s OpCertEndingKesPeriod
e CurrentKesPeriod
c SlotsTillKesKeyExpiry
tillExp
    | Word64
oCertStart Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
cKesPeriod = OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> CurrentKesPeriod
-> OpCertIntervalInformation
OpCertStartingKesPeriodIsInTheFuture OpCertStartingKesPeriod
s OpCertEndingKesPeriod
e CurrentKesPeriod
c
    | Word64
cKesPeriod Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
oCertEnd = OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> CurrentKesPeriod
-> OpCertIntervalInformation
OpCertExpired OpCertStartingKesPeriod
s OpCertEndingKesPeriod
e CurrentKesPeriod
c
    | Bool
otherwise = OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> CurrentKesPeriod
-> OpCertIntervalInformation
OpCertSomeOtherError OpCertStartingKesPeriod
s OpCertEndingKesPeriod
e CurrentKesPeriod
c
createOpCertIntervalInfo
  c :: CurrentKesPeriod
c@(CurrentKesPeriod Word64
cKesPeriod)
  s :: OpCertStartingKesPeriod
s@(OpCertStartingKesPeriod Word64
oCertStart)
  e :: OpCertEndingKesPeriod
e@(OpCertEndingKesPeriod Word64
oCertEnd)
  Maybe SlotsTillKesKeyExpiry
Nothing
    | Word64
oCertStart Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
> Word64
cKesPeriod = OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> CurrentKesPeriod
-> OpCertIntervalInformation
OpCertStartingKesPeriodIsInTheFuture OpCertStartingKesPeriod
s OpCertEndingKesPeriod
e CurrentKesPeriod
c
    | Word64
cKesPeriod Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
oCertEnd = OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> CurrentKesPeriod
-> OpCertIntervalInformation
OpCertExpired OpCertStartingKesPeriod
s OpCertEndingKesPeriod
e CurrentKesPeriod
c
    | Bool
otherwise = OpCertStartingKesPeriod
-> OpCertEndingKesPeriod
-> CurrentKesPeriod
-> OpCertIntervalInformation
OpCertSomeOtherError OpCertStartingKesPeriod
s OpCertEndingKesPeriod
e CurrentKesPeriod
c

data QueryTipLocalState mode = QueryTipLocalState
  { forall mode. QueryTipLocalState mode -> AnyCardanoEra
era :: AnyCardanoEra
  , forall mode. QueryTipLocalState mode -> EraHistory
eraHistory :: EraHistory
  , forall mode. QueryTipLocalState mode -> Maybe SystemStart
mSystemStart :: Maybe SystemStart
  , forall mode. QueryTipLocalState mode -> Maybe ChainTip
mChainTip :: Maybe ChainTip
  }

data QueryTipLocalStateOutput = QueryTipLocalStateOutput
  { QueryTipLocalStateOutput -> ChainTip
localStateChainTip :: ChainTip
  , QueryTipLocalStateOutput -> Maybe AnyCardanoEra
mEra :: Maybe AnyCardanoEra
  , QueryTipLocalStateOutput -> Maybe EpochNo
mEpoch :: Maybe EpochNo
  , QueryTipLocalStateOutput -> Maybe Word64
mSlotInEpoch :: Maybe Word64
  , QueryTipLocalStateOutput -> Maybe Word64
mSlotsToEpochEnd :: Maybe Word64
  , QueryTipLocalStateOutput -> Maybe Text
mSyncProgress :: Maybe Text
  }
  deriving Int -> QueryTipLocalStateOutput -> ShowS
[QueryTipLocalStateOutput] -> ShowS
QueryTipLocalStateOutput -> String
(Int -> QueryTipLocalStateOutput -> ShowS)
-> (QueryTipLocalStateOutput -> String)
-> ([QueryTipLocalStateOutput] -> ShowS)
-> Show QueryTipLocalStateOutput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> QueryTipLocalStateOutput -> ShowS
showsPrec :: Int -> QueryTipLocalStateOutput -> ShowS
$cshow :: QueryTipLocalStateOutput -> String
show :: QueryTipLocalStateOutput -> String
$cshowList :: [QueryTipLocalStateOutput] -> ShowS
showList :: [QueryTipLocalStateOutput] -> ShowS
Show

data QueryDRepStateOutput
  = -- Not a record, because we want exhaustive warnings in the code of ToJSON below,
    -- if we ever add more fields.
    QueryDRepStateOutput
      (L.Credential L.DRepRole L.StandardCrypto)
      -- ^ Credential
      EpochNo
      -- ^ Expiry
      (Maybe (L.Anchor L.StandardCrypto))
      -- ^ Anchor
      Lovelace
      -- ^ Deposit
      IncludeStake
      (Maybe Lovelace)
      -- ^ Stake

instance ToJSON QueryDRepStateOutput where
  toJSON :: QueryDRepStateOutput -> Value
toJSON (QueryDRepStateOutput Credential 'DRepRole StandardCrypto
credential EpochNo
expiry Maybe (Anchor StandardCrypto)
anchor Lovelace
deposit IncludeStake
includeStake Maybe Lovelace
stake) =
    (Credential 'DRepRole StandardCrypto, Value) -> Value
forall a. ToJSON a => a -> Value
toJSON
      ( Credential 'DRepRole StandardCrypto
credential
      , [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
          [ Key
"expiry" Key -> EpochNo -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= EpochNo
expiry
          , Key
"anchor" Key -> Maybe (Anchor StandardCrypto) -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe (Anchor StandardCrypto)
anchor
          , Key
"deposit" Key -> Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Lovelace
deposit
          ]
            [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> ( case IncludeStake
includeStake of
                  IncludeStake
WithStake -> [Key
"stake" Key -> Maybe Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Maybe Lovelace
stake]
                  IncludeStake
NoStake -> []
               )
      )

-- | A key-value pair difference list for encoding a JSON object.
(..=) :: (KeyValue e kv, ToJSON v) => Aeson.Key -> v -> [kv] -> [kv]
..= :: forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> v -> [kv] -> [kv]
(..=) Key
n v
v = (Key
n Key -> v -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
v kv -> [kv] -> [kv]
forall a. a -> [a] -> [a]
:)

-- | A key-value pair difference list for encoding a JSON object where Nothing encodes absence of the key-value pair.
(..=?) :: (KeyValue e kv, ToJSON v) => Aeson.Key -> Maybe v -> [kv] -> [kv]
..=? :: forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
(..=?) Key
n Maybe v
mv = case Maybe v
mv of
  Just v
v -> (Key
n Key -> v -> kv
forall v. ToJSON v => Key -> v -> kv
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= v
v kv -> [kv] -> [kv]
forall a. a -> [a] -> [a]
:)
  Maybe v
Nothing -> [kv] -> [kv]
forall a. a -> a
id

instance ToJSON QueryTipLocalStateOutput where
  toJSON :: QueryTipLocalStateOutput -> Value
toJSON QueryTipLocalStateOutput
a = case QueryTipLocalStateOutput -> ChainTip
localStateChainTip QueryTipLocalStateOutput
a of
    ChainTip
ChainTipAtGenesis ->
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        ( (Key
"era" Key -> Maybe AnyCardanoEra -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe AnyCardanoEra
mEra QueryTipLocalStateOutput
a)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"epoch" Key -> Maybe EpochNo -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe EpochNo
mEpoch QueryTipLocalStateOutput
a)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"slotInEpoch" Key -> Maybe Word64 -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Word64
mSlotInEpoch QueryTipLocalStateOutput
a)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"slotsToEpochEnd" Key -> Maybe Word64 -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Word64
mSlotsToEpochEnd QueryTipLocalStateOutput
a)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"syncProgress" Key -> Maybe Text -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Text
mSyncProgress QueryTipLocalStateOutput
a)
        )
          []
    ChainTip SlotNo
slotNo Hash BlockHeader
blockHeader BlockNo
blockNo ->
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        ( (Key
"slot" Key -> SlotNo -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> v -> [kv] -> [kv]
..= SlotNo
slotNo)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"hash" Key -> Text -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> v -> [kv] -> [kv]
..= Hash BlockHeader -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash BlockHeader
blockHeader)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"block" Key -> BlockNo -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> v -> [kv] -> [kv]
..= BlockNo
blockNo)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"era" Key -> Maybe AnyCardanoEra -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe AnyCardanoEra
mEra QueryTipLocalStateOutput
a)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"epoch" Key -> Maybe EpochNo -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe EpochNo
mEpoch QueryTipLocalStateOutput
a)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"slotInEpoch" Key -> Maybe Word64 -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Word64
mSlotInEpoch QueryTipLocalStateOutput
a)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"slotsToEpochEnd" Key -> Maybe Word64 -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Word64
mSlotsToEpochEnd QueryTipLocalStateOutput
a)
            ([Pair] -> [Pair]) -> ([Pair] -> [Pair]) -> [Pair] -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"syncProgress" Key -> Maybe Text -> [Pair] -> [Pair]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Text
mSyncProgress QueryTipLocalStateOutput
a)
        )
          []
  toEncoding :: QueryTipLocalStateOutput -> Encoding
toEncoding QueryTipLocalStateOutput
a = case QueryTipLocalStateOutput -> ChainTip
localStateChainTip QueryTipLocalStateOutput
a of
    ChainTip
ChainTipAtGenesis ->
      Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
        [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> [Series] -> Series
forall a b. (a -> b) -> a -> b
$
          ( (Key
"era" Key -> Maybe AnyCardanoEra -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe AnyCardanoEra
mEra QueryTipLocalStateOutput
a)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"epoch" Key -> Maybe EpochNo -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe EpochNo
mEpoch QueryTipLocalStateOutput
a)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"slotInEpoch" Key -> Maybe Word64 -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Word64
mSlotInEpoch QueryTipLocalStateOutput
a)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"slotsToEpochEnd" Key -> Maybe Word64 -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Word64
mSlotsToEpochEnd QueryTipLocalStateOutput
a)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"syncProgress" Key -> Maybe Text -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Text
mSyncProgress QueryTipLocalStateOutput
a)
          )
            []
    ChainTip SlotNo
slotNo Hash BlockHeader
blockHeader BlockNo
blockNo ->
      Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$
        [Series] -> Series
forall a. Monoid a => [a] -> a
mconcat ([Series] -> Series) -> [Series] -> Series
forall a b. (a -> b) -> a -> b
$
          ( (Key
"slot" Key -> SlotNo -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> v -> [kv] -> [kv]
..= SlotNo
slotNo)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"hash" Key -> Text -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> v -> [kv] -> [kv]
..= Hash BlockHeader -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText Hash BlockHeader
blockHeader)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"block" Key -> BlockNo -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> v -> [kv] -> [kv]
..= BlockNo
blockNo)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"era" Key -> Maybe AnyCardanoEra -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe AnyCardanoEra
mEra QueryTipLocalStateOutput
a)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"epoch" Key -> Maybe EpochNo -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe EpochNo
mEpoch QueryTipLocalStateOutput
a)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"slotInEpoch" Key -> Maybe Word64 -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Word64
mSlotInEpoch QueryTipLocalStateOutput
a)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"slotsToEpochEnd" Key -> Maybe Word64 -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Word64
mSlotsToEpochEnd QueryTipLocalStateOutput
a)
              ([Series] -> [Series])
-> ([Series] -> [Series]) -> [Series] -> [Series]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
"syncProgress" Key -> Maybe Text -> [Series] -> [Series]
forall e kv v.
(KeyValue e kv, ToJSON v) =>
Key -> Maybe v -> [kv] -> [kv]
..=? QueryTipLocalStateOutput -> Maybe Text
mSyncProgress QueryTipLocalStateOutput
a)
          )
            []

instance FromJSON QueryTipLocalStateOutput where
  parseJSON :: Value -> Parser QueryTipLocalStateOutput
parseJSON = String
-> (Object -> Parser QueryTipLocalStateOutput)
-> Value
-> Parser QueryTipLocalStateOutput
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"QueryTipLocalStateOutput" ((Object -> Parser QueryTipLocalStateOutput)
 -> Value -> Parser QueryTipLocalStateOutput)
-> (Object -> Parser QueryTipLocalStateOutput)
-> Value
-> Parser QueryTipLocalStateOutput
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Maybe AnyCardanoEra
mEra' <- Object
o Object -> Key -> Parser (Maybe AnyCardanoEra)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"era"
    Maybe EpochNo
mEpoch' <- Object
o Object -> Key -> Parser (Maybe EpochNo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"epoch"
    Maybe Text
mSyncProgress' <- Object
o Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"syncProgress"

    Maybe SlotNo
mSlot <- Object
o Object -> Key -> Parser (Maybe SlotNo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"slot"
    Maybe (Hash BlockHeader)
mHash <- Object
o Object -> Key -> Parser (Maybe (Hash BlockHeader))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"hash"
    Maybe BlockNo
mBlock <- Object
o Object -> Key -> Parser (Maybe BlockNo)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"block"
    Maybe Word64
mSlotInEpoch' <- Object
o Object -> Key -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"slotInEpoch"
    Maybe Word64
mSlotsToEpochEnd' <- Object
o Object -> Key -> Parser (Maybe Word64)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"slotsToEpochEnd"
    case (Maybe SlotNo
mSlot, Maybe (Hash BlockHeader)
mHash, Maybe BlockNo
mBlock) of
      (Maybe SlotNo
Nothing, Maybe (Hash BlockHeader)
Nothing, Maybe BlockNo
Nothing) ->
        QueryTipLocalStateOutput -> Parser QueryTipLocalStateOutput
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryTipLocalStateOutput -> Parser QueryTipLocalStateOutput)
-> QueryTipLocalStateOutput -> Parser QueryTipLocalStateOutput
forall a b. (a -> b) -> a -> b
$
          ChainTip
-> Maybe AnyCardanoEra
-> Maybe EpochNo
-> Maybe Word64
-> Maybe Word64
-> Maybe Text
-> QueryTipLocalStateOutput
QueryTipLocalStateOutput
            ChainTip
ChainTipAtGenesis
            Maybe AnyCardanoEra
mEra'
            Maybe EpochNo
mEpoch'
            Maybe Word64
mSlotInEpoch'
            Maybe Word64
mSlotsToEpochEnd'
            Maybe Text
mSyncProgress'
      (Just SlotNo
slot, Just Hash BlockHeader
hash, Just BlockNo
block) ->
        QueryTipLocalStateOutput -> Parser QueryTipLocalStateOutput
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (QueryTipLocalStateOutput -> Parser QueryTipLocalStateOutput)
-> QueryTipLocalStateOutput -> Parser QueryTipLocalStateOutput
forall a b. (a -> b) -> a -> b
$
          ChainTip
-> Maybe AnyCardanoEra
-> Maybe EpochNo
-> Maybe Word64
-> Maybe Word64
-> Maybe Text
-> QueryTipLocalStateOutput
QueryTipLocalStateOutput
            (SlotNo -> Hash BlockHeader -> BlockNo -> ChainTip
ChainTip SlotNo
slot Hash BlockHeader
hash BlockNo
block)
            Maybe AnyCardanoEra
mEra'
            Maybe EpochNo
mEpoch'
            Maybe Word64
mSlotInEpoch'
            Maybe Word64
mSlotsToEpochEnd'
            Maybe Text
mSyncProgress'
      (Maybe SlotNo
_, Maybe (Hash BlockHeader)
_, Maybe BlockNo
_) ->
        String -> Parser QueryTipLocalStateOutput
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser QueryTipLocalStateOutput)
-> String -> Parser QueryTipLocalStateOutput
forall a b. (a -> b) -> a -> b
$
          [String] -> String
forall a. Monoid a => [a] -> a
mconcat
            [ String
"QueryTipLocalStateOutput was incorrectly JSON encoded."
            , String
" Expected slot, header hash and block number (ChainTip)"
            , String
" or none (ChainTipAtGenesis)"
            ]

data ScriptCostOutput
  = ScriptCostOutput
  { ScriptCostOutput -> ScriptHash
scScriptHash :: ScriptHash
  , ScriptCostOutput -> ExecutionUnits
scExecutionUnits :: ExecutionUnits
  , ScriptCostOutput -> Lovelace
scAda :: Lovelace
  }

instance ToJSON ScriptCostOutput where
  toJSON :: ScriptCostOutput -> Value
toJSON (ScriptCostOutput ScriptHash
sHash ExecutionUnits
execUnits Lovelace
llCost) =
    [Pair] -> Value
object
      [ Key
"scriptHash" Key -> ScriptHash -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ScriptHash
sHash
      , Key
"executionUnits" Key -> ExecutionUnits -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ExecutionUnits
execUnits
      , Key
"lovelaceCost" Key -> Lovelace -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Lovelace
llCost
      ]

data PlutusScriptCostError
  = PlutusScriptCostErrPlutusScriptNotFound ScriptWitnessIndex
  | PlutusScriptCostErrExecError ScriptWitnessIndex (Maybe ScriptHash) ScriptExecutionError
  | PlutusScriptCostErrRationalExceedsBound
      [Text]
      -- ^ Execution logs
      L.Prices
      ExecutionUnits
  | PlutusScriptCostErrRefInputNoScript TxIn
  | PlutusScriptCostErrRefInputNotInUTxO TxIn
  deriving Int -> PlutusScriptCostError -> ShowS
[PlutusScriptCostError] -> ShowS
PlutusScriptCostError -> String
(Int -> PlutusScriptCostError -> ShowS)
-> (PlutusScriptCostError -> String)
-> ([PlutusScriptCostError] -> ShowS)
-> Show PlutusScriptCostError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlutusScriptCostError -> ShowS
showsPrec :: Int -> PlutusScriptCostError -> ShowS
$cshow :: PlutusScriptCostError -> String
show :: PlutusScriptCostError -> String
$cshowList :: [PlutusScriptCostError] -> ShowS
showList :: [PlutusScriptCostError] -> ShowS
Show

instance Error PlutusScriptCostError where
  prettyError :: forall ann. PlutusScriptCostError -> Doc ann
prettyError = \case
    PlutusScriptCostErrPlutusScriptNotFound ScriptWitnessIndex
sWitIndex ->
      Doc ann
"No Plutus script was found at: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptWitnessIndex -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ScriptWitnessIndex
sWitIndex
    PlutusScriptCostErrExecError ScriptWitnessIndex
sWitIndex Maybe ScriptHash
sHash ScriptExecutionError
sExecErro ->
      Doc ann
"Plutus script at: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptWitnessIndex -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ScriptWitnessIndex
sWitIndex
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" with hash: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Maybe ScriptHash -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Maybe ScriptHash
sHash
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
" errored with: "
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> ScriptExecutionError -> Doc ann
forall e ann. Error e => e -> Doc ann
forall ann. ScriptExecutionError -> Doc ann
prettyError ScriptExecutionError
sExecErro
    PlutusScriptCostErrRationalExceedsBound [Text]
executionLogs Prices
eUnitPrices ExecutionUnits
eUnits ->
      let firstLine :: Doc ann
firstLine =
            [Doc ann] -> Doc ann
forall a. Monoid a => [a] -> a
mconcat
              [ Doc ann
"Either the execution unit prices: "
              , Prices -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow Prices
eUnitPrices
              , Doc ann
" or the execution units: "
              , ExecutionUnits -> Doc ann
forall a ann. Show a => a -> Doc ann
pshow ExecutionUnits
eUnits
              , Doc ann
" or both are either too precise or not within bounds"
              ]
       in [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
            [ Doc ann
forall {ann}. Doc ann
firstLine
            , Doc ann
"Execution logs: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ([Text] -> Text
Text.unlines [Text]
executionLogs)
            ]
    PlutusScriptCostErrRefInputNoScript TxIn
txin ->
      Doc ann
"No reference script found at input: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TxIn -> Text
renderTxIn TxIn
txin)
    PlutusScriptCostErrRefInputNotInUTxO TxIn
txin ->
      Doc ann
"Reference input was not found in utxo: " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Text -> Doc ann
forall ann. Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (TxIn -> Text
renderTxIn TxIn
txin)

renderScriptCosts
  :: UTxO era
  -> L.Prices
  -> [(ScriptWitnessIndex, AnyScriptWitness era)]
  -- ^ Initial mapping of script witness index to actual script.
  -- We need this in order to know which script corresponds to the
  -- calculated execution units.
  -> Map ScriptWitnessIndex (Either ScriptExecutionError ([Text], ExecutionUnits))
  -- ^ Post execution cost calculation mapping of script witness
  -- index to execution units.
  -> Either PlutusScriptCostError [ScriptCostOutput]
renderScriptCosts :: forall era.
UTxO era
-> Prices
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
-> Map
     ScriptWitnessIndex
     (Either ScriptExecutionError ([Text], ExecutionUnits))
-> Either PlutusScriptCostError [ScriptCostOutput]
renderScriptCosts (UTxO Map TxIn (TxOut CtxUTxO era)
utxo) Prices
eUnitPrices [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptMapping Map
  ScriptWitnessIndex
  (Either ScriptExecutionError ([Text], ExecutionUnits))
executionCostMapping =
  [Either PlutusScriptCostError ScriptCostOutput]
-> Either PlutusScriptCostError [ScriptCostOutput]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Either PlutusScriptCostError ScriptCostOutput]
 -> Either PlutusScriptCostError [ScriptCostOutput])
-> [Either PlutusScriptCostError ScriptCostOutput]
-> Either PlutusScriptCostError [ScriptCostOutput]
forall a b. (a -> b) -> a -> b
$
    ([Either PlutusScriptCostError ScriptCostOutput]
 -> ScriptWitnessIndex
 -> Either ScriptExecutionError ([Text], ExecutionUnits)
 -> [Either PlutusScriptCostError ScriptCostOutput])
-> [Either PlutusScriptCostError ScriptCostOutput]
-> Map
     ScriptWitnessIndex
     (Either ScriptExecutionError ([Text], ExecutionUnits))
-> [Either PlutusScriptCostError ScriptCostOutput]
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey
      ( \[Either PlutusScriptCostError ScriptCostOutput]
accum ScriptWitnessIndex
sWitInd Either ScriptExecutionError ([Text], ExecutionUnits)
eExecUnits -> do
          case ScriptWitnessIndex
-> [(ScriptWitnessIndex, AnyScriptWitness era)]
-> Maybe (AnyScriptWitness era)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
List.lookup ScriptWitnessIndex
sWitInd [(ScriptWitnessIndex, AnyScriptWitness era)]
scriptMapping of
            Just (AnyScriptWitness SimpleScriptWitness{}) -> [Either PlutusScriptCostError ScriptCostOutput]
accum
            Just (AnyScriptWitness (PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
pVer (PScript PlutusScript lang
pScript) ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_)) -> do
              let scriptHash :: ScriptHash
scriptHash = Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript (Script lang -> ScriptHash) -> Script lang -> ScriptHash
forall a b. (a -> b) -> a -> b
$ PlutusScriptVersion lang -> PlutusScript lang -> Script lang
forall lang.
IsPlutusScriptLanguage lang =>
PlutusScriptVersion lang -> PlutusScript lang -> Script lang
PlutusScript PlutusScriptVersion lang
pVer PlutusScript lang
pScript
              case Either ScriptExecutionError ([Text], ExecutionUnits)
eExecUnits of
                Right ([Text]
logs, ExecutionUnits
execUnits) ->
                  case Prices -> ExecutionUnits -> Maybe Lovelace
calculateExecutionUnitsLovelace Prices
eUnitPrices ExecutionUnits
execUnits of
                    Just Lovelace
llCost ->
                      ScriptCostOutput -> Either PlutusScriptCostError ScriptCostOutput
forall a b. b -> Either a b
Right (ScriptHash -> ExecutionUnits -> Lovelace -> ScriptCostOutput
ScriptCostOutput ScriptHash
scriptHash ExecutionUnits
execUnits Lovelace
llCost)
                        Either PlutusScriptCostError ScriptCostOutput
-> [Either PlutusScriptCostError ScriptCostOutput]
-> [Either PlutusScriptCostError ScriptCostOutput]
forall a. a -> [a] -> [a]
: [Either PlutusScriptCostError ScriptCostOutput]
accum
                    Maybe Lovelace
Nothing ->
                      PlutusScriptCostError
-> Either PlutusScriptCostError ScriptCostOutput
forall a b. a -> Either a b
Left ([Text] -> Prices -> ExecutionUnits -> PlutusScriptCostError
PlutusScriptCostErrRationalExceedsBound [Text]
logs Prices
eUnitPrices ExecutionUnits
execUnits)
                        Either PlutusScriptCostError ScriptCostOutput
-> [Either PlutusScriptCostError ScriptCostOutput]
-> [Either PlutusScriptCostError ScriptCostOutput]
forall a. a -> [a] -> [a]
: [Either PlutusScriptCostError ScriptCostOutput]
accum
                Left ScriptExecutionError
err -> PlutusScriptCostError
-> Either PlutusScriptCostError ScriptCostOutput
forall a b. a -> Either a b
Left (ScriptWitnessIndex
-> Maybe ScriptHash
-> ScriptExecutionError
-> PlutusScriptCostError
PlutusScriptCostErrExecError ScriptWitnessIndex
sWitInd (ScriptHash -> Maybe ScriptHash
forall a. a -> Maybe a
Just ScriptHash
scriptHash) ScriptExecutionError
err) Either PlutusScriptCostError ScriptCostOutput
-> [Either PlutusScriptCostError ScriptCostOutput]
-> [Either PlutusScriptCostError ScriptCostOutput]
forall a. a -> [a] -> [a]
: [Either PlutusScriptCostError ScriptCostOutput]
accum
            -- TODO: Create a new sum type to encapsulate the fact that we can also
            -- have a txin and render the txin in the case of reference scripts.
            Just (AnyScriptWitness (PlutusScriptWitness ScriptLanguageInEra lang era
_ PlutusScriptVersion lang
_ (PReferenceScript TxIn
refTxIn) ScriptDatum witctx
_ ScriptRedeemer
_ ExecutionUnits
_)) ->
              case TxIn -> Map TxIn (TxOut CtxUTxO era) -> Maybe (TxOut CtxUTxO era)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup TxIn
refTxIn Map TxIn (TxOut CtxUTxO era)
utxo of
                Maybe (TxOut CtxUTxO era)
Nothing -> PlutusScriptCostError
-> Either PlutusScriptCostError ScriptCostOutput
forall a b. a -> Either a b
Left (TxIn -> PlutusScriptCostError
PlutusScriptCostErrRefInputNotInUTxO TxIn
refTxIn) Either PlutusScriptCostError ScriptCostOutput
-> [Either PlutusScriptCostError ScriptCostOutput]
-> [Either PlutusScriptCostError ScriptCostOutput]
forall a. a -> [a] -> [a]
: [Either PlutusScriptCostError ScriptCostOutput]
accum
                Just (TxOut AddressInEra era
_ TxOutValue era
_ TxOutDatum CtxUTxO era
_ ReferenceScript era
refScript) ->
                  case ReferenceScript era
refScript of
                    ReferenceScript era
ReferenceScriptNone -> PlutusScriptCostError
-> Either PlutusScriptCostError ScriptCostOutput
forall a b. a -> Either a b
Left (TxIn -> PlutusScriptCostError
PlutusScriptCostErrRefInputNoScript TxIn
refTxIn) Either PlutusScriptCostError ScriptCostOutput
-> [Either PlutusScriptCostError ScriptCostOutput]
-> [Either PlutusScriptCostError ScriptCostOutput]
forall a. a -> [a] -> [a]
: [Either PlutusScriptCostError ScriptCostOutput]
accum
                    ReferenceScript BabbageEraOnwards era
_ (ScriptInAnyLang ScriptLanguage lang
_ Script lang
script) ->
                      case Either ScriptExecutionError ([Text], ExecutionUnits)
eExecUnits of
                        Right ([Text]
logs, ExecutionUnits
execUnits) ->
                          case Prices -> ExecutionUnits -> Maybe Lovelace
calculateExecutionUnitsLovelace Prices
eUnitPrices ExecutionUnits
execUnits of
                            Just Lovelace
llCost ->
                              ScriptCostOutput -> Either PlutusScriptCostError ScriptCostOutput
forall a b. b -> Either a b
Right (ScriptHash -> ExecutionUnits -> Lovelace -> ScriptCostOutput
ScriptCostOutput (Script lang -> ScriptHash
forall lang. Script lang -> ScriptHash
hashScript Script lang
script) ExecutionUnits
execUnits Lovelace
llCost)
                                Either PlutusScriptCostError ScriptCostOutput
-> [Either PlutusScriptCostError ScriptCostOutput]
-> [Either PlutusScriptCostError ScriptCostOutput]
forall a. a -> [a] -> [a]
: [Either PlutusScriptCostError ScriptCostOutput]
accum
                            Maybe Lovelace
Nothing ->
                              PlutusScriptCostError
-> Either PlutusScriptCostError ScriptCostOutput
forall a b. a -> Either a b
Left ([Text] -> Prices -> ExecutionUnits -> PlutusScriptCostError
PlutusScriptCostErrRationalExceedsBound [Text]
logs Prices
eUnitPrices ExecutionUnits
execUnits)
                                Either PlutusScriptCostError ScriptCostOutput
-> [Either PlutusScriptCostError ScriptCostOutput]
-> [Either PlutusScriptCostError ScriptCostOutput]
forall a. a -> [a] -> [a]
: [Either PlutusScriptCostError ScriptCostOutput]
accum
                        Left ScriptExecutionError
err -> PlutusScriptCostError
-> Either PlutusScriptCostError ScriptCostOutput
forall a b. a -> Either a b
Left (ScriptWitnessIndex
-> Maybe ScriptHash
-> ScriptExecutionError
-> PlutusScriptCostError
PlutusScriptCostErrExecError ScriptWitnessIndex
sWitInd Maybe ScriptHash
forall a. Maybe a
Nothing ScriptExecutionError
err) Either PlutusScriptCostError ScriptCostOutput
-> [Either PlutusScriptCostError ScriptCostOutput]
-> [Either PlutusScriptCostError ScriptCostOutput]
forall a. a -> [a] -> [a]
: [Either PlutusScriptCostError ScriptCostOutput]
accum
            Maybe (AnyScriptWitness era)
Nothing -> PlutusScriptCostError
-> Either PlutusScriptCostError ScriptCostOutput
forall a b. a -> Either a b
Left (ScriptWitnessIndex -> PlutusScriptCostError
PlutusScriptCostErrPlutusScriptNotFound ScriptWitnessIndex
sWitInd) Either PlutusScriptCostError ScriptCostOutput
-> [Either PlutusScriptCostError ScriptCostOutput]
-> [Either PlutusScriptCostError ScriptCostOutput]
forall a. a -> [a] -> [a]
: [Either PlutusScriptCostError ScriptCostOutput]
accum
      )
      []
      Map
  ScriptWitnessIndex
  (Either ScriptExecutionError ([Text], ExecutionUnits))
executionCostMapping