{-# LANGUAGE DeriveAnyClass    #-}
{-# LANGUAGE DerivingVia       #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE LambdaCase        #-}
{-# LANGUAGE NamedFieldPuns    #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE Strict            #-}
{-# LANGUAGE TemplateHaskell   #-}
{-# LANGUAGE TypeApplications  #-}

{-# OPTIONS_GHC -Wno-orphans #-}

{-| Misc. types used in this package
-}
module Plutus.ChainIndex.Types(
    ChainIndexTx(..)
    , ChainIndexTxOutputs(..)
    , ChainIndexTxOut(..)
    , ReferenceScript(..)
    , BlockId(..)
    , blockId
    , Tip(..)
    , Point(..)
    , pointsToTip
    , tipAsPoint
    , _PointAtGenesis
    , _Point
    , TxValidity(..)
    , TxStatus
    , TxOutStatus
    , RollbackState(..)
    , TxOutState(..)
    , liftTxOutStatus
    , txOutStatusTxOutState
    , BlockNumber(..)
    , Depth(..)
    , Diagnostics(..)
    , TxConfirmedState(..)
    , TxStatusFailure(..)
    , TxIdState(..)
    , TxUtxoBalance(..)
    , tubUnspentOutputs
    , tubUnmatchedSpentInputs
    , TxOutBalance(..)
    , tobUnspentOutputs
    , tobSpentOutputs
    , ChainSyncBlock(..)
    , TxProcessOption(..)
    -- ** Lenses
    , citxTxId
    , citxInputs
    , citxOutputs
    , citxValidRange
    , citxData
    , citxRedeemers
    , citxScripts
    , citxCardanoTx
    , _InvalidTx
    , _ValidTx
    , fromReferenceScript
    ) where

import Cardano.Api qualified as C
import Codec.Serialise (Serialise)
import Codec.Serialise qualified as CBOR
import Codec.Serialise.Class (Serialise (decode, encode))
import Codec.Serialise.Decoding (decodeListLen, decodeWord)
import Codec.Serialise.Encoding (encodeListLen, encodeWord)
import Control.Lens (makeLenses, makePrisms, (&), (.~), (?~))
import Control.Monad (void)
import Crypto.Hash (SHA256, hash)
import Data.Aeson (FromJSON (parseJSON), ToJSON (toJSON), object, (.!=), (.:), (.:?), (.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.KeyMap qualified as Aeson
import Data.ByteArray qualified as BA
import Data.ByteString.Lazy qualified as BSL
import Data.Default (Default (..))
import Data.HashMap.Strict.InsOrd qualified as InsOrdMap
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Monoid (Last (..), Sum (..))
import Data.OpenApi (NamedSchema (NamedSchema), OpenApiType (OpenApiObject), byteSchema, declareSchemaRef, properties,
                     required, sketchSchema, type_)
import Data.OpenApi qualified as OpenApi
import Data.Semigroup.Generic (GenericSemigroupMonoid (..))
import Data.Set (Set)
import Data.Set qualified as Set
import Data.Typeable (Proxy (Proxy), Typeable)
import Data.Word (Word64)
import GHC.Generics (Generic)
import Ledger (CardanoAddress, CardanoTx, Language, SlotRange, TxIn (..), TxInType (..), TxOutRef (..), Versioned,
               toPlutusAddress)
import Ledger.Blockchain (BlockId (..))
import Ledger.Blockchain qualified as Ledger
import Ledger.Slot (Slot (Slot))
import Ledger.Tx.CardanoAPI (fromCardanoScriptInAnyLang)
import Plutus.V1.Ledger.Scripts (Datum (Datum), DatumHash (DatumHash), Script, ScriptHash (..))
import Plutus.V1.Ledger.Tx (RedeemerPtr, Redeemers, ScriptTag, TxId (TxId))
import Plutus.V2.Ledger.Api (CurrencySymbol (CurrencySymbol), Extended, Interval (..), LowerBound, OutputDatum (..),
                             Redeemer (Redeemer), TokenName (TokenName), UpperBound, Validator (Validator), Value (..))
import PlutusCore.Data
import PlutusTx.AssocMap qualified as AssocMap
import PlutusTx.Builtins.Internal (BuiltinData (..))
import PlutusTx.Lattice (MeetSemiLattice (..))
import PlutusTx.Prelude qualified as PlutusTx
import Prettyprinter
import Prettyprinter.Extras (PrettyShow (..))

data ReferenceScript = ReferenceScriptNone | ReferenceScriptInAnyLang C.ScriptInAnyLang
  deriving (ReferenceScript -> ReferenceScript -> Bool
(ReferenceScript -> ReferenceScript -> Bool)
-> (ReferenceScript -> ReferenceScript -> Bool)
-> Eq ReferenceScript
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReferenceScript -> ReferenceScript -> Bool
$c/= :: ReferenceScript -> ReferenceScript -> Bool
== :: ReferenceScript -> ReferenceScript -> Bool
$c== :: ReferenceScript -> ReferenceScript -> Bool
Eq, Int -> ReferenceScript -> ShowS
[ReferenceScript] -> ShowS
ReferenceScript -> String
(Int -> ReferenceScript -> ShowS)
-> (ReferenceScript -> String)
-> ([ReferenceScript] -> ShowS)
-> Show ReferenceScript
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReferenceScript] -> ShowS
$cshowList :: [ReferenceScript] -> ShowS
show :: ReferenceScript -> String
$cshow :: ReferenceScript -> String
showsPrec :: Int -> ReferenceScript -> ShowS
$cshowsPrec :: Int -> ReferenceScript -> ShowS
Show, (forall x. ReferenceScript -> Rep ReferenceScript x)
-> (forall x. Rep ReferenceScript x -> ReferenceScript)
-> Generic ReferenceScript
forall x. Rep ReferenceScript x -> ReferenceScript
forall x. ReferenceScript -> Rep ReferenceScript x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReferenceScript x -> ReferenceScript
$cfrom :: forall x. ReferenceScript -> Rep ReferenceScript x
Generic, [ReferenceScript] -> Encoding
ReferenceScript -> Encoding
(ReferenceScript -> Encoding)
-> (forall s. Decoder s ReferenceScript)
-> ([ReferenceScript] -> Encoding)
-> (forall s. Decoder s [ReferenceScript])
-> Serialise ReferenceScript
forall s. Decoder s [ReferenceScript]
forall s. Decoder s ReferenceScript
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [ReferenceScript]
$cdecodeList :: forall s. Decoder s [ReferenceScript]
encodeList :: [ReferenceScript] -> Encoding
$cencodeList :: [ReferenceScript] -> Encoding
decode :: Decoder s ReferenceScript
$cdecode :: forall s. Decoder s ReferenceScript
encode :: ReferenceScript -> Encoding
$cencode :: ReferenceScript -> Encoding
Serialise, Typeable ReferenceScript
Typeable ReferenceScript
-> (Proxy ReferenceScript
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ReferenceScript
Proxy ReferenceScript -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy ReferenceScript -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy ReferenceScript -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable ReferenceScript
OpenApi.ToSchema)

instance ToJSON ReferenceScript where
  toJSON :: ReferenceScript -> Value
toJSON (ReferenceScriptInAnyLang ScriptInAnyLang
s) = [Pair] -> Value
object [Key
"referenceScript" Key -> ScriptInAnyLang -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ScriptInAnyLang
s]
  toJSON ReferenceScript
ReferenceScriptNone          = Value
Aeson.Null

instance FromJSON ReferenceScript where
  parseJSON :: Value -> Parser ReferenceScript
parseJSON = String
-> (Object -> Parser ReferenceScript)
-> Value
-> Parser ReferenceScript
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ReferenceScript" ((Object -> Parser ReferenceScript)
 -> Value -> Parser ReferenceScript)
-> (Object -> Parser ReferenceScript)
-> Value
-> Parser ReferenceScript
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    case Key -> Object -> Maybe Value
forall v. Key -> KeyMap v -> Maybe v
Aeson.lookup Key
"referenceScript" Object
o of
      Maybe Value
Nothing        -> ReferenceScript -> Parser ReferenceScript
forall (f :: * -> *) a. Applicative f => a -> f a
pure ReferenceScript
ReferenceScriptNone
      Just Value
refScript -> ScriptInAnyLang -> ReferenceScript
ReferenceScriptInAnyLang (ScriptInAnyLang -> ReferenceScript)
-> Parser ScriptInAnyLang -> Parser ReferenceScript
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ScriptInAnyLang
forall a. FromJSON a => Value -> Parser a
parseJSON Value
refScript

instance Serialise C.ScriptInAnyLang where
    encode :: ScriptInAnyLang -> Encoding
encode (C.ScriptInAnyLang ScriptLanguage lang
lang Script lang
script) =
        let
            -- Since lang is a GADT we have to encode the script in all branches
            other :: Encoding
other = case ScriptLanguage lang
lang of
                C.SimpleScriptLanguage SimpleScriptVersion lang
C.SimpleScriptV1 -> Word -> Encoding
encodeWord Word
0 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. Serialise a => a -> Encoding
encode (Script lang -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR Script lang
script)
                C.SimpleScriptLanguage SimpleScriptVersion lang
C.SimpleScriptV2 -> Word -> Encoding
encodeWord Word
1 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. Serialise a => a -> Encoding
encode (Script lang -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR Script lang
script)
                C.PlutusScriptLanguage PlutusScriptVersion lang
C.PlutusScriptV1 -> Word -> Encoding
encodeWord Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. Serialise a => a -> Encoding
encode (Script lang -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR Script lang
script)
                C.PlutusScriptLanguage PlutusScriptVersion lang
C.PlutusScriptV2 -> Word -> Encoding
encodeWord Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
forall a. Serialise a => a -> Encoding
encode (Script lang -> ByteString
forall a. SerialiseAsCBOR a => a -> ByteString
C.serialiseToCBOR Script lang
script)
        in Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Encoding
other
    decode :: Decoder s ScriptInAnyLang
decode = do
        Int
len <- Decoder s Int
forall s. Decoder s Int
decodeListLen
        Word
langWord <- Decoder s Word
forall s. Decoder s Word
decodeWord
        ByteString
script <- Decoder s ByteString
forall a s. Serialise a => Decoder s a
decode
        case (Int
len, Word
langWord) of
            (Int
2, Word
0) -> do
                let decoded :: Script SimpleScriptV1
decoded = (DecoderError -> Script SimpleScriptV1)
-> (Script SimpleScriptV1 -> Script SimpleScriptV1)
-> Either DecoderError (Script SimpleScriptV1)
-> Script SimpleScriptV1
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> DecoderError -> Script SimpleScriptV1
forall a. HasCallStack => String -> a
error String
"Failed to deserialise AsSimpleScriptV1 from CBOR ") Script SimpleScriptV1 -> Script SimpleScriptV1
forall a. a -> a
id (AsType (Script SimpleScriptV1)
-> ByteString -> Either DecoderError (Script SimpleScriptV1)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
C.deserialiseFromCBOR (AsType SimpleScriptV1 -> AsType (Script SimpleScriptV1)
forall lang. AsType lang -> AsType (Script lang)
C.AsScript AsType SimpleScriptV1
C.AsSimpleScriptV1) ByteString
script)
                ScriptInAnyLang -> Decoder s ScriptInAnyLang
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptInAnyLang -> Decoder s ScriptInAnyLang)
-> ScriptInAnyLang -> Decoder s ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ ScriptLanguage SimpleScriptV1
-> Script SimpleScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
C.ScriptInAnyLang (SimpleScriptVersion SimpleScriptV1 -> ScriptLanguage SimpleScriptV1
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
C.SimpleScriptLanguage SimpleScriptVersion SimpleScriptV1
C.SimpleScriptV1) Script SimpleScriptV1
decoded
            (Int
2, Word
1) -> do
                let decoded :: Script SimpleScriptV2
decoded = (DecoderError -> Script SimpleScriptV2)
-> (Script SimpleScriptV2 -> Script SimpleScriptV2)
-> Either DecoderError (Script SimpleScriptV2)
-> Script SimpleScriptV2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> DecoderError -> Script SimpleScriptV2
forall a. HasCallStack => String -> a
error String
"Failed to deserialise AsSimpleScriptV2 from CBOR ") Script SimpleScriptV2 -> Script SimpleScriptV2
forall a. a -> a
id (AsType (Script SimpleScriptV2)
-> ByteString -> Either DecoderError (Script SimpleScriptV2)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
C.deserialiseFromCBOR (AsType SimpleScriptV2 -> AsType (Script SimpleScriptV2)
forall lang. AsType lang -> AsType (Script lang)
C.AsScript AsType SimpleScriptV2
C.AsSimpleScriptV2) ByteString
script)
                ScriptInAnyLang -> Decoder s ScriptInAnyLang
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptInAnyLang -> Decoder s ScriptInAnyLang)
-> ScriptInAnyLang -> Decoder s ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ ScriptLanguage SimpleScriptV2
-> Script SimpleScriptV2 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
C.ScriptInAnyLang (SimpleScriptVersion SimpleScriptV2 -> ScriptLanguage SimpleScriptV2
forall lang. SimpleScriptVersion lang -> ScriptLanguage lang
C.SimpleScriptLanguage SimpleScriptVersion SimpleScriptV2
C.SimpleScriptV2) Script SimpleScriptV2
decoded
            (Int
2, Word
2) -> do
                let decoded :: Script PlutusScriptV1
decoded = (DecoderError -> Script PlutusScriptV1)
-> (Script PlutusScriptV1 -> Script PlutusScriptV1)
-> Either DecoderError (Script PlutusScriptV1)
-> Script PlutusScriptV1
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> DecoderError -> Script PlutusScriptV1
forall a. HasCallStack => String -> a
error String
"Failed to deserialise AsPlutusScriptV1 from CBOR ") Script PlutusScriptV1 -> Script PlutusScriptV1
forall a. a -> a
id (AsType (Script PlutusScriptV1)
-> ByteString -> Either DecoderError (Script PlutusScriptV1)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
C.deserialiseFromCBOR (AsType PlutusScriptV1 -> AsType (Script PlutusScriptV1)
forall lang. AsType lang -> AsType (Script lang)
C.AsScript AsType PlutusScriptV1
C.AsPlutusScriptV1) ByteString
script)
                ScriptInAnyLang -> Decoder s ScriptInAnyLang
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptInAnyLang -> Decoder s ScriptInAnyLang)
-> ScriptInAnyLang -> Decoder s ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ ScriptLanguage PlutusScriptV1
-> Script PlutusScriptV1 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
C.ScriptInAnyLang (PlutusScriptVersion PlutusScriptV1 -> ScriptLanguage PlutusScriptV1
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
C.PlutusScriptLanguage PlutusScriptVersion PlutusScriptV1
C.PlutusScriptV1) Script PlutusScriptV1
decoded
            (Int
2, Word
3) -> do
                let decoded :: Script PlutusScriptV2
decoded = (DecoderError -> Script PlutusScriptV2)
-> (Script PlutusScriptV2 -> Script PlutusScriptV2)
-> Either DecoderError (Script PlutusScriptV2)
-> Script PlutusScriptV2
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> DecoderError -> Script PlutusScriptV2
forall a. HasCallStack => String -> a
error String
"Failed to deserialise AsPlutusScriptV2 from CBOR ") Script PlutusScriptV2 -> Script PlutusScriptV2
forall a. a -> a
id (AsType (Script PlutusScriptV2)
-> ByteString -> Either DecoderError (Script PlutusScriptV2)
forall a.
SerialiseAsCBOR a =>
AsType a -> ByteString -> Either DecoderError a
C.deserialiseFromCBOR (AsType PlutusScriptV2 -> AsType (Script PlutusScriptV2)
forall lang. AsType lang -> AsType (Script lang)
C.AsScript AsType PlutusScriptV2
C.AsPlutusScriptV2) ByteString
script)
                ScriptInAnyLang -> Decoder s ScriptInAnyLang
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ScriptInAnyLang -> Decoder s ScriptInAnyLang)
-> ScriptInAnyLang -> Decoder s ScriptInAnyLang
forall a b. (a -> b) -> a -> b
$ ScriptLanguage PlutusScriptV2
-> Script PlutusScriptV2 -> ScriptInAnyLang
forall lang. ScriptLanguage lang -> Script lang -> ScriptInAnyLang
C.ScriptInAnyLang (PlutusScriptVersion PlutusScriptV2 -> ScriptLanguage PlutusScriptV2
forall lang. PlutusScriptVersion lang -> ScriptLanguage lang
C.PlutusScriptLanguage PlutusScriptVersion PlutusScriptV2
C.PlutusScriptV2) Script PlutusScriptV2
decoded
            (Int, Word)
