Merge pull request #947 from IntersectMBO/mgalazyn/feature/rpc-add-plutusdata-support

gRPC: Add decoded PlutusData and NativeScript in proto definition

Author: carbolymer

.hlint.yaml

@@ -61,7 +61,7 @@
 - ignore: {name: Use camelCase, within: [Test.Cardano.Api.**, Test.Golden.Cardano.Api.**]}
 
 # Ignore all files in cardano-rpc/gen (generated code)
-- ignore: {within: [Proto.Cardano, Proto.Utxorpc]}
+- ignore: {within: [Proto.Cardano.**, Proto.Utxorpc.**]}
 
 - ignore: {name: Eta reduce}
 - ignore: {name: Use + directly}

cardano-api/src/Cardano/Api/Error.hs

@@ -8,6 +8,7 @@
 module Cardano.Api.Error
   ( Error (..)
   , throwErrorAsException
+  , liftEitherError
   , failEitherError
   , ErrorAsException (..)
   , FileError (..)
@@ -20,7 +21,8 @@ where
 import Cardano.Api.Monad.Error
 import Cardano.Api.Pretty
 
-import Control.Exception (Exception (..), IOException, throwIO)
+import Control.Exception.Safe
+import GHC.Stack
 import System.Directory (doesFileExist)
 import System.IO (Handle)
 
@@ -32,26 +34,49 @@ instance Error () where
 
 -- | The preferred approach is to use 'Except' or 'ExceptT', but you can if
 -- necessary use IO exceptions.
-throwErrorAsException :: Error e => e -> IO a
-throwErrorAsException e = throwIO (ErrorAsException e)
-
-failEitherError :: MonadFail m => Error e => Either e a -> m a
+throwErrorAsException
+  :: HasCallStack
+  => MonadThrow m
+  => Typeable e
+  => Error e
+  => e
+  -> m a
+throwErrorAsException e = withFrozenCallStack $ throwM $ ErrorAsException e
+
+-- | Pretty print 'Error e' and 'fail' if 'Left'.
+failEitherError
+  :: MonadFail m
+  => Error e
+  => Either e a
+  -> m a
 failEitherError = failEitherWith displayError
 
+-- | Pretty print 'Error e' and 'throwM' it wrapped in 'ErrorAsException' when 'Left'.
+liftEitherError
+  :: HasCallStack
+  => MonadThrow m
+  => Typeable e
+  => Error e
+  => Either e a
+  -> m a
+liftEitherError = withFrozenCallStack $ either throwErrorAsException pure
+
+-- | An exception wrapping any 'Error e', attaching a call stack from the construction place to it.
 data ErrorAsException where
-  ErrorAsException :: Error e => e -> ErrorAsException
+  ErrorAsException :: (HasCallStack, Typeable e, Error e) => e -> ErrorAsException
+
+instance Exception ErrorAsException
 
+-- | Pretty print the error inside the exception
 instance Error ErrorAsException where
   prettyError (ErrorAsException e) =
     prettyError e
 
+-- | Pretty print the error inside the exception followed by the call stack pointing to the place where 'Error e' was
+-- wrapped in 'ErrorAsException'
 instance Show ErrorAsException where
   show (ErrorAsException e) =
-    docToString $ prettyError e
-
-instance Exception ErrorAsException where
-  displayException (ErrorAsException e) =
-    docToString $ prettyError e
+    docToString (prettyError e) <> "\n" <> prettyCallStack callStack
 
 displayError :: Error a => a -> String
 displayError = docToString . prettyError

cardano-api/src/Cardano/Api/Experimental/Era.hs

@@ -309,9 +309,9 @@ type EraCommonConstraints era =
   , L.EraTxCert (LedgerEra era)
   , L.EraTxOut (LedgerEra era)
   , L.EraUTxO (LedgerEra era)
+  , L.Value (LedgerEra era) ~ L.MaryValue
   , FromCBOR (ChainDepState (ConsensusProtocol era))
-  , -- , FromCBOR (L.TxCert (LedgerEra era))
-    L.NativeScript (LedgerEra era) ~ L.Timelock (LedgerEra era)
+  , L.NativeScript (LedgerEra era) ~ L.Timelock (LedgerEra era)
   , PraosProtocolSupportsNode (ConsensusProtocol era)
   , ShelleyLedgerEra era ~ LedgerEra era
   , ToJSON (ChainDepState (ConsensusProtocol era))

cardano-api/src/Cardano/Api/HasTypeProxy.hs

@@ -13,10 +13,12 @@ module Cardano.Api.HasTypeProxy
 where
 
 import Data.ByteString qualified as BS
+import Data.ByteString.Lazy qualified as BSL
 import Data.Kind (Constraint, Type)
 import Data.Proxy (Proxy (..))
 import Data.Typeable (Typeable)
 import Data.Word (Word16, Word8)
+import Numeric.Natural (Natural)
 
 class Typeable t => HasTypeProxy t where
   -- | A family of singleton types used in this API to indicate which type to
@@ -35,10 +37,18 @@ instance HasTypeProxy Word16 where
   data AsType Word16 = AsWord16
   proxyToAsType _ = AsWord16
 
+instance HasTypeProxy Natural where
+  data AsType Natural = AsNatural
+  proxyToAsType _ = AsNatural
+
 instance HasTypeProxy BS.ByteString where
   data AsType BS.ByteString = AsByteString
   proxyToAsType _ = AsByteString
 
+instance HasTypeProxy BSL.ByteString where
+  data AsType BSL.ByteString = AsByteStringLazy
+  proxyToAsType _ = AsByteStringLazy
+
 data FromSomeType (c :: Type -> Constraint) b where
   FromSomeType :: c a => AsType a -> (a -> b) -> FromSomeType c b
 

cardano-api/src/Cardano/Api/Ledger/Internal/Reexport.hs

@@ -59,6 +59,7 @@ module Cardano.Api.Ledger.Internal.Reexport
   , TxId (..)
   , TxIn (..)
   , Value
+  , MaryValue (..)
   , MultiAsset (..)
   , addDeltaCoin
   , castSafeHash
@@ -343,7 +344,7 @@ import Cardano.Ledger.Keys
   , hashWithSerialiser
   , toVRFVerKeyHash
   )
