WalletConnect

README.md

@@ -221,3 +221,4 @@ The nice aspect of using a virtual machine is taking advantage of virtualbox's a
 To take a snapshot (if the machine is running), Click on the "Machine" menu of Virtualbox and click "Take Snapshot".
 
 To restore from a snapshot, go to the VirtualBox manager, click "Snapshot" and click "Restore".
+

backend/backend.cabal

@@ -46,6 +46,7 @@ library
                , hsass
                , template-haskell
                , th-utilities
+               , wallet-connect
 
   exposed-modules: Backend
                  , Backend.App

backend/src/Backend/App.hs

@@ -21,6 +21,7 @@ import qualified Control.Concurrent.Async as Async
 import qualified Data.ByteString as BS
 import qualified Data.List as L
 import qualified Data.Map as M
+import Data.Proxy (Proxy(..))
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
@@ -31,6 +32,7 @@ import qualified Snap.Http.Server as Snap
 import qualified System.Directory as Directory
 import qualified System.Environment as Env
 import Pact.Server.ApiClient (runTransactionLoggerT, logTransactionFile, commandLogFilename)
+import WalletConnect.Wallet (Metadata)
 
 import Backend (serveBackendRoute)
 import Common.Logger (LogStr,LogLevel)
@@ -164,6 +166,8 @@ main' ffi mainBundleResourcePath runHTML = do
     (signingHandler, quickSignHandler) <- walletServer
       (_appFFI_moveToForeground ffi)
       (_appFFI_moveToBackground ffi)
+      (Proxy :: Proxy Metadata)
+
     waitForBackend port
     liftIO $ putStrLn "Starting jsaddle"
     runHTML "index.html" route putStrLn handleOpen $ do
@@ -192,6 +196,11 @@ main' ffi mainBundleResourcePath runHTML = do
             bowserLoad <- takeMVarTriggerEvent bowserMVar
             fileOpened <- takeMVarTriggerEvent fileOpenedMVar
 
+            signingReqEv <- do
+              sreq <- tryReadMVarTriggerEvent (_mvarHandler_readRequest signingHandler)
+              qsreq <- tryReadMVarTriggerEvent (_mvarHandler_readRequest quickSignHandler)
+              pure $ leftmost [() <$ sreq, () <$ qsreq]
+
             let fileFFI = FileFFI
                   { _fileFFI_openFileDialog = liftIO . _appFFI_global_openFileDialog ffi
                   , _fileFFI_externalFileOpened = fileOpened
@@ -202,8 +211,7 @@ main' ffi mainBundleResourcePath runHTML = do
                   , _appCfg_loadEditor = loadEditorFromLocalStorage
                   -- DB 2019-08-07 Changing this back to False because it's just too convenient this way.
                   , _appCfg_editorReadOnly = False
-                  , _appCfg_signingHandler = mkFRPHandler signingHandler
-                  , _appCfg_quickSignHandler = mkFRPHandler quickSignHandler
+                  , _appCfg_signingHandler = (,) <$> mkFRPHandler signingHandler <*> mkFRPHandler quickSignHandler
                   , _appCfg_enabledSettings = enabledSettings
                   , _appCfg_logMessage = _appFFI_global_logFunction ffi
                   }
@@ -213,7 +221,7 @@ main' ffi mainBundleResourcePath runHTML = do
                  $ runWithReplace loaderMarkup
                  $ ( liftIO (_appFFI_activateWindow ffi)
                      >> liftIO (_appFFI_resizeWindow ffi defaultWindowSize)
-                     >> bipWallet fileFFI (_mvarHandler_readRequest signingHandler) (_mvarHandler_readRequest quickSignHandler) appCfg
+                     >> bipWallet fileFFI signingReqEv appCfg
                    )
                  <$ bowserLoad
             pure ()

common/src/Common/Route.hs

@@ -55,6 +55,7 @@ data FrontendRoute :: * -> * where
   FrontendRoute_Keys :: FrontendRoute ()
   FrontendRoute_Resources :: FrontendRoute ()
   FrontendRoute_Settings :: FrontendRoute ()
+  FrontendRoute_WalletConnect :: FrontendRoute (Map Text (Maybe Text))
 
 data ContractRoute a where
   -- | Route for loading an example.
