From 40ff87ef662328326d04e06e0d7e03a3870bc17e Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Thu, 3 Jun 2021 15:43:07 -0400 Subject: [PATCH 01/16] init commit --- frontend/frontend.cabal | 1 + frontend/src/Frontend/VersionedStore.hs | 16 ++- frontend/src/Frontend/VersionedStore/V2.hs | 158 +++++++++++++++++++++ frontend/src/Frontend/Wallet.hs | 2 +- 4 files changed, 172 insertions(+), 5 deletions(-) create mode 100644 frontend/src/Frontend/VersionedStore/V2.hs diff --git a/frontend/frontend.cabal b/frontend/frontend.cabal index 48dbbeddd..aef8dcba2 100644 --- a/frontend/frontend.cabal +++ b/frontend/frontend.cabal @@ -195,6 +195,7 @@ library , Frontend.VersionedStore.V0 , Frontend.VersionedStore.V0.Wallet , Frontend.VersionedStore.V1 + , Frontend.VersionedStore.V2 , Frontend.Wallet , Reflex.Class.Extended , Reflex.Dom.ACE.Extended diff --git a/frontend/src/Frontend/VersionedStore.hs b/frontend/src/Frontend/VersionedStore.hs index 77c925aad..f08d75f26 100644 --- a/frontend/src/Frontend/VersionedStore.hs +++ b/frontend/src/Frontend/VersionedStore.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} module Frontend.VersionedStore - ( module V1 + ( module V2 , VersionedStorage(..) , StorageVersion , VersioningDecodeJsonError(..) @@ -34,7 +34,8 @@ import Frontend.Storage.Class import qualified Frontend.Storage.Class as Storage import qualified Frontend.VersionedStore.V0 as V0 import qualified Frontend.VersionedStore.V1 as V1 -import Frontend.VersionedStore.V1 as Latest +import qualified Frontend.VersionedStore.V2 as V2 +import Frontend.VersionedStore.V2 as Latest import Frontend.Crypto.Class import Pact.Server.ApiClient (HasTransactionLogger) @@ -55,15 +56,18 @@ data VersioningDecodeJsonError data StoreFrontendVersion key k where StoreFrontendVersion_0 :: StoreFrontendVersion key (V0.StoreFrontend key) StoreFrontendVersion_1 :: StoreFrontendVersion key (V1.StoreFrontend key) + StoreFrontendVersion_2 :: StoreFrontendVersion key (V2.StoreFrontend key) parseVersion :: forall key. StorageVersion -> Maybe (DSum (StoreFrontendVersion key) Proxy) parseVersion 0 = Just $ StoreFrontendVersion_0 :=> (Proxy @(V0.StoreFrontend key)) parseVersion 1 = Just $ StoreFrontendVersion_1 :=> (Proxy @(V1.StoreFrontend key)) +parseVersion 2 = Just $ StoreFrontendVersion_2 :=> (Proxy @(V2.StoreFrontend key)) parseVersion _ = Nothing _nextVersion :: Some (StoreFrontendVersion key) -> Maybe (Some (StoreFrontendVersion key)) _nextVersion (Some StoreFrontendVersion_0) = Just (Some StoreFrontendVersion_1) -_nextVersion (Some StoreFrontendVersion_1) = Nothing +_nextVersion (Some StoreFrontendVersion_1) = Just (Some StoreFrontendVersion_2) +_nextVersion (Some StoreFrontendVersion_2) = Nothing versionedFrontend :: forall t m key @@ -133,8 +137,11 @@ versionedStorage = VersionedStorage Nothing -> throwError $ VersioningDecodeJsonError_UnknownVersion ver Just (StoreFrontendVersion_0 :=> p) -> do v0map <- decodeDMap p jval - lift $ V1.upgradeFromV0 v0map + lift $ V2.upgradeFromV0 v0map Just (StoreFrontendVersion_1 :=> p) -> do + v1map <- decodeDMap p jval + lift $ V2.upgradeFromV1 v1map + Just (StoreFrontendVersion_2 :=> p) -> do decodeDMap p jval decodeDMap @@ -161,3 +168,4 @@ versionedStorage = VersionedStorage liftIO $ Api._transactionLogger_rotateLogFile txLogger pure () Just (StoreFrontendVersion_1 :=> _) -> pure () + Just (StoreFrontendVersion_2 :=> _) -> pure () diff --git a/frontend/src/Frontend/VersionedStore/V2.hs b/frontend/src/Frontend/VersionedStore/V2.hs new file mode 100644 index 000000000..d878a8148 --- /dev/null +++ b/frontend/src/Frontend/VersionedStore/V2.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE GADTs #-} +{-# LANGUAGE TemplateHaskell #-} +module Frontend.VersionedStore.V2 where + +import Data.Aeson +import Data.Aeson.GADT.TH +import Data.Constraint (Dict(Dict)) +import Data.Constraint.Extras +import Data.Dependent.Map (DMap) +import Data.Dependent.Sum (DSum(..)) +import qualified Data.Dependent.Map as DMap +import Data.Functor.Identity (Identity(Identity), runIdentity) +import qualified Data.IntMap as IntMap +import Data.Map (Map) +import qualified Data.Map as Map +import Data.Maybe (catMaybes) +import Data.Text (Text) + +import Common.Foundation +import Common.Wallet +import Common.Network (NetworkName, NodeRef) +import Common.OAuth (OAuthProvider(..)) +import Common.GistStore (GistMeta) + +import Frontend.VersionedStore.TH +import qualified Frontend.VersionedStore.V0 as V0 +import qualified Frontend.VersionedStore.V1 as V1 +import qualified Frontend.VersionedStore.V0.Wallet as V0 +import Frontend.VersionedStore.MigrationUtils +import Frontend.Crypto.Class + +-- WARNING: Upstream deps. Check this when we bump pact and obelisk! +-- May be worth storing this in upstream independent datatypes. +import Pact.Types.ChainId (ChainId(ChainId)) +import Pact.Types.ChainMeta (PublicMeta (..)) +import Obelisk.OAuth.Common (AccessToken, OAuthState) + +data StoreFrontend key a where + StoreFrontend_Wallet_Keys :: StoreFrontend key (KeyStorage key) + StoreFrontend_Wallet_Accounts :: StoreFrontend key AccountStorage + + StoreFrontend_Network_PublicMeta :: StoreFrontend key PublicMeta + StoreFrontend_Network_Networks :: StoreFrontend key (Map NetworkName [NodeRef]) + StoreFrontend_Network_SelectedNetwork :: StoreFrontend key NetworkName + + StoreFrontend_OAuth_Tokens :: StoreFrontend key (Map OAuthProvider AccessToken) + StoreFrontend_OAuth_State :: OAuthProvider -> StoreFrontend key OAuthState + + StoreFrontend_Gist_GistRequested :: StoreFrontend key (GistMeta, Text) + + StoreFrontend_ModuleExplorer_SessionFile :: StoreFrontend key Text + +deriving instance Show (StoreFrontend key a) + +upgradeFromV0 :: (Monad m, HasCrypto key m) => DMap (V0.StoreFrontend key) Identity -> m (DMap (StoreFrontend key) Identity) +upgradeFromV0 v0 = do + (newKeysList, newAccountStorage) <- foldMapM splitOldKey oldKeysList + let newKeys = IntMap.fromList newKeysList + pure $ DMap.fromList . catMaybes $ + [ copyKeyDSum V0.StoreNetwork_PublicMeta StoreFrontend_Network_PublicMeta v0 + , copyKeyDSum V0.StoreNetwork_SelectedNetwork StoreFrontend_Network_SelectedNetwork v0 + -- Technically these are session only and shouldn't be here given the backup restore only works on + -- local storage, but desktop ignores the session vs local distinction so migrating them probably + -- does some good and certainly doesn't hurt. + -- Also, this is currently being very lazy not leaning on the Universe instance of OAuthProvider + , copyKeyDSum V0.StoreOAuth_Tokens StoreFrontend_OAuth_Tokens v0 + , copyKeyDSum (V0.StoreOAuth_State OAuthProvider_GitHub) (StoreFrontend_OAuth_State OAuthProvider_GitHub) v0 + + , copyKeyDSum V0.StoreModuleExplorer_SessionFile StoreFrontend_ModuleExplorer_SessionFile v0 + + , Just (StoreFrontend_Wallet_Keys :=> Identity newKeys) + , Just (StoreFrontend_Wallet_Accounts :=> Identity newAccountStorage) + , newNetworks + ] + where + oldKeysList = maybe [] (IntMap.toList . runIdentity) (DMap.lookup V0.StoreWallet_Keys v0) + + -- We have to walk through the slightly different encoding of the Network information. + -- Also if the storage contains _no_ network configuration then we shouldn't break the new version + -- by storing an empty object. + newNetworks = (\nets -> StoreFrontend_Network_Networks :=> Identity (V0.unNetworkMap $ runIdentity nets)) + <$> DMap.lookup V0.StoreNetwork_Networks v0 + + -- This will regenerate the missing key. Desktop will recover the key with + -- BIP, but the web version will generate a new key! + splitOldKey (keyIdx, V0.SomeAccount_Deleted) = do + (private, public) <- cryptoGenKey keyIdx + let regenerated = KeyPair + { _keyPair_publicKey = public + , _keyPair_privateKey = Just private + } + pure ([(keyIdx, Key regenerated)], mempty) + + splitOldKey (keyIdx, V0.SomeAccount_Account a) = pure + ([(keyIdx, Key (extractKey a))] + , oldAccountToNewStorage a + ) + + oldAccountToNewStorage :: V0.Account key -> AccountStorage + oldAccountToNewStorage a = + let + accountNameText = V0.unAccountName . V0._account_name $ a + chainIdText = V0.unChainId . V0._account_chainId $ a + newChainId = ChainId chainIdText + accountNotesText = V0.unAccountNotes . V0._account_notes $ a + newAccountNotes = mkAccountNotes accountNotesText + newUnfinishedXChain = V0._account_unfinishedCrossChainTransfer a + + accounts = Map.singleton (AccountName accountNameText) $ AccountInfo Nothing + $ Map.singleton newChainId $ VanityAccount newAccountNotes newUnfinishedXChain + + in AccountStorage $ Map.singleton (V0._account_network a) accounts + + upgradePublicKey = PublicKey . V0.unPublicKey + + extractKey (V0.Account { V0._account_key = kp } ) = KeyPair + -- This relies on the V0.Wallet.PublicKey FromJSON checking that it is Base16! + { _keyPair_publicKey = upgradePublicKey $ V0._keyPair_publicKey kp + , _keyPair_privateKey = V0._keyPair_privateKey kp + } + +upgradeFromV1 :: (Monad m, HasCrypto key m) => DMap (V1.StoreFrontend key) Identity -> m (DMap (StoreFrontend key) Identity) +upgradeFromV1 = undefined + +-- The TH doesn't deal with the key type param well because the key in each constructor is actually a +-- different type variable to the one in the data decl. +-- +-- src/Frontend.VersionedStore/V0.hs:69:1-29: error: +-- The exact Name ‘key_a2Kfr’ is not in scope +-- Probable cause: you used a unique Template Haskell name (NameU), +-- perhaps via newName, but did not bind it +-- If that's it, then -ddump-splices might be useful + +instance ArgDict c (StoreFrontend key) where + type ConstraintsFor (StoreFrontend key) c + = ( c (KeyStorage key) + , c AccountStorage + , c PublicMeta + , c (Map NetworkName [NodeRef]) + , c NetworkName + , c (Map OAuthProvider AccessToken) + , c OAuthState + , c (GistMeta, Text) + , c Text + ) + argDict = \case + StoreFrontend_Wallet_Keys {} -> Dict + StoreFrontend_Wallet_Accounts {} -> Dict + StoreFrontend_Network_PublicMeta {} -> Dict + StoreFrontend_Network_Networks {} -> Dict + StoreFrontend_Network_SelectedNetwork {} -> Dict + StoreFrontend_OAuth_Tokens {} -> Dict + StoreFrontend_OAuth_State {} -> Dict + StoreFrontend_Gist_GistRequested {} -> Dict + StoreFrontend_ModuleExplorer_SessionFile {} -> Dict + +deriveStoreInstances ''StoreFrontend +deriveJSONGADT ''StoreFrontend diff --git a/frontend/src/Frontend/Wallet.hs b/frontend/src/Frontend/Wallet.hs index e2b66019f..17ecc8bce 100644 --- a/frontend/src/Frontend/Wallet.hs +++ b/frontend/src/Frontend/Wallet.hs @@ -272,7 +272,7 @@ makeWallet mChangePassword model conf = do --addStarterAccount :: IntMap (Key key) -> AccountData -> AccountData addStarterAccount net ks ad = case IntMap.toList ks of - [(i,k)] -> if Map.size (ad ^. _AccountData . ix net) == 0 + [(_i,k)] -> if Map.size (ad ^. _AccountData . ix net) == 0 then ad <> (AccountData $ net =: (AccountName $ keyToText $ _keyPair_publicKey $ _key_pair k) =: mempty) else ad _ -> ad From 72e76f30ca405a9227012f8a6746660ac9d7a614 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Fri, 4 Jun 2021 12:54:57 -0400 Subject: [PATCH 02/16] 1st cut of migration If we find old noderefs (e.g. us1.testnet.chainweb.com), we remove them and put the correct uri (api.testnet.chainweb.com) --- frontend/src/Frontend/VersionedStore/V2.hs | 64 +++++++++++++++++++++- 1 file changed, 61 insertions(+), 3 deletions(-) diff --git a/frontend/src/Frontend/VersionedStore/V2.hs b/frontend/src/Frontend/VersionedStore/V2.hs index d878a8148..988a824e1 100644 --- a/frontend/src/Frontend/VersionedStore/V2.hs +++ b/frontend/src/Frontend/VersionedStore/V2.hs @@ -9,16 +9,19 @@ import Data.Constraint.Extras import Data.Dependent.Map (DMap) import Data.Dependent.Sum (DSum(..)) import qualified Data.Dependent.Map as DMap +import Data.Function (on) +import Data.Functor ((<&>)) import Data.Functor.Identity (Identity(Identity), runIdentity) import qualified Data.IntMap as IntMap import Data.Map (Map) import qualified Data.Map as Map import Data.Maybe (catMaybes) import Data.Text (Text) +import Text.Printf (printf) import Common.Foundation import Common.Wallet -import Common.Network (NetworkName, NodeRef) +import Common.Network (NetworkName, NodeRef, parseNodeRef) import Common.OAuth (OAuthProvider(..)) import Common.GistStore (GistMeta) @@ -78,7 +81,7 @@ upgradeFromV0 v0 = do -- We have to walk through the slightly different encoding of the Network information. -- Also if the storage contains _no_ network configuration then we shouldn't break the new version -- by storing an empty object. - newNetworks = (\nets -> StoreFrontend_Network_Networks :=> Identity (V0.unNetworkMap $ runIdentity nets)) + newNetworks = (\nets -> StoreFrontend_Network_Networks :=> Identity (convertNodeRefs $ V0.unNetworkMap $ runIdentity nets)) <$> DMap.lookup V0.StoreNetwork_Networks v0 -- This will regenerate the missing key. Desktop will recover the key with @@ -120,7 +123,62 @@ upgradeFromV0 v0 = do } upgradeFromV1 :: (Monad m, HasCrypto key m) => DMap (V1.StoreFrontend key) Identity -> m (DMap (StoreFrontend key) Identity) -upgradeFromV1 = undefined +upgradeFromV1 v1 = + pure $ DMap.fromList . catMaybes $ + [ + copyKeyDSum V1.StoreFrontend_Network_PublicMeta StoreFrontend_Network_PublicMeta v1 + , copyKeyDSum V1.StoreFrontend_Network_SelectedNetwork StoreFrontend_Network_SelectedNetwork v1 + , copyKeyDSum V1.StoreFrontend_OAuth_Tokens StoreFrontend_OAuth_Tokens v1 + , copyKeyDSum (V1.StoreFrontend_OAuth_State OAuthProvider_GitHub) (StoreFrontend_OAuth_State OAuthProvider_GitHub) v1 + , copyKeyDSum V1.StoreFrontend_Wallet_Keys StoreFrontend_Wallet_Keys v1 + , copyKeyDSum V1.StoreFrontend_Wallet_Accounts StoreFrontend_Wallet_Accounts v1 + , copyKeyDSum V1.StoreFrontend_ModuleExplorer_SessionFile StoreFrontend_ModuleExplorer_SessionFile v1 + , newNetworks + ] + where + newNetworks = DMap.lookup V1.StoreFrontend_Network_Networks v1 + <&> \nets -> StoreFrontend_Network_Networks :=> convertNodeRefs <$> nets + +toMultiSet :: Ord a => [a] -> Map a Int +toMultiSet = Map.fromList . flip zip (repeat 1) + +fromMultiSet :: Ord a => Map a Int -> [a] +fromMultiSet = ($ []) . Map.foldrWithKey (\k i -> (.) (dlrep k i)) id + where + dlrep v n + | n < 0 = error "fromMultiSet: IMPOSSIBLE" + | n == 0 = id + | otherwise = (v:) . dlrep v (n - 1) + +convertNodeRefs :: Map NetworkName [NodeRef] -> Map NetworkName [NodeRef] +convertNodeRefs = fmap migrate + where + -- We traverse over every key because in theory, the user could have renamed + -- a network entry (or created a new one) and populated its value with the same + -- undesired noderefs (e.g. us1.testnet.chainweb.com) + migrate = replaceMainnet . replaceTestnet + where + replaceTestnet = (unsafeParseNodeRef "api.testnet.chainweb.com" :) . fromMultiSet . on (flip Map.difference) toMultiSet testnetRefs + replaceMainnet = (unsafeParseNodeRef "api.chainweb.com" :) . fromMultiSet . on (flip Map.difference) toMultiSet mainnetRefs + testnetRefs = unsafeParseNodeRef <$> + [ "us1.testnet.chainweb.com" + , "us2.testnet.chainweb.com" + , "eu1.testnet.chainweb.com" + , "eu2.testnet.chainweb.com" + , "ap1.testnet.chainweb.com" + , "ap2.testnet.chainweb.com"] + mainnetRefs = unsafeParseNodeRef <$> + [ "us-e1.chainweb.com" + , "us-e2.chainweb.com" + , "us-w1.chainweb.com" + , "us-w2.chainweb.com" + , "jp1.chainweb.com" + , "jp2.chainweb.com" + , "fr1.chainweb.com" + , "fr2.chainweb.com"] + +unsafeParseNodeRef :: Text -> NodeRef +unsafeParseNodeRef = either (error . printf "unsafeParseNodeRef: %s") id . parseNodeRef -- The TH doesn't deal with the key type param well because the key in each constructor is actually a -- different type variable to the one in the data decl. From b837e7b34b068aebdfb2c1b97069fdb9c96de299 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Sat, 5 Jun 2021 13:00:31 -0400 Subject: [PATCH 03/16] compose migrations --- frontend/src/Frontend/VersionedStore.hs | 14 +++++++++++--- frontend/src/Frontend/VersionedStore/V2.hs | 10 +++++----- frontend/tests/Frontend/VersionedStoreSpec.hs | 3 ++- 3 files changed, 18 insertions(+), 9 deletions(-) diff --git a/frontend/src/Frontend/VersionedStore.hs b/frontend/src/Frontend/VersionedStore.hs index f08d75f26..909da3a01 100644 --- a/frontend/src/Frontend/VersionedStore.hs +++ b/frontend/src/Frontend/VersionedStore.hs @@ -10,7 +10,7 @@ module Frontend.VersionedStore , versionedFrontend ) where -import Control.Monad.Except (ExceptT, runExceptT, throwError) +import Control.Monad.Except (ExceptT(..), runExceptT, throwError) import Control.Monad.IO.Class (MonadIO, liftIO) import Control.Monad.Trans (lift) import Control.Error ((!?), hoistEither) @@ -164,8 +164,16 @@ versionedStorage = VersionedStorage removeKeyUniverse p localStorage removeKeyUniverse p sessionStorage restoreLocalStorageDump prefix v1Dump 1 + -- Complete the whole upgrade process, then move the logs (TODO: Is this necessary now?) + liftIO $ Api._transactionLogger_rotateLogFile txLogger + ExceptT $ upgradeStorage txLogger + Just (StoreFrontendVersion_1 :=> p) -> do + dump <- (backupLocalStorage prefix p ver) !? VersioningUpgradeError_CouldNotBackup ver + lift $ do + v2Dump <- V2.upgradeFromV1 dump + removeKeyUniverse p localStorage + removeKeyUniverse p sessionStorage + restoreLocalStorageDump prefix v2Dump 2 -- Complete the whole upgrade process, then move the logs liftIO $ Api._transactionLogger_rotateLogFile txLogger - pure () - Just (StoreFrontendVersion_1 :=> _) -> pure () Just (StoreFrontendVersion_2 :=> _) -> pure () diff --git a/frontend/src/Frontend/VersionedStore/V2.hs b/frontend/src/Frontend/VersionedStore/V2.hs index 988a824e1..305b1508b 100644 --- a/frontend/src/Frontend/VersionedStore/V2.hs +++ b/frontend/src/Frontend/VersionedStore/V2.hs @@ -156,18 +156,18 @@ convertNodeRefs = fmap migrate -- We traverse over every key because in theory, the user could have renamed -- a network entry (or created a new one) and populated its value with the same -- undesired noderefs (e.g. us1.testnet.chainweb.com) - migrate = replaceMainnet . replaceTestnet + migrate = replaceMainnetNodeRefs . replaceTestnetNodeRefs where - replaceTestnet = (unsafeParseNodeRef "api.testnet.chainweb.com" :) . fromMultiSet . on (flip Map.difference) toMultiSet testnetRefs - replaceMainnet = (unsafeParseNodeRef "api.chainweb.com" :) . fromMultiSet . on (flip Map.difference) toMultiSet mainnetRefs - testnetRefs = unsafeParseNodeRef <$> + replaceTestnetNodeRefs = (unsafeParseNodeRef "api.testnet.chainweb.com" :) . fromMultiSet . on (flip Map.difference) toMultiSet testnetNodeRefs + replaceMainnetNodeRefs = (unsafeParseNodeRef "api.chainweb.com" :) . fromMultiSet . on (flip Map.difference) toMultiSet mainnetNodeRefs + testnetNodeRefs = unsafeParseNodeRef <$> [ "us1.testnet.chainweb.com" , "us2.testnet.chainweb.com" , "eu1.testnet.chainweb.com" , "eu2.testnet.chainweb.com" , "ap1.testnet.chainweb.com" , "ap2.testnet.chainweb.com"] - mainnetRefs = unsafeParseNodeRef <$> + mainnetNodeRefs = unsafeParseNodeRef <$> [ "us-e1.chainweb.com" , "us-e2.chainweb.com" , "us-w1.chainweb.com" diff --git a/frontend/tests/Frontend/VersionedStoreSpec.hs b/frontend/tests/Frontend/VersionedStoreSpec.hs index 33ce8810b..e6d85c9b4 100644 --- a/frontend/tests/Frontend/VersionedStoreSpec.hs +++ b/frontend/tests/Frontend/VersionedStoreSpec.hs @@ -41,6 +41,7 @@ import Pact.Server.ApiClient (logTransactionStdout) import qualified Frontend.VersionedStore.V0 as V0 import qualified Frontend.VersionedStore.V0.Wallet as V0 import qualified Frontend.VersionedStore.V1 as V1 +import qualified Frontend.VersionedStore.V2 as V2 import Frontend.VersionedStore (VersionedStorage(..),versionedStorage) type TestPrv = Text @@ -214,7 +215,7 @@ testVersioner , HasStorage m , MonadIO m ) - => VersionedStorage m (V1.StoreFrontend TestPrv) + => VersionedStorage m (V2.StoreFrontend TestPrv) testVersioner = versionedStorage instance HasCrypto TestPrv InMemoryStorage where From ac59840262c7a981f128da5debba35e2ed2996d8 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Sat, 5 Jun 2021 16:47:56 -0400 Subject: [PATCH 04/16] bump version on restoreBackup --- frontend/src/Frontend/VersionedStore.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/frontend/src/Frontend/VersionedStore.hs b/frontend/src/Frontend/VersionedStore.hs index 909da3a01..39530bb9c 100644 --- a/frontend/src/Frontend/VersionedStore.hs +++ b/frontend/src/Frontend/VersionedStore.hs @@ -126,7 +126,7 @@ versionedStorage = VersionedStorage prefix = StoreKeyMetaPrefix "StoreFrontend_Meta" restoreBackup :: DMap (Latest.StoreFrontend key) Identity -> m () - restoreBackup dm = restoreLocalStorageDump prefix dm 1 + restoreBackup dm = restoreLocalStorageDump prefix dm 2 -- Takes a json blob and upgrades it to the latest DMap structure decodeVersionedJson From 1d53d8754fe8e05d1c428b3948afdbf664da25cb Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Mon, 7 Jun 2021 14:40:06 -0400 Subject: [PATCH 05/16] don't care about power users just replace the entries for the network names "Testnet" and "Mainnet" --- common/src/Common/Network.hs | 3 +++ frontend/src/Frontend/VersionedStore/V2.hs | 10 +++++----- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/common/src/Common/Network.hs b/common/src/Common/Network.hs index 6aaf22eae..fc7042014 100644 --- a/common/src/Common/Network.hs +++ b/common/src/Common/Network.hs @@ -36,6 +36,7 @@ import Data.CaseInsensitive (CI) import Data.Coerce (coerce) import Data.Map (Map) import Data.Maybe (fromMaybe) +import Data.String import Data.Text (Text) import Data.Void (Void) import GHC.Generics (Generic) @@ -69,6 +70,8 @@ instance ToJSON NetworkName where toJSON = toJSON . CI.original . unNetworkName instance ToJSONKey NetworkName where toJSONKey = A.toJSONKeyText (CI.original . unNetworkName) +instance IsString NetworkName where + fromString = mkNetworkName . fromString mkNetworkName :: Text -> NetworkName mkNetworkName = NetworkName . CI.mk . T.strip diff --git a/frontend/src/Frontend/VersionedStore/V2.hs b/frontend/src/Frontend/VersionedStore/V2.hs index 305b1508b..4fc1925c2 100644 --- a/frontend/src/Frontend/VersionedStore/V2.hs +++ b/frontend/src/Frontend/VersionedStore/V2.hs @@ -151,12 +151,12 @@ fromMultiSet = ($ []) . Map.foldrWithKey (\k i -> (.) (dlrep k i)) id | otherwise = (v:) . dlrep v (n - 1) convertNodeRefs :: Map NetworkName [NodeRef] -> Map NetworkName [NodeRef] -convertNodeRefs = fmap migrate +convertNodeRefs = Map.mapWithKey migrate where - -- We traverse over every key because in theory, the user could have renamed - -- a network entry (or created a new one) and populated its value with the same - -- undesired noderefs (e.g. us1.testnet.chainweb.com) - migrate = replaceMainnetNodeRefs . replaceTestnetNodeRefs + migrate = \case + "Mainnet" -> replaceMainnetNodeRefs + "Testnet" -> replaceTestnetNodeRefs + _ -> id where replaceTestnetNodeRefs = (unsafeParseNodeRef "api.testnet.chainweb.com" :) . fromMultiSet . on (flip Map.difference) toMultiSet testnetNodeRefs replaceMainnetNodeRefs = (unsafeParseNodeRef "api.chainweb.com" :) . fromMultiSet . on (flip Map.difference) toMultiSet mainnetNodeRefs From eaa6f844b87f29573a7e18a1328156b7851d4d9c Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Mon, 7 Jun 2021 21:29:20 -0400 Subject: [PATCH 06/16] add V1->V2 test, fix V0->V2 test also fixed upgrade procedure --- frontend/src/Frontend/VersionedStore/V2.hs | 6 +- .../V1/BIPStorage_RootKey | 1 + .../StoreFrontend_ModuleExplorer_SessionFile | 1 + .../V1/StoreFrontend_Network_Networks | 1 + .../V1/StoreFrontend_Network_PublicMeta | 1 + .../V1/StoreFrontend_Network_SelectedNetwork | 1 + .../V1/StoreFrontend_Wallet_Accounts | 1 + .../V1/StoreFrontend_Wallet_Keys | 1 + .../VersionedStoreSpec.files/V1/bippassword | 1 + .../VersionedStoreSpec.files/V1/bipphrase | 1 + frontend/tests/Frontend/VersionedStoreSpec.hs | 114 +++++++++++++++--- 11 files changed, 109 insertions(+), 20 deletions(-) create mode 100644 frontend/tests/Frontend/VersionedStoreSpec.files/V1/BIPStorage_RootKey create mode 100644 frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_ModuleExplorer_SessionFile create mode 100644 frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_Networks create mode 100644 frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_PublicMeta create mode 100644 frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_SelectedNetwork create mode 100644 frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Wallet_Accounts create mode 100644 frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Wallet_Keys create mode 100644 frontend/tests/Frontend/VersionedStoreSpec.files/V1/bippassword create mode 100644 frontend/tests/Frontend/VersionedStoreSpec.files/V1/bipphrase diff --git a/frontend/src/Frontend/VersionedStore/V2.hs b/frontend/src/Frontend/VersionedStore/V2.hs index 4fc1925c2..b86bba11b 100644 --- a/frontend/src/Frontend/VersionedStore/V2.hs +++ b/frontend/src/Frontend/VersionedStore/V2.hs @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE ViewPatterns #-} module Frontend.VersionedStore.V2 where import Data.Aeson @@ -158,8 +159,9 @@ convertNodeRefs = Map.mapWithKey migrate "Testnet" -> replaceTestnetNodeRefs _ -> id where - replaceTestnetNodeRefs = (unsafeParseNodeRef "api.testnet.chainweb.com" :) . fromMultiSet . on (flip Map.difference) toMultiSet testnetNodeRefs - replaceMainnetNodeRefs = (unsafeParseNodeRef "api.chainweb.com" :) . fromMultiSet . on (flip Map.difference) toMultiSet mainnetNodeRefs + replaceTestnetNodeRefs = addRef "api.testnet.chainweb.com" . fromMultiSet . on (flip Map.difference) toMultiSet testnetNodeRefs + replaceMainnetNodeRefs = addRef "api.chainweb.com" . fromMultiSet . on (flip Map.difference) toMultiSet mainnetNodeRefs + addRef (unsafeParseNodeRef -> ref) refs = if elem ref refs then refs else ref : refs testnetNodeRefs = unsafeParseNodeRef <$> [ "us1.testnet.chainweb.com" , "us2.testnet.chainweb.com" diff --git a/frontend/tests/Frontend/VersionedStoreSpec.files/V1/BIPStorage_RootKey b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/BIPStorage_RootKey new file mode 100644 index 000000000..ede6b42d9 --- /dev/null +++ b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/BIPStorage_RootKey @@ -0,0 +1 @@ +"aae16f371c2f3ed17eff30f1e63b2f5bd64cb9b21fcef399850cf0822a6506368125add41f68e7b5bdcfb5aad44cf409a0ec3d5d623188436d72d634485f093795066bed58fa2fd1be90f90f21f8c1d59d34cc3360a512f48da0011cb9a4bfcc433da5baccec66914232ad850b7c981e173e36864f98f22e3477679d0da3e6ed" diff --git a/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_ModuleExplorer_SessionFile b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_ModuleExplorer_SessionFile new file mode 100644 index 000000000..af47d7eba --- /dev/null +++ b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_ModuleExplorer_SessionFile @@ -0,0 +1 @@ +"(namespace \"free\")\n\n(module hello-world MODULE_ADMIN\n \"A smart contract to greet the world.\"\n (defcap MODULE_ADMIN () true)\n\n (defschema message-schema\n @doc \"Message schema\"\n @model [(invariant (!= msg \"\"))]\n\n msg:string)\n\n (deftable\n message:{message-schema})\n\n (defun set-message\n (\n m:string\n )\n \"Set the message that will be used next\"\n (enforce (!= m \"\") \"set-message: must not be empty\")\n (write message \"0\" {\"msg\": m})\n )\n\n (defun greet ()\n \"Do the hello-world dance\"\n (with-default-read message \"0\" { \"msg\": \"\" } { \"msg\":= msg }\n (format \"Hello {}!\" [msg])))\n)\n\n(create-table message)\n\n(set-message \"world\")\n(greet)" diff --git a/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_Networks b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_Networks new file mode 100644 index 000000000..61c62b29d --- /dev/null +++ b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_Networks @@ -0,0 +1 @@ +{"devnet":["us1.tn1.chainweb.com","us2.tn1.chainweb.com","eu1.tn1.chainweb.com","eu2.tn1.chainweb.com"],"testnet":["api.testnet.chainweb.com"]} \ No newline at end of file diff --git a/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_PublicMeta b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_PublicMeta new file mode 100644 index 000000000..4b76324a7 --- /dev/null +++ b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_PublicMeta @@ -0,0 +1 @@ +{"creationTime":0,"ttl":0,"gasLimit":0,"chainId":"0","gasPrice":0,"sender":"sender00"} diff --git a/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_SelectedNetwork b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_SelectedNetwork new file mode 100644 index 000000000..ad7e20a0e --- /dev/null +++ b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Network_SelectedNetwork @@ -0,0 +1 @@ +"devnet" \ No newline at end of file diff --git a/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Wallet_Accounts b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Wallet_Accounts new file mode 100644 index 000000000..68f383e30 --- /dev/null +++ b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Wallet_Accounts @@ -0,0 +1 @@ +{"devnet":{"b92a5ffed43abe09d3679a6c1ce084a87916dfc3bbb0e1cb10d2b5c5152117fd":{"chains":{"1":{"unfinishedCrossChainTransfer":{"amount":2,"recipientAccount":"c5535652d34724d3489d82a1b9217617eaa1ba607b8c123ecd4b393ea5ee293f","requestKey":"pddhO9LkJdh3r71kahDZktTOIf7Pwu3T8VqjJdDKssA","recipientChain":"2"}}}},"benkolera":{"chains":{"0":{"notes":"I bet you think this account is about you"}}},"c5535652d34724d3489d82a1b9217617eaa1ba607b8c123ecd4b393ea5ee293f":{"chains":{"2":{}}},"b7d6d1e3f20df081b5bbd3159406d9593ac2973e3297cfc13b962513bd537630":{"chains":{"0":{}}},"inflight":{"chains":{"3":{}}}},"testnet":{"d40aada7036bfe72e7ff0aaa16e1f4446b7dea9f26a6c0d0824cd69c42dc1118":{"chains":{"0":{}}},"c9bf2214b6c134fe387798c4994f44606b61ed05c98191c0e00ab79e75b54c2e":{"chains":{"5":{}}},"4e6756f17642c430795e2780d7a1193449ece6e5d9b0ab8d9c01d6a3b8a4d1a1":{"chains":{"1":{}}}}} \ No newline at end of file diff --git a/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Wallet_Keys b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Wallet_Keys new file mode 100644 index 000000000..33c44ef0b --- /dev/null +++ b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/StoreFrontend_Wallet_Keys @@ -0,0 +1 @@ +[[0,{"pair":{"private":"bab338cd6510acf0440f45d753de91e8a2901ca92541f68fe5b167852d65063611561014fe215833c4b56e6f2f23989584a1094c11a09e1262932e89ba2e7245d40aada7036bfe72e7ff0aaa16e1f4446b7dea9f26a6c0d0824cd69c42dc1118118f697b363694dc169bae879d116bf06e99cfd585d4d5194ecb87d321356d8c","public":"d40aada7036bfe72e7ff0aaa16e1f4446b7dea9f26a6c0d0824cd69c42dc1118"}}],[1,{"pair":{"private":"bab9fdfcc2e61269539a280dc735de1284f156c5b38b34b7f7bc3d6c2d650636c0031b438d1f3307d7fbe52a802ebe43a9e6b2840f7213fdcdaca3c5ea396c554e6756f17642c430795e2780d7a1193449ece6e5d9b0ab8d9c01d6a3b8a4d1a1307df71c95e281131c15d116c8385f08d389a0d8acf76ee9e14d5591956214e2","public":"4e6756f17642c430795e2780d7a1193449ece6e5d9b0ab8d9c01d6a3b8a4d1a1"}}],[2,{"pair":{"private":"0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000","public":"0000000000000000000000000000000000000000000000000000000000000000"}}],[3,{"pair":{"private":"da9710f00e8702a97753036b16927adfa32562a887d2d72c23e702b623650636ddb34cc37878f0a5634b443a413835089863fa0e9221186c1fe7c6f60baa267ac9bf2214b6c134fe387798c4994f44606b61ed05c98191c0e00ab79e75b54c2e83212f3e6631a68e7f0a1a77688478a40b9e0af5b3baefe5a82fb71db0c499e2","public":"c9bf2214b6c134fe387798c4994f44606b61ed05c98191c0e00ab79e75b54c2e"}}],[4,{"pair":{"private":"027bac5dccb253b1aa4c7300b134648e244b6e128b20e99153512fcd2f650636d832474457579ce0ce4700c80d80261a3e2ad8ad35fdae576b238fc8c0ce5674b7d6d1e3f20df081b5bbd3159406d9593ac2973e3297cfc13b962513bd53763052340252cbc1d7eac3a821309269ba5e4c8e80d1de3b928a782b5c323be8a02f","public":"b7d6d1e3f20df081b5bbd3159406d9593ac2973e3297cfc13b962513bd537630"}}],[5,{"pair":{"private":"2ac31da7751977744ef3966e6a0bd170bf3203081bae3d1f26135c4a2e65063605bded4e9067cd7017b1c489ca4819988154c07a4b07d5618b59cf5053cc5619b92a5ffed43abe09d3679a6c1ce084a87916dfc3bbb0e1cb10d2b5c5152117fd1b4beac9855c53695f78d7dd65e58d9cac79069daff050a321465b967a6c8403","public":"b92a5ffed43abe09d3679a6c1ce084a87916dfc3bbb0e1cb10d2b5c5152117fd"}}],[6,{"pair":{"private":"d275c3272c88692d94082f901114c83682c485e4bdd8f1e749e125432c650636cf5ca7a8677723fbe798824d51d2d1f22078844ecd5126eb2dadf0cf2ece759cc5535652d34724d3489d82a1b9217617eaa1ba607b8c123ecd4b393ea5ee293feae0b2a51164d673b62b2998bf05e805bbad2552853df0dacfcd55fcb62c9382","public":"c5535652d34724d3489d82a1b9217617eaa1ba607b8c123ecd4b393ea5ee293f"}}],[7,{"pair":{"private":"221d56b80fedb108b109fff560460cf508168d741d8d68c70a8250ca2e650636fd12ce16dcff50ee70b99e216105032716360f05db2d1d34955ffdf8d4a48f68496df4caddbb907e8ff1c76e4979a176ab1b12bd30e7d3136a8e566b50e07b523e7cf52e3c529f4886cc87b874574d1cbaaf55254b00c5df047ed345c33c9e7a","public":"496df4caddbb907e8ff1c76e4979a176ab1b12bd30e7d3136a8e566b50e07b52"}}],[8,{"pair":{"private":"2a55322b611d5ef426166f4d5f2cb6d5351066e193ce3fec137ab793216506368afdee7d23dabf73936a5fa7d309afa9bb22830d587eb006246114dd183b33f4c7fb88b67dee06b1f610411e48da6b87328fa4aea80c533a0ca96f64d3eb06320b73af7e218872031e6323b7baee4fae75a9c5e3d73baf30568aee5bd07946c2","public":"c7fb88b67dee06b1f610411e48da6b87328fa4aea80c533a0ca96f64d3eb0632"}}]] \ No newline at end of file diff --git a/frontend/tests/Frontend/VersionedStoreSpec.files/V1/bippassword b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/bippassword new file mode 100644 index 000000000..a32a4347a --- /dev/null +++ b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/bippassword @@ -0,0 +1 @@ +1234567890 diff --git a/frontend/tests/Frontend/VersionedStoreSpec.files/V1/bipphrase b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/bipphrase new file mode 100644 index 000000000..08bc46a59 --- /dev/null +++ b/frontend/tests/Frontend/VersionedStoreSpec.files/V1/bipphrase @@ -0,0 +1 @@ +save echo increase tape govern claim crystal mammal plastic mammal drastic tail diff --git a/frontend/tests/Frontend/VersionedStoreSpec.hs b/frontend/tests/Frontend/VersionedStoreSpec.hs index e6d85c9b4..23d1f2569 100644 --- a/frontend/tests/Frontend/VersionedStoreSpec.hs +++ b/frontend/tests/Frontend/VersionedStoreSpec.hs @@ -19,7 +19,7 @@ import Data.Text (Text) import Pact.Types.Util (ParseText, fromText') import Pact.Types.Command (RequestKey(..)) import Pact.Types.ChainMeta (PublicMeta (..)) -import Test.Tasty (TestTree, testGroup) +import Test.Tasty (DependencyType(..), TestTree, after, testGroup) import Test.Tasty.HUnit import Text.URI (Authority(Authority)) import Text.URI.QQ (host) @@ -59,6 +59,15 @@ type TestPrv = Text -- TODO: There's no data for the gist and oauth stuff here, but given desktop doesn't do that -- and it hasn't changed, that should be okay. +expectedPublicMeta = PublicMeta + { _pmChainId = "0" + , _pmSender = "sender00" + , _pmGasLimit = 0 + , _pmGasPrice = 0 + , _pmTTL = 0 + , _pmCreationTime = 0 + } + expectedSelectedNetwork :: NetworkName expectedSelectedNetwork = mkNetworkName "devnet" @@ -71,12 +80,7 @@ expectedNetworks = Map.fromList , mkNodeRef [host|eu2.tn1.chainweb.com|] ]) , (mkNetworkName "testnet", - [ mkNodeRef [host|ap1.testnet.chainweb.com|] - , mkNodeRef [host|ap2.testnet.chainweb.com|] - , mkNodeRef [host|eu1.testnet.chainweb.com|] - , mkNodeRef [host|eu2.testnet.chainweb.com|] - , mkNodeRef [host|us1.testnet.chainweb.com|] - , mkNodeRef [host|us2.testnet.chainweb.com|] + [ mkNodeRef [host|api.testnet.chainweb.com|] ]) ] where @@ -230,9 +234,77 @@ instance HasCrypto TestPrv InMemoryStorage where cryptoSignWithPactKeyEither = error "cryptoSignWithPactKeyEither for InMemoryStorage: not implemented" cryptoGenPubKeyFromPrivate = error "cryptoGenPubKeyFromPrivate for InMemoryStorage: not implemented" -test_v0ToV1Upgrade :: TestTree -test_v0ToV1Upgrade = testCaseSteps "V0 to V1 Upgrade" $ \step -> do - let v = testVersioner +test_v1ToV2Upgrade :: TestTree +test_v1ToV2Upgrade = testCaseSteps "V1 to V2 upgrade" $ \step -> do + let v = versionedStorage + step "Loading test data into 'InMemoryStorage'..." + ims@(localRef, sessionRef) <- inMemoryStorageFromTestData + (_versionedStorage_metaPrefix v) + (Proxy @(V1.StoreFrontend TestPrv)) + 1 + path + step "...test data loaded" + + step "Running versioner upgrade..." + (sn, pm, ns, sf, ks, as) <- flip runInMemoryStorage ims $ do + _versionedStorage_upgradeStorage v logTransactionStdout + sn <- getItemStorage localStorage V2.StoreFrontend_Network_SelectedNetwork + pm <- getItemStorage localStorage V2.StoreFrontend_Network_PublicMeta + ns <- getItemStorage localStorage V2.StoreFrontend_Network_Networks + sf <- getItemStorage localStorage V2.StoreFrontend_ModuleExplorer_SessionFile + ks <- getItemStorage localStorage (V2.StoreFrontend_Wallet_Keys @TestPrv) + as <- getItemStorage localStorage V2.StoreFrontend_Wallet_Accounts + pure (sn, pm, ns, sf, ks, as) + step "...versioner upgrade finished" + + step "Checking version refs match..." + + curV1Seq <- lookupRef localRef "StoreFrontend_Meta_Backups_V1_Latest" + curV1Seq @?= Just "0" + curV <- lookupRef localRef "StoreFrontend_Meta_Version" + curV @?= Just "2" + + let + + step "Checking networks and session file..." + sn @?= Just expectedSelectedNetwork + ns @?= Just expectedNetworks + pm @?= Just expectedPublicMeta + expectedSfText <- decodeFileStrict (path "StoreFrontend_ModuleExplorer_SessionFile") + sf @?= expectedSfText + + step "Checking we have keys from new schema only" + -- Check that we just have the keys from the new schema in the DB plus the backup. + lkeys <- sort . Map.keys <$> readIORef localRef + skeys <- sort . Map.keys <$> readIORef sessionRef + + lkeys @?= + [ "StoreFrontend_Meta_Backups_V1_0" + , "StoreFrontend_Meta_Backups_V1_Latest" + , "StoreFrontend_Meta_Version" + , "StoreFrontend_ModuleExplorer_SessionFile" + , "StoreFrontend_Network_Networks" + , "StoreFrontend_Network_PublicMeta" + , "StoreFrontend_Network_SelectedNetwork" + , "StoreFrontend_Wallet_Accounts" + , "StoreFrontend_Wallet_Keys" + ] + skeys @?= [] + + step "Checking expected keys" + ks @?~ Just expectedKeys + step "Checking expected accounts" + as @?~ Just expectedAccounts + + pure () + + + where + path = "tests" "Frontend" "VersionedStoreSpec.files" "V1" + +test_v0ToV2Upgrade :: TestTree +test_v0ToV2Upgrade = testCaseSteps "V0 to V2 Upgrade" $ \step -> do + let v = versionedStorage step "Loading test data into 'InMemoryStorage'..." ims@(localRef, sessionRef) <- inMemoryStorageFromTestData (_versionedStorage_metaPrefix v) @@ -244,12 +316,12 @@ test_v0ToV1Upgrade = testCaseSteps "V0 to V1 Upgrade" $ \step -> do step "Running versioner upgrade..." (sn, pm, ns, sf, ks, as) <- flip runInMemoryStorage ims $ do _versionedStorage_upgradeStorage v logTransactionStdout - sn <- getItemStorage localStorage V1.StoreFrontend_Network_SelectedNetwork - pm <- getItemStorage localStorage V1.StoreFrontend_Network_PublicMeta - ns <- getItemStorage localStorage V1.StoreFrontend_Network_Networks - sf <- getItemStorage localStorage V1.StoreFrontend_ModuleExplorer_SessionFile - ks <- getItemStorage localStorage (V1.StoreFrontend_Wallet_Keys @TestPrv) - as <- getItemStorage localStorage V1.StoreFrontend_Wallet_Accounts + sn <- getItemStorage localStorage V2.StoreFrontend_Network_SelectedNetwork + pm <- getItemStorage localStorage V2.StoreFrontend_Network_PublicMeta + ns <- getItemStorage localStorage V2.StoreFrontend_Network_Networks + sf <- getItemStorage localStorage V2.StoreFrontend_ModuleExplorer_SessionFile + ks <- getItemStorage localStorage (V2.StoreFrontend_Wallet_Keys @TestPrv) + as <- getItemStorage localStorage V2.StoreFrontend_Wallet_Accounts pure (sn, pm, ns, sf, ks, as) step "...versioner upgrade finished" @@ -257,7 +329,7 @@ test_v0ToV1Upgrade = testCaseSteps "V0 to V1 Upgrade" $ \step -> do curV0Seq <- lookupRef localRef "StoreFrontend_Meta_Backups_V0_Latest" curV0Seq @?= Just "0" curV <- lookupRef localRef "StoreFrontend_Meta_Version" - curV @?= Just "1" + curV @?= Just "2" step "Checking networks and session file..." sn @?= Just expectedSelectedNetwork @@ -274,6 +346,8 @@ test_v0ToV1Upgrade = testCaseSteps "V0 to V1 Upgrade" $ \step -> do lkeys @?= [ "StoreFrontend_Meta_Backups_V0_0" , "StoreFrontend_Meta_Backups_V0_Latest" + , "StoreFrontend_Meta_Backups_V1_0" + , "StoreFrontend_Meta_Backups_V1_Latest" , "StoreFrontend_Meta_Version" , "StoreFrontend_ModuleExplorer_SessionFile" , "StoreFrontend_Network_Networks" @@ -295,5 +369,9 @@ test_v0ToV1Upgrade = testCaseSteps "V0 to V1 Upgrade" $ \step -> do tests :: TestTree tests = testGroup "VersionedStoreSpec" - [ test_v0ToV1Upgrade + [ test_v1ToV2Upgrade ] + + -- [ test_v0ToV2Upgrade + -- , after AllSucceed "test_v0ToV2Upgrade" test_v1ToV2Upgrade + -- ] From 10051b87dfc53e0ee8ddb9d9b07bed7ccabe4a12 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Mon, 7 Jun 2021 21:39:50 -0400 Subject: [PATCH 07/16] actually run both upgrade tests --- frontend/tests/Frontend/VersionedStoreSpec.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/frontend/tests/Frontend/VersionedStoreSpec.hs b/frontend/tests/Frontend/VersionedStoreSpec.hs index 23d1f2569..77f8c9a3f 100644 --- a/frontend/tests/Frontend/VersionedStoreSpec.hs +++ b/frontend/tests/Frontend/VersionedStoreSpec.hs @@ -19,7 +19,7 @@ import Data.Text (Text) import Pact.Types.Util (ParseText, fromText') import Pact.Types.Command (RequestKey(..)) import Pact.Types.ChainMeta (PublicMeta (..)) -import Test.Tasty (DependencyType(..), TestTree, after, testGroup) +import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit import Text.URI (Authority(Authority)) import Text.URI.QQ (host) @@ -369,9 +369,6 @@ test_v0ToV2Upgrade = testCaseSteps "V0 to V2 Upgrade" $ \step -> do tests :: TestTree tests = testGroup "VersionedStoreSpec" - [ test_v1ToV2Upgrade + [ test_v0ToV2Upgrade + , test_v1ToV2Upgrade ] - - -- [ test_v0ToV2Upgrade - -- , after AllSucceed "test_v0ToV2Upgrade" test_v1ToV2Upgrade - -- ] From 40ced78dbc1f3895f3cb3a378e3f8e7f7f29613e Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Tue, 8 Jun 2021 16:59:15 -0400 Subject: [PATCH 08/16] mocking new test cases these new test cases will investigate how chainweaver recovers from a migration that fails at some point before completion. --- frontend/src/Frontend/Storage/Class.hs | 2 + .../tests/Frontend/Storage/InMemoryStorage.hs | 40 ++++++++++++++++++- .../Frontend/Storage/InMemoryStorageSpec.hs | 4 +- frontend/tests/Frontend/VersionedStoreSpec.hs | 8 ++++ 4 files changed, 50 insertions(+), 4 deletions(-) diff --git a/frontend/src/Frontend/Storage/Class.hs b/frontend/src/Frontend/Storage/Class.hs index 0c9fdb5fa..cfe3cee8d 100644 --- a/frontend/src/Frontend/Storage/Class.hs +++ b/frontend/src/Frontend/Storage/Class.hs @@ -169,6 +169,7 @@ restoreLocalStorage :: forall storeKeys m . ( HasStorage m , Monad m + , MonadIO m , GCompare storeKeys , Has' FromJSON storeKeys Identity , Has ToJSON storeKeys @@ -211,6 +212,7 @@ restoreLocalStorageDump :: forall storeKeys m . ( HasStorage m , Monad m + , MonadIO m , Has ToJSON storeKeys , GShow storeKeys ) diff --git a/frontend/tests/Frontend/Storage/InMemoryStorage.hs b/frontend/tests/Frontend/Storage/InMemoryStorage.hs index d282997eb..b09b6c181 100644 --- a/frontend/tests/Frontend/Storage/InMemoryStorage.hs +++ b/frontend/tests/Frontend/Storage/InMemoryStorage.hs @@ -1,13 +1,18 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeApplications #-} module Frontend.Storage.InMemoryStorage where +import Text.Printf +import Data.Text as T (unpack) +import qualified Data.Text.Encoding as T import Control.Monad.Free (iterM) import Control.Monad.Reader import Data.Aeson (FromJSON, ToJSON, eitherDecode) +import Data.Aeson as Aeson (encode) import Data.Bool (bool) import qualified Data.ByteString.Lazy as LBS import Data.Constraint.Extras (Has, Has', has) @@ -31,7 +36,9 @@ import System.Directory (doesFileExist) import System.FilePath (()) import Frontend.Crypto.Class +import Frontend.Foundation import Frontend.Storage +import Frontend.Storage.Class lookupRef :: IORef (Map Text Text) -> Text -> IO (Maybe Text) lookupRef ref k = Map.lookup k <$> readIORef ref @@ -79,6 +86,14 @@ newInMemoryStorage = do sessionRef <- newIORef (Map.empty :: Map Text Text) pure (localRef, sessionRef) +data AtOrBefore a = At a | Before a + +data FailStorageState where + FailOnWriteSingleKey :: AtOrBefore k -> FailStorageState + FailOnWriteKeys :: [AtOrBefore k] -> FailStorageState + FailOnSettingVersion :: AtOrBefore () -> FailStorageState + NoFailure :: FailStorageState + -- This function *should* be cool because it ought to allow us to drop in a desktop storage directory -- into the folder for a given version and then source those files into the inmem store for the tests -- @@ -98,13 +113,34 @@ inMemoryStorageFromTestData -> Proxy k -> Natural -> FilePath + -> FailStorageState -> IO IMS -inMemoryStorageFromTestData p _ ver dirPath = do +inMemoryStorageFromTestData p _ ver dirPath failure = do dmap <- keyUniverseToFilesDMap ims <- newInMemoryStorage - _ <- runInMemoryStorage (restoreLocalStorageDump p dmap ver) ims + -- _ <- runInMemoryStorage (restoreLocalStorageDump p dmap ver) ims + _ <- runInMemoryStorage (mockRestoreLocalStorageDump p dmap ver) ims pure ims where + + mockRestoreLocalStorageDump p dump ver = + case failure of + NoFailure -> do + for_ (DMap.toList dump) setSum + setCurrentVersion p ver + FailOnWriteSingleKey _ -> undefined + FailOnWriteKeys _ -> undefined + FailOnSettingVersion _ -> undefined + where + {- the three helpers below are added so as to not increase the number of + functions exported from Frontend.Storage.Class -} + encodeText = T.decodeUtf8 . LBS.toStrict . Aeson.encode + currentVersionKeyText :: StoreKeyMetaPrefix -> Text + currentVersionKeyText (StoreKeyMetaPrefix p) = (p <> "_Version") + setCurrentVersion p' = setItemStorage' localStorage (currentVersionKeyText p') . encodeText + setSum (k :=> ( Identity v )) = + has @ToJSON k $ setItemStorage localStorage k v + keyToPath :: k a -> FilePath keyToPath k = dirPath gshow k diff --git a/frontend/tests/Frontend/Storage/InMemoryStorageSpec.hs b/frontend/tests/Frontend/Storage/InMemoryStorageSpec.hs index fe712e4c6..ce2eaddba 100644 --- a/frontend/tests/Frontend/Storage/InMemoryStorageSpec.hs +++ b/frontend/tests/Frontend/Storage/InMemoryStorageSpec.hs @@ -31,7 +31,7 @@ test_inMemoryStorage = testCase "In Memory Storage" $ do test_inMemoryStorageFromTestData :: TestTree test_inMemoryStorageFromTestDataEmptyDir = testCase "In Memory storage from /var/empty" $ do - ims <- inMemoryStorageFromTestData storeTestKeyMetaPrefix (Proxy @StoreTestKey) 0 "/var/empty/" + ims <- inMemoryStorageFromTestData storeTestKeyMetaPrefix (Proxy @StoreTestKey) 0 "/var/empty/" NoFailure (mInt, mStr) <- flip runInMemoryStorage ims $ do mInt <- getItemStorage localStorage StoreInt mStr <- getItemStorage localStorage StoreString @@ -41,7 +41,7 @@ test_inMemoryStorageFromTestDataEmptyDir = testCase "In Memory storage from /var mInt @?= Nothing test_inMemoryStorageFromTestData = testCase ("In Memory Storage from " <> testDataPath) $ do - ims <- inMemoryStorageFromTestData storeTestKeyMetaPrefix (Proxy @StoreTestKey) 0 testDataPath + ims <- inMemoryStorageFromTestData storeTestKeyMetaPrefix (Proxy @StoreTestKey) 0 testDataPath NoFailure (mInt, mStr) <- flip runInMemoryStorage ims $ do mInt <- getItemStorage localStorage StoreInt mStr <- getItemStorage localStorage StoreString diff --git a/frontend/tests/Frontend/VersionedStoreSpec.hs b/frontend/tests/Frontend/VersionedStoreSpec.hs index 77f8c9a3f..f2a5835f8 100644 --- a/frontend/tests/Frontend/VersionedStoreSpec.hs +++ b/frontend/tests/Frontend/VersionedStoreSpec.hs @@ -243,6 +243,7 @@ test_v1ToV2Upgrade = testCaseSteps "V1 to V2 upgrade" $ \step -> do (Proxy @(V1.StoreFrontend TestPrv)) 1 path + NoFailure step "...test data loaded" step "Running versioner upgrade..." @@ -311,6 +312,7 @@ test_v0ToV2Upgrade = testCaseSteps "V0 to V2 Upgrade" $ \step -> do (Proxy @(V0.StoreFrontend TestPrv)) 0 path + NoFailure step "...test data loaded" step "Running versioner upgrade..." @@ -367,6 +369,12 @@ test_v0ToV2Upgrade = testCaseSteps "V0 to V2 Upgrade" $ \step -> do where path = "tests" "Frontend" "VersionedStoreSpec.files" "V0" +_fail_test_v0ToV2Upgrade :: FailStorageState -> TestTree +_fail_test_v0ToV2Upgrade _fstate = testCaseSteps "(failing) V0 to V2 upgrade" $ \step -> do + undefined + + + tests :: TestTree tests = testGroup "VersionedStoreSpec" [ test_v0ToV2Upgrade From 1b59cc9cc1e69488b75145ad270768c2aa2c1ec8 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Tue, 8 Jun 2021 17:02:12 -0400 Subject: [PATCH 09/16] add OverloadedStrings pragma --- frontend/tests/Frontend/Storage/InMemoryStorage.hs | 1 + 1 file changed, 1 insertion(+) diff --git a/frontend/tests/Frontend/Storage/InMemoryStorage.hs b/frontend/tests/Frontend/Storage/InMemoryStorage.hs index b09b6c181..980880e41 100644 --- a/frontend/tests/Frontend/Storage/InMemoryStorage.hs +++ b/frontend/tests/Frontend/Storage/InMemoryStorage.hs @@ -1,5 +1,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} From 17588f24b0a612b1efb4521bc245197031df0b03 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Wed, 9 Jun 2021 16:17:26 -0400 Subject: [PATCH 10/16] finished previously mocked tests (last commit) --- .../tests/Frontend/Storage/InMemoryStorage.hs | 49 +++-- frontend/tests/Frontend/VersionedStoreSpec.hs | 174 +++++++++++++++++- 2 files changed, 203 insertions(+), 20 deletions(-) diff --git a/frontend/tests/Frontend/Storage/InMemoryStorage.hs b/frontend/tests/Frontend/Storage/InMemoryStorage.hs index 980880e41..3f4282ca1 100644 --- a/frontend/tests/Frontend/Storage/InMemoryStorage.hs +++ b/frontend/tests/Frontend/Storage/InMemoryStorage.hs @@ -2,13 +2,12 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} -{-# LANGUAGE GADTs #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE TypeApplications #-} module Frontend.Storage.InMemoryStorage where import Text.Printf -import Data.Text as T (unpack) +import Data.Text as T (pack, unpack) import qualified Data.Text.Encoding as T import Control.Monad.Free (iterM) import Control.Monad.Reader @@ -34,6 +33,7 @@ import Data.Text (Text) import Data.Universe.Some (UniverseSome, universeSome) import Numeric.Natural (Natural) import System.Directory (doesFileExist) +import System.Exit (die) import System.FilePath (()) import Frontend.Crypto.Class @@ -87,13 +87,31 @@ newInMemoryStorage = do sessionRef <- newIORef (Map.empty :: Map Text Text) pure (localRef, sessionRef) -data AtOrBefore a = At a | Before a - -data FailStorageState where - FailOnWriteSingleKey :: AtOrBefore k -> FailStorageState - FailOnWriteKeys :: [AtOrBefore k] -> FailStorageState - FailOnSettingVersion :: AtOrBefore () -> FailStorageState - NoFailure :: FailStorageState +data FailStorageState = + FailOnKeyWrite Text Bool + | FailOnSettingVersion Bool + | NoFailure + + +instance Show FailStorageState where + show = \case + FailOnKeyWrite text before -> + if before + then "Failing just before loading key " ++ T.unpack text + else "Failing just after loading key " ++ T.unpack text + FailOnSettingVersion before -> + if before + then "Failing just before setting version" + else "Failing just after setting version" + NoFailure -> "Not exercising failure state" + +wrapFail :: MonadIO m => Bool -> m a -> m a +wrapFail False action = do + liftIO (die "") -- there is surely a better way to do this + action +wrapFail True action = do + action + liftIO (die "") -- there is surely a better way to do this -- This function *should* be cool because it ought to allow us to drop in a desktop storage directory -- into the folder for a given version and then source those files into the inmem store for the tests @@ -127,11 +145,16 @@ inMemoryStorageFromTestData p _ ver dirPath failure = do mockRestoreLocalStorageDump p dump ver = case failure of NoFailure -> do - for_ (DMap.toList dump) setSum + for_ (DMap.toList dump) $ \key@(k :=> _) -> do + setSum key setCurrentVersion p ver - FailOnWriteSingleKey _ -> undefined - FailOnWriteKeys _ -> undefined - FailOnSettingVersion _ -> undefined + FailOnKeyWrite keyText at -> do + for_ (DMap.toList dump) $ \key@(k :=> _) -> do + if T.pack (gshow k) == keyText then wrapFail at (setSum key) else setSum key + setCurrentVersion p ver + FailOnSettingVersion at -> do + for_ (DMap.toList dump) setSum + wrapFail at (setCurrentVersion p ver) where {- the three helpers below are added so as to not increase the number of functions exported from Frontend.Storage.Class -} diff --git a/frontend/tests/Frontend/VersionedStoreSpec.hs b/frontend/tests/Frontend/VersionedStoreSpec.hs index f2a5835f8..74c405953 100644 --- a/frontend/tests/Frontend/VersionedStoreSpec.hs +++ b/frontend/tests/Frontend/VersionedStoreSpec.hs @@ -2,13 +2,16 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeSynonymInstances #-} module Frontend.VersionedStoreSpec where import Control.Monad.IO.Class (MonadIO, liftIO) +import Control.Exception import Data.Aeson (decodeFileStrict) import qualified Data.IntMap as IntMap +import Data.Functor ((<&>)) import Data.IORef (readIORef) import Data.List (sort) import Data.Map (Map) @@ -23,8 +26,10 @@ import Test.Tasty (TestTree, testGroup) import Test.Tasty.HUnit import Text.URI (Authority(Authority)) import Text.URI.QQ (host) +import Numeric.Natural (Natural) import Obelisk.OAuth.Common (AccessToken, OAuthState) import System.FilePath (()) +import Text.Printf (printf) import TestUtils ((@?~)) import Common.Wallet @@ -369,14 +374,169 @@ test_v0ToV2Upgrade = testCaseSteps "V0 to V2 Upgrade" $ \step -> do where path = "tests" "Frontend" "VersionedStoreSpec.files" "V0" -_fail_test_v0ToV2Upgrade :: FailStorageState -> TestTree -_fail_test_v0ToV2Upgrade _fstate = testCaseSteps "(failing) V0 to V2 upgrade" $ \step -> do - undefined +fail_test_v0ToV2Upgrade :: FailStorageState -> TestTree +fail_test_v0ToV2Upgrade fstate = testCaseSteps "(failing) V0 to V2 upgrade" $ \step -> do + let v = versionedStorage + step "Loading test data into 'InMemoryStorage'..." + ims@(localRef, sessionRef) <- inMemoryStorageFromTestData + (_versionedStorage_metaPrefix v) + (Proxy @(V0.StoreFrontend TestPrv)) + 0 + path + fstate + `catch` + \(_ :: SomeException) -> do + step $ printf "reloading storage after reason: %s" (show fstate) + inMemoryStorageFromTestData (_versionedStorage_metaPrefix v) (Proxy @(V0.StoreFrontend TestPrv)) 0 path NoFailure + step "...test data loaded" + + step "Running versioner upgrade..." + (sn, pm, ns, sf, ks, as) <- flip runInMemoryStorage ims $ do + _versionedStorage_upgradeStorage v logTransactionStdout + sn <- getItemStorage localStorage V2.StoreFrontend_Network_SelectedNetwork + pm <- getItemStorage localStorage V2.StoreFrontend_Network_PublicMeta + ns <- getItemStorage localStorage V2.StoreFrontend_Network_Networks + sf <- getItemStorage localStorage V2.StoreFrontend_ModuleExplorer_SessionFile + ks <- getItemStorage localStorage (V2.StoreFrontend_Wallet_Keys @TestPrv) + as <- getItemStorage localStorage V2.StoreFrontend_Wallet_Accounts + pure (sn, pm, ns, sf, ks, as) + step "...versioner upgrade finished" + + step "Checking version refs match..." + curV0Seq <- lookupRef localRef "StoreFrontend_Meta_Backups_V0_Latest" + curV0Seq @?= Just "0" + curV <- lookupRef localRef "StoreFrontend_Meta_Version" + curV @?= Just "2" + + step "Checking networks and session file..." + sn @?= Just expectedSelectedNetwork + ns @?= Just expectedNetworks + pm @?= Nothing + expectedSfText <- decodeFileStrict (path "StoreModuleExplorer_SessionFile") + sf @?= expectedSfText + + step "Checking we have keys from new schema only" + -- Check that we just have the keys from the new schema in the DB plus the backup. + lkeys <- sort . Map.keys <$> readIORef localRef + skeys <- sort . Map.keys <$> readIORef sessionRef + + lkeys @?= + [ "StoreFrontend_Meta_Backups_V0_0" + , "StoreFrontend_Meta_Backups_V0_Latest" + , "StoreFrontend_Meta_Backups_V1_0" + , "StoreFrontend_Meta_Backups_V1_Latest" + , "StoreFrontend_Meta_Version" + , "StoreFrontend_ModuleExplorer_SessionFile" + , "StoreFrontend_Network_Networks" + , "StoreFrontend_Network_SelectedNetwork" + , "StoreFrontend_Wallet_Accounts" + , "StoreFrontend_Wallet_Keys" + ] + skeys @?= [] + + step "Checking expected keys" + ks @?~ Just expectedKeys + step "Checking expected accounts" + as @?~ Just expectedAccounts + + pure () + + where + path = "tests" "Frontend" "VersionedStoreSpec.files" "V0" + +fail_test_v1ToV2Upgrade :: FailStorageState -> TestTree +fail_test_v1ToV2Upgrade fstate = testCaseSteps "(failing) V1 to V2 upgrade" $ \step -> do + + let v = versionedStorage + step "Loading test data into 'InMemoryStorage'..." + ims@(localRef, sessionRef) <- inMemoryStorageFromTestData + (_versionedStorage_metaPrefix v) + (Proxy @(V1.StoreFrontend TestPrv)) + 1 + path + fstate + `catch` + \(_ :: SomeException) -> do + step $ printf "reloading storage after reason: %s" (show fstate) + inMemoryStorageFromTestData (_versionedStorage_metaPrefix v) (Proxy @(V1.StoreFrontend TestPrv)) 1 path NoFailure + + step "...test data loaded" + + step "Running versioner upgrade..." + (sn, pm, ns, sf, ks, as) <- flip runInMemoryStorage ims $ do + _versionedStorage_upgradeStorage v logTransactionStdout + sn <- getItemStorage localStorage V2.StoreFrontend_Network_SelectedNetwork + pm <- getItemStorage localStorage V2.StoreFrontend_Network_PublicMeta + ns <- getItemStorage localStorage V2.StoreFrontend_Network_Networks + sf <- getItemStorage localStorage V2.StoreFrontend_ModuleExplorer_SessionFile + ks <- getItemStorage localStorage (V2.StoreFrontend_Wallet_Keys @TestPrv) + as <- getItemStorage localStorage V2.StoreFrontend_Wallet_Accounts + pure (sn, pm, ns, sf, ks, as) + step "...versioner upgrade finished" + + step "Checking version refs match..." + curV1Seq <- lookupRef localRef "StoreFrontend_Meta_Backups_V1_Latest" + curV1Seq @?= Just "0" + curV <- lookupRef localRef "StoreFrontend_Meta_Version" + curV @?= Just "2" + + step "Checking networks and session file..." + sn @?= Just expectedSelectedNetwork + ns @?= Just expectedNetworks + pm @?= Just expectedPublicMeta + expectedSfText <- decodeFileStrict (path "StoreFrontend_ModuleExplorer_SessionFile") + sf @?= expectedSfText + + step "Checking we have keys from new schema only" + -- Check that we just have the keys from the new schema in the DB plus the backup. + lkeys <- sort . Map.keys <$> readIORef localRef + skeys <- sort . Map.keys <$> readIORef sessionRef + + lkeys @?= + [ "StoreFrontend_Meta_Backups_V1_0" + , "StoreFrontend_Meta_Backups_V1_Latest" + , "StoreFrontend_Meta_Version" + , "StoreFrontend_ModuleExplorer_SessionFile" + , "StoreFrontend_Network_Networks" + , "StoreFrontend_Network_PublicMeta" + , "StoreFrontend_Network_SelectedNetwork" + , "StoreFrontend_Wallet_Accounts" + , "StoreFrontend_Wallet_Keys" + ] + skeys @?= [] + + step "Checking expected keys" + ks @?~ Just expectedKeys + step "Checking expected accounts" + as @?~ Just expectedAccounts + + pure () + + where + path = "tests" "Frontend" "VersionedStoreSpec.files" "V1" tests :: TestTree -tests = testGroup "VersionedStoreSpec" - [ test_v0ToV2Upgrade - , test_v1ToV2Upgrade - ] +tests = testGroup "VersionedStoreSpec" $ + [ test_v0ToV2Upgrade + , test_v1ToV2Upgrade + ] + ++ (fail_test_v0ToV2Upgrade <$> (FailOnKeyWrite <$> ks0 <*> [False, True])) + ++ (fail_test_v1ToV2Upgrade <$> (FailOnKeyWrite <$> ks1 <*> [False, True])) + + where + ks0 = [ + "StoreNetwork_SelectedNetwork" + , "StoreNetwork_Networks" + , "StoreModuleExplorer_SessionFile" + , "StoreWallet_Keys" + ] + ks1 = [ + "StoreNetwork_Network_SelectedNetwork" + , "StoreNetwork_Network_PublicMeta" + , "StoreNetwork_Network_Networks" + , "StoreNetwork_ModuleExplorer_SessionFile" + , "StoreNetwork_Wallet_Keys" + , "StoreNetwork_Wallet_Accounts" + ] From 1594e250d844a4fc7753c3064d8af3412a9d430d Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Thu, 10 Jun 2021 14:50:04 -0400 Subject: [PATCH 11/16] take out unnecessary MonadIO constraints --- frontend/src/Frontend/Storage/Class.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/frontend/src/Frontend/Storage/Class.hs b/frontend/src/Frontend/Storage/Class.hs index cfe3cee8d..0c9fdb5fa 100644 --- a/frontend/src/Frontend/Storage/Class.hs +++ b/frontend/src/Frontend/Storage/Class.hs @@ -169,7 +169,6 @@ restoreLocalStorage :: forall storeKeys m . ( HasStorage m , Monad m - , MonadIO m , GCompare storeKeys , Has' FromJSON storeKeys Identity , Has ToJSON storeKeys @@ -212,7 +211,6 @@ restoreLocalStorageDump :: forall storeKeys m . ( HasStorage m , Monad m - , MonadIO m , Has ToJSON storeKeys , GShow storeKeys ) From a5c3e57bce3d47e538cabe0bc6cf36ba5546180a Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Thu, 10 Jun 2021 18:49:35 -0400 Subject: [PATCH 12/16] unconditionally alter refs for networks in local storage In essence, we don't care what networks the user has either created, modified or left alone, we filter out undesired noderefs in that network name. --- frontend/src/Frontend/VersionedStore/V2.hs | 26 ++++++++++++------- frontend/tests/Frontend/VersionedStoreSpec.hs | 9 ++++--- 2 files changed, 21 insertions(+), 14 deletions(-) diff --git a/frontend/src/Frontend/VersionedStore/V2.hs b/frontend/src/Frontend/VersionedStore/V2.hs index b86bba11b..6a1200050 100644 --- a/frontend/src/Frontend/VersionedStore/V2.hs +++ b/frontend/src/Frontend/VersionedStore/V2.hs @@ -1,5 +1,6 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeApplications #-} {-# LANGUAGE ViewPatterns #-} module Frontend.VersionedStore.V2 where @@ -10,14 +11,16 @@ import Data.Constraint.Extras import Data.Dependent.Map (DMap) import Data.Dependent.Sum (DSum(..)) import qualified Data.Dependent.Map as DMap -import Data.Function (on) +import Data.Function ((&), on) import Data.Functor ((<&>)) import Data.Functor.Identity (Identity(Identity), runIdentity) import qualified Data.IntMap as IntMap import Data.Map (Map) import qualified Data.Map as Map +import qualified Data.Map.Merge.Lazy as Map import Data.Maybe (catMaybes) import Data.Text (Text) +import Data.These import Text.Printf (printf) import Common.Foundation @@ -141,7 +144,7 @@ upgradeFromV1 v1 = <&> \nets -> StoreFrontend_Network_Networks :=> convertNodeRefs <$> nets toMultiSet :: Ord a => [a] -> Map a Int -toMultiSet = Map.fromList . flip zip (repeat 1) +toMultiSet = Map.fromListWith (+) . flip zip (repeat 1) fromMultiSet :: Ord a => Map a Int -> [a] fromMultiSet = ($ []) . Map.foldrWithKey (\k i -> (.) (dlrep k i)) id @@ -152,16 +155,19 @@ fromMultiSet = ($ []) . Map.foldrWithKey (\k i -> (.) (dlrep k i)) id | otherwise = (v:) . dlrep v (n - 1) convertNodeRefs :: Map NetworkName [NodeRef] -> Map NetworkName [NodeRef] -convertNodeRefs = Map.mapWithKey migrate +convertNodeRefs = fmap migrate where - migrate = \case - "Mainnet" -> replaceMainnetNodeRefs - "Testnet" -> replaceTestnetNodeRefs - _ -> id + migrate = replaceRefsWith "api.chainweb.com" mainnetNodeRefs . replaceRefsWith "api.testnet.chainweb.com" testnetNodeRefs where - replaceTestnetNodeRefs = addRef "api.testnet.chainweb.com" . fromMultiSet . on (flip Map.difference) toMultiSet testnetNodeRefs - replaceMainnetNodeRefs = addRef "api.chainweb.com" . fromMultiSet . on (flip Map.difference) toMultiSet mainnetNodeRefs - addRef (unsafeParseNodeRef -> ref) refs = if elem ref refs then refs else ref : refs + replaceRefsWith ref baseRefs refs = + refs + & on (Map.mergeA @(These ()) Map.dropMissing Map.preserveMissing (Map.zipWithMaybeAMatched (\_ _ _ -> pure Nothing))) toMultiSet baseRefs + & \case + This () -> error "IMPOSSIBLE" + That m -> if null m then addRef ref m else m + These () m -> addRef ref m + & fromMultiSet + addRef (unsafeParseNodeRef -> ref) = Map.insert ref 1 testnetNodeRefs = unsafeParseNodeRef <$> [ "us1.testnet.chainweb.com" , "us2.testnet.chainweb.com" diff --git a/frontend/tests/Frontend/VersionedStoreSpec.hs b/frontend/tests/Frontend/VersionedStoreSpec.hs index 74c405953..ade333201 100644 --- a/frontend/tests/Frontend/VersionedStoreSpec.hs +++ b/frontend/tests/Frontend/VersionedStoreSpec.hs @@ -16,6 +16,7 @@ import Data.IORef (readIORef) import Data.List (sort) import Data.Map (Map) import qualified Data.Map as Map +import qualified Data.Set as S import Data.Maybe (fromJust, fromMaybe) import Data.Proxy (Proxy(Proxy)) import Data.Text (Text) @@ -274,7 +275,7 @@ test_v1ToV2Upgrade = testCaseSteps "V1 to V2 upgrade" $ \step -> do step "Checking networks and session file..." sn @?= Just expectedSelectedNetwork - ns @?= Just expectedNetworks + (fmap (S.fromList <$>) ns) @?= Just (S.fromList <$> expectedNetworks) pm @?= Just expectedPublicMeta expectedSfText <- decodeFileStrict (path "StoreFrontend_ModuleExplorer_SessionFile") sf @?= expectedSfText @@ -340,7 +341,7 @@ test_v0ToV2Upgrade = testCaseSteps "V0 to V2 Upgrade" $ \step -> do step "Checking networks and session file..." sn @?= Just expectedSelectedNetwork - ns @?= Just expectedNetworks + (fmap (S.fromList <$>) ns) @?= Just (S.fromList <$> expectedNetworks) pm @?= Nothing expectedSfText <- decodeFileStrict (path "StoreModuleExplorer_SessionFile") sf @?= expectedSfText @@ -412,7 +413,7 @@ fail_test_v0ToV2Upgrade fstate = testCaseSteps "(failing) V0 to V2 upgrade" $ \s step "Checking networks and session file..." sn @?= Just expectedSelectedNetwork - ns @?= Just expectedNetworks + (fmap (S.fromList <$>) ns) @?= Just (S.fromList <$> expectedNetworks) pm @?= Nothing expectedSfText <- decodeFileStrict (path "StoreModuleExplorer_SessionFile") sf @?= expectedSfText @@ -484,7 +485,7 @@ fail_test_v1ToV2Upgrade fstate = testCaseSteps "(failing) V1 to V2 upgrade" $ \s step "Checking networks and session file..." sn @?= Just expectedSelectedNetwork - ns @?= Just expectedNetworks + (fmap (S.fromList <$>) ns) @?= Just (S.fromList <$> expectedNetworks) pm @?= Just expectedPublicMeta expectedSfText <- decodeFileStrict (path "StoreFrontend_ModuleExplorer_SessionFile") sf @?= expectedSfText From 712eb9d2076484a7cc4944c6fc102b75ff643abb Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Fri, 11 Jun 2021 02:12:12 -0400 Subject: [PATCH 13/16] create simplified version of "These" (Cheese) It is equivalent to "These" except that we take out the "This" constructor. With it gone, we still get the same applicative operations from "These" (sans "This") but we don't have to account for the "This" constructor in situations where we know it is impossible to produce it. --- frontend/src/Frontend/Network.hs | 2 +- frontend/src/Frontend/VersionedStore/V2.hs | 21 ++++++++++++++++----- 2 files changed, 17 insertions(+), 6 deletions(-) diff --git a/frontend/src/Frontend/Network.hs b/frontend/src/Frontend/Network.hs index bacc2e0b8..c8b9b8a80 100644 --- a/frontend/src/Frontend/Network.hs +++ b/frontend/src/Frontend/Network.hs @@ -142,7 +142,7 @@ import Frontend.Foundation import Frontend.Messages import Frontend.Network.NodeInfo import Frontend.Storage -import Frontend.VersionedStore +import Frontend.VersionedStore hiding (Cheese(..)) import Frontend.Log diff --git a/frontend/src/Frontend/VersionedStore/V2.hs b/frontend/src/Frontend/VersionedStore/V2.hs index 6a1200050..c43b9ddea 100644 --- a/frontend/src/Frontend/VersionedStore/V2.hs +++ b/frontend/src/Frontend/VersionedStore/V2.hs @@ -20,7 +20,6 @@ import qualified Data.Map as Map import qualified Data.Map.Merge.Lazy as Map import Data.Maybe (catMaybes) import Data.Text (Text) -import Data.These import Text.Printf (printf) import Common.Foundation @@ -154,6 +153,19 @@ fromMultiSet = ($ []) . Map.foldrWithKey (\k i -> (.) (dlrep k i)) id | n == 0 = id | otherwise = (v:) . dlrep v (n - 1) +data Cheese a b = That b | These a b + +instance Functor (Cheese a) where + fmap f (That b) = That (f b) + fmap f (These a b) = These a (f b) + +instance (Semigroup a) => Applicative (Cheese a) where + pure = That + That f <*> That x = That (f x) + That f <*> These b x = These b (f x) + These a f <*> That x = These a (f x) + These a f <*> These b x = These (a <> b) (f x) + convertNodeRefs :: Map NetworkName [NodeRef] -> Map NetworkName [NodeRef] convertNodeRefs = fmap migrate where @@ -161,11 +173,10 @@ convertNodeRefs = fmap migrate where replaceRefsWith ref baseRefs refs = refs - & on (Map.mergeA @(These ()) Map.dropMissing Map.preserveMissing (Map.zipWithMaybeAMatched (\_ _ _ -> pure Nothing))) toMultiSet baseRefs + & on (Map.mergeA Map.dropMissing Map.preserveMissing (Map.zipWithMaybeAMatched (\_ _ _ -> These () Nothing))) toMultiSet baseRefs & \case - This () -> error "IMPOSSIBLE" - That m -> if null m then addRef ref m else m - These () m -> addRef ref m + That m -> m + These () m -> addRef ref m -- if we hit this case, there were matching keys & fromMultiSet addRef (unsafeParseNodeRef -> ref) = Map.insert ref 1 testnetNodeRefs = unsafeParseNodeRef <$> From 5167b87f3c5971268bc6a71fc9240e62403440cd Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Fri, 11 Jun 2021 10:34:38 -0400 Subject: [PATCH 14/16] Use an even simpler datatype for processing the map merge The datatype we really want is something equivalent to Either () a but with a different Applicative instance. --- frontend/src/Frontend/Network.hs | 2 +- frontend/src/Frontend/VersionedStore/V2.hs | 47 ++++++++++++---------- 2 files changed, 27 insertions(+), 22 deletions(-) diff --git a/frontend/src/Frontend/Network.hs b/frontend/src/Frontend/Network.hs index c8b9b8a80..bacc2e0b8 100644 --- a/frontend/src/Frontend/Network.hs +++ b/frontend/src/Frontend/Network.hs @@ -142,7 +142,7 @@ import Frontend.Foundation import Frontend.Messages import Frontend.Network.NodeInfo import Frontend.Storage -import Frontend.VersionedStore hiding (Cheese(..)) +import Frontend.VersionedStore import Frontend.Log diff --git a/frontend/src/Frontend/VersionedStore/V2.hs b/frontend/src/Frontend/VersionedStore/V2.hs index c43b9ddea..7614f5380 100644 --- a/frontend/src/Frontend/VersionedStore/V2.hs +++ b/frontend/src/Frontend/VersionedStore/V2.hs @@ -153,32 +153,37 @@ fromMultiSet = ($ []) . Map.foldrWithKey (\k i -> (.) (dlrep k i)) id | n == 0 = id | otherwise = (v:) . dlrep v (n - 1) -data Cheese a b = That b | These a b - -instance Functor (Cheese a) where - fmap f (That b) = That (f b) - fmap f (These a b) = These a (f b) - -instance (Semigroup a) => Applicative (Cheese a) where - pure = That - That f <*> That x = That (f x) - That f <*> These b x = These b (f x) - These a f <*> That x = These a (f x) - These a f <*> These b x = These (a <> b) (f x) +-- It is equivalent to "These () a" except that we take out the +-- "This" constructor. With it gone, we still get the same applicative +-- operations from "These" (sans "This") but we don't have to account for +-- the "This" constructor in situations where we know it is impossible to +-- produce it. This is also morally equivalent to Either () b with a +-- different applicative instance +data Deez b = Dis b | Dat b + +instance Functor Deez where + fmap f (Dis b) = Dis (f b) + fmap f (Dat b) = Dat (f b) + +instance Applicative Deez where + pure = Dis + Dis f <*> Dis x = Dis (f x) + Dis f <*> Dat x = Dat (f x) + Dat f <*> Dis x = Dat (f x) + Dat f <*> Dat x = Dat (f x) convertNodeRefs :: Map NetworkName [NodeRef] -> Map NetworkName [NodeRef] convertNodeRefs = fmap migrate where migrate = replaceRefsWith "api.chainweb.com" mainnetNodeRefs . replaceRefsWith "api.testnet.chainweb.com" testnetNodeRefs - where - replaceRefsWith ref baseRefs refs = - refs - & on (Map.mergeA Map.dropMissing Map.preserveMissing (Map.zipWithMaybeAMatched (\_ _ _ -> These () Nothing))) toMultiSet baseRefs - & \case - That m -> m - These () m -> addRef ref m -- if we hit this case, there were matching keys - & fromMultiSet - addRef (unsafeParseNodeRef -> ref) = Map.insert ref 1 + replaceRefsWith ref baseRefs refs = + refs + & on (Map.mergeA Map.dropMissing Map.preserveMissing (Map.zipWithMaybeAMatched (\_ _ _ -> Dat Nothing))) toMultiSet baseRefs + & \case + Dis m -> m + Dat m -> addRef ref m -- if we hit this case, there were matching keys + & fromMultiSet + addRef (unsafeParseNodeRef -> ref) = Map.insert ref 1 testnetNodeRefs = unsafeParseNodeRef <$> [ "us1.testnet.chainweb.com" , "us2.testnet.chainweb.com" From e5d7d24656182cefb5a251f7ffbd88a7c98ffe67 Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Fri, 11 Jun 2021 13:04:18 -0400 Subject: [PATCH 15/16] another simple refactor make "Deez" a newtype --- frontend/src/Frontend/VersionedStore/V2.hs | 25 +++++++++++----------- 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/frontend/src/Frontend/VersionedStore/V2.hs b/frontend/src/Frontend/VersionedStore/V2.hs index 7614f5380..1ebd6bbdb 100644 --- a/frontend/src/Frontend/VersionedStore/V2.hs +++ b/frontend/src/Frontend/VersionedStore/V2.hs @@ -157,20 +157,20 @@ fromMultiSet = ($ []) . Map.foldrWithKey (\k i -> (.) (dlrep k i)) id -- "This" constructor. With it gone, we still get the same applicative -- operations from "These" (sans "This") but we don't have to account for -- the "This" constructor in situations where we know it is impossible to --- produce it. This is also morally equivalent to Either () b with a +-- produce it. This is also morally equivalent to Either a a with a -- different applicative instance -data Deez b = Dis b | Dat b +newtype Deez a = Deez {getDeez :: Either a a} instance Functor Deez where - fmap f (Dis b) = Dis (f b) - fmap f (Dat b) = Dat (f b) + fmap f (Deez (Right a)) = Deez (Right $ f a) + fmap f (Deez (Left a)) = Deez (Left $ f a) instance Applicative Deez where - pure = Dis - Dis f <*> Dis x = Dis (f x) - Dis f <*> Dat x = Dat (f x) - Dat f <*> Dis x = Dat (f x) - Dat f <*> Dat x = Dat (f x) + pure = Deez . Right + Deez (Right f) <*> Deez (Right x) = Deez (Right $ f x) + Deez (Right f) <*> Deez (Left x) = Deez (Left $ f x) + Deez (Left f) <*> Deez (Right x) = Deez (Left $ f x) + Deez (Left f) <*> Deez (Left x) = Deez (Left $ f x) convertNodeRefs :: Map NetworkName [NodeRef] -> Map NetworkName [NodeRef] convertNodeRefs = fmap migrate @@ -178,10 +178,11 @@ convertNodeRefs = fmap migrate migrate = replaceRefsWith "api.chainweb.com" mainnetNodeRefs . replaceRefsWith "api.testnet.chainweb.com" testnetNodeRefs replaceRefsWith ref baseRefs refs = refs - & on (Map.mergeA Map.dropMissing Map.preserveMissing (Map.zipWithMaybeAMatched (\_ _ _ -> Dat Nothing))) toMultiSet baseRefs + & on (Map.mergeA Map.dropMissing Map.preserveMissing (Map.zipWithMaybeAMatched (\_ _ _ -> Deez $ Left Nothing))) toMultiSet baseRefs + & getDeez & \case - Dis m -> m - Dat m -> addRef ref m -- if we hit this case, there were matching keys + Right m -> m + Left m -> addRef ref m -- if we hit this case, there were matching keys & fromMultiSet addRef (unsafeParseNodeRef -> ref) = Map.insert ref 1 testnetNodeRefs = unsafeParseNodeRef <$> From 84eaa4b5c2d554ea189ca3946c9d08eb75352efd Mon Sep 17 00:00:00 2001 From: Emmanuel Denloye-Ito Date: Fri, 11 Jun 2021 14:00:03 -0400 Subject: [PATCH 16/16] for JM --- frontend/tests/Frontend/Storage/InMemoryStorage.hs | 4 ++++ frontend/tests/Frontend/VersionedStoreSpec.hs | 3 +++ 2 files changed, 7 insertions(+) diff --git a/frontend/tests/Frontend/Storage/InMemoryStorage.hs b/frontend/tests/Frontend/Storage/InMemoryStorage.hs index 3f4282ca1..67a73801d 100644 --- a/frontend/tests/Frontend/Storage/InMemoryStorage.hs +++ b/frontend/tests/Frontend/Storage/InMemoryStorage.hs @@ -87,12 +87,14 @@ newInMemoryStorage = do sessionRef <- newIORef (Map.empty :: Map Text Text) pure (localRef, sessionRef) +-- for JM data FailStorageState = FailOnKeyWrite Text Bool | FailOnSettingVersion Bool | NoFailure +-- for JM instance Show FailStorageState where show = \case FailOnKeyWrite text before -> @@ -105,6 +107,7 @@ instance Show FailStorageState where else "Failing just after setting version" NoFailure -> "Not exercising failure state" +-- for JM wrapFail :: MonadIO m => Bool -> m a -> m a wrapFail False action = do liftIO (die "") -- there is surely a better way to do this @@ -142,6 +145,7 @@ inMemoryStorageFromTestData p _ ver dirPath failure = do pure ims where +-- for JM mockRestoreLocalStorageDump p dump ver = case failure of NoFailure -> do diff --git a/frontend/tests/Frontend/VersionedStoreSpec.hs b/frontend/tests/Frontend/VersionedStoreSpec.hs index ade333201..0ec02b648 100644 --- a/frontend/tests/Frontend/VersionedStoreSpec.hs +++ b/frontend/tests/Frontend/VersionedStoreSpec.hs @@ -375,6 +375,7 @@ test_v0ToV2Upgrade = testCaseSteps "V0 to V2 Upgrade" $ \step -> do where path = "tests" "Frontend" "VersionedStoreSpec.files" "V0" +-- for JM fail_test_v0ToV2Upgrade :: FailStorageState -> TestTree fail_test_v0ToV2Upgrade fstate = testCaseSteps "(failing) V0 to V2 upgrade" $ \step -> do @@ -447,6 +448,8 @@ fail_test_v0ToV2Upgrade fstate = testCaseSteps "(failing) V0 to V2 upgrade" $ \s where path = "tests" "Frontend" "VersionedStoreSpec.files" "V0" + +-- for JM fail_test_v1ToV2Upgrade :: FailStorageState -> TestTree fail_test_v1ToV2Upgrade fstate = testCaseSteps "(failing) V1 to V2 upgrade" $ \step -> do