Add HttpUtils

Author: marcusbfs

src/Internal/QueryM.purs

@@ -30,6 +30,7 @@ import Control.Monad.Rec.Class (class MonadRec)
 import Control.Parallel (class Parallel, parallel, sequential)
 import Control.Plus (class Plus)
 import Ctl.Internal.Helpers (logWithLevel)
+import Ctl.Internal.QueryM.HttpUtils (handleAffjaxResponseGeneric)
 import Ctl.Internal.QueryM.Ogmios.QueryEnv (QueryRuntime)
 import Ctl.Internal.ServerConfig (ServerConfig)
 import Data.Bifunctor (lmap)
@@ -128,27 +129,17 @@ instance Parallel (QueryMT ParAff) (QueryMT Aff) where
   sequential :: QueryMT ParAff ~> QueryMT Aff
   sequential = wrap <<< sequential <<< unwrap
 
---------------------------------------------------------------------------------
--- Affjax
---------------------------------------------------------------------------------
-
--- Checks response status code and returns `ClientError` in case of failure,
--- otherwise attempts to decode the result.
---
--- This function solves the problem described there:
--- https://github.com/eviefp/purescript-affjax-errors
 handleAffjaxResponse
   :: forall (result :: Type)
    . DecodeAeson result
   => Either Affjax.Error (Affjax.Response String)
   -> Either ClientError result
-handleAffjaxResponse (Left affjaxError) =
-  Left (ClientHttpError affjaxError)
-handleAffjaxResponse
-  (Right { status: Affjax.StatusCode.StatusCode statusCode, body })
-  | statusCode < 200 || statusCode > 299 =
-      Left $ ClientHttpResponseError (wrap statusCode) $ ServiceOtherError body
-  | otherwise =
-      body # lmap (ClientDecodeJsonError body)
-        <<< (decodeAeson <=< parseJsonStringToAeson)
-
+handleAffjaxResponse =
+  handleAffjaxResponseGeneric
+    ClientHttpError
+    ( \statusCode body -> ClientHttpResponseError (wrap statusCode)
+        (ServiceOtherError body)
+    )
+    ClientDecodeJsonError
+    (decodeAeson <=< parseJsonStringToAeson)
+    pure

src/Internal/QueryM/HttpUtils.purs

@@ -0,0 +1,54 @@
+-- | This module defines utilities for working with HTTP requests
+module Ctl.Internal.QueryM.HttpUtils
+  ( handleAffjaxResponseGeneric
+  ) where
+
+import Prelude
+
+import Aeson (JsonDecodeError)
+import Affjax (Error, Response) as Affjax
+import Affjax.StatusCode as Affjax.StatusCode
+import Data.Bifunctor (lmap)
+import Data.Either (Either(Left, Right))
+
+--------------------------------------------------------------------------------
+-- Affjax
+--------------------------------------------------------------------------------
+
+-- Checks response status code and returns `ClientError` in case of failure,
+-- otherwise attempts to decode the result.
+--
+-- This function solves the problem described there:
+-- https://github.com/eviefp/purescript-affjax-errors
+
+handleAffjaxResponseGeneric
+  :: forall err intermediate result
+   . (Affjax.Error -> err)
+  -- ^ Convert an Affjax error into custom error
+  -> (Int -> String -> err)
+  -- ^ Convert a non-2xx status code into custom error
+  -> (String -> JsonDecodeError -> err)
+  -- ^ Wrap aeson-parse/decode errors
+  -> (String -> Either JsonDecodeError intermediate)
+  -- ^ Parse the response body
+  -> (intermediate -> Either err result)
+  -- ^ Function from `intermediate` to `result`
+  -> Either Affjax.Error (Affjax.Response String)
+  -- ^ Argument
+  -> Either err result
+handleAffjaxResponseGeneric
+  mkHttpError
+  mkHttpResponseError
+  mkDecodeError
+  decodeAeson
+  mkResult =
+  case _ of
+    Left affjaxError ->
+      Left (mkHttpError affjaxError)
+    Right { status: Affjax.StatusCode.StatusCode statusCode, body }
+      | statusCode < 200 || statusCode > 299 ->
+          Left (mkHttpResponseError statusCode body)
+      | otherwise -> do
+          intermediate <- lmap (mkDecodeError body) do
+            decodeAeson body
+          mkResult intermediate

src/Internal/QueryM/Ogmios.purs

@@ -21,7 +21,7 @@ import Affjax.ResponseFormat (string) as Affjax.ResponseFormat
 import Affjax.StatusCode (StatusCode(StatusCode))
 import Affjax.StatusCode as Affjax.StatusCode
 import Cardano.Provider.Error
-  ( ClientError(ClientHttpError, ClientHttpResponseError)
+  ( ClientError(ClientHttpError, ClientHttpResponseError, ClientDecodeJsonError)
   , ServiceError(ServiceOtherError)
   )
 import Cardano.Provider.TxEvaluation as Provider
@@ -33,13 +33,14 @@ import Control.Monad.Error.Class (class MonadThrow, throwError)
 import Control.Monad.Reader.Class (asks)
 import Ctl.Internal.Affjax (request) as Affjax
 import Ctl.Internal.QueryM (QueryM)
+import Ctl.Internal.QueryM.HttpUtils (handleAffjaxResponseGeneric)
 import Ctl.Internal.QueryM.Ogmios.Types
   ( class DecodeOgmios
   , AdditionalUtxoSet
   , ChainTipQR(CtChainPoint, CtChainOrigin)
   , CurrentEpoch
   , DelegationsAndRewardsR
-  , OgmiosDecodeError(ResultDecodingError, ClientErrorResponse)
+  , OgmiosDecodeError(ClientErrorResponse)
   , OgmiosEraSummaries
   , OgmiosProtocolParameters
   , OgmiosSystemStart
@@ -137,7 +138,7 @@ ogmiosQueryNoParams
    . DecodeOgmios a
   => String
   -> QueryM (Either OgmiosDecodeError a)
-ogmiosQueryNoParams method = do ogmiosQueryParams method {}
+ogmiosQueryNoParams = flip ogmiosQueryParams {}
 
 ogmiosQueryParams
   :: forall a p
@@ -201,17 +202,16 @@ handleAffjaxOgmiosResponse
    . DecodeOgmios result
   => Either Affjax.Error (Affjax.Response String)
   -> Either OgmiosDecodeError result
-handleAffjaxOgmiosResponse (Left affjaxError) =
-  Left (ClientErrorResponse $ ClientHttpError affjaxError)
-handleAffjaxOgmiosResponse
-  (Right { status: Affjax.StatusCode.StatusCode statusCode, body })
-  | statusCode < 200 || statusCode > 299 =
-      Left $ ClientErrorResponse $ ClientHttpResponseError (wrap statusCode) $
-        ServiceOtherError body
-  | otherwise = do
-      aeson <- lmap ResultDecodingError
-        $ parseJsonStringToAeson body
-      decodeOgmios aeson
+handleAffjaxOgmiosResponse =
+  handleAffjaxResponseGeneric
+    (ClientErrorResponse <<< ClientHttpError)
+    ( \statusCode body -> ClientErrorResponse $ ClientHttpResponseError
+        (wrap statusCode)
+        (ServiceOtherError body)
+    )
+    (\body -> ClientErrorResponse <<< ClientDecodeJsonError body)
+    parseJsonStringToAeson
+    decodeOgmios
 
 ogmiosErrorHandler
   :: forall a m