SCP-1986: Add observable state to contract

plutus-contract/src/Language/Plutus/Contract.hs

@@ -140,28 +140,28 @@ type HasBlockchainActions s =
   )
 
 -- | Execute both contracts in any order
-both :: Contract s e a -> Contract s e b -> Contract s e (a, b)
+both :: Contract w s e a -> Contract w s e b -> Contract w s e (a, b)
 both a b =
   let swap (b_, a_) = (a_, b_) in
   ((,) <$> a <*> b) `select` (fmap swap ((,) <$> b <*> a))
 
 -- | Log a message at the 'Debug' level
-logDebug :: ToJSON a => a -> Contract s e ()
+logDebug :: ToJSON a => a -> Contract w s e ()
 logDebug = Contract . L.logDebug . toJSON
 
 -- | Log a message at the 'Info' level
-logInfo :: ToJSON a => a -> Contract s e ()
+logInfo :: ToJSON a => a -> Contract w s e ()
 logInfo = Contract . L.logInfo . toJSON
 
 -- | Log a message at the 'Warning' level
-logWarn :: ToJSON a => a -> Contract s e ()
+logWarn :: ToJSON a => a -> Contract w s e ()
 logWarn = Contract . L.logWarn . toJSON
 
 -- | Log a message at the 'Error' level
