{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE OverloadedStrings  #-}
module Plutus.ChainIndex.ChainIndexLog (ChainIndexLog(..), InsertUtxoPosition(..)) where

import Cardano.BM.Data.Tracer (ToObject (..))
import Control.Monad.Freer.Extras.Beam (BeamLog)
import Data.Aeson (FromJSON, ToJSON)
import GHC.Generics (Generic)
import Ledger (TxOutRef)
import Plutus.ChainIndex.ChainIndexError (ChainIndexError)
import Plutus.ChainIndex.Tx (ChainIndexTxOut)
import Plutus.ChainIndex.Types (Tip (..))
import Plutus.Contract.CardanoAPI (FromCardanoError (..))
import Plutus.V1.Ledger.Api (TxId)
import Prettyprinter (Pretty (..), colon, viaShow, (<+>))

data ChainIndexLog =
    InsertionSuccess Tip InsertUtxoPosition
    | ConversionFailed FromCardanoError
    | RollbackSuccess Tip
    | Err ChainIndexError
    | TxNotFound TxId
    | TxOutNotFound TxOutRef
    | TipIsGenesis
    | NoDatumScriptAddr ChainIndexTxOut
    | BeamLogItem BeamLog
    deriving stock (ChainIndexLog -> ChainIndexLog -> Bool
(ChainIndexLog -> ChainIndexLog -> Bool)
-> (ChainIndexLog -> ChainIndexLog -> Bool) -> Eq ChainIndexLog
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainIndexLog -> ChainIndexLog -> Bool
$c/= :: ChainIndexLog -> ChainIndexLog -> Bool
== :: ChainIndexLog -> ChainIndexLog -> Bool
$c== :: ChainIndexLog -> ChainIndexLog -> Bool
Eq, Int -> ChainIndexLog -> ShowS
[ChainIndexLog] -> ShowS
ChainIndexLog -> String
(Int -> ChainIndexLog -> ShowS)
-> (ChainIndexLog -> String)
-> ([ChainIndexLog] -> ShowS)
-> Show ChainIndexLog
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainIndexLog] -> ShowS
$cshowList :: [ChainIndexLog] -> ShowS
show :: ChainIndexLog -> String
$cshow :: ChainIndexLog -> String
showsPrec :: Int -> ChainIndexLog -> ShowS
$cshowsPrec :: Int -> ChainIndexLog -> ShowS
Show, (forall x. ChainIndexLog -> Rep ChainIndexLog x)
-> (forall x. Rep ChainIndexLog x -> ChainIndexLog)
-> Generic ChainIndexLog
forall x. Rep ChainIndexLog x -> ChainIndexLog
forall x. ChainIndexLog -> Rep ChainIndexLog x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainIndexLog x -> ChainIndexLog
$cfrom :: forall x. ChainIndexLog -> Rep ChainIndexLog x
Generic)
    deriving anyclass (Value -> Parser [ChainIndexLog]
Value -> Parser ChainIndexLog
(Value -> Parser ChainIndexLog)
-> (Value -> Parser [ChainIndexLog]) -> FromJSON ChainIndexLog
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChainIndexLog]
$cparseJSONList :: Value -> Parser [ChainIndexLog]
parseJSON :: Value -> Parser ChainIndexLog
$cparseJSON :: Value -> Parser ChainIndexLog
FromJSON, [ChainIndexLog] -> Encoding
[ChainIndexLog] -> Value
ChainIndexLog -> Encoding
ChainIndexLog -> Value
(ChainIndexLog -> Value)
-> (ChainIndexLog -> Encoding)
-> ([ChainIndexLog] -> Value)
-> ([ChainIndexLog] -> Encoding)
-> ToJSON ChainIndexLog
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChainIndexLog] -> Encoding
$ctoEncodingList :: [ChainIndexLog] -> Encoding
toJSONList :: [ChainIndexLog] -> Value
$ctoJSONList :: [ChainIndexLog] -> Value
toEncoding :: ChainIndexLog -> Encoding
$ctoEncoding :: ChainIndexLog -> Encoding
toJSON :: ChainIndexLog -> Value
$ctoJSON :: ChainIndexLog -> Value
ToJSON, TracingVerbosity -> ChainIndexLog -> Object
ChainIndexLog -> Object -> Text
(TracingVerbosity -> ChainIndexLog -> Object)
-> (ChainIndexLog -> Object -> Text) -> ToObject ChainIndexLog
forall a.
(TracingVerbosity -> a -> Object)
-> (a -> Object -> Text) -> ToObject a
textTransformer :: ChainIndexLog -> Object -> Text
$ctextTransformer :: ChainIndexLog -> Object -> Text
toObject :: TracingVerbosity -> ChainIndexLog -> Object
$ctoObject :: TracingVerbosity -> ChainIndexLog -> Object
ToObject)

