{-# LANGUAGE RecordWildCards #-}
-- | Cardano Utils responses

module Blockfrost.Types.Cardano.Utils
  ( DerivedAddress (..)
  , TxEval (..)
  , TxEvalValidator (..)
  , TxEvalBudget (..)
  , evalSample
  , TxEvalInput (..)
  ) where

import Data.Aeson
  ( FromJSON (..)
  , FromJSONKey (..)
  , ToJSON (..)
  , ToJSONKey (..)
  , Value (Array)
  , object
  , withObject
  , withText
  , (.:)
  , (.:?)
  , (.=)
  )
import Data.Aeson.Types (FromJSONKeyFunction(..), Parser)

import Blockfrost.Types.Shared.CBOR (CBORString(..))
import Blockfrost.Types.Shared.ValidationPurpose (ValidationPurpose(..))
import Data.Text (Text)
import Data.Map (Map)
import Deriving.Aeson
import Servant.Docs (ToSample (..), singleSample)
import qualified Data.Aeson.Types
import qualified Data.Char
import qualified Data.Text
import qualified Data.Map.Strict
import qualified Text.Read

-- | Derived Shelley address
data DerivedAddress = DerivedAddress
  { DerivedAddress -> Text
_derivedAddressXpub    :: Text    -- ^ Hexadecimal xpub
  , DerivedAddress -> Integer
_derivedAddressRole    :: Integer -- ^ Account role
  , DerivedAddress -> Integer
_derivedAddressIndex   :: Integer -- ^ Address index
  , DerivedAddress -> Text
_derivedAddressAddress :: Text    -- ^ Derived address
  }
  deriving stock (Int -> DerivedAddress -> ShowS
[DerivedAddress] -> ShowS
DerivedAddress -> String
(Int -> DerivedAddress -> ShowS)
-> (DerivedAddress -> String)
-> ([DerivedAddress] -> ShowS)
-> Show DerivedAddress
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DerivedAddress -> ShowS
showsPrec :: Int -> DerivedAddress -> ShowS
$cshow :: DerivedAddress -> String
show :: DerivedAddress -> String
$cshowList :: [DerivedAddress] -> ShowS
showList :: [DerivedAddress] -> ShowS
Show, DerivedAddress -> DerivedAddress -> Bool
(DerivedAddress -> DerivedAddress -> Bool)
-> (DerivedAddress -> DerivedAddress -> Bool) -> Eq DerivedAddress
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DerivedAddress -> DerivedAddress -> Bool
== :: DerivedAddress -> DerivedAddress -> Bool
$c/= :: DerivedAddress -> DerivedAddress -> Bool
/= :: DerivedAddress -> DerivedAddress -> Bool
Eq, (forall x. DerivedAddress -> Rep DerivedAddress x)
-> (forall x. Rep DerivedAddress x -> DerivedAddress)
-> Generic DerivedAddress
forall x. Rep DerivedAddress x -> DerivedAddress
forall x. DerivedAddress -> Rep DerivedAddress x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DerivedAddress -> Rep DerivedAddress x
from :: forall x. DerivedAddress -> Rep DerivedAddress x
$cto :: forall x. Rep DerivedAddress x -> DerivedAddress
to :: forall x. Rep DerivedAddress x -> DerivedAddress
Generic)
  deriving (Maybe DerivedAddress
Value -> Parser [DerivedAddress]
Value -> Parser DerivedAddress
(Value -> Parser DerivedAddress)
-> (Value -> Parser [DerivedAddress])
-> Maybe DerivedAddress
-> FromJSON DerivedAddress
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser DerivedAddress
parseJSON :: Value -> Parser DerivedAddress
$cparseJSONList :: Value -> Parser [DerivedAddress]
parseJSONList :: Value -> Parser [DerivedAddress]
$comittedField :: Maybe DerivedAddress
omittedField :: Maybe DerivedAddress
FromJSON, [DerivedAddress] -> Value
[DerivedAddress] -> Encoding
DerivedAddress -> Bool
DerivedAddress -> Value
DerivedAddress -> Encoding
(DerivedAddress -> Value)
-> (DerivedAddress -> Encoding)
-> ([DerivedAddress] -> Value)
-> ([DerivedAddress] -> Encoding)
-> (DerivedAddress -> Bool)
-> ToJSON DerivedAddress
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: DerivedAddress -> Value
toJSON :: DerivedAddress -> Value
$ctoEncoding :: DerivedAddress -> Encoding
toEncoding :: DerivedAddress -> Encoding
$ctoJSONList :: [DerivedAddress] -> Value
toJSONList :: [DerivedAddress] -> Value
$ctoEncodingList :: [DerivedAddress] -> Encoding
toEncodingList :: [DerivedAddress] -> Encoding
$comitField :: DerivedAddress -> Bool
omitField :: DerivedAddress -> Bool
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_derivedAddress", CamelToSnake]] DerivedAddress

instance ToSample DerivedAddress where
  toSamples :: Proxy DerivedAddress -> [(Text, DerivedAddress)]
toSamples = [(Text, DerivedAddress)]
-> Proxy DerivedAddress -> [(Text, DerivedAddress)]
forall a. a -> Proxy DerivedAddress -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, DerivedAddress)]
 -> Proxy DerivedAddress -> [(Text, DerivedAddress)])
