Reduce Concurrency to fix build execution in new version of MacOS + obelisk bump

.obelisk/impl/default.nix

@@ -1,7 +1,2 @@
 # DO NOT HAND-EDIT THIS FILE
-import ((import <nixpkgs> {}).fetchFromGitHub (
-  let json = builtins.fromJSON (builtins.readFile ./github.json);
-  in { inherit (json) owner repo rev sha256;
-       private = json.private or false;
-     }
-))
+import (import ./thunk.nix)

.obelisk/impl/github.json

@@ -1,7 +1,8 @@
 {
   "owner": "obsidiansystems",
   "repo": "obelisk",
-  "branch": "master",
-  "rev": "7ad33cbe3e84b209e83c505ce25486445bbd602e",
-  "sha256": "0dlk8y6rxc87crw7764zq2py7nqn38lw496ca1y893m9gdq8qdkz"
+  "branch": "aa/closure-compiler-crash",
+  "private": false,
+  "rev": "d090d08c2e18ba99dbb538cf394e27bb2bf4be6e",
+  "sha256": "0inisvngi409dmbbczxycf005g6czkqackvh0hl5irywbnllgwk9"
 }

.obelisk/impl/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/kpkgs/github.json

@@ -1,8 +1,8 @@
 {
-  "owner": "kadena-io",
+  "owner": "obsidiansystems",
   "repo": "kpkgs",
-  "branch": "master",
+  "branch": "cn/bump-reflex-platform-to-9.0.0",
   "private": false,
-  "rev": "763f1763207a02fbf6257bd8e2a8cef2a9f86e1d",
-  "sha256": "1dncp11hn65dvwpqrw3di6hdlykjpgc0w0ii5lvwdziac861ak2n"
+  "rev": "db1ce502fdc742fb6f2c9797d8ff095579708ad2",
+  "sha256": "16fryymjzk8374va33s9pnjj37gnawb2imj8iiypkdhhzvwlx773"
 }

desktop/src/Desktop/Setup.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -165,7 +166,7 @@ restoreFromImport walletExists fileFFI backWF eBack = nagScreen
       (eSubmit, (dFileSelected, pwInput)) <- setupForm "" "Import File" disabled $ mdo
         ePb <- getPostBuild
         (selectElt, _) <- elClass' "div" "setup__recover-import-file" $ do
-          imgWithAlt (static @"img/import.svg") "Import" blank
+          imgWithAlt $(static "img/import.svg") "Import" blank
           divClass "setup__recover-import-file-text" $ dynText $ ffor dFileSelected $
             maybe "Select a file" (T.pack . takeFileName . fst)
 

frontend/src/Frontend.hs

@@ -126,7 +126,7 @@ loaderMarkup = divClass "spinner" $ do
 newHead :: (Prerender js t m, DomBuilder t m) => (R BackendRoute -> Text) -> m (Event t ())
 newHead routeText = do
   el "title" $ text "(BETA) Kadena Chainweaver: Wallet & IDE"
-  elAttr "link" ("rel" =: "icon" <> "type" =: "image/png" <> "href" =: static @"img/favicon/favicon-96x96.png") blank
+  elAttr "link" ("rel" =: "icon" <> "type" =: "image/png" <> "href" =: $(static "img/favicon/favicon-96x96.png")) blank
   meta ("name" =: "description" <> "content" =: "Write, test, and deploy safe smart contracts using Pact, Kadena's programming language")
   meta ("name" =: "keywords" <> "content" =: "kadena, pact, pact testnet, pact language, pact programming language, smart contracts, safe smart contracts, smart contract language, blockchain, learn blockchain programming, chainweb")
   meta ("charset" =: "utf-8")
@@ -137,15 +137,15 @@ newHead routeText = do
 
   ss "https://fonts.googleapis.com/css?family=Roboto"
   ss "https://fonts.googleapis.com/css?family=Work+Sans"
-  ss (static @"css/font-awesome.min.css")
-  ss (static @"css/ace-theme-chainweaver.css")
+  ss $(static "css/font-awesome.min.css")
+  ss $(static "css/ace-theme-chainweaver.css")
   js "/static/js/ace/ace.js"
   prerender_ blank $ js "/static/js/ace/mode-pact.js"
   -- Allows importing private keys
