Convert Text to TxId, update examples

Author: samuelWilliams99

examples/plutus-game/app/Main.hs

@@ -66,6 +66,6 @@ main = do
           , pcDryRun = True
           , pcLogLevel = Debug
           , pcProtocolParamsFile = "./protocol.json"
-          , pcEnableTxEndpoint = False
+          , pcEnableTxEndpoint = True
           }
   BotPlutusInterface.runPAB @GameContracts pabConf

examples/plutus-nft/app/Main.hs

@@ -66,6 +66,6 @@ main = do
           , pcDryRun = True
           , pcLogLevel = Debug
           , pcProtocolParamsFile = "./protocol.json"
-          , pcEnableTxEndpoint = False
+          , pcEnableTxEndpoint = True
           }
   BotPlutusInterface.runPAB @MintNFTContracts pabConf

examples/plutus-transfer/app/Main.hs

@@ -65,5 +65,6 @@ main = do
           , pcDryRun = True
           , pcLogLevel = Debug
           , pcProtocolParamsFile = "./protocol.json"
+          , pcEnableTxEndpoint = True
           }
   BotPlutusInterface.runPAB @TransferContracts pabConf

src/BotPlutusInterface/Files.hs

@@ -9,6 +9,7 @@ module BotPlutusInterface.Files (
   signingKeyFilePath,
   txFilePath,
   txFileName,
+  txIdToText,
   writeAll,
   writePolicyScriptFile,
   redeemerJsonFilePath,
@@ -84,7 +85,7 @@ import Plutus.V1.Ledger.Api (
  )
 import PlutusTx (ToData, toData)
 import PlutusTx.Builtins (fromBuiltin)
-import System.FilePath (replaceExtension, takeExtension, (</>))
+import System.FilePath (takeExtension, (</>))
 import Prelude
 
 -- | Filename of a minting policy script
@@ -115,12 +116,13 @@ signingKeyFilePath pabConf (PubKeyHash pubKeyHash) =
    in pabConf.pcSigningKeyFileDir <> "/signing-key-" <> h <> ".skey"
 
 txFilePath :: PABConfig -> Text -> Tx.Tx -> Text
-txFilePath pabConf ext tx =
-  let txId = encodeByteString $ fromBuiltin $ TxId.getTxId $ Tx.txId tx
-   in pabConf.pcTxFileDir <> "/" <> txFileName txId ext
+txFilePath pabConf ext tx = pabConf.pcTxFileDir <> "/" <> txFileName (Tx.txId tx) ext
 
-txFileName :: Text -> Text -> Text
-txFileName name ext = Text.pack $ replaceExtension ("tx-" <> Text.unpack name) (Text.unpack ext)
+txFileName :: TxId.TxId -> Text -> Text
+txFileName txId ext = "tx-" <> txIdToText txId <> "." <> ext
+
+txIdToText :: TxId.TxId -> Text
+txIdToText = encodeByteString . fromBuiltin . TxId.getTxId
 
 -- | Compiles and writes a script file under the given folder
 writePolicyScriptFile ::

src/BotPlutusInterface/Server.hs

@@ -6,10 +6,11 @@ module BotPlutusInterface.Server (
   WebSocketEndpoint,
   ActivateContractEndpoint,
   RawTxEndpoint,
+  TxIdCapture (TxIdCapture),
 ) where
 
 import BotPlutusInterface.Contract (runContract)
-import BotPlutusInterface.Files (txFileName)
+import BotPlutusInterface.Files (txFileName, txIdToText)
 import BotPlutusInterface.Types (
   AppState (AppState),
   ContractEnvironment (..),
@@ -25,15 +26,18 @@ import Control.Monad.Error.Class (throwError)
 import Control.Monad.IO.Class (liftIO)
 import Data.Aeson (FromJSON, ToJSON (toJSON))
 import Data.Aeson qualified as JSON
+import Data.Bifunctor (bimap)
 import Data.ByteString.Lazy qualified as LBS
 import Data.Either.Combinators (leftToMaybe)
 import Data.Kind (Type)
 import Data.Map qualified as Map
 import Data.Maybe (catMaybes)
 import Data.Proxy (Proxy (Proxy))
 import Data.Row (Row)
-import Data.Text (Text, unpack)
+import Data.Text (Text, pack, unpack)
+import Data.Text.Encoding (encodeUtf8)
 import Data.UUID.V4 qualified as UUID
+import Ledger.TxId (TxId (TxId))
 import Network.WebSockets (
   Connection,
   PendingConnection,
@@ -56,7 +60,19 @@ import Plutus.PAB.Webserver.Types (
   ContractActivationArgs (..),
   InstanceStatusToClient (ContractFinished, NewObservableState),
  )
-import Servant.API (Capture, Get, JSON, Post, ReqBody, (:<|>) (..), (:>))
+import Plutus.V1.Ledger.Bytes (LedgerBytes (LedgerBytes), fromHex)
+import PlutusTx.Prelude (lengthOfByteString)
+import Servant.API (
+  Capture,
+  FromHttpApiData (parseUrlPiece),
+  Get,
+  JSON,
+  Post,
+  ReqBody,
+  ToHttpApiData (toUrlPiece),
+  (:<|>) ((:<|>)),
+  (:>),
+ )
 import Servant.API.WebSocket (WebSocketPending)
 import Servant.Server (Application, Handler, Server, err404, serve)
 import System.Directory (canonicalizePath, doesFileExist, makeAbsolute)
@@ -85,9 +101,26 @@ type ActivateContractEndpoint a =
 
 type RawTxEndpoint =
   "raw-tx"
-    :> Capture "txId" Text
+    :> Capture "tx-id" TxIdCapture
     :> Get '[JSON] RawTx
 
+newtype TxIdCapture = TxIdCapture TxId
+
+instance FromHttpApiData TxIdCapture where
+  parseUrlPiece :: Text -> Either Text TxIdCapture
+  parseUrlPiece t = bimap pack bytesToTxIdCapture $ checkLength =<< fromHex (encodeUtf8 t)
+    where
+      checkLength :: LedgerBytes -> Either String LedgerBytes
+      checkLength b@(LedgerBytes bs) =
+        if lengthOfByteString bs == 32
+          then Right b
+          else Left "Invalid length"
+      bytesToTxIdCapture :: LedgerBytes -> TxIdCapture
+      bytesToTxIdCapture (LedgerBytes b) = TxIdCapture $ TxId b
+
+instance ToHttpApiData TxIdCapture where
+  toUrlPiece (TxIdCapture txId) = txIdToText txId
+
 server :: HasDefinitions t => PABConfig -> AppState -> Server (API t)
 server pabConfig state =
   websocketHandler state
@@ -234,16 +267,16 @@ handleContract pabConf state@(AppState st) contract = liftIO $ do
   pure contractInstanceID
 
 -- | This handler will allow to retrieve raw transactions from the pcTxFileDir if pcEnableTxEndpoint is True
-rawTxHandler :: PABConfig -> Text -> Handler RawTx
-rawTxHandler config txId = do
+rawTxHandler :: PABConfig -> TxIdCapture -> Handler RawTx
+rawTxHandler config (TxIdCapture txId) = do
   -- Check that endpoint is enabled
   assert config.pcEnableTxEndpoint
   -- Absolute path to pcTxFileDir that is specified in the config
   txFolderPath <- liftIO $ makeAbsolute (unpack config.pcTxFileDir)
 
   -- Add/Set .raw extension on path
   let suppliedPath :: FilePath
-      suppliedPath = txFolderPath </> unpack (txFileName txId ".raw")
+      suppliedPath = txFolderPath </> unpack (txFileName txId "raw")
   -- Resolve path indirections
   path <- liftIO $ canonicalizePath suppliedPath
   -- ensure it does not try to escape txFolderPath

test/Spec/BotPlutusInterface/Server.hs

@@ -1,14 +1,15 @@
 module Spec.BotPlutusInterface.Server (tests) where
 
 import BotPlutusInterface.Files (txFileName)
-import BotPlutusInterface.Server (RawTxEndpoint, app, initState)
+import BotPlutusInterface.Server (RawTxEndpoint, TxIdCapture (TxIdCapture), app, initState)
 import BotPlutusInterface.Types (
   HasDefinitions (..),
   PABConfig (..),
   RawTx (..),
   SomeBuiltin (..),
  )
 
+import Ledger.TxId (TxId)
 import Playground.Types (FunctionSchema)
 import Schema (FormSchema)
 
@@ -25,14 +26,14 @@ import Data.Aeson (FromJSON, ToJSON, encode)
 import Data.ByteString.Lazy qualified as LBS
 import Data.Default (def)
 import Data.Proxy (Proxy (..))
-import Data.Text (Text, pack, unpack)
+import Data.Text (pack, unpack)
 import Data.Void (Void, absurd)
 import System.FilePath ((</>))
 import System.IO.Temp (withSystemTempDirectory)
 import Prelude
 
 type RawTxEndpointResponse = Either ClientError RawTx
-type RawTxTest a = (Text -> IO RawTxEndpointResponse) -> IO a
+type RawTxTest a = (TxId -> IO RawTxEndpointResponse) -> IO a
 
 tests :: TestTree
 tests =
@@ -46,8 +47,7 @@ rawTxTests =
   testGroup
     "rawTx"
     [ testCase "Can fetch valid tx file" fetchTx
-    , testCase "If an extension is supplied, it is replaced by .raw" fetchSignedTx
-    , testCase "Unable to fetch outside tx folder" fetchOutsideTxFolder
+    , testCase "Returns 404 for missing txs" fetchMissingTx
     , testCase "Returns 404 for valid request when the endpoint is disabled" fetchWithDefaultConfig
     ]
   where
@@ -57,16 +57,10 @@ rawTxTests =
         result <- runRawTxClient txHash
         result @?= Right rawTx
 
-    fetchSignedTx :: IO ()
-    fetchSignedTx = do
+    fetchMissingTx :: IO ()
+    fetchMissingTx = do
       initServerAndClient enableTxEndpointConfig $ \runRawTxClient -> do
-        result <- runRawTxClient $ txHash <> ".signed"
-        result @?= Right rawTx
-
-    fetchOutsideTxFolder :: IO ()
-    fetchOutsideTxFolder = do
-      initServerAndClient enableTxEndpointConfig $ \runRawTxClient -> do
-        Left (FailureResponse _ res) <- runRawTxClient "../somefile"
+        Left (FailureResponse _ res) <- runRawTxClient txHash2
         responseStatusCode res @?= status404
 
     fetchWithDefaultConfig :: IO ()
@@ -95,16 +89,19 @@ initServerAndClient config test = do
       let clientEnv :: ClientEnv
           clientEnv = mkClientEnv manager $ baseUrl {baseUrlPort = port}
 
-          runRawTxClient :: Text -> IO RawTxEndpointResponse
-          runRawTxClient hash = runClientM (client txProxy hash) clientEnv
+          runRawTxClient :: TxId -> IO RawTxEndpointResponse
+          runRawTxClient txId = runClientM (client txProxy (TxIdCapture txId)) clientEnv
 
       testToRun runRawTxClient
 
-txHash :: Text
-txHash = "test"
+txHash :: TxId
+txHash = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
+
+txHash2 :: TxId
+txHash2 = "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb"
 
 testTxFileName :: FilePath
-testTxFileName = unpack $ txFileName txHash ".raw"
+testTxFileName = unpack $ txFileName txHash "raw"
 
 rawTx :: RawTx
 rawTx =