-> [(Text, DerivedAddress)]
-> Proxy DerivedAddress
-> [(Text, DerivedAddress)]
forall a b. (a -> b) -> a -> b
$ DerivedAddress -> [(Text, DerivedAddress)]
forall a. a -> [(Text, a)]
singleSample
    DerivedAddress
      { _derivedAddressXpub :: Text
_derivedAddressXpub    = Text
"d507c8f866691bd96e131334c355188b1a1d0b2fa0ab11545075aab332d77d9eb19657ad13ee581b56b0f8d744d66ca356b93d42fe176b3de007d53e9c4c4e7a"
      , _derivedAddressRole :: Integer
_derivedAddressRole    = Integer
0
      , _derivedAddressIndex :: Integer
_derivedAddressIndex   = Integer
0
      , _derivedAddressAddress :: Text
_derivedAddressAddress = Text
"addr1q90sqnljxky88s0jsnps48jd872p7znzwym0jpzqnax6qs5nfrlkaatu28n0qzmqh7f2cpksxhpc9jefx3wrl0a2wu8q5amen7"
      }

-- * TxEval

data TxEvalValidator = TxEvalValidator
  { TxEvalValidator -> ValidationPurpose
_txEvalValidatorPurpose :: ValidationPurpose
  , TxEvalValidator -> Int
_txEvalValidatorIndex :: Int
  }
  deriving stock (TxEvalValidator -> TxEvalValidator -> Bool
(TxEvalValidator -> TxEvalValidator -> Bool)
-> (TxEvalValidator -> TxEvalValidator -> Bool)
-> Eq TxEvalValidator
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxEvalValidator -> TxEvalValidator -> Bool
== :: TxEvalValidator -> TxEvalValidator -> Bool
$c/= :: TxEvalValidator -> TxEvalValidator -> Bool
/= :: TxEvalValidator -> TxEvalValidator -> Bool
Eq, Eq TxEvalValidator
Eq TxEvalValidator =>
(TxEvalValidator -> TxEvalValidator -> Ordering)
-> (TxEvalValidator -> TxEvalValidator -> Bool)
-> (TxEvalValidator -> TxEvalValidator -> Bool)
-> (TxEvalValidator -> TxEvalValidator -> Bool)
-> (TxEvalValidator -> TxEvalValidator -> Bool)
-> (TxEvalValidator -> TxEvalValidator -> TxEvalValidator)
-> (TxEvalValidator -> TxEvalValidator -> TxEvalValidator)
-> Ord TxEvalValidator
TxEvalValidator -> TxEvalValidator -> Bool
TxEvalValidator -> TxEvalValidator -> Ordering
TxEvalValidator -> TxEvalValidator -> TxEvalValidator
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: TxEvalValidator -> TxEvalValidator -> Ordering
compare :: TxEvalValidator -> TxEvalValidator -> Ordering
$c< :: TxEvalValidator -> TxEvalValidator -> Bool
< :: TxEvalValidator -> TxEvalValidator -> Bool
$c<= :: TxEvalValidator -> TxEvalValidator -> Bool
<= :: TxEvalValidator -> TxEvalValidator -> Bool
$c> :: TxEvalValidator -> TxEvalValidator -> Bool
> :: TxEvalValidator -> TxEvalValidator -> Bool
$c>= :: TxEvalValidator -> TxEvalValidator -> Bool
>= :: TxEvalValidator -> TxEvalValidator -> Bool
$cmax :: TxEvalValidator -> TxEvalValidator -> TxEvalValidator
max :: TxEvalValidator -> TxEvalValidator -> TxEvalValidator
$cmin :: TxEvalValidator -> TxEvalValidator -> TxEvalValidator
min :: TxEvalValidator -> TxEvalValidator -> TxEvalValidator
Ord, Int -> TxEvalValidator -> ShowS
[TxEvalValidator] -> ShowS
TxEvalValidator -> String
(Int -> TxEvalValidator -> ShowS)
-> (TxEvalValidator -> String)
-> ([TxEvalValidator] -> ShowS)
-> Show TxEvalValidator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxEvalValidator -> ShowS
showsPrec :: Int -> TxEvalValidator -> ShowS
$cshow :: TxEvalValidator -> String
show :: TxEvalValidator -> String
$cshowList :: [TxEvalValidator] -> ShowS
showList :: [TxEvalValidator] -> ShowS
Show, (forall x. TxEvalValidator -> Rep TxEvalValidator x)
-> (forall x. Rep TxEvalValidator x -> TxEvalValidator)
-> Generic TxEvalValidator
forall x. Rep TxEvalValidator x -> TxEvalValidator
forall x. TxEvalValidator -> Rep TxEvalValidator x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxEvalValidator -> Rep TxEvalValidator x
from :: forall x. TxEvalValidator -> Rep TxEvalValidator x
$cto :: forall x. Rep TxEvalValidator x -> TxEvalValidator
to :: forall x. Rep TxEvalValidator x -> TxEvalValidator
Generic)