-  js (static @"js/nacl-fast.min-v1.0.0.js")
+  js $(static "js/nacl-fast.min-v1.0.0.js")
   -- Allows for BIP39-based key generation and encrypted storage of private keys
-  js (static @"js/kadena-crypto.js")
-  (bowser, _) <- js' (static @"js/bowser.min.js")
+  js $(static "js/kadena-crypto.js")
+  (bowser, _) <- js' $(static "js/bowser.min.js")
   pure $ domEvent Load bowser
   where
     js :: forall t n. DomBuilder t n => Text -> n ()
@@ -158,10 +158,10 @@ newHead routeText = do
     -- Allows the use of `static` in CSS and sharing parameters with desktop apps
     haskellCss = T.unlines
       [ "body { min-width: " <> tshow w <> "px; " <> "min-height: " <> tshow h <> "px; }"
-      , alertImg ".icon_type_error"                $ static @"img/error.svg"
-      , alertImg ".icon_type_warning"              $ static @"img/warning.svg"
-      , alertImg "div.ace_gutter-cell.ace_error"   $ static @"img/error.svg"
-      , alertImg "div.ace_gutter-cell.ace_warning" $ static @"img/warning.svg"
+      , alertImg ".icon_type_error"                $ $(static "img/error.svg")
+      , alertImg ".icon_type_warning"              $ $(static "img/warning.svg")
+      , alertImg "div.ace_gutter-cell.ace_error"   $ $(static "img/error.svg")
+      , alertImg "div.ace_gutter-cell.ace_warning" $ $(static "img/warning.svg")
       ]
       where
         bgImg src = "background-image: url(" <> src <> "); background-position: left center"

frontend/src/Frontend/App.hs

@@ -7,6 +7,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -137,7 +138,7 @@ app sidebarExtra fileFFI appCfg = Store.versionedFrontend (Store.versionedStorag
           rec
             let collapseAttrs = ffor open $ \o -> Map.fromList
                   [ ("class", "main__pane-collapse-button" <> if o then "" else " collapsed")
-                  , ("src", static @"img/double_left_arrow.svg")
+                  , ("src", $(static "img/double_left_arrow.svg"))
                   , ("title", if o then "Collapse" else "Open")
                   ]
             (e, _) <- elDynAttr' "img" collapseAttrs blank
@@ -204,7 +205,7 @@ walletSidebar
   => m ()
   -> m (Event t ())
 walletSidebar sidebarExtra = elAttr "div" ("class" =: "sidebar") $ do
-  divClass "sidebar__logo" $ elAttr "img" ("src" =: static @"img/logo.png") blank
+  divClass "sidebar__logo" $ elAttr "img" ("src" =: $(static "img/logo.png")) blank
 
   elAttr "div" ("class" =: "sidebar__content") $ do
     route <- demux . fmap (\(r :/ _) -> Some r) <$> askRoute
@@ -214,7 +215,7 @@ walletSidebar sidebarExtra = elAttr "div" ("class" =: "sidebar") $ do
           void $ uiSidebarIcon selected (routeIcon r) label
     sidebarLink (FrontendRoute_Accounts :/ mempty) "Accounts"
     sidebarLink (FrontendRoute_Keys :/ ()) "Keys"
-    signEvt <- uiSidebarIcon (constDyn False) (static @"img/menu/signature.svg") "SigBuilder"
+    signEvt <- uiSidebarIcon (constDyn False) $(static "img/menu/signature.svg") "SigBuilder"
     sidebarLink (FrontendRoute_Contracts :/ Nothing) "Contracts"
     elAttr "div" ("style" =: "flex-grow: 1") blank
     sidebarLink (FrontendRoute_Resources :/ ()) "Resources"
@@ -225,11 +226,11 @@ walletSidebar sidebarExtra = elAttr "div" ("class" =: "sidebar") $ do
 -- | Get the routes to the icon assets for each route
 routeIcon :: R FrontendRoute -> Text
 routeIcon = \case
-  FrontendRoute_Contracts :/ _ -> static @"img/menu/contracts.svg"
-  FrontendRoute_Accounts :/ _ -> static @"img/menu/wallet.svg"
-  FrontendRoute_Keys :/ _ -> static @"img/menu/keys.svg"
-  FrontendRoute_Resources :/ _ -> static @"img/menu/resources.svg"
-  FrontendRoute_Settings :/ _ -> static @"img/menu/settings.svg"
+  FrontendRoute_Contracts :/ _ -> $(static "img/menu/contracts.svg")
+  FrontendRoute_Accounts :/ _ -> $(static "img/menu/wallet.svg")
+  FrontendRoute_Keys :/ _ -> $(static "img/menu/keys.svg")
+  FrontendRoute_Resources :/ _ -> $(static "img/menu/resources.svg")
+  FrontendRoute_Settings :/ _ -> $(static "img/menu/settings.svg")
 
 -- | Code editing (left hand side currently)
 codePanel :: forall r key t m a. (MonadWidget t m, Routed t r m) => AppCfg key t m -> Dynamic t CssClass -> Ide a key t -> m (IdeCfg a key t)
@@ -413,7 +414,7 @@ controlBarRight fileFFI appCfg m = do
               & uiButtonCfg_title .~ Just "Create gist on GitHub"
               {- & uiButtonCfg_class %~ (<> "main-header__text-icon-button") -}
           ) $ do
