Fix captoken codec, add SigCapability, move Signer to its own module

pact-request-api/Pact/Core/Command/Client.hs

@@ -69,7 +69,6 @@ import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Short as SBS
 import GHC.Generics
 
-import Pact.Core.Capabilities
 import Pact.Core.ChainData
 import Pact.Core.Command.RPC
 import Pact.Core.Command.Types
@@ -83,6 +82,7 @@ import Pact.Core.StableEncoding
 import Pact.Core.Gas
 import Pact.Core.Hash
 import Pact.Core.SPV
+import Pact.Core.Signer
 import qualified Pact.Core.Hash as PactHash
 import Pact.Core.Command.SigData
 
@@ -97,7 +97,7 @@ data ApiKeyPair = ApiKeyPair {
   _akpPublic :: Maybe PublicKeyBS,
   _akpAddress :: Maybe Text,
   _akpScheme :: Maybe PPKScheme,
-  _akpCaps :: Maybe [CapToken QualifiedName PactValue]
+  _akpCaps :: Maybe [SigCapability]
   } deriving (Eq, Show, Generic)
 
 instance JD.FromJSON ApiKeyPair where
@@ -106,7 +106,7 @@ instance JD.FromJSON ApiKeyPair where
     pub <- o JD..:? "public"
     addr <- o JD..: "address"
     scheme <- o JD..:? "scheme"