instance ToJSON TxEvalValidator where
  toJSON :: TxEvalValidator -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value)
-> (TxEvalValidator -> Text) -> TxEvalValidator -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxEvalValidator -> Text
mkOgmiosValidator

instance ToJSONKey TxEvalValidator where
  toJSONKey :: ToJSONKeyFunction TxEvalValidator
toJSONKey = (TxEvalValidator -> Text) -> ToJSONKeyFunction TxEvalValidator
forall a. (a -> Text) -> ToJSONKeyFunction a
Data.Aeson.Types.toJSONKeyText TxEvalValidator -> Text
mkOgmiosValidator

mkOgmiosValidator
  :: TxEvalValidator
  -> Text
mkOgmiosValidator :: TxEvalValidator -> Text
mkOgmiosValidator TxEvalValidator{Int
ValidationPurpose
_txEvalValidatorPurpose :: TxEvalValidator -> ValidationPurpose
_txEvalValidatorIndex :: TxEvalValidator -> Int
_txEvalValidatorPurpose :: ValidationPurpose
_txEvalValidatorIndex :: Int
..} =
  (    ValidationPurpose -> Text
toOgmiosPurpose ValidationPurpose
_txEvalValidatorPurpose
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Data.Text.pack (Int -> String
forall a. Show a => a -> String
show Int
_txEvalValidatorIndex)
  )
instance FromJSON TxEvalValidator where
  parseJSON :: Value -> Parser TxEvalValidator
parseJSON =
    String
-> (Text -> Parser TxEvalValidator)
-> Value
-> Parser TxEvalValidator
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText
      String
"TxEvalValidator"
      Text -> Parser TxEvalValidator
parseOgmiosValidator

instance FromJSONKey TxEvalValidator where
  fromJSONKey :: FromJSONKeyFunction TxEvalValidator
fromJSONKey = (Text -> Parser TxEvalValidator)
-> FromJSONKeyFunction TxEvalValidator
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser TxEvalValidator
parseOgmiosValidator

parseOgmiosValidator
  :: Text
  -> Parser TxEvalValidator
parseOgmiosValidator :: Text -> Parser TxEvalValidator
parseOgmiosValidator =
      (\case
         [Text
purpose, Text
index] ->
            case Text -> Either String ValidationPurpose
fromOgmiosPurpose Text
purpose of
              Right ValidationPurpose
p ->
                case String -> Maybe Int
forall a. Read a => String -> Maybe a
Text.Read.readMaybe (Text -> String
Data.Text.unpack Text
index) of
                  Maybe Int
Nothing -> String -> Parser TxEvalValidator
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TxEvalValidator)
-> String -> Parser TxEvalValidator
forall a b. (a -> b) -> a -> b
$ String
"Expecting numeric index, got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> (Text -> String
Data.Text.unpack Text
index)
                  Just Int
