From 383a845c94eea626b3bbcc7a77f6b07ea48bf532 Mon Sep 17 00:00:00 2001 From: Sudip Bhattarai Date: Mon, 15 Aug 2022 18:06:09 +0545 Subject: [PATCH] Add transaction validity by slot --- docker-compose.yml | 4 +- docs/json-api-reference.md | 19 +++-- kuber.cabal | 5 +- server/kuber-server.cabal | 2 +- src/Cardano/Kuber/Api.hs | 10 ++- src/Cardano/Kuber/Core/TxBuilder.hs | 94 ++++++++++++++++-------- src/Cardano/Kuber/Core/TxFramework.hs | 42 ++++++++--- src/Cardano/Kuber/Data/TxBuilderAeson.hs | 32 ++++++-- 8 files changed, 147 insertions(+), 61 deletions(-) diff --git a/docker-compose.yml b/docker-compose.yml index 3139050..5c9fd9e 100644 --- a/docker-compose.yml +++ b/docker-compose.yml @@ -1,7 +1,7 @@ version: "3.5" services: cardano-node: - image: inputoutput/cardano-node:${CARDANO_NODE_VERSION:-1.35.0} + image: inputoutput/cardano-node:${CARDANO_NODE_VERSION:-1.35.3} environment: NETWORK: ${NETWORK:-testnet} volumes: @@ -13,7 +13,7 @@ services: max-size: "200k" max-file: "10" kuber: - image: dquadrant/kuber:${KUBER_VERSION:-2.0.0} + image: dquadrant/kuber:${KUBER_VERSION:-2.1.0} environment: NETWORK: ${NETWORK:- testnet} volumes: diff --git a/docs/json-api-reference.md b/docs/json-api-reference.md index f1bd634..9cbbb40 100644 --- a/docs/json-api-reference.md +++ b/docs/json-api-reference.md @@ -8,15 +8,18 @@ Kuber Json Api Reference - [**selections**](#1-selections---string--object--array-of-utxos-that-can-be-used-to-balance-the-transaction) : List of utxos/addresses that can be used for balancing transaction - [**inputs**](#2-inputs---string--object---inputs-utxos-being-spent-in-the-transaction) : List inputs in transactions - [**referenceInputs**](#3-referenceinputs--string--referenceinputs-transction-field) : Reference Inputs -- [**outputs**](#4-outputs--object--outputs-created-in--the-transaction) : List Output utxos in the transaction +- [**outputs**](#4-outputs--object--outputs-created-in-the-transaction) : List Output utxos in the transaction - [**collaterals**](#5-collaterals-string-optional--collateral-inputs-in-the-transaction) : [optional] List of collaterals in the transaction (It is automatically selected if missing) -- **validityStart** : [Integer: UnixTimestamp millisecond] Transaction validFrom -- **validityEnd** : [Integer : UnixTimestamp millisecond] Transaction validUntil +- **validityStart** : [Integer: PosixTimestamp seconds] (convinence field for usage instead of `validityStartSlot`) Transaction validFrom +- **validityStartSlot** : [Integer: Slot Number] Transaction validFrom +- **validityEnd** : [Integer : PosixTimestamp seconds] (convinence field for usage instead of `validityEndSlot`) Transaction validUntil +- **validityEndSlot** : [Integer : Slot Numbers] Transaction validUntil + - [**mint**](#6-mint--object--minting-script-and-amount-in-the-transaction) : Minting Scripts and value in the transaction -- [**signatures**](#7 -) +- [**signatures**](#7-signatures-string) - **fee** : [Integer : Lovelace] Fee is calculated automatically, but setting this will set transaction fee explicitly. - **changeAddress** [Optional ] : Default change address. If it's missing, it's selected from one of the selection address. Setting `addChange` in any one output will disable this option -- [**metadata**](#7-metadata--object--transaction-metadata) : Transaction metadata +- [**metadata**](#8-metadata--object--transaction-metadata) : Transaction metadata ### 1. `selections` : [ string | object ] Array of utxos that can be used to balance the transaction @@ -274,8 +277,12 @@ Each object in the mint list must have following keys "scripts": [ BasicScript | MultiScript ] : when required number of script condition is met, token can be minted. } +### 7. Signatures: "String" + PubKey Signatures required for usage by Plutus Contract. It must be set when `txSignedBy` function constraint is used in Plutus script. + + It can be either bench32 or cborHex format Address. -### 7. metadata : Object : Transaction Metadata +### 8. metadata : Object : Transaction Metadata Transaction metadata must be a json object with top level integer key label. Keys in the json shouldn't be longer than 64 bytes length. If the string value in the metadata is longer than 64 bytes length, Kuber will split the string and replace it with array of smaller chunks of the string. diff --git a/kuber.cabal b/kuber.cabal index 3722635..3587fd5 100644 --- a/kuber.cabal +++ b/kuber.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: kuber -version: 2.0.0.0 +version: 2.1.0.0 -- A short (one-line) description of the package. -- synopsis: @@ -66,9 +66,12 @@ library -- , shelley-spec-ledger , plutus-ledger-api , plutus-tx + , ouroboros-consensus , ouroboros-network , vector + , transformers , unordered-containers + , time test-suite test default-language: Haskell2010 diff --git a/server/kuber-server.cabal b/server/kuber-server.cabal index 9cf4755..d4ecb52 100644 --- a/server/kuber-server.cabal +++ b/server/kuber-server.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: kuber-server -version: 2.0.0.0 +version: 2.1.0.0 -- A short (one-line) description of the package. -- synopsis: diff --git a/src/Cardano/Kuber/Api.hs b/src/Cardano/Kuber/Api.hs index d208630..5e4e264 100644 --- a/src/Cardano/Kuber/Api.hs +++ b/src/Cardano/Kuber/Api.hs @@ -38,10 +38,12 @@ module Cardano.Kuber.Api( , txSign -- transaction validity - , txValidFromPosixMs - , txValidUntilPosixMs - , txValidPosixTimeRangeMs - + , txValidFromPosix + , txValidUntilPosix + , txValidPosixTimeRange + , txValidFromSlot + , txValidUntilSlot + , txValidSlotRange -- Core Tx builder object and it's transformation functions , TxBuilder , txBuilderToTxBody diff --git a/src/Cardano/Kuber/Core/TxBuilder.hs b/src/Cardano/Kuber/Core/TxBuilder.hs index c071547..e6a0147 100644 --- a/src/Cardano/Kuber/Core/TxBuilder.hs +++ b/src/Cardano/Kuber/Core/TxBuilder.hs @@ -6,6 +6,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE TypeApplications #-} module Cardano.Kuber.Core.TxBuilder where @@ -19,6 +20,7 @@ import Cardano.Slotting.Time import qualified Cardano.Ledger.Alonzo.TxBody as LedgerBody import qualified Data.Map as Map import qualified Data.Set as Set +import Data.Time.Clock import Data.Map (Map) import Control.Exception import Data.Either @@ -52,6 +54,8 @@ import qualified Data.HashMap.Internal.Strict as H import Data.Bifunctor import Cardano.Kuber.Utility.ScriptUtil ( fromPlutusV2Script) import GHC.Generics (Generic) +import Data.Time.Clock.POSIX +import Foreign.C (CTime) data TxSimpleScript = TxSimpleScriptV1 (SimpleScript SimpleScriptV1 ) @@ -139,6 +143,33 @@ data TxMintingScriptSource = data TxMintData s = TxMintData s [(AssetName ,Quantity)] (Map Word64 (Map AssetName Aeson.Value)) deriving (Show) +data ValidityTimestamp = NoValidityTime + | ValidityPosixTime POSIXTime + | ValiditySlot SlotNo deriving (Show,Eq) + +instance Semigroup ValidityTimestamp where + (<>) = maxValidity + +instance Monoid ValidityTimestamp where + mempty = NoValidityTime + +minValidity :: ValidityTimestamp -> ValidityTimestamp -> ValidityTimestamp +minValidity NoValidityTime v2 = v2 +minValidity v1 NoValidityTime = v1 +minValidity (ValidityPosixTime t1) (ValidityPosixTime t2) = ValidityPosixTime (min t1 t2) +minValidity (ValiditySlot s1) (ValiditySlot s2) = ValiditySlot (min s1 s2) +minValidity v1@(ValiditySlot _) _ = v1 +minValidity _ v2 = v2 + + +maxValidity :: ValidityTimestamp -> ValidityTimestamp -> ValidityTimestamp +maxValidity NoValidityTime v2 = v2 +maxValidity v1 NoValidityTime = v1 +maxValidity (ValidityPosixTime t1) (ValidityPosixTime t2) = ValidityPosixTime (max t1 t2) +maxValidity (ValiditySlot s1) (ValiditySlot s2) = ValiditySlot (max s1 s2) +maxValidity v1@(ValiditySlot _) _ = v1 +maxValidity _ v2 = v2 + -- TxBuilder object -- It is a semigroup and monoid instance, so it can be constructed using helper function -- and merged to construct a transaction specification @@ -148,8 +179,8 @@ data TxBuilder=TxBuilder{ txInputReferences:: [TxInputReference], txOutputs :: [TxOutput TxOutputContent], txCollaterals :: [TxCollateral], -- collateral for the transaction - txValidityStart :: Maybe Integer, - txValidityEnd :: Maybe Integer, + txValidityStart :: ValidityTimestamp, + txValidityEnd :: ValidityTimestamp, txMintData :: [TxMintData TxMintingScriptSource], txSignatures :: [TxSignature], txFee :: Maybe Integer, @@ -158,7 +189,7 @@ data TxBuilder=TxBuilder{ } deriving (Show) instance Monoid TxBuilder where - mempty = TxBuilder [] [] [] [] [] Nothing Nothing [] [] Nothing Nothing Map.empty + mempty = TxBuilder [] [] [] [] [] mempty mempty [] [] Nothing Nothing Map.empty instance Semigroup TxBuilder where (<>) txb1 txb2 =TxBuilder{ @@ -167,16 +198,8 @@ instance Semigroup TxBuilder where txInputReferences = txInputReferences txb1 ++ txInputReferences txb2, txOutputs = txOutputs txb1 ++ txOutputs txb2, txCollaterals = txCollaterals txb1 ++ txCollaterals txb2, -- collateral for the transaction - txValidityStart = case txValidityStart txb1 of - Just v1 -> case txValidityStart txb2 of - Just v2 -> Just $ min v1 v2 - Nothing -> Just v1 - Nothing -> txValidityStart txb2, - txValidityEnd = case txValidityEnd txb1 of - Just v1 -> case txValidityEnd txb2 of - Just v2 -> Just $ max v1 v2 - _ -> Just v1 - _ -> txValidityEnd txb2, + txValidityStart = minValidity (txValidityStart txb1) (txValidityStart txb2), + txValidityEnd = maxValidity (txValidityStart txb1) (txValidityStart txb2), txMintData = txMintData txb1 <> txMintData txb2, txSignatures = txSignatures txb1 ++ txSignatures txb2, txFee = case txFee txb1 of @@ -190,50 +213,61 @@ instance Semigroup TxBuilder where txMetadata = txMetadata txb1 <> txMetadata txb2 } - data TxContext = TxContext { ctxAvailableUtxo :: UTxO BabbageEra, ctxBuiler :: [TxBuilder] } txSelection :: TxInputSelection -> TxBuilder -txSelection v = TxBuilder [v] [] [] [] [] Nothing Nothing [] [] Nothing Nothing Map.empty +txSelection v = TxBuilder [v] [] [] [] [] mempty mempty [] [] Nothing Nothing Map.empty txInput :: TxInput -> TxBuilder -txInput v = TxBuilder [] [v] [] [] [] Nothing Nothing [] [] Nothing Nothing Map.empty +txInput v = TxBuilder [] [v] [] [] [] mempty mempty [] [] Nothing Nothing Map.empty txInputReference :: TxInputReference -> TxBuilder -txInputReference v = TxBuilder [] [] [v] [] [] Nothing Nothing [] [] Nothing Nothing Map.empty +txInputReference v = TxBuilder [] [] [v] [] [] mempty mempty [] [] Nothing Nothing Map.empty txMints :: [TxMintData TxMintingScriptSource] -> TxBuilder -txMints md= TxBuilder [] [] [] [] [] Nothing Nothing md [] Nothing Nothing Map.empty +txMints md= TxBuilder [] [] [] [] [] mempty mempty md [] Nothing Nothing Map.empty txOutput :: TxOutput TxOutputContent -> TxBuilder -txOutput v = TxBuilder [] [] [] [v] [] Nothing Nothing [] [] Nothing Nothing Map.empty +txOutput v = TxBuilder [] [] [] [v] [] mempty mempty [] [] Nothing Nothing Map.empty txCollateral :: TxCollateral -> TxBuilder -txCollateral v = TxBuilder [] [] [] [] [v] Nothing Nothing [] [] Nothing Nothing Map.empty +txCollateral v = TxBuilder [] [] [] [] [v] mempty mempty [] [] Nothing Nothing Map.empty txSignature :: TxSignature -> TxBuilder -txSignature v = TxBuilder [] [] [] [] [] Nothing Nothing [] [v] Nothing Nothing Map.empty +txSignature v = TxBuilder [] [] [] [] [] mempty mempty [] [v] Nothing Nothing Map.empty -- Transaction validity --- Set validity Start and end time in posixMilliseconds -txValidPosixTimeRangeMs :: Integer -> Integer -> TxBuilder -txValidPosixTimeRangeMs start end = TxBuilder [] [] [] [] [] (Just start) (Just end) [] [] Nothing Nothing Map.empty +-- Set validity Start and end time in posix seconds +txValidPosixTimeRange :: POSIXTime -> POSIXTime -> TxBuilder +txValidPosixTimeRange start end = TxBuilder [] [] [] [] [] (ValidityPosixTime start ) (ValidityPosixTime end) [] [] Nothing Nothing Map.empty + +-- set validity statart time in posix seconds +txValidFromPosix:: POSIXTime -> TxBuilder +txValidFromPosix start = TxBuilder [] [] [] [] [] (ValidityPosixTime start) mempty [] [] Nothing Nothing Map.empty + +-- set transaction validity end time in posix seconds +txValidUntilPosix :: POSIXTime -> TxBuilder +txValidUntilPosix end = TxBuilder [] [] [] [] [] mempty (ValidityPosixTime end) [] [] Nothing Nothing Map.empty + +-- Set validity Start and end slot +txValidSlotRange :: SlotNo -> SlotNo -> TxBuilder +txValidSlotRange start end = TxBuilder [] [] [] [] [] (ValiditySlot start ) (ValiditySlot end) [] [] Nothing Nothing Map.empty --- set validity statart time in posixMilliseconds -txValidFromPosixMs:: Integer -> TxBuilder -txValidFromPosixMs start = TxBuilder [] [] [] [] [] (Just start) Nothing [] [] Nothing Nothing Map.empty +-- set validity statart time in posix seconds +txValidFromSlot:: SlotNo -> TxBuilder +txValidFromSlot start = TxBuilder [] [] [] [] [] (ValiditySlot start) mempty [] [] Nothing Nothing Map.empty --- set transaction validity end time in posixMilliseconds -txValidUntilPosixMs :: Integer -> TxBuilder -txValidUntilPosixMs end = TxBuilder [] [] [] [] [] Nothing (Just end) [] [] Nothing Nothing Map.empty +-- set transaction validity end time in posix seconds +txValidUntilSlot :: SlotNo -> TxBuilder +txValidUntilSlot end = TxBuilder [] [] [] [] [] mempty (ValiditySlot end) [] [] Nothing Nothing Map.empty --- minting _txMint v = txMints [v] diff --git a/src/Cardano/Kuber/Core/TxFramework.hs b/src/Cardano/Kuber/Core/TxFramework.hs index e94a4ac..32ffcc5 100644 --- a/src/Cardano/Kuber/Core/TxFramework.hs +++ b/src/Cardano/Kuber/Core/TxFramework.hs @@ -71,6 +71,14 @@ import Cardano.Ledger.Coin (Coin(Coin)) import qualified Data.Aeson.KeyMap as A import qualified Data.Aeson.Key as A import qualified Data.HashMap.Lazy as HMap +import Data.Time (nominalDiffTimeToSeconds) +import Cardano.Ledger.Alonzo.TxInfo (slotToPOSIXTime) +import qualified Data.Text as Text +import Cardano.Ledger.Slot (EpochInfo, epochInfoFirst) +import Cardano.Slotting.EpochInfo (hoistEpochInfo, epochInfoSlotToUTCTime) +import Ouroboros.Consensus.HardFork.History.EpochInfo (interpreterToEpochInfo) +import Control.Monad.Trans.Except(runExcept) +import Data.Time.Clock.POSIX (utcTimeToPOSIXSeconds) type BoolChange = Bool type BoolFee = Bool @@ -161,6 +169,12 @@ txBuilderToTxBody' dCinfo@(DetailedChainInfo cpw conn pParam ledgerPParam syste (UTxO availableUtxo) (TxBuilder selections _inputs _inputRefs _outputs _collaterals validityStart validityEnd mintData extraSignatures explicitFee mChangeAddr metadata ) = do + -- (toLedgerPParams era pparams) + -- tx + -- (toLedgerUTxO era utxo) + -- (toLedgerEpochInfo history) + -- systemstart + -- cModelArray let network = getNetworkId dCinfo (resolvedMints, unresolvedMints) <- classifyMints (UTxO availableUtxo) mintData <&> partitionEithers let mergedMetadata = foldl injectMetadataPolicy (foldl injectMetadataPolicy metadata resolvedMints) unresolvedMints @@ -242,7 +256,7 @@ txBuilderToTxBody' dCinfo@(DetailedChainInfo cpw conn pParam ledgerPParam syste in iteratedBalancing 10 txBody1 fee1 ) ) - + respond finalBody finalSignatories where applyMintExUnits :: Map PolicyId ExecutionUnits @@ -757,11 +771,14 @@ txBuilderToTxBody' dCinfo@(DetailedChainInfo cpw conn pParam ledgerPParam syste txOutValue_ txout= case txout of { TxOut aie tov tod _-> txOutValueToValue tov } txLowerBound = case validityStart of - Nothing -> TxValidityNoLowerBound - Just v -> TxValidityLowerBound ValidityLowerBoundInBabbageEra (toSlot v) + NoValidityTime -> TxValidityNoLowerBound + ValidityPosixTime ndt -> TxValidityLowerBound ValidityLowerBoundInBabbageEra (toSlot ndt) + ValiditySlot sn -> TxValidityLowerBound ValidityLowerBoundInBabbageEra sn txUpperBound = case validityEnd of - Nothing -> TxValidityNoUpperBound ValidityNoUpperBoundInBabbageEra - Just n -> TxValidityUpperBound ValidityUpperBoundInBabbageEra (toSlot n) + NoValidityTime -> TxValidityNoUpperBound ValidityNoUpperBoundInBabbageEra + ValidityPosixTime ndt -> TxValidityUpperBound ValidityUpperBoundInBabbageEra (toSlot ndt) + ValiditySlot sn -> TxValidityUpperBound ValidityUpperBoundInBabbageEra sn + plutusWitness script _data redeemer exUnits = PlutusScriptWitness PlutusScriptV2InBabbage PlutusScriptV2 script @@ -781,11 +798,11 @@ txBuilderToTxBody' dCinfo@(DetailedChainInfo cpw conn pParam ledgerPParam syste -- case x of -- Left tbe -> throw $ SomeError $ "First Balance :" ++ show tbe -- Right res -> pure res - toSlot tStamp= case getNetworkId dCinfo of - Mainnet -> SlotNo $ fromIntegral $ mainnetSlot tStamp - Testnet nm -> SlotNo $ fromIntegral $ testnetSlot tStamp - testnetSlot timestamp= ((timestamp -1607199617000) `div` 1000 )+ 12830401 -- using epoch 100 as refrence - mainnetSlot timestamp = ((timestamp -1596491091000 ) `div` 1000 )+ 4924800 -- using epoch 209 as reference + toSlot tStamp = case getNetworkId dCinfo of + Mainnet -> SlotNo $ fromIntegral $ mainnetSlot $ round tStamp + Testnet nm -> SlotNo $ fromIntegral $ testnetSlot $ round tStamp + testnetSlot timestamp= (timestamp -1607199617 )+ 12830401 -- using epoch 100 as refrence + mainnetSlot timestamp = (timestamp -1596491091 )+ 4924800 -- using epoch 209 as reference -- mkBalancedBody :: ProtocolParameters -- -> UTxO BabbageEra @@ -954,3 +971,8 @@ txBuilderToTxBody' dCinfo@(DetailedChainInfo cpw conn pParam ledgerPParam syste -- gatherInfo cInfo txBuilder@TxBuilder{txSelections, txInputs} = do -- error "sad" -- where + +toLedgerEpochInfo :: EraHistory mode -> EpochInfo (Either Text.Text) +toLedgerEpochInfo (EraHistory _ interpreter) = + hoistEpochInfo (first (Text.pack . show) . runExcept) $ + interpreterToEpochInfo interpreter \ No newline at end of file diff --git a/src/Cardano/Kuber/Data/TxBuilderAeson.hs b/src/Cardano/Kuber/Data/TxBuilderAeson.hs index dc384a2..08da4b1 100644 --- a/src/Cardano/Kuber/Data/TxBuilderAeson.hs +++ b/src/Cardano/Kuber/Data/TxBuilderAeson.hs @@ -63,22 +63,36 @@ import qualified Data.ByteString.Char8 as BS8 import Control.Applicative ((<|>)) import Data.Bifunctor (second) + + + + instance FromJSON TxBuilder where - parseJSON (A.Object v) = + parseJSON (A.Object v) =do TxBuilder <$> (v .?< "selection") <*> v .?< "input" <*> v .?< "referenceInput" <*> v .?< "output" <*> v .?< "collateral" - <*> v .:? "validityStart" - <*> v .:? "validityEnd" + <*> v `parseValidity` "validityStart" + <*> v `parseValidity` "validityEnd" <*> v .?< "mint" <*> v .?< "signature" <*> v .:? "fee" <*> (v .:? "changeAddress" <&> fmap unAddressModal) <*> (v.:? "metadata" .!= Map.empty) where + parseValidity obj key = do + mPosixTime <- obj .:? key + case mPosixTime of + Just posixTime -> pure $ ValidityPosixTime posixTime + Nothing -> do + mSlot <- obj .:? (key <> "Slot") + case mSlot of + Just slot -> pure $ ValiditySlot $ SlotNo $ slot + _ -> pure $ NoValidityTime + (.?<) :: FromJSON v=> A.Object -> T.Text -> Parser [v] (.?<) obj key = do mVal1<- obj .:? A.fromText key @@ -162,20 +176,24 @@ instance ToJSON TxBuilder where appendNonEmpty :: (Foldable t, KeyValue a1, ToJSON (t a2)) => A.Key -> t a2 -> [a1] -> [a1] appendNonEmpty key val obj = if null val then obj else (key .= val) : obj + appendValidity key val obj = case val of + NoValidityTime -> obj + ValidityPosixTime ndt -> (key .= ndt) : obj + ValiditySlot sn -> ((key <> "Slot" ) .= sn) : obj + nonEmpyPair :: [A.Pair] nonEmpyPair = "selections" >= selections <+> "inputs" >= inputs <+> "referenceInputs">= map (\(TxInputReference tin) ->renderTxIn tin) refInputs <+> "collaterals" >= collaterals <+> "mint" >= mintData - <+> "outputs" >= outputs - <+> "validityStart" >= validityStart - <+> "validityEnd" >= validityEnd + <+> "outputs" >= outputs + <+> "validityStart" `appendValidity` validityStart + <+> "validityEnd" `appendValidity` validityEnd <+> "signatures" >= signatures <+> "fee" >= fee <+> "changeAddress" >= defaultChangeAddr <#> "metadata" >= metadata - infixl 8 >= (>=) a b = appendNonEmpty a b infixr 7 <#>