Merge pull request #51 from input-output-hk/PLT-8206

PLT-8206 - Add GET endpoint to import contracts

changelog.d/20231024_024818_pablo.lamela_PLT_8206.md

@@ -0,0 +1,41 @@
+<!--
+A new scriv changelog fragment.
+
+Uncomment the section that is right (remove the HTML comment wrapper).
+-->
+
+<!--
+### Removed
+
+- A bullet item for the Removed category.
+
+-->
+
+### Added
+
+- Added endpoint to import contracts from other websites 
+
+<!--
+### Changed
+
+- A bullet item for the Changed category.
+
+-->
+<!--
+### Deprecated
+
+- A bullet item for the Deprecated category.
+
+-->
+<!--
+### Fixed
+
+- A bullet item for the Fixed category.
+
+-->
+<!--
+### Security
+
+- A bullet item for the Security category.
+
+-->

marlowe-playground-client/src/MainFrame/State.purs

@@ -108,7 +108,7 @@ import Page.JavascriptEditor.Types
   ) as JS
 import Page.JavascriptEditor.Types (CompilationState(..))
 import Page.MarloweEditor.State as MarloweEditor
-import Page.MarloweEditor.Types as ME
+import Page.MarloweEditor.Types (Action(..), State, initialState) as ME
 import Page.Simulation.State as Simulation
 import Page.Simulation.Types as ST
 import Rename.State (handleAction) as Rename
@@ -257,6 +257,11 @@ handleSubRoute Router.Simulation = selectView Simulation
 
 handleSubRoute Router.MarloweEditor = selectView MarloweEditor
 
+handleSubRoute (Router.ImportContract contract) = do
+  handleActionWithoutNavigationGuard
+    (MarloweEditorAction (ME.ImportCompressedJSON contract))
+  selectView MarloweEditor
+
 handleSubRoute Router.HaskellEditor = selectView HaskellEditor
 
 handleSubRoute Router.JSEditor = selectView JSEditor
@@ -697,6 +702,7 @@ routeToView { subroute } = case subroute of
   Router.Simulation -> Just Simulation
   Router.HaskellEditor -> Just HaskellEditor
   Router.MarloweEditor -> Just MarloweEditor
+  Router.ImportContract _ -> Just MarloweEditor
   Router.JSEditor -> Just JSEditor
   Router.Blockly -> Just BlocklyEditor
   Router.GithubAuthCallback -> Nothing

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

@@ -11,6 +11,7 @@ import Component.BottomPanel.Types (Action(..), State) as BottomPanel
 import Control.Monad.Except (lift)
 import Control.Monad.Maybe.Extra (hoistMaybe)
 import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)
+import Data.Argonaut.Extra (parseDecodeJson)
 import Data.Array as Array
 import Data.Either (hush)
 import Data.Foldable (for_)
@@ -31,6 +32,7 @@ import Halogen.Extra (mapSubmodule)
 import Halogen.Monaco (Message(..), Query(..)) as Monaco
 import Language.Marlowe.Extended.V1 as Extended
 import Language.Marlowe.Extended.V1.Metadata.Types (MetaData, MetadataHintInfo)
+import Language.Marlowe.ToTerm (toTerm)
 import MainFrame.Types (ChildSlots, _marloweEditorPageSlot)
 import Marlowe (Api)
 import Marlowe.Holes as Holes
@@ -71,6 +73,7 @@ import StaticAnalysis.Types
 import StaticData (marloweBufferLocalStorageKey)
 import StaticData as StaticData
 import Text.Pretty (pretty)
+import Web.Blob.CompressString (decompressFromURI)
 import Web.Event.Extra (preventDefault, readFileFromDragEvent)
 
 toBottomPanel
@@ -142,6 +145,17 @@ handleAction _ (LoadScript key) = do
 
 handleAction _ (SetEditorText contents) = editorSetValue contents
 
+handleAction _ (ImportCompressedJSON contents) = do
+  let
+    decodedContract = case parseDecodeJson (decompressFromURI contents) of
+      Right contract -> contract
+      Left _ -> Extended.Close
+    termContract = toTerm decodedContract :: Holes.Term Holes.Contract
+    prettyContents = show $ pretty termContract
+  editorSetValue prettyContents
+  liftEffect $ SessionStorage.setItem marloweBufferLocalStorageKey
+    prettyContents
+
 handleAction metadata (BottomPanelAction (BottomPanel.PanelAction action)) =
   handleAction
     metadata

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

@@ -32,6 +32,7 @@ data Action
   | MoveToPosition Pos Pos
   | LoadScript String
   | SetEditorText String
+  | ImportCompressedJSON String
   | BottomPanelAction (BottomPanel.Action BottomPanelView Action)
   | ShowErrorDetail Boolean
   | SendToSimulator
@@ -59,6 +60,7 @@ instance actionIsEvent :: IsEvent Action where
   toEvent (LoadScript script) = Just $ (defaultEvent "LoadScript")
     { label = Just script }
   toEvent (SetEditorText _) = Just $ defaultEvent "SetEditorText"
+  toEvent (ImportCompressedJSON _) = Just $ defaultEvent "ImportCompressedJSON"
   toEvent (BottomPanelAction action) = A.toEvent action
   toEvent (ShowErrorDetail _) = Just $ defaultEvent "ShowErrorDetail"
   toEvent SendToSimulator = Just $ defaultEvent "SendToSimulator"

marlowe-playground-client/src/Router.purs

@@ -20,6 +20,7 @@ data SubRoute
   = Home
   | Simulation
   | MarloweEditor
+  | ImportContract String
   | HaskellEditor
   | JSEditor
   | Blockly
@@ -39,12 +40,15 @@ route =
           { "Home": noArgs
           , "Simulation": "simulation" / noArgs
           , "MarloweEditor": "marlowe" / noArgs
+          , "ImportContract": "importContract" / (param "contract")
           , "HaskellEditor": "haskell" / noArgs
           , "JSEditor": "javascript" / noArgs
           , "Blockly": "blockly" / noArgs
           , "GithubAuthCallback": "gh-oauth-cb" / noArgs
           }
   where
+  _importedContract = Proxy :: _ "importedContract"
+
   _gistId = Proxy :: _ "gistId"
 
   _subroute = Proxy :: _ "subroute"

marlowe-playground-client/src/Web/Blob/CompressString.js

@@ -3,3 +3,7 @@ import LZString from 'lz-string';
 export function compressToURI(originalString) {
     return LZString.compressToEncodedURIComponent(originalString);
 }
+
+export function decompressFromURI(compressedString) {
+    return LZString.decompressFromEncodedURIComponent(compressedString);
+}

marlowe-playground-client/src/Web/Blob/CompressString.purs

@@ -1,3 +1,5 @@
-module Web.Blob.CompressString (compressToURI) where
+module Web.Blob.CompressString (compressToURI, decompressFromURI) where
 
 foreign import compressToURI :: String -> String
+
+foreign import decompressFromURI :: String -> String