Introduce StableHashMap to support hashable-1.5.0.0 (#1378)

* Introduce StableHashMap to support hashable-1.5.0.0

* add test cases for StableHashable

* tests for StableHashMap

Author: larskuhtz

pact.cabal

@@ -203,6 +203,7 @@ library
     Pact.Types.Verifier
     Pact.Types.Version
     Pact.Utils.Servant
+    Pact.Utils.StableHashMap
 
   other-modules:
     Pact.Crypto.WebAuthn.Cose.PublicKey
@@ -448,6 +449,7 @@ test-suite hspec
     , directory
     , errors
     , filepath
+    , hashable
     , hspec
     , lens
     , mod
@@ -474,6 +476,7 @@ test-suite hspec
     Test.Pact.Native.Pairing
     Test.Pact.Parse
     Test.Pact.Utils.LegacyValue
+    Test.Pact.Utils.StableHashMap
 
   if flag(build-tool)
     cpp-options: -DBUILD_TOOL

src-tool/Pact/Analyze/Check.hs

@@ -106,6 +106,7 @@ import           Pact.Analyze.Translate
 import           Pact.Analyze.Types
 import           Pact.Analyze.Util
 import Pact.Types.Exp
+import qualified Pact.Utils.StableHashMap as SHM
 
 smtConfig :: SBV.SMTConfig
 smtConfig = SBV.z3
@@ -766,7 +767,7 @@ parseModuleModelDecl exps = traverse parseDecl exps where
 
 -- | Organize the module's refs by type
 moduleRefs :: ModuleData Ref -> ModuleRefs
-moduleRefs (ModuleData _ refMap _) = foldl' f noRefs (HM.toList refMap)
+moduleRefs (ModuleData _ refMap _) = foldl' f noRefs (SHM.toList refMap)
   where
     f accum (name, ref) = case ref of
       Ref (TDef (Def{_dDefType, _dDefBody}) _) ->
@@ -1137,7 +1138,7 @@ getFunChecks env@(CheckEnv tables consts propDefs moduleData _cs _g de _) refs =
 scopeCheckInterface
   :: Set Text
   -- ^ A set of table, definition and property names in scope
-  -> HM.HashMap Text Ref
+  -> SHM.StableHashMap Text Ref
   -- ^ The set of refs to check
   -> [ScopeError]
 scopeCheckInterface globalNames refs = refs <&&> \case
@@ -1229,7 +1230,7 @@ verifyModule mDebug de modules moduleData@(ModuleData modDef allRefs _) = runExc
           globalNames = Set.unions $ fmap Set.fromList
             [ fmap _tableName tables
             , HM.keys propDefs
-            , HM.keys allRefs
+            , SHM.keys allRefs
             ]
           scopeErrors = scopeCheckInterface globalNames allRefs
 
@@ -1322,7 +1323,7 @@ verifyCheck de moduleData funName check checkType = do
       moduleName = moduleDefName $ moduleData ^. mdModule
       modules    = HM.fromList [(moduleName, moduleData)]
       moduleFun :: ModuleData Ref -> Text -> Maybe Ref
-      moduleFun ModuleData{..} name = name `HM.lookup` _mdRefMap
+      moduleFun ModuleData{..} name = name `SHM.lookup` _mdRefMap
       modRefs    = moduleRefs moduleData
 
   caps   <- moduleCapabilities de [moduleData]

src/Pact/Bench.hs

@@ -21,7 +21,6 @@ import Data.Aeson
 import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import Data.Default
-import qualified Data.HashMap.Strict as HM
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 import Data.Text (unpack, pack, intercalate)
@@ -60,6 +59,7 @@ import Pact.Types.Capability
 import Pact.Runtime.Utils
 import Pact.JSON.Legacy.Value
 import qualified Pact.JSON.Encode as J
+import qualified Pact.Utils.StableHashMap as SHM
 
 -- | Flags for enabling file-based perf bracketing,
 -- see 'mkFilePerf' below.
@@ -191,7 +191,7 @@ runPactExec pt msg ss cdata benchMod dbEnv pc = do
   e <- set eeAdvice pt <$> setupEvalEnv dbEnv entity Transactional md (versionedNativesRefStore ec)
           prodGasEnv permissiveNamespacePolicy noSPVSupport def ec
   let s = perfInterpreter pt $ defaultInterpreterState $
-          maybe id (const . initStateModules . HM.singleton (ModuleName "bench" Nothing)) benchMod
+          maybe id (const . initStateModules . SHM.singleton (ModuleName "bench" Nothing)) benchMod
   (r :: Either SomeException EvalResult) <- try $! evalExec s e pc
   r' <- eitherDie ("runPactExec': " ++ msg) $ fmapL show r
   return $!! _erOutput r'

src/Pact/Coverage.hs

@@ -38,6 +38,7 @@ import Pact.Types.Pretty
 import Pact.Types.Term hiding (App(..),Object(..),Step(..))
 import Pact.Types.Typecheck
 import Pact.Types.Runtime (ModuleData(..))
+import qualified Pact.Utils.StableHashMap as SHM
 
 mkCoverageAdvice :: IO (IORef LcovReport,Advice)
 mkCoverageAdvice = newIORef mempty >>= \r -> return (r,Advice $ cover r)
@@ -78,7 +79,7 @@ cover ref i ctx = case _iInfo i of
     postModule :: MonadIO m => ModuleData Ref -> m ()
     postModule (ModuleData (MDModule _m) modDefs _) = do
       ((modFuns,modLines),_) <- liftIO $ runTC 0 False $
-        foldM walkDefs (mempty,mempty) (HM.elems modDefs)
+        foldM walkDefs (mempty,mempty) (SHM.elems modDefs)
       let (fn,_l) = parseInf i
           newRep = mkFileLcov fn modFuns mempty modLines
       liftIO $ modifyIORef ref (<> newRep)