Move some types around

IntersectMBO · Apr 6, 2021 · 75e5d7f · 75e5d7f
1 parent 298d810
commit 75e5d7f
Show file tree

Hide file tree

Showing 5 changed files with 63 additions and 133 deletions.
diff --git a/plutus-pab/src/Plutus/PAB/Monitoring/PABLogMsg.hs b/plutus-pab/src/Plutus/PAB/Monitoring/PABLogMsg.hs
@@ -48,7 +48,6 @@ import           Plutus.PAB.Instances                    ()
 import           Plutus.PAB.Monitoring.MonadLoggerBridge (MonadLoggerMsg (..))
 import           Plutus.PAB.ParseStringifiedJSON         (UnStringifyJSONLog (..))
 import           Wallet.Emulator.MultiAgent              (EmulatorEvent)
-import Plutus.PAB.Webserver.Types (WebSocketLogMsg)
 import           Wallet.Emulator.Wallet                  (WalletEvent (..))
 
 data AppMsg t =
@@ -82,7 +81,6 @@ data PABLogMsg =
     | SUnstringifyJSON UnStringifyJSONLog
     | SWalletEvent Wallet.Emulator.Wallet.WalletEvent
     | SLoggerBridge MonadLoggerMsg
-    | SWebsocketMsg WebSocketLogMsg
     | SContractRuntimeMsg ContractRuntimeMsg
     | SChainIndexServerMsg ChainIndexServerMsg
     | SWalletMsg WalletMsg
@@ -100,7 +98,6 @@ instance Pretty PABLogMsg where
         SUnstringifyJSON m     -> pretty m
         SWalletEvent w         -> pretty w
         SLoggerBridge m        -> pretty m
-        SWebsocketMsg m        -> pretty m
         SContractRuntimeMsg m  -> pretty m
         SChainIndexServerMsg m -> pretty m
         SWalletMsg m           -> pretty m
@@ -152,7 +149,6 @@ instance ToObject PABLogMsg where
         SUnstringifyJSON m     -> toObject v m
         SWalletEvent e         -> toObject v e
         SLoggerBridge e        -> toObject v e
-        SWebsocketMsg e        -> toObject v e
         SContractRuntimeMsg e  -> toObject v e
         SChainIndexServerMsg m -> toObject v m
         SWalletMsg m           -> toObject v m

diff --git a/plutus-pab/src/Plutus/PAB/Webserver/API.hs b/plutus-pab/src/Plutus/PAB/Webserver/API.hs
@@ -9,27 +9,15 @@ module Plutus.PAB.Webserver.API
     , WSAPI
     -- * New API that will eventually replace 'API'
     , NewAPI
-    , ContractActivationArgs(..)
-    , ContractInstanceClientState(..)
-    , InstanceStatusToClient(..)
-    , CombinedWSStreamToClient(..)
-    , CombinedWSStreamToServer(..)
     ) where
 
