Cloud key based on wallet signature

CHANGELOG.md

@@ -1,5 +1,9 @@
 # Revision history for encoins-frontend
 
+## 0.1.1.5
+
+* Add one more way to make cloud key, the key is making out of connected wallet sign.
+
 ## 0.1.1.4
 
 * Update roadmap

frontend/encoins-frontend.cabal

@@ -1,6 +1,6 @@
 cabal-version: 3.0
 name:          encoins-frontend
-version:       0.1.1.4
+version:       0.1.1.5
 build-type:    Simple
 author:
   Vladimir Sinyakov

frontend/src/Backend/Utility.hs

@@ -8,10 +8,11 @@ import Control.Monad.IO.Class (liftIO)
 import qualified Crypto.Hash.Keccak as Keccak
 import Data.Bool (bool)
 import Data.ByteString.Base16 as BS16
-import Data.Functor ((<&>))
 import Data.Foldable (foldl')
+import Data.Functor ((<&>))
 import qualified Data.Map as Map
 import Data.Maybe (isNothing)
+import qualified Data.Set as Set
 import Data.Text (Text)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
@@ -20,17 +21,17 @@ import qualified Data.UUID as Uid
 import qualified Data.UUID.V4 as Uid
 import Reflex.Dom
 import Witherable (catMaybes)
-import qualified Data.Set as Set
 
 -- O(n * log(n)) instead of O(n^2) in 'nubBy'
 -- It reverse list of tokens
 nubWith :: (Ord b) => (a -> b) -> [a] -> [a]
 nubWith f l = snd $ foldl' (func f) (Set.empty, []) l
-  where
-    func f' (set, acc) x
-          | Set.member x' set = (set, acc)
-          | otherwise = (Set.insert x' set, x : acc)
-        where x' = f' x
+    where
+        func f' (set, acc) x
+            | Set.member x' set = (set, acc)
+            | otherwise = (Set.insert x' set, x : acc)
+            where
+                x' = f' x
 
 -- Combine two lists efficiently excluding duplicates from both lists
 -- Original 'union' excludes duplicates from last list only.
@@ -39,12 +40,13 @@ nubWith f l = snd $ foldl' (func f) (Set.empty, []) l
 -- It reverse list of tokens
 unionWith :: (Ord b) => (a -> b) -> [a] -> [a] -> [a]
 unionWith f l1 l2 =
-  let func f' (set, acc) x
-          | Set.member x' set = (set, acc)
-          | otherwise = (Set.insert x' set, x : acc)
-        where x' = f' x
-      listOfUniq = snd $ foldl' (func f) (Set.empty, []) $ l1 <> l2
-  in listOfUniq
+    let func f' (set, acc) x
+            | Set.member x' set = (set, acc)
+            | otherwise = (Set.insert x' set, x : acc)
+            where
+                x' = f' x
+        listOfUniq = snd $ foldl' (func f) (Set.empty, []) $ l1 <> l2
+     in listOfUniq
 
 normalizePingUrl :: Text -> Text
 normalizePingUrl url = T.append (T.dropWhileEnd (== '/') url) $ case appNetwork of
@@ -127,14 +129,23 @@ toText = T.pack . show
 genUid :: (MonadWidget t m) => Event t () -> m (Event t Text)
 genUid ev = performEvent $ (Uid.toText <$> liftIO Uid.nextRandom) <$ ev
 
--- Keccak 512 is SHA-3. It is used in cryptoJS
--- we use it to replace js external library
+data HashBit = B512 | B384 | B256 | B224
+    deriving (Eq)
+
+hashKeccak :: HashBit -> Text -> Text
+hashKeccak hb raw =
+    let keccak = case hb of
+            B512 -> Keccak.keccak512
+            B384 -> Keccak.keccak384
+            B256 -> Keccak.keccak256
+            B224 -> Keccak.keccak224
+     in TE.decodeUtf8 $ BS16.encode $ keccak $ TE.encodeUtf8 raw
+
 hashKeccak512 :: Text -> Text
-hashKeccak512 raw =
-    TE.decodeUtf8 $
-        BS16.encode $
-            Keccak.keccak512 $
-                TE.encodeUtf8 raw
+hashKeccak512 = hashKeccak B512
+
+hashKeccak256 :: Text -> Text
+hashKeccak256 = hashKeccak B256
 
 isHashOfRaw :: Text -> Text -> Bool
 isHashOfRaw hash raw = hash == hashKeccak512 raw

frontend/src/ENCOINS/App/Body.hs

@@ -12,7 +12,7 @@ import Backend.Protocol.StrongTypes (toPasswordHash)
 import Backend.Protocol.Types (PasswordRaw (..))
 import Backend.Utility (switchHoldDyn)
 import Backend.Status (AppStatus(..))
-import Backend.Wallet (walletsSupportedInApp)
+import Backend.Wallet (walletsSupportedInApp, Wallet(walletName))
 import ENCOINS.App.Widgets.Basic
     ( loadAppDataE
     , waitForScripts
@@ -117,6 +117,7 @@ bodyContentWidget mPass = mdo
     (dSaveWindow, dNewKeyWindow, eRestore) <-
         cloudSettingsWindow
             mPass
+            (walletName <$> dWallet)
             dSaveOnFromCache
             dCloudStatus
             eCloudOpen

frontend/src/ENCOINS/App/Widgets/Cloud.hs

@@ -4,13 +4,14 @@
 module ENCOINS.App.Widgets.Cloud where
 
 import Backend.Protocol.Types
+import Backend.Wallet(WalletName, toJS)
 import Backend.Servant.Requests (restoreRequest, savePingRequest, saveRequest)
 import Backend.Status
     ( AppStatus (..)
     , CloudIconStatus (..)
     , CloudRestoreStatus (..)
     )
-import Backend.Utility (eventMaybeDynDef, switchHoldDyn, toText, unionWith)
+import Backend.Utility (eventMaybeDynDef, switchHoldDyn, toText, unionWith, hashKeccak256)
 import ENCOINS.App.Widgets.Basic
     ( elementResultJS
     , loadAppData
@@ -275,6 +276,26 @@ genAesKey mPass dmCachedKey ev1 = do
         Just _ -> pure never
     pure eNewKeySaved
 
+-- Make cloud key basing on wallet signature.
+-- Then save it to local cache
+makeSignedKey ::
+    (MonadWidget t m) =>
+    Maybe PasswordRaw
+    -> Dynamic t WalletName
+    -> Event t ()
+    -> m (Event t ())
+makeSignedKey mPass dWalletName ev = do
+    let getKeyElId = "getKeyFromSign2"
+    ev2 <- delay 0.1 ev
+    performEvent_ $ JS.getSignedKey getKeyElId <$> tagPromptlyDyn (toJS <$> dWalletName) ev2
+    eSignedKey <- updated <$> elementResultJS
+      getKeyElId
+      id
+    let eHashedSign = hashKeccak256 <$> eSignedKey
+    let eAesKey = MkAesKeyRaw <$> eHashedSign
+    eKeySaved <- saveAppData mPass aesKey eAesKey
+    pure eKeySaved
+
 fetchAesKey ::
     (MonadWidget t m) =>
     Maybe PasswordRaw

frontend/src/ENCOINS/App/Widgets/CloudWindow.hs

@@ -6,12 +6,19 @@ module ENCOINS.App.Widgets.CloudWindow where
 import Backend.Protocol.Types
 import Backend.Status (CloudIconStatus (..))
 import Backend.Utility (space, switchHoldDyn)
+import Backend.Wallet (WalletName (..))
 import ENCOINS.App.Widgets.Basic (removeCacheKey, saveAppData, saveAppData_)
-import ENCOINS.App.Widgets.Cloud (fetchAesKey, genAesKey)
+import ENCOINS.App.Widgets.Cloud (fetchAesKey, genAesKey, makeSignedKey)
 import ENCOINS.Common.Cache (aesKey, isCloudOn)
 import ENCOINS.Common.Events
 import ENCOINS.Common.Widgets.Advanced (copyButton, dialogWindow, withTooltip)
-import ENCOINS.Common.Widgets.Basic (br, btn, btnWithBlock, image)
+import ENCOINS.Common.Widgets.Basic
+    ( br
+    , btn
+    , btnWithBlock
+    , btnWithOverOutBlock
+    , image
+    )
 import JS.Website (copyText)
 
 import Control.Monad (void)
@@ -26,11 +33,12 @@ import Text.Hex (decodeHex)
 cloudSettingsWindow ::
     (MonadWidget t m) =>
     Maybe PasswordRaw
+    -> Dynamic t WalletName
     -> Dynamic t Bool
     -> Dynamic t CloudIconStatus
     -> Event t ()
     -> m (Dynamic t Bool, Dynamic t (Maybe AesKeyRaw), Event t ())
-cloudSettingsWindow mPass cloudCacheFlag dCloudStatus eOpen = mdo
+cloudSettingsWindow mPass dWalletName cloudCacheFlag dCloudStatus eOpen = mdo
     (dCloudOn, dmKey, eCloseByRestore) <- dialogWindow
         True
         eOpen
@@ -48,7 +56,7 @@ cloudSettingsWindow mPass cloudCacheFlag dCloudStatus eOpen = mdo
                 False -> pure never
                 True -> do
                     let eFirstKeyLoad = leftmost [() <$ eCloudChangeValDelayed, eOpen]
-                    dmNewKey <- cloudKeyWidget mPass eFirstKeyLoad
+                    dmNewKey <- cloudKeyWidget mPass dWalletName eFirstKeyLoad
                     divClass "app-Cloud_Restore_Title" $
                         text "Restore all unburned encoins from cloud with your current key"
                     eRestore <- restoreButton dmNewKey
@@ -138,13 +146,15 @@ restoreButton dmKey =
 cloudKeyWidget ::
     (MonadWidget t m) =>
     Maybe PasswordRaw
+    -> Dynamic t WalletName
     -> Event t ()
     -> m (Dynamic t (Maybe AesKeyRaw))
-cloudKeyWidget mPass eFirstLoadKey = mdo
+cloudKeyWidget mPass dWalletName eFirstLoadKey = mdo
     divClass "app-Cloud_AesKey_Title" $
         text "Your AES key for restoring encoins. Save it to a file and keep it secure!"
     eLoadKey <-
-        delay 0.05 $ leftmost [eFirstLoadKey, eKeyRemoved, eKeyGenerated, eUserKeySaved]
+        delay 0.05 $
+            leftmost [eFirstLoadKey, eKeyRemoved, eKeyGenerated, eUserKeySaved, eSignedKey]
     dmKey <- fetchAesKey mPass "cloudKeyWidget-fetchAesKey" eLoadKey
     showKeyWidget dmKey
 
@@ -155,32 +165,57 @@ cloudKeyWidget mPass eFirstLoadKey = mdo
     eUserKeySaved <- saveAppData mPass aesKey eKeyInputByUser
 
     eKeyGenerated <- genAesKey mPass dmKey eGenerate
+
+    eSignedKey <- makeSignedKey mPass dWalletName eGetSignedKey
+
     let dBlockEnter =
             zipDynWith
                 (\mUserKey mCacheKey -> isNothing mUserKey || isJust mCacheKey)
                 dmCorrectKey
                 dmKey
-    (eGenerate, eDelete, eEnter) <- divClass "app-Cloud_Key_ButtonContainer" $ do
+    ( (eEnterOver, eEnterOut, eEnter)
+        , (eGenOver, eGenOut, eGenerate)
+        , (eSignOver, eSignOut, eGetSignedKey)
+        , (eDelOver, eDelOut, eDelete)
+        ) <- divClass "app-Cloud_Key_ButtonContainer" $ do
+        eEnt <-
+            btnWithOverOutBlock
+                "button-switching inverted flex-center"
+                ""
+                dBlockEnter
+                (text "Enter")
         eGen <-
-            btnWithBlock
+            btnWithOverOutBlock
                 "button-switching inverted flex-center"
                 ""
                 (isJust <$> dmKey)
                 (text "Generate")
+        eSign <-
+            btnWithOverOutBlock
+                "button-switching inverted flex-center"
+                ""
+                (zipDynWith (\mKey name -> isJust mKey || name == None) dmKey dWalletName)
+                (text "SignKey")
         eDel <-
-            btnWithBlock
+            btnWithOverOutBlock
                 "button-switching inverted flex-center"
                 ""
                 (isNothing <$> dmKey)
                 (text "Delete")
-        eEnt <-
-            btnWithBlock
-                "button-switching inverted flex-center"
-                ""
-                dBlockEnter
-                (text "Enter")
-        pure (eGen, eDel, eEnt)
+        pure (eEnt, eGen, eSign, eDel)
     eKeyRemoved <- deleteKeyDialog eDelete
+    let eMouseOutButton = leftmost [eEnterOut, eGenOut, eSignOut, eDelOut]
+    dButtonDescription <-
+        holdDyn "To see more details, hover over the active button." $
+            leftmost
+                [ "Button 'Enter' confirmes manually input key." <$ eEnterOver
+                , "Button 'Generate' generates random cloud key." <$ eGenOver
+                , "Button 'SignKey' makes key basing on the sign of connected wallet."
+                    <$ eSignOver
+                , "Button 'Delete' removes currently set key." <$ eDelOver
+                , "To see more details, hover over the active button." <$ eMouseOutButton
+                ]
+    divClass "app-Cloud_ButtonDescription" $ dynText dButtonDescription
     pure dmKey
 
 inputCloudKeyWidget ::

frontend/src/ENCOINS/Common/Widgets/Basic.hs

@@ -77,6 +77,30 @@ btnWithBlock dCls dStyle dIsBlock tags = do
                 leftmost [() <$ domEvent Click e, keydown Enter e]
     pure eGated
 
+btnWithOverOutBlock ::
+    (MonadWidget t m) =>
+    Dynamic t Text
+    -> Dynamic t Text
+    -> Dynamic t Bool
+    -> m ()
+    -> m (Event t (), Event t (), Event t ())
+btnWithOverOutBlock dCls dStyle dIsBlock tags = do
+    let f style cls =
+            "href" =: "#"
+                <> "class" =: "app-button  w-button " `T.append` cls
+                <> "style" =: style
+    let dBlockBtnCls = do
+            defaultClass <- dCls
+            let classWithDisable = defaultClass <> space <> "button-disabled"
+            bool defaultClass classWithDisable <$> dIsBlock
+    (e, _) <- elDynAttr' "a" (zipDynWith f dStyle dBlockBtnCls) tags
+    let mouseOver = () <$ domEvent Mouseover e
+    let mouseOut = () <$ domEvent Mouseout e
+    let eGated =
+            gate (current $ not <$> dIsBlock) $
+                leftmost [() <$ domEvent Click e, keydown Enter e]
+    pure (mouseOver, mouseOut, eGated)
+
 btnExternal ::
     (MonadWidget t m) =>
     Dynamic t Text

frontend/src/JS/App.hs

@@ -219,3 +219,16 @@ decryptSecretList (key, resId, list) = liftIO $ do
 decryptSecretList :: MonadIO m => (Text, Text, [(Text,Text)]) -> m ()
 decryptSecretList _ = error "GHCJS is required!"
 #endif
+
+#ifdef __GHCJS__
+foreign import javascript unsafe
+  "getSignedKey($1,$2)" getSignedKey_js :: JSString -> JSVal -> JSM ()
+
+getSignedKey :: MonadIO m => Text -> Text -> m ()
+getSignedKey resId walletName = liftIO $ do
+  wn <- toJSVal walletName
+  getSignedKey_js (textToStr resId) wn
+#else
+getSignedKey :: MonadIO m => Text -> Text -> m ()
+getSignedKey = const $ error "GHCJS is required!"
+#endif

result/css/encoins.webflow.css

@@ -2404,8 +2404,6 @@ body {
   display: flex;
   justify-content: left;
   flex-direction: column;
-  /* gap: 10px; */
-  /* margin-left: 5%; */
   margin-right: 5%;
 }
 
@@ -2605,4 +2603,11 @@ body {
 .main-Footer_VersionText {
   font-family: Poppins, sans-serif;
   font-size: 20px;
+}
+
+.app-Cloud_ButtonDescription {
+  display: flex;
+  justify-content: left;
+  gap: 10px;
+  margin-top: 10px;
 }

result/js/ENCOINS.js

@@ -155,6 +155,22 @@ async function walletAPI(walletName) {
   }
 }
 
+async function getSignedKey(resId, walletName) {
+  try {
+    const api = await walletAPI(walletName);
+    const rewardAddress = await api.getRewardAddresses();
+    const stakeAddress = rewardAddress[0];
+
+    const mes = '454e434f494e53204163636f756e74'; // hex from 'ENCOINS Account'
+    const dataSignature = await api.signData(stakeAddress, mes);
+
+    setInputValue(resId, dataSignature.signature + dataSignature.key);
+  } catch (e) {
+    console.log('Error in getSignedKey');
+    console.log('error:', e);
+}
+}
+
 async function walletLoad(walletName) {
   console.log("begin walletLoad");
   await loader.load();