Fix everything

src/Pact/ApiReq.hs

@@ -51,13 +51,13 @@ import qualified Data.ByteString.Lazy.Char8 as BSL
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Short as SBS
 import Data.Default (def)
+import Data.Foldable
 import Data.List
 import Data.List.NonEmpty (NonEmpty(..))
 import qualified Data.Set as S
 import qualified Data.Map.Strict as Map
 import Data.Text (Text, pack)
 import Data.Text.Encoding
-import Data.Foldable(foldrM)
 import Pact.Time
 import qualified Data.Yaml as Y
 import GHC.Generics
@@ -298,7 +298,7 @@ loadSigData fp = do
 
 addSigToSigData :: Ed25519KeyPair -> SigData a -> IO (SigData a)
 addSigToSigData kp sd = do
-  sig <- signHash (_sigDataHash sd) kp
+  let sig = signHash (_sigDataHash sd) kp
   let k = PublicKeyHex $ toB16Text $ getPublic kp
   return $ sd { _sigDataSigs = addSigToList k sig $ _sigDataSigs sd }
 
@@ -341,29 +341,22 @@ returnSigDataOrCommand  outputLocal sd
     when (length (_pSigners payload) /= length sigs) $
       Left "Number of signers in the payload does not match number of signers in the sigData"
     usrSigs <- traverse (toSignerPair sigMap) (_pSigners payload)
-    let failedSigs = filter (not . verifySig h) usrSigs
-    when (length failedSigs /= 0) $ Left $ "Invalid sig(s) found: " ++ show (J.encode . J.Array <$> failedSigs)
+    traverse_ Left $ verifyUserSigs h [ (signer, sig) | (Just signer, sig) <- usrSigs ]
     _ <- verifyHash h (encodeUtf8 cmd)
     pure ()
     where
-    verifySig hsh (signer, usrSig) = case usrSig of
-      Nothing -> True
-      Just sig -> verifyUserSig hsh sig signer
     toSignerPair sigMap signer =
       case Map.lookup (PublicKeyHex $ _siPubKey signer) sigMap of
         Nothing -> Left $ "Signer in payload does not show up in signatures" <> show (_siPubKey signer)
-        Just v -> pure (signer, v)
+        Just v -> pure (v, signer)
   verifyPartialSigData (SigData h sigs Nothing) = do
     sigs' <- foldrM toVerifPair [] sigs
-    let scheme = toScheme ED25519
-        failedSigs = filter (\(pk, sig) -> not $ verify scheme (toUntypedHash h) pk sig) sigs'
-    when (length failedSigs /= 0) $ Left $ "Invalid sig(s) found: " ++ show (J.encode . J.Array <$> failedSigs)
-    pure ()
+    traverse_ Left $ verifyUserSigs h sigs'
     where
     toVerifPair (PublicKeyHex pktext, Just (ED25519Sig _usSig) ) m = do
-      pk <- PubBS <$> parseB16TextOnly pktext
-      sig <- SigBS <$> parseB16TextOnly _usSig
-      pure $ (pk, sig):m
+      let sig = ED25519Sig _usSig
+      let signer = Signer (Just ED25519) pktext Nothing []
+      pure $ (sig, signer):m
     toVerifPair (_, _) m = pure m
 
 returnCommandIfDone :: Bool -> SigData Text -> IO ByteString
@@ -474,7 +467,7 @@ signCmd keyFiles bs = do
     Right h -> do
       kps <- mapM importKeyFile keyFiles
       fmap (encodeYaml . J.Object) $ forM kps $ \kp -> do
-            ED25519Sig sig  <- signHash (fromUntypedHash $ Hash $ SBS.toShort h) kp
+            let sig = signHash (fromUntypedHash $ Hash $ SBS.toShort h) kp
             return (asString (B16JsonBytes (getPublic kp)), sig)
 
 withKeypairsOrSigner

src/Pact/Bench.hs

@@ -44,7 +44,6 @@ import Pact.Persist.MockPersist
 import Pact.Types.Command
 import Pact.Types.Crypto
 import Pact.Types.Lang
-import Pact.Types.KeySet (KeysetPublicKey(KeysetPublicKey))
 import Pact.Types.Logger
 import Pact.Types.PactValue
 import Pact.Types.RowData
@@ -212,12 +211,12 @@ benchPures pt dbEnv es = bgroup "pures" $ (`map` es) $
   \p -> benchNFIO (fst p) $ execPure pt dbEnv p
 
 benchKeySet :: KeySet
