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

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

import Data.Aeson
  ( FromJSON (..)
  , ToJSON (..)
  , Value (Array)
  , object
  , withObject
  , (.:)
  , (.:?)
  , (.=)
  )

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

-- | 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DerivedAddress] -> ShowS
$cshowList :: [DerivedAddress] -> ShowS
show :: DerivedAddress -> String
$cshow :: DerivedAddress -> String
showsPrec :: Int -> DerivedAddress -> ShowS
$cshowsPrec :: Int -> DerivedAddress -> ShowS
Show, DerivedAddress -> DerivedAddress -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DerivedAddress -> DerivedAddress -> Bool
$c/= :: DerivedAddress -> DerivedAddress -> Bool
== :: DerivedAddress -> DerivedAddress -> Bool
$c== :: DerivedAddress -> DerivedAddress -> Bool
Eq, 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
$cto :: forall x. Rep DerivedAddress x -> DerivedAddress
$cfrom :: forall x. DerivedAddress -> Rep DerivedAddress x
Generic)
  deriving (Maybe DerivedAddress
Value -> Parser [DerivedAddress]
Value -> Parser DerivedAddress
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe DerivedAddress
$comittedField :: Maybe DerivedAddress
parseJSONList :: Value -> Parser [DerivedAddress]
$cparseJSONList :: Value -> Parser [DerivedAddress]
parseJSON :: Value -> Parser DerivedAddress
$cparseJSON :: Value -> Parser DerivedAddress
FromJSON, [DerivedAddress] -> Encoding
[DerivedAddress] -> Value
DerivedAddress -> Bool
DerivedAddress -> Encoding
DerivedAddress -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: DerivedAddress -> Bool
$comitField :: DerivedAddress -> Bool
toEncodingList :: [DerivedAddress] -> Encoding
$ctoEncodingList :: [DerivedAddress] -> Encoding
toJSONList :: [DerivedAddress] -> Value
$ctoJSONList :: [DerivedAddress] -> Value
toEncoding :: DerivedAddress -> Encoding
$ctoEncoding :: DerivedAddress -> Encoding
toJSON :: DerivedAddress -> Value
$ctoJSON :: DerivedAddress -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_derivedAddress", CamelToSnake]] DerivedAddress

instance ToSample DerivedAddress where
  toSamples :: Proxy DerivedAddress -> [(Text, DerivedAddress)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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"
      }

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

instance ToSample TxEvalBudget where
  toSamples :: Proxy TxEvalBudget -> [(Text, TxEvalBudget)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> [(Text, a)]
singleSample
    TxEvalBudget
      { _txEvalBudgetMemory :: Integer
_txEvalBudgetMemory = Integer
1700
      , _txEvalBudgetCPU :: Integer
_txEvalBudgetCPU    = Integer
476468
      }

-- | Transaction evaluation result
data TxEvalResult = TxEvalResult
  { TxEvalResult -> Text
_txEvalResultValidator :: Text         -- ^ Redeemer pointer
  , TxEvalResult -> TxEvalBudget
_txEvalResultBudget    :: TxEvalBudget -- ^ Budget
  }
  deriving stock (Int -> TxEvalResult -> ShowS
[TxEvalResult] -> ShowS
TxEvalResult -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxEvalResult] -> ShowS
$cshowList :: [TxEvalResult] -> ShowS
show :: TxEvalResult -> String
$cshow :: TxEvalResult -> String
showsPrec :: Int -> TxEvalResult -> ShowS
$cshowsPrec :: Int -> TxEvalResult -> ShowS
Show, TxEvalResult -> TxEvalResult -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxEvalResult -> TxEvalResult -> Bool
$c/= :: TxEvalResult -> TxEvalResult -> Bool
== :: TxEvalResult -> TxEvalResult -> Bool
$c== :: TxEvalResult -> TxEvalResult -> Bool
Eq, forall x. Rep TxEvalResult x -> TxEvalResult
forall x. TxEvalResult -> Rep TxEvalResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxEvalResult x -> TxEvalResult
$cfrom :: forall x. TxEvalResult -> Rep TxEvalResult x
Generic)
  deriving (Maybe TxEvalResult
Value -> Parser [TxEvalResult]
Value -> Parser TxEvalResult
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe TxEvalResult
$comittedField :: Maybe TxEvalResult
parseJSONList :: Value -> Parser [TxEvalResult]
$cparseJSONList :: Value -> Parser [TxEvalResult]
parseJSON :: Value -> Parser TxEvalResult
$cparseJSON :: Value -> Parser TxEvalResult
FromJSON, [TxEvalResult] -> Encoding
[TxEvalResult] -> Value
TxEvalResult -> Bool
TxEvalResult -> Encoding
TxEvalResult -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: TxEvalResult -> Bool
$comitField :: TxEvalResult -> Bool
toEncodingList :: [TxEvalResult] -> Encoding
$ctoEncodingList :: [TxEvalResult] -> Encoding
toJSONList :: [TxEvalResult] -> Value
$ctoJSONList :: [TxEvalResult] -> Value
toEncoding :: TxEvalResult -> Encoding
$ctoEncoding :: TxEvalResult -> Encoding
toJSON :: TxEvalResult -> Value
$ctoJSON :: TxEvalResult -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_txEvalResult", CamelToSnake]] TxEvalResult

resultSample :: TxEvalResult
resultSample :: TxEvalResult
resultSample =
  TxEvalResult
    { _txEvalResultValidator :: Text
_txEvalResultValidator = Text
"spend:0"
    , _txEvalResultBudget :: TxEvalBudget
_txEvalResultBudget =
        TxEvalBudget
          { _txEvalBudgetMemory :: Integer
_txEvalBudgetMemory = Integer
1700
          , _txEvalBudgetCPU :: Integer
_txEvalBudgetCPU    = Integer
476468
          }
    }

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

-- | Transaction evaluation result wrapper
newtype TxEval = TxEval { TxEval -> [TxEvalResult]
_txEvalResult :: [TxEvalResult] }
  deriving stock (Int -> TxEval -> ShowS
[TxEval] -> ShowS
TxEval -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxEval] -> ShowS
$cshowList :: [TxEval] -> ShowS
show :: TxEval -> String
$cshow :: TxEval -> String
showsPrec :: Int -> TxEval -> ShowS
$cshowsPrec :: Int -> TxEval -> ShowS
Show, TxEval -> TxEval -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxEval -> TxEval -> Bool
$c/= :: TxEval -> TxEval -> Bool
== :: TxEval -> TxEval -> Bool
$c== :: TxEval -> TxEval -> Bool
Eq, 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
$cto :: forall x. Rep TxEval x -> TxEval
$cfrom :: forall x. TxEval -> Rep TxEval x
Generic)

instance ToJSON TxEval where
  toJSON :: TxEval -> Value
toJSON TxEval{[TxEvalResult]
_txEvalResult :: [TxEvalResult]
_txEvalResult :: TxEval -> [TxEvalResult]
..} =
    [Pair] -> Value
object
      [ Key
"jsonrpc" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"2.0" :: Text)
      , Key
"method" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"evaluateTransaction" :: Text)
      , Key