idx -> TxEvalValidator -> Parser TxEvalValidator
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TxEvalValidator -> Parser TxEvalValidator)
-> TxEvalValidator -> Parser TxEvalValidator
forall a b. (a -> b) -> a -> b
$ ValidationPurpose -> Int -> TxEvalValidator
TxEvalValidator ValidationPurpose
p Int
idx
              Left String
e ->
                String -> Parser TxEvalValidator
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
         [Text]
x -> String -> Parser TxEvalValidator
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser TxEvalValidator)
-> String -> Parser TxEvalValidator
forall a b. (a -> b) -> a -> b
$ String
"Expecting [purpose, index], got " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Text] -> String
forall a. Show a => a -> String
show [Text]
x
      ([Text] -> Parser TxEvalValidator)
-> (Text -> [Text]) -> Text -> Parser TxEvalValidator
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
Data.Text.splitOn Text
":"
      )

toOgmiosPurpose
  :: ValidationPurpose
  -> Text
toOgmiosPurpose :: ValidationPurpose -> Text
toOgmiosPurpose ValidationPurpose
Spend = Text
"spend"
toOgmiosPurpose ValidationPurpose
Mint = Text
"mint"
toOgmiosPurpose ValidationPurpose
Cert = Text
"publish"
toOgmiosPurpose ValidationPurpose
Reward = Text
"withdraw"

fromOgmiosPurpose
  :: Text
  -> Either String ValidationPurpose
fromOgmiosPurpose :: Text -> Either String ValidationPurpose
fromOgmiosPurpose Text
"spend" = ValidationPurpose -> Either String ValidationPurpose
forall a b. b -> Either a b
Right ValidationPurpose
Spend
fromOgmiosPurpose Text
"mint" = ValidationPurpose -> Either String ValidationPurpose
forall a b. b -> Either a b
Right ValidationPurpose
Mint
fromOgmiosPurpose Text
"publish" = ValidationPurpose -> Either String ValidationPurpose
forall a b. b -> Either a b
Right ValidationPurpose
Cert
fromOgmiosPurpose Text
"withdraw" = ValidationPurpose -> Either String ValidationPurpose
forall a b. b -> Either a b
Right ValidationPurpose
Reward
fromOgmiosPurpose Text
x =
  String -> Either String ValidationPurpose
forall a b. a -> Either a b
Left
    (String -> Either String ValidationPurpose)
-> String -> Either String ValidationPurpose
forall a b. (a -> b) -> a -> b
$ String
"Don't know how to handle Ogmios validation purpose: " 
      String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Data.Text.unpack Text
x

validatorSample :: TxEvalValidator
validatorSample :: TxEvalValidator
validatorSample =
  TxEvalValidator
    { _txEvalValidatorPurpose :: ValidationPurpose
_txEvalValidatorPurpose = ValidationPurpose
Spend
    , _txEvalValidatorIndex :: Int
_txEvalValidatorIndex = Int
0
    }

instance ToSample TxEvalValidator where
  toSamples :: Proxy TxEvalValidator -> [(Text, TxEvalValidator)]
toSamples = [(Text, TxEvalValidator)]
-> Proxy TxEvalValidator -> [(Text, TxEvalValidator)]
forall a. a -> Proxy TxEvalValidator -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, TxEvalValidator)]
 -> Proxy TxEvalValidator -> [(Text, TxEvalValidator)])
-> [(Text, TxEvalValidator)]
-> Proxy TxEvalValidator
-> [(Text, TxEvalValidator)]
forall a b. (a -> b) -> a -> b
$ TxEvalValidator -> [(Text, TxEvalValidator)]
forall a. a -> [(Text, a)]
singleSample TxEvalValidator
validatorSample