@@ -92,6 +93,7 @@ backendRouteEncoder = handleEncoder (\_e -> hoistR (FullRoute_Frontend . Obelisk
       FrontendRoute_Keys -> PathSegment "keys" $ unitEncoder mempty
       FrontendRoute_Settings -> PathSegment "settings" $ unitEncoder mempty
       FrontendRoute_Resources -> PathSegment "resources" $ unitEncoder mempty
+      FrontendRoute_WalletConnect -> PathSegment "wc" $ queryOnlyEncoder
 
 contractRouteEncoder :: (MonadError Text parse, MonadError Text check) => Encoder parse check (R ContractRoute) PageName
 contractRouteEncoder = pathComponentEncoder $ \case

dep/reflex-notifications/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/reflex-notifications/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "reflex-notifications",
+  "branch": "main",
+  "private": false,
+  "rev": "ff606c5b6dc001368f7516c028ee162ff64d6062",
+  "sha256": "083bmsgha9vynjsrwbw34r3rafddaqpbvxj5jj8b0isc3vkp6z3z"
+}

dep/reflex-notifications/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/wallet-connect/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/wallet-connect/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "kadena-io",
+  "repo": "walletconnect-hs-interface",
+  "branch": "main",
+  "private": false,
+  "rev": "e2eb54045a7b058b2d1de4c0c4ca65f7997f67c9",
+  "sha256": "01d9z334gsxbx6zp4d7h1k6x82ia2jkhw8j4a4qx3rx6rlq0d328"
+}

dep/wallet-connect/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

desktop/desktop.cabal

@@ -55,14 +55,13 @@ library
     , transformers
     , universe-dependent-sum
     , wai-cors
+    , wallet-connect
     , warp
 
   exposed-modules:
     Desktop.Crypto.BIP
     , Desktop.Frontend
-    , Desktop.ImportExport
     , Desktop.Orphans
-    , Desktop.Setup
     , Desktop.Storage.File
     , Desktop.Syslog
     , Desktop.WalletApi

desktop/src/Desktop/Crypto/BIP.hs

@@ -72,9 +72,6 @@ data BIPStorage a where
   BIPStorage_RootKey :: BIPStorage Crypto.XPrv
 deriving instance Show (BIPStorage a)
 
-bipMetaPrefix :: StoreKeyMetaPrefix
-bipMetaPrefix = StoreKeyMetaPrefix "BIPStorage_Meta"
-
 -- | Check the validity of the password by signing and verifying a message
 passwordRoundTripTest :: Crypto.XPrv -> Password -> Bool
 passwordRoundTripTest xprv (Password pass) =
@@ -236,5 +233,5 @@ instance (Prerender js t m, Monad m, Reflex t) => Prerender js t (BIPCryptoT t m
   type Client (BIPCryptoT t m) = BIPCryptoT t (Client m)
   prerender a b = BIPCryptoT $ prerender (unBIPCryptoT a) (unBIPCryptoT b)
 
-runBIPCryptoT :: Behavior t (Crypto.XPrv, Text) -> BIPCryptoT t m a -> m a
-runBIPCryptoT b (BIPCryptoT m) = runReaderT m b
+runBIPCryptoT :: (Reflex t) => Behavior t (Crypto.XPrv, Password) -> BIPCryptoT t m a -> m a
+runBIPCryptoT b (BIPCryptoT m) = runReaderT m ((\(k, Password p) -> (k, p)) <$> b)

desktop/src/Desktop/Frontend.hs

@@ -24,12 +24,13 @@ import Control.Monad ((<=<), guard, void, when)
 import Control.Monad.Fix (MonadFix)
 import Control.Monad.Trans (lift)
 import Control.Monad.IO.Class
-import Data.Bifunctor (first, second)
+import Data.Bifunctor (second)
 import Data.Dependent.Sum
 import Data.Functor.Compose
 import Data.Functor.Identity
 import Data.GADT.Compare.TH
 import Data.Maybe (isJust)
+import Data.Proxy (Proxy(..))
 import Data.Text (Text)
 import Data.Time (NominalDiffTime, getCurrentTime, addUTCTime)
 import Data.Traversable (for)
@@ -53,9 +54,9 @@ import Common.Route
 import Common.Wallet
 import Frontend.AppCfg
 import Desktop.Crypto.BIP
+import Desktop.Orphans ()
 import Frontend.ModuleExplorer.Impl (loadEditorFromLocalStorage)
 import Frontend.Log (defaultLogger)
-import Frontend.Wallet (genZeroKeyPrefix, _unPublicKeyPrefix)
 import Frontend.Storage
 import Frontend.UI.Modal.Impl (showModalBrutal)
 import Frontend.UI.Dialogs.LogoutConfirmation (uiIdeLogoutConfirmation)
@@ -69,12 +70,13 @@ import Frontend.VersionedStore (StoreFrontend(..))
 import Frontend.Storage (runBrowserStorageT)
 import Frontend.Crypto.Password
 import Frontend.Setup.Common
+import Frontend.Setup.ImportExport
 import Frontend.Setup.Password
+import Frontend.Setup.Setup
 import Frontend.Setup.Widgets
-import Desktop.Setup
-import Desktop.ImportExport
 import Desktop.Storage.File
 import Desktop.WalletApi
+import Frontend.WalletConnect
 
 import Pact.Server.ApiClient (WalletEvent (..), commandLogFilename, _transactionLogger_walletEvent, _transactionLogger_rotateLogFile)
 
@@ -132,7 +134,7 @@ data LockScreen a where
   LockScreen_Restore :: LockScreen Crypto.XPrv -- ^ Root key
   LockScreen_RunSetup :: LockScreen ()
   LockScreen_Locked :: LockScreen Crypto.XPrv -- ^ Root key
-  LockScreen_Unlocked :: LockScreen (Crypto.XPrv, Text) -- ^ The root key and password
+  LockScreen_Unlocked :: LockScreen (Crypto.XPrv, Password) -- ^ The root key and password
 
 type MkAppCfg t m
   =  EnabledSettings Crypto.XPrv t (RoutedT t (R FrontendRoute) (BIPCryptoT t m))
@@ -149,11 +151,10 @@ bipWallet
      , Prerender js t m
      )
   => FileFFI t m
