add keccak256 native

Co-authored-by: rsoeldner <r.soeldner@gmail.com>

docs/en/pact-functions.md

@@ -461,7 +461,7 @@ Return ID if called during current pact execution, failing if not.
 Obtain current pact build version.
 ```lisp
 pact> (pact-version)
-"4.10"
+"4.11"
 ```
 
 Top level only: this function will fail if used in module code.
@@ -1796,7 +1796,25 @@ pact> (scalar-mult 'g1 {'x: 1, 'y: 2} 2)
 {"x": 1368015179489954701390400359078579693043519447331113978918064868415326638035,"y": 9918110051302171585080402603319702774565515993150576347155970296011118125764}
 ```
 
-## Poseidon Hash {#Poseidon Hash}
+## Hashes {#Hashes}
+
+### hash-keccak256 {#hash-keccak256}
+
+*bytes* `[string]` *→* `string`
+
+
+Compute the hash of a list of unpadded base64url-encoded inputs. The hash is computed incrementally over all of the decoded inputs.
+```lisp
+pact> (hash-keccak256 [])
+"xdJGAYb3IzySfn2y3McDwOUAtlPKgic7e_rYBF2FpHA"
+pact> (hash-keccak256 [""])
+"xdJGAYb3IzySfn2y3McDwOUAtlPKgic7e_rYBF2FpHA"
+pact> (hash-keccak256 ["T73FllCNJKKgAQ4UCYC4CfucbVXsdRJYkd2YXTdmW9gPm-tqUCB1iKvzzu6Md82KWtSKngqgdO04hzg2JJbS-yyHVDuzNJ6mSZfOPntCTqktEi9X27CFWoAwWEN_4Ir7DItecXm5BEu_TYGnFjsxOeMIiLU2sPlX7_macWL0ylqnVqSpgt-tvzHvJVCDxLXGwbmaEH19Ov_9uJFHwsxMmiZD9Hjl4tOTrqN7THy0tel9rc8WtrUKrg87VJ7OR3Rtts5vZ91EBs1OdVldUQPRP536eTcpJNMo-N0fy-taji6L9Mdt4I4_xGqgIfmJxJMpx6ysWmiFVte8vLKl1L5p0yhOnEDsSDjuhZISDOIKC2NeytqoT9VpBQn1T3fjWkF8WEZIvJg5uXTge_qwA46QKV0LE5AlMKgw0cK91T8fnJ-u1Dyk7tCo3XYbx-292iiih8YM1Cr1-cdY5cclAjHAmlglY2ia_GXit5p6K2ggBmd1LpEBdG8DGE4jmeTtiDXLjprpDilq8iCuI0JZ_gvQvMYPekpf8_cMXtTenIxRmhDpYvZzyCxek1F4aoo7_VcAMYV71Mh_T8ox7U1Q4U8hB9oCy1BYcAt06iQai0HXhGFljxsrkL_YSkwsnWVDhhqzxWRRdX3PubpgMzSI290C1gG0Gq4xfKdHTrbm3Q"])
+"DqM-LjT1ckQGQCRMfx9fBGl86XE5vacqZVjYZjwCs4g"
+pact> (hash-keccak256 ["T73FllCNJKKgAQ4UCYC4CfucbVXsdRJYkd2YXTdmW9g", "D5vralAgdYir887ujHfNilrUip4KoHTtOIc4NiSW0vs", "LIdUO7M0nqZJl84-e0JOqS0SL1fbsIVagDBYQ3_givs", "DItecXm5BEu_TYGnFjsxOeMIiLU2sPlX7_macWL0ylo", "p1akqYLfrb8x7yVQg8S1xsG5mhB9fTr__biRR8LMTJo", "JkP0eOXi05Ouo3tMfLS16X2tzxa2tQquDztUns5HdG0", "ts5vZ91EBs1OdVldUQPRP536eTcpJNMo-N0fy-taji4", "i_THbeCOP8RqoCH5icSTKcesrFpohVbXvLyypdS-adM", "KE6cQOxIOO6FkhIM4goLY17K2qhP1WkFCfVPd-NaQXw", "WEZIvJg5uXTge_qwA46QKV0LE5AlMKgw0cK91T8fnJ8", "rtQ8pO7QqN12G8ftvdoooofGDNQq9fnHWOXHJQIxwJo", "WCVjaJr8ZeK3mnoraCAGZ3UukQF0bwMYTiOZ5O2INcs", "jprpDilq8iCuI0JZ_gvQvMYPekpf8_cMXtTenIxRmhA", "6WL2c8gsXpNReGqKO_1XADGFe9TIf0_KMe1NUOFPIQc", "2gLLUFhwC3TqJBqLQdeEYWWPGyuQv9hKTCydZUOGGrM", "xWRRdX3PubpgMzSI290C1gG0Gq4xfKdHTrbm3Q"])
+"DqM-LjT1ckQGQCRMfx9fBGl86XE5vacqZVjYZjwCs4g"
+```
+
 
 ### poseidon-hash-hack-a-chain {#poseidon-hash-hack-a-chain}
 
@@ -1822,9 +1840,9 @@ pact> (poseidon-hash-hack-a-chain 1 2 3 4 5 6 7 8)
 *x* `string` *→* `object:*`
 
 
-Decode a base-64 encoded Hyperlane Token Message into an object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}`.
+Decode a base-64-unpadded encoded Hyperlane Token Message into an object `{recipient:GUARD, amount:DECIMAL, chainId:STRING}`.
 ```lisp
-pact> (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==")
+pact> (hyperlane-decode-token-message "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAewAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAEAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAGF7InByZWQiOiAia2V5cy1hbGwiLCAia2V5cyI6WyJkYTFhMzM5YmQ4MmQyYzJlOTE4MDYyNmEwMGRjMDQzMjc1ZGViM2FiYWJiMjdiNTczOGFiZjZiOWRjZWU4ZGI2Il19AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA")
 {"amount": 0.000000000000000123,"chainId": "4","recipient": KeySet {keys: [da1a339bd82d2c2e9180626a00dc043275deb3ababb27b5738abf6b9dcee8db6],pred: keys-all}}
 ```
 
@@ -1983,7 +2001,7 @@ Retreive any accumulated events and optionally clear event state. Object returne
  *→* `[string]`
 
 
-Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisableNewTrans","DisablePact40","DisablePact410","DisablePact411","DisablePact42","DisablePact43","DisablePact431","DisablePact44","DisablePact45","DisablePact46","DisablePact47","DisablePact48","DisablePact49","DisablePactEvents","DisableRuntimeReturnTypeChecking","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"]
+Queries, or with arguments, sets execution config flags. Valid flags: ["AllowReadInLocal","DisableHistoryInTransactionalMode","DisableInlineMemCheck","DisableModuleInstall","DisableNewTrans","DisablePact40","DisablePact410","DisablePact411","DisablePact412","DisablePact42","DisablePact43","DisablePact431","DisablePact44","DisablePact45","DisablePact46","DisablePact47","DisablePact48","DisablePact49","DisablePactEvents","DisableRuntimeReturnTypeChecking","EnforceKeyFormats","OldReadOnlyBehavior","PreserveModuleIfacesBug","PreserveModuleNameBug","PreserveNsModuleInstallBug","PreserveShowDefs"]
 ```lisp
 pact> (env-exec-config ['DisableHistoryInTransactionalMode]) (env-exec-config)
 ["DisableHistoryInTransactionalMode"]

docs/en/pact-properties-api.md

@@ -814,6 +814,19 @@ BLAKE2b 256-bit hash of lists
 
 Supported in properties only.
 
+### keccak {#FKeccak256Hash}
+
+```lisp
+(keccak256 xs)
+```
+
+* takes `xs`: [`string`]
+* produces `string`
+
+Compute the hash of a list of base64-encoded inputs. The hash is computed incrementally over all of the base64-decoded inputs.
+
+Supported in properties only.
+
 ## String operators {#String}
 
 ### length {#FStringLength}

golden/gas-model/golden

@@ -126,6 +126,13 @@
   - 5
 - - (hash smallOjectMap)
   - 5
+- - |-
+    (hash-keccak256 [])
+    (hash-keccak256 [""])
+    (hash-keccak256 ["IP9FQ2ml0FuBp489sFgZ_qmwjCOE91ywq2qhFd1pDaMTGHShyo9witFRnqlSweJJy1QNGWOSx56HdVQk_ufIkICMViciNZ7qUuihL7u5ad15YdK6UgN0k3VaX6BPDVChqibJtEFIwNO5TRxKWaMayhWui9RKy3gz2OkcS4b6MTWkIzh7gVG0Ez7SP21xh7UOwiBK2QGtdNOW5EJ04OyvquF7O5CF4iJgs1ylOxXMUqu6dYr2eY-9BOzuztZI869P2z3tdVeppc-3OCYSqKjz9FlH0aKc4pByko7Bk8ol1RBxvV4ZhOz0AvMG6nYvDyUoL1KW2Zdli-P5g2lv-m0JXGNptNr3nppdMTYikSj462PBK56fp4r_ej6eGaYgIkk80Tbe-7W7e6G5OPNn_S9j61ynbAsP8hueNsPwcjDPPDB05dpYcECnaXXX459ElKzlSG_L84CrdVjE_ollYzW4Lk24ZZUJ6rRqGWExJuWUBCcy3UxBH0GqjN6sccD7QKlObaVYwF53thgoBvJtmv3z2gDGlBkiLIGGpu-tYAtBDmzi8qeX5J3B8TUxmAH6bzlrBvl14qGQoCPkdLYY5w"])
+    (hash-keccak256 ["IP9FQ2ml0FuBp489sFgZ_qmwjCOE91ywq2qhFd1pDaM", "Exh0ocqPcIrRUZ6pUsHiSctUDRljkseeh3VUJP7nyJA", "gIxWJyI1nupS6KEvu7lp3Xlh0rpSA3STdVpfoE8NUKE", "qibJtEFIwNO5TRxKWaMayhWui9RKy3gz2OkcS4b6MTU", "pCM4e4FRtBM-0j9tcYe1DsIgStkBrXTTluRCdODsr6o", "4Xs7kIXiImCzXKU7FcxSq7p1ivZ5j70E7O7O1kjzr08", "2z3tdVeppc-3OCYSqKjz9FlH0aKc4pByko7Bk8ol1RA", "cb1eGYTs9ALzBup2Lw8lKC9SltmXZYvj-YNpb_ptCVw", "Y2m02veeml0xNiKRKPjrY8Ernp-niv96Pp4ZpiAiSTw", "0Tbe-7W7e6G5OPNn_S9j61ynbAsP8hueNsPwcjDPPDA", "dOXaWHBAp2l11-OfRJSs5Uhvy_OAq3VYxP6JZWM1uC4", "TbhllQnqtGoZYTEm5ZQEJzLdTEEfQaqM3qxxwPtAqU4", "baVYwF53thgoBvJtmv3z2gDGlBkiLIGGpu-tYAtBDmw", "4vKnl-SdwfE1MZgB-m85awb5deKhkKAj5HS2GOc"])
+    (hash-keccak256 ["T73FllCNJKKgAQ4UCYC4CfucbVXsdRJYkd2YXTdmW9gPm-tqUCB1iKvzzu6Md82KWtSKngqgdO04hzg2JJbS-yyHVDuzNJ6mSZfOPntCTqktEi9X27CFWoAwWEN_4Ir7DItecXm5BEu_TYGnFjsxOeMIiLU2sPlX7_macWL0ylqnVqSpgt-tvzHvJVCDxLXGwbmaEH19Ov_9uJFHwsxMmiZD9Hjl4tOTrqN7THy0tel9rc8WtrUKrg87VJ7OR3Rtts5vZ91EBs1OdVldUQPRP536eTcpJNMo-N0fy-taji6L9Mdt4I4_xGqgIfmJxJMpx6ysWmiFVte8vLKl1L5p0yhOnEDsSDjuhZISDOIKC2NeytqoT9VpBQn1T3fjWkF8WEZIvJg5uXTge_qwA46QKV0LE5AlMKgw0cK91T8fnJ-u1Dyk7tCo3XYbx-292iiih8YM1Cr1-cdY5cclAjHAmlglY2ia_GXit5p6K2ggBmd1LpEBdG8DGE4jmeTtiDXLjprpDilq8iCuI0JZ_gvQvMYPekpf8_cMXtTenIxRmhDpYvZzyCxek1F4aoo7_VcAMYV71Mh_T8ox7U1Q4U8hB9oCy1BYcAt06iQai0HXhGFljxsrkL_YSkwsnWVDhhqzxWRRdX3PubpgMzSI290C1gG0Gq4xfKdHTrbm3Q"])
+  - 44
 - - (* longNumber longNumber)
   - 3
 - - (* medNumber medNumber)

pact.cabal

@@ -96,6 +96,7 @@ library
     cbits/musl/sqrt_data.c
   exposed-modules:
     Crypto.Hash.Blake2Native
+    Crypto.Hash.Keccak256Native
     Crypto.Hash.HyperlaneMessageId
     Crypto.Hash.PoseidonNative
     Pact.Analyze.Remote.Types
@@ -222,11 +223,12 @@ library
     , direct-sqlite >=2.3.27
     , directory >=1.2.6.2
     , errors >=2.3
+    , ethereum >= 0.1
     , exceptions >=0.8.3
     , filepath >=1.4.1.0
     , groups
     , hashable >=1.4
-    , ethereum >= 0.1
+    , hashes >= 0.2
     , lens >=4.14
     , megaparsec >=9
     , memory
@@ -421,6 +423,7 @@ test-suite hspec
     , attoparsec
     , base
     , base16-bytestring
+    , base64-bytestring
     , bound
     , bytestring
     , containers
@@ -471,6 +474,7 @@ test-suite hspec
       GoldenSpec
       HistoryServiceSpec
       HyperlaneSpec
+      Keccak256Spec
       PactContinuationSpec
       PersistSpec
       PoseidonSpec

src-tool/Pact/Analyze/Eval/Core.hs

@@ -47,6 +47,7 @@ import Pact.Types.Util (AsString(asString))
 import Data.Text.Encoding (encodeUtf8)
 import qualified Pact.Types.Lang as Pact
 import qualified Pact.Types.PactValue as Pact
+import Crypto.Hash.Keccak256Native
 import qualified Data.ByteString as BS
 import Data.Functor ((<&>))
 import qualified Data.Vector as V
@@ -312,6 +313,17 @@ evalCore (ListHash ty' xs) = do
       SList t' -> Pact.PList . V.fromList <$> traverse (reify t') c
       _ -> throwErrorNoLoc (FailureMessage "Unsupported type, currently we support integer, decimal, string, and bool")
 
+evalCore (Keccak256Hash xs) = eval xs <&> unliteralS >>= \case
+    Nothing -> do
+      -- (keccak256 [])
+      let h = "xdJGAYb3IzySfn2y3McDwOUAtlPKgic7e_rYBF2FpHA"
+      emitWarning (FVShimmedStaticContent "hash-keccak256" ("of type '[string]', substitute '" <> T.pack h <> "')"))
+      pure (literalS (Str h))
+    Just (xs':: [Str]) -> do
+      let tm = fmap (\x -> T.pack (unStr x)) xs'
+          h = keccak256 (V.fromList tm)
+      pure (literalS . Str . either (error . show) T.unpack $ h)
+
 evalCore (ListContains ty needle haystack) = withSymVal ty $ do
   S _ needle'   <- withSing ty $ eval needle
   S _ haystack' <- withSing ty $ eval haystack

src-tool/Pact/Analyze/Feature.hs

@@ -82,7 +82,7 @@ data Feature
   | FFloorRound
   | FDecCast
   | FModulus
- 
+
   -- Bitwise operators
   | FBitwiseAnd
   | FBitwiseOr
@@ -133,6 +133,7 @@ data Feature
   | FNumericalHash
   | FBoolHash
   | FListHash
+  | FKeccak256Hash
   -- Temporal operators
   | FTemporalAddition
   | FTemporalDiff
@@ -1303,6 +1304,21 @@ doc FListHash = Doc
         ]
       (TyCon str)
   ]
+doc FKeccak256Hash = Doc
+  "keccak"
+  CList
+  PropOnly
+  "Compute the hash of a list of base64-encoded inputs. The hash is computed incrementally over all of the base64-decoded inputs."
+  [ Usage
+      "(hash-keccak256 xs)"
+      Map.empty
+      $ Fun
+        Nothing
+        [ ("xs", TyList' (TyCon str))
+        ]
+      (TyCon str)
+  ]
+
 -- Temporal features
 
 doc FTemporalAddition = Doc
@@ -1894,6 +1910,7 @@ PAT(SStringHash, FStringHash)
 PAT(SNumericalHash, FNumericalHash)
 PAT(SBoolHash, FBoolHash)
 PAT(SListHash, FListHash)
+PAT(SKeccak256Hash, FKeccak256Hash)
 PAT(STemporalAddition, FTemporalAddition)
 PAT(STemporalDiff, FTemporalDiff)
 PAT(SUniversalQuantification, FUniversalQuantification)

src-tool/Pact/Analyze/Patterns.hs

@@ -189,6 +189,9 @@ pattern AST_ParseTime formatStr timeStr <-
 pattern AST_Hash :: forall a. AST a -> AST a
 pattern AST_Hash val <- App _node (NativeFunc "hash") [val]
 
+pattern AST_Keccak :: forall a. AST a -> AST a
+pattern AST_Keccak val <- App _node (NativeFunc "hash-keccak256") [val]
+
 pattern AST_AddTime :: forall a. AST a -> AST a -> AST a
 pattern AST_AddTime time seconds <- App _ (NativeFunc STemporalAddition) [time, seconds]
 

src-tool/Pact/Analyze/PrenexNormalize.hs

@@ -109,6 +109,7 @@ singFloat ty p = case p of
   CoreProp (BoolHash s) -> CoreProp . BoolHash <$> float s
   CoreProp (DecHash s)  -> CoreProp . DecHash  <$> float s
   CoreProp (ListHash ty' s) -> CoreProp . ListHash ty' <$> singFloat (SList ty') s
+  CoreProp (Keccak256Hash s) -> CoreProp . Keccak256Hash <$> float s
   -- time
   CoreProp (IntAddTime time int) -> PIntAddTime <$> float time <*> float int
   CoreProp (DecAddTime time dec) -> PDecAddTime <$> float time <*> float dec

src-tool/Pact/Analyze/Translate.hs

@@ -1007,7 +1007,7 @@ translateNode astNode = withAstContext astNode $ case astNode of
       notStaticShim = do
         addWarning' (UnsupportedNonFatal "Call to `hash` is only implemented for string, bool, and integer, substituting hash of `hello pact`")
         wrap (StrHash (Lit' (Str "hello pact")))
-    
+
     case ty of
       SStr       -> wrap (StrHash val')
       SBool      -> wrap (BoolHash val')
@@ -1022,6 +1022,10 @@ translateNode astNode = withAstContext astNode $ case astNode of
         _otherwise ->  notStaticShim
       _otherwise -> notStaticShim
 
+  AST_Keccak val -> translateNode val >>= \case
+    Some (SList SStr) val' -> pure $ Some SStr $ CoreTerm $ Keccak256Hash val'
+    _ -> unexpectedNode astNode
+
   AST_ReadKeyset nameA -> translateNode nameA >>= \case
     Some SStr nameT -> return $ Some SGuard $ ReadKeySet nameT
     _ -> unexpectedNode astNode

src-tool/Pact/Analyze/Types/Languages.hs

@@ -213,6 +213,9 @@ data Core (t :: Ty -> K.Type) (a :: Ty) where
   DecHash      :: t 'TyDecimal -> Core t 'TyStr
   ListHash     :: SingTy a -> t ('TyList a) -> Core t 'TyStr
 
+  -- | Keccak256 hash
+  Keccak256Hash :: t ('TyList 'TyStr) -> Core t 'TyStr
+
   Enumerate :: t 'TyInteger -> t 'TyInteger -> t 'TyInteger -> Core t ('TyList 'TyInteger)
 
   -- numeric ops
@@ -765,6 +768,7 @@ showsPrecCore ty p core = showParen (p > 10) $ case core of
   BoolHash a       -> showString "BoolHash "     . showsTm 11 a
   DecHash a        -> showString "DecimalHash "  . showsTm 11 a
   ListHash ty' a   -> showString "ListHash "     . showsPrec 11 ty' . showChar ' ' . singShowsTmList ty' 11 a
+  Keccak256Hash a  -> showString "Keccak256"     . showsTm 11 a
   Enumerate a b c  -> showString "Enumerate "    . showsTm 11 a . showChar ' ' . showsTm 11 b . showChar ' ' . showsTm 11 c
   Numerical a      -> showString "Numerical "    . showsNumerical ty 11 a
   IntAddTime a b   -> showString "IntAddTime "   . showsTm 11 a . showChar ' ' . showsTm 11 b
@@ -1024,7 +1028,7 @@ prettyCore ty = \case
   BoolHash x               -> parensSep [pretty SBoolHash, prettyTm x]
   DecHash x                -> parensSep [pretty SNumericalHash, prettyTm x]
   ListHash ty' x           -> parensSep [pretty SListHash, singPrettyTmList ty' x]
-
+  Keccak256Hash x          -> parensSep [pretty SKeccak256Hash, prettyTm x]
   Enumerate x y z          -> parensSep [pretty SEnumerate, prettyTm x, prettyTm y, prettyTm z]
   Numerical tm             -> prettyNumerical ty tm
   IntAddTime x y           -> parensSep [pretty STemporalAddition, prettyTm x, prettyTm y]
@@ -1911,6 +1915,8 @@ propToInvariant (CoreProp core) = CoreInvariant <$> case core of
     BoolHash <$> f tm1
   ListHash ty tm1 ->
     ListHash ty <$> f tm1
+  Keccak256Hash tm ->
+    Keccak256Hash <$> f tm
   Enumerate tm1 tm2 tm3 ->
     Enumerate <$> f tm1 <*> f tm2 <*> f tm3
   Numerical num ->

src/Crypto/Hash/Keccak256Native.hs

@@ -0,0 +1,55 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DerivingStrategies #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- | Implementation of the `keccak256` pact native.
+--
+--   `keccak256` takes as input a Pact object representing a
+--   'HyperlaneMessage', and returns a base16-encoded hash of the abi-encoding
+--   of the input.
+module Crypto.Hash.Keccak256Native (Keccak256Error(..), keccak256) where
+
+import Control.Exception (Exception(..), SomeException(..), try)
+import Control.Monad (forM_)
+import Control.Monad.Catch (throwM)
+import Data.ByteString.Short qualified as BSS
+import Data.Hash.Class.Mutable (initialize, finalize, updateByteString)
+import Data.Hash.Internal.OpenSSL (OpenSslException(..))
+import Data.Hash.Keccak (Keccak256(..))
+import Data.Text (Text)
+import Data.Text.Encoding qualified as Text
+import Data.Vector (Vector)
+import Pact.Types.Util (encodeBase64UrlUnpadded, decodeBase64UrlUnpadded)
+import System.IO.Unsafe (unsafePerformIO)
+
+data Keccak256Error
+  = Keccak256OpenSslException String
+  | Keccak256Base64Exception String
+  | Keccak256OtherException !SomeException
+  deriving stock (Show)
+  deriving anyclass (Exception)
+
+keccak256 :: Vector Text -> Either Keccak256Error Text
+keccak256 strings = unsafePerformIO $ do
+  e <- try @SomeException @_ $ do
+    ctx <- initialize @Keccak256
+    forM_ strings $ \string -> do
+      case decodeBase64UrlUnpadded (Text.encodeUtf8 string) of
+        Left b64Err -> do
+          throwM (Keccak256Base64Exception b64Err)
+        Right bytes -> do
+          updateByteString @Keccak256 ctx bytes
+    Keccak256 hash <- finalize ctx
+    pure (BSS.fromShort hash)
+  case e of
+    Left err
+      | Just (OpenSslException msg) <- fromException err -> pure (Left (Keccak256OpenSslException msg))
+      | Just (exc :: Keccak256Error) <- fromException err -> pure (Left exc)
+      | otherwise -> pure (Left (Keccak256OtherException err))
+    Right hash -> pure (Right (Text.decodeUtf8 (encodeBase64UrlUnpadded hash)))
+{-# noinline keccak256 #-}

src/Pact/Gas/Table.hs

@@ -12,6 +12,7 @@ import Data.Map (Map)
 import qualified Data.Map as Map
 import Data.Ratio
 import Data.Text (Text)
+import qualified Data.Vector as V
 import qualified Data.Text as T
 import qualified GHC.Integer.Logarithms as IntLog
 import GHC.Int(Int(..))
@@ -57,6 +58,8 @@ data GasCostConfig = GasCostConfig
   , _gasCostConfig_poseidonHashHackAChainLinearGasFactor :: Gas
   , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes :: MilliGas
   , _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes :: MilliGas
+  , _gasCostConfig_keccak256GasPerOneHundredBytes :: MilliGas
+  , _gasCostConfig_keccak256GasPerChunk :: MilliGas
   }
 
 defaultGasConfig :: GasCostConfig
@@ -85,6 +88,8 @@ defaultGasConfig = GasCostConfig
   , _gasCostConfig_poseidonHashHackAChainQuadraticGasFactor = 38
   , _gasCostConfig_hyperlaneMessageIdGasPerRecipientOneHundredBytes = MilliGas 47
   , _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes = MilliGas 50
+  , _gasCostConfig_keccak256GasPerOneHundredBytes = MilliGas 146
+  , _gasCostConfig_keccak256GasPerChunk = MilliGas 2_120
   }
 
 defaultGasTable :: Map Text Gas
@@ -242,6 +247,7 @@ defaultGasTable =
   ,("poseidon-hash-hack-a-chain", 124)
   ,("hyperlane-message-id", 2)
   ,("hyperlane-decode-token-message", 2)
+  ,("hash-keccak256",1)
   ]
 
 {-# NOINLINE defaultGasTable #-}
@@ -345,6 +351,15 @@ tableGasModel gasConfig =
         GHyperlaneDecodeTokenMessage len ->
           let MilliGas costPerOneHundredBytes = _gasCostConfig_hyperlaneDecodeTokenMessageGasPerOneHundredBytes gasConfig
           in MilliGas (costPerOneHundredBytes * div (fromIntegral len) 100)
+        GKeccak256 chunkBytes ->
+          let MilliGas costPerOneHundredBytes = _gasCostConfig_keccak256GasPerOneHundredBytes gasConfig
+              MilliGas costPerChunk = _gasCostConfig_keccak256GasPerChunk gasConfig
+
+              -- we need to use ceiling here, otherwise someone could cheat by
+              -- having as many bytes as they want, but in chunks of 99 bytes.
+              gasOne numBytesInChunk = costPerChunk + costPerOneHundredBytes * ceiling (fromIntegral @_ @Double numBytesInChunk / 100.0)
+
+          in MilliGas (V.sum (V.map gasOne chunkBytes))
 
   in GasModel
       { gasModelName = "table"