data TxEvalBudget = TxEvalBudget
  { TxEvalBudget -> Integer
_txEvalBudgetMemory :: Integer -- ^ Memory budget
  , TxEvalBudget -> Integer
_txEvalBudgetSteps  :: Integer -- ^ CPU budget
  }
  deriving stock (Int -> TxEvalBudget -> ShowS
[TxEvalBudget] -> ShowS
TxEvalBudget -> String
(Int -> TxEvalBudget -> ShowS)
-> (TxEvalBudget -> String)
-> ([TxEvalBudget] -> ShowS)
-> Show TxEvalBudget
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxEvalBudget -> ShowS
showsPrec :: Int -> TxEvalBudget -> ShowS
$cshow :: TxEvalBudget -> String
show :: TxEvalBudget -> String
$cshowList :: [TxEvalBudget] -> ShowS
showList :: [TxEvalBudget] -> ShowS
Show, TxEvalBudget -> TxEvalBudget -> Bool
(TxEvalBudget -> TxEvalBudget -> Bool)
-> (TxEvalBudget -> TxEvalBudget -> Bool) -> Eq TxEvalBudget
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxEvalBudget -> TxEvalBudget -> Bool
== :: TxEvalBudget -> TxEvalBudget -> Bool
$c/= :: TxEvalBudget -> TxEvalBudget -> Bool
/= :: TxEvalBudget -> TxEvalBudget -> Bool
Eq, (forall x. TxEvalBudget -> Rep TxEvalBudget x)
-> (forall x. Rep TxEvalBudget x -> TxEvalBudget)
-> Generic TxEvalBudget
forall x. Rep TxEvalBudget x -> TxEvalBudget
forall x. TxEvalBudget -> Rep TxEvalBudget x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxEvalBudget -> Rep TxEvalBudget x
from :: forall x. TxEvalBudget -> Rep TxEvalBudget x
$cto :: forall x. Rep TxEvalBudget x -> TxEvalBudget
to :: forall x. Rep TxEvalBudget x -> TxEvalBudget
Generic)
  deriving (Maybe TxEvalBudget
Value -> Parser [TxEvalBudget]
Value -> Parser TxEvalBudget
(Value -> Parser TxEvalBudget)
-> (Value -> Parser [TxEvalBudget])
-> Maybe TxEvalBudget
-> FromJSON TxEvalBudget
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TxEvalBudget
parseJSON :: Value -> Parser TxEvalBudget
$cparseJSONList :: Value -> Parser [TxEvalBudget]
parseJSONList :: Value -> Parser [TxEvalBudget]
$comittedField :: Maybe TxEvalBudget
omittedField :: Maybe TxEvalBudget
FromJSON, [TxEvalBudget] -> Value
[TxEvalBudget] -> Encoding
TxEvalBudget -> Bool
TxEvalBudget -> Value
TxEvalBudget -> Encoding
(TxEvalBudget -> Value)
-> (TxEvalBudget -> Encoding)
-> ([TxEvalBudget] -> Value)
-> ([TxEvalBudget] -> Encoding)
-> (TxEvalBudget -> Bool)
-> ToJSON TxEvalBudget
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TxEvalBudget -> Value
toJSON :: TxEvalBudget -> Value
$ctoEncoding :: TxEvalBudget -> Encoding
toEncoding :: TxEvalBudget -> Encoding
$ctoJSONList :: [TxEvalBudget] -> Value
toJSONList :: [TxEvalBudget] -> Value
$ctoEncodingList :: [TxEvalBudget] -> Encoding
toEncodingList :: [TxEvalBudget] -> Encoding
$comitField :: TxEvalBudget -> Bool
omitField :: TxEvalBudget -> Bool
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_txEvalBudget", CamelToSnake]] TxEvalBudget

budgetSample :: TxEvalBudget
budgetSample :: TxEvalBudget
budgetSample =
  TxEvalBudget
      { _txEvalBudgetMemory :: Integer
_txEvalBudgetMemory = Integer
1765011
      , _txEvalBudgetSteps :: Integer
_txEvalBudgetSteps  = Integer
503871230
      }

instance ToSample TxEvalBudget where
  toSamples :: Proxy TxEvalBudget -> [(Text, TxEvalBudget)]
toSamples = [(Text, TxEvalBudget)]
-> Proxy TxEvalBudget -> [(Text, TxEvalBudget)]
forall a. a -> Proxy TxEvalBudget -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, TxEvalBudget)]
 -> Proxy TxEvalBudget -> [(Text, TxEvalBudget)])
-> [(Text, TxEvalBudget)]
-> Proxy TxEvalBudget
-> [(Text, TxEvalBudget)]
forall a b. (a -> b) -> a -> b
$ TxEvalBudget -> [(Text, TxEvalBudget)]
forall a. a -> [(Text, a)]
singleSample TxEvalBudget
budgetSample

