{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleInstances  #-}
{-# LANGUAGE LambdaCase         #-}
{-# LANGUAGE NamedFieldPuns     #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE RecordWildCards    #-}
{-# LANGUAGE StrictData         #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE TypeApplications   #-}

module Plutus.PAB.Types where

import Cardano.ChainIndex.Types qualified as ChainIndex
import Cardano.Node.Types (PABServerConfig)
import Cardano.Wallet.Types qualified as Wallet
import Control.Lens.TH (makePrisms)
import Control.Monad.Freer.Extras.Beam (BeamError)
import Control.Monad.Freer.Extras.Beam.Postgres qualified as Postgres (DbConfig)
import Control.Monad.Freer.Extras.Beam.Sqlite qualified as Sqlite (DbConfig)
import Data.Aeson (FromJSON, ToJSON, Value (..), object, parseJSON, toJSON, (.:), (.:?), (.=))
import Data.Default (Default, def)
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Pool (Pool)
import Data.Text (Text)
import Data.Time.Units (Second)
import Data.UUID (UUID)
import Data.UUID.Extras qualified as UUID
import Database.PostgreSQL.Simple qualified as Postgres
import Database.SQLite.Simple qualified as Sqlite
import GHC.Generics (Generic)
import Ledger (Block, Blockchain, CardanoTx, TxId, eitherTx, getCardanoTxId)
import Ledger.Index (UtxoIndex (UtxoIndex))
import Ledger.Index qualified as UtxoIndex
import Plutus.Blockfrost.Types qualified as Blockfrost
import Plutus.ChainIndex.Types (Point (..))
import Plutus.Contract.Types (ContractError)
import Plutus.PAB.Instances ()
import Prettyprinter (Pretty, line, pretty, viaShow, (<+>))
import Servant.Client (BaseUrl (BaseUrl), ClientEnv, ClientError, Scheme (Http))
import Wallet.API (WalletAPIError)
import Wallet.Emulator.Wallet (Wallet)
import Wallet.Types (ContractInstanceId (ContractInstanceId), NotificationError)

data PABError
    = FileNotFound FilePath
    | ContractNotFound FilePath
    | ContractInstanceNotFound ContractInstanceId
    | PABContractError ContractError
    | WalletClientError ClientError
    | NodeClientError ClientError
    | BeamEffectError BeamError
    | RandomTxClientError ClientError
    | ChainIndexError ClientError
    | WalletError WalletAPIError
    | ContractCommandError Int Text -- ?
    | InvalidUUIDError  Text
    | OtherError Text -- ?
    | EndpointCallError NotificationError
    | InstanceAlreadyStopped ContractInstanceId -- ^ Attempt to stop the instance failed because it was not running
    | WalletNotFound Wallet
    | MissingConfigFileOption
    | ContractStateNotFound ContractInstanceId
    | AesonDecodingError Text Text
    | MigrationNotDoneError Text
    | RemoteWalletWithMockNodeError
    | TxSenderNotAvailable
    deriving stock (Int -> PABError -> ShowS
[PABError] -> ShowS
PABError -> String
(Int -> PABError -> ShowS)
-> (PABError -> String) -> ([PABError] -> ShowS) -> Show PABError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PABError] -> ShowS
$cshowList :: [PABError] -> ShowS
show :: PABError -> String
$cshow :: PABError -> String
showsPrec :: Int -> PABError -> ShowS
$cshowsPrec :: Int -> PABError -> ShowS
Show, PABError -> PABError -> Bool
(PABError -> PABError -> Bool)
-> (PABError -> PABError -> Bool) -> Eq PABError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PABError -> PABError -> Bool
$c/= :: PABError -> PABError -> Bool
== :: PABError -> PABError -> Bool
$c== :: PABError -> PABError -> Bool
Eq, (forall x. PABError -> Rep PABError x)
-> (forall x. Rep PABError x -> PABError) -> Generic PABError
forall x. Rep PABError x -> PABError
forall x. PABError -> Rep PABError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PABError x -> PABError
$cfrom :: forall x. PABError -> Rep PABError x
Generic)
    deriving anyclass ([PABError] -> Encoding
[PABError] -> Value
PABError -> Encoding
PABError -> Value
(PABError -> Value)
-> (PABError -> Encoding)
-> ([PABError] -> Value)
-> ([PABError] -> Encoding)
-> ToJSON PABError
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [PABError] -> Encoding
$ctoEncodingList :: [PABError] -> Encoding
toJSONList :: [PABError] -> Value
$ctoJSONList :: [PABError] -> Value
toEncoding :: PABError -> Encoding
$ctoEncoding :: PABError -> Encoding
toJSON :: PABError -> Value
$ctoJSON :: PABError -> Value
ToJSON, Value -> Parser [PABError]
Value -> Parser PABError
(Value -> Parser PABError)
-> (Value -> Parser [PABError]) -> FromJSON PABError
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [PABError]
$cparseJSONList :: Value -> Parser [PABError]
parseJSON :: Value -> Parser PABError
$cparseJSON :: Value -> Parser PABError
FromJSON)

instance Pretty PABError where
    pretty :: PABError -> Doc ann
pretty = \case
        FileNotFound String
fp            -> Doc ann
"File not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
fp
        ContractNotFound String
fp        -> Doc ann
"Contract not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> String -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty String
fp
        ContractInstanceNotFound ContractInstanceId
i -> Doc ann
"Contract instance not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceId
i
        PABContractError ContractError
e         -> Doc ann
"Contract error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractError
e
        WalletClientError ClientError
e        -> Doc ann
"Wallet client error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ClientError -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow ClientError
e
        NodeClientError ClientError
e          -> Doc ann
"Node client error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ClientError -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow ClientError
e
        BeamEffectError BeamError
e          -> Doc ann
"Beam effect error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> BeamError -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow BeamError
e
        RandomTxClientError ClientError
e      -> Doc ann
"Random tx client error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ClientError -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow ClientError
e
        ChainIndexError ClientError
e          -> Doc ann
"Chain index error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ClientError -> Doc ann
forall a ann. Show a => a -> Doc ann
viaShow ClientError
e
        WalletError WalletAPIError
e              -> Doc ann
"Wallet error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> WalletAPIError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty WalletAPIError
e
        ContractCommandError Int
i Text
t   -> Doc ann
"Contract command error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Int -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Int
i Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
        InvalidUUIDError Text
t         -> Doc ann
"Invalid UUID:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
        OtherError Text
t               -> Doc ann
"Other error:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
t
        EndpointCallError NotificationError
n        -> Doc ann
"Endpoint call failed:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> NotificationError -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty NotificationError
n
        InstanceAlreadyStopped ContractInstanceId
i   -> Doc ann
"Instance already stopped:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceId
i
        WalletNotFound Wallet
w           -> Doc ann
"Wallet not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Wallet -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Wallet
w
        PABError
MissingConfigFileOption    -> Doc ann
"The --config option is required"
        ContractStateNotFound ContractInstanceId
i    -> Doc ann
"State for contract instance not found:" Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> ContractInstanceId -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty ContractInstanceId
i
        AesonDecodingError Text
msg Text
o   -> Doc ann
"Error while Aeson decoding: " Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
msg Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
o
        MigrationNotDoneError Text
msg  -> Text -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Text
msg
                                   Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
forall ann. Doc ann
line
                                   Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Doc ann
"Did you forget to run the 'migrate' command ?"
                                   Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
"(ex. 'plutus-pab-migrate' or 'plutus-pab-examples --config <CONFIG_FILE> migrate')"
        PABError
RemoteWalletWithMockNodeError   -> Doc ann
"The remote wallet can't be used with the mock node."
        PABError
TxSenderNotAvailable         -> Doc ann
"Cannot send a transaction when connected to the real node."

data DBConnection = PostgresPool (Pool Postgres.Connection)
                  | SqlitePool (Pool Sqlite.Connection)

data DbConfig = SqliteDB Sqlite.DbConfig
              | PostgresDB Postgres.DbConfig
    deriving (Int -> DbConfig -> ShowS
[DbConfig] -> ShowS
DbConfig -> String
(Int -> DbConfig -> ShowS)
-> (DbConfig -> String) -> ([DbConfig] -> ShowS) -> Show DbConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DbConfig] -> ShowS
$cshowList :: [DbConfig] -> ShowS
show :: DbConfig -> String
$cshow :: DbConfig -> String
showsPrec :: Int -> DbConfig -> ShowS
$cshowsPrec :: Int -> DbConfig -> ShowS
Show, DbConfig -> DbConfig -> Bool
(DbConfig -> DbConfig -> Bool)
-> (DbConfig -> DbConfig -> Bool) -> Eq DbConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DbConfig -> DbConfig -> Bool
$c/= :: DbConfig -> DbConfig -> Bool
== :: DbConfig -> DbConfig -> Bool
$c== :: DbConfig -> DbConfig -> Bool
Eq, (forall x. DbConfig -> Rep DbConfig x)
-> (forall x. Rep DbConfig x -> DbConfig) -> Generic DbConfig
forall x. Rep DbConfig x -> DbConfig
forall x. DbConfig -> Rep DbConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DbConfig x -> DbConfig
$cfrom :: forall x. DbConfig -> Rep DbConfig x
Generic)

takeSqliteDB :: DbConfig -> Sqlite.DbConfig
takeSqliteDB :: DbConfig -> DbConfig
takeSqliteDB (SqliteDB DbConfig
dbConf) = DbConfig
dbConf
takeSqliteDB (PostgresDB DbConfig
_)    = String -> DbConfig
forall a. HasCallStack => String -> a
error String
"Not an SqliteDB configuration"

takePostgresDB :: DbConfig -> Postgres.DbConfig
takePostgresDB :: DbConfig -> DbConfig
takePostgresDB (PostgresDB DbConfig
dbConf) = DbConfig
dbConf
takePostgresDB (SqliteDB DbConfig
_)        = String -> DbConfig
forall a. HasCallStack => String -> a
error String
"Not a PostgresDB configuration"

instance FromJSON DbConfig where
    parseJSON :: Value -> Parser DbConfig
parseJSON (Object Object
obj) = do
        Maybe DbConfig
ci <- Object
obj Object -> Key -> Parser (Maybe DbConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"sqliteDB"
        Maybe DbConfig
bf <- Object
obj Object -> Key -> Parser (Maybe DbConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"postgresDB"
        case (Maybe DbConfig
ci, Maybe DbConfig
bf) of
            (Just DbConfig
a, Maybe DbConfig
Nothing)  -> DbConfig -> Parser DbConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DbConfig -> Parser DbConfig) -> DbConfig -> Parser DbConfig
forall a b. (a -> b) -> a -> b
$ DbConfig -> DbConfig
SqliteDB DbConfig
a
            (Maybe DbConfig
Nothing, Just DbConfig
a)  -> DbConfig -> Parser DbConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (DbConfig -> Parser DbConfig) -> DbConfig -> Parser DbConfig
forall a b. (a -> b) -> a -> b
$ DbConfig -> DbConfig
PostgresDB DbConfig
a
            (Maybe DbConfig
Nothing, Maybe DbConfig
Nothing) -> String -> Parser DbConfig
forall a. HasCallStack => String -> a
error (String -> Parser DbConfig) -> String -> Parser DbConfig
forall a b. (a -> b) -> a -> b
$ [String] -> String
unwords
                                  [ String
"No configuration available, expecting"
                                  , String
"sqliteDB or postgresDB. Note if you have"
                                  , String
"updated to the newer plutus you should change"
                                  , String
"the dbConfig section in your yaml config file."
                                  ]
            (Just DbConfig
_, Just DbConfig
_)   -> String -> Parser DbConfig
forall a. HasCallStack => String -> a
error String
"Can't have Sqlite and Postgres databases"
    parseJSON Value
_            = String -> Parser DbConfig
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting object value"

instance ToJSON DbConfig where
    toJSON :: DbConfig -> Value
toJSON (SqliteDB DbConfig
cfg)   = [Pair] -> Value
object [Key
"sqliteDB"   Key -> DbConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DbConfig
cfg]
    toJSON (PostgresDB DbConfig
cfg) = [Pair] -> Value
object [Key
"postgresDB" Key -> DbConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DbConfig
cfg]

-- | Default database config uses an in-memory sqlite database that is shared
-- between all threads in the process.
defaultDbConfig :: DbConfig
defaultDbConfig :: DbConfig
defaultDbConfig = DbConfig -> DbConfig
SqliteDB DbConfig
forall a. Default a => a
def

instance Default DbConfig where
  def :: DbConfig
def = DbConfig
defaultDbConfig

data ChainQueryConfig = ChainIndexConfig ChainIndex.ChainIndexConfig
                      | BlockfrostConfig Blockfrost.BlockfrostConfig
    deriving stock (Int -> ChainQueryConfig -> ShowS
[ChainQueryConfig] -> ShowS
ChainQueryConfig -> String
(Int -> ChainQueryConfig -> ShowS)
-> (ChainQueryConfig -> String)
-> ([ChainQueryConfig] -> ShowS)
-> Show ChainQueryConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainQueryConfig] -> ShowS
$cshowList :: [ChainQueryConfig] -> ShowS
show :: ChainQueryConfig -> String
$cshow :: ChainQueryConfig -> String
showsPrec :: Int -> ChainQueryConfig -> ShowS
$cshowsPrec :: Int -> ChainQueryConfig -> ShowS
Show, ChainQueryConfig -> ChainQueryConfig -> Bool
(ChainQueryConfig -> ChainQueryConfig -> Bool)
-> (ChainQueryConfig -> ChainQueryConfig -> Bool)
-> Eq ChainQueryConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainQueryConfig -> ChainQueryConfig -> Bool
$c/= :: ChainQueryConfig -> ChainQueryConfig -> Bool
== :: ChainQueryConfig -> ChainQueryConfig -> Bool
$c== :: ChainQueryConfig -> ChainQueryConfig -> Bool
Eq, (forall x. ChainQueryConfig -> Rep ChainQueryConfig x)
-> (forall x. Rep ChainQueryConfig x -> ChainQueryConfig)
-> Generic ChainQueryConfig
forall x. Rep ChainQueryConfig x -> ChainQueryConfig
forall x. ChainQueryConfig -> Rep ChainQueryConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainQueryConfig x -> ChainQueryConfig
$cfrom :: forall x. ChainQueryConfig -> Rep ChainQueryConfig x
Generic)

instance FromJSON ChainQueryConfig where
    parseJSON :: Value -> Parser ChainQueryConfig
parseJSON (Object Object
obj) = do
        Maybe ChainIndexConfig
ci <- Object
obj Object -> Key -> Parser (Maybe ChainIndexConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"chainIndexConfig"
        Maybe BlockfrostConfig
bf <- Object
obj Object -> Key -> Parser (Maybe BlockfrostConfig)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"blockfrostConfig"
        case (Maybe ChainIndexConfig
ci, Maybe BlockfrostConfig
bf) of
            (Just ChainIndexConfig
a, Maybe BlockfrostConfig
Nothing)  -> ChainQueryConfig -> Parser ChainQueryConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainQueryConfig -> Parser ChainQueryConfig)
-> ChainQueryConfig -> Parser ChainQueryConfig
forall a b. (a -> b) -> a -> b
$ ChainIndexConfig -> ChainQueryConfig
ChainIndexConfig ChainIndexConfig
a
            (Maybe ChainIndexConfig
Nothing, Just BlockfrostConfig
a)  -> ChainQueryConfig -> Parser ChainQueryConfig
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ChainQueryConfig -> Parser ChainQueryConfig)
-> ChainQueryConfig -> Parser ChainQueryConfig
forall a b. (a -> b) -> a -> b
$ BlockfrostConfig -> ChainQueryConfig
BlockfrostConfig BlockfrostConfig
a
            (Maybe ChainIndexConfig
Nothing, Maybe BlockfrostConfig
Nothing) -> String -> Parser ChainQueryConfig
forall a. HasCallStack => String -> a
error String
"No configuration available"
            (Just ChainIndexConfig
_, Just BlockfrostConfig
_)   -> String -> Parser ChainQueryConfig
forall a. HasCallStack => String -> a
error String
"Cant have ChainIndex and Blockfrost configuration"
    parseJSON Value
_            = String -> Parser ChainQueryConfig
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Can´t parse ChainQueryConfig from a non-object Value"

instance ToJSON ChainQueryConfig where
    toJSON :: ChainQueryConfig -> Value
toJSON (ChainIndexConfig ChainIndexConfig
cfg) = [Pair] -> Value
object [Key
"chainIndexConfig" Key -> ChainIndexConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= ChainIndexConfig
cfg]
    toJSON (BlockfrostConfig BlockfrostConfig
cfg) = [Pair] -> Value
object [Key
"blockfrostConfig" Key -> BlockfrostConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= BlockfrostConfig
cfg]

instance Default ChainQueryConfig where
    def :: ChainQueryConfig
def = ChainIndexConfig -> ChainQueryConfig
ChainIndexConfig ChainIndexConfig
forall a. Default a => a
def

data ChainQueryEnv = ChainIndexEnv ClientEnv
                   | BlockfrostEnv Blockfrost.BlockfrostEnv

getChainIndexEnv :: ChainQueryEnv -> ClientEnv
getChainIndexEnv :: ChainQueryEnv -> ClientEnv
getChainIndexEnv (ChainIndexEnv ClientEnv
env) = ClientEnv
env
getChainIndexEnv (BlockfrostEnv BlockfrostEnv
_)   = String -> ClientEnv
forall a. HasCallStack => String -> a
error String
"Can't get ChainIndexEnv from BlockfrostEnv"

getBlockfrostEnv :: ChainQueryEnv -> Blockfrost.BlockfrostEnv
getBlockfrostEnv :: ChainQueryEnv -> BlockfrostEnv
getBlockfrostEnv (BlockfrostEnv BlockfrostEnv
env) = BlockfrostEnv
env
getBlockfrostEnv (ChainIndexEnv ClientEnv
_)   = String -> BlockfrostEnv
forall a. HasCallStack => String -> a
error String
"Can't get BlockfrostEnv from ChainIndexEnv"


data Config =
    Config
        { Config -> DbConfig
dbConfig                :: DbConfig
        , Config -> WalletConfig
walletServerConfig      :: Wallet.WalletConfig
        , Config -> PABServerConfig
nodeServerConfig        :: PABServerConfig
        , Config -> WebserverConfig
pabWebserverConfig      :: WebserverConfig
        , Config -> ChainQueryConfig
chainQueryConfig        :: ChainQueryConfig
        , Config -> RequestProcessingConfig
requestProcessingConfig :: RequestProcessingConfig
        , Config -> DevelopmentOptions
developmentOptions      :: DevelopmentOptions
        }
    deriving (Int -> Config -> ShowS
[Config] -> ShowS
Config -> String
(Int -> Config -> ShowS)
-> (Config -> String) -> ([Config] -> ShowS) -> Show Config
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Config] -> ShowS
$cshowList :: [Config] -> ShowS
show :: Config -> String
$cshow :: Config -> String
showsPrec :: Int -> Config -> ShowS
$cshowsPrec :: Int -> Config -> ShowS
Show, Config -> Config -> Bool
(Config -> Config -> Bool)
-> (Config -> Config -> Bool) -> Eq Config
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Config -> Config -> Bool
$c/= :: Config -> Config -> Bool
== :: Config -> Config -> Bool
$c== :: Config -> Config -> Bool
Eq, (forall x. Config -> Rep Config x)
-> (forall x. Rep Config x -> Config) -> Generic Config
forall x. Rep Config x -> Config
forall x. Config -> Rep Config x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Config x -> Config
$cfrom :: forall x. Config -> Rep Config x
Generic)