-        {- btnTextIcon (static @"img/github-gist-dark.svg") "Make Gist" blank -}
+        {- btnTextIcon $(static "img/github-gist-dark.svg") "Make Gist" blank -}
         text "Make Gist"
 
     openFileBtn = do
@@ -425,11 +426,11 @@ resourcesWidget
   :: (DomBuilder t m)
   => m ()
 resourcesWidget = elClass "div" "icon-grid" $ do
-  resourceCell "Support" (static @"img/resources/support.svg") "https://www.kadena.io/chainweaver"
+  resourceCell "Support" $(static "img/resources/support.svg") "https://www.kadena.io/chainweaver"
     "Explore Help Resources to learn about Chainweaver, solve problems and get in touch"
-  resourceCell "Documentation" (static @"img/resources/documentation.svg") "https://github.com/kadena-io/chainweaver"
+  resourceCell "Documentation" $(static "img/resources/documentation.svg") "https://github.com/kadena-io/chainweaver"
     "Complete technical resources for Chainweaver"
-  resourceCell "Tutorials" (static @"img/resources/tutorials.svg") "https://pactlang.org/"
+  resourceCell "Tutorials" $(static "img/resources/tutorials.svg") "https://pactlang.org/"
     "Read or watch tutorials for writing smart contracts using the Pact language"
   where
     resourceCell title iconUrl href desc = iconGridLaunchLink href $ IconGridCellConfig

frontend/src/Frontend/ModuleExplorer/Example.hs

@@ -110,26 +110,26 @@ exampleName = \case
 exampleFileName :: ExampleRef -> Text
 exampleFileName = \case
   ExampleRef_HelloWorld
-    -> static @ "examples/helloWorld-1.0.pact"
+    -> $(static "examples/helloWorld-1.0.pact")
   ExampleRef_HelloWorld_Keyset
-    -> static @ "examples/helloWorld-keyset-1.0.pact"
+    -> $(static "examples/helloWorld-keyset-1.0.pact")
   ExampleRef_SimplePayment
-    -> static @ "examples/simplePayments-1.0.pact"
+    -> $(static "examples/simplePayments-1.0.pact")
   ExampleRef_Verification
-    -> static @ "examples/verification-1.0.pact"
+    -> $(static "examples/verification-1.0.pact")
 
 
 -- | File name of JSON data for example.
 exampleDataName :: ExampleRef -> Text
 exampleDataName = \case
   ExampleRef_HelloWorld
-    -> static @ "examples/helloWorld-1.0.data.json"
+    -> $(static "examples/helloWorld-1.0.data.json")
   ExampleRef_HelloWorld_Keyset