-benchKeySet = mkKeySet [KeysetPublicKey (PublicKeyText "benchadmin") ED25519] ">"
+benchKeySet = mkKeySet [PublicKeyText "benchadmin"] ">"
 
 acctRow :: RowData
 acctRow = RowData RDV1 $ fmap pactValueToRowData $ ObjectMap $ M.fromList
   [("balance",PLiteral (LDecimal 100.0))
-  ,("guard",PGuard $ GKeySet (mkKeySet [KeysetPublicKey (PublicKeyText pk) ED25519] "keys-all"))
+  ,("guard",PGuard $ GKeySet (mkKeySet [PublicKeyText pk] "keys-all"))
   ]
 
 benchRead :: PersistModuleData -> Domain k v -> k -> Method () (Maybe v)

src/Pact/Eval.hs

@@ -123,7 +123,7 @@ enforceKeySet i ksn KeySet{..} = do
   where
     matchKey k _ = k `elem` _ksKeys
     failed = failTx i $ "Keyset failure " <> parens (pretty _ksPredFun) <> ": " <>
-      maybe (pretty $ map (elide . asString . _pkPublicKey) $ toList _ksKeys) pretty ksn
+      maybe (pretty $ map (elide . asString) $ toList _ksKeys) pretty ksn
     atLeast t m = m >= t
     elide pk | T.length pk < 8 = pk
              | otherwise = T.take 8 pk <> "..."
@@ -173,7 +173,12 @@ enforceGuard i g = case g of
           evalError' i $ "Pact guard failed, intended: " <> pretty pid <> ", active: " <> pretty currPid
 
 getSizeOfVersion :: Eval e SizeOfVersion