data TxEvalFailure = TxEvalFailure Value
  deriving stock (Int -> TxEvalFailure -> ShowS
[TxEvalFailure] -> ShowS
TxEvalFailure -> String
(Int -> TxEvalFailure -> ShowS)
-> (TxEvalFailure -> String)
-> ([TxEvalFailure] -> ShowS)
-> Show TxEvalFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxEvalFailure -> ShowS
showsPrec :: Int -> TxEvalFailure -> ShowS
$cshow :: TxEvalFailure -> String
show :: TxEvalFailure -> String
$cshowList :: [TxEvalFailure] -> ShowS
showList :: [TxEvalFailure] -> ShowS
Show, TxEvalFailure -> TxEvalFailure -> Bool
(TxEvalFailure -> TxEvalFailure -> Bool)
-> (TxEvalFailure -> TxEvalFailure -> Bool) -> Eq TxEvalFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxEvalFailure -> TxEvalFailure -> Bool
== :: TxEvalFailure -> TxEvalFailure -> Bool
$c/= :: TxEvalFailure -> TxEvalFailure -> Bool
/= :: TxEvalFailure -> TxEvalFailure -> Bool
Eq, (forall x. TxEvalFailure -> Rep TxEvalFailure x)
-> (forall x. Rep TxEvalFailure x -> TxEvalFailure)
-> Generic TxEvalFailure
forall x. Rep TxEvalFailure x -> TxEvalFailure
forall x. TxEvalFailure -> Rep TxEvalFailure x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxEvalFailure -> Rep TxEvalFailure x
from :: forall x. TxEvalFailure -> Rep TxEvalFailure x
$cto :: forall x. Rep TxEvalFailure x -> TxEvalFailure
to :: forall x. Rep TxEvalFailure x -> TxEvalFailure
Generic)
  deriving (Maybe TxEvalFailure
Value -> Parser [TxEvalFailure]
Value -> Parser TxEvalFailure
(Value -> Parser TxEvalFailure)
-> (Value -> Parser [TxEvalFailure])
-> Maybe TxEvalFailure
-> FromJSON TxEvalFailure
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TxEvalFailure
parseJSON :: Value -> Parser TxEvalFailure
$cparseJSONList :: Value -> Parser [TxEvalFailure]
parseJSONList :: Value -> Parser [TxEvalFailure]
$comittedField :: Maybe TxEvalFailure
omittedField :: Maybe TxEvalFailure
FromJSON, [TxEvalFailure] -> Value
[TxEvalFailure] -> Encoding
TxEvalFailure -> Bool
TxEvalFailure -> Value
TxEvalFailure -> Encoding
(TxEvalFailure -> Value)
-> (TxEvalFailure -> Encoding)
-> ([TxEvalFailure] -> Value)
-> ([TxEvalFailure] -> Encoding)
-> (TxEvalFailure -> Bool)
-> ToJSON TxEvalFailure
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TxEvalFailure -> Value
toJSON :: TxEvalFailure -> Value
$ctoEncoding :: TxEvalFailure -> Encoding
toEncoding :: TxEvalFailure -> Encoding
$ctoJSONList :: [TxEvalFailure] -> Value
toJSONList :: [TxEvalFailure] -> Value
$ctoEncodingList :: [TxEvalFailure] -> Encoding
toEncodingList :: [TxEvalFailure] -> Encoding
$comitField :: TxEvalFailure -> Bool
omitField :: TxEvalFailure -> Bool
ToJSON)

-- | Transaction evaluation result wrapper
newtype TxEval = TxEval
  { TxEval -> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)
_txEvalResult ::
      Either
        TxEvalFailure
        (Map
          TxEvalValidator
          TxEvalBudget)
  }
  deriving stock (Int -> TxEval -> ShowS
[TxEval] -> ShowS
TxEval -> String
(Int -> TxEval -> ShowS)
-> (TxEval -> String) -> ([TxEval] -> ShowS) -> Show TxEval
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxEval -> ShowS
showsPrec :: Int -> TxEval -> ShowS
$cshow :: TxEval -> String
show :: TxEval -> String
$cshowList :: [TxEval] -> ShowS
showList :: [TxEval] -> ShowS
Show, TxEval -> TxEval -> Bool
(TxEval -> TxEval -> Bool)
-> (TxEval -> TxEval -> Bool) -> Eq TxEval
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxEval -> TxEval -> Bool
== :: TxEval -> TxEval -> Bool
$c/= :: TxEval -> TxEval -> Bool
/= :: TxEval -> TxEval -> Bool
Eq, (forall x. TxEval -> Rep TxEval x)
-> (forall x. Rep TxEval x -> TxEval) -> Generic TxEval
forall x. Rep TxEval x -> TxEval
forall x. TxEval -> Rep TxEval x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxEval -> Rep TxEval x
from :: forall x. TxEval -> Rep TxEval x
$cto :: forall x. Rep TxEval x -> TxEval
to :: forall x. Rep TxEval x -> TxEval
Generic)

