{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE DataKinds           #-}
{-# LANGUAGE DerivingStrategies  #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE GADTs               #-}
{-# LANGUAGE StrictData          #-}
{-# LANGUAGE TypeApplications    #-}
{-# LANGUAGE TypeFamilies        #-}
{-

Effects for running contract instances and for storing and loading their state.

-}
module Plutus.PAB.Effects.Contract(
    PABContract(..)
    , requests
    , ContractEffect(..)
    , initialState
    , updateContract
    -- * Storing and retrieving contract state
    , ContractStore(..)
    , putState
    , getState
    , getDefinition
    , getActiveContracts
    , getContracts
    , putStartInstance
    , putStopInstance
    , deleteState
    -- * Storing and retrieving definitions of contracts
    , ContractDefinition(..)
    , addDefinition
    , getDefinitions
    ) where

import Control.Monad.Freer (Eff, Member, send)
import Data.Aeson (Value)
import Data.Map (Map)
import Data.Map qualified as Map
import Data.Proxy (Proxy (..))
import Plutus.Contract.Effects (PABReq, PABResp)
import Plutus.Contract.Resumable (Request, Response)
import Plutus.Contract.State (ContractResponse)
import Plutus.Contract.State qualified as C
import Plutus.PAB.Webserver.Types (ContractActivationArgs)
import Wallet.Types (ContractActivityStatus (..), ContractInstanceId)

-- | A class of contracts running in the PAB. The purpose of the type
--   parameter @contract@ is to allow for different ways of running
--   contracts, for example: A compiled executable running in a separate
--   process, or an "inline" contract that was compiled with the PAB and
--   runs in the same process.
--
--   The associated type families correspond to the type arguments needed
--   for the 'ContractRequest' and 'ContractResponse' types from
--   'Plutus.Contract.State'.
class PABContract contract where
    -- | Any data needed to identify the contract. For example, the location of the executable.
    type ContractDef contract

    -- | Contract state type
    type State contract

    -- | Extract the serialisable state from the contract instance state.
    serialisableState :: Proxy contract -> State contract -> ContractResponse Value Value PABResp PABReq

-- | The open requests of the contract instance.
requests :: forall contract. PABContract contract => State contract -> [Request PABReq]
requests :: State contract -> [Request PABReq]
requests = ContractResponse Value Value PABResp PABReq -> [Request PABReq]
forall w e s h. ContractResponse w e s h -> [Request h]
C.hooks (ContractResponse Value Value PABResp PABReq -> [Request PABReq])
-> (State contract -> ContractResponse Value Value PABResp PABReq)
-> State contract
-> [Request PABReq]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy contract
-> State contract -> ContractResponse Value Value PABResp PABReq
forall contract.
PABContract contract =>
Proxy contract
-> State contract -> ContractResponse Value Value PABResp PABReq
serialisableState (Proxy contract
forall k (t :: k). Proxy t
Proxy @contract)

-- | An effect for sending updates to contracts that implement @PABContract@
data ContractEffect t r where
    InitialState   :: PABContract t => ContractInstanceId -> ContractDef t -> ContractEffect t (State t) -- ^ The initial state of the contract's instance
    UpdateContract :: PABContract t => ContractInstanceId -> ContractDef t -> State t -> Response PABResp -> ContractEffect t (State t) -- ^ Send an update to the contract and return the new state.

-- | Get the initial state of a contract
initialState ::
    forall t effs.
    ( Member (ContractEffect t) effs
    , PABContract t
    )
    => ContractInstanceId
    -> ContractDef t
    -> Eff effs (State t)
initialState :: ContractInstanceId -> ContractDef t -> Eff effs (State t)
initialState ContractInstanceId
i ContractDef t
def =
    let ContractEffect t (State t)
command :: ContractEffect t (State t) = ContractInstanceId -> ContractDef t -> ContractEffect t (State t)
forall t.
PABContract t =>
ContractInstanceId -> ContractDef t -> ContractEffect t (State t)
InitialState ContractInstanceId
i ContractDef t
def
    in ContractEffect t (State t) -> Eff effs (State t)
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send ContractEffect t (State t)
command

-- | Send an update to the contract and return the new state.
updateContract ::
    forall t effs.
    ( Member (ContractEffect t) effs
    , PABContract t
    )
    => ContractInstanceId
    -> ContractDef t
    -> State t
    -> Response PABResp
    -> Eff effs (State t)
updateContract :: ContractInstanceId
-> ContractDef t
-> State t
-> Response PABResp
-> Eff effs (State t)
updateContract ContractInstanceId
i ContractDef t
def State t
state Response PABResp
request =
    let ContractEffect t (State t)
command :: ContractEffect t (State t) = ContractInstanceId
-> ContractDef t
-> State t
-> Response PABResp
-> ContractEffect t (State t)
forall t.
PABContract t =>
ContractInstanceId
-> ContractDef t
-> State t
-> Response PABResp
-> ContractEffect t (State t)
UpdateContract ContractInstanceId
i ContractDef t
def State t
state Response PABResp
request
    in ContractEffect t (State t) -> Eff effs (State t)
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send ContractEffect t (State t)
command

-- | Storing and retrieving the state of a contract instance
data ContractStore t r where
    PutStartInstance :: ContractActivationArgs (ContractDef t) -> ContractInstanceId -> ContractStore t () -- ^ Record the starting of a new contract instance
    PutState :: ContractActivationArgs (ContractDef t) -> ContractInstanceId -> State t -> ContractStore t () -- ^ Record the updated state of the contract instance
    GetState :: ContractInstanceId -> ContractStore t (State t) -- ^ Retrieve the last recorded state of the contract instance
    PutStopInstance :: ContractInstanceId -> ContractStore t () -- ^ Record the fact that a contract instance has stopped
    GetContracts :: Maybe ContractActivityStatus -> ContractStore t (Map ContractInstanceId (ContractActivationArgs (ContractDef t))) -- ^ Get contracts with their activation args by status (all by default)
    DeleteState :: ContractInstanceId -> ContractStore t () -- ^ Delete the state of a contract instance

putStartInstance ::
    forall t effs.
    ( Member (ContractStore t) effs
    )
    => ContractActivationArgs (ContractDef t)
    -> ContractInstanceId
    -> Eff effs ()
putStartInstance :: ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> Eff effs ()
putStartInstance ContractActivationArgs (ContractDef t)
def ContractInstanceId
i =
    let ContractStore t ()
command :: ContractStore t () = ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> ContractStore t ()
forall t.
ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> ContractStore t ()
PutStartInstance ContractActivationArgs (ContractDef t)
def ContractInstanceId
i
    in ContractStore t () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send ContractStore t ()
command

putStopInstance ::
    forall t effs.
    ( Member (ContractStore t) effs
    )
    => ContractInstanceId
    -> Eff effs ()
putStopInstance :: ContractInstanceId -> Eff effs ()
putStopInstance ContractInstanceId
i =
    let ContractStore t ()
command :: ContractStore t () = ContractInstanceId -> ContractStore t ()
forall t. ContractInstanceId -> ContractStore t ()
PutStopInstance ContractInstanceId
i
    in ContractStore t () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send ContractStore t ()
command

-- | Store the state of the contract instance
putState ::
    forall t effs.
    ( Member (ContractStore t) effs
    )
    => ContractActivationArgs (ContractDef t)
    -> ContractInstanceId
    -> State t
    -> Eff effs ()
putState :: ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> State t -> Eff effs ()
putState ContractActivationArgs (ContractDef t)
def ContractInstanceId
i State t
state =
    let ContractStore t ()
command :: ContractStore t () = ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> State t -> ContractStore t ()
forall t.
ContractActivationArgs (ContractDef t)
-> ContractInstanceId -> State t -> ContractStore t ()
PutState ContractActivationArgs (ContractDef t)
def ContractInstanceId
i State t
state
    in ContractStore t () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send ContractStore t ()
command

-- | Load the state of the contract instance
getState ::
    forall t effs.
    ( Member (ContractStore t) effs
    )
    => ContractInstanceId
    -> Eff effs (State t)
getState :: ContractInstanceId -> Eff effs (State t)
getState ContractInstanceId
i =
    let ContractStore t (State t)
command :: ContractStore t (State t) = ContractInstanceId -> ContractStore t (State t)
forall t. ContractInstanceId -> ContractStore t (State t)
GetState ContractInstanceId
i
    in ContractStore t (State t) -> Eff effs (State t)
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send ContractStore t (State t)
command

-- | All active contracts with their definitions
-- WARNING : definition is misleading as this function is retrieving all instances (i.e., not only active ones),
-- especially when the in memory database setting is used
-- Indeed, handler defined in ContractStore ignores the status parameter given in GetContracts.
-- Note also that a contract instance added in the db has active status set to True.
-- This status is set to False only when the contract is explicitly stopped.
getActiveContracts ::
    forall t effs.
    ( Member (ContractStore t) effs
    )
    => Eff effs (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
getActiveContracts :: Eff
  effs
  (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
getActiveContracts = Maybe ContractActivityStatus
-> Eff
     effs
     (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
Maybe ContractActivityStatus
-> Eff
     effs
     (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
getContracts @t (ContractActivityStatus -> Maybe ContractActivityStatus
forall a. a -> Maybe a
Just ContractActivityStatus
Active)

-- | All contracts with their definitions by given status (all by default)
getContracts ::
    forall t effs.
    ( Member (ContractStore t) effs
    )
    => Maybe ContractActivityStatus
    -> Eff effs (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
getContracts :: Maybe ContractActivityStatus
-> Eff
     effs
     (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
getContracts Maybe ContractActivityStatus
mStatus =
    let ContractStore
  t (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
command :: ContractStore t (Map ContractInstanceId (ContractActivationArgs (ContractDef t))) = Maybe ContractActivityStatus
-> ContractStore
     t (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
forall t.
Maybe ContractActivityStatus
-> ContractStore
     t (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
GetContracts Maybe ContractActivityStatus
mStatus
    in ContractStore
  t (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
-> Eff
     effs
     (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send ContractStore
  t (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
command

deleteState ::
    forall t effs.
    ( Member (ContractStore t) effs
    )
    => ContractInstanceId
    -> Eff effs ()
deleteState :: ContractInstanceId -> Eff effs ()
deleteState ContractInstanceId
i =
    let ContractStore t ()
command :: ContractStore t () = ContractInstanceId -> ContractStore t ()
forall t. ContractInstanceId -> ContractStore t ()
DeleteState ContractInstanceId
i
    in ContractStore t () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send ContractStore t ()
command

-- | Get the definition of a running contract
getDefinition ::
    forall t effs.
    ( Member (ContractStore t) effs)
    => ContractInstanceId
    -> Eff effs (Maybe (ContractActivationArgs (ContractDef t)))
getDefinition :: ContractInstanceId
-> Eff effs (Maybe (ContractActivationArgs (ContractDef t)))
getDefinition ContractInstanceId
i = ContractInstanceId
-> Map ContractInstanceId (ContractActivationArgs (ContractDef t))
-> Maybe (ContractActivationArgs (ContractDef t))
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ContractInstanceId
i (Map ContractInstanceId (ContractActivationArgs (ContractDef t))
 -> Maybe (ContractActivationArgs (ContractDef t)))
-> Eff
     effs
     (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
-> Eff effs (Maybe (ContractActivationArgs (ContractDef t)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall (effs :: [* -> *]).
Member (ContractStore t) effs =>
Eff
  effs
  (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
forall t (effs :: [* -> *]).
Member (ContractStore t) effs =>
Eff
  effs
  (Map ContractInstanceId (ContractActivationArgs (ContractDef t)))
getActiveContracts @t)

-- | Storing and retrieving definitions of contracts.
--   (Not all 't's support this)
data ContractDefinition t r where
    AddDefinition :: ContractDef t -> ContractDefinition t ()
    GetDefinitions :: ContractDefinition t [ContractDef t]

addDefinition ::
    forall t effs.
    ( Member (ContractDefinition t) effs
    )
    => ContractDef t
    -> Eff effs ()
addDefinition :: ContractDef t -> Eff effs ()
addDefinition ContractDef t
def =
    let command :: ContractDefinition t ()
        command :: ContractDefinition t ()
command = ContractDef t -> ContractDefinition t ()
forall t. ContractDef t -> ContractDefinition t ()
AddDefinition ContractDef t
def
    in ContractDefinition t () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send ContractDefinition t ()
command

getDefinitions ::
    forall t effs.
    ( Member (ContractDefinition t) effs
    )
    => Eff effs [ContractDef t]
getDefinitions :: Eff effs [ContractDef t]
getDefinitions = ContractDefinition t [ContractDef t] -> Eff effs [ContractDef t]
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send @(ContractDefinition t) ContractDefinition t [ContractDef t]
forall t. ContractDefinition t [ContractDef t]
GetDefinitions