-logError :: ToJSON a => a -> Contract s e ()
+logError :: ToJSON a => a -> Contract w s e ()
 logError = Contract . L.logError . toJSON
 
 -- | Send a notification to the outside world. (This is a placeholder
 --   until we implement https://jira.iohk.io/browse/SCP-1837)
-notify :: ToJSON a => a -> Contract s e ()
+notify :: ToJSON a => a -> Contract w s e ()
 notify = logInfo

plutus-contract/src/Language/Plutus/Contract/Effects/AwaitSlot.hs

@@ -43,27 +43,27 @@ type AwaitSlot = SlotSymbol .== (Slot, WaitingForSlot)
 -- | A contract that waits until the slot is reached, then returns the
 --   current slot.
 awaitSlot
-    :: forall s e.
+    :: forall w s e.
        ( HasAwaitSlot s
        , AsContractError e
        )
     => Slot
-    -> Contract s e Slot
+    -> Contract w s e Slot
 awaitSlot sl =
   let s = WaitingForSlot sl
       check :: Slot -> Maybe Slot
       check sl' = if sl' >= sl then Just sl' else Nothing
   in
-  requestMaybe @SlotSymbol @_ @_ @s s check
+  requestMaybe @w @SlotSymbol @_ @_ @s s check
 
 -- | Wait for a number of slots.
 waitNSlots
-  :: forall s e.
+  :: forall w s e.
      ( HasAwaitSlot s
      , AsContractError e
      )
   => Integer
-  -> Contract s e Slot
+  -> Contract w s e Slot
 waitNSlots i = do
   Slot current <- currentSlot
   awaitSlot $ Slot (current + i)
@@ -85,71 +85,71 @@ request (Handlers r) = unWaitingForSlot <$> trial' r (Label @SlotSymbol)
 
 -- | Run a contract until the given slot has been reached.
 until
-  :: forall s e a.
+  :: forall w s e a.
      ( HasAwaitSlot s
      , AsContractError e
      )
-  => Contract s e a
+  => Contract w s e a
   -> Slot
-  -> Contract s e (Maybe a)
+  -> Contract w s e (Maybe a)
 until c sl =
-  fmap (either (const Nothing) Just) (selectEither (awaitSlot @s sl) c)
+  fmap (either (const Nothing) Just) (selectEither (awaitSlot @w @s sl) c)
 
 -- | Run a contract when the given slot has been reached.
 when
-  :: forall s e a.
+  :: forall w s e a.
      ( HasAwaitSlot s
      , AsContractError e
      )
   => Slot
-  -> Contract s e a
-  -> Contract s e a
-when s c = awaitSlot @s s >> c
+  -> Contract w s e a
+  -> Contract w s e a
+when s c = awaitSlot @w @s s >> c
 
 -- | Run a contract until the given slot has been reached.
 --   @timeout = flip until@
 timeout
-  :: forall s e a.
+  :: forall w s e a.
      ( HasAwaitSlot s
      , AsContractError e
      )
   => Slot
-  -> Contract s e a
-  -> Contract s e (Maybe a)
-timeout = flip (until @s)
+  -> Contract w s e a
+  -> Contract w s e (Maybe a)
+timeout = flip (until @w @s)
 
 -- | Wait until the first slot is reached, then run the contract until
 --   the second slot is reached.
 between
-  :: forall s e a.
+  :: forall w s e a.
      ( HasAwaitSlot s
      , AsContractError e
      )
   => Slot
   -> Slot
-  -> Contract s e a
-  -> Contract s e (Maybe a)
-between a b = timeout @s b . when @s a
+  -> Contract w s e a
+  -> Contract w s e (Maybe a)
+between a b = timeout @w @s b . when @w @s a
 
 -- | Repeatedly run a contract until the slot is reached, then
 --   return the last result.
 collectUntil
-  :: forall s e a b.
+  :: forall w s e a b.
      ( HasAwaitSlot s
      , AsContractError e
      )
   => (a -> b -> b)
   -> b
-  -> Contract s e a
+  -> Contract w s e a
   -> Slot
-  -> Contract s e b
-collectUntil f b con s = foldMaybe f b (until @s con s)
+  -> Contract w s e b
+collectUntil f b con s = foldMaybe f b (until @w @s con s)
 
 -- | The current slot number
 currentSlot
-  :: forall s e.
+  :: forall w s e.
   ( HasAwaitSlot s
   , AsContractError e
   )
-  => Contract s e Slot
+  => Contract w s e Slot
 currentSlot = awaitSlot 0

plutus-contract/src/Language/Plutus/Contract/Effects/AwaitTxConfirmed.hs

@@ -39,13 +39,13 @@ type TxConfirmation = TxConfirmationSym .== (TxConfirmed, TxId)
 -- TODO: Configurable level of confirmation (for example, as soon as the tx is
 --       included in a block, or only when it can't be rolled back anymore)
 -- | Wait until a transaction is confirmed (added to the ledger).
-awaitTxConfirmed :: forall s e. (AsContractError e, HasTxConfirmation s) => TxId -> Contract s e ()
+awaitTxConfirmed :: forall w s e. (AsContractError e, HasTxConfirmation s) => TxId -> Contract w s e ()
 awaitTxConfirmed i =
     let check :: TxConfirmed -> Maybe ()
         check (TxConfirmed txId') =
             if txId' == i then Just () else Nothing
     in
-    requestMaybe @TxConfirmationSym @_ @_ @s i check
+    requestMaybe @w @TxConfirmationSym @_ @_ @s i check
 
 event
     :: forall s.

plutus-contract/src/Language/Plutus/Contract/Effects/ExposeEndpoint.hs

@@ -64,27 +64,27 @@ type Endpoint l a = l .== (EndpointValue a, ActiveEndpoint)
 
 -- | Expose an endpoint, return the data that was entered
 endpoint
-  :: forall l a s e.
+  :: forall l a w s e.
      ( HasEndpoint l a s
      , AsContractError e
      )
-  => Contract s e a
-endpoint = unEndpointValue <$> request @l @_ @_ @s s where
+  => Contract w s e a
+endpoint = unEndpointValue <$> request @w @l @_ @_ @s s where
   s = ActiveEndpoint
         { aeDescription = EndpointDescription $ symbolVal (Proxy @l)
         , aeMetadata    = Nothing
         }
 
 -- | Expose an endpoint with some metadata. Return the data that was entered.
 endpointWithMeta
-  :: forall l a s e b.
+  :: forall l a w s e b.
      ( HasEndpoint l a s
      , AsContractError e
      , ToJSON b
      )
   => b
-  -> Contract s e a
-endpointWithMeta b = unEndpointValue <$> request @l @_ @_ @s s where
+  -> Contract w s e a
+endpointWithMeta b = unEndpointValue <$> request @w @l @_ @_ @s s where
   s = ActiveEndpoint
         { aeDescription = endpointDescription (Proxy @l)
         , aeMetadata    = Just $ JSON.toJSON b

plutus-contract/src/Language/Plutus/Contract/Effects/Instance.hs

@@ -65,8 +65,8 @@ instance FromJSON OwnIdRequest where
 deriving via (PrettyShow OwnIdRequest) instance Pretty OwnIdRequest
 
 -- | Get the 'ContractInstanceId' of this instance.
-ownInstanceId :: forall s e. (AsContractError e, HasOwnId s) => Contract s e ContractInstanceId
-ownInstanceId = requestMaybe @OwnIdSym @_ @_ @s WaitingForInstanceId Just
+ownInstanceId :: forall w s e. (AsContractError e, HasOwnId s) => Contract w s e ContractInstanceId
+ownInstanceId = requestMaybe @w @OwnIdSym @_ @_ @s WaitingForInstanceId Just
 
 event
     :: forall s.

plutus-contract/src/Language/Plutus/Contract/Effects/Notify.hs

@@ -35,32 +35,32 @@ type ContractInstanceNotify = NotifySym .== (Maybe NotificationError, Notificati
 --
 --   TODO: In the future the runtime should check that the contract instance
 --   does indeed conform with 'otherSchema'.
-notifyInstance :: forall ep a otherSchema s.
+notifyInstance :: forall ep a otherSchema w s.
     ( HasContractNotify s
     , HasEndpoint ep a otherSchema
     , ToJSON a
     )
     => ContractInstanceId
     -> a
-    -> Contract s NotificationError ()
+    -> Contract w s NotificationError ()
 notifyInstance i v = notifyInstanceUnsafe @ep i (toJSON v)
 
 -- | Send a notification to a contract instance.
-notifyInstanceUnsafe :: forall ep s.
+notifyInstanceUnsafe :: forall ep w s.
     ( HasContractNotify s
     , KnownSymbol ep
     )
     => ContractInstanceId
     -> Value
-    -> Contract s NotificationError ()
+    -> Contract w s NotificationError ()
 notifyInstanceUnsafe i a = do
     let notification = Notification
             { notificationContractID = i
             , notificationContractEndpoint = endpointDescription (Proxy @ep)
             , notificationContractArg = a
             }
     r <- mapError OtherNotificationError
-            $ R.request @NotifySym @_ @_ @s notification
+            $ R.request @w @NotifySym @_ @_ @s notification
     traverse_ throwError r
 
 

plutus-contract/src/Language/Plutus/Contract/Effects/OwnPubKey.hs

@@ -63,8 +63,8 @@ deriving via (PrettyShow OwnPubKeyRequest) instance Pretty OwnPubKeyRequest
 --     'requiredSignatures' field of 'Tx'.
 --   * There is a 1-n relationship between wallets and public keys (although in
 --     the mockchain n=1)
-ownPubKey :: forall s e. (AsContractError e, HasOwnPubKey s) => Contract s e PubKey
-ownPubKey = requestMaybe @OwnPubKeySym @_ @_ @s WaitingForPubKey Just
+ownPubKey :: forall w s e. (AsContractError e, HasOwnPubKey s) => Contract w s e PubKey
+ownPubKey = requestMaybe @w @OwnPubKeySym @_ @_ @s WaitingForPubKey Just
 
 event
     :: forall s.

plutus-contract/src/Language/Plutus/Contract/Effects/RPC.hs

@@ -92,7 +92,7 @@ type HasRPCServer r s = HasEndpoint (RPCRequestEndpoint r) (RPCParams (RPCReques
 data Retries = NoRetries | MaxRetries Natural
 
 -- | Call an endpoint on another contract instance.
-callRPC :: forall r s.
+callRPC :: forall r w s.
     ( HasOwnId s
     , HasAwaitSlot s
     , HasEndpoint (RPCResponseEndpoint r) (Either (RPCError r) (RPCResponse r)) s
@@ -103,13 +103,13 @@ callRPC :: forall r s.
     => Retries
     -> ContractInstanceId
     -> RPCRequest r
-    -> Contract s RPCCallError (Either (RPCError r) (RPCResponse r))
+    -> Contract w s RPCCallError (Either (RPCError r) (RPCResponse r))
 callRPC retries targetInstance requestArgs =
-    let inner :: Contract s RPCCallError (Either (RPCError r) (RPCResponse r))
+    let inner :: Contract w s RPCCallError (Either (RPCError r) (RPCResponse r))
         inner = call @(RPCRequestEndpoint r) @(RPCResponseEndpoint r) @(RPCRequest r)  @(RPCResponse r) @(RPCError r) targetInstance requestArgs
         maxRetries = case retries of { NoRetries -> 0; MaxRetries n -> n }
 
-        go :: Natural -> Contract s RPCCallError (Either (RPCError r) (RPCResponse r))
+        go :: Natural -> Contract w s RPCCallError (Either (RPCError r) (RPCResponse r))
         go i = do
             rpcResult <- mapError absurd $ runError inner
             case rpcResult of
@@ -146,7 +146,7 @@ data RPCRespondError =
     deriving anyclass (ToJSON, FromJSON)
 
 -- | Call another instance and return the response.
-call :: forall (rpc :: Symbol) (rpcRsp :: Symbol) req resp err s.
+call :: forall (rpc :: Symbol) (rpcRsp :: Symbol) req resp err w s.
     ( HasContractNotify s
     , HasEndpoint rpcRsp (Either err resp) s
     , HasOwnId s
@@ -155,7 +155,7 @@ call :: forall (rpc :: Symbol) (rpcRsp :: Symbol) req resp err s.
     )
     => ContractInstanceId -- ^ ID of the contract instance that is to be called
     -> req -- ^ RPC argument
-    -> Contract s RPCCallError (Either err resp)
+    -> Contract w s RPCCallError (Either err resp)
 call t req = do
     ownId <- mapError RPCOtherError ownInstanceId
     let params = RPCParams{rpcCallbackInstance = ownId, rpcPayload = req}
@@ -164,26 +164,26 @@ call t req = do
 
 -- | Wait for another instance to call the RPC endpoint, and respond to the
 --   call.
-respondRPC :: forall r s.
+respondRPC :: forall w r s.
     ( HasEndpoint (RPCRequestEndpoint r) (RPCParams (RPCRequest r)) s
     , HasContractNotify s
     , RPC r
     , KnownSymbol (RPCResponseEndpoint r)
     )
-    => (RPCRequest r -> Contract s (RPCError r) (RPCResponse r)) -- ^ Implementation of the RPC
-    -> Contract s RPCRespondError ()
-respondRPC = respond @(RPCRequestEndpoint r) @(RPCResponseEndpoint r) @(RPCRequest r) @(RPCResponse r) @s @(RPCError r)
+    => (RPCRequest r -> Contract w s (RPCError r) (RPCResponse r)) -- ^ Implementation of the RPC
+    -> Contract w s RPCRespondError ()
+respondRPC = respond @(RPCRequestEndpoint r) @(RPCResponseEndpoint r) @(RPCRequest r) @(RPCResponse r) @w @s @(RPCError r)
 
 -- | Wait to be called by another instance.
-respond :: forall (rpc :: Symbol) (rpcRespondEndpoint :: Symbol) req resp s e.
+respond :: forall (rpc :: Symbol) (rpcRespondEndpoint :: Symbol) req resp w s e.
     ( HasEndpoint rpc (RPCParams req) s
     , HasContractNotify s
     , ToJSON resp
     , ToJSON e
     , KnownSymbol rpcRespondEndpoint
     )
-    => (req -> Contract s e resp)
-    -> Contract s RPCRespondError ()
+    => (req -> Contract w s e resp)
+    -> Contract w s RPCRespondError ()
 respond k = do
     RPCParams{rpcCallbackInstance, rpcPayload} <- mapError RPCEndpointError $ endpoint @rpc
     result :: Either e resp <- mapError absurd $ runError $ k rpcPayload

plutus-contract/src/Language/Plutus/Contract/Effects/UtxoAt.hs

@@ -51,13 +51,13 @@ instance Pretty UtxoAtAddress where
 type UtxoAt = UtxoAtSym .== (UtxoAtAddress, Address)
 
 -- | Get the unspent transaction outputs at an address.
-utxoAt :: forall s e. (AsContractError e, HasUtxoAt s) => Address -> Contract s e UtxoMap
+utxoAt :: forall w s e. (AsContractError e, HasUtxoAt s) => Address -> Contract w s e UtxoMap
 utxoAt address' =
     let check :: UtxoAtAddress -> Maybe UtxoMap
         check UtxoAtAddress{address,utxo} =
           if address' == address then Just utxo else Nothing
     in
-    requestMaybe @UtxoAtSym @_ @_ @s address' check
+    requestMaybe @w @UtxoAtSym @_ @_ @s address' check
 
 event
     :: forall s.
@@ -76,12 +76,12 @@ utxoAtRequest (Handlers r) = trial' r (Label @UtxoAtSym)
 -- | Watch an address until the given slot, then return all known outputs
 --   at the address.
 watchAddressUntil
-    :: forall s e.
+    :: forall w s e.
        ( HasAwaitSlot s
        , HasUtxoAt s
        , AsContractError e
        )
     => Address
     -> Slot
-    -> Contract s e UtxoMap
+    -> Contract w s e UtxoMap
 watchAddressUntil a slot = awaitSlot slot >> utxoAt a