instance ToJSON TxEval where
  toJSON :: TxEval -> Value
toJSON TxEval{Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)
_txEvalResult :: TxEval -> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)
_txEvalResult :: Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)
..} =
    [Pair] -> Value
object
      [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"jsonwsp/response" :: Text)
      , Key
"version" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"1.0" :: Text)
      , Key
"servicename" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"ogmios" :: Text)
      , Key
"methodname" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"EvaluateTx" :: Text)
      , Key
"result" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Either TxEvalFailure (Map TxEvalValidator TxEvalBudget) -> Value
forall a. ToJSON a => a -> Value
toJSON Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)
_txEvalResult
      ]

instance FromJSON TxEval where
  parseJSON :: Value -> Parser TxEval
parseJSON = String -> (Object -> Parser TxEval) -> Value -> Parser TxEval
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"txEval" ((Object -> Parser TxEval) -> Value -> Parser TxEval)
-> (Object -> Parser TxEval) -> Value -> Parser TxEval
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Object
r <- Object
o Object -> Key -> Parser Object
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result"
    Maybe Value
mEvalResult <- Object
r Object -> Key -> Parser (Maybe Value)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"EvaluationResult"
    case Maybe Value
mEvalResult of
      Maybe Value
Nothing -> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget) -> TxEval
TxEval (Either TxEvalFailure (Map TxEvalValidator TxEvalBudget) -> TxEval)
-> (Value
    -> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget))
-> Value
-> TxEval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TxEvalFailure
-> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)
forall a b. a -> Either a b
Left (TxEvalFailure
 -> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget))
-> (Value -> TxEvalFailure)
-> Value
-> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> TxEvalFailure
TxEvalFailure (Value -> TxEval) -> Parser Value -> Parser TxEval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
r Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"EvaluationFailure"
      Just Value
evalRes -> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget) -> TxEval
TxEval (Either TxEvalFailure (Map TxEvalValidator TxEvalBudget) -> TxEval)
-> (Map TxEvalValidator TxEvalBudget
    -> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget))
-> Map TxEvalValidator TxEvalBudget
-> TxEval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxEvalValidator TxEvalBudget
-> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)
forall a b. b -> Either a b
Right (Map TxEvalValidator TxEvalBudget -> TxEval)
-> Parser (Map TxEvalValidator TxEvalBudget) -> Parser TxEval
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser (Map TxEvalValidator TxEvalBudget)
forall a. FromJSON a => Value -> Parser a
parseJSON Value
evalRes

evalSample :: TxEval
evalSample :: TxEval
evalSample =
  Either TxEvalFailure (Map TxEvalValidator TxEvalBudget) -> TxEval
TxEval
    (Either TxEvalFailure (Map TxEvalValidator TxEvalBudget) -> TxEval)
-> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)
-> TxEval
forall a b. (a -> b) -> a -> b
$ Map TxEvalValidator TxEvalBudget
-> Either TxEvalFailure (Map TxEvalValidator TxEvalBudget)
forall a b. b -> Either a b
Right
        ([(TxEvalValidator, TxEvalBudget)]
-> Map TxEvalValidator TxEvalBudget
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.Strict.fromList
          [(TxEvalValidator
validatorSample, TxEvalBudget
budgetSample)]
        )

instance ToSample TxEval where
  toSamples :: Proxy TxEval -> [(Text, TxEval)]
toSamples = [(Text, TxEval)] -> Proxy TxEval -> [(Text, TxEval)]
forall a. a -> Proxy TxEval -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, TxEval)] -> Proxy TxEval -> [(Text, TxEval)])
-> [(Text, TxEval)] -> Proxy TxEval -> [(Text, TxEval)]
forall a b. (a -> b) -> a -> b
$ TxEval -> [(Text, TxEval)]
forall a. a -> [(Text, a)]
singleSample TxEval
evalSample

data LowerLeading
instance StringModifier LowerLeading where
  getStringModifier :: ShowS
getStringModifier String
"" = String
""
  getStringModifier (Char
c:String
xs) = Char -> Char
Data.Char.toLower Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: String
xs