"result" forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= forall a. ToJSON a => a -> Value
toJSON [TxEvalResult]
_txEvalResult
      ]

instance FromJSON TxEval where
  parseJSON :: Value -> Parser TxEval
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"txEval" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    (Maybe Value
mErr :: Maybe Value) <- Object
o forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"error"
    case Maybe Value
mErr of
      Just Value
err -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show Value
err
      Maybe Value
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

    Value
r <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"result"
    [TxEvalResult] -> TxEval
TxEval forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON Value
r

evalSample :: TxEval
evalSample :: TxEval
evalSample = [TxEvalResult] -> TxEval
TxEval (forall (f :: * -> *) a. Applicative f => a -> f a
pure TxEvalResult
resultSample)

instance ToSample TxEval where
  toSamples :: Proxy TxEval -> [(Text, TxEval)]
toSamples = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ 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 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxEvalInput] -> ShowS
$cshowList :: [TxEvalInput] -> ShowS
show :: TxEvalInput -> String
$cshow :: TxEvalInput -> String
showsPrec :: Int -> TxEvalInput -> ShowS
$cshowsPrec :: Int -> TxEvalInput -> ShowS
Show, TxEvalInput -> TxEvalInput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxEvalInput -> TxEvalInput -> Bool
$c/= :: TxEvalInput -> TxEvalInput -> Bool
== :: TxEvalInput -> TxEvalInput -> Bool
$c== :: TxEvalInput -> TxEvalInput -> Bool
Eq, 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
$cto :: forall x. Rep TxEvalInput x -> TxEvalInput
$cfrom :: forall x. TxEvalInput -> Rep TxEvalInput x
Generic)
  deriving (Maybe TxEvalInput
Value -> Parser [TxEvalInput]
Value -> Parser TxEvalInput
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
omittedField :: Maybe TxEvalInput
$comittedField :: Maybe TxEvalInput
parseJSONList :: Value -> Parser [TxEvalInput]
$cparseJSONList :: Value -> Parser [TxEvalInput]
parseJSON :: Value -> Parser TxEvalInput
$cparseJSON :: Value -> Parser TxEvalInput
FromJSON, [TxEvalInput] -> Encoding
[TxEvalInput] -> Value
TxEvalInput -> Bool
TxEvalInput -> Encoding
TxEvalInput -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
omitField :: TxEvalInput -> Bool
$comitField :: TxEvalInput -> Bool
toEncodingList :: [TxEvalInput] -> Encoding
$ctoEncodingList :: [TxEvalInput] -> Encoding
toJSONList :: [TxEvalInput] -> Value
$ctoJSONList :: [TxEvalInput] -> Value
toEncoding :: TxEvalInput -> Encoding
$ctoEncoding :: TxEvalInput -> Encoding
toJSON :: TxEvalInput -> Value
$ctoJSON :: TxEvalInput -> Value
ToJSON)
  via CustomJSON '[FieldLabelModifier '[StripPrefix "_txEvalInput", LowerLeading]] TxEvalInput

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