Merge pull request #511 from Plutonomicon/neil/fix-eval-ex-units

Fix eval-ex-units and fees endpoints

.gitignore

@@ -18,6 +18,7 @@ result-*
 .node-cfg
 /server/dist-newstyle
 /server/dist-newstyle/
+/server/dist/
 .projectile
 /dist/
 output.js

server/README.md

@@ -14,7 +14,7 @@ We plan on supporting at least the following features:
 
 Run `nix develop .#hsDevShell` (or equivalently `nix develop .#package.x86_64-{linux|darwin}`; NB: not currently tested on macOS) in the repository root (i.e. up one level from `server`). This will place you in a development shell with `cabal`, `hoogle`, `haskell-language-server`, etc...
 
-The server executable can be built with `nix build .#cardano-trasaction-lib-server:exe:cardano-trasaction-lib-server` and run with `./result/bin/cardano-trasaction-lib-server`. `cabal` can also be used once in the development shell. The server will run on port 8081. You can optionally pass the `--port`/`-p` flag to explicitly choose a port to run on
+The server executable can be built with `nix build .#ctl-server:exe:ctl-server` and run with `./result/bin/ctl-server`. `cabal` can also be used once in the development shell. The server will run on port 8081. You can optionally pass the `--port`/`-p` flag to explicitly choose a port to run on
 
 ---
 
@@ -51,14 +51,20 @@ The server executable can be built with `nix build .#cardano-trasaction-lib-serv
 "4d01000033222220051200120011"
 ```
 
-## GET /eval-ex-units
+## POST /eval-ex-units
 
-### GET Parameters:
+### Request:
+
+- Supported content types are:
+
+    - `application/json;charset=utf-8`
+    - `application/json`
 
-- tx
-    - **Values**: *84a300818258205d677265fa5bb21ce6d8c7502aca70b9316d10e958611f3c6b758f65ad9599960001818258390030fb3b8539951e26f034910a5a37f22cb99d94d1d409f69ddbaea9711c12f03c1ef2e935acc35ec2e6f96c650fd3bfba3e96550504d5336100021a0002b569a0f5f6*
-    - **Description**: A CBOR-encoded `Tx AlonzoEra`; should be sent as a hexadecimal string
+- The input should contain the CBOR of the tx (`application/json;charset=utf-8`, `application/json`):
 
+```javascript
+{"tx":"00"}
+```
 
 ### Response:
 
@@ -76,18 +82,20 @@ The server executable can be built with `nix build .#cardano-trasaction-lib-serv
 [{"exUnitsSteps":0,"rdmrPtrTag":0,"exUnitsMem":0,"rdmrPtrIdx":0}]
 ```
 
-## GET /fees
+## POST /fees
 
-### GET Parameters:
+### Request:
 
-- wit-count
-    - **Values**: *1*
-    - **Description**: A natural number representing the intended number of key witnessesfor the transaction
+- Supported content types are:
 
-- tx
-    - **Values**: *84a300818258205d677265fa5bb21ce6d8c7502aca70b9316d10e958611f3c6b758f65ad9599960001818258390030fb3b8539951e26f034910a5a37f22cb99d94d1d409f69ddbaea9711c12f03c1ef2e935acc35ec2e6f96c650fd3bfba3e96550504d5336100021a0002b569a0f5f6*
-    - **Description**: A CBOR-encoded `Tx AlonzoEra`; should be sent as a hexadecimal string
+    - `application/json;charset=utf-8`
+    - `application/json`
 
+- The input should contain the intended number of witnesses and theCBOR of the tx (`application/json;charset=utf-8`, `application/json`):
+
+```javascript
+{"tx":"00","count":1}
+```
 
 ### Response:
 

server/ctl-server.cabal

@@ -15,6 +15,7 @@ common common-language
     DeriveLift
     DeriveTraversable
     DerivingStrategies
+    DuplicateRecordFields
     ExplicitForAll
     FlexibleContexts
     FlexibleInstances
@@ -23,6 +24,7 @@ common common-language
     LambdaCase
     MonoLocalBinds
     MultiParamTypeClasses
+    NamedFieldPuns
     NumericUnderscores
     OverloadedStrings
     QuasiQuotes

server/src/Api.hs