-- | Transaction evaluation input for UTXO variant
data TxEvalInput = TxEvalInput
  { TxEvalInput -> CBORString
_txEvalInputCbor              :: CBORString  -- ^ CBOR encoded transaction
  , TxEvalInput -> Value
_txEvalInputAdditionalUtxoSet :: Value -- ^ Additional UTXO set as JSON @Value@
  }
  deriving stock (Int -> TxEvalInput -> ShowS
[TxEvalInput] -> ShowS
TxEvalInput -> String
(Int -> TxEvalInput -> ShowS)
-> (TxEvalInput -> String)
-> ([TxEvalInput] -> ShowS)
-> Show TxEvalInput
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TxEvalInput -> ShowS
showsPrec :: Int -> TxEvalInput -> ShowS
$cshow :: TxEvalInput -> String
show :: TxEvalInput -> String
$cshowList :: [TxEvalInput] -> ShowS
showList :: [TxEvalInput] -> ShowS
Show, TxEvalInput -> TxEvalInput -> Bool
(TxEvalInput -> TxEvalInput -> Bool)
-> (TxEvalInput -> TxEvalInput -> Bool) -> Eq TxEvalInput
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TxEvalInput -> TxEvalInput -> Bool
== :: TxEvalInput -> TxEvalInput -> Bool
$c/= :: TxEvalInput -> TxEvalInput -> Bool
/= :: TxEvalInput -> TxEvalInput -> Bool
Eq, (forall x. TxEvalInput -> Rep TxEvalInput x)
-> (forall x. Rep TxEvalInput x -> TxEvalInput)
-> Generic TxEvalInput
forall x. Rep TxEvalInput x -> TxEvalInput
forall x. TxEvalInput -> Rep TxEvalInput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. TxEvalInput -> Rep TxEvalInput x
from :: forall x. TxEvalInput -> Rep TxEvalInput x
$cto :: forall x. Rep TxEvalInput x -> TxEvalInput
to :: forall x. Rep TxEvalInput x -> TxEvalInput
Generic)
  deriving (Maybe TxEvalInput
Value -> Parser [TxEvalInput]
Value -> Parser TxEvalInput
(Value -> Parser TxEvalInput)
-> (Value -> Parser [TxEvalInput])
-> Maybe TxEvalInput
-> FromJSON TxEvalInput
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser TxEvalInput
parseJSON :: Value -> Parser TxEvalInput
$cparseJSONList :: Value -> Parser [TxEvalInput]
parseJSONList :: Value -> Parser [TxEvalInput]
$comittedField :: Maybe TxEvalInput
omittedField :: Maybe TxEvalInput
FromJSON, [TxEvalInput] -> Value
[TxEvalInput] -> Encoding
TxEvalInput -> Bool
TxEvalInput -> Value
TxEvalInput -> Encoding
(TxEvalInput -> Value)
-> (TxEvalInput -> Encoding)
-> ([TxEvalInput] -> Value)
-> ([TxEvalInput] -> Encoding)
-> (TxEvalInput -> Bool)
-> ToJSON TxEvalInput
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: TxEvalInput -> Value
toJSON :: TxEvalInput -> Value
$ctoEncoding :: TxEvalInput -> Encoding
toEncoding :: TxEvalInput -> Encoding
$ctoJSONList :: [TxEvalInput] -> Value
toJSONList :: [TxEvalInput] -> Value
$ctoEncodingList :: [TxEvalInput] -> Encoding
toEncodingList :: [TxEvalInput] -> Encoding
$comitField :: TxEvalInput -> Bool
omitField :: TxEvalInput -> Bool
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_txEvalInput", LowerLeading]] TxEvalInput

instance ToSample TxEvalInput where
  toSamples :: Proxy TxEvalInput -> [(Text, TxEvalInput)]
toSamples = [(Text, TxEvalInput)] -> Proxy TxEvalInput -> [(Text, TxEvalInput)]
forall a. a -> Proxy TxEvalInput -> a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, TxEvalInput)]
 -> Proxy TxEvalInput -> [(Text, TxEvalInput)])
-> [(Text, TxEvalInput)]
-> Proxy TxEvalInput
-> [(Text, TxEvalInput)]
forall a b. (a -> b) -> a -> b
$ TxEvalInput -> [(Text, TxEvalInput)]
forall a. a -> [(Text, a)]
singleSample
    TxEvalInput
      { _txEvalInputCbor :: CBORString
_txEvalInputCbor              = ByteString -> CBORString
CBORString ByteString
"83a40081825820daa9"
      , _txEvalInputAdditionalUtxoSet :: Value
_txEvalInputAdditionalUtxoSet = Array -> Value
Array Array
forall a. Monoid a => a
mempty
      }