-import           Data.Aeson                                      (FromJSON, ToJSON)
-import qualified Data.Aeson                                      as JSON
-import           Data.Text                                       (Text)
-import           GHC.Generics                                    (Generic)
-import           Plutus.Contract.Effects.ExposeEndpoint (ActiveEndpoint)
-import           Plutus.PAB.Events.ContractInstanceState         (PartiallyDecodedResponse)
-
-import           Ledger.Slot                                     (Slot)
-import           Ledger.Value                                    (Value)
-import           Plutus.PAB.Webserver.Types                      (ContractSignatureResponse, FullReport)
-import           Servant.API                                     (Capture, Get, JSON, Post, ReqBody, (:<|>), (:>))
-import           Servant.API.WebSocket                           (WebSocketPending)
-import           Wallet.Emulator.Wallet                          (Wallet)
-import           Wallet.Types                                    (ContractInstanceId, NotificationError)
+import qualified Data.Aeson                 as JSON
+import           Data.Text                  (Text)
+import           Plutus.PAB.Webserver.Types (ContractActivationArgs, ContractInstanceClientState,
+                                             ContractSignatureResponse, FullReport)
+import           Servant.API                (Capture, Get, JSON, Post, ReqBody, (:<|>), (:>))
+import           Servant.API.WebSocket      (WebSocketPending)
+import           Wallet.Types               (ContractInstanceId, NotificationError)
 
 type API t
      = "api" :> ("healthcheck" :> Get '[ JSON] ()
@@ -40,25 +28,6 @@ type API t
 
 type WSAPI = "ws" :> WebSocketPending
 
--- | Data needed to start a new instance of a contract.
-data ContractActivationArgs t =
-    ContractActivationArgs
-        { caID     :: t -- ^ ID of the contract
-        , caWallet :: Wallet -- ^ Wallet that should be used for this instance
-        }
-    deriving stock (Eq, Show, Generic)
-    deriving anyclass (JSON.ToJSON, JSON.FromJSON)
-
--- | Current state of a contract instance
---   (to be sent to external clients)
-data ContractInstanceClientState =
-    ContractInstanceClientState
-        { cicContract     :: ContractInstanceId
-        , cicCurrentState :: PartiallyDecodedResponse ActiveEndpoint
-        }
-        deriving stock (Eq, Show, Generic)
-        deriving anyclass (JSON.ToJSON, JSON.FromJSON)
-
 -- | PAB client API for contracts of type @t@. Examples of @t@ are
 --   * Contract executables that reside in the user's file system
 --   * "Builtin" contracts that run in the same process as the PAB (ie. the PAB is compiled & distributed with these contracts)
@@ -75,26 +44,3 @@ type NewAPI t
             :<|> "instances" :> Get '[ JSON] [ContractInstanceClientState] -- list of all active contract instances
             :<|> "definitions" :> Get '[JSON] [ContractSignatureResponse t] -- list of available contracts
         )
-
--- | Status updates for contract instances streamed to client
-data InstanceStatusToClient
-    = NewObservableState JSON.Value -- ^ The observable state of the contract has changed.
-    | NewActiveEndpoints [ActiveEndpoint] -- ^ The set of active endpoints has changed.
-    | ContractFinished (Maybe JSON.Value) -- ^ Contract instance is done with an optional error message.
-    deriving stock (Generic, Eq, Show)
-    deriving anyclass (ToJSON, FromJSON)
-
--- | Data sent to the client through the combined websocket API
-data CombinedWSStreamToClient
-    = InstanceUpdate ContractInstanceId InstanceStatusToClient
-    | SlotChange Slot -- ^ New slot number
-    | WalletFundsChange Wallet Value -- ^ The funds of the wallet have changed
-    deriving stock (Generic, Eq, Show)
-    deriving anyclass (ToJSON, FromJSON)
-
--- | Instructions sent to the server through the combined websocket API
-data CombinedWSStreamToServer
-    = Subscribe (Either ContractInstanceId Wallet)
-    | Unsubscribe (Either ContractInstanceId Wallet)
-    deriving stock (Generic, Eq, Show)
-    deriving anyclass (ToJSON, FromJSON)
diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs b/plutus-pab/src/Plutus/PAB/Webserver/Handler.hs
@@ -39,7 +39,6 @@ import qualified Plutus.PAB.Effects.Contract             as Contract
 import           Plutus.PAB.Events.Contract              (ContractPABRequest, _UserEndpointRequest)
 import           Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse (..))
 import           Plutus.PAB.Types
-import           Plutus.PAB.Webserver.API                (ContractActivationArgs (..), ContractInstanceClientState (..))
 import           Plutus.PAB.Webserver.Types
 import qualified Plutus.PAB.Webserver.WebSocket          as WS
 import           Servant                                 ((:<|>) ((:<|>)))

diff --git a/plutus-pab/src/Plutus/PAB/Webserver/Types.hs b/plutus-pab/src/Plutus/PAB/Webserver/Types.hs
@@ -10,26 +10,22 @@
 
 module Plutus.PAB.Webserver.Types where
 