_ -> String -> Decoder s ScriptInAnyLang
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid ScriptInAnyLang encoding"

instance OpenApi.ToSchema C.ScriptInAnyLang where
    declareNamedSchema :: Proxy ScriptInAnyLang -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy ScriptInAnyLang
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
OpenApi.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"ScriptInAnyLang") Schema
forall a. Monoid a => a
mempty

fromReferenceScript :: ReferenceScript -> Maybe (Versioned Script)
fromReferenceScript :: ReferenceScript -> Maybe (Versioned Script)
fromReferenceScript ReferenceScript
ReferenceScriptNone             = Maybe (Versioned Script)
forall a. Maybe a
Nothing
fromReferenceScript (ReferenceScriptInAnyLang ScriptInAnyLang
sial) = ScriptInAnyLang -> Maybe (Versioned Script)
fromCardanoScriptInAnyLang ScriptInAnyLang
sial

instance OpenApi.ToSchema (C.AddressInEra C.BabbageEra) where
    declareNamedSchema :: Proxy (AddressInEra BabbageEra)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (AddressInEra BabbageEra)
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
OpenApi.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"AddressInBabbageEra") Schema
forall a. Monoid a => a
mempty

instance OpenApi.ToSchema Data where
  declareNamedSchema :: Proxy Data -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Data
_ = do
    Referenced Schema
integerSchema <- Proxy Integer -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
OpenApi.declareSchemaRef (Proxy Integer
forall k (t :: k). Proxy t
Proxy :: Proxy Integer)
    Referenced Schema
constrArgsSchema <- Proxy (Integer, [Data])
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
OpenApi.declareSchemaRef (Proxy (Integer, [Data])
forall k (t :: k). Proxy t
Proxy :: Proxy (Integer, [Data]))
    Referenced Schema
mapArgsSchema <- Proxy [(Data, Data)]
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
OpenApi.declareSchemaRef (Proxy [(Data, Data)]
forall k (t :: k). Proxy t
Proxy :: Proxy [(Data, Data)])
    Referenced Schema
listArgsSchema <- Proxy [Data] -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
OpenApi.declareSchemaRef (Proxy [Data]
forall k (t :: k). Proxy t
Proxy :: Proxy [Data])
    Referenced Schema
bytestringSchema <- Proxy String -> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
OpenApi.declareSchemaRef (Proxy String
forall k (t :: k). Proxy t
Proxy :: Proxy String)
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
OpenApi.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Data") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
OpenApi.type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApi.OpenApiObject
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
OpenApi.properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~
          [(Text, Referenced Schema)]
-> InsOrdHashMap Text (Referenced Schema)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdMap.fromList
          [ (Text
"Constr", Referenced Schema
constrArgsSchema)
          , (Text
"Map", Referenced Schema
mapArgsSchema)
          , (Text
"List", Referenced Schema
listArgsSchema)
          , (Text
"I", Referenced Schema
integerSchema)
          , (Text
"B", Referenced Schema
bytestringSchema)
          ]

deriving instance OpenApi.ToSchema BuiltinData

instance OpenApi.ToSchema PlutusTx.BuiltinByteString where
    declareNamedSchema :: Proxy BuiltinByteString -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy BuiltinByteString
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
OpenApi.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Bytes") Schema
forall a. Monoid a => a
mempty

deriving newtype instance OpenApi.ToSchema TokenName
deriving newtype instance OpenApi.ToSchema Value
deriving instance OpenApi.ToSchema a => OpenApi.ToSchema (Extended a)
deriving instance OpenApi.ToSchema a => OpenApi.ToSchema (Interval a)
deriving instance OpenApi.ToSchema a => OpenApi.ToSchema (LowerBound a)
deriving instance OpenApi.ToSchema a => OpenApi.ToSchema (UpperBound a)
deriving instance OpenApi.ToSchema Language
deriving instance OpenApi.ToSchema script => OpenApi.ToSchema (Versioned script)
-- deriving anyclass instance OpenApi.ToSchema C.TxId
deriving newtype instance OpenApi.ToSchema TxId
deriving instance OpenApi.ToSchema ScriptTag
deriving newtype instance OpenApi.ToSchema Validator
deriving instance OpenApi.ToSchema TxInType
deriving instance OpenApi.ToSchema TxIn
deriving newtype instance OpenApi.ToSchema Slot
deriving anyclass instance (OpenApi.ToSchema k, OpenApi.ToSchema v) => OpenApi.ToSchema (AssocMap.Map k v)
deriving anyclass instance OpenApi.ToSchema OutputDatum

instance OpenApi.ToSchema C.Value where
    declareNamedSchema :: Proxy Value -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Value
_ = NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
OpenApi.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Value") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Proxy [(String, Integer)] -> Schema
forall a. ToSchema a => Proxy a -> Schema
OpenApi.toSchema (Proxy [(String, Integer)]
forall k (t :: k). Proxy t
Proxy @[(String, Integer)])

data ChainIndexTxOut = ChainIndexTxOut
  { ChainIndexTxOut -> AddressInEra BabbageEra
citoAddress   :: CardanoAddress -- ^ We can't use AddressInAnyEra here because of missing FromJson instance for Byron era
  , ChainIndexTxOut -> Value
citoValue     :: C.Value
  , ChainIndexTxOut -> OutputDatum
citoDatum     :: OutputDatum
  , ChainIndexTxOut -> ReferenceScript
citoRefScript :: ReferenceScript
  } deriving (ChainIndexTxOut -> ChainIndexTxOut -> Bool
(ChainIndexTxOut -> ChainIndexTxOut -> Bool)
-> (ChainIndexTxOut -> ChainIndexTxOut -> Bool)
-> Eq ChainIndexTxOut
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainIndexTxOut -> ChainIndexTxOut -> Bool
$c/= :: ChainIndexTxOut -> ChainIndexTxOut -> Bool
== :: ChainIndexTxOut -> ChainIndexTxOut -> Bool
$c== :: ChainIndexTxOut -> ChainIndexTxOut -> Bool
Eq, Int -> ChainIndexTxOut -> ShowS
[ChainIndexTxOut] -> ShowS
ChainIndexTxOut -> String
(Int -> ChainIndexTxOut -> ShowS)
-> (ChainIndexTxOut -> String)
-> ([ChainIndexTxOut] -> ShowS)
-> Show ChainIndexTxOut
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainIndexTxOut] -> ShowS
$cshowList :: [ChainIndexTxOut] -> ShowS
show :: ChainIndexTxOut -> String
$cshow :: ChainIndexTxOut -> String
showsPrec :: Int -> ChainIndexTxOut -> ShowS
$cshowsPrec :: Int -> ChainIndexTxOut -> ShowS
Show, (forall x. ChainIndexTxOut -> Rep ChainIndexTxOut x)
-> (forall x. Rep ChainIndexTxOut x -> ChainIndexTxOut)
-> Generic ChainIndexTxOut
forall x. Rep ChainIndexTxOut x -> ChainIndexTxOut
forall x. ChainIndexTxOut -> Rep ChainIndexTxOut x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainIndexTxOut x -> ChainIndexTxOut
$cfrom :: forall x. ChainIndexTxOut -> Rep ChainIndexTxOut x
Generic, [ChainIndexTxOut] -> Encoding
ChainIndexTxOut -> Encoding
(ChainIndexTxOut -> Encoding)
-> (forall s. Decoder s ChainIndexTxOut)
-> ([ChainIndexTxOut] -> Encoding)
-> (forall s. Decoder s [ChainIndexTxOut])
-> Serialise ChainIndexTxOut
forall s. Decoder s [ChainIndexTxOut]
forall s. Decoder s ChainIndexTxOut
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [ChainIndexTxOut]
$cdecodeList :: forall s. Decoder s [ChainIndexTxOut]
encodeList :: [ChainIndexTxOut] -> Encoding
$cencodeList :: [ChainIndexTxOut] -> Encoding
decode :: Decoder s ChainIndexTxOut
$cdecode :: forall s. Decoder s ChainIndexTxOut
encode :: ChainIndexTxOut -> Encoding
$cencode :: ChainIndexTxOut -> Encoding
Serialise, Typeable ChainIndexTxOut
Typeable ChainIndexTxOut
-> (Proxy ChainIndexTxOut
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ChainIndexTxOut
Proxy ChainIndexTxOut -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy ChainIndexTxOut -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy ChainIndexTxOut -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable ChainIndexTxOut
OpenApi.ToSchema)

instance ToJSON ChainIndexTxOut where
    toJSON :: ChainIndexTxOut -> Value
toJSON ChainIndexTxOut{Value
AddressInEra BabbageEra
OutputDatum
ReferenceScript
citoRefScript :: ReferenceScript
citoDatum :: OutputDatum
citoValue :: Value
citoAddress :: AddressInEra BabbageEra
citoRefScript :: ChainIndexTxOut -> ReferenceScript
citoDatum :: ChainIndexTxOut -> OutputDatum
citoValue :: ChainIndexTxOut -> Value
citoAddress :: ChainIndexTxOut -> AddressInEra BabbageEra
..} = [Pair] -> Value
object
        [ Key
"address" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= AddressInEra BabbageEra -> Value
forall a. ToJSON a => a -> Value
toJSON AddressInEra BabbageEra
citoAddress
        , Key
"value" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
citoValue
        , Key
"datum" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= OutputDatum -> Value
forall a. ToJSON a => a -> Value
toJSON OutputDatum
citoDatum
        , Key
"refScript" Key -> Value -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ReferenceScript -> Value
forall a. ToJSON a => a -> Value
toJSON ReferenceScript
citoRefScript
        ]

instance FromJSON ChainIndexTxOut where
    parseJSON :: Value -> Parser ChainIndexTxOut
parseJSON =
        String
-> (Object -> Parser ChainIndexTxOut)
-> Value
-> Parser ChainIndexTxOut
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"ChainIndexTxOut" ((Object -> Parser ChainIndexTxOut)
 -> Value -> Parser ChainIndexTxOut)
-> (Object -> Parser ChainIndexTxOut)
-> Value
-> Parser ChainIndexTxOut
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
            AddressInEra BabbageEra
-> Value -> OutputDatum -> ReferenceScript -> ChainIndexTxOut
ChainIndexTxOut
                (AddressInEra BabbageEra
 -> Value -> OutputDatum -> ReferenceScript -> ChainIndexTxOut)
-> Parser (AddressInEra BabbageEra)
-> Parser
     (Value -> OutputDatum -> ReferenceScript -> ChainIndexTxOut)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Key -> Parser (AddressInEra BabbageEra)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"address"
                Parser (Value -> OutputDatum -> ReferenceScript -> ChainIndexTxOut)
-> Parser Value
-> Parser (OutputDatum -> ReferenceScript -> ChainIndexTxOut)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
                Parser (OutputDatum -> ReferenceScript -> ChainIndexTxOut)
-> Parser OutputDatum
-> Parser (ReferenceScript -> ChainIndexTxOut)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser OutputDatum
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"datum"
                Parser (ReferenceScript -> ChainIndexTxOut)
-> Parser ReferenceScript -> Parser ChainIndexTxOut
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser (Maybe ReferenceScript)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"refScript" Parser (Maybe ReferenceScript)
-> ReferenceScript -> Parser ReferenceScript
forall a. Parser (Maybe a) -> a -> Parser a
.!= ReferenceScript
ReferenceScriptNone

instance Pretty ChainIndexTxOut where
    pretty :: ChainIndexTxOut -> Doc ann
pretty ChainIndexTxOut {AddressInEra BabbageEra
citoAddress :: AddressInEra BabbageEra
citoAddress :: ChainIndexTxOut -> AddressInEra BabbageEra
citoAddress, Value
citoValue :: Value
citoValue :: ChainIndexTxOut -> Value
citoValue} =
        Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"-" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Value -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Value
citoValue Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"addressed to", Address -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (AddressInEra BabbageEra -> Address
forall era. AddressInEra era -> Address
toPlutusAddress AddressInEra BabbageEra
citoAddress)]

-- | List of outputs of a transaction. There is only an optional collateral output
-- if the transaction is invalid.
data ChainIndexTxOutputs =
    InvalidTx (Maybe ChainIndexTxOut) -- ^ The transaction is invalid so there is maybe a collateral output.
  | ValidTx [ChainIndexTxOut]
  deriving (Int -> ChainIndexTxOutputs -> ShowS
[ChainIndexTxOutputs] -> ShowS
ChainIndexTxOutputs -> String
(Int -> ChainIndexTxOutputs -> ShowS)
-> (ChainIndexTxOutputs -> String)
-> ([ChainIndexTxOutputs] -> ShowS)
-> Show ChainIndexTxOutputs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainIndexTxOutputs] -> ShowS
$cshowList :: [ChainIndexTxOutputs] -> ShowS
show :: ChainIndexTxOutputs -> String
$cshow :: ChainIndexTxOutputs -> String
showsPrec :: Int -> ChainIndexTxOutputs -> ShowS
$cshowsPrec :: Int -> ChainIndexTxOutputs -> ShowS
Show, ChainIndexTxOutputs -> ChainIndexTxOutputs -> Bool
(ChainIndexTxOutputs -> ChainIndexTxOutputs -> Bool)
-> (ChainIndexTxOutputs -> ChainIndexTxOutputs -> Bool)
-> Eq ChainIndexTxOutputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainIndexTxOutputs -> ChainIndexTxOutputs -> Bool
$c/= :: ChainIndexTxOutputs -> ChainIndexTxOutputs -> Bool
== :: ChainIndexTxOutputs -> ChainIndexTxOutputs -> Bool
$c== :: ChainIndexTxOutputs -> ChainIndexTxOutputs -> Bool
Eq, (forall x. ChainIndexTxOutputs -> Rep ChainIndexTxOutputs x)
-> (forall x. Rep ChainIndexTxOutputs x -> ChainIndexTxOutputs)
-> Generic ChainIndexTxOutputs
forall x. Rep ChainIndexTxOutputs x -> ChainIndexTxOutputs
forall x. ChainIndexTxOutputs -> Rep ChainIndexTxOutputs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainIndexTxOutputs x -> ChainIndexTxOutputs
$cfrom :: forall x. ChainIndexTxOutputs -> Rep ChainIndexTxOutputs x
Generic, [ChainIndexTxOutputs] -> Encoding
[ChainIndexTxOutputs] -> Value
ChainIndexTxOutputs -> Encoding
ChainIndexTxOutputs -> Value
(ChainIndexTxOutputs -> Value)
-> (ChainIndexTxOutputs -> Encoding)
-> ([ChainIndexTxOutputs] -> Value)
-> ([ChainIndexTxOutputs] -> Encoding)
-> ToJSON ChainIndexTxOutputs
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChainIndexTxOutputs] -> Encoding
$ctoEncodingList :: [ChainIndexTxOutputs] -> Encoding
toJSONList :: [ChainIndexTxOutputs] -> Value
$ctoJSONList :: [ChainIndexTxOutputs] -> Value
toEncoding :: ChainIndexTxOutputs -> Encoding
$ctoEncoding :: ChainIndexTxOutputs -> Encoding
toJSON :: ChainIndexTxOutputs -> Value
$ctoJSON :: ChainIndexTxOutputs -> Value
ToJSON, Value -> Parser [ChainIndexTxOutputs]
Value -> Parser ChainIndexTxOutputs
(Value -> Parser ChainIndexTxOutputs)
-> (Value -> Parser [ChainIndexTxOutputs])
-> FromJSON ChainIndexTxOutputs
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChainIndexTxOutputs]
$cparseJSONList :: Value -> Parser [ChainIndexTxOutputs]
parseJSON :: Value -> Parser ChainIndexTxOutputs
$cparseJSON :: Value -> Parser ChainIndexTxOutputs
FromJSON, [ChainIndexTxOutputs] -> Encoding
ChainIndexTxOutputs -> Encoding
(ChainIndexTxOutputs -> Encoding)
-> (forall s. Decoder s ChainIndexTxOutputs)
-> ([ChainIndexTxOutputs] -> Encoding)
-> (forall s. Decoder s [ChainIndexTxOutputs])
-> Serialise ChainIndexTxOutputs
forall s. Decoder s [ChainIndexTxOutputs]
forall s. Decoder s ChainIndexTxOutputs
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [ChainIndexTxOutputs]
$cdecodeList :: forall s. Decoder s [ChainIndexTxOutputs]
encodeList :: [ChainIndexTxOutputs] -> Encoding
$cencodeList :: [ChainIndexTxOutputs] -> Encoding
decode :: Decoder s ChainIndexTxOutputs
$cdecode :: forall s. Decoder s ChainIndexTxOutputs
encode :: ChainIndexTxOutputs -> Encoding
$cencode :: ChainIndexTxOutputs -> Encoding
Serialise, Typeable ChainIndexTxOutputs
Typeable ChainIndexTxOutputs
-> (Proxy ChainIndexTxOutputs
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ChainIndexTxOutputs
Proxy ChainIndexTxOutputs
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy ChainIndexTxOutputs
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy ChainIndexTxOutputs
-> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable ChainIndexTxOutputs
OpenApi.ToSchema)