-    -> static @ "examples/helloWorld-keyset-1.0.data.json"
+    -> $(static "examples/helloWorld-keyset-1.0.data.json")
   ExampleRef_SimplePayment
-    -> static @ "examples/simplePayments-1.0.data.json"
+    -> $(static "examples/simplePayments-1.0.data.json")
   ExampleRef_Verification
-    -> static @ "examples/verification-1.0.data.json"
+    -> $(static "examples/verification-1.0.data.json")
 
 -- | Actually fetch Example code and data.
 --

frontend/src/Frontend/Network.hs

@@ -353,7 +353,7 @@ getNodeInfosAsync
   => [NodeRef]
   -> ((NodeRef, Either Text NodeInfo) -> IO ())
   -> m ()
-getNodeInfosAsync nodes cb = for_ nodes $ \nodeRef -> void $ liftJSM $ forkJSM $ do
+getNodeInfosAsync nodes cb = liftJSM $ forkJSM $ for_ nodes $ \nodeRef -> void $ do
   r <- discoverNode nodeRef
   liftIO $ cb (nodeRef, r)
 

frontend/src/Frontend/Network/NodeInfo.hs

@@ -58,6 +58,7 @@ import qualified Data.Aeson                  as Aeson
 import qualified Data.Aeson.Lens             as AL
 import           Data.Char                   (isDigit)
 import           Data.Default
+import           Data.Either                 (lefts, rights)
 import           Data.List                   (sortOn)
 import           Data.Text                   (Text)
 import qualified Data.Text                   as T
@@ -119,26 +120,23 @@ nodeVersion ni = case _nodeInfo_type ni of
 -- | Retrive the `NodeInfo` for a given host by quering its API.
 discoverNode :: forall m. (MonadJSM m, MonadUnliftIO m, HasJSContext m) => NodeRef -> m (Either Text NodeInfo)
 discoverNode (NodeRef auth) = do
-    httpsReqs <- async $ discoverChainwebOrPact httpsUri
-    httpReqs <- async $ discoverChainwebOrPact httpUri
-
-    -- For some http only servers waiting for a https response will take ages
-    -- on the other hand we need to prefer chainweb detection over pact -s
-    -- detection (as the former is more reliable). Therefore we group them by
-    -- protocol and go with the first success result.
-    waitSuccess [httpsReqs, httpReqs]
+    chainwebResponseHttps <- discoverChainwebNode httpsUri
+    pactResponseHttps     <- discoverPactNode httpsUri
+    chainwebResponseHttp  <- discoverChainwebNode httpUri
+    pactResponseHttp      <- discoverPactNode httpUri
+
+    let allResponses = [chainwebResponseHttps, pactResponseHttps,
+                        chainwebResponseHttp, pactResponseHttp]
+
+    case rights allResponses of
+      [] ->
+        -- Since we didn't get a right response, we'll combine all the error messages
+        pure $ Left $ T.unlines $ lefts allResponses
+      (x:_) ->
+        -- We take the first good answer
+        pure (Right x)
 
   where
-    waitSuccess :: [Async (Either Text NodeInfo)] -> m (Either Text NodeInfo)
-    waitSuccess = \case
-      [] -> pure $ Left ""
-      xs -> do
-        (finished, r) <- waitAny xs
-        case r of
-          Left err -> do
-            left ((err <> "\n\n") <>) <$> waitSuccess (filter (/= finished) xs)
-          Right success -> pure $ Right success
-
     httpsUri = uriFromSchemeAuth [URI.scheme|https|]
     httpUri = uriFromSchemeAuth [URI.scheme|http|]
 
@@ -310,7 +308,7 @@ newXMLHttpRequestWithErrorSane req cb =
 
    Possibly a bug in 'newXMLHttpRequestWithError': https://github.com/reflex-frp/reflex-dom/issues/369
 -}
-newtype SafeXhrRequest a = SafeXhrRequest (XhrRequest a)
+newtype SafeXhrRequest a = SafeXhrRequest (XhrRequest a) deriving Show
 
 mkSafeReq :: URI -> Either Text (SafeXhrRequest ())
 mkSafeReq uri = case uri ^. uriAuthority ^? _Right . authPort of

