{-# LANGUAGE DeriveAnyClass       #-}
{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE OverloadedStrings    #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Plutus.PAB.Events.ContractInstanceState(
    PartiallyDecodedResponse(..)
    , fromResp
    , hasActiveRequests
    ) where

import Control.Monad.Freer.Extras.Log (LogLevel, LogMessage)
import Data.Aeson (FromJSON, ToJSON (..), Value)
import Data.Aeson.Encode.Pretty qualified as JSON
import Data.ByteString.Lazy.Char8 qualified as BS8
import Data.OpenApi.Schema qualified as OpenApi
import Data.Text qualified as Text
import Data.Text.Extras (abbreviate)
import GHC.Generics (Generic)
import Plutus.Contract.Resumable qualified as Contract
import Plutus.Contract.State qualified as Contract
import Prettyprinter

deriving instance OpenApi.ToSchema Value
deriving instance OpenApi.ToSchema LogLevel
deriving instance OpenApi.ToSchema (LogMessage Value)
deriving newtype instance OpenApi.ToSchema Contract.IterationID
deriving newtype instance OpenApi.ToSchema Contract.RequestID
deriving instance OpenApi.ToSchema o => OpenApi.ToSchema (Contract.Request o)

-- TODO: Replace with type synonym for @ContractResponse Value Value Value h@
data PartiallyDecodedResponse v =
    PartiallyDecodedResponse
        { PartiallyDecodedResponse v -> [Request v]
hooks           :: [Contract.Request v]
        , PartiallyDecodedResponse v -> [LogMessage Value]
logs            :: [LogMessage Value]
        , PartiallyDecodedResponse v -> [LogMessage Value]
lastLogs        :: [LogMessage Value] -- The log messages returned by the last step ('lastLogs' is a suffix of 'logs')
        , PartiallyDecodedResponse v -> Maybe Value
err             :: Maybe Value
        , PartiallyDecodedResponse v -> Value
observableState :: Value
        }
    deriving (Int -> PartiallyDecodedResponse v -> ShowS
[PartiallyDecodedResponse v] -> ShowS
PartiallyDecodedResponse v -> String
(Int -> PartiallyDecodedResponse v -> ShowS)
-> (PartiallyDecodedResponse v -> String)
-> ([PartiallyDecodedResponse v] -> ShowS)
-> Show (PartiallyDecodedResponse v)
forall v. Show v => Int -> PartiallyDecodedResponse v -> ShowS
forall v. Show v => [PartiallyDecodedResponse v] -> ShowS
forall v. Show v => PartiallyDecodedResponse v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartiallyDecodedResponse v] -> ShowS
$cshowList :: forall v. Show v => [PartiallyDecodedResponse v] -> ShowS
show :: PartiallyDecodedResponse v -> String
$cshow :: forall v. Show v => PartiallyDecodedResponse v -> String
showsPrec :: Int -> PartiallyDecodedResponse v -> ShowS
$cshowsPrec :: forall v. Show v => Int -> PartiallyDecodedResponse v -> ShowS
Show, PartiallyDecodedResponse v -> PartiallyDecodedResponse v -> Bool
(PartiallyDecodedResponse v -> PartiallyDecodedResponse v -> Bool)
-> (PartiallyDecodedResponse v
    -> PartiallyDecodedResponse v -> Bool)
-> Eq (PartiallyDecodedResponse v)
forall v.
Eq v =>
PartiallyDecodedResponse v -> PartiallyDecodedResponse v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartiallyDecodedResponse v -> PartiallyDecodedResponse v -> Bool
$c/= :: forall v.
Eq v =>
PartiallyDecodedResponse v -> PartiallyDecodedResponse v -> Bool
== :: PartiallyDecodedResponse v -> PartiallyDecodedResponse v -> Bool
$c== :: forall v.
Eq v =>
PartiallyDecodedResponse v -> PartiallyDecodedResponse v -> Bool
Eq, (forall x.
 PartiallyDecodedResponse v -> Rep (PartiallyDecodedResponse v) x)
-> (forall x.
    Rep (PartiallyDecodedResponse v) x -> PartiallyDecodedResponse v)
-> Generic (PartiallyDecodedResponse v)
forall x.
Rep (PartiallyDecodedResponse v) x -> PartiallyDecodedResponse v
forall x.
PartiallyDecodedResponse v -> Rep (PartiallyDecodedResponse v) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall v x.
Rep (PartiallyDecodedResponse v) x -> PartiallyDecodedResponse v
forall v x.
PartiallyDecodedResponse v -> Rep (PartiallyDecodedResponse v) x
$cto :: forall v x.
Rep (PartiallyDecodedResponse v) x -> PartiallyDecodedResponse v
$cfrom :: forall v x.
PartiallyDecodedResponse v -> Rep (PartiallyDecodedResponse v) x
Generic, a -> PartiallyDecodedResponse b -> PartiallyDecodedResponse a
(a -> b)
-> PartiallyDecodedResponse a -> PartiallyDecodedResponse b
(forall a b.
 (a -> b)
 -> PartiallyDecodedResponse a -> PartiallyDecodedResponse b)
-> (forall a b.
    a -> PartiallyDecodedResponse b -> PartiallyDecodedResponse a)
-> Functor PartiallyDecodedResponse
forall a b.
a -> PartiallyDecodedResponse b -> PartiallyDecodedResponse a
forall a b.
(a -> b)
-> PartiallyDecodedResponse a -> PartiallyDecodedResponse b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> PartiallyDecodedResponse b -> PartiallyDecodedResponse a
$c<$ :: forall a b.
a -> PartiallyDecodedResponse b -> PartiallyDecodedResponse a
fmap :: (a -> b)
-> PartiallyDecodedResponse a -> PartiallyDecodedResponse b
$cfmap :: forall a b.
(a -> b)
-> PartiallyDecodedResponse a -> PartiallyDecodedResponse b
Functor, PartiallyDecodedResponse a -> Bool
(a -> m) -> PartiallyDecodedResponse a -> m
(a -> b -> b) -> b -> PartiallyDecodedResponse a -> b
(forall m. Monoid m => PartiallyDecodedResponse m -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> PartiallyDecodedResponse a -> m)
-> (forall m a.
    Monoid m =>
    (a -> m) -> PartiallyDecodedResponse a -> m)
-> (forall a b.
    (a -> b -> b) -> b -> PartiallyDecodedResponse a -> b)
-> (forall a b.
    (a -> b -> b) -> b -> PartiallyDecodedResponse a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> PartiallyDecodedResponse a -> b)
-> (forall b a.
    (b -> a -> b) -> b -> PartiallyDecodedResponse a -> b)
-> (forall a. (a -> a -> a) -> PartiallyDecodedResponse a -> a)
-> (forall a. (a -> a -> a) -> PartiallyDecodedResponse a -> a)
-> (forall a. PartiallyDecodedResponse a -> [a])
-> (forall a. PartiallyDecodedResponse a -> Bool)
-> (forall a. PartiallyDecodedResponse a -> Int)
-> (forall a. Eq a => a -> PartiallyDecodedResponse a -> Bool)
-> (forall a. Ord a => PartiallyDecodedResponse a -> a)
-> (forall a. Ord a => PartiallyDecodedResponse a -> a)
-> (forall a. Num a => PartiallyDecodedResponse a -> a)
-> (forall a. Num a => PartiallyDecodedResponse a -> a)
-> Foldable PartiallyDecodedResponse
forall a. Eq a => a -> PartiallyDecodedResponse a -> Bool
forall a. Num a => PartiallyDecodedResponse a -> a
forall a. Ord a => PartiallyDecodedResponse a -> a
forall m. Monoid m => PartiallyDecodedResponse m -> m
forall a. PartiallyDecodedResponse a -> Bool
forall a. PartiallyDecodedResponse a -> Int
forall a. PartiallyDecodedResponse a -> [a]
forall a. (a -> a -> a) -> PartiallyDecodedResponse a -> a
forall m a. Monoid m => (a -> m) -> PartiallyDecodedResponse a -> m
forall b a. (b -> a -> b) -> b -> PartiallyDecodedResponse a -> b
forall a b. (a -> b -> b) -> b -> PartiallyDecodedResponse a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: PartiallyDecodedResponse a -> a
$cproduct :: forall a. Num a => PartiallyDecodedResponse a -> a
sum :: PartiallyDecodedResponse a -> a
$csum :: forall a. Num a => PartiallyDecodedResponse a -> a
minimum :: PartiallyDecodedResponse a -> a
$cminimum :: forall a. Ord a => PartiallyDecodedResponse a -> a
maximum :: PartiallyDecodedResponse a -> a
$cmaximum :: forall a. Ord a => PartiallyDecodedResponse a -> a
elem :: a -> PartiallyDecodedResponse a -> Bool
$celem :: forall a. Eq a => a -> PartiallyDecodedResponse a -> Bool
length :: PartiallyDecodedResponse a -> Int
$clength :: forall a. PartiallyDecodedResponse a -> Int
null :: PartiallyDecodedResponse a -> Bool
$cnull :: forall a. PartiallyDecodedResponse a -> Bool
toList :: PartiallyDecodedResponse a -> [a]
$ctoList :: forall a. PartiallyDecodedResponse a -> [a]
foldl1 :: (a -> a -> a) -> PartiallyDecodedResponse a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> PartiallyDecodedResponse a -> a
foldr1 :: (a -> a -> a) -> PartiallyDecodedResponse a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> PartiallyDecodedResponse a -> a
foldl' :: (b -> a -> b) -> b -> PartiallyDecodedResponse a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> PartiallyDecodedResponse a -> b
foldl :: (b -> a -> b) -> b -> PartiallyDecodedResponse a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> PartiallyDecodedResponse a -> b
foldr' :: (a -> b -> b) -> b -> PartiallyDecodedResponse a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> PartiallyDecodedResponse a -> b
foldr :: (a -> b -> b) -> b -> PartiallyDecodedResponse a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> PartiallyDecodedResponse a -> b
foldMap' :: (a -> m) -> PartiallyDecodedResponse a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> PartiallyDecodedResponse a -> m
foldMap :: (a -> m) -> PartiallyDecodedResponse a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> PartiallyDecodedResponse a -> m
fold :: PartiallyDecodedResponse m -> m
$cfold :: forall m. Monoid m => PartiallyDecodedResponse m -> m
Foldable, Functor PartiallyDecodedResponse
Foldable PartiallyDecodedResponse
Functor PartiallyDecodedResponse
-> Foldable PartiallyDecodedResponse
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b)
    -> PartiallyDecodedResponse a -> f (PartiallyDecodedResponse b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    PartiallyDecodedResponse (f a) -> f (PartiallyDecodedResponse a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b)
    -> PartiallyDecodedResponse a -> m (PartiallyDecodedResponse b))