makePrisms ''ChainIndexTxOutputs

deriving instance OpenApi.ToSchema TxOutRef
deriving instance OpenApi.ToSchema RedeemerPtr
deriving newtype instance OpenApi.ToSchema Redeemer
deriving newtype instance OpenApi.ToSchema ScriptHash
instance OpenApi.ToSchema Script where
    declareNamedSchema :: Proxy Script -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy Script
_ =
        NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
OpenApi.NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Script") (Proxy String -> Schema
forall a. ToSchema a => Proxy a -> Schema
OpenApi.toSchema (Proxy String
forall k (t :: k). Proxy t
Proxy :: Proxy String))
deriving newtype instance OpenApi.ToSchema CurrencySymbol
deriving newtype instance OpenApi.ToSchema Datum
deriving newtype instance OpenApi.ToSchema DatumHash

instance (Typeable era, Typeable mode) => OpenApi.ToSchema (C.EraInMode era mode) where
  declareNamedSchema :: Proxy (EraInMode era mode)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (EraInMode era mode)
_ = do
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"EraInMode") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ EraInMode BabbageEra CardanoMode -> Schema
forall a. ToJSON a => a -> Schema
sketchSchema EraInMode BabbageEra CardanoMode
C.BabbageEraInCardanoMode

instance (Typeable era) => OpenApi.ToSchema (C.Tx era) where
  declareNamedSchema :: Proxy (Tx era) -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy (Tx era)
_ = do
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Tx") Schema
byteSchema

instance OpenApi.ToSchema CardanoTx where
  declareNamedSchema :: Proxy CardanoTx -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy CardanoTx
_ = do
    Referenced Schema
txSchema <- Proxy (Tx BabbageEra)
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy (Tx BabbageEra)
forall k (t :: k). Proxy t
Proxy :: Proxy (C.Tx C.BabbageEra))
    Referenced Schema
eraInModeSchema <- Proxy (EraInMode BabbageEra CardanoMode)
-> Declare (Definitions Schema) (Referenced Schema)
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) (Referenced Schema)
declareSchemaRef (Proxy (EraInMode BabbageEra CardanoMode)
forall k (t :: k). Proxy t
Proxy :: Proxy (C.EraInMode C.BabbageEra C.CardanoMode))
    NamedSchema -> Declare (Definitions Schema) NamedSchema
forall (m :: * -> *) a. Monad m => a -> m a
return (NamedSchema -> Declare (Definitions Schema) NamedSchema)
-> NamedSchema -> Declare (Definitions Schema) NamedSchema
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Schema -> NamedSchema
NamedSchema (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"CardanoTx") (Schema -> NamedSchema) -> Schema -> NamedSchema
forall a b. (a -> b) -> a -> b
$ Schema
forall a. Monoid a => a
mempty
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (Maybe OpenApiType -> Identity (Maybe OpenApiType))
-> Schema -> Identity Schema
forall s a. HasType s a => Lens' s a
type_ ((Maybe OpenApiType -> Identity (Maybe OpenApiType))
 -> Schema -> Identity Schema)
-> OpenApiType -> Schema -> Schema
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ OpenApiType
OpenApiObject
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& (InsOrdHashMap Text (Referenced Schema)
 -> Identity (InsOrdHashMap Text (Referenced Schema)))
-> Schema -> Identity Schema
forall s a. HasProperties s a => Lens' s a
properties ((InsOrdHashMap Text (Referenced Schema)
  -> Identity (InsOrdHashMap Text (Referenced Schema)))
 -> Schema -> Identity Schema)
-> InsOrdHashMap Text (Referenced Schema) -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~
          [(Text, Referenced Schema)]
-> InsOrdHashMap Text (Referenced Schema)
forall k v. (Eq k, Hashable k) => [(k, v)] -> InsOrdHashMap k v
InsOrdMap.fromList [ (Text
"tx", Referenced Schema
txSchema)
          , (Text
"eraInMode", Referenced Schema
eraInModeSchema)
          ]
      Schema -> (Schema -> Schema) -> Schema
forall a b. a -> (a -> b) -> b
& ([Text] -> Identity [Text]) -> Schema -> Identity Schema
forall s a. HasRequired s a => Lens' s a
required (([Text] -> Identity [Text]) -> Schema -> Identity Schema)
-> [Text] -> Schema -> Schema
forall s t a b. ASetter s t a b -> b -> s -> t
.~ [ Text
"tx", Text
"eraInMode" ]

data ChainIndexTx = ChainIndexTx {
    ChainIndexTx -> TxId
_citxTxId       :: TxId,
    -- ^ The id of this transaction.
    ChainIndexTx -> [TxIn]
_citxInputs     :: [TxIn],
    -- ^ The inputs to this transaction.
    ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs    :: ChainIndexTxOutputs,
    -- ^ The outputs of this transaction, ordered so they can be referenced by index.
    ChainIndexTx -> SlotRange
_citxValidRange :: !SlotRange,
    -- ^ The 'SlotRange' during which this transaction may be validated.
    ChainIndexTx -> Map DatumHash Datum
_citxData       :: Map DatumHash Datum,
    -- ^ Datum objects recorded on this transaction.
    ChainIndexTx -> Redeemers
_citxRedeemers  :: Redeemers,
    -- ^ Redeemers of the minting scripts.
    ChainIndexTx -> Map ScriptHash (Versioned Script)
_citxScripts    :: Map ScriptHash (Versioned Script),
    -- ^ The scripts (validator, stake validator or minting) part of cardano tx.
    ChainIndexTx -> Maybe CardanoTx
_citxCardanoTx  :: Maybe CardanoTx
    -- ^ The full Cardano API tx which was used to populate the rest of the
    -- 'ChainIndexTx' fields. Useful because 'ChainIndexTx' doesn't have all the
    -- details of the tx, so we keep it as a safety net. Might be Nothing if we
    -- are in the emulator.
    } deriving (Int -> ChainIndexTx -> ShowS
[ChainIndexTx] -> ShowS
ChainIndexTx -> String
(Int -> ChainIndexTx -> ShowS)
-> (ChainIndexTx -> String)
-> ([ChainIndexTx] -> ShowS)
-> Show ChainIndexTx
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainIndexTx] -> ShowS
$cshowList :: [ChainIndexTx] -> ShowS
show :: ChainIndexTx -> String
$cshow :: ChainIndexTx -> String
showsPrec :: Int -> ChainIndexTx -> ShowS
$cshowsPrec :: Int -> ChainIndexTx -> ShowS
Show, ChainIndexTx -> ChainIndexTx -> Bool
(ChainIndexTx -> ChainIndexTx -> Bool)
-> (ChainIndexTx -> ChainIndexTx -> Bool) -> Eq ChainIndexTx
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainIndexTx -> ChainIndexTx -> Bool
$c/= :: ChainIndexTx -> ChainIndexTx -> Bool
== :: ChainIndexTx -> ChainIndexTx -> Bool
$c== :: ChainIndexTx -> ChainIndexTx -> Bool
Eq, (forall x. ChainIndexTx -> Rep ChainIndexTx x)
-> (forall x. Rep ChainIndexTx x -> ChainIndexTx)
-> Generic ChainIndexTx
forall x. Rep ChainIndexTx x -> ChainIndexTx
forall x. ChainIndexTx -> Rep ChainIndexTx x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainIndexTx x -> ChainIndexTx
$cfrom :: forall x. ChainIndexTx -> Rep ChainIndexTx x
Generic, [ChainIndexTx] -> Encoding
[ChainIndexTx] -> Value
ChainIndexTx -> Encoding
ChainIndexTx -> Value
(ChainIndexTx -> Value)
-> (ChainIndexTx -> Encoding)
-> ([ChainIndexTx] -> Value)
-> ([ChainIndexTx] -> Encoding)
-> ToJSON ChainIndexTx
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChainIndexTx] -> Encoding
$ctoEncodingList :: [ChainIndexTx] -> Encoding
toJSONList :: [ChainIndexTx] -> Value
$ctoJSONList :: [ChainIndexTx] -> Value
toEncoding :: ChainIndexTx -> Encoding
$ctoEncoding :: ChainIndexTx -> Encoding
toJSON :: ChainIndexTx -> Value
$ctoJSON :: ChainIndexTx -> Value
ToJSON, Value -> Parser [ChainIndexTx]
Value -> Parser ChainIndexTx
(Value -> Parser ChainIndexTx)
-> (Value -> Parser [ChainIndexTx]) -> FromJSON ChainIndexTx
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChainIndexTx]
$cparseJSONList :: Value -> Parser [ChainIndexTx]
parseJSON :: Value -> Parser ChainIndexTx
$cparseJSON :: Value -> Parser ChainIndexTx
FromJSON, [ChainIndexTx] -> Encoding
ChainIndexTx -> Encoding
(ChainIndexTx -> Encoding)
-> (forall s. Decoder s ChainIndexTx)
-> ([ChainIndexTx] -> Encoding)
-> (forall s. Decoder s [ChainIndexTx])
-> Serialise ChainIndexTx
forall s. Decoder s [ChainIndexTx]
forall s. Decoder s ChainIndexTx
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [ChainIndexTx]
$cdecodeList :: forall s. Decoder s [ChainIndexTx]
encodeList :: [ChainIndexTx] -> Encoding
$cencodeList :: [ChainIndexTx] -> Encoding
decode :: Decoder s ChainIndexTx
$cdecode :: forall s. Decoder s ChainIndexTx
encode :: ChainIndexTx -> Encoding
$cencode :: ChainIndexTx -> Encoding
Serialise, Typeable ChainIndexTx
Typeable ChainIndexTx
-> (Proxy ChainIndexTx -> Declare (Definitions Schema) NamedSchema)
-> ToSchema ChainIndexTx
Proxy ChainIndexTx -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy ChainIndexTx -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy ChainIndexTx -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable ChainIndexTx
OpenApi.ToSchema)

makeLenses ''ChainIndexTx

instance Pretty ChainIndexTx where
    pretty :: ChainIndexTx -> Doc ann
pretty ChainIndexTx{TxId
_citxTxId :: TxId
_citxTxId :: ChainIndexTx -> TxId
_citxTxId, [TxIn]
_citxInputs :: [TxIn]
_citxInputs :: ChainIndexTx -> [TxIn]
_citxInputs, _citxOutputs :: ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs = ValidTx [ChainIndexTxOut]
outputs, SlotRange
_citxValidRange :: SlotRange
_citxValidRange :: ChainIndexTx -> SlotRange
_citxValidRange, Map DatumHash Datum
_citxData :: Map DatumHash Datum
_citxData :: ChainIndexTx -> Map DatumHash Datum
_citxData, Redeemers
_citxRedeemers :: Redeemers
_citxRedeemers :: ChainIndexTx -> Redeemers
_citxRedeemers, Map ScriptHash (Versioned Script)
_citxScripts :: Map ScriptHash (Versioned Script)
_citxScripts :: ChainIndexTx -> Map ScriptHash (Versioned Script)
_citxScripts} =
        let lines' :: [Doc ann]
lines' =
                [ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"inputs:" Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TxIn -> Doc ann) -> [TxIn] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxIn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [TxIn]
_citxInputs))
                , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"outputs:" Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (ChainIndexTxOut -> Doc ann) -> [ChainIndexTxOut] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ChainIndexTxOut -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [ChainIndexTxOut]
outputs))
                , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"scripts hashes:"Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: ((ScriptHash, Versioned Script) -> Doc ann)
-> [(ScriptHash, Versioned Script)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScriptHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ScriptHash -> Doc ann)
-> ((ScriptHash, Versioned Script) -> ScriptHash)
-> (ScriptHash, Versioned Script)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScriptHash, Versioned Script) -> ScriptHash
forall a b. (a, b) -> a
fst) (Map ScriptHash (Versioned Script)
-> [(ScriptHash, Versioned Script)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ScriptHash (Versioned Script)
_citxScripts)))
                , Doc ann
"validity range:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SlotRange -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow SlotRange
_citxValidRange
                , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"data:"Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: ((DatumHash, Datum) -> Doc ann)
-> [(DatumHash, Datum)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Datum -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Datum -> Doc ann)
-> ((DatumHash, Datum) -> Datum) -> (DatumHash, Datum) -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DatumHash, Datum) -> Datum
forall a b. (a, b) -> b
snd) (Map DatumHash Datum -> [(DatumHash, Datum)]
forall k a. Map k a -> [(k, a)]
Map.toList Map DatumHash Datum
_citxData) ))
                , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"redeemers:"Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: ((RedeemerPtr, Redeemer) -> Doc ann)
-> [(RedeemerPtr, Redeemer)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Redeemer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Redeemer -> Doc ann)
-> ((RedeemerPtr, Redeemer) -> Redeemer)
-> (RedeemerPtr, Redeemer)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RedeemerPtr, Redeemer) -> Redeemer
forall a b. (a, b) -> b
snd) (Redeemers -> [(RedeemerPtr, Redeemer)]
forall k a. Map k a -> [(k, a)]
Map.toList Redeemers
_citxRedeemers) ))
                ]
        in Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"Valid tx" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxId
