PLT-8828 - Forbid contract is not mixing mainnet and testnet before s…

…ending to Runner

marlowe-playground-client/src/Marlowe/Linter.purs

@@ -13,6 +13,7 @@ module Marlowe.Linter
   , _network
   , hasInvalidAddresses
   , isSeveralNetworks
+  , getNetworkFor
   ) where
 
 import Prologue
@@ -1041,3 +1042,6 @@ hasInvalidAddresses ec =
     State { warnings } = lint Nil (toTerm ec)
   in
     any isAddressWarning warnings
+
+getNetworkFor :: Term Contract -> Networks
+getNetworkFor c = let State { network: n } = lint Nil c in n

marlowe-playground-client/src/Page/Simulation/Lenses.purs

@@ -4,6 +4,7 @@ import Component.BottomPanel.Types as BottomPanel
 import Data.Lens (Lens')
 import Data.Lens.Record (prop)
 import Help (HelpContext)
+import Marlowe.Linter (Networks)
 import Page.Simulation.Types (BottomPanelView, State)
 import Type.Proxy (Proxy(..))
 
@@ -18,3 +19,7 @@ _bottomPanelState = prop (Proxy :: _ "bottomPanelState")
 
 _decorationIds :: Lens' State (Array String)
 _decorationIds = prop (Proxy :: _ "decorationIds")
+
+_network :: Lens' State Networks
+_network = prop (Proxy :: _ "networks")
+

marlowe-playground-client/src/Page/Simulation/State.purs

@@ -56,6 +56,7 @@ import Marlowe (Api)
 import Marlowe as Server
 import Marlowe.Holes (Contract) as Term
 import Marlowe.Holes (Location(..), Term, fromTerm, getLocation)
+import Marlowe.Linter (getNetworkFor)
 import Marlowe.Monaco as MM
 import Marlowe.Parser (parseContract)
 import Marlowe.Template (_timeContent, _valueContent, fillTemplate)
@@ -65,6 +66,7 @@ import Page.Simulation.Lenses
   ( _bottomPanelState
   , _decorationIds
   , _helpContext
+  , _network
   , _showRightPanel
   )
 import Page.Simulation.Types (Action(..), BottomPanelView(..), State, StateBase)
@@ -112,6 +114,7 @@ mkStateBase tzOffset =
   , helpContext: MarloweHelp
   , bottomPanelState: BottomPanel.initialState CurrentStateView
   , decorationIds: []
+  , networks: mempty
   }
 
 toBottomPanel
@@ -248,14 +251,14 @@ handleAction metadata (LoadContract contents) = do
       _ -> pure Nothing
   let
     mTermContract = hush $ parseContract contents
-  for_ mTermContract \termContract ->
+  for_ mTermContract \termContract -> do
+    assign _network (getNetworkFor termContract)
     assign
       _marloweState
       ( NEL.singleton
           $ initialMarloweState currentTime termContract metadata
               prevTemplateContent
       )
-
   editorSetValue contents
 
 handleAction metadata (BottomPanelAction (BottomPanel.PanelAction action)) =

marlowe-playground-client/src/Page/Simulation/Types.purs

@@ -20,6 +20,7 @@ import Language.Marlowe.Core.V1.Semantics.Types
   , ChosenNum
   , InputContent
   )
+import Marlowe.Linter (Networks)
 import Marlowe.Symbolic.Types.Response (Result)
 import Network.RemoteData (RemoteData)
 import Simulator.Types (MarloweState)
@@ -32,6 +33,7 @@ type StateBase r =
   , helpContext :: HelpContext
   -- List of decoration ids used by the monaco editor to track the running contract
   , decorationIds :: Array String
+  , networks :: Networks
   | r
   }
 

marlowe-playground-client/src/Page/Simulation/View.purs

@@ -94,7 +94,7 @@ import Halogen.HTML
   , ul
   )
 import Halogen.HTML.Events (onClick)
-import Halogen.HTML.Properties (class_, classes, disabled, enabled, id)
+import Halogen.HTML.Properties (class_, classes, disabled, enabled, id, title)
 import Halogen.HTML.Properties.ARIA (label, role)
 import Halogen.Monaco (monacoComponent)
 import Humanize
@@ -129,6 +129,7 @@ import MainFrame.Types
   )
 import Marlowe.Holes (TransactionInputContent(..))
 import Marlowe.Holes as Holes
+import Marlowe.Linter (Networks(..))
 import Marlowe.Monaco as MM
 import Marlowe.Template (TemplateContent(..), orderContentUsingMetadata)
 import Marlowe.Time (unixEpoch)
@@ -329,13 +330,14 @@ sidebar
   => MetaData
   -> State
   -> Array (ComponentHTML Action ChildSlots m)
-sidebar metadata state =
+sidebar metadata state@({ networks: netw }) =
   case preview (_marloweState <<< _Head <<< _executionState) state of
     Just (SimulationNotStarted notStartedRecord) ->
       [ startSimulationWidget
           metadata
           notStartedRecord
           state.tzOffset
+          netw
       ]
     Just (SimulationRunning _) ->
       [ div [ class_ smallSpaceBottom ] [ simulationStateWidget state ]
@@ -360,13 +362,15 @@ startSimulationWidget
   => MetaData
   -> InitialConditionsRecord
   -> Minutes
+  -> Networks
   -> ComponentHTML Action ChildSlots m
 startSimulationWidget
   metadata
   { initialTime
   , templateContent
   }
-  tzOffset =
+  tzOffset
+  netwrks =
   cardWidget "Simulation has not started yet"
     $ div_
         [ div
@@ -395,10 +399,22 @@ startSimulationWidget
                 ]
                 [ text "Download as JSON" ]
             , button
-                [ classNames
-                    [ "btn", "bold", "flex-1", "max-w-[15rem]", "mx-2" ]
-                , onClick $ const ExportToRunner
-                ]
+                ( [ classNames
+                      [ "btn", "bold", "flex-1", "max-w-[15rem]", "mx-2" ]
+                  , onClick $ const ExportToRunner
+                  ] <> case netwrks of
+                    Unknown -> [ enabled true ]
+                    Mainnet ->
+                      [ enabled false
+                      , title "Exporting to mainnet Runner not supported"
+                      ]
+                    Testnet -> [ enabled true ]
+                    SeveralNetworks ->
+                      [ enabled false
+                      , title
+                          "Addresses from both mainnet and testnet were found in the contract"
+                      ]
+                )
                 [ text "Export to Marlowe Runner" ]
             , button
                 [ classNames