-import           Cardano.BM.Data.Tracer                  (ToObject, toObject)
-import           Cardano.BM.Data.Tracer.Extras           (StructuredLog, mkObjectStr)
-import qualified Cardano.Metadata.Types                  as Metadata
-import           Data.Aeson                              (FromJSON, ToJSON)
-import           Data.Map                                (Map)
-import           Data.Tagged                             (Tagged (Tagged))
-import           Data.Text                               (Text)
-import           Data.Text.Prettyprint.Doc               (Pretty, pretty, viaShow, (<+>))
-import           Data.UUID                               (UUID)
-import           GHC.Generics                            (Generic)
-import           Ledger                                  (Tx, TxId)
-import           Ledger.Index                            (UtxoIndex)
-import           Playground.Types                        (FunctionSchema)
-import           Plutus.PAB.Effects.Contract.ContractExe (ContractExe)
-import           Plutus.PAB.Events                       (PABEvent)
-import           Plutus.PAB.Events.Contract              (ContractPABRequest)
-import           Plutus.PAB.Events.ContractInstanceState (PartiallyDecodedResponse)
-import           Schema                                  (FormSchema)
-import           Wallet.Rollup.Types                     (AnnotatedTx)
-import           Wallet.Types                            (ContractInstanceId)
+import           Data.Aeson                                      (FromJSON, ToJSON)
+import qualified Data.Aeson                                      as JSON
+import           Data.Map                                        (Map)
+import           GHC.Generics                                    (Generic)
+import           Plutus.Contract.Effects.ExposeEndpoint (ActiveEndpoint)
+import           Ledger                                          (Tx, TxId)
+import           Ledger.Index                                    (UtxoIndex)
+import           Ledger.Slot                                     (Slot)
+import           Ledger.Value                                    (Value)
+import           Playground.Types                                (FunctionSchema)
+import           Plutus.PAB.Events.Contract                      (ContractPABRequest)
+import           Plutus.PAB.Events.ContractInstanceState         (PartiallyDecodedResponse)
+import           Schema                                          (FormSchema)
+import           Wallet.Emulator.Wallet                          (Wallet)
+import           Wallet.Rollup.Types                             (AnnotatedTx)
+import           Wallet.Types                                    (ContractInstanceId)
 
 data ContractReport t =
     ContractReport
@@ -67,52 +63,44 @@ data ContractSignatureResponse t =
     deriving stock (Generic, Eq, Show)
     deriving anyclass (ToJSON, FromJSON)
 