_citxTxId Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon, Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann]
lines')]
    pretty ChainIndexTx{TxId
_citxTxId :: TxId
_citxTxId :: ChainIndexTx -> TxId
_citxTxId, [TxIn]
_citxInputs :: [TxIn]
_citxInputs :: ChainIndexTx -> [TxIn]
_citxInputs, _citxOutputs :: ChainIndexTx -> ChainIndexTxOutputs
_citxOutputs = InvalidTx Maybe ChainIndexTxOut
mOutput, SlotRange
_citxValidRange :: SlotRange
_citxValidRange :: ChainIndexTx -> SlotRange
_citxValidRange, Map DatumHash Datum
_citxData :: Map DatumHash Datum
_citxData :: ChainIndexTx -> Map DatumHash Datum
_citxData, Redeemers
_citxRedeemers :: Redeemers
_citxRedeemers :: ChainIndexTx -> Redeemers
_citxRedeemers, Map ScriptHash (Versioned Script)
_citxScripts :: Map ScriptHash (Versioned Script)
_citxScripts :: ChainIndexTx -> Map ScriptHash (Versioned Script)
_citxScripts} =
        let lines' :: [Doc ann]
lines' =
                [ Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"inputs:" Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: (TxIn -> Doc ann) -> [TxIn] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TxIn -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty [TxIn]
_citxInputs))
                , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"collateral output:", Doc ann
-> (ChainIndexTxOut -> Doc ann) -> Maybe ChainIndexTxOut -> Doc ann
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc ann
"-" ChainIndexTxOut -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Maybe ChainIndexTxOut
mOutput])
                , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"scripts hashes:"Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: ((ScriptHash, Versioned Script) -> Doc ann)
-> [(ScriptHash, Versioned Script)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ScriptHash -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (ScriptHash -> Doc ann)
-> ((ScriptHash, Versioned Script) -> ScriptHash)
-> (ScriptHash, Versioned Script)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ScriptHash, Versioned Script) -> ScriptHash
forall a b. (a, b) -> a
fst) (Map ScriptHash (Versioned Script)
-> [(ScriptHash, Versioned Script)]
forall k a. Map k a -> [(k, a)]
Map.toList Map ScriptHash (Versioned Script)
_citxScripts)))
                , Doc ann
"validity range:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> SlotRange -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow SlotRange
_citxValidRange
                , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"data:"Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: ((DatumHash, Datum) -> Doc ann)
-> [(DatumHash, Datum)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Datum -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Datum -> Doc ann)
-> ((DatumHash, Datum) -> Datum) -> (DatumHash, Datum) -> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DatumHash, Datum) -> Datum
forall a b. (a, b) -> b
snd) (Map DatumHash Datum -> [(DatumHash, Datum)]
forall k a. Map k a -> [(k, a)]
Map.toList Map DatumHash Datum
_citxData) ))
                , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
hang Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep (Doc ann
"redeemers:"Doc ann -> [Doc ann] -> [Doc ann]
forall a. a -> [a] -> [a]
: ((RedeemerPtr, Redeemer) -> Doc ann)
-> [(RedeemerPtr, Redeemer)] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Redeemer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Redeemer -> Doc ann)
-> ((RedeemerPtr, Redeemer) -> Redeemer)
-> (RedeemerPtr, Redeemer)
-> Doc ann
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (RedeemerPtr, Redeemer) -> Redeemer
forall a b. (a, b) -> b
snd) (Redeemers -> [(RedeemerPtr, Redeemer)]
forall k a. Map k a -> [(k, a)]
Map.toList Redeemers
_citxRedeemers) ))
                ]
        in Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
nest Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann
"Invalid tx" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxId
_citxTxId Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon, Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
braces ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep [Doc ann]
lines')]

-- | Compute a hash of the block's contents.
blockId :: Ledger.Block -> BlockId
blockId :: Block -> BlockId
blockId = ByteString -> BlockId
BlockId
        (ByteString -> BlockId)
-> (Block -> ByteString) -> Block -> BlockId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Digest SHA256 -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert
        (Digest SHA256 -> ByteString)
-> (Block -> Digest SHA256) -> Block -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteArrayAccess ByteString, HashAlgorithm SHA256) =>
ByteString -> Digest SHA256
forall ba a.
(ByteArrayAccess ba, HashAlgorithm a) =>
ba -> Digest a
hash @_ @SHA256
        (ByteString -> Digest SHA256)
-> (Block -> ByteString) -> Block -> Digest SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
        (ByteString -> ByteString)
-> (Block -> ByteString) -> Block -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block -> ByteString
forall a. Serialise a => a -> ByteString
CBOR.serialise

newtype BlockNumber = BlockNumber { BlockNumber -> Word64
unBlockNumber :: Word64 }
    deriving stock (BlockNumber -> BlockNumber -> Bool
(BlockNumber -> BlockNumber -> Bool)
-> (BlockNumber -> BlockNumber -> Bool) -> Eq BlockNumber
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BlockNumber -> BlockNumber -> Bool
$c/= :: BlockNumber -> BlockNumber -> Bool
== :: BlockNumber -> BlockNumber -> Bool
$c== :: BlockNumber -> BlockNumber -> Bool
Eq, Eq BlockNumber
Eq BlockNumber
-> (BlockNumber -> BlockNumber -> Ordering)
-> (BlockNumber -> BlockNumber -> Bool)
-> (BlockNumber -> BlockNumber -> Bool)
-> (BlockNumber -> BlockNumber -> Bool)
-> (BlockNumber -> BlockNumber -> Bool)
-> (BlockNumber -> BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber -> BlockNumber)
-> Ord BlockNumber
BlockNumber -> BlockNumber -> Bool
BlockNumber -> BlockNumber -> Ordering
BlockNumber -> BlockNumber -> BlockNumber
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
min :: BlockNumber -> BlockNumber -> BlockNumber
$cmin :: BlockNumber -> BlockNumber -> BlockNumber
max :: BlockNumber -> BlockNumber -> BlockNumber
$cmax :: BlockNumber -> BlockNumber -> BlockNumber
>= :: BlockNumber -> BlockNumber -> Bool
$c>= :: BlockNumber -> BlockNumber -> Bool
> :: BlockNumber -> BlockNumber -> Bool
$c> :: BlockNumber -> BlockNumber -> Bool
<= :: BlockNumber -> BlockNumber -> Bool
$c<= :: BlockNumber -> BlockNumber -> Bool
< :: BlockNumber -> BlockNumber -> Bool
$c< :: BlockNumber -> BlockNumber -> Bool
compare :: BlockNumber -> BlockNumber -> Ordering
$ccompare :: BlockNumber -> BlockNumber -> Ordering
$cp1Ord :: Eq BlockNumber
Ord, Int -> BlockNumber -> ShowS
[BlockNumber] -> ShowS
BlockNumber -> String
(Int -> BlockNumber -> ShowS)
-> (BlockNumber -> String)
-> ([BlockNumber] -> ShowS)
-> Show BlockNumber
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BlockNumber] -> ShowS
$cshowList :: [BlockNumber] -> ShowS
show :: BlockNumber -> String
$cshow :: BlockNumber -> String
showsPrec :: Int -> BlockNumber -> ShowS
$cshowsPrec :: Int -> BlockNumber -> ShowS
Show, (forall x. BlockNumber -> Rep BlockNumber x)
-> (forall x. Rep BlockNumber x -> BlockNumber)
-> Generic BlockNumber
forall x. Rep BlockNumber x -> BlockNumber
forall x. BlockNumber -> Rep BlockNumber x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BlockNumber x -> BlockNumber
$cfrom :: forall x. BlockNumber -> Rep BlockNumber x
Generic)
    deriving newtype (Integer -> BlockNumber
BlockNumber -> BlockNumber
BlockNumber -> BlockNumber -> BlockNumber
(BlockNumber -> BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber)
-> (Integer -> BlockNumber)
-> Num BlockNumber
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> BlockNumber
$cfromInteger :: Integer -> BlockNumber
signum :: BlockNumber -> BlockNumber
$csignum :: BlockNumber -> BlockNumber
abs :: BlockNumber -> BlockNumber
$cabs :: BlockNumber -> BlockNumber
negate :: BlockNumber -> BlockNumber
$cnegate :: BlockNumber -> BlockNumber
* :: BlockNumber -> BlockNumber -> BlockNumber
$c* :: BlockNumber -> BlockNumber -> BlockNumber
- :: BlockNumber -> BlockNumber -> BlockNumber
$c- :: BlockNumber -> BlockNumber -> BlockNumber
+ :: BlockNumber -> BlockNumber -> BlockNumber
$c+ :: BlockNumber -> BlockNumber -> BlockNumber
Num, Num BlockNumber
Ord BlockNumber
Num BlockNumber
-> Ord BlockNumber -> (BlockNumber -> Rational) -> Real BlockNumber
BlockNumber -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: BlockNumber -> Rational
$ctoRational :: BlockNumber -> Rational
$cp2Real :: Ord BlockNumber
$cp1Real :: Num BlockNumber
Real, Int -> BlockNumber
BlockNumber -> Int
BlockNumber -> [BlockNumber]
BlockNumber -> BlockNumber
BlockNumber -> BlockNumber -> [BlockNumber]
BlockNumber -> BlockNumber -> BlockNumber -> [BlockNumber]
(BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber)
-> (Int -> BlockNumber)
-> (BlockNumber -> Int)
-> (BlockNumber -> [BlockNumber])
-> (BlockNumber -> BlockNumber -> [BlockNumber])
-> (BlockNumber -> BlockNumber -> [BlockNumber])
-> (BlockNumber -> BlockNumber -> BlockNumber -> [BlockNumber])
-> Enum BlockNumber
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: BlockNumber -> BlockNumber -> BlockNumber -> [BlockNumber]
$cenumFromThenTo :: BlockNumber -> BlockNumber -> BlockNumber -> [BlockNumber]
enumFromTo :: BlockNumber -> BlockNumber -> [BlockNumber]
$cenumFromTo :: BlockNumber -> BlockNumber -> [BlockNumber]
enumFromThen :: BlockNumber -> BlockNumber -> [BlockNumber]
$cenumFromThen :: BlockNumber -> BlockNumber -> [BlockNumber]
enumFrom :: BlockNumber -> [BlockNumber]
$cenumFrom :: BlockNumber -> [BlockNumber]
fromEnum :: BlockNumber -> Int
$cfromEnum :: BlockNumber -> Int
toEnum :: Int -> BlockNumber
$ctoEnum :: Int -> BlockNumber
pred :: BlockNumber -> BlockNumber
$cpred :: BlockNumber -> BlockNumber
succ :: BlockNumber -> BlockNumber
$csucc :: BlockNumber -> BlockNumber
Enum, Enum BlockNumber
Real BlockNumber
Real BlockNumber
-> Enum BlockNumber
-> (BlockNumber -> BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber -> BlockNumber)
-> (BlockNumber -> BlockNumber -> (BlockNumber, BlockNumber))
-> (BlockNumber -> BlockNumber -> (BlockNumber, BlockNumber))
-> (BlockNumber -> Integer)
-> Integral BlockNumber
BlockNumber -> Integer
BlockNumber -> BlockNumber -> (BlockNumber, BlockNumber)
BlockNumber -> BlockNumber -> BlockNumber
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: BlockNumber -> Integer
$ctoInteger :: BlockNumber -> Integer
divMod :: BlockNumber -> BlockNumber -> (BlockNumber, BlockNumber)
$cdivMod :: BlockNumber -> BlockNumber -> (BlockNumber, BlockNumber)
quotRem :: BlockNumber -> BlockNumber -> (BlockNumber, BlockNumber)
$cquotRem :: BlockNumber -> BlockNumber -> (BlockNumber, BlockNumber)
mod :: BlockNumber -> BlockNumber -> BlockNumber
$cmod :: BlockNumber -> BlockNumber -> BlockNumber
div :: BlockNumber -> BlockNumber -> BlockNumber
$cdiv :: BlockNumber -> BlockNumber -> BlockNumber
rem :: BlockNumber -> BlockNumber -> BlockNumber
$crem :: BlockNumber -> BlockNumber -> BlockNumber
quot :: BlockNumber -> BlockNumber -> BlockNumber
$cquot :: BlockNumber -> BlockNumber -> BlockNumber
$cp2Integral :: Enum BlockNumber
$cp1Integral :: Real BlockNumber
Integral, [BlockNumber] -> Encoding
[BlockNumber] -> Value
BlockNumber -> Encoding
BlockNumber -> Value
(BlockNumber -> Value)
-> (BlockNumber -> Encoding)
-> ([BlockNumber] -> Value)
-> ([BlockNumber] -> Encoding)
-> ToJSON BlockNumber
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [BlockNumber] -> Encoding
$ctoEncodingList :: [BlockNumber] -> Encoding
toJSONList :: [BlockNumber] -> Value
$ctoJSONList :: [BlockNumber] -> Value
toEncoding :: BlockNumber -> Encoding
$ctoEncoding :: BlockNumber -> Encoding
toJSON :: BlockNumber -> Value
$ctoJSON :: BlockNumber -> Value
ToJSON, Value -> Parser [BlockNumber]
Value -> Parser BlockNumber
(Value -> Parser BlockNumber)
-> (Value -> Parser [BlockNumber]) -> FromJSON BlockNumber
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [BlockNumber]
$cparseJSONList :: Value -> Parser [BlockNumber]
parseJSON :: Value -> Parser BlockNumber
$cparseJSON :: Value -> Parser BlockNumber
FromJSON, Typeable BlockNumber
Typeable BlockNumber
-> (Proxy BlockNumber -> Declare (Definitions Schema) NamedSchema)
-> ToSchema BlockNumber
Proxy BlockNumber -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy BlockNumber -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy BlockNumber -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable BlockNumber
OpenApi.ToSchema)

instance Pretty BlockNumber where
    pretty :: BlockNumber -> Doc ann
pretty (BlockNumber Word64
blockNumber) =
        Doc ann
"BlockNumber " Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Word64 -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Word64
blockNumber

instance OpenApi.ToSchema BlockId where
    declareNamedSchema :: Proxy BlockId -> Declare (Definitions Schema) NamedSchema
declareNamedSchema Proxy BlockId
_ = Proxy String -> Declare (Definitions Schema) NamedSchema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) NamedSchema
OpenApi.declareNamedSchema (Proxy String
forall k (t :: k). Proxy t
Proxy @String)

-- | The tip of the chain index.
data Tip =
      TipAtGenesis
    | Tip
        { Tip -> Slot
tipSlot    :: Slot -- ^ Last slot
        , Tip -> BlockId
tipBlockId :: BlockId -- ^ Last block ID
        , Tip -> BlockNumber
tipBlockNo :: BlockNumber -- ^ Last block number
        }
    deriving stock (Tip -> Tip -> Bool
(Tip -> Tip -> Bool) -> (Tip -> Tip -> Bool) -> Eq Tip
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tip -> Tip -> Bool
$c/= :: Tip -> Tip -> Bool
== :: Tip -> Tip -> Bool
$c== :: Tip -> Tip -> Bool
Eq, Int -> Tip -> ShowS
[Tip] -> ShowS
Tip -> String
(Int -> Tip -> ShowS)
-> (Tip -> String) -> ([Tip] -> ShowS) -> Show Tip
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tip] -> ShowS
$cshowList :: [Tip] -> ShowS
show :: Tip -> String
$cshow :: Tip -> String
showsPrec :: Int -> Tip -> ShowS
$cshowsPrec :: Int -> Tip -> ShowS
Show, (forall x. Tip -> Rep Tip x)
-> (forall x. Rep Tip x -> Tip) -> Generic Tip
forall x. Rep Tip x -> Tip
forall x. Tip -> Rep Tip x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Tip x -> Tip
$cfrom :: forall x. Tip -> Rep Tip x
Generic)
    deriving anyclass ([Tip] -> Encoding
[Tip] -> Value
Tip -> Encoding
Tip -> Value
(Tip -> Value)
-> (Tip -> Encoding)
-> ([Tip] -> Value)
-> ([Tip] -> Encoding)
-> ToJSON Tip
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Tip] -> Encoding
$ctoEncodingList :: [Tip] -> Encoding
toJSONList :: [Tip] -> Value
$ctoJSONList :: [Tip] -> Value
toEncoding :: Tip -> Encoding
$ctoEncoding :: Tip -> Encoding
toJSON :: Tip -> Value
$ctoJSON :: Tip -> Value
ToJSON, Value -> Parser [Tip]
Value -> Parser Tip
(Value -> Parser Tip) -> (Value -> Parser [Tip]) -> FromJSON Tip
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Tip]
$cparseJSONList :: Value -> Parser [Tip]
parseJSON :: Value -> Parser Tip
$cparseJSON :: Value -> Parser Tip
FromJSON, Typeable Tip
Typeable Tip
-> (Proxy Tip -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Tip
Proxy Tip -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy Tip -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy Tip -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable Tip
OpenApi.ToSchema)

