Remove unnecessary checks

Add url encoding tests

Author: samuelWilliams99

bot-plutus-interface.cabal

@@ -118,6 +118,7 @@ library
     , plutus-tx
     , plutus-tx-plugin
     , process
+    , QuickCheck
     , row-types
     , serialise
     , servant
@@ -186,6 +187,7 @@ test-suite bot-plutus-interface-test
     , quickcheck-instances
     , row-types
     , serialise
+    , servant
     , servant-client
     , servant-client-core
     , stm

src/BotPlutusInterface/Server.hs

@@ -34,6 +34,7 @@ import Data.Map qualified as Map
 import Data.Maybe (catMaybes)
 import Data.Proxy (Proxy (Proxy))
 import Data.Row (Row)
+import Data.String (fromString)
 import Data.Text (Text, pack, unpack)
 import Data.Text.Encoding (encodeUtf8)
 import Data.UUID.V4 qualified as UUID
@@ -75,8 +76,9 @@ import Servant.API (
  )
 import Servant.API.WebSocket (WebSocketPending)
 import Servant.Server (Application, Handler, Server, err404, serve)
-import System.Directory (canonicalizePath, doesFileExist, makeAbsolute)
-import System.FilePath (takeDirectory, (</>))
+import System.Directory (doesFileExist, makeAbsolute)
+import System.FilePath ((</>))
+import Test.QuickCheck (Arbitrary (arbitrary), elements, vectorOf)
 import Wallet.Types (ContractInstanceId (..))
 import Prelude
 
@@ -105,6 +107,7 @@ type RawTxEndpoint =
     :> Get '[JSON] RawTx
 
 newtype TxIdCapture = TxIdCapture TxId
+  deriving newtype (Eq, Show)
 
 instance FromHttpApiData TxIdCapture where
   parseUrlPiece :: Text -> Either Text TxIdCapture
@@ -121,6 +124,9 @@ instance FromHttpApiData TxIdCapture where
 instance ToHttpApiData TxIdCapture where
   toUrlPiece (TxIdCapture txId) = txIdToText txId
 
+instance Arbitrary TxIdCapture where
+  arbitrary = TxIdCapture . fromString <$> vectorOf 64 (elements "0123456789abcdefABCDEF")
+
 server :: HasDefinitions t => PABConfig -> AppState -> Server (API t)
 server pabConfig state =
   websocketHandler state
@@ -274,13 +280,10 @@ rawTxHandler config (TxIdCapture txId) = do
   -- 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")
-  -- Resolve path indirections
-  path <- liftIO $ canonicalizePath suppliedPath
-  -- ensure it does not try to escape txFolderPath
-  assert (takeDirectory path == txFolderPath)
+  -- Create full path
+  let path :: FilePath
+      path = txFolderPath </> unpack (txFileName txId "raw")
+
   -- ensure file exists
   fileExists <- liftIO $ doesFileExist path
   assert fileExists

test/Spec/BotPlutusInterface/Server.hs

@@ -15,10 +15,15 @@ import Schema (FormSchema)
 
 import Test.Tasty (TestTree, testGroup)
 import Test.Tasty.HUnit (testCase, (@?=))
+import Test.Tasty.QuickCheck (Property, testProperty, (===))
 
 import Network.HTTP.Client (defaultManagerSettings, newManager)
 import Network.HTTP.Types.Status (status404)
 import Network.Wai.Handler.Warp (testWithApplication)
+import Servant.API (
+  FromHttpApiData (parseUrlPiece),
+  ToHttpApiData (toUrlPiece),
+ )
 import Servant.Client (ClientEnv, ClientError (..), client, mkClientEnv, responseStatusCode, runClientM)
 import Servant.Client.Core.BaseUrl (BaseUrl (..), parseBaseUrl)
 
@@ -49,6 +54,7 @@ rawTxTests =
     [ testCase "Can fetch valid tx file" fetchTx
     , testCase "Returns 404 for missing txs" fetchMissingTx
     , testCase "Returns 404 for valid request when the endpoint is disabled" fetchWithDefaultConfig
+    , testProperty "TxId URL encoding reversible" txIdReversible
     ]
   where
     fetchTx :: IO ()
@@ -69,6 +75,9 @@ rawTxTests =
         Left (FailureResponse _ res) <- runRawTxClient txHash
         responseStatusCode res @?= status404
 
+    txIdReversible :: TxIdCapture -> Property
+    txIdReversible txId = parseUrlPiece (toUrlPiece txId) === Right txId
+
 txProxy :: Proxy RawTxEndpoint
 txProxy = Proxy