-  -> MVar SigningRequest
-  -> MVar QuickSignRequest
+  -> Event t ()
   -> MkAppCfg t m
   -> RoutedT t (R FrontendRoute) m ()
-bipWallet fileFFI signingReq quickSignReq mkAppCfg = do
+bipWallet fileFFI signingReqEv mkAppCfg = do
   txLogger <- askTransactionLogger
 
   let
@@ -162,9 +163,13 @@ bipWallet fileFFI signingReq quickSignReq mkAppCfg = do
       -> WalletExists
       -> RoutedT t (R FrontendRoute) m (Event t (DSum LockScreen Identity))
     runSetup0 mPrv walletExists = do
-      keyAndPass <- runSetup (liftFileFFI lift fileFFI) (isJust mPrv) walletExists
+      let pwCheck k p= pure $ passwordRoundTripTest k p
+          runF k p = runBIPCryptoT (pure (k, p))
+          importWidgetApis = ImportWidgetApis BIPStorage_RootKey pwCheck runF
+
+      keyAndPass <- runSetup (liftFileFFI lift fileFFI) (isJust mPrv) walletExists importWidgetApis
       performEvent $ flip push keyAndPass $ \case
-        Right (x, Password p, newWallet) -> pure $ Just $ do
+        Right (x, p, newWallet) -> pure $ Just $ do
           setItemStorage localStorage BIPStorage_RootKey x
           when newWallet $ do
             liftIO $ _transactionLogger_rotateLogFile txLogger
@@ -189,7 +194,7 @@ bipWallet fileFFI signingReq quickSignReq mkAppCfg = do
       LockScreen_RunSetup :=> _ -> runSetup0 Nothing WalletExists_No
       -- Wallet exists but the lock screen is active
       LockScreen_Locked :=> Compose root -> do
