From 2d13b5075fa936f5abdf3e7cd194d7bb450d4197 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Enis=20Bayramo=C4=9Flu?= Date: Fri, 26 Apr 2024 17:12:44 +0200 Subject: [PATCH] Update to latest pact (v4.11) --- cabal.project | 48 ++++++++++------------ flake.lock | 82 +++++++++++++++++++++++++++----------- flake.nix | 2 +- kda-tool.cabal | 3 +- src/AppMain.hs | 4 +- src/Commands/GenTx.hs | 3 +- src/Commands/Keygen.hs | 7 ++-- src/Commands/Local.hs | 3 +- src/Commands/Poll.hs | 3 +- src/Commands/Send.hs | 3 +- src/Commands/Sign.hs | 5 ++- src/Commands/WalletSign.hs | 5 ++- src/Kadena/SigningApi.hs | 3 -- src/Kadena/SigningTypes.hs | 45 ++++++++++++++++----- src/Keys.hs | 7 ++-- src/TxTemplate.hs | 6 +-- src/Types/Encoding.hs | 8 ++-- src/Types/Env.hs | 5 ++- src/Types/TxInputs.hs | 25 +++++++++--- src/Utils.hs | 15 +++++-- 20 files changed, 184 insertions(+), 98 deletions(-) diff --git a/cabal.project b/cabal.project index b224ae4..6cb925c 100644 --- a/cabal.project +++ b/cabal.project @@ -7,15 +7,15 @@ package pact source-repository-package type: git - location: https://github.com/mightybyte/HsYAML.git - tag: 2ad3cbd1c84f8ab362cf1f5fd4bb3e869dfcc102 - --sha256: 1cmwavqz7vdpjvfybxbjphnw7448xy0353wmy9h29ix24lv8w7rr + location: https://github.com/kadena-io/HsYAML.git + tag: b3c49dbceb39733dfc07c22f2097d3c74fc86e74 + --sha256: sha256-lnnUni7D949nM4faMrORMetZi5wJy2Qhchm9ne6Cqv8= source-repository-package type: git - location: https://github.com/mightybyte/HsYAML-aeson.git - tag: 077110e5e52dc91d593c546dd1baaafd3066558d - --sha256: 1r91ldq4sb49wqg1agvbjj21z6nwiyk3yx4r80arz0fhcv083czv + location: https://github.com/kadena-io/HsYAML-aeson.git + tag: 84292468200166b96ff4e8c7324ee01e6ab6d181 + --sha256: sha256-zaDcqwSs4ASb7PO3+E9oGzmSXlSt7bL1NiP0red7CiY= source-repository-package type: git @@ -26,29 +26,23 @@ source-repository-package source-repository-package type: git location: https://github.com/kadena-io/chainweb-api.git - tag: b3e28d62c622ebda0d84e136ea6c995d5f97e46f - --sha256: 1m9x9n5mwmv97fkv2z3hvlhlj59xm2mpsc816hzriw28pv1jb9zh + tag: 1b2de025cfdc09698bfb1ec3807cd85405d6a339 + --sha256: sha256-06jvD1kmkmthcRkyWhVLTbytwabghInxqXQD/Lm7kbA= source-repository-package type: git - location: https://github.com/pcapriotti/optparse-applicative - tag: 9399fd0f745e4d4d71e8bba03d402648b767363c - --sha256: 0gkgccix898mafrs25fajqwxbb7zmg30livrj7b79knd6a5sqj76 + location: https://github.com/kadena-io/pact.git + tag: a1c7906efbf32095883e71594a53a21162fbe5a7 + --sha256: sha256-Mtgz/ilxa81TDUoBKQv5x3BlOftFjNV1Ak0uYzSguNQ= source-repository-package - type: git - location: https://github.com/kadena-io/pact.git - tag: 83c5944991d6edcd34d79f9fbf8e537d060689c6 - --sha256: 0l59xi2by6l6gi10r8c437m7ics29215zr0zl1syyr3039vgmv0x - -allow-newer: hashable:base -allow-newer: chainweb-api:aeson - --- bounds from pact -constraints: aeson <2 -constraints: base16-bytestring <1 -constraints: base64-bytestring <1.1 -constraints: hashable <1.3.1 -constraints: prettyprinter <1.6.1 -constraints: unordered-containers <0.2.16 -constraints: tls <1.7.0 + type: git + location: https://github.com/kadena-io/pact-json.git + tag: 1d260bfaa48312b54851057885de4c43c420e35f + --sha256: 0fzq4mzaszj5clvixx9mn1x6r4dcrnwvbl2znd0p5mmy5h2jr0hh + +source-repository-package + type: git + location: https://github.com/kadena-io/kadena-ethereum-bridge.git + tag: a32d901e4a79be62af9c27c01152c9a4c3912a62 + --sha256: sha256-xdawv/tdjh61MbJKcBqm9Fje36+gVljuZsAxOTX1gP0= \ No newline at end of file diff --git a/flake.lock b/flake.lock index 451b17c..952eeb4 100644 --- a/flake.lock +++ b/flake.lock @@ -69,11 +69,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1696379114, - "narHash": "sha256-dtax/ci3JfYvR2lLsvpvC6b3NCoEGZLrDH21/2svTps=", + "lastModified": 1707870123, + "narHash": "sha256-pOvz6uuPYw3CiPgi63QhNYumoKeyzDh9JOkLDngGWsE=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "21eae6f46c91831741496101e541e628aadecd98", + "rev": "75345eba5d4159e6f54cbdc38785d1e0d0e655e0", "type": "github" }, "original": { @@ -109,7 +109,7 @@ "hs-nix-infra", "empty" ], - "ghc980": [ + "ghc98X": [ "hs-nix-infra", "empty" ], @@ -133,7 +133,19 @@ "hs-nix-infra", "empty" ], - "hls-2.3": "hls-2.3", + "hls-2.3": [ + "hs-nix-infra", + "empty" + ], + "hls-2.4": [ + "hs-nix-infra", + "empty" + ], + "hls-2.5": [ + "hs-nix-infra", + "empty" + ], + "hls-2.6": "hls-2.6", "hpc-coveralls": [ "hs-nix-infra", "empty" @@ -146,6 +158,7 @@ "hs-nix-infra", "empty" ], + "nix-tools-static": "nix-tools-static", "nixpkgs": [ "hs-nix-infra", "haskellNix", @@ -175,6 +188,10 @@ "hs-nix-infra", "empty" ], + "nixpkgs-2311": [ + "hs-nix-infra", + "empty" + ], "nixpkgs-unstable": "nixpkgs-unstable", "old-ghc-nix": [ "hs-nix-infra", @@ -186,11 +203,11 @@ ] }, "locked": { - "lastModified": 1697195891, - "narHash": "sha256-0L803S/wcHmVebEwFxObYCYOaB14ZtBAFCdg0aRgH70=", + "lastModified": 1707876653, + "narHash": "sha256-hsj9chw/cy9h8XuxQkxnfFR22Ek8xEm33aON2+TcUaI=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "c6cb3ff56b001b211690da35f70827fab5bf3272", + "rev": "d1a608f84c9ed00ceca8571b253e79f67a1ae2d6", "type": "github" }, "original": { @@ -199,19 +216,19 @@ "type": "github" } }, - "hls-2.3": { + "hls-2.6": { "flake": false, "locked": { - "lastModified": 1695910642, - "narHash": "sha256-tR58doOs3DncFehHwCLczJgntyG/zlsSd7DgDgMPOkI=", + "lastModified": 1705325287, + "narHash": "sha256-+P87oLdlPyMw8Mgoul7HMWdEvWP/fNlo8jyNtwME8E8=", "owner": "haskell", "repo": "haskell-language-server", - "rev": "458ccdb55c9ea22cd5d13ec3051aaefb295321be", + "rev": "6e0b342fa0327e628610f2711f8c3e4eaaa08b1e", "type": "github" }, "original": { "owner": "haskell", - "ref": "2.3.0.0", + "ref": "2.6.0.0", "repo": "haskell-language-server", "type": "github" } @@ -226,11 +243,11 @@ "nixpkgs-rec": "nixpkgs-rec" }, "locked": { - "lastModified": 1699970998, - "narHash": "sha256-NgvBCRIB+lvcxJWMpU8Mulx8PG8s5jtqSR8K/natoTA=", + "lastModified": 1708100161, + "narHash": "sha256-rWwE59SfmqXcVQL7GXovYvjbDPMsb4e1GgiNH+7tlrM=", "owner": "kadena-io", "repo": "hs-nix-infra", - "rev": "a69071dafa3f0d12edf30ecc5a562aee1f7d138d", + "rev": "bcbf823a0851b41d64d4f9c87053abc3153c126e", "type": "github" }, "original": { @@ -255,19 +272,36 @@ "type": "github" } }, + "nix-tools-static": { + "flake": false, + "locked": { + "lastModified": 1706266250, + "narHash": "sha256-9t+GRk3eO9muCtKdNAwBtNBZ5dH1xHcnS17WaQyftwA=", + "owner": "input-output-hk", + "repo": "haskell-nix-example", + "rev": "580cb6db546a7777dad3b9c0fa487a366c045c4e", + "type": "github" + }, + "original": { + "owner": "input-output-hk", + "ref": "nix", + "repo": "haskell-nix-example", + "type": "github" + } + }, "nixpkgs": { "locked": { - "lastModified": 1669833724, - "narHash": "sha256-/HEZNyGbnQecrgJnfE8d0WC5c1xuPSD2LUpB6YXlg4c=", + "lastModified": 1694822471, + "narHash": "sha256-6fSDCj++lZVMZlyqOe9SIOL8tYSBz1bI8acwovRwoX8=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "4d2b37a84fad1091b9de401eb450aae66f1a741e", + "rev": "47585496bcb13fb72e4a90daeea2f434e2501998", "type": "github" }, "original": { "owner": "NixOS", "repo": "nixpkgs", - "rev": "4d2b37a84fad1091b9de401eb450aae66f1a741e", + "rev": "47585496bcb13fb72e4a90daeea2f434e2501998", "type": "github" } }, @@ -289,17 +323,17 @@ }, "nixpkgs-unstable": { "locked": { - "lastModified": 1695318763, - "narHash": "sha256-FHVPDRP2AfvsxAdc+AsgFJevMz5VBmnZglFUMlxBkcY=", + "lastModified": 1694822471, + "narHash": "sha256-6fSDCj++lZVMZlyqOe9SIOL8tYSBz1bI8acwovRwoX8=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "e12483116b3b51a185a33a272bf351e357ba9a99", + "rev": "47585496bcb13fb72e4a90daeea2f434e2501998", "type": "github" }, "original": { "owner": "NixOS", - "ref": "nixpkgs-unstable", "repo": "nixpkgs", + "rev": "47585496bcb13fb72e4a90daeea2f434e2501998", "type": "github" } }, diff --git a/flake.nix b/flake.nix index b3e50a7..c319d27 100644 --- a/flake.nix +++ b/flake.nix @@ -12,7 +12,7 @@ kdaToolProject = final.haskell-nix.project' { src = ./.; - compiler-nix-name = "ghc8107"; + compiler-nix-name = "ghc964"; shell.tools = { cabal = {}; }; diff --git a/kda-tool.cabal b/kda-tool.cabal index aca044e..1dec825 100644 --- a/kda-tool.cabal +++ b/kda-tool.cabal @@ -45,7 +45,7 @@ library Decimal , HsYAML , HsYAML-aeson - , aeson < 2 + , aeson , async , attoparsec , base >= 4.13 && < 5 @@ -80,6 +80,7 @@ library , network-uri , optparse-applicative , pact + , pact-json , process , resource-pool , retry diff --git a/src/AppMain.hs b/src/AppMain.hs index 47f8d0d..a327df2 100644 --- a/src/AppMain.hs +++ b/src/AppMain.hs @@ -9,11 +9,11 @@ module AppMain where import Control.Monad.IO.Class import Data.Aeson import Data.Default +import Data.String (fromString) import Katip import Network.HTTP.Client hiding (withConnection) import Network.HTTP.Client.TLS import Options.Applicative -import Options.Applicative.Help.Pretty hiding (()) import System.Directory import System.FilePath import System.IO @@ -81,7 +81,7 @@ appMain = do , header "kda - Command line tool for interacting with the Kadena blockchain" , footerDoc (Just theFooter) ] - theFooter = string $ unlines + theFooter = fromString $ unlines [ "Run the following command to enable tab completion:" , "" , "source <(kda --bash-completion-script `which kda`)" diff --git a/src/Commands/GenTx.hs b/src/Commands/GenTx.hs index d60de9a..b7ef37a 100644 --- a/src/Commands/GenTx.hs +++ b/src/Commands/GenTx.hs @@ -27,6 +27,7 @@ import Network.HTTP.Client.TLS import Network.HTTP.Types.Status --import Pact.ApiReq import qualified Pact.ApiReq as Pact +import qualified Pact.JSON.Encode as J import Pact.Types.Command import Pact.Types.SigData import System.IO @@ -100,7 +101,7 @@ genFromContents op tplContents useOldOutput = do cmds :: [Command Text] <- mapM (fmap snd . lift . Pact.mkApiReqCmd True "") apiReqs let chooseFormat i = if useOldOutput - then pure $ encodeText i + then pure $ encodeText $ J.toJsonViaEncode i else fmap encodeText $ sdToCsd i let outs :: [Text] = catMaybes $ map (chooseFormat <=< hush . commandToSigData) cmds let outPat = maybe (defaultOutPat augmentedVars) T.pack $ _genData_outFilePat gd diff --git a/src/Commands/Keygen.hs b/src/Commands/Keygen.hs index 517298a..d03cf14 100644 --- a/src/Commands/Keygen.hs +++ b/src/Commands/Keygen.hs @@ -15,15 +15,16 @@ import Pact.Types.Crypto import Keys import Types.KeyType import Utils +import Data.Base16.Types (extractBase16) ------------------------------------------------------------------------------ keygenCommand :: KeyType -> IO () keygenCommand kt = do case kt of Plain -> do - kp <- genKeyPair defaultScheme - putStrLn $ "public: " ++ T.unpack (encodeBase16 $ getPublic kp) - putStrLn $ "secret: " ++ T.unpack (encodeBase16 $ getPrivate kp) + kp <- genKeyPair + putStrLn $ "public: " ++ T.unpack (extractBase16 $ encodeBase16 $ getPublic kp) + putStrLn $ "secret: " ++ T.unpack (extractBase16 $ encodeBase16 $ getPrivate kp) HD -> do let toPhrase = T.unwords . M.elems . mkPhraseMapFromMnemonic let prettyErr err = "ERROR generating menmonic: " <> tshow err diff --git a/src/Commands/Local.hs b/src/Commands/Local.hs index 4334cab..051005d 100644 --- a/src/Commands/Local.hs +++ b/src/Commands/Local.hs @@ -11,6 +11,7 @@ import Control.Lens hiding ((.=)) import Control.Monad import Control.Monad.Trans import Data.Aeson +import Data.Aeson.Key import Data.Aeson.Lens import Data.Bifunctor import qualified Data.ByteString.Lazy as LB @@ -47,7 +48,7 @@ localCommand e (LocalCmdArgs args verifySigs shortOutput) = do printf "%s: testing %d commands on %d chains\n" (schemeHostPortToText shp) (length txs) (length groups) responses <- lift $ mapM (localNodeQuery le verifySigs n) txs - pure $ schemeHostPortToText shp .= map responseToValue responses + pure $ fromText (schemeHostPortToText shp) .= map responseToValue responses case res of Left er -> putStrLn er >> exitFailure Right results -> do diff --git a/src/Commands/Poll.hs b/src/Commands/Poll.hs index f16a592..dc7c05c 100644 --- a/src/Commands/Poll.hs +++ b/src/Commands/Poll.hs @@ -10,6 +10,7 @@ import Control.Error import Control.Monad import Control.Monad.Trans import Data.Aeson +import Data.Aeson.Key import Data.Bifunctor import qualified Data.ByteString.Lazy as LB import Data.Function @@ -46,7 +47,7 @@ pollCommand e args = do printf "%s: polling %d commands to %d chains\n" (schemeHostPortToText shp) (length txs) (length groups) responses <- lift $ mapM (\ts -> pollNode le n (txChain $ NE.head ts) (_transaction_hash <$> ts)) groups - pure $ schemeHostPortToText shp .= map responseToValue responses + pure $ fromText (schemeHostPortToText shp) .= map responseToValue responses case res of Left er -> putStrLn er >> exitFailure Right results -> T.putStrLn $ toS $ encode $ Object $ mconcat results diff --git a/src/Commands/Send.hs b/src/Commands/Send.hs index bd54cd6..280ef74 100644 --- a/src/Commands/Send.hs +++ b/src/Commands/Send.hs @@ -9,6 +9,7 @@ import Control.Error import Control.Monad import Control.Monad.Trans import Data.Aeson +import Data.Aeson.Key import Data.Bifunctor import qualified Data.ByteString.Lazy as LB import Data.Function @@ -48,7 +49,7 @@ sendCommand e args = do printf "%s: sending %d commands to %d chains\n" (schemeHostPortToText shp) (length txs) (length groups) responses <- lift $ mapM (sendToNode le n) groups - pure $ schemeHostPortToText shp .= map responseToValue responses + pure $ fromText (schemeHostPortToText shp) .= map responseToValue responses case res of Left er -> putStrLn er >> exitFailure Right results -> T.putStrLn $ toS $ encode $ Object $ mconcat results diff --git a/src/Commands/Sign.hs b/src/Commands/Sign.hs index ee14222..e746a9a 100644 --- a/src/Commands/Sign.hs +++ b/src/Commands/Sign.hs @@ -10,6 +10,7 @@ import qualified Cardano.Crypto.Wallet as Crypto import Control.Error import qualified Crypto.Hash as Crypto import Control.Monad.Except +import Control.Monad.Trans import Data.ByteString (ByteString) import qualified Data.ByteArray as BA import Data.List @@ -89,7 +90,7 @@ signYamlFile kkey mindex enc msgFile = do let pubHex = PublicKeyHex $ toB16 $ BA.convert pub if S.member pubHex signingKeys then do - let sig = UserSig $ toB16 $ BA.convert $ sign sec (calcHash $ encodeUtf8 cmd) + let sig = ED25519Sig $ toB16 $ BA.convert $ sign sec (calcHash $ encodeUtf8 cmd) hClose mh let newSigs = addSig pubHex sig sigs let csd2 = CommandSigData newSigs cmd @@ -110,7 +111,7 @@ tryHdIndex msgFile csd xprv mpass mind = do cmdBS = encodeUtf8 cmd signingKeys = S.fromList $ map _s_pubKey $ unSignatureList startingSigs signPairs = getSigningInds signingKeys xprv mpass (maybe [0..100] (:[]) mind) - f (esec, pub) = addSig pub (UserSig $ sigToText $ signHD esec (fromMaybe "" mpass) (calcHash cmdBS)) + f (esec, pub) = addSig pub (ED25519Sig $ sigToText $ signHD esec (fromMaybe "" mpass) (calcHash cmdBS)) newSigs = foldr f startingSigs signPairs let csd2 = CommandSigData newSigs cmd num1 = countSigs csd diff --git a/src/Commands/WalletSign.hs b/src/Commands/WalletSign.hs index 0c78534..a6a952f 100644 --- a/src/Commands/WalletSign.hs +++ b/src/Commands/WalletSign.hs @@ -8,6 +8,8 @@ module Commands.WalletSign ------------------------------------------------------------------------------ import Control.Error import Control.Lens +import Control.Monad +import Control.Monad.Trans import Control.Monad.Except import Data.Aeson.Lens import Data.List @@ -35,6 +37,7 @@ import Text.Printf import Types.Encoding import Types.Env import Utils +import Pact.JSON.Legacy.Value (LegacyValue(_getLegacyValue)) ------------------------------------------------------------------------------ walletSignCommand :: Env -> WalletSignArgs -> IO () @@ -161,7 +164,7 @@ csdToSigningRequest csd = do Continuation _ -> Left "Cannot sign CONT transactions with the old signing API" Exec m -> do let code = _pcCode $ _pmCode m - d = _pmData m ^? _Object + d = _getLegacyValue (_pmData m) ^? _Object let caps = map mkDappCap $ S.toList $ S.fromList $ concatMap _siCapList $ _pSigners p let n = Just $ _pNonce p meta = _pMeta p diff --git a/src/Kadena/SigningApi.hs b/src/Kadena/SigningApi.hs index 81409c0..6124376 100644 --- a/src/Kadena/SigningApi.hs +++ b/src/Kadena/SigningApi.hs @@ -5,13 +5,11 @@ module Kadena.SigningApi where -import Control.Lens hiding ((.=)) import Control.Applicative((<|>)) import Data.Aeson import Data.Proxy import Data.Text (Text) import GHC.Generics -import Pact.Server.API import Pact.Types.Capability (SigCapability(..)) import Pact.Types.ChainMeta (TTLSeconds(..)) import Pact.Types.Runtime (GasLimit(..), ChainId, PublicKeyText) @@ -104,4 +102,3 @@ type V1SigningApi = "sign" :> ReqBody '[JSON] SigningRequest :> Post '[JSON] Sig signingAPI :: Proxy SigningApi signingAPI = Proxy - diff --git a/src/Kadena/SigningTypes.hs b/src/Kadena/SigningTypes.hs index 7ad6398..31589d6 100644 --- a/src/Kadena/SigningTypes.hs +++ b/src/Kadena/SigningTypes.hs @@ -1,5 +1,8 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} + {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} @@ -10,21 +13,24 @@ import Control.Lens hiding ((.=)) import Control.Monad import qualified Data.Aeson as A import Data.Aeson.Types +import qualified Data.ByteString.Lazy as BSL import Data.Char as Char -import qualified Data.HashMap.Strict as HM import qualified Data.List.Split as L import qualified Data.Map as M import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T -import qualified Data.Vector as V import GHC.Generics +import Pact.ApiReq +import qualified Pact.JSON.Encode as J +import Pact.Types.Capability (SigCapability(..)) import Pact.Types.ChainMeta import Pact.Types.Command import Pact.Types.Hash import Pact.Parse +import Pact.Types.Runtime (GasLimit(..), ChainId, NetworkId, PublicKeyText) -- TODO: Rip out sig data dependency import Pact.Types.SigData (PublicKeyHex(..)) @@ -37,14 +43,18 @@ data CSDSigner = CSDSigner instance ToJSON CSDSigner where toJSON (CSDSigner (PublicKeyHex pkh) mSig) = object $ [ "pubKey" .= pkh - , "sig" .= (_usSig <$> mSig) + , "sig" .= sig ] + where sig = mSig <&> \case + ED25519Sig s -> s + WebAuthnSig s -> T.decodeUtf8 $ BSL.toStrict $ J.encode s instance FromJSON CSDSigner where - parseJSON = withObject "Signer" $ \o -> do + parseJSON v = flip (withObject "Signer") v $ \o -> do pk <- o .: "pubKey" - mSig ::(Maybe Text) <- o.:? "sig" - pure $ CSDSigner pk $ UserSig <$> mSig + mSigTxt ::(Maybe Text) <- o.:? "sig" + mSig <- forM mSigTxt $ \sigTxt -> parseJSON $ object ["sig" .= sigTxt] + pure $ CSDSigner pk mSig -------------------------------------------------------------------------------- newtype SignatureList = @@ -85,7 +95,8 @@ data SigningOutcome = instance ToJSON SigningOutcome where toJSON a = case a of - SO_Success h -> object ["result" .= ("success" :: Text), "hash" .= h ] + SO_Success h -> object ["result" .= ("success" :: Text), "hash" .= hashTxt ] + where hashTxt = hashToText $ toUntypedHash h SO_Failure msg -> object ["result" .= ("failure" :: Text), "msg" .= msg ] SO_NoSig -> object ["result" .= ("noSig" :: Text)] @@ -96,7 +107,7 @@ instance FromJSON SigningOutcome where "success" -> SO_Success <$> o .: "hash" "failure" -> SO_Failure <$> o .: "msg" "noSig" -> pure SO_NoSig - otherwise -> fail "ill-formed SigningOutcome" + _ -> fail "ill-formed SigningOutcome" data CSDResponse = CSDResponse { _csdr_csd :: CommandSigData @@ -136,7 +147,7 @@ instance FromJSON QuicksignError where "reject" -> pure QuicksignError_Reject "emptyList" -> pure QuicksignError_EmptyList "other" -> fmap QuicksignError_Other $ o .: "msg" - otherwise -> fail "ill-formed QuicksignError" + _ -> fail "ill-formed QuicksignError" -------------------------------------------------------------------------------- commandSigDataToCommand :: CommandSigData -> Either String (Command Text) @@ -199,3 +210,19 @@ compactEncoding = defaultOptions where -- As long as names are not empty or just underscores this head should be fine: shortener = head . reverse . filter (/= "") . L.splitOn "_" + +------------------- ORPHANS ------------------- +-- We're defining these orphans here because Pact moved away from `ToJSON` to +-- pact-json's Encode typeclass, which is equivalent to aeson's `ToJSON` typeclass. +-- If these orphans conflict with future ToJSON instances, we can remove them. + +instance ToJSON SigCapability where toJSON = J.toJsonViaEncode +instance ToJSON PublicKeyText where toJSON = J.toJsonViaEncode +instance ToJSON TTLSeconds where toJSON = J.toJsonViaEncode +instance ToJSON GasLimit where toJSON = J.toJsonViaEncode +instance ToJSON ChainId where toJSON = J.toJsonViaEncode +instance ToJSON NetworkId where toJSON = J.toJsonViaEncode +instance J.Encode a => ToJSON (Command a) where toJSON = J.toJsonViaEncode +instance ToJSON ApiSigner where toJSON = J.toJsonViaEncode +instance ToJSON ApiPublicMeta where toJSON = J.toJsonViaEncode +instance ToJSON UserSig where toJSON = J.toJsonViaEncode \ No newline at end of file diff --git a/src/Keys.hs b/src/Keys.hs index f2d6f9a..080bb60 100644 --- a/src/Keys.hs +++ b/src/Keys.hs @@ -39,6 +39,7 @@ import System.IO.Echo import Text.Read (readMaybe) ------------------------------------------------------------------------------ import Utils +import Data.Base16.Types (extractBase16) ------------------------------------------------------------------------------ mnemonicToRoot :: MnemonicPhrase -> Crypto.XPrv @@ -169,7 +170,7 @@ decodeMnemonic t = do decodeEncryptedMnemonic :: Text -> IO (Either String KadenaKey) decodeEncryptedMnemonic t = do - case Crypto.xprv =<< fmapL T.unpack (B16.decodeBase16 (T.encodeUtf8 t)) of + case Crypto.xprv =<< fmapL T.unpack (B16.decodeBase16Untyped (T.encodeUtf8 t)) of Left _ -> pure $ Left "Could not decode HD key" Right xprv -> do hSetBuffering stderr NoBuffering @@ -232,10 +233,10 @@ textTo :: IsString a => Text -> a textTo = fromString . T.unpack toB16 :: ByteString -> Text -toB16 = B16.encodeBase16 +toB16 = extractBase16 . B16.encodeBase16 fromB16 :: Text -> Either Text ByteString -fromB16 txt = B16.decodeBase16 $ T.encodeUtf8 txt +fromB16 txt = B16.decodeBase16Untyped $ T.encodeUtf8 txt readNatural :: String -> Maybe Natural readNatural = readMaybe diff --git a/src/TxTemplate.hs b/src/TxTemplate.hs index 1e92e71..97bb5c6 100644 --- a/src/TxTemplate.hs +++ b/src/TxTemplate.hs @@ -7,8 +7,8 @@ module TxTemplate where import Control.Applicative import Control.Monad import qualified Data.Aeson as A -import qualified Data.Aeson.Parser as A import qualified Data.Attoparsec.ByteString as Atto +import qualified Data.Attoparsec.ByteString.Char8 as Atto import Data.Bifunctor import Data.Either import qualified Data.HashMap.Strict as HM @@ -125,9 +125,9 @@ replicateSingleArr _ v = v parseTextValue :: (Text, Text) -> Either String (Text, MU.Value) parseTextValue (k,vt) = do let bs = encodeUtf8 vt - num = A.Number <$> Atto.parseOnly (A.scientific <* Atto.endOfInput) bs + num = A.Number <$> Atto.parseOnly (Atto.scientific <* Atto.endOfInput) bs str = Right $ A.String vt - v <- first addLoc $ A.eitherDecodeStrict bs <|> num <|> str + v <- first addLoc $ A.eitherDecodeStrict bs <> num <> str v2 <- case v of A.Number _ -> pure $ A.String vt A.String _ -> pure v diff --git a/src/Types/Encoding.hs b/src/Types/Encoding.hs index 1967fa4..47e4d08 100644 --- a/src/Types/Encoding.hs +++ b/src/Types/Encoding.hs @@ -48,15 +48,15 @@ textToEncoding = \case genericDecode :: Encoding -> ByteString -> Either Text ByteString genericDecode Raw = Right -genericDecode B16 = decodeBase16 -genericDecode B64 = B64.decodeBase64 -genericDecode B64Url = B64Url.decodeBase64 +genericDecode B16 = decodeBase16Untyped +genericDecode B64 = B64.decodeBase64Untyped +genericDecode B64Url = B64Url.decodeBase64Untyped genericDecode Yaml = decodeYamlBS -- We don't actually use the result of this case decodeYamlBS :: ByteString -> Either Text ByteString decodeYamlBS bs = do v :: Value <- first (T.pack . snd) $ YA.decode1Strict bs - let mhash = hush . B64Url.decodeBase64 . encodeUtf8 =<< (v ^? key "hash" . _String) + let mhash = hush . B64Url.decodeBase64Untyped . encodeUtf8 =<< (v ^? key "hash" . _String) mcmd = encodeUtf8 <$> (v ^? key "cmd" . _String) case (mhash, mcmd) of (Nothing, Nothing) -> Left "YAML must contain a key 'hash' and/or 'cmd'" diff --git a/src/Types/Env.hs b/src/Types/Env.hs index 013bd07..7279a25 100644 --- a/src/Types/Env.hs +++ b/src/Types/Env.hs @@ -15,6 +15,7 @@ import Chainweb.Api.ChainId import Chainweb.Api.Transaction import Control.Error import Control.Lens (makeLenses) +import Control.Monad import Control.Monad.Reader import Data.Aeson hiding (Encoding) import Data.Binary.Builder @@ -384,9 +385,9 @@ filePatP = strOption $ mconcat , short 'o' , metavar "OUT_PAT" , helpDoc $ Just $ mconcat - [ text "Pattern to use for output filenames" + [ "Pattern to use for output filenames" , hardline - , text "(example: \"tx-{{chain}}.yaml\")" + , "(example: \"tx-{{chain}}.yaml\")" ] ] diff --git a/src/Types/TxInputs.hs b/src/Types/TxInputs.hs index 7561841..9eca299 100644 --- a/src/Types/TxInputs.hs +++ b/src/Types/TxInputs.hs @@ -6,6 +6,7 @@ module Types.TxInputs where import Control.Applicative import Control.Error import Data.Aeson as A +import Data.Aeson.Key as A import Data.Aeson.Types import qualified Data.ByteString.Lazy as LB import Data.Text (Text) @@ -13,8 +14,12 @@ import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T import Pact.ApiReq +import Kadena.SigningTypes () +import qualified Pact.JSON.Encode as J +import Pact.JSON.Legacy.Value import Pact.Types.Lang import Pact.Types.RPC +import Pact.Types.Verifier ------------------------------------------------------------------------------ data PactTxType = PttExec | PttCont @@ -39,7 +44,7 @@ data ExecInputs = ExecInputs , _execInputs_dataOrFile :: Either Value FilePath } deriving (Eq,Show) -execInputsPairs :: (Monoid a, KeyValue a) => ExecInputs -> a +execInputsPairs :: (Monoid a, KeyValue e a) => ExecInputs -> a execInputsPairs ei = mconcat [ either ("code" .=) ("codeFile" .=) $ _execInputs_codeOrFile ei , either ("data" .=) ("dataFile" .=) $ _execInputs_dataOrFile ei @@ -59,6 +64,7 @@ data TxInputs = TxInputs { _txInputs_type :: PactTxType , _txInputs_payload :: Either ContMsg ExecInputs , _txInputs_signers :: Maybe [ApiSigner] + , _txInputs_verifiers :: Maybe [Verifier ParsedVerifierProof] , _txInputs_nonce :: Maybe Text , _txInputs_meta :: ApiPublicMeta , _txInputs_networkId :: NetworkId @@ -74,13 +80,14 @@ txInputsToApiReq txi = do (let PactId pid = _cmPactId c in hush $ fromText' pid) (Just $ _cmStep c) (Just $ _cmRollback c) - (Just $ _cmData c) + (Just $ _getLegacyValue $ _cmData c) (_cmProof c) Nothing Nothing Nothing Nothing (Just $ fromMaybe [] $ _txInputs_signers txi) + (Just $ fromMaybe [] $ _txInputs_verifiers txi) (_txInputs_nonce txi) (Just $ _txInputs_meta txi) n @@ -99,6 +106,7 @@ txInputsToApiReq txi = do Nothing Nothing (Just $ fromMaybe [] $ _txInputs_signers txi) + (Just $ fromMaybe [] $ _txInputs_verifiers txi) (_txInputs_nonce txi) (Just $ _txInputs_meta txi) n @@ -113,7 +121,7 @@ instance ToJSON TxInputs where toJSON ti = A.Object $ payloadPairs <> mconcat [ "type" .= _txInputs_type ti , "signers" .= fromMaybe [] (_txInputs_signers ti) - , "nonce" .?= _txInputs_nonce ti + , "nonce" .??= _txInputs_nonce ti -- TODO Not sure if this should be "meta" or "publicMeta". I think it should -- be "meta" because we want to move people towards the key used in the @@ -125,9 +133,13 @@ instance ToJSON TxInputs where ] where payloadPairs = either contMsgJsonPairs execInputsPairs $ _txInputs_payload ti - k .?= v = case v of + k .??= v = case v of Nothing -> mempty Just v' -> k .= v' + contMsgJsonPairs contMsg = case J.toJsonViaEncode contMsg of + A.Object o -> o + _ -> error "contMsgJsonPairs: impossible" + instance FromJSON TxInputs where @@ -154,6 +166,7 @@ instance FromJSON TxInputs where <$> pure t <*> pure p <*> o .:? "signers" + <*> o .:? "verifiers" <*> o .:? "nonce" <*> pure m <*> o .: "networkId" @@ -161,7 +174,7 @@ instance FromJSON TxInputs where parseMaybePair :: FromJSON a => A.Object - -> Text + -> A.Key -> Parser (Maybe (Either a FilePath)) parseMaybePair o name = do mn <- o .:? name @@ -171,4 +184,4 @@ parseMaybePair o name = do (Nothing,Nothing) -> pure Nothing (Just n,Nothing) -> pure $ Just $ Left n (Nothing,Just f) -> pure $ Just $ Right f - (Just _,Just _) -> fail $ T.unpack ("Cannot have both " <> name <> " and " <> nameFile) + (Just _,Just _) -> fail $ T.unpack ("Cannot have both " <> A.toText name <> " and " <> A.toText nameFile) diff --git a/src/Utils.hs b/src/Utils.hs index 49f8204..1403588 100644 --- a/src/Utils.hs +++ b/src/Utils.hs @@ -41,6 +41,7 @@ import Options.Applicative hiding (Parser) import Pact.Types.Command import System.Directory import System.FilePath +import Data.Vector.Internal.Check (HasCallStack) ------------------------------------------------------------------------------ tshow :: Show a => a -> Text @@ -144,15 +145,23 @@ commandSigDataToTransaction requireSigs csd = do pure $ mkTransaction pc (map userSigToSig sigs) where addDummy = maybe (if requireSigs then Nothing else Just dummySig) Just - dummySig = UserSig "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + dummySig = ED25519Sig "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" + +convertViaJson :: (ToJSON a, FromJSON b) => a -> Either String b +convertViaJson = eitherDecode . encode + +convertViaJson' :: HasCallStack => (ToJSON a, FromJSON b) => a -> b +convertViaJson' a = case convertViaJson a of + Left e -> error $ "Failed to convert via JSON:" ++ e + Right b -> b -- | Converts chainweb-api's 'Sig' type to Pact's 'UserSig'. userSigToSig :: UserSig -> Sig -userSigToSig = Sig . _usSig +userSigToSig = convertViaJson' -- | Converts Pact's 'UserSig' type to chainweb-api's 'Sig'. sigToUserSig :: Sig -> UserSig -sigToUserSig = UserSig . unSig +sigToUserSig = convertViaJson' --data SigData a = SigData -- { _sigDataHash :: PactHash