instance Pretty ChainIndexLog where
  pretty :: ChainIndexLog -> Doc ann
pretty = \case
    InsertionSuccess Tip
t InsertUtxoPosition
p ->
         Doc ann
"InsertionSuccess"
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
colon
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"New tip is"
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Tip -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Tip
t
      Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"."
      Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> InsertUtxoPosition -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty InsertUtxoPosition
p
    RollbackSuccess Tip
t -> Doc ann
"RollbackSuccess: New tip is" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Tip -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Tip
t
    ConversionFailed FromCardanoError
cvError -> Doc ann
"Conversion failed: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> FromCardanoError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty FromCardanoError
cvError
    Err ChainIndexError
ciError -> Doc ann
"ChainIndexError:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ChainIndexError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ChainIndexError
ciError
    TxNotFound TxId
txid -> Doc ann
"TxNotFound:" 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
txid
    TxOutNotFound TxOutRef
ref -> Doc ann
"TxOut not found with:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> TxOutRef -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty TxOutRef
ref
    ChainIndexLog
TipIsGenesis -> Doc ann
"TipIsGenesis"
    NoDatumScriptAddr ChainIndexTxOut
txout -> Doc ann
"The following transaction output from a script adress does not have a datum:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ChainIndexTxOut -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow ChainIndexTxOut
txout
    BeamLogItem BeamLog
b -> Doc ann
"BeamLogItem:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BeamLog -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty BeamLog
b