instance FromJSON Config where
    parseJSON :: Value -> Parser Config
parseJSON val :: Value
val@(Object Object
obj) = DbConfig
-> WalletConfig
-> PABServerConfig
-> WebserverConfig
-> ChainQueryConfig
-> RequestProcessingConfig
-> DevelopmentOptions
-> Config
Config (DbConfig
 -> WalletConfig
 -> PABServerConfig
 -> WebserverConfig
 -> ChainQueryConfig
 -> RequestProcessingConfig
 -> DevelopmentOptions
 -> Config)
-> Parser DbConfig
-> Parser
     (WalletConfig
      -> PABServerConfig
      -> WebserverConfig
      -> ChainQueryConfig
      -> RequestProcessingConfig
      -> DevelopmentOptions
      -> Config)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser DbConfig
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
                                    Parser
  (WalletConfig
   -> PABServerConfig
   -> WebserverConfig
   -> ChainQueryConfig
   -> RequestProcessingConfig
   -> DevelopmentOptions
   -> Config)
-> Parser WalletConfig
-> Parser
     (PABServerConfig
      -> WebserverConfig
      -> ChainQueryConfig
      -> RequestProcessingConfig
      -> DevelopmentOptions
      -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser WalletConfig
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"walletServerConfig"
                                    Parser
  (PABServerConfig
   -> WebserverConfig
   -> ChainQueryConfig
   -> RequestProcessingConfig
   -> DevelopmentOptions
   -> Config)
-> Parser PABServerConfig
-> Parser
     (WebserverConfig
      -> ChainQueryConfig
      -> RequestProcessingConfig
      -> DevelopmentOptions
      -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser PABServerConfig
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"nodeServerConfig"
                                    Parser
  (WebserverConfig
   -> ChainQueryConfig
   -> RequestProcessingConfig
   -> DevelopmentOptions
   -> Config)
-> Parser WebserverConfig
-> Parser
     (ChainQueryConfig
      -> RequestProcessingConfig -> DevelopmentOptions -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser WebserverConfig
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"pabWebserverConfig"
                                    Parser
  (ChainQueryConfig
   -> RequestProcessingConfig -> DevelopmentOptions -> Config)
-> Parser ChainQueryConfig
-> Parser (RequestProcessingConfig -> DevelopmentOptions -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser ChainQueryConfig
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
                                    Parser (RequestProcessingConfig -> DevelopmentOptions -> Config)
-> Parser RequestProcessingConfig
-> Parser (DevelopmentOptions -> Config)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser RequestProcessingConfig
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"requestProcessingConfig"
                                    Parser (DevelopmentOptions -> Config)
-> Parser DevelopmentOptions -> Parser Config
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Key -> Parser DevelopmentOptions
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"developmentOptions"
    parseJSON Value
val = String -> Parser Config
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Config) -> String -> Parser Config
forall a b. (a -> b) -> a -> b
$ String
"Unexpected value: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
val

instance ToJSON Config where
    toJSON :: Config -> Value
toJSON Config {WalletConfig
PABServerConfig
DevelopmentOptions
WebserverConfig
RequestProcessingConfig
ChainQueryConfig
DbConfig
developmentOptions :: DevelopmentOptions
requestProcessingConfig :: RequestProcessingConfig
chainQueryConfig :: ChainQueryConfig
pabWebserverConfig :: WebserverConfig
nodeServerConfig :: PABServerConfig
walletServerConfig :: WalletConfig
dbConfig :: DbConfig
developmentOptions :: Config -> DevelopmentOptions
requestProcessingConfig :: Config -> RequestProcessingConfig
chainQueryConfig :: Config -> ChainQueryConfig
pabWebserverConfig :: Config -> WebserverConfig
nodeServerConfig :: Config -> PABServerConfig
walletServerConfig :: Config -> WalletConfig
dbConfig :: Config -> DbConfig
..}=
        [Pair] -> Value
object
        [ Key
"walletServerConfig" Key -> WalletConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WalletConfig
walletServerConfig
        , Key
"nodeServerConfig" Key -> PABServerConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= PABServerConfig
nodeServerConfig
        , Key
"pabWebserverConfig" Key -> WebserverConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= WebserverConfig
pabWebserverConfig
        , Key
"requestProcessingConfig" Key -> RequestProcessingConfig -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RequestProcessingConfig
requestProcessingConfig
        , Key
"developmentOptions" Key -> DevelopmentOptions -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= DevelopmentOptions
developmentOptions
        ] Value -> Value -> Value
`mergeObjects` (ChainQueryConfig -> Value
forall a. ToJSON a => a -> Value
toJSON ChainQueryConfig
chainQueryConfig)
        Value -> Value -> Value
`mergeObjects` DbConfig -> Value
forall a. ToJSON a => a -> Value
toJSON DbConfig
dbConfig

mergeObjects :: Value -> Value -> Value
mergeObjects :: Value -> Value -> Value
mergeObjects (Object Object
o1) (Object Object
o2) = Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ Object
o1 Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object
o2
mergeObjects Value
_ Value
_                     = String -> Value
forall a. HasCallStack => String -> a
error String
"Value must be an object"

defaultConfig :: Config
defaultConfig :: Config
defaultConfig =
    Config :: DbConfig
-> WalletConfig
-> PABServerConfig
-> WebserverConfig
-> ChainQueryConfig
-> RequestProcessingConfig
-> DevelopmentOptions
-> Config
Config
    { dbConfig :: DbConfig
dbConfig = DbConfig
forall a. Default a => a
def
    , walletServerConfig :: WalletConfig
walletServerConfig = WalletConfig
forall a. Default a => a
def
    , nodeServerConfig :: PABServerConfig
nodeServerConfig = PABServerConfig
forall a. Default a => a
def
    , pabWebserverConfig :: WebserverConfig
pabWebserverConfig = WebserverConfig
forall a. Default a => a
def
    , chainQueryConfig :: ChainQueryConfig
chainQueryConfig = ChainQueryConfig
forall a. Default a => a
def
    , requestProcessingConfig :: RequestProcessingConfig
requestProcessingConfig = RequestProcessingConfig
forall a. Default a => a
def
    , developmentOptions :: DevelopmentOptions
developmentOptions = DevelopmentOptions
forall a. Default a => a
def
    }

instance Default Config where
  def :: Config
def = Config
defaultConfig

newtype RequestProcessingConfig =
    RequestProcessingConfig
        { RequestProcessingConfig -> Second
requestProcessingInterval :: Second -- ^ How many seconds to wait between calls to 'Plutus.PAB.Core.ContractInstance.processAllContractOutboxes'
        }
    deriving (Int -> RequestProcessingConfig -> ShowS
[RequestProcessingConfig] -> ShowS
RequestProcessingConfig -> String
(Int -> RequestProcessingConfig -> ShowS)
-> (RequestProcessingConfig -> String)
-> ([RequestProcessingConfig] -> ShowS)
-> Show RequestProcessingConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RequestProcessingConfig] -> ShowS
$cshowList :: [RequestProcessingConfig] -> ShowS
show :: RequestProcessingConfig -> String
$cshow :: RequestProcessingConfig -> String
showsPrec :: Int -> RequestProcessingConfig -> ShowS
$cshowsPrec :: Int -> RequestProcessingConfig -> ShowS
Show, RequestProcessingConfig -> RequestProcessingConfig -> Bool
(RequestProcessingConfig -> RequestProcessingConfig -> Bool)
-> (RequestProcessingConfig -> RequestProcessingConfig -> Bool)
-> Eq RequestProcessingConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RequestProcessingConfig -> RequestProcessingConfig -> Bool
$c/= :: RequestProcessingConfig -> RequestProcessingConfig -> Bool
== :: RequestProcessingConfig -> RequestProcessingConfig -> Bool
$c== :: RequestProcessingConfig -> RequestProcessingConfig -> Bool
Eq, (forall x.
 RequestProcessingConfig -> Rep RequestProcessingConfig x)
-> (forall x.
    Rep RequestProcessingConfig x -> RequestProcessingConfig)
-> Generic RequestProcessingConfig
forall x. Rep RequestProcessingConfig x -> RequestProcessingConfig
forall x. RequestProcessingConfig -> Rep RequestProcessingConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RequestProcessingConfig x -> RequestProcessingConfig
$cfrom :: forall x. RequestProcessingConfig -> Rep RequestProcessingConfig x
Generic)
    deriving anyclass (Value -> Parser [RequestProcessingConfig]
Value -> Parser RequestProcessingConfig
(Value -> Parser RequestProcessingConfig)
-> (Value -> Parser [RequestProcessingConfig])
-> FromJSON RequestProcessingConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [RequestProcessingConfig]
$cparseJSONList :: Value -> Parser [RequestProcessingConfig]
parseJSON :: Value -> Parser RequestProcessingConfig
$cparseJSON :: Value -> Parser RequestProcessingConfig
FromJSON, [RequestProcessingConfig] -> Encoding
[RequestProcessingConfig] -> Value
RequestProcessingConfig -> Encoding
RequestProcessingConfig -> Value
(RequestProcessingConfig -> Value)
-> (RequestProcessingConfig -> Encoding)
-> ([RequestProcessingConfig] -> Value)
-> ([RequestProcessingConfig] -> Encoding)
-> ToJSON RequestProcessingConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [RequestProcessingConfig] -> Encoding
$ctoEncodingList :: [RequestProcessingConfig] -> Encoding
toJSONList :: [RequestProcessingConfig] -> Value
$ctoJSONList :: [RequestProcessingConfig] -> Value
toEncoding :: RequestProcessingConfig -> Encoding
$ctoEncoding :: RequestProcessingConfig -> Encoding
toJSON :: RequestProcessingConfig -> Value
$ctoJSON :: RequestProcessingConfig -> Value
ToJSON)

defaultRequestProcessingConfig :: RequestProcessingConfig
defaultRequestProcessingConfig :: RequestProcessingConfig
defaultRequestProcessingConfig =
  RequestProcessingConfig :: Second -> RequestProcessingConfig
RequestProcessingConfig
    { requestProcessingInterval :: Second
requestProcessingInterval = Second
1
    }

instance Default RequestProcessingConfig where
  def :: RequestProcessingConfig
def = RequestProcessingConfig
defaultRequestProcessingConfig

data WebserverConfig =
    WebserverConfig
        { WebserverConfig -> BaseUrl
baseUrl              :: BaseUrl
        , WebserverConfig -> Maybe String
staticDir            :: Maybe FilePath
        , WebserverConfig -> Bool
permissiveCorsPolicy :: Bool -- ^ If true; use a very permissive CORS policy (any website can interact.)
        , WebserverConfig -> Maybe Second
endpointTimeout      :: Maybe Second
        -- ^ timeout to be used when endpoint is not available on invocation.
        , WebserverConfig -> Maybe Second
waitStatusTimeout    :: Maybe Second
        -- ^ timeout to be used when querying endpoint result when expected contract status must be set to Done.
        , WebserverConfig -> Bool
enableMarconi        :: Bool
        , WebserverConfig -> Maybe String
certificatePath      :: Maybe FilePath -- ^ Certificate file for serving over HTTPS
        , WebserverConfig -> Maybe String
keyPath              :: Maybe FilePath -- ^ Key file for serving over HTTPS
        }
    deriving (Int -> WebserverConfig -> ShowS
[WebserverConfig] -> ShowS
WebserverConfig -> String
(Int -> WebserverConfig -> ShowS)
-> (WebserverConfig -> String)
-> ([WebserverConfig] -> ShowS)
-> Show WebserverConfig
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebserverConfig] -> ShowS
$cshowList :: [WebserverConfig] -> ShowS
show :: WebserverConfig -> String
$cshow :: WebserverConfig -> String
showsPrec :: Int -> WebserverConfig -> ShowS
$cshowsPrec :: Int -> WebserverConfig -> ShowS
Show, WebserverConfig -> WebserverConfig -> Bool
(WebserverConfig -> WebserverConfig -> Bool)
-> (WebserverConfig -> WebserverConfig -> Bool)
-> Eq WebserverConfig
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebserverConfig -> WebserverConfig -> Bool
$c/= :: WebserverConfig -> WebserverConfig -> Bool
== :: WebserverConfig -> WebserverConfig -> Bool
$c== :: WebserverConfig -> WebserverConfig -> Bool
Eq, (forall x. WebserverConfig -> Rep WebserverConfig x)
-> (forall x. Rep WebserverConfig x -> WebserverConfig)
-> Generic WebserverConfig
forall x. Rep WebserverConfig x -> WebserverConfig
forall x. WebserverConfig -> Rep WebserverConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WebserverConfig x -> WebserverConfig
$cfrom :: forall x. WebserverConfig -> Rep WebserverConfig x
Generic)
    deriving anyclass (Value -> Parser [WebserverConfig]
Value -> Parser WebserverConfig
(Value -> Parser WebserverConfig)
-> (Value -> Parser [WebserverConfig]) -> FromJSON WebserverConfig
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [WebserverConfig]
$cparseJSONList :: Value -> Parser [WebserverConfig]
parseJSON :: Value -> Parser WebserverConfig
$cparseJSON :: Value -> Parser WebserverConfig
FromJSON, [WebserverConfig] -> Encoding
[WebserverConfig] -> Value
WebserverConfig -> Encoding
WebserverConfig -> Value
(WebserverConfig -> Value)
-> (WebserverConfig -> Encoding)
-> ([WebserverConfig] -> Value)
-> ([WebserverConfig] -> Encoding)
-> ToJSON WebserverConfig
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [WebserverConfig] -> Encoding
$ctoEncodingList :: [WebserverConfig] -> Encoding
toJSONList :: [WebserverConfig] -> Value
$ctoJSONList :: [WebserverConfig] -> Value
toEncoding :: WebserverConfig -> Encoding
$ctoEncoding :: WebserverConfig -> Encoding
toJSON :: WebserverConfig -> Value
$ctoJSON :: WebserverConfig -> Value
ToJSON)

-- | Default config for debugging.
defaultWebServerConfig :: WebserverConfig
defaultWebServerConfig :: WebserverConfig
defaultWebServerConfig =
  WebserverConfig :: BaseUrl
-> Maybe String
-> Bool
-> Maybe Second
-> Maybe Second
-> Bool
-> Maybe String
-> Maybe String
-> WebserverConfig
WebserverConfig
    -- See Note [pab-ports] in test/full/Plutus/PAB/CliSpec.hs.
    { baseUrl :: BaseUrl
baseUrl              = Scheme -> String -> Int -> String -> BaseUrl
BaseUrl Scheme
Http String
"localhost" Int
9080 String
""
    , staticDir :: Maybe String
staticDir            = Maybe String
forall a. Maybe a
Nothing
    , permissiveCorsPolicy :: Bool
permissiveCorsPolicy = Bool
False
    , endpointTimeout :: Maybe Second
endpointTimeout      = Maybe Second
forall a. Maybe a
Nothing
    , waitStatusTimeout :: Maybe Second
waitStatusTimeout    = Maybe Second
forall a. Maybe a
Nothing
    , enableMarconi :: Bool
enableMarconi        = Bool
False
    , certificatePath :: Maybe String
certificatePath      = Maybe String
forall a. Maybe a
Nothing
    , keyPath :: Maybe String
keyPath              = Maybe String
forall a. Maybe a
Nothing
    }

instance Default WebserverConfig where
  def :: WebserverConfig
def = WebserverConfig
defaultWebServerConfig

data DevelopmentOptions =
    DevelopmentOptions
        { DevelopmentOptions -> Maybe Int
pabRollbackHistory :: Maybe Int
        , DevelopmentOptions -> Point
pabResumeFrom      :: Point
        }
    deriving (Int -> DevelopmentOptions -> ShowS
[DevelopmentOptions] -> ShowS
DevelopmentOptions -> String
(Int -> DevelopmentOptions -> ShowS)
-> (DevelopmentOptions -> String)
-> ([DevelopmentOptions] -> ShowS)
-> Show DevelopmentOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DevelopmentOptions] -> ShowS
$cshowList :: [DevelopmentOptions] -> ShowS
show :: DevelopmentOptions -> String
$cshow :: DevelopmentOptions -> String
showsPrec :: Int -> DevelopmentOptions -> ShowS
$cshowsPrec :: Int -> DevelopmentOptions -> ShowS
Show, DevelopmentOptions -> DevelopmentOptions -> Bool
(DevelopmentOptions -> DevelopmentOptions -> Bool)
-> (DevelopmentOptions -> DevelopmentOptions -> Bool)
-> Eq DevelopmentOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DevelopmentOptions -> DevelopmentOptions -> Bool
$c/= :: DevelopmentOptions -> DevelopmentOptions -> Bool
== :: DevelopmentOptions -> DevelopmentOptions -> Bool
$c== :: DevelopmentOptions -> DevelopmentOptions -> Bool
Eq, (forall x. DevelopmentOptions -> Rep DevelopmentOptions x)
-> (forall x. Rep DevelopmentOptions x -> DevelopmentOptions)
-> Generic DevelopmentOptions
forall x. Rep DevelopmentOptions x -> DevelopmentOptions
forall x. DevelopmentOptions -> Rep DevelopmentOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DevelopmentOptions x -> DevelopmentOptions
$cfrom :: forall x. DevelopmentOptions -> Rep DevelopmentOptions x
Generic)
    deriving anyclass (Value -> Parser [DevelopmentOptions]
Value -> Parser DevelopmentOptions
(Value -> Parser DevelopmentOptions)
-> (Value -> Parser [DevelopmentOptions])
-> FromJSON DevelopmentOptions
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [DevelopmentOptions]
$cparseJSONList :: Value -> Parser [DevelopmentOptions]
parseJSON :: Value -> Parser DevelopmentOptions
$cparseJSON :: Value -> Parser DevelopmentOptions
FromJSON, [DevelopmentOptions] -> Encoding
[DevelopmentOptions] -> Value
DevelopmentOptions -> Encoding
DevelopmentOptions -> Value
(DevelopmentOptions -> Value)
-> (DevelopmentOptions -> Encoding)
-> ([DevelopmentOptions] -> Value)
-> ([DevelopmentOptions] -> Encoding)
-> ToJSON DevelopmentOptions
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [DevelopmentOptions] -> Encoding
$ctoEncodingList :: [DevelopmentOptions] -> Encoding
toJSONList :: [DevelopmentOptions] -> Value
$ctoJSONList :: [DevelopmentOptions] -> Value
toEncoding :: DevelopmentOptions -> Encoding
$ctoEncoding :: DevelopmentOptions -> Encoding
toJSON :: DevelopmentOptions -> Value
$ctoJSON :: DevelopmentOptions -> Value
ToJSON)