-> (forall (m :: * -> *) a.
    Monad m =>
    PartiallyDecodedResponse (m a) -> m (PartiallyDecodedResponse a))
-> Traversable PartiallyDecodedResponse
(a -> f b)
-> PartiallyDecodedResponse a -> f (PartiallyDecodedResponse b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
PartiallyDecodedResponse (m a) -> m (PartiallyDecodedResponse a)
forall (f :: * -> *) a.
Applicative f =>
PartiallyDecodedResponse (f a) -> f (PartiallyDecodedResponse a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> PartiallyDecodedResponse a -> m (PartiallyDecodedResponse b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> PartiallyDecodedResponse a -> f (PartiallyDecodedResponse b)
sequence :: PartiallyDecodedResponse (m a) -> m (PartiallyDecodedResponse a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
PartiallyDecodedResponse (m a) -> m (PartiallyDecodedResponse a)
mapM :: (a -> m b)
-> PartiallyDecodedResponse a -> m (PartiallyDecodedResponse b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b)
-> PartiallyDecodedResponse a -> m (PartiallyDecodedResponse b)
sequenceA :: PartiallyDecodedResponse (f a) -> f (PartiallyDecodedResponse a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
PartiallyDecodedResponse (f a) -> f (PartiallyDecodedResponse a)
traverse :: (a -> f b)
-> PartiallyDecodedResponse a -> f (PartiallyDecodedResponse b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> PartiallyDecodedResponse a -> f (PartiallyDecodedResponse b)
$cp2Traversable :: Foldable PartiallyDecodedResponse
$cp1Traversable :: Functor PartiallyDecodedResponse
Traversable)
    deriving anyclass ([PartiallyDecodedResponse v] -> Value
[PartiallyDecodedResponse v] -> Encoding
PartiallyDecodedResponse v -> Value
PartiallyDecodedResponse v -> Encoding
(PartiallyDecodedResponse v -> Value)
-> (PartiallyDecodedResponse v -> Encoding)
-> ([PartiallyDecodedResponse v] -> Value)
-> ([PartiallyDecodedResponse v] -> Encoding)
-> ToJSON (PartiallyDecodedResponse v)
forall v. ToJSON v => [PartiallyDecodedResponse v] -> Value
forall v. ToJSON v => [PartiallyDecodedResponse v] -> Encoding
forall v. ToJSON v => PartiallyDecodedResponse v -> Value
forall v. ToJSON v => PartiallyDecodedResponse v -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PartiallyDecodedResponse v] -> Encoding
$ctoEncodingList :: forall v. ToJSON v => [PartiallyDecodedResponse v] -> Encoding
toJSONList :: [PartiallyDecodedResponse v] -> Value
$ctoJSONList :: forall v. ToJSON v => [PartiallyDecodedResponse v] -> Value
toEncoding :: PartiallyDecodedResponse v -> Encoding
$ctoEncoding :: forall v. ToJSON v => PartiallyDecodedResponse v -> Encoding
toJSON :: PartiallyDecodedResponse v -> Value
$ctoJSON :: forall v. ToJSON v => PartiallyDecodedResponse v -> Value
ToJSON, Value -> Parser [PartiallyDecodedResponse v]
Value -> Parser (PartiallyDecodedResponse v)
(Value -> Parser (PartiallyDecodedResponse v))
-> (Value -> Parser [PartiallyDecodedResponse v])
-> FromJSON (PartiallyDecodedResponse v)
forall v.
FromJSON v =>
Value -> Parser [PartiallyDecodedResponse v]
forall v.
FromJSON v =>
Value -> Parser (PartiallyDecodedResponse v)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PartiallyDecodedResponse v]
$cparseJSONList :: forall v.
FromJSON v =>
Value -> Parser [PartiallyDecodedResponse v]
parseJSON :: Value -> Parser (PartiallyDecodedResponse v)
$cparseJSON :: forall v.
FromJSON v =>
Value -> Parser (PartiallyDecodedResponse v)
FromJSON, Typeable (PartiallyDecodedResponse v)
Typeable (PartiallyDecodedResponse v)
-> (Proxy (PartiallyDecodedResponse v)
    -> Declare (Definitions Schema) NamedSchema)
-> ToSchema (PartiallyDecodedResponse v)
Proxy (PartiallyDecodedResponse v)
-> Declare (Definitions Schema) NamedSchema
forall a.
Typeable a
-> (Proxy a -> Declare (Definitions Schema) NamedSchema)
-> ToSchema a
forall v. ToSchema v => Typeable (PartiallyDecodedResponse v)
forall v.
ToSchema v =>
Proxy (PartiallyDecodedResponse v)
-> Declare (Definitions Schema) NamedSchema
declareNamedSchema :: Proxy (PartiallyDecodedResponse v)
-> Declare (Definitions Schema) NamedSchema
$cdeclareNamedSchema :: forall v.
ToSchema v =>
Proxy (PartiallyDecodedResponse v)
-> Declare (Definitions Schema) NamedSchema
$cp1ToSchema :: forall v. ToSchema v => Typeable (PartiallyDecodedResponse v)
OpenApi.ToSchema)

fromResp :: Contract.ContractResponse Value Value s v -> PartiallyDecodedResponse v
fromResp :: ContractResponse Value Value s v -> PartiallyDecodedResponse v
fromResp Contract.ContractResponse{[Request v]
hooks :: forall w e s h. ContractResponse w e s h -> [Request h]
hooks :: [Request v]
Contract.hooks, [LogMessage Value]
logs :: forall w e s h. ContractResponse w e s h -> [LogMessage Value]
logs :: [LogMessage Value]
Contract.logs, Maybe Value
err :: forall w e s h. ContractResponse w e s h -> Maybe e
err :: Maybe Value
Contract.err, [LogMessage Value]
lastLogs :: forall w e s h. ContractResponse w e s h -> [LogMessage Value]
lastLogs :: [LogMessage Value]
Contract.lastLogs, newState :: forall w e s h.
ContractResponse w e s h -> State w (CheckpointKey, s)
Contract.newState = Contract.State{Value
observableState :: forall w e. State w e -> w
observableState :: Value
Contract.observableState}} =
    PartiallyDecodedResponse :: forall v.
[Request v]
-> [LogMessage Value]
-> [LogMessage Value]
-> Maybe Value
-> Value
-> PartiallyDecodedResponse v
PartiallyDecodedResponse{[Request v]
hooks :: [Request v]
hooks :: [Request v]
hooks, [LogMessage Value]
logs :: [LogMessage Value]
logs :: [LogMessage Value]
logs, Maybe Value
err :: Maybe Value
err :: Maybe Value
err, Value
observableState :: Value
observableState :: Value
observableState, [LogMessage Value]
lastLogs :: [LogMessage Value]
lastLogs :: [LogMessage Value]
lastLogs}

instance Pretty v => Pretty (PartiallyDecodedResponse v) where
    pretty :: PartiallyDecodedResponse v -> Doc ann
pretty PartiallyDecodedResponse {[Request v]
hooks :: [Request v]
hooks :: forall v. PartiallyDecodedResponse v -> [Request v]
hooks, Value
observableState :: Value
observableState :: forall v. PartiallyDecodedResponse v -> Value
observableState} =
        [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep
            [ Doc ann
"State:"
            , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 (Doc ann -> Doc ann) -> Doc ann -> Doc ann
forall a b. (a -> b) -> a -> b
$ Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Text -> Doc ann) -> Text -> Doc ann
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
abbreviate Int
120 (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> String
BS8.unpack (ByteString -> String) -> ByteString -> String
forall a b. (a -> b) -> a -> b
$ Value -> ByteString
forall a. ToJSON a => a -> ByteString
JSON.encodePretty Value
observableState
            , Doc ann
"Hooks:"
            , Int -> Doc ann -> Doc ann
forall ann. Int -> Doc ann -> Doc ann
indent Int
2 ([Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
vsep ([Doc ann] -> Doc ann) -> [Doc ann] -> Doc ann
forall a b. (a -> b) -> a -> b
$ Request v -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Request v -> Doc ann) -> [Request v] -> [Doc ann]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Request v]
hooks)
            ]

-- | Whether the instance has any active requests
hasActiveRequests :: forall w s e a. Contract.ContractResponse w e s a -> Bool
hasActiveRequests :: ContractResponse w e s a -> Bool
hasActiveRequests = Bool -> Bool
not (Bool -> Bool)
-> (ContractResponse w e s a -> Bool)
-> ContractResponse w e s a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Request a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ([Request a] -> Bool)
-> (ContractResponse w e s a -> [Request a])
-> ContractResponse w e s a
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContractResponse w e s a -> [Request a]
forall w e s h. ContractResponse w e s h -> [Request h]
Contract.hooks