-        (restore, mLogin) <- lockScreenWidget signingReq quickSignReq $ fmap runIdentity $ current root
+        (restore, mLogin) <- lockScreenWidget signingReqEv (\k p -> pure $ passwordRoundTripTest k p) False $ fmap runIdentity $ current root
         pure $ leftmost
           [ (LockScreen_Restore ==>) . runIdentity <$> current root <@ restore
           , (LockScreen_Unlocked ==>) <$> attach (runIdentity <$> current root) mLogin
@@ -212,7 +217,7 @@ bipWallet fileFFI signingReq quickSignReq mkAppCfg = do
                 { _keyPair_publicKey = pub
                 , _keyPair_privateKey = Just newPrv
                 }
-          Frontend.App.app sidebarLogoutLink frontendFileFFI $ mkAppCfg $ EnabledSettings
+          Frontend.App.app sidebarLogoutLink frontendFileFFI never $ mkAppCfg $ EnabledSettings
             { _enabledSettings_changePassword = Just $ ChangePassword
               { _changePassword_requestChange =
                 let doChange (Identity (oldRoot, _)) (Password oldPass, Password newPass, Password repeatPass)
@@ -222,44 +227,18 @@ bipWallet fileFFI signingReq quickSignReq mkAppCfg = do
                           -- Change password for root key
                           let newRoot = Crypto.xPrvChangePass (T.encodeUtf8 oldPass) (T.encodeUtf8 newPass) oldRoot
                           setItemStorage localStorage BIPStorage_RootKey newRoot
-                          liftIO $ trigger (newRoot, newPass)
+                          liftIO $ trigger (newRoot, Password newPass)
                           pure $ Right ()
                       | otherwise = pure $ Left "Invalid password"
                 in performEvent . attachWith doChange (current details)
               -- When updating the keys here, we just always regenerate the key from
               -- the new root
-              , _changePassword_updateKeys = ((second Password) <$> updates, changePasswordDesktopAction)
-              }
-            , _enabledSettings_exportWallet = Just $ ExportWallet
-              { _exportWallet_requestExport = \ePw -> do
-                  let bOldPw = (\(Identity (_,oldPw)) -> oldPw) <$> current details
-                      runExport oldPw newPw = do
-                        pfx <- genZeroKeyPrefix
-                        doExport txLogger pfx oldPw newPw
-
-                      logExport = do
-                        ts <- liftIO getCurrentTime
-                        sender <- genZeroKeyPrefix
-                        liftIO $ _transactionLogger_walletEvent txLogger
-                          WalletEvent_Export
-                          (_unPublicKeyPrefix sender)
-                          ts
-
-                  eExport <- performEvent $ runExport
-                    <$> (Password <$> bOldPw)
-                    <@> (Password <$> ePw)
-
-                  let (eErrExport, eGoodExport) = fanEither eExport
-
-                  eFileDone <- _fileFFI_deliverFile frontendFileFFI eGoodExport
-                  eLogExportDone <- performEvent $ (\r -> r <$ logExport) <$> eFileDone
-
-                  pure $ leftmost
-                    [ Left <$> eErrExport
-                    , first ExportWalletError_FileNotWritable <$> eLogExportDone
-                    ]
+              , _changePassword_updateKeys = (updates, changePasswordDesktopAction)
               }
+            , _enabledSettings_exportWallet =
+              Just $ mkExportWallet txLogger frontendFileFFI details (Proxy :: Proxy (BIPStorage Crypto.XPrv))
             , _enabledSettings_transactionLog = True
+            , _enabledSettings_walletConnect = Nothing
             }
 
           setRoute $ landingPageRoute <$ onLogoutConfirm
@@ -285,20 +264,4 @@ _watchInactivity checkInterval timeout = do
   let checkTime la ti = guard $ addUTCTime timeout la <= _tickInfo_lastUTC ti
   pure $ attachWithMaybe checkTime lastActivity check
 
-lockScreenWidget
-  :: (DomBuilder t m, PostBuild t m, TriggerEvent t m, PerformEvent t m, MonadIO m, MonadFix m, MonadHold t m)
-  => MVar SigningRequest -> MVar QuickSignRequest -> Behavior t Crypto.XPrv -> m (Event t (), Event t Text)
-lockScreenWidget signingReq quickSignReq xprv =
-  setupDiv "fullscreen" $ divClass "wrapper" $ setupDiv "splash" $ mdo
-    (restore, pass, eSubmit) <- lockScreen $ (fmap . fmap)  Password isValid
-    sreq <- tryReadMVarTriggerEvent signingReq
-    qsreq <- tryReadMVarTriggerEvent  quickSignReq
-    let req = leftmost [() <$ sreq, () <$ qsreq]
-    widgetHold_ blank $ ffor req $ \_ -> do
-      let line = divClass (setupClass "signing-request") . text
-      line "You have an incoming signing request."
-      line "Unlock your wallet to view and sign the transaction."
-    let isValid = attachWith (\(p, x) _ -> p <$ guard (passwordRoundTripTest x (Password p))) ((,) <$> current pass <*> xprv) eSubmit
-    pure (restore, fmapMaybe id isValid)
-
 deriveGEq ''LockScreen