defaultDevelopmentOptions :: DevelopmentOptions
defaultDevelopmentOptions :: DevelopmentOptions
defaultDevelopmentOptions =
    DevelopmentOptions :: Maybe Int -> Point -> DevelopmentOptions
DevelopmentOptions
        { pabRollbackHistory :: Maybe Int
pabRollbackHistory = Maybe Int
forall a. Maybe a
Nothing
        , pabResumeFrom :: Point
pabResumeFrom      = Point
PointAtGenesis
        }

instance Default DevelopmentOptions where
    def :: DevelopmentOptions
def = DevelopmentOptions
defaultDevelopmentOptions

-- | The source of a PAB event, used for sharding of the event stream
data Source
    = PABEventSource
    | InstanceEventSource ContractInstanceId
    deriving (Int -> Source -> ShowS
[Source] -> ShowS
Source -> String
(Int -> Source -> ShowS)
-> (Source -> String) -> ([Source] -> ShowS) -> Show Source
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Source] -> ShowS
$cshowList :: [Source] -> ShowS
show :: Source -> String
$cshow :: Source -> String
showsPrec :: Int -> Source -> ShowS
$cshowsPrec :: Int -> Source -> ShowS
Show, Source -> Source -> Bool
(Source -> Source -> Bool)
-> (Source -> Source -> Bool) -> Eq Source
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Source -> Source -> Bool
$c/= :: Source -> Source -> Bool
== :: Source -> Source -> Bool
$c== :: Source -> Source -> Bool
Eq)

