Split each endpoint into its own type synonym

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

Author: nazrhom

bot-plutus-interface.cabal

@@ -186,7 +186,6 @@ test-suite bot-plutus-interface-test
     , quickcheck-instances
     , row-types
     , serialise
-    , servant
     , servant-client
     , servant-client-core
     , stm

src/BotPlutusInterface/Server.hs

@@ -1,6 +1,12 @@
 {-# LANGUAGE AllowAmbiguousTypes #-}
 
-module BotPlutusInterface.Server (app, initState) where
+module BotPlutusInterface.Server (
+  app,
+  initState,
+  WebSocketEndpoint,
+  ActivateContractEndpoint,
+  RawTxEndpoint,
+) where
 
 import BotPlutusInterface.Contract (runContract)
 import BotPlutusInterface.Types (
@@ -61,18 +67,25 @@ initState :: IO AppState
 initState = AppState <$> newTVarIO Map.empty
 
 -- | Mock API Schema, stripped endpoints that we don't use in this project
-type API a =
-  ("ws" :> WebSocketPending) -- Combined websocket (subscription protocol)
-    :<|> ( "api"
-            :> "contract"
-            :> "activate"
-            :> ReqBody '[JSON] (ContractActivationArgs a)
-            :> Post '[JSON] ContractInstanceId -- Start a new instance.
-         )
-    :<|> ( "rawTx"
-            :> Capture "hash" Text
-            :> Get '[JSON] RawTx
-         )
+type API a = WebSocketEndpoint :<|> ActivateContractEndpoint a :<|> RawTxEndpoint
+
+-- Endpoints are split up so it is easier to test them. In particular servant-client
+-- can not generate a client for the WebSocketEndpoint; this allows us to still
+-- use servant-client to test the other endpoints
+
+type WebSocketEndpoint = "ws" :> WebSocketPending -- Combined websocket (subscription protocol)
+
+type ActivateContractEndpoint a =
+  "api"
+    :> "contract"
+    :> "activate"
+    :> ReqBody '[JSON] (ContractActivationArgs a)
+    :> Post '[JSON] ContractInstanceId -- Start a new instance.
+
+type RawTxEndpoint =
+  "rawTx"
+    :> Capture "hash" Text
+    :> Get '[JSON] RawTx
 
 server :: HasDefinitions t => PABConfig -> AppState -> Server (API t)
 server pabConfig state =
@@ -223,9 +236,9 @@ handleContract pabConf state@(AppState st) contract = liftIO $ do
 rawTxHandler :: PABConfig -> Text -> Handler RawTx
 rawTxHandler config hash = do
   -- Check that endpoint is enabled
-  assert (pcEnableTxEndpoint config)
+  assert config.pcEnableTxEndpoint
   -- Absolute path to pcTxFileDir that is specified in the config
-  txFolderPath <- liftIO $ makeAbsolute (unpack $ pcTxFileDir config)
+  txFolderPath <- liftIO $ makeAbsolute (unpack config.pcTxFileDir)
 
   -- Add/Set .raw extension on path
   let suppliedPath :: FilePath

src/BotPlutusInterface/Types.hs

@@ -135,4 +135,4 @@ data RawTx = RawTx
 
 -- type is a reserved keyword in haskell and can not be used as a field name
 -- when converting this to JSON we drop the _ prefix from each field
-$(deriveJSON defaultOptions {fieldLabelModifier = drop 1} ''RawTx)
+deriveJSON defaultOptions {fieldLabelModifier = drop 1} ''RawTx

test/Spec/BotPlutusInterface/Server.hs

@@ -1,6 +1,6 @@
 module Spec.BotPlutusInterface.Server (tests) where
 
-import BotPlutusInterface.Server (app, initState)
+import BotPlutusInterface.Server (RawTxEndpoint, app, initState)
 import BotPlutusInterface.Types (
   HasDefinitions (..),
   PABConfig (..),
@@ -17,7 +17,6 @@ import Test.Tasty.HUnit (testCase, (@?=))
 import Network.HTTP.Client (defaultManagerSettings, newManager)
 import Network.HTTP.Types.Status (status404)
 import Network.Wai.Handler.Warp (testWithApplication)
-import Servant.API (Capture, Get, JSON, (:>))
 import Servant.Client (ClientEnv, ClientError (..), client, mkClientEnv, responseStatusCode, runClientM)
 import Servant.Client.Core.BaseUrl (BaseUrl (..), parseBaseUrl)
 
@@ -75,14 +74,7 @@ rawTxTests =
         Left (FailureResponse _ res) <- runRawTxClient txHash
         responseStatusCode res @?= status404
 
--- Ideally we would reuse the API type definition from BotPlutusInterface.Server but servant-client
--- can not generate a client for the websocket endpoint.
-txProxy ::
-  Proxy
-    ( "rawTx"
-        :> Capture "hash" Text
-        :> Get '[JSON] RawTx
-    )
+txProxy :: Proxy RawTxEndpoint
 txProxy = Proxy
 
 initServerAndClient :: PABConfig -> RawTxTest a -> IO a