@@ -19,14 +19,11 @@ import Data.Proxy (Proxy (Proxy))
 import Network.Wai.Middleware.Cors qualified as Cors
 import Servant (
   Application,
-  Get,
   Handler,
   HasServer (ServerT),
   JSON,
   Post,
-  QueryParam',
   ReqBody,
-  Required,
   Server,
   ServerError (errBody),
   err400,
@@ -47,31 +44,30 @@ import Types (
     ScriptExecutionError,
     TxValidityIntervalError
   ),
-  Cbor,
   CborDecodeError (InvalidCbor, InvalidHex, OtherDecodeError),
   CtlServerError (CardanoError, CborDecode),
   Env,
+  EvalExUnitsRequest,
   ExecutionUnitsMap,
   Fee,
+  FeesRequest,
   FinalizeRequest,
   FinalizedTransaction,
-  WitnessCount,
  )
 import Utils (lbshow)
 
 type Api =
   "fees"
-    :> QueryParam' '[Required] "count" WitnessCount
-    :> QueryParam' '[Required] "tx" Cbor
-    :> Get '[JSON] Fee
+    :> ReqBody '[JSON] FeesRequest
+    :> Post '[JSON] Fee
     -- Since @Script@ and @Data@ have @From/ToJSON@ instances, we can just
     -- accept them in the body of a POST request
     :<|> "apply-args"
       :> ReqBody '[JSON] ApplyArgsRequest
       :> Post '[JSON] AppliedScript
     :<|> "eval-ex-units"
-      :> QueryParam' '[Required] "tx" Cbor
-      :> Get '[JSON] ExecutionUnitsMap
+      :> ReqBody '[JSON] EvalExUnitsRequest
+      :> Post '[JSON] ExecutionUnitsMap
     :<|> "finalize"
       :> ReqBody '[JSON] FinalizeRequest
       :> Post '[JSON] FinalizedTransaction
@@ -133,9 +129,9 @@ server =
 apiDocs :: Docs.API
 apiDocs = Docs.docs api
 
-estimateTxFees :: WitnessCount -> Cbor -> ClientM Fee
+estimateTxFees :: FeesRequest -> ClientM Fee
 applyArgs :: ApplyArgsRequest -> ClientM AppliedScript
-evalTxExecutionUnits :: Cbor -> ClientM ExecutionUnitsMap
+evalTxExecutionUnits :: EvalExUnitsRequest -> ClientM ExecutionUnitsMap
 finalizeTx :: FinalizeRequest -> ClientM FinalizedTransaction
 estimateTxFees
   :<|> applyArgs

server/src/Api/Handlers.hs