toUUID :: Source -> UUID
toUUID :: Source -> UUID
toUUID = \case
    InstanceEventSource (ContractInstanceId UUID
i) -> UUID
i
    Source
PABEventSource                             -> Word32 -> UUID
UUID.sequenceIdToMockUUID Word32
1

data ChainOverview =
    ChainOverview
        { ChainOverview -> Blockchain
chainOverviewBlockchain     :: Blockchain
        , ChainOverview -> Map TxId CardanoTx
chainOverviewUnspentTxsById :: Map TxId CardanoTx
        , ChainOverview -> UtxoIndex
chainOverviewUtxoIndex      :: UtxoIndex
        }
    deriving (Int -> ChainOverview -> ShowS
[ChainOverview] -> ShowS
ChainOverview -> String
(Int -> ChainOverview -> ShowS)
-> (ChainOverview -> String)
-> ([ChainOverview] -> ShowS)
-> Show ChainOverview
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ChainOverview] -> ShowS
$cshowList :: [ChainOverview] -> ShowS
show :: ChainOverview -> String
$cshow :: ChainOverview -> String
showsPrec :: Int -> ChainOverview -> ShowS
$cshowsPrec :: Int -> ChainOverview -> ShowS
Show, ChainOverview -> ChainOverview -> Bool
(ChainOverview -> ChainOverview -> Bool)
-> (ChainOverview -> ChainOverview -> Bool) -> Eq ChainOverview
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ChainOverview -> ChainOverview -> Bool
$c/= :: ChainOverview -> ChainOverview -> Bool
== :: ChainOverview -> ChainOverview -> Bool
$c== :: ChainOverview -> ChainOverview -> Bool
Eq, (forall x. ChainOverview -> Rep ChainOverview x)
-> (forall x. Rep ChainOverview x -> ChainOverview)
-> Generic ChainOverview
forall x. Rep ChainOverview x -> ChainOverview
forall x. ChainOverview -> Rep ChainOverview x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ChainOverview x -> ChainOverview
$cfrom :: forall x. ChainOverview -> Rep ChainOverview x
Generic)
    deriving anyclass ([ChainOverview] -> Encoding
[ChainOverview] -> Value
ChainOverview -> Encoding
ChainOverview -> Value
(ChainOverview -> Value)
-> (ChainOverview -> Encoding)
-> ([ChainOverview] -> Value)
-> ([ChainOverview] -> Encoding)
-> ToJSON ChainOverview
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ChainOverview] -> Encoding
$ctoEncodingList :: [ChainOverview] -> Encoding
toJSONList :: [ChainOverview] -> Value
$ctoJSONList :: [ChainOverview] -> Value
toEncoding :: ChainOverview -> Encoding
$ctoEncoding :: ChainOverview -> Encoding
toJSON :: ChainOverview -> Value
$ctoJSON :: ChainOverview -> Value
ToJSON, Value -> Parser [ChainOverview]
Value -> Parser ChainOverview
(Value -> Parser ChainOverview)
-> (Value -> Parser [ChainOverview]) -> FromJSON ChainOverview
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ChainOverview]
$cparseJSONList :: Value -> Parser [ChainOverview]
parseJSON :: Value -> Parser ChainOverview
$cparseJSON :: Value -> Parser ChainOverview
FromJSON)

