Skip to content

Commit

Permalink
Add transaction validity by slot
Browse files Browse the repository at this point in the history
  • Loading branch information
mesudip committed Aug 15, 2022
1 parent f5ef7c0 commit 383a845
Show file tree
Hide file tree
Showing 8 changed files with 147 additions and 61 deletions.
4 changes: 2 additions & 2 deletions docker-compose.yml
Original file line number Diff line number Diff line change
@@ -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:
Expand All @@ -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:
Expand Down
19 changes: 13 additions & 6 deletions docs/json-api-reference.md
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down Expand Up @@ -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.
Expand Down
5 changes: 4 additions & 1 deletion kuber.cabal
Original file line number Diff line number Diff line change
@@ -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:
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion server/kuber-server.cabal
Original file line number Diff line number Diff line change
@@ -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:
Expand Down
10 changes: 6 additions & 4 deletions src/Cardano/Kuber/Api.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
94 changes: 64 additions & 30 deletions src/Cardano/Kuber/Core/TxBuilder.hs
Original file line number Diff line number Diff line change
Expand Up @@ -6,6 +6,7 @@
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeApplications #-}
module Cardano.Kuber.Core.TxBuilder

where
Expand All @@ -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
Expand Down Expand Up @@ -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 )
Expand Down Expand Up @@ -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
Expand All @@ -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,
Expand All @@ -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{
Expand All @@ -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
Expand All @@ -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]
Expand Down
42 changes: 32 additions & 10 deletions src/Cardano/Kuber/Core/TxFramework.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down Expand Up @@ -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
Loading

0 comments on commit 383a845

Please sign in to comment.