makePrisms ''Tip

-- | When performing a rollback the chain sync protocol does not provide a block
--   number where to resume from.
data Point =
      PointAtGenesis
    | Point
        { Point -> Slot
pointSlot    :: Slot -- ^ Slot number
        , Point -> BlockId
pointBlockId :: BlockId -- ^ Block number
        }
    deriving stock (Point -> Point -> Bool
(Point -> Point -> Bool) -> (Point -> Point -> Bool) -> Eq Point
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: Point -> Point -> Bool
Eq, Int -> Point -> ShowS
[Point] -> ShowS
Point -> String
(Int -> Point -> ShowS)
-> (Point -> String) -> ([Point] -> ShowS) -> Show Point
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point] -> ShowS
$cshowList :: [Point] -> ShowS
show :: Point -> String
$cshow :: Point -> String
showsPrec :: Int -> Point -> ShowS
$cshowsPrec :: Int -> Point -> ShowS
Show, (forall x. Point -> Rep Point x)
-> (forall x. Rep Point x -> Point) -> Generic Point
forall x. Rep Point x -> Point
forall x. Point -> Rep Point x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Point x -> Point
$cfrom :: forall x. Point -> Rep Point x
Generic)
    deriving anyclass ([Point] -> Encoding
[Point] -> Value
Point -> Encoding
Point -> Value
(Point -> Value)
-> (Point -> Encoding)
-> ([Point] -> Value)
-> ([Point] -> Encoding)
-> ToJSON Point
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Point] -> Encoding
$ctoEncodingList :: [Point] -> Encoding
toJSONList :: [Point] -> Value
$ctoJSONList :: [Point] -> Value
toEncoding :: Point -> Encoding
$ctoEncoding :: Point -> Encoding
toJSON :: Point -> Value
$ctoJSON :: Point -> Value
ToJSON, Value -> Parser [Point]
Value -> Parser Point
(Value -> Parser Point)
-> (Value -> Parser [Point]) -> FromJSON Point
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Point]
$cparseJSONList :: Value -> Parser [Point]
parseJSON :: Value -> Parser Point
$cparseJSON :: Value -> Parser Point
FromJSON)

makePrisms ''Point

instance Ord Point where
  Point
PointAtGenesis <= :: Point -> Point -> Bool
<= Point
_              = Bool
True
  Point
_              <= Point
PointAtGenesis = Bool
False
  (Point Slot
ls BlockId
_)   <= (Point Slot
rs BlockId
_)   = Slot
ls Slot -> Slot -> Bool
forall a. Ord a => a -> a -> Bool
<= Slot
rs

instance Pretty Point where
    pretty :: Point -> Doc ann
pretty Point
PointAtGenesis = Doc ann
"PointAtGenesis"
    pretty Point {Slot
pointSlot :: Slot
pointSlot :: Point -> Slot
pointSlot, BlockId
pointBlockId :: BlockId
pointBlockId :: Point -> BlockId
pointBlockId} =
        Doc ann
"Point("
     Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Slot -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Slot
pointSlot
     Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
comma
     Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BlockId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty BlockId
pointBlockId
     Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
")"

tipAsPoint :: Tip -> Point
tipAsPoint :: Tip -> Point
tipAsPoint Tip
TipAtGenesis = Point
PointAtGenesis
tipAsPoint (Tip Slot
tSlot BlockId
tBlockId BlockNumber
_) =
    Point :: Slot -> BlockId -> Point
Point { pointSlot :: Slot
pointSlot = Slot
tSlot
          , pointBlockId :: BlockId
pointBlockId = BlockId
tBlockId
          }

pointsToTip :: Point -> Tip -> Bool
pointsToTip :: Point -> Tip -> Bool
pointsToTip Point
PointAtGenesis Tip
TipAtGenesis = Bool
True
pointsToTip (Point Slot
pSlot BlockId
pBlockId)
            (Tip   Slot
tSlot BlockId
tBlockId BlockNumber
_)
  | Slot
tSlot Slot -> Slot -> Bool
forall a. Eq a => a -> a -> Bool
== Slot
pSlot Bool -> Bool -> Bool
&& BlockId
tBlockId BlockId -> BlockId -> Bool
forall a. Eq a => a -> a -> Bool
== BlockId
pBlockId = Bool
True
pointsToTip Point
_ Tip
_ = Bool
False

-- | This mirrors the previously defined Tip which used the Last monoid definition.
instance Semigroup Tip where
    Tip
t <> :: Tip -> Tip -> Tip
<> Tip
TipAtGenesis = Tip
t
    Tip
_ <> Tip
t            = Tip
t

instance Semigroup Point where
    Point
t <> :: Point -> Point -> Point
<> Point
PointAtGenesis = Point
t
    Point
_ <> Point
t              = Point
t

instance Monoid Tip where
    mempty :: Tip
mempty = Tip
TipAtGenesis

instance Monoid Point where
    mempty :: Point
mempty = Point
PointAtGenesis

instance Ord Tip where
    compare :: Tip -> Tip -> Ordering
compare Tip
TipAtGenesis Tip
TipAtGenesis   = Ordering
EQ
    compare Tip
TipAtGenesis Tip
_              = Ordering
LT
    compare Tip
_            Tip
TipAtGenesis   = Ordering
GT
    compare (Tip Slot
ls BlockId
_ BlockNumber
lb) (Tip Slot
rs BlockId
_ BlockNumber
rb) = Slot -> Slot -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Slot
ls Slot
rs Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> BlockNumber -> BlockNumber -> Ordering
forall a. Ord a => a -> a -> Ordering
compare BlockNumber
lb BlockNumber
rb

instance Pretty Tip where
    pretty :: Tip -> Doc ann
pretty Tip
TipAtGenesis = Doc ann
"TipAtGenesis"
    pretty Tip {Slot
tipSlot :: Slot
tipSlot :: Tip -> Slot
tipSlot, BlockId
tipBlockId :: BlockId
tipBlockId :: Tip -> BlockId
tipBlockId, BlockNumber
tipBlockNo :: BlockNumber
tipBlockNo :: Tip -> BlockNumber
tipBlockNo} =
            Doc ann
"Tip("
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Slot -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Slot
tipSlot
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
forall ann. Doc ann
comma
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BlockId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty BlockId
tipBlockId
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
forall ann. Doc ann
comma
        Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BlockNumber -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty BlockNumber
tipBlockNo
        Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<>  Doc ann
")"

-- | Validity of a transaction that has been added to the ledger
data TxValidity = TxValid | TxInvalid | UnknownValidity
  deriving stock (TxValidity -> TxValidity -> Bool
(TxValidity -> TxValidity -> Bool)
-> (TxValidity -> TxValidity -> Bool) -> Eq TxValidity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxValidity -> TxValidity -> Bool
$c/= :: TxValidity -> TxValidity -> Bool
== :: TxValidity -> TxValidity -> Bool
$c== :: TxValidity -> TxValidity -> Bool
Eq, Eq TxValidity
Eq TxValidity
-> (TxValidity -> TxValidity -> Ordering)
-> (TxValidity -> TxValidity -> Bool)
-> (TxValidity -> TxValidity -> Bool)
-> (TxValidity -> TxValidity -> Bool)
-> (TxValidity -> TxValidity -> Bool)
-> (TxValidity -> TxValidity -> TxValidity)
-> (TxValidity -> TxValidity -> TxValidity)
-> Ord TxValidity
TxValidity -> TxValidity -> Bool
TxValidity -> TxValidity -> Ordering
TxValidity -> TxValidity -> TxValidity
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
min :: TxValidity -> TxValidity -> TxValidity
$cmin :: TxValidity -> TxValidity -> TxValidity
max :: TxValidity -> TxValidity -> TxValidity
$cmax :: TxValidity -> TxValidity -> TxValidity
>= :: TxValidity -> TxValidity -> Bool
$c>= :: TxValidity -> TxValidity -> Bool
> :: TxValidity -> TxValidity -> Bool
$c> :: TxValidity -> TxValidity -> Bool
<= :: TxValidity -> TxValidity -> Bool
$c<= :: TxValidity -> TxValidity -> Bool
< :: TxValidity -> TxValidity -> Bool
$c< :: TxValidity -> TxValidity -> Bool
compare :: TxValidity -> TxValidity -> Ordering
$ccompare :: TxValidity -> TxValidity -> Ordering
$cp1Ord :: Eq TxValidity
Ord, Int -> TxValidity -> ShowS
[TxValidity] -> ShowS
TxValidity -> String
(Int -> TxValidity -> ShowS)
-> (TxValidity -> String)
-> ([TxValidity] -> ShowS)
-> Show TxValidity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxValidity] -> ShowS
$cshowList :: [TxValidity] -> ShowS
show :: TxValidity -> String
$cshow :: TxValidity -> String
showsPrec :: Int -> TxValidity -> ShowS
$cshowsPrec :: Int -> TxValidity -> ShowS
Show, (forall x. TxValidity -> Rep TxValidity x)
-> (forall x. Rep TxValidity x -> TxValidity) -> Generic TxValidity
forall x. Rep TxValidity x -> TxValidity
forall x. TxValidity -> Rep TxValidity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxValidity x -> TxValidity
$cfrom :: forall x. TxValidity -> Rep TxValidity x
Generic)
  deriving anyclass ([TxValidity] -> Encoding
[TxValidity] -> Value
TxValidity -> Encoding
TxValidity -> Value
(TxValidity -> Value)
-> (TxValidity -> Encoding)
-> ([TxValidity] -> Value)
-> ([TxValidity] -> Encoding)
-> ToJSON TxValidity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TxValidity] -> Encoding
$ctoEncodingList :: [TxValidity] -> Encoding
toJSONList :: [TxValidity] -> Value
$ctoJSONList :: [TxValidity] -> Value
toEncoding :: TxValidity -> Encoding
$ctoEncoding :: TxValidity -> Encoding
toJSON :: TxValidity -> Value
$ctoJSON :: TxValidity -> Value
ToJSON, Value -> Parser [TxValidity]
Value -> Parser TxValidity
(Value -> Parser TxValidity)
-> (Value -> Parser [TxValidity]) -> FromJSON TxValidity
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TxValidity]
$cparseJSONList :: Value -> Parser [TxValidity]
parseJSON :: Value -> Parser TxValidity
$cparseJSON :: Value -> Parser TxValidity
FromJSON)
  deriving [TxValidity] -> Doc ann
TxValidity -> Doc ann
(forall ann. TxValidity -> Doc ann)
-> (forall ann. [TxValidity] -> Doc ann) -> Pretty TxValidity
forall ann. [TxValidity] -> Doc ann
forall ann. TxValidity -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [TxValidity] -> Doc ann
$cprettyList :: forall ann. [TxValidity] -> Doc ann
pretty :: TxValidity -> Doc ann
$cpretty :: forall ann. TxValidity -> Doc ann
Pretty via (PrettyShow TxValidity)

instance MeetSemiLattice TxValidity where
  TxValidity
TxValid /\ :: TxValidity -> TxValidity -> TxValidity
/\ TxValidity
TxValid     = TxValidity
TxValid
  TxValidity
TxInvalid /\ TxValidity
TxInvalid = TxValidity
TxInvalid
  TxValidity
_ /\ TxValidity
_                 = TxValidity
UnknownValidity