mkChainOverview :: Blockchain -> ChainOverview
mkChainOverview :: Blockchain -> ChainOverview
mkChainOverview = (ChainOverview -> Block -> ChainOverview)
-> ChainOverview -> Blockchain -> ChainOverview
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl ChainOverview -> Block -> ChainOverview
reducer ChainOverview
emptyChainOverview
  where
    reducer :: ChainOverview -> Block -> ChainOverview
    reducer :: ChainOverview -> Block -> ChainOverview
reducer ChainOverview { chainOverviewBlockchain :: ChainOverview -> Blockchain
chainOverviewBlockchain = Blockchain
oldBlockchain
                          , chainOverviewUnspentTxsById :: ChainOverview -> Map TxId CardanoTx
chainOverviewUnspentTxsById = Map TxId CardanoTx
oldTxById
                          , chainOverviewUtxoIndex :: ChainOverview -> UtxoIndex
chainOverviewUtxoIndex = UtxoIndex
oldUtxoIndex
                          } Block
txs =
        let unprunedTxById :: Map TxId CardanoTx
unprunedTxById =
                (Map TxId CardanoTx -> OnChainTx -> Map TxId CardanoTx)
-> Map TxId CardanoTx -> Block -> Map TxId CardanoTx
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\Map TxId CardanoTx
m -> (CardanoTx -> Map TxId CardanoTx)
-> (CardanoTx -> Map TxId CardanoTx)
-> OnChainTx
-> Map TxId CardanoTx
forall r. (CardanoTx -> r) -> (CardanoTx -> r) -> OnChainTx -> r
eitherTx (Map TxId CardanoTx -> CardanoTx -> Map TxId CardanoTx
forall a b. a -> b -> a
const Map TxId CardanoTx
m) (\CardanoTx
tx -> TxId -> CardanoTx -> Map TxId CardanoTx -> Map TxId CardanoTx
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (CardanoTx -> TxId
getCardanoTxId CardanoTx
tx) CardanoTx
tx Map TxId CardanoTx
m)) Map TxId CardanoTx
oldTxById Block
txs
            newTxById :: Map TxId CardanoTx