-data StreamToServer
-    = FetchProperties Metadata.Subject
-    | FetchProperty Metadata.Subject Metadata.PropertyKey
-    deriving (Show, Eq, Generic)
-    deriving anyclass (FromJSON, ToJSON)
-
-deriving via (Tagged "stream_to_server" StreamToServer) instance
-         StructuredLog StreamToServer
-
-data StreamToClient
-    = NewChainReport ChainReport
-    | NewContractReport (ContractReport ContractExe)
-    | NewPABEvents [PABEvent ContractExe]
-    | FetchedProperties (Metadata.SubjectProperties 'Metadata.AesonEncoding)
-    | FetchedProperty Metadata.Subject (Metadata.Property 'Metadata.AesonEncoding)
-    | ErrorResponse Text
-    deriving (Show, Eq, Generic)
-    deriving anyclass (FromJSON, ToJSON)
+-- | Data needed to start a new instance of a contract.
+data ContractActivationArgs t =
+    ContractActivationArgs
+        { caID     :: t -- ^ ID of the contract
+        , caWallet :: Wallet -- ^ Wallet that should be used for this instance
+        }
+    deriving stock (Eq, Show, Generic)
+    deriving anyclass (ToJSON, FromJSON)
 
-deriving via (Tagged "stream_to_client" StreamToClient) instance
-         StructuredLog StreamToClient
+-- | Current state of a contract instance
+--   (to be sent to external clients)
+data ContractInstanceClientState =
+    ContractInstanceClientState
+        { cicContract     :: ContractInstanceId
+        , cicCurrentState :: PartiallyDecodedResponse ActiveEndpoint
+        }
+        deriving stock (Eq, Show, Generic)
+        deriving anyclass (ToJSON, FromJSON)
 
-data WebSocketLogMsg
-    = CreatedConnection UUID
-    | ClosedConnection UUID
-    | ReceivedWebSocketRequest (Either Text StreamToServer)
-    | SendingWebSocketResponse StreamToClient
-    deriving  (Show, Eq, Generic)
+-- | Status updates for contract instances streamed to client
+data InstanceStatusToClient
+    = NewObservableState JSON.Value -- ^ The observable state of the contract has changed.
+    | NewActiveEndpoints [ActiveEndpoint] -- ^ The set of active endpoints has changed.
+    | ContractFinished (Maybe JSON.Value) -- ^ Contract instance is done with an optional error message.
+    deriving stock (Generic, Eq, Show)
     deriving anyclass (ToJSON, FromJSON)
 
-instance Pretty WebSocketLogMsg where
-    pretty (CreatedConnection uuid) =
-        "Created WebSocket conection:" <+> viaShow uuid
-    pretty (ClosedConnection uuid) =
-        "Closed WebSocket conection:" <+> viaShow uuid
-    pretty (ReceivedWebSocketRequest request) =
-        "Received WebSocket request:" <+> viaShow request
-    pretty (SendingWebSocketResponse response) =
-        "Sending WebSocket response:" <+> viaShow response
+-- | Data sent to the client through the combined websocket API
+data CombinedWSStreamToClient
+    = InstanceUpdate ContractInstanceId InstanceStatusToClient
+    | SlotChange Slot -- ^ New slot number
+    | WalletFundsChange Wallet Value -- ^ The funds of the wallet have changed
+    deriving stock (Generic, Eq, Show)
+    deriving anyclass (ToJSON, FromJSON)
 
-instance ToObject WebSocketLogMsg where
-    toObject _ =
-        \case
-            CreatedConnection u -> mkObjectStr "created connection" u
-            ClosedConnection u -> mkObjectStr "closed connection" u
-            ReceivedWebSocketRequest request ->
-                mkObjectStr "received websocket request" request
-            SendingWebSocketResponse response ->
-                mkObjectStr "sending websocket response" response
+-- | Instructions sent to the server through the combined websocket API
+data CombinedWSStreamToServer
+    = Subscribe (Either ContractInstanceId Wallet)
+    | Unsubscribe (Either ContractInstanceId Wallet)
+    deriving stock (Generic, Eq, Show)
+    deriving anyclass (ToJSON, FromJSON)
diff --git a/plutus-pab/src/Plutus/PAB/Webserver/WebSocket.hs b/plutus-pab/src/Plutus/PAB/Webserver/WebSocket.hs
@@ -48,10 +48,11 @@ import           Plutus.PAB.Core.ContractInstance.STM            (BlockchainEnv,
 import qualified Plutus.PAB.Core.ContractInstance.STM            as Instances
 import qualified Plutus.PAB.Effects.Contract                     as Contract
 import           Plutus.PAB.Types                                (PABError (OtherError))
-import           Plutus.PAB.Webserver.API                        (CombinedWSStreamToClient (..),
-                                                                  CombinedWSStreamToServer (..),
+import           Plutus.PAB.Webserver.API                        ()
+import           Plutus.PAB.Webserver.Types                      (CombinedWSStreamToClient (..),
+                                                                  CombinedWSStreamToServer (..), ContractReport (..),
+                                                                  ContractSignatureResponse (..),
                                                                   InstanceStatusToClient (..))
-import           Plutus.PAB.Webserver.Types                      (ContractReport (..), ContractSignatureResponse (..))
 import           Wallet.Emulator.Wallet                          (Wallet)
 import qualified Wallet.Emulator.Wallet                          as Wallet
 import           Wallet.Types                                    (ContractInstanceId (..))