-- | How many blocks deep the tx is on the chain
newtype Depth = Depth { Depth -> Int
unDepth :: Int }
    deriving stock (Depth -> Depth -> Bool
(Depth -> Depth -> Bool) -> (Depth -> Depth -> Bool) -> Eq Depth
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Depth -> Depth -> Bool
$c/= :: Depth -> Depth -> Bool
== :: Depth -> Depth -> Bool
$c== :: Depth -> Depth -> Bool
Eq, Eq Depth
Eq Depth
-> (Depth -> Depth -> Ordering)
-> (Depth -> Depth -> Bool)
-> (Depth -> Depth -> Bool)
-> (Depth -> Depth -> Bool)
-> (Depth -> Depth -> Bool)
-> (Depth -> Depth -> Depth)
-> (Depth -> Depth -> Depth)
-> Ord Depth
Depth -> Depth -> Bool
Depth -> Depth -> Ordering
Depth -> Depth -> Depth
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
min :: Depth -> Depth -> Depth
$cmin :: Depth -> Depth -> Depth
max :: Depth -> Depth -> Depth
$cmax :: Depth -> Depth -> Depth
>= :: Depth -> Depth -> Bool
$c>= :: Depth -> Depth -> Bool
> :: Depth -> Depth -> Bool
$c> :: Depth -> Depth -> Bool
<= :: Depth -> Depth -> Bool
$c<= :: Depth -> Depth -> Bool
< :: Depth -> Depth -> Bool
$c< :: Depth -> Depth -> Bool
compare :: Depth -> Depth -> Ordering
$ccompare :: Depth -> Depth -> Ordering
$cp1Ord :: Eq Depth
Ord, Int -> Depth -> ShowS
[Depth] -> ShowS
Depth -> String
(Int -> Depth -> ShowS)
-> (Depth -> String) -> ([Depth] -> ShowS) -> Show Depth
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Depth] -> ShowS
$cshowList :: [Depth] -> ShowS
show :: Depth -> String
$cshow :: Depth -> String
showsPrec :: Int -> Depth -> ShowS
$cshowsPrec :: Int -> Depth -> ShowS
Show, (forall x. Depth -> Rep Depth x)
-> (forall x. Rep Depth x -> Depth) -> Generic Depth
forall x. Rep Depth x -> Depth
forall x. Depth -> Rep Depth x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Depth x -> Depth
$cfrom :: forall x. Depth -> Rep Depth x
Generic)
    deriving newtype (Integer -> Depth
Depth -> Depth
Depth -> Depth -> Depth
(Depth -> Depth -> Depth)
-> (Depth -> Depth -> Depth)
-> (Depth -> Depth -> Depth)
-> (Depth -> Depth)
-> (Depth -> Depth)
-> (Depth -> Depth)
-> (Integer -> Depth)
-> Num Depth
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Depth
$cfromInteger :: Integer -> Depth
signum :: Depth -> Depth
$csignum :: Depth -> Depth
abs :: Depth -> Depth
$cabs :: Depth -> Depth
negate :: Depth -> Depth
$cnegate :: Depth -> Depth
* :: Depth -> Depth -> Depth
$c* :: Depth -> Depth -> Depth
- :: Depth -> Depth -> Depth
$c- :: Depth -> Depth -> Depth
+ :: Depth -> Depth -> Depth
$c+ :: Depth -> Depth -> Depth
Num, Num Depth
Ord Depth
Num Depth -> Ord Depth -> (Depth -> Rational) -> Real Depth
Depth -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: Depth -> Rational
$ctoRational :: Depth -> Rational
$cp2Real :: Ord Depth
$cp1Real :: Num Depth
Real, Int -> Depth
Depth -> Int
Depth -> [Depth]
Depth -> Depth
Depth -> Depth -> [Depth]
Depth -> Depth -> Depth -> [Depth]
(Depth -> Depth)
-> (Depth -> Depth)
-> (Int -> Depth)
-> (Depth -> Int)
-> (Depth -> [Depth])
-> (Depth -> Depth -> [Depth])
-> (Depth -> Depth -> [Depth])
-> (Depth -> Depth -> Depth -> [Depth])
-> Enum Depth
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: Depth -> Depth -> Depth -> [Depth]
$cenumFromThenTo :: Depth -> Depth -> Depth -> [Depth]
enumFromTo :: Depth -> Depth -> [Depth]
$cenumFromTo :: Depth -> Depth -> [Depth]
enumFromThen :: Depth -> Depth -> [Depth]
$cenumFromThen :: Depth -> Depth -> [Depth]
enumFrom :: Depth -> [Depth]
$cenumFrom :: Depth -> [Depth]
fromEnum :: Depth -> Int
$cfromEnum :: Depth -> Int
toEnum :: Int -> Depth
$ctoEnum :: Int -> Depth
pred :: Depth -> Depth
$cpred :: Depth -> Depth
succ :: Depth -> Depth
$csucc :: Depth -> Depth
Enum, Enum Depth
Real Depth
Real Depth
-> Enum Depth
-> (Depth -> Depth -> Depth)
-> (Depth -> Depth -> Depth)
-> (Depth -> Depth -> Depth)
-> (Depth -> Depth -> Depth)
-> (Depth -> Depth -> (Depth, Depth))
-> (Depth -> Depth -> (Depth, Depth))
-> (Depth -> Integer)
-> Integral Depth
Depth -> Integer
Depth -> Depth -> (Depth, Depth)
Depth -> Depth -> Depth
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: Depth -> Integer
$ctoInteger :: Depth -> Integer
divMod :: Depth -> Depth -> (Depth, Depth)
$cdivMod :: Depth -> Depth -> (Depth, Depth)
quotRem :: Depth -> Depth -> (Depth, Depth)
$cquotRem :: Depth -> Depth -> (Depth, Depth)
mod :: Depth -> Depth -> Depth
$cmod :: Depth -> Depth -> Depth
div :: Depth -> Depth -> Depth
$cdiv :: Depth -> Depth -> Depth
rem :: Depth -> Depth -> Depth
$crem :: Depth -> Depth -> Depth
quot :: Depth -> Depth -> Depth
$cquot :: Depth -> Depth -> Depth
$cp2Integral :: Enum Depth
$cp1Integral :: Real Depth
Integral, [Depth] -> Doc ann
Depth -> Doc ann
(forall ann. Depth -> Doc ann)
-> (forall ann. [Depth] -> Doc ann) -> Pretty Depth
forall ann. [Depth] -> Doc ann
forall ann. Depth -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [Depth] -> Doc ann
$cprettyList :: forall ann. [Depth] -> Doc ann
pretty :: Depth -> Doc ann
$cpretty :: forall ann. Depth -> Doc ann
Pretty, [Depth] -> Encoding
[Depth] -> Value
Depth -> Encoding
Depth -> Value
(Depth -> Value)
-> (Depth -> Encoding)
-> ([Depth] -> Value)
-> ([Depth] -> Encoding)
-> ToJSON Depth
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Depth] -> Encoding
$ctoEncodingList :: [Depth] -> Encoding
toJSONList :: [Depth] -> Value
$ctoJSONList :: [Depth] -> Value
toEncoding :: Depth -> Encoding
$ctoEncoding :: Depth -> Encoding
toJSON :: Depth -> Value
$ctoJSON :: Depth -> Value
ToJSON, Value -> Parser [Depth]
Value -> Parser Depth
(Value -> Parser Depth)
-> (Value -> Parser [Depth]) -> FromJSON Depth
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Depth]
$cparseJSONList :: Value -> Parser [Depth]
parseJSON :: Value -> Parser Depth
$cparseJSON :: Value -> Parser Depth
FromJSON)

instance MeetSemiLattice Depth where
  Depth Int
a /\ :: Depth -> Depth -> Depth
/\ Depth Int
b = Int -> Depth
Depth (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
a Int
b)

{- Note [TxStatus state machine]

The status of a transaction is described by the following state machine.

Current state | Next state(s)
-----------------------------------------------------
Unknown       | OnChain
OnChain       | OnChain, Unknown, Committed
Committed     | -

The initial state after submitting the transaction is Unknown.
-}

-- | The status of a Cardano transaction
type TxStatus = RollbackState ()

-- | The rollback state of a Cardano transaction
data RollbackState a =
    Unknown
    -- ^ The transaction is not on the chain. That's all we can say.
  | TentativelyConfirmed Depth TxValidity a
    -- ^ The transaction is on the chain, n blocks deep. It can still be rolled
    -- back.
  | Committed TxValidity a
    -- ^ The transaction is on the chain. It cannot be rolled back anymore.
  deriving stock (RollbackState a -> RollbackState a -> Bool
(RollbackState a -> RollbackState a -> Bool)
-> (RollbackState a -> RollbackState a -> Bool)
-> Eq (RollbackState a)
forall a. Eq a => RollbackState a -> RollbackState a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RollbackState a -> RollbackState a -> Bool
$c/= :: forall a. Eq a => RollbackState a -> RollbackState a -> Bool
== :: RollbackState a -> RollbackState a -> Bool
$c== :: forall a. Eq a => RollbackState a -> RollbackState a -> Bool
Eq, Eq (RollbackState a)
Eq (RollbackState a)
-> (RollbackState a -> RollbackState a -> Ordering)
-> (RollbackState a -> RollbackState a -> Bool)
-> (RollbackState a -> RollbackState a -> Bool)
-> (RollbackState a -> RollbackState a -> Bool)
-> (RollbackState a -> RollbackState a -> Bool)
-> (RollbackState a -> RollbackState a -> RollbackState a)
-> (RollbackState a -> RollbackState a -> RollbackState a)
-> Ord (RollbackState a)
RollbackState a -> RollbackState a -> Bool
RollbackState a -> RollbackState a -> Ordering
RollbackState a -> RollbackState a -> RollbackState a
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
forall a. Ord a => Eq (RollbackState a)
forall a. Ord a => RollbackState a -> RollbackState a -> Bool
forall a. Ord a => RollbackState a -> RollbackState a -> Ordering
forall a.
Ord a =>
RollbackState a -> RollbackState a -> RollbackState a
min :: RollbackState a -> RollbackState a -> RollbackState a
$cmin :: forall a.
Ord a =>
RollbackState a -> RollbackState a -> RollbackState a
max :: RollbackState a -> RollbackState a -> RollbackState a
$cmax :: forall a.
Ord a =>
RollbackState a -> RollbackState a -> RollbackState a
>= :: RollbackState a -> RollbackState a -> Bool
$c>= :: forall a. Ord a => RollbackState a -> RollbackState a -> Bool
> :: RollbackState a -> RollbackState a -> Bool
$c> :: forall a. Ord a => RollbackState a -> RollbackState a -> Bool
<= :: RollbackState a -> RollbackState a -> Bool
$c<= :: forall a. Ord a => RollbackState a -> RollbackState a -> Bool
< :: RollbackState a -> RollbackState a -> Bool
$c< :: forall a. Ord a => RollbackState a -> RollbackState a -> Bool
compare :: RollbackState a -> RollbackState a -> Ordering
$ccompare :: forall a. Ord a => RollbackState a -> RollbackState a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (RollbackState a)
Ord, Int -> RollbackState a -> ShowS
[RollbackState a] -> ShowS
RollbackState a -> String
(Int -> RollbackState a -> ShowS)
-> (RollbackState a -> String)
-> ([RollbackState a] -> ShowS)
-> Show (RollbackState a)
forall a. Show a => Int -> RollbackState a -> ShowS
forall a. Show a => [RollbackState a] -> ShowS
forall a. Show a => RollbackState a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RollbackState a] -> ShowS
$cshowList :: forall a. Show a => [RollbackState a] -> ShowS
show :: RollbackState a -> String
$cshow :: forall a. Show a => RollbackState a -> String
showsPrec :: Int -> RollbackState a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> RollbackState a -> ShowS
Show, (forall x. RollbackState a -> Rep (RollbackState a) x)
-> (forall x. Rep (RollbackState a) x -> RollbackState a)
-> Generic (RollbackState a)
forall x. Rep (RollbackState a) x -> RollbackState a
forall x. RollbackState a -> Rep (RollbackState a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (RollbackState a) x -> RollbackState a
forall a x. RollbackState a -> Rep (RollbackState a) x
$cto :: forall a x. Rep (RollbackState a) x -> RollbackState a
$cfrom :: forall a x. RollbackState a -> Rep (RollbackState a) x
Generic, a -> RollbackState b -> RollbackState a
(a -> b) -> RollbackState a -> RollbackState b
(forall a b. (a -> b) -> RollbackState a -> RollbackState b)
-> (forall a b. a -> RollbackState b -> RollbackState a)
-> Functor RollbackState
forall a b. a -> RollbackState b -> RollbackState a
forall a b. (a -> b) -> RollbackState a -> RollbackState b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> RollbackState b -> RollbackState a
$c<$ :: forall a b. a -> RollbackState b -> RollbackState a
fmap :: (a -> b) -> RollbackState a -> RollbackState b
$cfmap :: forall a b. (a -> b) -> RollbackState a -> RollbackState b
Functor)
  deriving anyclass ([RollbackState a] -> Encoding
[RollbackState a] -> Value
RollbackState a -> Encoding
RollbackState a -> Value
(RollbackState a -> Value)
-> (RollbackState a -> Encoding)
-> ([RollbackState a] -> Value)
-> ([RollbackState a] -> Encoding)
-> ToJSON (RollbackState a)
forall a. ToJSON a => [RollbackState a] -> Encoding
forall a. ToJSON a => [RollbackState a] -> Value
forall a. ToJSON a => RollbackState a -> Encoding
forall a. ToJSON a => RollbackState a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RollbackState a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [RollbackState a] -> Encoding
toJSONList :: [RollbackState a] -> Value
$ctoJSONList :: forall a. ToJSON a => [RollbackState a] -> Value
toEncoding :: RollbackState a -> Encoding
$ctoEncoding :: forall a. ToJSON a => RollbackState a -> Encoding
toJSON :: RollbackState a -> Value
$ctoJSON :: forall a. ToJSON a => RollbackState a -> Value
ToJSON, Value -> Parser [RollbackState a]
Value -> Parser (RollbackState a)
(Value -> Parser (RollbackState a))
-> (Value -> Parser [RollbackState a])
-> FromJSON (RollbackState a)
forall a. FromJSON a => Value -> Parser [RollbackState a]
forall a. FromJSON a => Value -> Parser (RollbackState a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RollbackState a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [RollbackState a]
parseJSON :: Value -> Parser (RollbackState a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (RollbackState a)
FromJSON)
  deriving [RollbackState a] -> Doc ann
RollbackState a -> Doc ann
(forall ann. RollbackState a -> Doc ann)
-> (forall ann. [RollbackState a] -> Doc ann)
-> Pretty (RollbackState a)
forall a ann. Show a => [RollbackState a] -> Doc ann
forall a ann. Show a => RollbackState a -> Doc ann
forall ann. [RollbackState a] -> Doc ann
forall ann. RollbackState a -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [RollbackState a] -> Doc ann
$cprettyList :: forall a ann. Show a => [RollbackState a] -> Doc ann
pretty :: RollbackState a -> Doc ann
$cpretty :: forall a ann. Show a => RollbackState a -> Doc ann
Pretty via (PrettyShow (RollbackState a))

instance MeetSemiLattice a => MeetSemiLattice (RollbackState a) where
  RollbackState a
Unknown /\ :: RollbackState a -> RollbackState a -> RollbackState a
/\ RollbackState a
a = RollbackState a
a
  RollbackState a
a /\ RollbackState a
Unknown = RollbackState a
a
  TentativelyConfirmed Depth
d1 TxValidity
v1 a
a1 /\ TentativelyConfirmed Depth
d2 TxValidity
v2 a
a2 =
    Depth -> TxValidity -> a -> RollbackState a
forall a. Depth -> TxValidity -> a -> RollbackState a
TentativelyConfirmed (Depth
d1 Depth -> Depth -> Depth
forall a. MeetSemiLattice a => a -> a -> a
/\ Depth
d2) (TxValidity
v1 TxValidity -> TxValidity -> TxValidity
forall a. MeetSemiLattice a => a -> a -> a
/\ TxValidity
v2) (a
a1 a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ a
a2)
  TentativelyConfirmed Depth
_ TxValidity
v1 a
a1 /\ Committed TxValidity
v2 a
a2 = TxValidity -> a -> RollbackState a
forall a. TxValidity -> a -> RollbackState a
Committed (TxValidity
v1 TxValidity -> TxValidity -> TxValidity
forall a. MeetSemiLattice a => a -> a -> a
/\ TxValidity
v2) (a
a1 a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ a
a2)
  Committed TxValidity
v1 a
a1 /\ TentativelyConfirmed Depth
_ TxValidity
v2 a
a2 = TxValidity -> a -> RollbackState a
forall a. TxValidity -> a -> RollbackState a
Committed (TxValidity
v1 TxValidity -> TxValidity -> TxValidity
forall a. MeetSemiLattice a => a -> a -> a
/\ TxValidity
v2) (a
a1 a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ a
a2)
  Committed TxValidity
v1 a
a1 /\ Committed TxValidity
v2 a
a2 = TxValidity -> a -> RollbackState a
forall a. TxValidity -> a -> RollbackState a
Committed (TxValidity
v1 TxValidity -> TxValidity -> TxValidity
forall a. MeetSemiLattice a => a -> a -> a
/\ TxValidity
v2) (a
a1 a -> a -> a
forall a. MeetSemiLattice a => a -> a -> a
/\ a
a2)


{- Note [TxOutStatus state machine]

The status of a transaction output is described by the following state machine.

Current state           | Next state(s)
-----------------------------------------------------
TxOutUnknown            | TxOutTentativelyUnspent
TxOutTentativelyUnspent | TxOutUnknown, TxOutTentativelySpent, TxOutConfirmedUnspent
TxOutTentativelySpent   | TxOutUnknown, TxOutConfirmedSpent
TxOutConfirmedUnspent   | TxOutConfirmedSpent
TxOutConfirmedSpent     | -

The initial state after submitting the transaction is 'TxOutUnknown'.
-}

type TxOutStatus = RollbackState TxOutState

data TxOutState = Spent TxId -- Spent by this transaction
                | Unspent
  deriving stock (TxOutState -> TxOutState -> Bool
(TxOutState -> TxOutState -> Bool)
-> (TxOutState -> TxOutState -> Bool) -> Eq TxOutState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxOutState -> TxOutState -> Bool
$c/= :: TxOutState -> TxOutState -> Bool
== :: TxOutState -> TxOutState -> Bool
$c== :: TxOutState -> TxOutState -> Bool
Eq, Eq TxOutState
Eq TxOutState
-> (TxOutState -> TxOutState -> Ordering)
-> (TxOutState -> TxOutState -> Bool)
-> (TxOutState -> TxOutState -> Bool)
-> (TxOutState -> TxOutState -> Bool)
-> (TxOutState -> TxOutState -> Bool)
-> (TxOutState -> TxOutState -> TxOutState)
-> (TxOutState -> TxOutState -> TxOutState)
-> Ord TxOutState
TxOutState -> TxOutState -> Bool
TxOutState -> TxOutState -> Ordering
TxOutState -> TxOutState -> TxOutState
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
min :: TxOutState -> TxOutState -> TxOutState
$cmin :: TxOutState -> TxOutState -> TxOutState
max :: TxOutState -> TxOutState -> TxOutState
$cmax :: TxOutState -> TxOutState -> TxOutState
>= :: TxOutState -> TxOutState -> Bool
$c>= :: TxOutState -> TxOutState -> Bool
> :: TxOutState -> TxOutState -> Bool
$c> :: TxOutState -> TxOutState -> Bool
<= :: TxOutState -> TxOutState -> Bool
$c<= :: TxOutState -> TxOutState -> Bool
< :: TxOutState -> TxOutState -> Bool
$c< :: TxOutState -> TxOutState -> Bool
compare :: TxOutState -> TxOutState -> Ordering
$ccompare :: TxOutState -> TxOutState -> Ordering
$cp1Ord :: Eq TxOutState
Ord, Int -> TxOutState -> ShowS
[TxOutState] -> ShowS
TxOutState -> String
(Int -> TxOutState -> ShowS)
-> (TxOutState -> String)
-> ([TxOutState] -> ShowS)
-> Show TxOutState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOutState] -> ShowS
$cshowList :: [TxOutState] -> ShowS
show :: TxOutState -> String
$cshow :: TxOutState -> String
showsPrec :: Int -> TxOutState -> ShowS
$cshowsPrec :: Int -> TxOutState -> ShowS
Show, (forall x. TxOutState -> Rep TxOutState x)
-> (forall x. Rep TxOutState x -> TxOutState) -> Generic TxOutState
forall x. Rep TxOutState x -> TxOutState
forall x. TxOutState -> Rep TxOutState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxOutState x -> TxOutState
$cfrom :: forall x. TxOutState -> Rep TxOutState x
Generic)
  deriving anyclass ([TxOutState] -> Encoding
[TxOutState] -> Value
TxOutState -> Encoding
TxOutState -> Value
(TxOutState -> Value)
-> (TxOutState -> Encoding)
-> ([TxOutState] -> Value)
-> ([TxOutState] -> Encoding)
-> ToJSON TxOutState
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TxOutState] -> Encoding
$ctoEncodingList :: [TxOutState] -> Encoding
toJSONList :: [TxOutState] -> Value
$ctoJSONList :: [TxOutState] -> Value
toEncoding :: TxOutState -> Encoding
$ctoEncoding :: TxOutState -> Encoding
toJSON :: TxOutState -> Value
$ctoJSON :: TxOutState -> Value
ToJSON, Value -> Parser [TxOutState]
Value -> Parser TxOutState
(Value -> Parser TxOutState)
-> (Value -> Parser [TxOutState]) -> FromJSON TxOutState
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TxOutState]
$cparseJSONList :: Value -> Parser [TxOutState]
parseJSON :: Value -> Parser TxOutState
$cparseJSON :: Value -> Parser TxOutState
FromJSON)
  deriving [TxOutState] -> Doc ann
