Add warning for transfers to accounts with names that don't match 🔑 s…

…et (#695) * added proper checks for mismatched keysets * add warning for mismatched keysets and anon accnames Co-authored-by: jmininger <none>
kadena-io · Oct 25, 2021 · a4ae0ae · a4ae0ae
1 parent 1b9d9c8
commit a4ae0ae
Show file tree

Hide file tree

Showing 3 changed files with 79 additions and 24 deletions.
diff --git a/common/src/Common/Wallet.hs b/common/src/Common/Wallet.hs
@@ -21,6 +21,8 @@ module Common.Wallet
   , textToKey
   , keyToText
   , parsePublicKey
+  , parsePubKeyOrKAccount
+  , accountNameMatchesKeyset 
   , toPactPublicKey
   , KeyPair(..)
   , AccountName(..)
@@ -86,7 +88,7 @@ import Control.Monad.Except (MonadError, throwError)
 import Control.Newtype.Generics    (Newtype (..))
 import Data.Aeson
 import Data.Aeson.Types (toJSONKeyText)
-import Data.Bifunctor (first)
+import Data.Bifunctor (first, second)
 import Data.ByteString (ByteString)
 import Data.Decimal (Decimal, roundTo)
 import Data.Default
@@ -187,6 +189,11 @@ decodeBase16M i =
 parsePublicKey :: MonadError Text m => Text -> m PublicKey
 parsePublicKey = throwDecodingErr . textToKey <=< checkPub . T.strip
 
+-- (Is_k:acc, pubkey)
+parsePubKeyOrKAccount :: AccountName -> (Bool, Either Text PublicKey)
+parsePubKeyOrKAccount (AccountName accName) = 
+  second parsePublicKey $ maybe (False, accName) (\k -> (True, k)) $ T.stripPrefix "k:" accName
+
 throwDecodingErr
   :: MonadError Text m
   => Maybe v
@@ -396,6 +403,20 @@ filterKeyPairs :: Set PublicKey -> IntMap (Key key) -> [KeyPair key]
 filterKeyPairs s m = Map.elems $ Map.restrictKeys (toMap m) s
   where toMap = Map.fromList . fmap (\k -> (_keyPair_publicKey $ _key_pair k, _key_pair k)) . IntMap.elems
 
+-- Checks that all account names of form accName = pubkey has a single-key guard with the same pubkey as
+-- account name
+accountNameMatchesKeyset :: AccountName -> AccountGuard -> Bool
+accountNameMatchesKeyset accName g = case g of
+  AccountGuard_Other _ -> False
+  AccountGuard_KeySetLike (KeySetHeritage ksKeys _ksPred _ksRef) ->
+    case parsePubKeyOrKAccount accName of
+      -- non-k: & non-vanity --> check keyset is singleton
+      (False, Right pk) -> ksKeys == Set.singleton pk
+      -- k:<pubkey> account name, we ignore the keyset and let those users
+      -- do what they want in regard to guards
+      (True, _) -> True
+      otherwise -> False
+
 keysetSatisfiesPredicate :: AccountGuard -> IntMap (Key key) -> Bool
 keysetSatisfiesPredicate ag keys0 = case ag of
   AccountGuard_Other _ -> False

diff --git a/frontend/src/Frontend/UI/Dialogs/AccountDetails.hs b/frontend/src/Frontend/UI/Dialogs/AccountDetails.hs
@@ -7,6 +7,7 @@
 module Frontend.UI.Dialogs.AccountDetails
   ( uiAccountDetailsOnChain
   , uiAccountDetails
+  , uiDisplayKeyset
   ) where
 
 import Control.Lens
@@ -112,28 +113,13 @@ uiAccountDetailsOnChainImpl netname (name, chain, details, account) onClose = Wo
       case _account_status account of
         AccountStatus_Unknown -> text "Unknown"
         AccountStatus_DoesNotExist -> text "Does not exist"
-        AccountStatus_Exists d -> case _accountDetails_guard d of
-          AccountGuard_KeySetLike (KeySetHeritage ksKeys ksPred _ksRef) -> do
-            _ <- displayText "Predicate" ksPred ""
-            elClass "div" "segment segment_type_tertiary labeled-input" $ do
-              divClass "label labeled-input__label" $ text "Public Keys Controlling Account"
-              for_ ksKeys $ \key -> uiInputElement $ def
-                & initialAttributes %~ Map.insert "disabled" "disabled" . addToClassAttr "labeled-input__input labeled-input__multiple"
-                & inputElementConfig_initialValue .~ keyToText key
-          AccountGuard_Other g -> case g of
-            (Pact.GKeySetRef (Pact.KeySetName name)) -> do
-              void $ displayText "Name" name ""
-            _ -> void $ displayText (pactGuardTypeText $ Pact.guardTypeOf g) (renderCompactText g) ""
-
+        AccountStatus_Exists d -> uiDisplayKeyset $ _accountDetails_guard d
     pure notesEdit
-
   modalFooter $ do
     onDone <- confirmButton def "Done"
-
     let
       onNotesUpdate = (netname, name, Just chain,) <$> current notesEdit <@ (onDone <> onClose)
       conf = mempty & walletCfg_updateAccountNotes .~ onNotesUpdate
-
     pure ( ("Account Details", (conf, onDone))
          , never
          )
@@ -157,6 +143,27 @@ uiAccountDetails net account notes onCloseExternal = mdo
          , leftmost [switch $ current dEvent, onClose]
          )
 