-    caps <- ((fmap.fmap) _stableEncoding <$> o JD..:? "caps")
+    caps <- o JD..:? "caps"
     pure $ ApiKeyPair
       {_akpSecret = secret
       , _akpPublic = pub
@@ -120,7 +120,7 @@ instance J.Encode ApiKeyPair where
     [ "address" J..= _akpAddress o
     , "secret" J..= _akpSecret o
     , "scheme" J..= _akpScheme o
-    , "caps" J..= fmap (J.Array . fmap StableEncoding) (_akpCaps o)
+    , "caps" J..= fmap J.Array (_akpCaps o)
     , "public" J..= _akpPublic o
     ]
   {-# INLINE build #-}
@@ -133,15 +133,15 @@ data ApiSigner = ApiSigner {
   _asPublic :: Text,
   _asAddress :: Maybe Text,
   _asScheme :: Maybe PPKScheme,
-  _asCaps :: Maybe [CapToken QualifiedName PactValue]
+  _asCaps :: Maybe [SigCapability]
   } deriving (Eq, Show, Generic)
 
 instance JD.FromJSON ApiSigner where
   parseJSON = JD.withObject "ApiSigner" $ \o -> do
     pub <- o JD..: "public"
     addr <- o JD..:? "address"
     scheme <- o JD..:? "scheme"
-    caps <- ((fmap.fmap) _stableEncoding <$> o JD..:? "caps")
+    caps <- o JD..:? "caps"
     pure $ ApiSigner
       { _asPublic = pub
       , _asAddress = addr
@@ -153,7 +153,7 @@ instance J.Encode ApiSigner where
   build o = J.object
     [ "address" J..= _asAddress o
     , "scheme" J..= _asScheme o
-    , "caps" J..= fmap (J.Array . fmap StableEncoding) (_asCaps o)
+    , "caps" J..= fmap J.Array (_asCaps o)
     , "public" J..= _asPublic o
     ]
   {-# INLINE build #-}
@@ -533,8 +533,8 @@ signCmd keyFiles bs = do
 withKeypairsOrSigner
   :: Bool
   -> ApiReq
-  -> ([(DynKeyPair, [CapToken QualifiedName PactValue])] -> IO a)
-  -> ([Signer QualifiedName PactValue] -> IO a)
+  -> ([(DynKeyPair, [SigCapability])] -> IO a)
+  -> ([Signer] -> IO a)
   -> IO a
 withKeypairsOrSigner unsignedReq ApiReq{..} keypairAction signerAction =
   case (_ylSigners,_ylKeyPairs,unsignedReq) of
@@ -610,7 +610,7 @@ mkExec
     -- ^ optional environment data
   -> PublicMeta
     -- ^ public metadata
-  -> [(DynKeyPair, [CapToken QualifiedName PactValue])]
+  -> [(DynKeyPair, [SigCapability])]
     -- ^ signing keypairs + caplists
   -> [Verifier ParsedVerifierProof]
     -- ^ verifiers
@@ -639,7 +639,7 @@ mkUnsignedExec
     -- ^ optional environment data
   -> PublicMeta
     -- ^ public metadata
-  -> [Signer QualifiedName PactValue]
+  -> [Signer]
     -- ^ payload signers
   -> [Verifier ParsedVerifierProof]
     -- ^ payload verifiers
@@ -703,7 +703,7 @@ mkCont
     -- ^ environment data
   -> PublicMeta
     -- ^ command public metadata
-  -> [(DynKeyPair, [CapToken QualifiedName PactValue])]
+  -> [(DynKeyPair, [SigCapability])]
     -- ^ signing keypairs
   -> [Verifier ParsedVerifierProof]
     -- ^ verifiers
@@ -739,7 +739,7 @@ mkUnsignedCont
     -- ^ environment data
   -> PublicMeta
     -- ^ command public metadata
-  -> [Signer QualifiedName PactValue]
+  -> [Signer]
     -- ^ payload signers
   -> [Verifier ParsedVerifierProof]
     -- ^ verifiers
@@ -779,14 +779,14 @@ mkCommand creds vers meta nonce nid rpc = mkCommand' creds encodedPayload
     encodedPayload = J.encodeStrict payload
 
 
-keyPairToSigner :: Ed25519KeyPair -> [UserCapability] -> Signer QualifiedName PactValue
+keyPairToSigner :: Ed25519KeyPair -> [UserCapability] -> Signer
 keyPairToSigner cred caps = Signer scheme pub addr caps
       where
         scheme = Nothing
         pub = toB16Text $ exportEd25519PubKey $ fst cred
         addr = Nothing
 
-keyPairsToSigners :: [Ed25519KeyPairCaps] -> [Signer QualifiedName PactValue]
+keyPairsToSigners :: [Ed25519KeyPairCaps] -> [Signer]
 keyPairsToSigners creds = map (uncurry keyPairToSigner) creds
 
 signHash :: PactHash.Hash -> Ed25519KeyPair -> Text
@@ -797,7 +797,7 @@ signHash hsh (pub,priv) =
 mkUnsignedCommand
   :: J.Encode m
   => J.Encode c
-  => [Signer QualifiedName PactValue]
+  => [Signer]
   -> [Verifier ParsedVerifierProof]
   -> m
   -> Text
@@ -849,7 +849,7 @@ mkCommandWithDynKeys' creds env = do
 mkCommandWithDynKeys
   :: J.Encode c
   => J.Encode m
-  => [(DynKeyPair, [UserCapability])]
+  => [(DynKeyPair, [SigCapability])]
   -> [Verifier ParsedVerifierProof]
   -> m
   -> Text
@@ -881,7 +881,7 @@ mkCommandWithDynKeys creds vers meta nonce nid rpc = mkCommandWithDynKeys' creds
             , _siCapList = caps
             }
 
-type UserCapability = CapToken QualifiedName PactValue
+type UserCapability = SigCapability
 
 -- | A utility function for handling the common case of commands
 -- with no verifiers. `None` is distinguished from `Just []` in
@@ -895,15 +895,15 @@ nonemptyVerifiers vs = Just vs
 -- Parse `APIKeyPair`s into Ed25519 keypairs and WebAuthn keypairs.
 -- The keypairs must not be prefixed with "WEBAUTHN-", it accepts
 -- only the raw (unprefixed) keys.
-mkKeyPairs :: [ApiKeyPair] -> IO [(DynKeyPair, [CapToken QualifiedName PactValue])]
+mkKeyPairs :: [ApiKeyPair] -> IO [(DynKeyPair, [SigCapability])]
 mkKeyPairs keyPairs = traverse mkPair keyPairs
   where
 
         importValidKeyPair
           :: Maybe PublicKeyBS
           -> PrivateKeyBS
-          -> Maybe [CapToken QualifiedName PactValue]
-          -> Either String (Ed25519KeyPair, [CapToken QualifiedName PactValue])
+          -> Maybe [SigCapability]
+          -> Either String (Ed25519KeyPair, [SigCapability])
         importValidKeyPair pubEd25519 privEd25519 caps = fmap (,maybe [] id caps) $
           importEd25519KeyPair pubEd25519 privEd25519
 
@@ -913,7 +913,7 @@ mkKeyPairs keyPairs = traverse mkPair keyPairs
           Just ED25519 -> True
           _ -> False
 
-        mkPair :: ApiKeyPair -> IO (DynKeyPair, [CapToken QualifiedName PactValue])
+        mkPair :: ApiKeyPair -> IO (DynKeyPair, [SigCapability])
         mkPair akp = case (_akpScheme akp, _akpPublic akp, _akpSecret akp, _akpAddress akp) of
           (scheme, pub, priv, Nothing) | isEd25519 scheme ->
             either dieAR (return . first DynEd25519KeyPair) (importValidKeyPair pub priv (_akpCaps akp))

pact-request-api/Pact/Core/Command/Types.hs

@@ -82,12 +82,12 @@ import Pact.Core.Compile
 import Pact.Core.DefPacts.Types
 import Pact.Core.Guards
 import Pact.Core.Gas.Types
-import Pact.Core.Names
 import qualified Pact.Core.Hash as PactHash
 import Pact.Core.Persistence.Types
 import Pact.Core.PactValue (PactValue(..))
 import Pact.Core.Command.RPC
 import Pact.Core.StableEncoding
+import Pact.Core.Signer
 import qualified Pact.Core.Syntax.ParseTree as Lisp
 import Pact.Core.Verifiers
 
@@ -137,10 +137,6 @@ instance (NFData a,NFData m) => NFData (ProcessedCommand m a)
 
 type Ed25519KeyPairCaps = (Ed25519KeyPair ,[SigCapability])
 
--- These two types in legacy pact had the same definition and
--- JSON encoding. Can they be unified?
-type SigCapability = CapToken QualifiedName PactValue
-
 
 -- | Pair parsed Pact expressions with the original text.
 data ParsedCode = ParsedCode
@@ -175,12 +171,12 @@ verifyCommand orig@Command{..} =
 
     verifiedHash = PactHash.verifyHash _cmdHash _cmdPayload
 
-hasInvalidSigs :: PactHash.Hash -> [UserSig] -> [Signer QualifiedName PactValue] -> Maybe String
+hasInvalidSigs :: PactHash.Hash -> [UserSig] -> [Signer] -> Maybe String
 hasInvalidSigs hsh sigs signers
   | not (length sigs == length signers)  = Just "Number of sig(s) does not match number of signer(s)"
   | otherwise                            = verifyUserSigs hsh (zip sigs signers)
 
-verifyUserSigs :: PactHash.Hash -> [(UserSig, Signer QualifiedName PactValue)] -> Maybe String
+verifyUserSigs :: PactHash.Hash -> [(UserSig, Signer)] -> Maybe String
 verifyUserSigs hsh sigsAndSigners
   | null failedSigs = Nothing
   | otherwise = formatIssues
@@ -191,7 +187,7 @@ verifyUserSigs hsh sigsAndSigners
   failedSigs = concatMap getFailedVerify sigsAndSigners
   formatIssues = Just $ "Invalid sig(s) found: " ++ show (J.encode . J.Object $ failedSigs)
 
-verifyUserSig :: PactHash.Hash -> UserSig -> Signer QualifiedName PactValue -> Either String ()
+verifyUserSig :: PactHash.Hash -> UserSig -> Signer -> Either String ()
 verifyUserSig msg sig Signer{..} = do
   case (sig, scheme) of
     (ED25519Sig edSig, ED25519) -> do
@@ -231,7 +227,7 @@ data Payload m c = Payload
   { _pPayload :: !(PactRPC c)
   , _pNonce :: !Text
   , _pMeta :: !m
-  , _pSigners :: ![Signer QualifiedName PactValue]
+  , _pSigners :: ![Signer]
   , _pVerifiers :: !(Maybe [Verifier ParsedVerifierProof])
   , _pNetworkId :: !(Maybe NetworkId)
   } deriving (Show, Eq, Generic, Functor, Foldable, Traversable)
@@ -241,7 +237,7 @@ instance (J.Encode a, J.Encode m) => J.Encode (Payload m a) where
   build o = J.object
     [ "networkId" J..= fmap _networkId (_pNetworkId o)
     , "payload" J..= _pPayload o
-    , "signers" J..= J.Array (StableEncoding <$> _pSigners o)
+    , "signers" J..= J.Array (_pSigners o)
     , "verifiers" J..?= fmap J.Array (_pVerifiers o)
     , "meta" J..= _pMeta o
     , "nonce" J..= _pNonce o
@@ -256,7 +252,7 @@ instance (FromJSON a,FromJSON m) => FromJSON (Payload m a) where
     signers <- o .: "signers"
     verifiers <- o .:? "verifiers"
     networkId <- o .:? "networkId"
-    pure $ Payload payload nonce' meta (_stableEncoding <$> signers) verifiers (fmap NetworkId networkId)
+    pure $ Payload payload nonce' meta signers verifiers (fmap NetworkId networkId)
 
 data PactResult err
   = PactResultOk PactValue

pact-tests/Pact/Core/Test/SignatureSchemeTests.hs

@@ -16,16 +16,15 @@ import qualified Data.ByteString          as BS
 import qualified Control.Lens             as Lens
 import qualified Data.ByteString.Base16   as B16
 
-import Pact.Core.Capabilities
 import Pact.Core.Command.Types
 import Pact.Core.Command.Crypto
 import Pact.Core.Command.Client
 import qualified Pact.JSON.Encode as J
-import Pact.Core.Names
 import Pact.Core.PactValue
 import Pact.Core.Hash
 import Pact.Core.Command.RPC
 import Pact.Core.Command.Util
+import Pact.Core.Signer
 
 
 ---- HELPER DATA TYPES AND FUNCTIONS ----
@@ -72,17 +71,17 @@ toApiKeyPairs kps = map makeAKP kps
           ApiKeyPair priv (Just pub) add (Just scheme) Nothing
 
 
-mkCommandTest :: [(DynKeyPair, [CapToken QualifiedName PactValue])] -> [Signer QualifiedName PactValue] -> Text -> IO (Command ByteString)
+mkCommandTest :: [(DynKeyPair, [SigCapability])] -> [Signer] -> Text -> IO (Command ByteString)
 mkCommandTest kps signers code = mkCommandWithDynKeys' kps $ toExecPayload signers code
 
 
-toSigners :: [(PublicKeyBS, PrivateKeyBS, Address, PPKScheme)] -> IO [Signer QualifiedName PactValue ]
+toSigners :: [(PublicKeyBS, PrivateKeyBS, Address, PPKScheme)] -> IO [Signer]
 toSigners kps = return $ map makeSigner kps
   where makeSigner (PubBS pub, _, add, scheme) =
           Signer (Just scheme) (toB16Text pub) add []
 
 
-toExecPayload :: [Signer QualifiedName PactValue] -> Text -> ByteString
+toExecPayload :: [Signer] -> Text -> ByteString
 toExecPayload signers t = J.encodeStrict payload
   where
     payload = Payload (Exec (ExecMsg t $ PUnit)) "nonce" (J.Aeson ()) signers Nothing Nothing

pact-tng.cabal

@@ -114,6 +114,7 @@ common pact-common
   default-extensions:
     OverloadedStrings
     DeriveGeneric
+    DerivingStrategies
     ViewPatterns
     LambdaCase
     TupleSections
@@ -257,6 +258,7 @@ library
     Pact.Core.Verifiers
     Pact.Core.Interpreter
     Pact.Core.DeriveConTag
+    Pact.Core.Signer
 
      -- Syntax modules
     Pact.Core.Syntax.ParseTree

pact/Pact/Core/Capabilities.hs

@@ -4,7 +4,6 @@
 {-# LANGUAGE GADTs #-}
 {-# LANGUAGE StrictData #-}
 
-
 module Pact.Core.Capabilities
  ( DefCapMeta(..)
  , DefManagedMeta(..)
@@ -21,7 +20,6 @@ module Pact.Core.Capabilities
  , ManagedCapType(..)
  , PactEvent(..)
  , dcMetaFqName
- , Signer(..)
  , getManagedParam
  ) where
 
@@ -36,7 +34,6 @@ import GHC.Generics
 import Pact.Core.Pretty
 import Pact.Core.Names
 import Pact.Core.Hash ( ModuleHash )
-import Pact.Core.Scheme
 
 data DefManagedMeta name
   = DefManagedMeta (Int, Text) name
@@ -132,24 +129,13 @@ makeLenses ''CapToken
 makeLenses ''CapSlot
 makeLenses ''ManagedCap
 
--- | Signer combines PPKScheme, PublicKey, and the Address (aka the
---   formatted PublicKey).
-data Signer name v = Signer
- { _siScheme :: !(Maybe PPKScheme)
- -- ^ PPKScheme, which is defaulted to 'defPPKScheme' if not present
- , _siPubKey :: !Text
- -- ^ pub key value
- , _siAddress :: !(Maybe Text)
- -- ^ optional "address", for different pub key formats like ETH
- , _siCapList :: [CapToken name v]
- -- ^ clist for designating signature to specific caps
- } deriving (Eq, Ord, Show, Generic)
+
 
 instance (Pretty name, Pretty v) => Pretty (CapToken name v) where
   pretty (CapToken qn args) =
     pretty $ PrettyLispApp qn args
 
-instance (NFData name, NFData v) => NFData (Signer name v)
+
 instance (NFData name, NFData v) => NFData (ManagedCap name v)
 instance NFData v => NFData (ManagedCapType v)
 instance NFData v => NFData (PactEvent v)

pact/Pact/Core/Evaluate.hs

@@ -60,6 +60,7 @@ import Pact.Core.IR.Desugar
 import Pact.Core.Verifiers
 import Pact.Core.Interpreter
 import Pact.Core.Info
+import Pact.Core.Signer
 import qualified Pact.Core.IR.Eval.CEK as Eval
 import qualified Pact.Core.IR.Eval.Direct.Evaluator as Direct
 import qualified Pact.Core.Syntax.Lexer as Lisp
@@ -102,7 +103,7 @@ evalDirectInterpreter =
 data MsgData = MsgData
   { mdData :: !PactValue
   , mdHash :: !Hash
-  , mdSigners :: [Signer QualifiedName PactValue]
+  , mdSigners :: [Signer]
   , mdVerifiers :: [Verifier ()]
   }
 
@@ -178,7 +179,7 @@ setupEvalEnv pdb mode msgData gasModel' np spv pd efs = do
   mkMsgSigs ss = M.fromList $ map toPair ss
     where
     toPair (Signer _scheme pubK addr capList) =
-      (PublicKeyText (fromMaybe pubK addr),S.fromList capList)
+      (PublicKeyText (fromMaybe pubK addr),S.fromList (_sigCapability <$> capList))
   mkMsgVerifiers vs = M.fromListWith S.union $ map toPair vs
     where
     toPair (Verifier vfn _ caps) = (vfn, S.fromList caps)