-getSizeOfVersion = ifExecutionFlagSet' FlagDisablePact45 SizeOfV0 SizeOfV1
+getSizeOfVersion = do
+  pact410 <- isExecutionFlagSet FlagDisablePact410
+  pact45 <- isExecutionFlagSet FlagDisablePact45
+  if pact45 then return SizeOfV0
+  else if pact410 then return SizeOfV1
+  else return SizeOfV2
 {-# INLINABLE getSizeOfVersion #-}
 
 -- | Hoist Name back to ref

src/Pact/Gas/Table/Format.hs

@@ -55,7 +55,7 @@ instance ToPactStringGas PactId where
 
 instance ToPactStringGas (Guard PactValue) where
   estimate (GPact (PactGuard (PactId t1) t2)) = estimate t1 <> estimate t2
-  estimate (GKeySet (KeySet ks predFun)) = estimateList (_pubKey . _pkPublicKey <$> toList ks) <> estimate predFun
+  estimate (GKeySet (KeySet ks predFun)) = estimateList (_pubKey <$> toList ks) <> estimate predFun
   estimate (GKeySetRef (KeySetName txt mn)) = estimate txt <> estimate mn
   estimate (GModule (ModuleGuard mn t)) = estimate mn <> estimate t
   estimate (GUser (UserGuard name args)) = estimate name <> estimateList args

src/Pact/GasModel/Utils.hs

@@ -75,7 +75,6 @@ import qualified Data.Text as T
 import Pact.Compile (compileExps, mkTextInfo)
 import Pact.Types.Capability (SigCapability)
 import Pact.Types.Command
-import Pact.Types.KeySet (KeysetPublicKey(KeysetPublicKey))
 import Pact.Types.Lang
 import Pact.Types.PactValue (PactValue(..))
 import Pact.Types.RowData
@@ -378,16 +377,16 @@ sampleLoadedKeysetName = "some-loaded-keyset"
 sampleLoadedMultisigKeysetName :: T.Text
 sampleLoadedMultisigKeysetName = "some-loaded-multisig-keyset"
 
-samplePubKeys :: [KeysetPublicKey]
-samplePubKeys = [KeysetPublicKey (PublicKeyText "something") ED25519]
+samplePubKeys :: [PublicKeyText]
+samplePubKeys = [PublicKeyText "something"]
 
-sampleMultiPubKeys :: [KeysetPublicKey]
+sampleMultiPubKeys :: [PublicKeyText]
 sampleMultiPubKeys =
-  [ KeysetPublicKey (PublicKeyText "key1") ED25519
-  , KeysetPublicKey (PublicKeyText "key2") ED25519
+  [ PublicKeyText "key1"
+  , PublicKeyText "key2"
   ]
 
-samplePubKeysWithCaps :: [(KeysetPublicKey, S.Set SigCapability)]
+samplePubKeysWithCaps :: [(PublicKeyText, S.Set SigCapability)]
 samplePubKeysWithCaps = map (\p -> (p,S.empty)) samplePubKeys
 
 sampleKeyset :: KeySet

src/Pact/Interpreter.hs

@@ -37,7 +37,7 @@ module Pact.Interpreter
   , versionedNativesRefStore
   , ExecutionConfig (..)
   , pact40Natives
-  , pact420Natives
+  , pact42Natives
   , pact43Natives
   , pact431Natives
   , pact46Natives
@@ -69,7 +69,6 @@ import Pact.Native (nativeDefs)
 import qualified Pact.Persist.Pure as Pure
 import qualified Pact.Persist.SQLite as PSL
 import Pact.PersistPactDb
-import Pact.Types.KeySet (KeysetPublicKey(KeysetPublicKey, _pkPublicKey, _pkCryptoScheme))
 import Pact.Types.Command
 import Pact.Types.ExpParser
 import Pact.Types.Logger
@@ -216,11 +215,7 @@ setupEvalEnv dbEnv ent mode msgData refStore gasEnv np spv pd ec = do
       where
         toPair Signer{..} = (pk,S.fromList _siCapList)
           where
-            pk :: KeysetPublicKey
-            pk = KeysetPublicKey
-              { _pkPublicKey = maybe (PublicKeyText _siPubKey) PublicKeyText _siAddress
-              , _pkCryptoScheme =  fromMaybe ED25519 _siScheme
-              }
+            pk = PublicKeyText $ fromMaybe _siPubKey _siAddress
 
 
 disablePactNatives :: [Text] -> ExecutionFlag -> ExecutionConfig -> Endo RefStore
@@ -232,8 +227,8 @@ disablePact40Natives :: ExecutionConfig -> Endo RefStore
 disablePact40Natives =
   disablePactNatives pact40Natives FlagDisablePact40
 
-disablePact420Natives :: ExecutionConfig -> Endo RefStore
-disablePact420Natives = disablePactNatives pact420Natives FlagDisablePact420
+disablePact42Natives :: ExecutionConfig -> Endo RefStore
+disablePact42Natives = disablePactNatives pact42Natives FlagDisablePact42
 
 disablePact43Natives :: ExecutionConfig -> Endo RefStore
 disablePact43Natives = disablePactNatives pact43Natives FlagDisablePact43
@@ -250,8 +245,8 @@ disablePact47Natives = disablePactNatives pact47Natives FlagDisablePact47
 pact40Natives :: [Text]
 pact40Natives = ["enumerate" , "distinct" , "emit-event" , "concat" , "str-to-list"]
 
-pact420Natives :: [Text]
-pact420Natives = ["zip", "fold-db"]
+pact42Natives :: [Text]
+pact42Natives = ["zip", "fold-db"]
 
 pact43Natives :: [Text]
 pact43Natives = ["create-principal", "validate-principal", "continue"]
@@ -273,7 +268,7 @@ versionedNativesRefStore ec = versionNatives initRefStore
   where
   versionNatives = appEndo $ mconcat
     [ disablePact40Natives ec
-    , disablePact420Natives ec
+    , disablePact42Natives ec
     , disablePact43Natives ec
     , disablePact431Natives ec
     , disablePact46Natives ec

src/Pact/Native.hs

@@ -1017,7 +1017,7 @@ filter' i as@[tLamToApp -> app@TApp {},l] = gasUnreduced i as $ reduce l >>= \ca
     t <- apply (_tApp app) [a']
     case t of
       (TLiteral (LBool bo) _) -> return bo
-      _ -> ifExecutionFlagSet FlagDisablePact420
+      _ -> ifExecutionFlagSet FlagDisablePact42
              (return False)
              (evalError' i $ "filter: expected closure to return bool: " <> pretty app)
   t -> isOffChainForkedError FlagDisablePact47 >>= \case

src/Pact/Native/Db.hs

@@ -448,7 +448,7 @@ write wt partial i as = do
         TyAny -> return ()
         TyVar {} -> return ()
         tty -> void $ checkUserType partial (_faInfo i) ps tty
-      rdv <- ifExecutionFlagSet' FlagDisablePact420 RDV0 RDV1
+      rdv <- ifExecutionFlagSet' FlagDisablePact42 RDV0 RDV1
       success "Write succeeded" $ writeRow (_faInfo i) wt (userTable table) (RowKey key) $
           RowData rdv (pactValueToRowData <$> ps')
     _ -> argsError i ts

src/Pact/PersistPactDb/Regression.hs

@@ -23,8 +23,6 @@ import Pact.Types.Runtime
 import Pact.Persist.Pure (initPureDb,persister,PureDb)
 import Data.Aeson
 import Pact.Types.Logger
-import Pact.Types.KeySet (KeysetPublicKey(KeysetPublicKey))
-import Pact.Types.Scheme (PPKScheme(ED25519))
 import Pact.Types.PactValue
 import Pact.Repl
 import Pact.Repl.Types
@@ -81,7 +79,7 @@ runRegression p = do
   let row' = RowData RDV1 $ ObjectMap $ fmap pactValueToRowData $ M.fromList [("gah",toPV False),("fh",toPV (1 :: Int))]
   _writeRow pactdb Update usert "key1" row' v
   assertEquals' "user update" (Just row') (_readRow pactdb usert "key1" v)
-  let ks = mkKeySet [KeysetPublicKey (PublicKeyText "skdjhfskj") ED25519] "predfun"
+  let ks = mkKeySet [PublicKeyText "skdjhfskj"] "predfun"
   _writeRow pactdb Write KeySets "ks1" ks v
   assertEquals' "keyset write" (Just ks) $ _readRow pactdb KeySets "ks1" v
   (modName,modRef,mod') <- loadModule

src/Pact/Repl/Lib.hs

@@ -66,8 +66,6 @@ import Pact.Persist.Pure
 import Pact.PersistPactDb
 import Pact.Types.Logger
 import Pact.Types.Pretty
-import Pact.Types.KeySet (KeysetPublicKey(KeysetPublicKey, _pkPublicKey, _pkCryptoScheme))
-import Pact.Types.Scheme (PPKScheme(ED25519))
 import Pact.Repl.Types
 import Pact.Native.Capabilities (evalCap)
 import Pact.Gas.Table
@@ -334,17 +332,12 @@ mockSPV i as = case as of
   _ -> argsError i as
 
 
--- TOOD: Support webauthn keys with a different set of arguments.
--- A list of objects [{"public": KEY, "scheme": "ED25519"|"WebAuthn"}]
 setsigs :: RNativeFun LibState
 setsigs i [TList ts _ _] = do
   ks <- forM ts $ \t -> case t of
-          (TLitString s) -> return (KeysetPublicKey
-                                    { _pkPublicKey = PublicKeyText s
-                                    , _pkCryptoScheme = ED25519
-                                    })
+          (TLitString s) -> return s
           _ -> argsError i (V.toList ts)
-  setenv eeMsgSigs $ M.fromList $ (,mempty) <$> V.toList ks
+  setenv eeMsgSigs $ M.fromList ((,mempty) . PublicKeyText <$> V.toList ks)
   return $ tStr "Setting transaction keys"
 setsigs i as = argsError i as
 
@@ -356,14 +349,10 @@ setsigs' _ [TList ts _ _] = do
         (Just k'',Just (TList clist _ _)) -> do
           reduce k'' >>= \k' -> case k' of
             TLitString k -> do
-              let pk = KeysetPublicKey
-                        { _pkPublicKey = PublicKeyText k
-                        , _pkCryptoScheme = ED25519
-                        }
               caps <- forM clist $ \cap -> case cap of
                 (TApp a _) -> view _1 <$> appToCap a
                 o -> evalError' o $ "Expected capability invocation"
-              return (pk, S.fromList (V.toList caps))
+              return (PublicKeyText k,S.fromList (V.toList caps))
             _ -> evalError' k' "Expected string value"
         _ -> evalError' t "Expected object with 'key': string, 'caps': [capability]"
     _ -> evalError' t $ "Expected object"

src/Pact/Runtime/Capabilities.hs

@@ -40,7 +40,6 @@ import Data.Text (Text)
 import qualified Data.Map.Strict as M
 import qualified Data.Set as S
 
-import Pact.Types.KeySet (KeysetPublicKey)
 import Pact.Types.Capability
 import Pact.Types.PactValue
 import Pact.Types.Pretty
@@ -265,8 +264,8 @@ revokeAllCapabilities = evalCapabilities .= def
 
 -- | Check signature caps against current granted set.
 checkSigCaps
-  :: M.Map KeysetPublicKey (S.Set UserCapability)
-     -> Eval e (M.Map KeysetPublicKey (S.Set UserCapability))
+  :: M.Map PublicKeyText (S.Set UserCapability)
+     -> Eval e (M.Map PublicKeyText (S.Set UserCapability))
 checkSigCaps sigs = go
   where
     go = do