Compress URI for exporting to Marlowe Runner (#48)

input-output-hk · Oct 18, 2023 · cb14132 · cb14132
1 parent 3e23f02
commit cb14132
Show file tree

Hide file tree

Showing 5 changed files with 21 additions and 11 deletions.
diff --git a/marlowe-playground-client/package-lock.json b/marlowe-playground-client/package-lock.json
diff --git a/marlowe-playground-client/package.json b/marlowe-playground-client/package.json
@@ -23,6 +23,7 @@
     "bootstrap": "^4.3.1",
     "decimal.js": "^10.0.0",
     "json-bigint": "^1.0.0",
+    "lz-string": "^1.5.0",
     "monaco-editor": "^0.22.3",
     "monaco-emacs": "^0.2.2",
     "monaco-vim": "^0.1.7",

diff --git a/marlowe-playground-client/src/MainFrame/State.purs b/marlowe-playground-client/src/MainFrame/State.purs
@@ -31,7 +31,6 @@ import Data.RawJson (RawJson(..))
 import Effect.Aff.Class (class MonadAff, liftAff)
 import Effect.Class (class MonadEffect)
 import Effect.Class.Console (log)
-import Effect.Console as Console
 import Gist (Gist, gistDescription, gistId)
 import Gists.Extra (_GistId)
 import Gists.Types (GistAction(..))
@@ -44,7 +43,6 @@ import Halogen.Monaco (KeyBindings(DefaultBindings))
 import Halogen.Monaco as Monaco
 import Halogen.Query (HalogenM)
 import Halogen.Query.Event (eventListener)
-import JSURI (encodeURIComponent)
 import Language.Marlowe.Core.V1.Semantics.Types (Contract)
 import Language.Marlowe.Extended.V1.Metadata
   ( emptyContractMetadata
@@ -127,6 +125,7 @@ import Simple.JSON (unsafeStringify)
 import StaticData (gistIdLocalStorageKey)
 import StaticData as StaticData
 import Types (WebpackBuildMode(..))
+import Web.Blob.CompressString (compressToURI)
 import Web.HTML (window)
 import Web.HTML (window) as Web
 import Web.HTML.HTMLDocument (toEventTarget)
@@ -643,15 +642,12 @@ handleAction (OpenModal modalView) = assign _showModal $ Just modalView
 handleAction CloseModal = assign _showModal Nothing
 
 handleAction (SendToRunner url contractString) = do
-  case encodeURIComponent contractString of
-    Just encodedContract -> do
-      let fullUrl = url <> "?contract=" <> encodedContract
-      liftEffect $ do
-        win <- window
-        void $ open fullUrl "_blank" "" win
-      handleAction CloseModal
-    Nothing -> do
-      liftEffect $ Console.error "Failed to encode contract string for URL."
+  let encodedContract = compressToURI contractString
+  let fullUrl = url <> "?contract=" <> encodedContract
+  liftEffect $ do
+    win <- window
+    void $ open fullUrl "_blank" "" win
+  handleAction CloseModal
 
 handleAction (OpenLoginPopup intendedAction) = do
   authRole <- liftAff openLoginPopup

diff --git a/marlowe-playground-client/src/Web/Blob/CompressString.js b/marlowe-playground-client/src/Web/Blob/CompressString.js
@@ -0,0 +1,5 @@
+import LZString from 'lz-string';
+
+export function compressToURI(originalString) {
+    return LZString.compressToEncodedURIComponent(originalString);
+}
diff --git a/marlowe-playground-client/src/Web/Blob/CompressString.purs b/marlowe-playground-client/src/Web/Blob/CompressString.purs
@@ -0,0 +1,3 @@
+module Web.Blob.CompressString (compressToURI) where
+
+foreign import compressToURI :: String -> String
Original file line number	Diff line number	Diff line change
		@@ -0,0 +1,3 @@
		module Web.Blob.CompressString (compressToURI) where

		foreign import compressToURI :: String -> String