-import Cardano.Ledger.Mary.Value (MultiAsset (..))
+import Cardano.Ledger.Mary.Value (MaryValue (..), MultiAsset (..))
 import Cardano.Ledger.Plutus.Data (Data (..), unData)
 import Cardano.Ledger.Plutus.Language (Language, Plutus, languageToText, plutusBinary)
 import Cardano.Ledger.Shelley.API

cardano-api/src/Cardano/Api/Serialise/Raw.hs

@@ -26,13 +26,17 @@ import Data.Bits (Bits (..))
 import Data.ByteString qualified as BS
 import Data.ByteString.Base16 qualified as Base16
 import Data.ByteString.Builder qualified as BSB
-import Data.ByteString.Char8 as BSC
+import Data.ByteString.Char8 (ByteString)
+import Data.ByteString.Char8 qualified as BSC
+import Data.ByteString.Lazy qualified as BSL
 import Data.Data (typeRep)
+import Data.Foldable qualified as F
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Data.Text.Encoding qualified as Text
 import Data.Typeable (TypeRep, Typeable)
 import Data.Word (Word16, Word8)
+import Numeric.Natural (Natural)
 
 class (HasTypeProxy a, Typeable a) => SerialiseAsRawBytes a where
   serialiseToRawBytes :: a -> ByteString
@@ -60,10 +64,24 @@ instance SerialiseAsRawBytes Word16 where
       throwError . SerialiseAsRawBytesError $
         "Cannot decode Word16 from (hex): " <> BSC.unpack (Base16.encode bs)
 