TxOutState -> Doc ann
(forall ann. TxOutState -> Doc ann)
-> (forall ann. [TxOutState] -> Doc ann) -> Pretty TxOutState
forall ann. [TxOutState] -> Doc ann
forall ann. TxOutState -> Doc ann
forall a.
(forall ann. a -> Doc ann)
-> (forall ann. [a] -> Doc ann) -> Pretty a
prettyList :: [TxOutState] -> Doc ann
$cprettyList :: forall ann. [TxOutState] -> Doc ann
pretty :: TxOutState -> Doc ann
$cpretty :: forall ann. TxOutState -> Doc ann
Pretty via (PrettyShow TxOutState)

-- | Maybe extract the 'TxOutState' (Spent or Unspent) of a 'TxOutStatus'.
txOutStatusTxOutState :: TxOutStatus -> Maybe TxOutState
txOutStatusTxOutState :: TxOutStatus -> Maybe TxOutState
txOutStatusTxOutState TxOutStatus
Unknown                      = Maybe TxOutState
forall a. Maybe a
Nothing
txOutStatusTxOutState (TentativelyConfirmed Depth
_ TxValidity
_ TxOutState
s) = TxOutState -> Maybe TxOutState
forall a. a -> Maybe a
Just TxOutState
s
txOutStatusTxOutState (Committed TxValidity
_ TxOutState
s)              = TxOutState -> Maybe TxOutState
forall a. a -> Maybe a
Just TxOutState
s

-- | Converts a 'TxOutStatus' to a 'TxStatus'. Possible since a transaction
-- output belongs to a transaction.
--
-- Note, however, that we can't convert a 'TxStatus' to a 'TxOutStatus'.
liftTxOutStatus :: TxOutStatus -> TxStatus
liftTxOutStatus :: TxOutStatus -> TxStatus
liftTxOutStatus = TxOutStatus -> TxStatus
forall (f :: * -> *) a. Functor f => f a -> f ()
void

data Diagnostics =
    Diagnostics
        { Diagnostics -> Integer
numTransactions    :: Integer
        , Diagnostics -> Integer
numScripts         :: Integer
        , Diagnostics -> Integer
numAddresses       :: Integer
        , Diagnostics -> Integer
numAssetClasses    :: Integer
        , Diagnostics -> Int
numUnspentOutputs  :: Int
        , Diagnostics -> Int
numUnmatchedInputs :: Int
        , Diagnostics -> [TxId]
someTransactions   :: [TxId]
        , Diagnostics -> [ChainIndexTxOut]
unspentTxOuts      :: [ChainIndexTxOut]
        }
        deriving stock (Diagnostics -> Diagnostics -> Bool
(Diagnostics -> Diagnostics -> Bool)
-> (Diagnostics -> Diagnostics -> Bool) -> Eq Diagnostics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Diagnostics -> Diagnostics -> Bool
$c/= :: Diagnostics -> Diagnostics -> Bool
== :: Diagnostics -> Diagnostics -> Bool
$c== :: Diagnostics -> Diagnostics -> Bool
Eq, Int -> Diagnostics -> ShowS
[Diagnostics] -> ShowS
Diagnostics -> String
(Int -> Diagnostics -> ShowS)
-> (Diagnostics -> String)
-> ([Diagnostics] -> ShowS)
-> Show Diagnostics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Diagnostics] -> ShowS
$cshowList :: [Diagnostics] -> ShowS
show :: Diagnostics -> String
$cshow :: Diagnostics -> String
showsPrec :: Int -> Diagnostics -> ShowS
$cshowsPrec :: Int -> Diagnostics -> ShowS
Show, (forall x. Diagnostics -> Rep Diagnostics x)
-> (forall x. Rep Diagnostics x -> Diagnostics)
-> Generic Diagnostics
forall x. Rep Diagnostics x -> Diagnostics
forall x. Diagnostics -> Rep Diagnostics x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Diagnostics x -> Diagnostics
$cfrom :: forall x. Diagnostics -> Rep Diagnostics x
Generic)
        deriving anyclass ([Diagnostics] -> Encoding
[Diagnostics] -> Value
Diagnostics -> Encoding
Diagnostics -> Value
(Diagnostics -> Value)
-> (Diagnostics -> Encoding)
-> ([Diagnostics] -> Value)
-> ([Diagnostics] -> Encoding)
-> ToJSON Diagnostics
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Diagnostics] -> Encoding
$ctoEncodingList :: [Diagnostics] -> Encoding
toJSONList :: [Diagnostics] -> Value
$ctoJSONList :: [Diagnostics] -> Value
toEncoding :: Diagnostics -> Encoding
$ctoEncoding :: Diagnostics -> Encoding
toJSON :: Diagnostics -> Value
$ctoJSON :: Diagnostics -> Value
ToJSON, Value -> Parser [Diagnostics]
Value -> Parser Diagnostics
(Value -> Parser Diagnostics)
-> (Value -> Parser [Diagnostics]) -> FromJSON Diagnostics
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Diagnostics]
$cparseJSONList :: Value -> Parser [Diagnostics]
parseJSON :: Value -> Parser Diagnostics
$cparseJSON :: Value -> Parser Diagnostics
FromJSON, Typeable Diagnostics
Typeable Diagnostics
-> (Proxy Diagnostics -> Declare (Definitions Schema) NamedSchema)
-> ToSchema Diagnostics
Proxy Diagnostics -> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
declareNamedSchema :: Proxy Diagnostics -> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: Proxy Diagnostics -> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: Typeable Diagnostics
OpenApi.ToSchema)

-- | Datatype returned when we couldn't get the state of a tx or a tx output.
data TxStatusFailure
      -- | We couldn't return the status because the 'TxIdState' was in a ...
      -- state ... that we didn't know how to decode in
      -- 'Plutus.ChainIndex.TxIdState.transactionStatus'.
      = TxIdStateInvalid BlockNumber TxId TxIdState
      -- | We couldn't return the status because the 'TxOutBalance' does not
      -- contain the target tx output.
      | TxOutBalanceStateInvalid BlockNumber TxOutRef TxOutBalance
      | InvalidRollbackAttempt BlockNumber TxId TxIdState
      deriving (Int -> TxStatusFailure -> ShowS
[TxStatusFailure] -> ShowS
TxStatusFailure -> String
(Int -> TxStatusFailure -> ShowS)
-> (TxStatusFailure -> String)
-> ([TxStatusFailure] -> ShowS)
-> Show TxStatusFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxStatusFailure] -> ShowS
$cshowList :: [TxStatusFailure] -> ShowS
show :: TxStatusFailure -> String
$cshow :: TxStatusFailure -> String
showsPrec :: Int -> TxStatusFailure -> ShowS
$cshowsPrec :: Int -> TxStatusFailure -> ShowS
Show, TxStatusFailure -> TxStatusFailure -> Bool
(TxStatusFailure -> TxStatusFailure -> Bool)
-> (TxStatusFailure -> TxStatusFailure -> Bool)
-> Eq TxStatusFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxStatusFailure -> TxStatusFailure -> Bool
$c/= :: TxStatusFailure -> TxStatusFailure -> Bool
== :: TxStatusFailure -> TxStatusFailure -> Bool
$c== :: TxStatusFailure -> TxStatusFailure -> Bool
Eq)

data TxIdState = TxIdState
  { TxIdState -> Map TxId TxConfirmedState
txnsConfirmed :: Map TxId TxConfirmedState
  -- ^ Number of times this transaction has been added as well as other
  -- necessary metadata.
  , TxIdState -> Map TxId (Sum Int)
txnsDeleted   :: Map TxId (Sum Int)
  -- ^ Number of times this transaction has been deleted.
  }
  deriving stock (TxIdState -> TxIdState -> Bool
(TxIdState -> TxIdState -> Bool)
-> (TxIdState -> TxIdState -> Bool) -> Eq TxIdState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxIdState -> TxIdState -> Bool
$c/= :: TxIdState -> TxIdState -> Bool
== :: TxIdState -> TxIdState -> Bool
$c== :: TxIdState -> TxIdState -> Bool
Eq, (forall x. TxIdState -> Rep TxIdState x)
-> (forall x. Rep TxIdState x -> TxIdState) -> Generic TxIdState
forall x. Rep TxIdState x -> TxIdState
forall x. TxIdState -> Rep TxIdState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxIdState x -> TxIdState
$cfrom :: forall x. TxIdState -> Rep TxIdState x
Generic, Int -> TxIdState -> ShowS
[TxIdState] -> ShowS
TxIdState -> String
(Int -> TxIdState -> ShowS)
-> (TxIdState -> String)
-> ([TxIdState] -> ShowS)
-> Show TxIdState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxIdState] -> ShowS
$cshowList :: [TxIdState] -> ShowS
show :: TxIdState -> String
$cshow :: TxIdState -> String
showsPrec :: Int -> TxIdState -> ShowS
$cshowsPrec :: Int -> TxIdState -> ShowS
Show)

-- A semigroup instance that merges the two maps, instead of taking the
-- leftmost one.
instance Semigroup TxIdState where
  TxIdState{txnsConfirmed :: TxIdState -> Map TxId TxConfirmedState
txnsConfirmed=Map TxId TxConfirmedState
c, txnsDeleted :: TxIdState -> Map TxId (Sum Int)
txnsDeleted=Map TxId (Sum Int)
d} <> :: TxIdState -> TxIdState -> TxIdState
<> TxIdState{txnsConfirmed :: TxIdState -> Map TxId TxConfirmedState
txnsConfirmed=Map TxId TxConfirmedState
c', txnsDeleted :: TxIdState -> Map TxId (Sum Int)
txnsDeleted=Map TxId (Sum Int)
d'}
    = TxIdState :: Map TxId TxConfirmedState -> Map TxId (Sum Int) -> TxIdState
TxIdState { txnsConfirmed :: Map TxId TxConfirmedState
txnsConfirmed = (TxConfirmedState -> TxConfirmedState -> TxConfirmedState)
-> Map TxId TxConfirmedState
-> Map TxId TxConfirmedState
-> Map TxId TxConfirmedState
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith TxConfirmedState -> TxConfirmedState -> TxConfirmedState
forall a. Semigroup a => a -> a -> a
(<>) Map TxId TxConfirmedState
c Map TxId TxConfirmedState
c'
                , txnsDeleted :: Map TxId (Sum Int)
txnsDeleted   = (Sum Int -> Sum Int -> Sum Int)
-> Map TxId (Sum Int) -> Map TxId (Sum Int) -> Map TxId (Sum Int)
forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith Sum Int -> Sum Int -> Sum Int
forall a. Semigroup a => a -> a -> a
(<>) Map TxId (Sum Int)
d Map TxId (Sum Int)
d'
                }

instance Monoid TxIdState where
    mappend :: TxIdState -> TxIdState -> TxIdState
mappend = TxIdState -> TxIdState -> TxIdState
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: TxIdState
mempty  = TxIdState :: Map TxId TxConfirmedState -> Map TxId (Sum Int) -> TxIdState
TxIdState { txnsConfirmed :: Map TxId TxConfirmedState
txnsConfirmed=Map TxId TxConfirmedState
forall a. Monoid a => a
mempty, txnsDeleted :: Map TxId (Sum Int)
txnsDeleted=Map TxId (Sum Int)
forall a. Monoid a => a
mempty }

data TxConfirmedState =
  TxConfirmedState
    { TxConfirmedState -> Sum Int
timesConfirmed :: Sum Int
    , TxConfirmedState -> Last BlockNumber
blockAdded     :: Last BlockNumber
    , TxConfirmedState -> Last TxValidity
validity       :: Last TxValidity
    }
    deriving stock (TxConfirmedState -> TxConfirmedState -> Bool
(TxConfirmedState -> TxConfirmedState -> Bool)
-> (TxConfirmedState -> TxConfirmedState -> Bool)
-> Eq TxConfirmedState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxConfirmedState -> TxConfirmedState -> Bool
$c/= :: TxConfirmedState -> TxConfirmedState -> Bool
== :: TxConfirmedState -> TxConfirmedState -> Bool
$c== :: TxConfirmedState -> TxConfirmedState -> Bool
Eq, (forall x. TxConfirmedState -> Rep TxConfirmedState x)
-> (forall x. Rep TxConfirmedState x -> TxConfirmedState)
-> Generic TxConfirmedState
forall x. Rep TxConfirmedState x -> TxConfirmedState
forall x. TxConfirmedState -> Rep TxConfirmedState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxConfirmedState x -> TxConfirmedState
$cfrom :: forall x. TxConfirmedState -> Rep TxConfirmedState x
Generic, Int -> TxConfirmedState -> ShowS
[TxConfirmedState] -> ShowS
TxConfirmedState -> String
(Int -> TxConfirmedState -> ShowS)
-> (TxConfirmedState -> String)
-> ([TxConfirmedState] -> ShowS)
-> Show TxConfirmedState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxConfirmedState] -> ShowS
$cshowList :: [TxConfirmedState] -> ShowS
show :: TxConfirmedState -> String
$cshow :: TxConfirmedState -> String
showsPrec :: Int -> TxConfirmedState -> ShowS
$cshowsPrec :: Int -> TxConfirmedState -> ShowS
Show)
    deriving (Semigroup TxConfirmedState
TxConfirmedState
Semigroup TxConfirmedState
-> TxConfirmedState
-> (TxConfirmedState -> TxConfirmedState -> TxConfirmedState)
-> ([TxConfirmedState] -> TxConfirmedState)
-> Monoid TxConfirmedState
[TxConfirmedState] -> TxConfirmedState
TxConfirmedState -> TxConfirmedState -> TxConfirmedState
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [TxConfirmedState] -> TxConfirmedState
$cmconcat :: [TxConfirmedState] -> TxConfirmedState
mappend :: TxConfirmedState -> TxConfirmedState -> TxConfirmedState
$cmappend :: TxConfirmedState -> TxConfirmedState -> TxConfirmedState
mempty :: TxConfirmedState
$cmempty :: TxConfirmedState
$cp1Monoid :: Semigroup TxConfirmedState
Monoid) via (GenericSemigroupMonoid TxConfirmedState)