@@ -1,5 +1,3 @@
-{-# LANGUAGE NamedFieldPuns #-}
-
 module Api.Handlers (
   estimateTxFees,
   applyArgs,
@@ -53,8 +51,10 @@ import Types (
   CborDecodeError (InvalidCbor, InvalidHex, OtherDecodeError),
   CtlServerError (CardanoError, CborDecode),
   Env (protocolParams),
+  EvalExUnitsRequest (EvalExUnitsRequest, tx),
   ExecutionUnitsMap (ExecutionUnitsMap),
   Fee (Fee),
+  FeesRequest (FeesRequest, count, tx),
   FinalizeRequest (FinalizeRequest, datums, redeemers, tx),
   FinalizedTransaction (FinalizedTransaction),
   RdmrPtrExUnits (
@@ -72,14 +72,15 @@ import Types (
 -- Handlers
 --------------------------------------------------------------------------------
 
-estimateTxFees :: WitnessCount -> Cbor -> AppM Fee
-estimateTxFees (WitnessCount numWits) cbor = do
-  decodeCborTx cbor & either (throwM . CborDecode) pure >>= \case
+estimateTxFees :: FeesRequest -> AppM Fee
+estimateTxFees FeesRequest {count, tx} = do
+  decodeCborTx tx & either (throwM . CborDecode) pure >>= \case
     C.Tx txBody' keyWits -> do
       pparams <- asks protocolParams
       -- calculate and set script integrity hash before estimating fees
-      let txBody = setScriptIntegrityHash pparams txBody'
-          fee = estimateFee pparams numWits (C.Tx txBody keyWits)
+      let WitnessCount witCount = count
+          txBody = setScriptIntegrityHash pparams txBody'
+          fee = estimateFee pparams witCount (C.Tx txBody keyWits)
       Fee <$> finalizeTxFee fee
   where
     -- `txfee` value must also be taken into account when calculating fees,
@@ -115,9 +116,9 @@ applyArgs ApplyArgsRequest {script, args} =
 {- | Computes the execution units needed for each script in the transaction.
  https://input-output-hk.github.io/cardano-node/cardano-api/src/Cardano.Api.Fees.html#evaluateTransactionExecutionUnits
 -}
-evalTxExecutionUnits :: Cbor -> AppM ExecutionUnitsMap
-evalTxExecutionUnits cbor =
-  case decodeCborTx cbor of
+evalTxExecutionUnits :: EvalExUnitsRequest -> AppM ExecutionUnitsMap
+evalTxExecutionUnits EvalExUnitsRequest {tx} =
+  case decodeCborTx tx of
     Left err ->
       throwM (CborDecode err)
     Right (C.Tx txBody@(C.TxBody txBodyContent) _) -> do

server/src/Ogmios/Query.hs

@@ -87,6 +87,6 @@ tryQueryUntilZero query remainAttempts
         putStrLn $ "Error : " <> show e
         putStrLn "Waiting for ogmios conection attempt"
         putStrLn $ "Attempts remain : " <> show (remainAttempts -1)
-        Time.Extra.sleep 0.5
+        Time.Extra.sleep 3
         hFlush stdout
-        tryQueryUntilZero query (remainAttempts - 1)
+        tryQueryUntilZero query $ remainAttempts - 1

server/src/Types.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE DerivingVia #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 
 module Types (
   AppM (AppM),
@@ -9,8 +10,10 @@ module Types (
   RdmrPtrExUnits (..),
   Fee (..),
   WitnessCount (..),
+  FeesRequest (..),
   ApplyArgsRequest (..),
   AppliedScript (..),
+  EvalExUnitsRequest (..),
   FinalizeRequest (..),
   FinalizedTransaction (..),
   CardanoError (..),
@@ -124,13 +127,20 @@ data RdmrPtrExUnits = RdmrPtrExUnits
   deriving stock (Show, Generic)
   deriving anyclass (FromJSON, ToJSON)
 
+data FeesRequest = FeesRequest
+  { count :: WitnessCount
+  , tx :: Cbor
+  }
+  deriving stock (Show, Eq, Generic)
+  deriving anyclass (FromJSON, ToJSON)
+
 newtype Fee = Fee Integer
   deriving stock (Show, Generic)
   deriving newtype (Eq)
 
 newtype WitnessCount = WitnessCount Word
   deriving stock (Show, Generic)
-  deriving newtype (Eq, FromHttpApiData, ToHttpApiData)
+  deriving newtype (Eq, FromJSON, ToJSON)
 
 instance ToJSON Fee where
   -- to avoid issues with integer parsing in PS, we should probably return
@@ -157,6 +167,12 @@ newtype AppliedScript = AppliedScript Ledger.Script
   deriving stock (Show, Generic)
   deriving newtype (Eq, FromJSON, ToJSON)
 
+newtype EvalExUnitsRequest = EvalExUnitsRequest
+  { tx :: Cbor
+  }
+  deriving stock (Show, Generic, Eq)
+  deriving anyclass (FromJSON, ToJSON)
+
 data FinalizeRequest = FinalizeRequest
   { tx :: Cbor
   , datums :: [Cbor]
@@ -213,14 +229,22 @@ instance Docs.ToParam (QueryParam' '[Required] "tx" Cbor) where
           , "3e96550504d5336100021a0002b569a0f5f6"
           ]
 
-instance Docs.ToParam (QueryParam' '[Required] "count" WitnessCount) where
-  toParam _ =
-    Docs.DocQueryParam
-      "wit-count"
-      ["1"]
-      "A natural number representing the intended number of key witnesses\
-      \for the transaction"
-      Docs.Normal
+instance Docs.ToSample FeesRequest where
+  toSamples _ =
+    [
+      ( "The input should contain the intended number of witnesses and the\
+        \CBOR of the tx"
+      , FeesRequest (WitnessCount 1) (Cbor "00")
+      )
+    ]
+
+instance Docs.ToSample EvalExUnitsRequest where
+  toSamples _ =
+    [
+      ( "The input should contain the CBOR of the tx"
+      , EvalExUnitsRequest (Cbor "00")
+      )
+    ]
 
 instance Docs.ToSample ExecutionUnitsMap where
   toSamples _ =

server/test/Main.hs

@@ -40,8 +40,9 @@ import Cardano.Api.Shelley (
   ),
  )
 import Data.Bifunctor (second)
-import Data.ByteString.Lazy qualified as ByteString
+import Data.ByteString.Lazy qualified as LBS
 import Data.ByteString.Lazy.Char8 qualified as LC8
+import Data.Functor ((<&>))
 import Data.Kind (Type)
 import Data.Map.Strict qualified as Map.Strict
 import Network.HTTP.Client (defaultManagerSettings, newManager)
@@ -79,6 +80,7 @@ import Types (
   Cbor (Cbor),
   Env (Env),
   Fee (Fee),
+  FeesRequest (FeesRequest),
   ServerOptions (
     ServerOptions,
     networkId,
@@ -130,21 +132,23 @@ feeEstimateSpec = around withTestApp $ do
   context "GET fees" $ do
     it "estimates the correct fee" $ \port -> do
       result <-
-        runClientM' (clientEnv port) $
-          estimateTxFees (WitnessCount 1) cborTxFixture
+        runClientM' (clientEnv port) . estimateTxFees $
+          FeesRequest (WitnessCount 1) cborTxFixture
       result `shouldBe` Right (Fee 168625)
 
     it "catches invalid hex strings" $ \port -> do
       result <-
         runClientM' (clientEnv port)
-          . estimateTxFees (WitnessCount 1)
+          . estimateTxFees
+          . FeesRequest (WitnessCount 1)
           $ Cbor "deadbeefq"
       result `shouldSatisfy` expectError 400 "invalid bytestring size"
 
     it "catches invalid CBOR-encoded transactions" $ \port -> do
       result <-
         runClientM' (clientEnv port)
-          . estimateTxFees (WitnessCount 1)
+          . estimateTxFees
+          . FeesRequest (WitnessCount 1)
           $ Cbor "deadbeef"
       result
         `shouldSatisfy` expectError
@@ -284,7 +288,7 @@ fixedProtocolParameters :: ProtocolParameters
 fixedProtocolParameters =
   ProtocolParameters
     { protocolParamProtocolVersion = (6, 0)
-    , protocolParamDecentralization = 0 / 1
+    , protocolParamDecentralization = 0
     , protocolParamExtraPraosEntropy = Nothing
     , protocolParamMaxBlockHeaderSize = 1100
     , protocolParamMaxBlockBodySize = 98304
@@ -327,8 +331,8 @@ fixedProtocolParameters =
 
 loadParametersFile :: IO (Either String ProtocolParameters)
 loadParametersFile =
-  ByteString.readFile "test/ogmios.json"
-    >>= pure . decodeProtocolParameters
+  LBS.readFile "test/ogmios.json"
+    <&> decodeProtocolParameters
 
 testParser :: Spec
 testParser =

src/QueryM.purs

@@ -392,12 +392,8 @@ txToHex tx =
 calculateMinFee :: Transaction -> QueryM (Either ClientError Coin)
 calculateMinFee tx@(Transaction { body: Transaction.TxBody body }) = do
   txHex <- liftEffect (txToHex tx)
-  url <- mkServerEndpointUrl
-    $ "fees?tx="
-        <> txHex
-        <> "&count="
-        <> UInt.toString witCount
-  liftAff (Affjax.get Affjax.ResponseFormat.string url)
+  url <- mkServerEndpointUrl "fees"
+  liftAff (postAeson url (encodeAeson { count: witCount, tx: txHex }))
     <#> either
       (Left <<< ClientHttpError)
       ( bimap ClientDecodeJsonError (wrap <<< unwrap :: FeeEstimate -> Coin)
@@ -440,8 +436,8 @@ evalTxExecutionUnits
   :: Transaction -> QueryM (Either ClientError (Array RdmrPtrExUnits))
 evalTxExecutionUnits tx = do
   txHex <- liftEffect (txToHex tx)
-  url <- mkServerEndpointUrl ("eval-ex-units?tx=" <> txHex)
-  liftAff (Affjax.get Affjax.ResponseFormat.string url)
+  url <- mkServerEndpointUrl "eval-ex-units"
+  liftAff (postAeson url (encodeAeson { tx: txHex }))
     <#> either
       (Left <<< ClientHttpError)
       ( lmap ClientDecodeJsonError <<< (decodeAeson <=< parseJsonStringToAeson)