+-- | Convert the number into binary value
+instance SerialiseAsRawBytes Natural where
+  serialiseToRawBytes 0 = BS.singleton 0x00
+  serialiseToRawBytes n = BS.toStrict . BSB.toLazyByteString $ go n mempty
+   where
+    go 0 acc = acc
+    go x acc = go (x `shiftR` 8) (BSB.word8 (fromIntegral (x .&. 0xFF)) <> acc)
+  deserialiseFromRawBytes AsNatural "\x00" = pure 0
+  deserialiseFromRawBytes AsNatural input = pure . F.foldl' (\acc byte -> acc `shiftL` 8 .|. fromIntegral byte) 0 $ BS.unpack input
+
 instance SerialiseAsRawBytes BS.ByteString where
   serialiseToRawBytes = id
   deserialiseFromRawBytes AsByteString = pure
 
+instance SerialiseAsRawBytes BSL.ByteString where
+  serialiseToRawBytes = BSL.toStrict
+  deserialiseFromRawBytes AsByteStringLazy = pure . BSL.fromStrict
+
 serialiseToRawBytesHex :: SerialiseAsRawBytes a => a -> ByteString
 serialiseToRawBytesHex = Base16.encode . serialiseToRawBytes
 

cardano-api/src/Cardano/Api/Serialise/SerialiseUsing.hs

@@ -17,8 +17,10 @@ import Cardano.Api.Serialise.Json
 import Cardano.Api.Serialise.Raw
 
 import Data.Aeson.Types qualified as Aeson
+import Data.ByteString qualified as B
 import Data.Text.Encoding qualified as Text
 import Data.Typeable (tyConName, typeRep, typeRepTyCon)
+import Numeric (showBin)
 
 -- | For use with @deriving via@, to provide 'ToCBOR' and 'FromCBOR' instances,
 -- based on the 'SerialiseAsRawBytes' instance.
@@ -39,6 +41,10 @@ instance SerialiseAsRawBytes a => FromCBOR (UsingRawBytes a) where
     ttoken = proxyToAsType (Proxy :: Proxy a)
     tname = (tyConName . typeRepTyCon . typeRep) (Proxy :: Proxy a)
 
+-- | Prints the representation in binary format, quoted
+instance SerialiseAsRawBytes a => Show (UsingRawBytes a) where
+  showsPrec _ (UsingRawBytes x) = showChar '"' . mconcat (map showBin . B.unpack $ serialiseToRawBytes x) . showChar '"'
+
 -- | For use with @deriving via@, to provide instances for any\/all of 'Show',
 -- 'ToJSON', 'FromJSON', 'ToJSONKey', FromJSONKey' using a hex
 -- encoding, based on the 'SerialiseAsRawBytes' instance.

cardano-api/src/Cardano/Api/Tx/Internal/Fee.hs

@@ -84,7 +84,6 @@ import Cardano.Ledger.Api qualified as L
 import Cardano.Ledger.Coin qualified as L
 import Cardano.Ledger.Conway.Governance qualified as L
 import Cardano.Ledger.Credential as Ledger (Credential)
-import Cardano.Ledger.Mary.Value qualified as L
 import Cardano.Ledger.Plutus.Language qualified as Plutus
 import Cardano.Ledger.Val qualified as L
 import Ouroboros.Consensus.HardFork.History qualified as Consensus

cardano-rpc/cardano-rpc.cabal

@@ -69,7 +69,6 @@ library
     bytestring,
     cardano-api >=10.17,
     cardano-ledger-api,
-    cardano-ledger-binary,
     cardano-ledger-conway,
     cardano-ledger-core,
     cardano-rpc:gen,
@@ -132,3 +131,4 @@ test-suite cardano-rpc-test
   build-tool-depends: tasty-discover:tasty-discover
   other-modules:
     Test.Cardano.Rpc.ProtocolParameters
+    Test.Cardano.Rpc.TxOutput