+uiDisplayKeyset :: MonadWidget t m => AccountGuard -> m ()
+uiDisplayKeyset guard = 
+  let displayText lbl v cls =
+        let
+          attrFn cfg = uiInputElement $ cfg
+            & initialAttributes <>~ ("disabled" =: "true" <> "class" =: (" " <> cls))
+        in
+          mkLabeledInputView False lbl attrFn $ pure v
+  in case guard of
+    AccountGuard_KeySetLike (KeySetHeritage ksKeys ksPred _ksRef) -> do
+      _ <- displayText "Predicate" ksPred ""
+      elClass "div" "segment segment_type_tertiary labeled-input" $ do
+        divClass "label labeled-input__label" $ text "Public Keys Controlling Account"
+        for_ ksKeys $ \key -> uiInputElement $ def
+          & initialAttributes %~ Map.insert "disabled" "disabled" . addToClassAttr "labeled-input__input labeled-input__multiple"
+          & inputElementConfig_initialValue .~ keyToText key
+    AccountGuard_Other g -> case g of
+      (Pact.GKeySetRef (Pact.KeySetName name)) -> do
+        void $ displayText "Name" name ""
+      _ -> void $ displayText (pactGuardTypeText $ Pact.guardTypeOf g) (renderCompactText g) ""
+
 uiAccountDetailsImpl
   :: ( Monoid mConf
      , HasWalletCfg mConf key t

diff --git a/frontend/src/Frontend/UI/Transfer.hs b/frontend/src/Frontend/UI/Transfer.hs
@@ -107,6 +107,7 @@ import           Frontend.UI.Button
 import           Frontend.UI.DeploymentSettings
 import           Frontend.UI.Dialogs.DeployConfirmation
 import           Frontend.UI.Dialogs.Send
+import           Frontend.UI.Dialogs.AccountDetails
 import           Frontend.UI.Form.Common
 import           Frontend.UI.FormWidget
 import           Frontend.UI.KeysetWidget
@@ -559,17 +560,43 @@ checkReceivingAccount model netInfo ti ty fks tks fromPair = do
           else
             transferDialog model netInfo ti ty fks tks fromPair
       (Just (AccountStatus_Exists (AccountDetails _ g)), Nothing) -> do
+        let 
+          transferDialogWithWarn model netInfo ti ty fks tks fromPair = do
+            close <- modalHeader $ text "Account Keyset"
+            _ <- elClass "div" "modal__main" $ do
+              el "h3" $ text "WARNING"
+              el "div" $ text $ "The on-chain keyset of the receiving account does not match the account name. This may be an indicator of foul-play; you should confirm that the receiving keyset is the expected keyset before continuing"
+              el "hr" blank
+              el "div" $ text $ "If you are doing a cross-chain transfer to yourself, and see this message, you may want to reconsider, as it is possible that you don't have control over the account on the destination chain"
+              el "hr" blank
+              el "div" $ do
+                dialogSectionHeading mempty "Destination Account Name:"
+                mkLabeledInput False "Account Name" uiInputElement $ def
+                  & initialAttributes .~ "disabled" =: "disabled"
+                  & inputElementConfig_initialValue .~ (unAccountName toAccount)
+                dialogSectionHeading mempty "Destination Account Guard:"
+                uiDisplayKeyset g
+            modalFooter $ do
+              cancel <- cancelButton def "No, take me back"
+              let cfg = def & uiButtonCfg_class <>~ "button_type_confirm"
+              next <- uiButtonDyn cfg $ text "Yes, proceed to transfer"
+              return ((mempty, close <> cancel),
+                      Workflow (transferDialog model netInfo ti ty fks tks fromPair) <$ next)
+
+          transferDialogWithKeysetCheck = case accountNameMatchesKeyset toAccount g of
+            True -> transferDialog
+            False -> transferDialogWithWarn
         if (_ca_chain $ _ti_fromAccount ti) /= (_ca_chain $ _ti_toAccount ti)
           then do
             case g of
               AccountGuard_KeySetLike (KeySetHeritage ks p _ref) ->
                 let ti2 = ti { _ti_toKeyset = Just $ UserKeyset ks (parseKeysetPred p) }
-                in transferDialog model netInfo ti2 ty fks tks fromPair
-              AccountGuard_Other _ -> transferDialog model netInfo ti ty fks tks fromPair
+                in transferDialogWithKeysetCheck model netInfo ti2 ty fks tks fromPair
+              AccountGuard_Other _ -> transferDialogWithKeysetCheck model netInfo ti ty fks tks fromPair
           else
             -- Use transfer, probably show the guard at some point
             -- TODO check well-formedness of all keys in the keyset
-            transferDialog model netInfo ti ty fks tks fromPair
+            transferDialogWithKeysetCheck model netInfo ti ty fks tks fromPair
       (_, Just userKeyset) -> do
         -- Use transfer-create
         transferDialog model netInfo ti ty fks tks fromPair
@@ -597,10 +624,10 @@ handleMissingKeyset
   -> (AccountName, AccountDetails)
   -> m ((mConf, Event t ()), Event t (Workflow t m (mConf, Event t ())))
 handleMissingKeyset model netInfo ti ty fks tks fromPair = do
-    let toAccountText = unAccountName $ _ca_account $ _ti_toAccount ti
-        parsePubKeyOrKAccount key = 
-          second parsePublicKey $ maybe (False, key) (\k -> (True, k)) $ T.stripPrefix "k:" key
-    case parsePubKeyOrKAccount toAccountText of
+    let 
+      toAccount = _ca_account $ _ti_toAccount ti
+      toAccountText = unAccountName $ _ca_account $ _ti_toAccount ti
+    case parsePubKeyOrKAccount toAccount of
       -- Vanity account name
       (_, Left _) -> do
         cancel <- fatalTransferError $