frontend/src/Frontend/Setup/Common.hs

@@ -5,6 +5,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -103,7 +104,7 @@ lockScreen isValid = do
                    "href" =: "https://www.kadena.io/chainweaver" <>
                    "target" =: "_blank"
                  ) $ do
-        elAttr "img" ("src" =: static @"img/launch_dark.svg" <> "class" =: "button__text-icon") blank
+        elAttr "img" ("src" =: $(static "img/launch_dark.svg") <> "class" =: "button__text-icon") blank
         text "Help"
       uiButton btnCfgSecondary $ text "Restore"
     pure (restore, value pass, eSubmit)
@@ -163,7 +164,7 @@ data WalletExists
 splashLogo :: DomBuilder t m => m ()
 splashLogo = do
   elAttr "div"
-    (  "style" =: ("background-image: url(" <> (static @"img/Wallet_Graphic_1.png") <> ");")
+    (  "style" =: ("background-image: url(" <> $(static "img/Wallet_Graphic_1.png") <> ");")
     <> "class" =: setupClass "splash-bg"
     ) kadenaWalletLogo
 
@@ -247,12 +248,12 @@ passphraseWidget dWords dStage exposeEmpty = do
 walletSplashWithIcon :: DomBuilder t m => m () -> m ()
 walletSplashWithIcon w = do
   elAttr "div" (
-    "style" =: ("background-image: url(" <> (static @"img/Wallet_Graphic_1.png") <> ");")
+    "style" =: ("background-image: url(" <> $(static "img/Wallet_Graphic_1.png") <> ");")
     <> "class" =: (setupClass "splash-bg " <> setupClass "done-splash-bg")
     ) $ do
       w
       elAttr "img" (
-        "src" =: static @"img/Wallet_Icon_Highlighted_Blue.svg" <>
+        "src" =: $(static "img/Wallet_Icon_Highlighted_Blue.svg") <>
         "class" =: setupClass "wallet-blue-icon"
         ) blank
 
@@ -287,7 +288,7 @@ createNewWallet backWF eBack = selfWF
   where
     selfWF = Workflow $  do
       ePb <- getPostBuild
-      elAttr "img" ("src" =: static @"img/Wallet_Graphic_2.png" <> "class" =: setupClass "password-bg") blank
+      elAttr "img" ("src" =: $(static "img/Wallet_Graphic_2.png") <> "class" =: setupClass "password-bg") blank
 
       el "h1" $ text "Set a password"
       setupDiv "new-wallet-password-text" $ do
@@ -474,6 +475,6 @@ mkSidebarLogoutLink :: (TriggerEvent t m, PerformEvent t n, PostBuild t n, DomBu
 mkSidebarLogoutLink = do
   (logout, triggerLogout) <- newTriggerEvent
   pure $ (,) logout $ do
-    clk <- uiSidebarIcon (pure False) (static @"img/menu/logout.svg") "Logout"
+    clk <- uiSidebarIcon (pure False) $(static "img/menu/logout.svg") "Logout"
     performEvent_ $ liftIO . triggerLogout <$> clk
 

frontend/src/Frontend/Setup/Widgets.hs

@@ -6,6 +6,7 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE TypeFamilies #-}
 
@@ -47,7 +48,7 @@ continueForm = setupForm "continue-button" "Continue"
 -- | Wallet logo
 kadenaWalletLogo :: DomBuilder t m => m ()
 kadenaWalletLogo = divClass "logo" $ do
-  elAttr "img" ("src" =: static @"img/kadena_blue_logo.png" <> "class" =: setupClass "kadena-logo") blank
+  elAttr "img" ("src" =: $(static "img/kadena_blue_logo.png") <> "class" =: setupClass "kadena-logo") blank
   elClass "div" "chainweaver" $ text "Chainweaver"
 #ifdef  ghcjs_HOST_OS
   elClass "div" "by-kadena" $ text "by Kadena (BETA)"