instance Semigroup TxConfirmedState where
    (TxConfirmedState Sum Int
tc Last BlockNumber
ba Last TxValidity
v) <> :: TxConfirmedState -> TxConfirmedState -> TxConfirmedState
<> (TxConfirmedState Sum Int
tc' Last BlockNumber
ba' Last TxValidity
v') =
        Sum Int -> Last BlockNumber -> Last TxValidity -> TxConfirmedState
TxConfirmedState (Sum Int
tc Sum Int -> Sum Int -> Sum Int
forall a. Semigroup a => a -> a -> a
<> Sum Int
tc') (Last BlockNumber
ba Last BlockNumber -> Last BlockNumber -> Last BlockNumber
forall a. Semigroup a => a -> a -> a
<> Last BlockNumber
ba') (Last TxValidity
v Last TxValidity -> Last TxValidity -> Last TxValidity
forall a. Semigroup a => a -> a -> a
<> Last TxValidity
v')

-- | The effect of a transaction (or a number of them) on the tx output set.
data TxOutBalance =
  TxOutBalance
    { TxOutBalance -> Set TxOutRef
_tobUnspentOutputs :: Set TxOutRef
    -- ^ Outputs newly added by the transaction(s)
    , TxOutBalance -> Map TxOutRef TxId
_tobSpentOutputs   :: Map TxOutRef TxId
    -- ^ Outputs spent by the transaction(s) along with the tx id that spent it
    }
    deriving stock (TxOutBalance -> TxOutBalance -> Bool
(TxOutBalance -> TxOutBalance -> Bool)
-> (TxOutBalance -> TxOutBalance -> Bool) -> Eq TxOutBalance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxOutBalance -> TxOutBalance -> Bool
$c/= :: TxOutBalance -> TxOutBalance -> Bool
== :: TxOutBalance -> TxOutBalance -> Bool
$c== :: TxOutBalance -> TxOutBalance -> Bool
Eq, Int -> TxOutBalance -> ShowS
[TxOutBalance] -> ShowS
TxOutBalance -> String
(Int -> TxOutBalance -> ShowS)
-> (TxOutBalance -> String)
-> ([TxOutBalance] -> ShowS)
-> Show TxOutBalance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxOutBalance] -> ShowS
$cshowList :: [TxOutBalance] -> ShowS
show :: TxOutBalance -> String
$cshow :: TxOutBalance -> String
showsPrec :: Int -> TxOutBalance -> ShowS
$cshowsPrec :: Int -> TxOutBalance -> ShowS
Show, (forall x. TxOutBalance -> Rep TxOutBalance x)
-> (forall x. Rep TxOutBalance x -> TxOutBalance)
-> Generic TxOutBalance
forall x. Rep TxOutBalance x -> TxOutBalance
forall x. TxOutBalance -> Rep TxOutBalance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxOutBalance x -> TxOutBalance
$cfrom :: forall x. TxOutBalance -> Rep TxOutBalance x
Generic)
    deriving anyclass (Value -> Parser [TxOutBalance]
Value -> Parser TxOutBalance
(Value -> Parser TxOutBalance)
-> (Value -> Parser [TxOutBalance]) -> FromJSON TxOutBalance
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TxOutBalance]
$cparseJSONList :: Value -> Parser [TxOutBalance]
parseJSON :: Value -> Parser TxOutBalance
$cparseJSON :: Value -> Parser TxOutBalance
FromJSON, [TxOutBalance] -> Encoding
[TxOutBalance] -> Value
TxOutBalance -> Encoding
TxOutBalance -> Value
(TxOutBalance -> Value)
-> (TxOutBalance -> Encoding)
-> ([TxOutBalance] -> Value)
-> ([TxOutBalance] -> Encoding)
-> ToJSON TxOutBalance
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TxOutBalance] -> Encoding
$ctoEncodingList :: [TxOutBalance] -> Encoding
toJSONList :: [TxOutBalance] -> Value
$ctoJSONList :: [TxOutBalance] -> Value
toEncoding :: TxOutBalance -> Encoding
$ctoEncoding :: TxOutBalance -> Encoding
toJSON :: TxOutBalance -> Value
$ctoJSON :: TxOutBalance -> Value
ToJSON)

instance Semigroup TxOutBalance where
    TxOutBalance
l <> :: TxOutBalance -> TxOutBalance -> TxOutBalance
<> TxOutBalance
r =
        TxOutBalance :: Set TxOutRef -> Map TxOutRef TxId -> TxOutBalance
TxOutBalance
            { _tobUnspentOutputs :: Set TxOutRef
_tobUnspentOutputs = TxOutBalance -> Set TxOutRef
_tobUnspentOutputs TxOutBalance
r
                                Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Semigroup a => a -> a -> a
<> (TxOutBalance -> Set TxOutRef
_tobUnspentOutputs TxOutBalance
l Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` Map TxOutRef TxId -> Set TxOutRef
forall k a. Map k a -> Set k
Map.keysSet (TxOutBalance -> Map TxOutRef TxId
_tobSpentOutputs TxOutBalance
r))
            , _tobSpentOutputs :: Map TxOutRef TxId
_tobSpentOutputs   = TxOutBalance -> Map TxOutRef TxId
_tobSpentOutputs TxOutBalance
l Map TxOutRef TxId -> Map TxOutRef TxId -> Map TxOutRef TxId
forall a. Semigroup a => a -> a -> a
<> TxOutBalance -> Map TxOutRef TxId
_tobSpentOutputs TxOutBalance
r
            }

instance Monoid TxOutBalance where
    mappend :: TxOutBalance -> TxOutBalance -> TxOutBalance
mappend = TxOutBalance -> TxOutBalance -> TxOutBalance
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: TxOutBalance
mempty = Set TxOutRef -> Map TxOutRef TxId -> TxOutBalance
TxOutBalance Set TxOutRef
forall a. Monoid a => a
mempty Map TxOutRef TxId
forall a. Monoid a => a
mempty

makeLenses ''TxOutBalance

-- | The effect of a transaction (or a number of them) on the utxo set.
data TxUtxoBalance =
    TxUtxoBalance
        { TxUtxoBalance -> Set TxOutRef
_tubUnspentOutputs       :: Set TxOutRef
        -- ^ Outputs newly added by the transaction(s)
        , TxUtxoBalance -> Set TxOutRef
_tubUnmatchedSpentInputs :: Set TxOutRef
        -- ^ Outputs spent by the transaction(s) that have no matching unspent output
        }
        deriving stock (TxUtxoBalance -> TxUtxoBalance -> Bool
(TxUtxoBalance -> TxUtxoBalance -> Bool)
-> (TxUtxoBalance -> TxUtxoBalance -> Bool) -> Eq TxUtxoBalance
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TxUtxoBalance -> TxUtxoBalance -> Bool
$c/= :: TxUtxoBalance -> TxUtxoBalance -> Bool
== :: TxUtxoBalance -> TxUtxoBalance -> Bool
$c== :: TxUtxoBalance -> TxUtxoBalance -> Bool
Eq, Int -> TxUtxoBalance -> ShowS
[TxUtxoBalance] -> ShowS
TxUtxoBalance -> String
(Int -> TxUtxoBalance -> ShowS)
-> (TxUtxoBalance -> String)
-> ([TxUtxoBalance] -> ShowS)
-> Show TxUtxoBalance
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxUtxoBalance] -> ShowS
$cshowList :: [TxUtxoBalance] -> ShowS
show :: TxUtxoBalance -> String
$cshow :: TxUtxoBalance -> String
showsPrec :: Int -> TxUtxoBalance -> ShowS
$cshowsPrec :: Int -> TxUtxoBalance -> ShowS
Show, (forall x. TxUtxoBalance -> Rep TxUtxoBalance x)
-> (forall x. Rep TxUtxoBalance x -> TxUtxoBalance)
-> Generic TxUtxoBalance
forall x. Rep TxUtxoBalance x -> TxUtxoBalance
forall x. TxUtxoBalance -> Rep TxUtxoBalance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TxUtxoBalance x -> TxUtxoBalance
$cfrom :: forall x. TxUtxoBalance -> Rep TxUtxoBalance x
Generic)
        deriving anyclass (Value -> Parser [TxUtxoBalance]
Value -> Parser TxUtxoBalance
(Value -> Parser TxUtxoBalance)
-> (Value -> Parser [TxUtxoBalance]) -> FromJSON TxUtxoBalance
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TxUtxoBalance]
$cparseJSONList :: Value -> Parser [TxUtxoBalance]
parseJSON :: Value -> Parser TxUtxoBalance
$cparseJSON :: Value -> Parser TxUtxoBalance
FromJSON, [TxUtxoBalance] -> Encoding
[TxUtxoBalance] -> Value
TxUtxoBalance -> Encoding
TxUtxoBalance -> Value
(TxUtxoBalance -> Value)
-> (TxUtxoBalance -> Encoding)
-> ([TxUtxoBalance] -> Value)
-> ([TxUtxoBalance] -> Encoding)
-> ToJSON TxUtxoBalance
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TxUtxoBalance] -> Encoding
$ctoEncodingList :: [TxUtxoBalance] -> Encoding
toJSONList :: [TxUtxoBalance] -> Value
$ctoJSONList :: [TxUtxoBalance] -> Value
toEncoding :: TxUtxoBalance -> Encoding
$ctoEncoding :: TxUtxoBalance -> Encoding
toJSON :: TxUtxoBalance -> Value
$ctoJSON :: TxUtxoBalance -> Value
ToJSON, [TxUtxoBalance] -> Encoding
TxUtxoBalance -> Encoding
(TxUtxoBalance -> Encoding)
-> (forall s. Decoder s TxUtxoBalance)
-> ([TxUtxoBalance] -> Encoding)
-> (forall s. Decoder s [TxUtxoBalance])
-> Serialise TxUtxoBalance
forall s. Decoder s [TxUtxoBalance]
forall s. Decoder s TxUtxoBalance
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [TxUtxoBalance]
$cdecodeList :: forall s. Decoder s [TxUtxoBalance]
encodeList :: [TxUtxoBalance] -> Encoding
$cencodeList :: [TxUtxoBalance] -> Encoding
decode :: Decoder s TxUtxoBalance
$cdecode :: forall s. Decoder s TxUtxoBalance
encode :: TxUtxoBalance -> Encoding
$cencode :: TxUtxoBalance -> Encoding
Serialise)

makeLenses ''TxUtxoBalance

instance Semigroup TxUtxoBalance where
    TxUtxoBalance
l <> :: TxUtxoBalance -> TxUtxoBalance -> TxUtxoBalance
<> TxUtxoBalance
r =
        TxUtxoBalance :: Set TxOutRef -> Set TxOutRef -> TxUtxoBalance
TxUtxoBalance
            { _tubUnspentOutputs :: Set TxOutRef
_tubUnspentOutputs       = TxUtxoBalance -> Set TxOutRef
_tubUnspentOutputs TxUtxoBalance
r
                                      Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Semigroup a => a -> a -> a
<> (TxUtxoBalance -> Set TxOutRef
_tubUnspentOutputs TxUtxoBalance
l Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` TxUtxoBalance -> Set TxOutRef
_tubUnmatchedSpentInputs TxUtxoBalance
r)
            , _tubUnmatchedSpentInputs :: Set TxOutRef
_tubUnmatchedSpentInputs = (TxUtxoBalance -> Set TxOutRef
_tubUnmatchedSpentInputs TxUtxoBalance
r Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Ord a => Set a -> Set a -> Set a
`Set.difference` TxUtxoBalance -> Set TxOutRef
_tubUnspentOutputs TxUtxoBalance
l)
                                      Set TxOutRef -> Set TxOutRef -> Set TxOutRef
forall a. Semigroup a => a -> a -> a
<> TxUtxoBalance -> Set TxOutRef
_tubUnmatchedSpentInputs TxUtxoBalance
l
            }

instance Monoid TxUtxoBalance where
    mappend :: TxUtxoBalance -> TxUtxoBalance -> TxUtxoBalance
mappend = TxUtxoBalance -> TxUtxoBalance -> TxUtxoBalance
forall a. Semigroup a => a -> a -> a
(<>)
    mempty :: TxUtxoBalance
mempty = Set TxOutRef -> Set TxOutRef -> TxUtxoBalance
TxUtxoBalance Set TxOutRef
forall a. Monoid a => a
mempty Set TxOutRef
forall a. Monoid a => a
mempty


-- | User-customizable options to process a transaction.
-- See #73 for more motivations.
newtype TxProcessOption = TxProcessOption
    { TxProcessOption -> Bool
tpoStoreTx :: Bool
    -- ^ Should the chain index store this transaction or not.
    -- If not, only handle the UTXOs.
    -- This, for example, allows applications to skip unwanted pre-Alonzo transactions.
    }
    deriving (Int -> TxProcessOption -> ShowS
[TxProcessOption] -> ShowS
TxProcessOption -> String
(Int -> TxProcessOption -> ShowS)
-> (TxProcessOption -> String)
-> ([TxProcessOption] -> ShowS)
-> Show TxProcessOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TxProcessOption] -> ShowS
$cshowList :: [TxProcessOption] -> ShowS
show :: TxProcessOption -> String
$cshow :: TxProcessOption -> String
showsPrec :: Int -> TxProcessOption -> ShowS
$cshowsPrec :: Int -> TxProcessOption -> ShowS
Show)

-- We should think twice when setting the default option.
-- For now, it should store all data to avoid weird non-backward-compatible bugs in the future.
instance Default TxProcessOption where
    def :: TxProcessOption
def = TxProcessOption :: Bool -> TxProcessOption
TxProcessOption { tpoStoreTx :: Bool
tpoStoreTx = Bool
True }

-- | A block of transactions to be synced.
data ChainSyncBlock = Block
    { ChainSyncBlock -> Tip
blockTip :: Tip
    , ChainSyncBlock -> [(ChainIndexTx, TxProcessOption)]
blockTxs :: [(ChainIndexTx, TxProcessOption)]
    }
    deriving (Int -> ChainSyncBlock -> ShowS
[ChainSyncBlock] -> ShowS
ChainSyncBlock -> String
(Int -> ChainSyncBlock -> ShowS)
-> (ChainSyncBlock -> String)
-> ([ChainSyncBlock] -> ShowS)
-> Show ChainSyncBlock
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainSyncBlock] -> ShowS
$cshowList :: [ChainSyncBlock] -> ShowS
show :: ChainSyncBlock -> String
$cshow :: ChainSyncBlock -> String
showsPrec :: Int -> ChainSyncBlock -> ShowS
$cshowsPrec :: Int -> ChainSyncBlock -> ShowS
Show)