-- | Outcome of inserting a 'UtxoState' into the utxo index
data InsertUtxoPosition =
    InsertAtEnd -- ^ The utxo state was added to the end. Returns the new index
    | InsertBeforeEnd -- ^ The utxo state was added somewhere before the end. Returns the new index and the tip
    deriving stock (InsertUtxoPosition -> InsertUtxoPosition -> Bool
(InsertUtxoPosition -> InsertUtxoPosition -> Bool)
-> (InsertUtxoPosition -> InsertUtxoPosition -> Bool)
-> Eq InsertUtxoPosition
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
$c/= :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
== :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
$c== :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
Eq, Eq InsertUtxoPosition
Eq InsertUtxoPosition
-> (InsertUtxoPosition -> InsertUtxoPosition -> Ordering)
-> (InsertUtxoPosition -> InsertUtxoPosition -> Bool)
-> (InsertUtxoPosition -> InsertUtxoPosition -> Bool)
-> (InsertUtxoPosition -> InsertUtxoPosition -> Bool)
-> (InsertUtxoPosition -> InsertUtxoPosition -> Bool)
-> (InsertUtxoPosition -> InsertUtxoPosition -> InsertUtxoPosition)
-> (InsertUtxoPosition -> InsertUtxoPosition -> InsertUtxoPosition)
-> Ord InsertUtxoPosition
InsertUtxoPosition -> InsertUtxoPosition -> Bool
InsertUtxoPosition -> InsertUtxoPosition -> Ordering
InsertUtxoPosition -> InsertUtxoPosition -> InsertUtxoPosition
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 :: InsertUtxoPosition -> InsertUtxoPosition -> InsertUtxoPosition
$cmin :: InsertUtxoPosition -> InsertUtxoPosition -> InsertUtxoPosition
max :: InsertUtxoPosition -> InsertUtxoPosition -> InsertUtxoPosition
$cmax :: InsertUtxoPosition -> InsertUtxoPosition -> InsertUtxoPosition
>= :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
$c>= :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
> :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
$c> :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
<= :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
$c<= :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
< :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
$c< :: InsertUtxoPosition -> InsertUtxoPosition -> Bool
compare :: InsertUtxoPosition -> InsertUtxoPosition -> Ordering
$ccompare :: InsertUtxoPosition -> InsertUtxoPosition -> Ordering
$cp1Ord :: Eq InsertUtxoPosition
Ord, Int -> InsertUtxoPosition -> ShowS
[InsertUtxoPosition] -> ShowS
InsertUtxoPosition -> String
(Int -> InsertUtxoPosition -> ShowS)
-> (InsertUtxoPosition -> String)
-> ([InsertUtxoPosition] -> ShowS)
-> Show InsertUtxoPosition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InsertUtxoPosition] -> ShowS
$cshowList :: [InsertUtxoPosition] -> ShowS
show :: InsertUtxoPosition -> String
$cshow :: InsertUtxoPosition -> String
showsPrec :: Int -> InsertUtxoPosition -> ShowS
$cshowsPrec :: Int -> InsertUtxoPosition -> ShowS
Show, (forall x. InsertUtxoPosition -> Rep InsertUtxoPosition x)
-> (forall x. Rep InsertUtxoPosition x -> InsertUtxoPosition)
-> Generic InsertUtxoPosition
forall x. Rep InsertUtxoPosition x -> InsertUtxoPosition
forall x. InsertUtxoPosition -> Rep InsertUtxoPosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep InsertUtxoPosition x -> InsertUtxoPosition
$cfrom :: forall x. InsertUtxoPosition -> Rep InsertUtxoPosition x
Generic)
    deriving anyclass (Value -> Parser [InsertUtxoPosition]
Value -> Parser InsertUtxoPosition
(Value -> Parser InsertUtxoPosition)
-> (Value -> Parser [InsertUtxoPosition])
-> FromJSON InsertUtxoPosition
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [InsertUtxoPosition]
$cparseJSONList :: Value -> Parser [InsertUtxoPosition]
parseJSON :: Value -> Parser InsertUtxoPosition
$cparseJSON :: Value -> Parser InsertUtxoPosition
FromJSON, [InsertUtxoPosition] -> Encoding
[InsertUtxoPosition] -> Value
InsertUtxoPosition -> Encoding
InsertUtxoPosition -> Value
(InsertUtxoPosition -> Value)
-> (InsertUtxoPosition -> Encoding)
-> ([InsertUtxoPosition] -> Value)
-> ([InsertUtxoPosition] -> Encoding)
-> ToJSON InsertUtxoPosition
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [InsertUtxoPosition] -> Encoding
$ctoEncodingList :: [InsertUtxoPosition] -> Encoding
toJSONList :: [InsertUtxoPosition] -> Value
$ctoJSONList :: [InsertUtxoPosition] -> Value
toEncoding :: InsertUtxoPosition -> Encoding
$ctoEncoding :: InsertUtxoPosition -> Encoding
toJSON :: InsertUtxoPosition -> Value
$ctoJSON :: InsertUtxoPosition -> Value
ToJSON)

instance Pretty InsertUtxoPosition where
  pretty :: InsertUtxoPosition -> Doc ann
pretty = \case
    InsertUtxoPosition
InsertAtEnd     -> Doc ann
"UTxO state was added to the end."
    InsertUtxoPosition
InsertBeforeEnd -> Doc ann
"UTxO state was added somewhere before the end."