newTxById = Map TxId CardanoTx
unprunedTxById -- TODO Prune spent keys.
            newUtxoIndex :: UtxoIndex
newUtxoIndex = Block -> UtxoIndex -> UtxoIndex
UtxoIndex.insertBlock Block
txs UtxoIndex
oldUtxoIndex
         in ChainOverview :: Blockchain -> Map TxId CardanoTx -> UtxoIndex -> ChainOverview
ChainOverview
                { chainOverviewBlockchain :: Blockchain
chainOverviewBlockchain = Block
txs Block -> Blockchain -> Blockchain
forall a. a -> [a] -> [a]
: Blockchain
oldBlockchain
                , chainOverviewUnspentTxsById :: Map TxId CardanoTx
chainOverviewUnspentTxsById = Map TxId CardanoTx
newTxById
                , chainOverviewUtxoIndex :: UtxoIndex
chainOverviewUtxoIndex = UtxoIndex
newUtxoIndex
                }
    emptyChainOverview :: ChainOverview
emptyChainOverview =
        ChainOverview :: Blockchain -> Map TxId CardanoTx -> UtxoIndex -> ChainOverview
ChainOverview
            { chainOverviewBlockchain :: Blockchain
chainOverviewBlockchain = []
            , chainOverviewUnspentTxsById :: Map TxId CardanoTx
chainOverviewUnspentTxsById = Map TxId CardanoTx
forall k a. Map k a
Map.empty
            , chainOverviewUtxoIndex :: UtxoIndex
chainOverviewUtxoIndex = Map TxOutRef TxOut -> UtxoIndex
UtxoIndex Map TxOutRef TxOut
forall k a. Map k a
Map.empty
            }

makePrisms ''PABError
makePrisms ''DBConnection