Change return type to RawTx from Text

Change-type: patch
Signed-off-by: Giovanni Garufi <giovanni@mlabs.city>

Author: nazrhom

src/BotPlutusInterface/Server.hs

@@ -8,6 +8,7 @@ import BotPlutusInterface.Types (
   ContractEnvironment (..),
   ContractState (ContractState, csActivity, csObservableState),
   PABConfig (..),
+  RawTx,
   SomeContractState (SomeContractState),
  )
 import Control.Concurrent (ThreadId, forkIO)
@@ -17,14 +18,14 @@ 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.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.IO qualified as Text
 import Data.UUID.V4 qualified as UUID
 import Network.WebSockets (
   Connection,
@@ -70,7 +71,7 @@ type API a =
          )
     :<|> ( "rawTx"
             :> Capture "hash" Text
-            :> Get '[JSON] Text
+            :> Get '[JSON] RawTx
          )
 
 server :: HasDefinitions t => PABConfig -> AppState -> Server (API t)
@@ -219,7 +220,7 @@ 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 Text
+rawTxHandler :: PABConfig -> Text -> Handler RawTx
 rawTxHandler config hash = do
   -- Check that endpoint is enabled
   assert (pcEnableTxEndpoint config)
@@ -237,8 +238,10 @@ rawTxHandler config hash = do
   fileExists <- liftIO $ doesFileExist path
   assert fileExists
 
-  -- Read contents of path
-  liftIO $ Text.readFile path
+  contents <- liftIO $ LBS.readFile path
+  case JSON.decode contents of
+    Just rawTx -> pure rawTx
+    Nothing -> throwError err404
   where
     assert :: Bool -> Handler ()
     assert True = pure ()

src/BotPlutusInterface/Types.hs

@@ -1,4 +1,5 @@
 {-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TemplateHaskell #-}
 
 module BotPlutusInterface.Types (
   PABConfig (..),
@@ -11,16 +12,19 @@ module BotPlutusInterface.Types (
   HasDefinitions (..),
   SomeBuiltin (SomeBuiltin),
   endpointsToSchemas,
+  RawTx (..),
 ) where
 
 import Cardano.Api (NetworkId (Testnet), NetworkMagic (..))
 import Cardano.Api.ProtocolParameters (ProtocolParameters)
 import Control.Concurrent.STM (TVar)
 import Data.Aeson (ToJSON)
+import Data.Aeson.TH (Options (..), defaultOptions, deriveJSON)
 import Data.Default (Default (def))
 import Data.Kind (Type)
 import Data.Map (Map)
 import Data.Text (Text)
+import GHC.Generics (Generic)
 import Ledger (PubKeyHash)
 import Network.Wai.Handler.Warp (Port)
 import Plutus.PAB.Core.ContractInstance.STM (Activity)
@@ -103,3 +107,12 @@ instance Default PABConfig where
       , pcPort = 9080
       , pcEnableTxEndpoint = False
       }
+
+data RawTx = RawTx
+  { rawType :: Text
+  , rawDescription :: Text
+  , rawCborHex :: Text
+  }
+  deriving (Generic, Eq, Show)
+
+$(deriveJSON defaultOptions {fieldLabelModifier = drop 3} ''RawTx)

test/Spec.hs

@@ -2,8 +2,8 @@ module Main (main) where
 
 import Spec.BotPlutusInterface.Contract qualified
 import Spec.BotPlutusInterface.PreBalance qualified
-import Spec.BotPlutusInterface.UtxoParser qualified
 import Spec.BotPlutusInterface.Server qualified
+import Spec.BotPlutusInterface.UtxoParser qualified
 import Test.Tasty (TestTree, defaultMain, testGroup)
 import Prelude
 

test/Spec/BotPlutusInterface/Server.hs

@@ -4,6 +4,7 @@ import BotPlutusInterface.Server (app, initState)
 import BotPlutusInterface.Types (
   HasDefinitions (..),
   PABConfig (..),
+  RawTx (..),
   SomeBuiltin (..),
  )
 
@@ -20,7 +21,8 @@ import Servant.API (Capture, Get, JSON, (:>))
 import Servant.Client (ClientEnv, ClientError (..), client, mkClientEnv, responseStatusCode, runClientM)
 import Servant.Client.Core.BaseUrl (BaseUrl (..), parseBaseUrl)
 
-import Data.Aeson (FromJSON, ToJSON)
+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)
@@ -29,13 +31,13 @@ import System.FilePath ((</>))
 import System.IO.Temp (withSystemTempDirectory)
 import Prelude
 
-type RawTxEndpointResponse = Either ClientError Text
+type RawTxEndpointResponse = Either ClientError RawTx
 type RawTxTest a = (Text -> IO RawTxEndpointResponse) -> IO a
 
 tests :: TestTree
 tests =
   testGroup
-    "Server"
+    "BotPlutusInterface.Server"
     [ rawTxTests
     ]
 
@@ -53,13 +55,13 @@ rawTxTests =
     fetchTx = do
       initServerAndClient enableTxEndpointConfig $ \runRawTxClient -> do
         result <- runRawTxClient txHash
-        result @?= Right (pack txFileContents)
+        result @?= Right rawTx
 
     fetchSignedTx :: IO ()
     fetchSignedTx = do
       initServerAndClient enableTxEndpointConfig $ \runRawTxClient -> do
         result <- runRawTxClient $ txHash <> ".signed"
-        result @?= Right (pack txFileContents)
+        result @?= Right rawTx
 
     fetchOutsideTxFolder :: IO ()
     fetchOutsideTxFolder = do
@@ -79,7 +81,7 @@ txProxy ::
   Proxy
     ( "rawTx"
         :> Capture "hash" Text
-        :> Get '[JSON] Text
+        :> Get '[JSON] RawTx
     )
 txProxy = Proxy
 
@@ -89,7 +91,7 @@ initServerAndClient config test = do
     let pabConfig :: PABConfig
         pabConfig = config {pcTxFileDir = pack path}
     state <- initState
-    writeFile (path </> txFileName) txFileContents
+    LBS.writeFile (path </> txFileName) txFileContents
     testWithApplication (pure $ app @EmptyContract pabConfig state) (initClientOnPort test)
   where
     initClientOnPort :: RawTxTest a -> Int -> IO a
@@ -106,13 +108,21 @@ initServerAndClient config test = do
       testToRun runRawTxClient
 
 txHash :: Text
-txHash = "aaaa"
+txHash = "test"
 
 txFileName :: FilePath
 txFileName = "tx-" <> unpack txHash <> ".raw"
 
-txFileContents :: String
-txFileContents = "test"
+rawTx :: RawTx
+rawTx =
+  RawTx
+    { rawType = "TxBodyAlonzo"
+    , rawDescription = "description"
+    , rawCborHex = "hex"
+    }
+
+txFileContents :: LBS.ByteString
+txFileContents = encode rawTx
 
 enableTxEndpointConfig :: PABConfig
 enableTxEndpointConfig = def {pcEnableTxEndpoint = True}