Add transaction validity by slot

Author: mesudip

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:

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.

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

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:

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

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]

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