From e92d7fed09238fa8e10343b3a9e1e9650def4bca Mon Sep 17 00:00:00 2001 From: Rosario Pulella Date: Wed, 4 May 2022 16:10:47 -0400 Subject: [PATCH] deploy: Only show "External Signatures" tab when external keys in payload --- .../src/Frontend/UI/DeploymentSettings.hs | 62 ++++++++++++------- 1 file changed, 38 insertions(+), 24 deletions(-) diff --git a/frontend/src/Frontend/UI/DeploymentSettings.hs b/frontend/src/Frontend/UI/DeploymentSettings.hs index 81c3ee72..59fe44f3 100644 --- a/frontend/src/Frontend/UI/DeploymentSettings.hs +++ b/frontend/src/Frontend/UI/DeploymentSettings.hs @@ -173,21 +173,34 @@ showSettingsTabName DeploymentSettingsView_Preview = "Preview" showSettingsTabName DeploymentSettingsView_Signing = "External Signatures" showSettingsTabName DeploymentSettingsView_Cfg = "Configuration" +tabsToShow :: Maybe DeploymentSettingsView -> Bool -> Bool -> [DeploymentSettingsView] +tabsToShow mUserTabName includePreview includeExternalSignatures + = (maybeToList mUserTabName) + <> stdTabs + <> (if includeExternalSignatures then [DeploymentSettingsView_Signing] else []) + <> (if includePreview then [DeploymentSettingsView_Preview] else []) + + where + stdTabs = [DeploymentSettingsView_Cfg, DeploymentSettingsView_Keys] + -- | Get the previous view, taking into account the custom user tab. -prevView :: Maybe DeploymentSettingsView -> DeploymentSettingsView -> Maybe DeploymentSettingsView -prevView custom = \case +prevView :: Maybe DeploymentSettingsView -> Bool -> DeploymentSettingsView -> Maybe DeploymentSettingsView +prevView custom showingSigningTab = \case DeploymentSettingsView_Custom _ -> Nothing DeploymentSettingsView_Cfg -> custom DeploymentSettingsView_Keys -> Just DeploymentSettingsView_Cfg DeploymentSettingsView_Signing -> Just DeploymentSettingsView_Keys - DeploymentSettingsView_Preview -> Just DeploymentSettingsView_Signing + DeploymentSettingsView_Preview | showingSigningTab -> Just DeploymentSettingsView_Signing + | otherwise -> Just DeploymentSettingsView_Keys -- | Get the next view. -nextView :: Bool -> DeploymentSettingsView -> Maybe DeploymentSettingsView -nextView includePreviewTab = \case +nextView :: Bool -> Bool -> DeploymentSettingsView -> Maybe DeploymentSettingsView +nextView includePreviewTab showingSigningTab = \case DeploymentSettingsView_Custom _ -> Just DeploymentSettingsView_Cfg DeploymentSettingsView_Cfg -> Just DeploymentSettingsView_Keys - DeploymentSettingsView_Keys -> Just DeploymentSettingsView_Signing + DeploymentSettingsView_Keys | showingSigningTab -> Just DeploymentSettingsView_Signing + | includePreviewTab -> Just DeploymentSettingsView_Preview + | otherwise -> Nothing DeploymentSettingsView_Signing | includePreviewTab -> Just DeploymentSettingsView_Preview | otherwise -> Nothing DeploymentSettingsView_Preview -> Nothing @@ -314,12 +327,13 @@ buildDeployTabs ) => Maybe DeploymentSettingsView -> Bool + -> Dynamic t Bool -> Event t (DeploymentSettingsView -> Maybe DeploymentSettingsView) -> m ( Dynamic t DeploymentSettingsView , Event t () , Event t DeploymentSettingsView ) -buildDeployTabs mUserTabName includePreviewTab controls = mdo +buildDeployTabs mUserTabName includePreviewTab dShowExternalSignature controls = mdo let initTab = fromMaybe DeploymentSettingsView_Cfg mUserTabName f thisView g = case g thisView of Just view' -> (Just view', Nothing) @@ -328,19 +342,14 @@ buildDeployTabs mUserTabName includePreviewTab controls = mdo [ const . Just <$> onTabClick , controls ] - (TabBar onTabClick) <- makeTabBar $ TabBarCfg - { _tabBarCfg_tabs = availableTabs - , _tabBarCfg_mkLabel = const $ text . showSettingsTabName - , _tabBarCfg_selectedTab = Just <$> curSelection - , _tabBarCfg_classes = mempty - , _tabBarCfg_type = TabBarType_Secondary + (TabBar onTabClick) <- makeTabBarDyn $ TabBarDynCfg + { _tabBarDynCfg_tabs = tabsToShow mUserTabName includePreviewTab <$> dShowExternalSignature + , _tabBarDynCfg_mkLabel = const $ text . showSettingsTabName + , _tabBarDynCfg_selectedTab = Just <$> curSelection + , _tabBarDynCfg_classes = mempty + , _tabBarDynCfg_type = TabBarType_Secondary } pure (curSelection, done, onTabClick) - where - userTabs = maybeToList mUserTabName - stdTabs = [DeploymentSettingsView_Cfg, DeploymentSettingsView_Keys, DeploymentSettingsView_Signing] - withPreview = if includePreviewTab then [DeploymentSettingsView_Preview] else [] - availableTabs = userTabs <> stdTabs <> withPreview defaultTabViewProgressButtonLabel :: DeploymentSettingsView -> Text defaultTabViewProgressButtonLabel DeploymentSettingsView_Preview = "Submit" @@ -353,11 +362,12 @@ buildDeployTabFooterControls ) => Maybe DeploymentSettingsView -> Bool + -> Behavior t Bool -> Dynamic t DeploymentSettingsView -> (DeploymentSettingsView -> Text) -> Dynamic t Bool -> m (Event t (DeploymentSettingsView -> Maybe DeploymentSettingsView)) -buildDeployTabFooterControls mUserTabName includePreviewTab curSelection stepFn hasResult = do +buildDeployTabFooterControls mUserTabName includePreviewTab bShowExternalSignature curSelection nextBtnTextForTab hasResult = do let backConfig = btnCfgTertiary & uiButtonCfg_class .~ ffor curSelection (\s -> if s == fromMaybe DeploymentSettingsView_Cfg mUserTabName then "hidden" else "") @@ -371,11 +381,11 @@ buildDeployTabFooterControls mUserTabName includePreviewTab curSelection stepFn back <- cancelButton backConfig "Back" next <- uiButtonDyn (def & uiButtonCfg_class .~ "button_type_confirm" & uiButtonCfg_disabled .~ isDisabled) - $ dynText (stepFn <$> curSelection) + $ dynText (nextBtnTextForTab <$> curSelection) pure $ leftmost - [ nextView includePreviewTab <$ next - , prevView mUserTabName <$ back + [ nextView includePreviewTab <$> bShowExternalSignature <@ next + , prevView mUserTabName <$> bShowExternalSignature <@ back ] -- | Show settings related to deployments to the user. @@ -389,14 +399,15 @@ uiDeploymentSettings , HasJsonDataCfg mConf t, Flattenable mConf t, HasJsonData model t , HasCrypto key (Performable m), HasLogger model t , HasTransactionLogger m + , HasCrypto key m ) => model -> DeploymentSettingsConfig t m model a -> m (mConf, Event t (DeploymentSettingsResult key), Maybe a) uiDeploymentSettings m settings = mdo let code = _deploymentSettingsConfig_code settings - (curSelection, done, _) <- buildDeployTabs mUserTabName (_deploymentSettingsConfig_includePreviewTab settings) controls - (conf, result, ma) <- elClass "div" "modal__main transaction_details" $ do + (curSelection, done, _) <- buildDeployTabs mUserTabName (_deploymentSettingsConfig_includePreviewTab settings) showSigning controls + (conf, result, ma, showSigning) <- elClass "div" "modal__main transaction_details" $ do mRes <- traverse (uncurry $ tabPane mempty curSelection) mUserTabCfg @@ -420,6 +431,7 @@ uiDeploymentSettings m settings = mdo let publicKeys = signers <> (Map.keysSet <$> capabilities) eUpdatedSignaturesUi = current (uiSignatures <$> (m ^.wallet_keys) <*> (fmap Set.toList publicKeys)) <@> ePayload + payloadContainsExternalKeys = fmap (not . Set.null . snd) $ splitKeysInAndOutOfStore <$> (m ^. wallet_keys) <*> publicKeys res <- tabPane mempty curSelection DeploymentSettingsView_Signing $ do -- TODO initial condition seems like an error that should not exist. @@ -478,12 +490,14 @@ uiDeploymentSettings m settings = mdo ( cfg & networkCfg_setSender .~ fmapMaybe (fmap unAccountName) (updated mSender) , res , mRes + , payloadContainsExternalKeys ) let command = tagMaybe (current $ fmap hush result) done controls <- modalFooter $ buildDeployTabFooterControls mUserTabName (_deploymentSettingsConfig_includePreviewTab settings) + (current showSigning) curSelection defaultTabViewProgressButtonLabel (isLeft <$> result)