{-# LANGUAGE ApplicativeDo #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Hasura.RQL.DDL.Webhook.Transform.QueryParams
  ( -- * Query transformations
    QueryParams (..),
    TransformFn (..),
    TransformCtx (..),
    QueryParamsTransformFn (..),
  )
where

-------------------------------------------------------------------------------

import Data.Validation (Validation)
import Data.Validation qualified as V
import Hasura.Prelude
import Hasura.RQL.DDL.Webhook.Transform.Class
  ( TemplatingEngine,
    Transform (..),
    TransformErrorBundle (..),
  )
import Hasura.RQL.DDL.Webhook.Transform.Request
  ( RequestTransformCtx,
    runUnescapedRequestTemplateTransform',
    validateRequestUnescapedTemplateTransform',
  )
import Hasura.RQL.Types.Webhook.Transform.QueryParams (QueryParams (..), QueryParamsTransformFn (..), TransformCtx (..), TransformFn (..))
import Network.HTTP.Types.URI (parseQuery)

-------------------------------------------------------------------------------

instance Transform QueryParams where
  -- NOTE: GHC does not let us attach Haddock documentation to typeclass
  -- method implementations, so 'applyQueryParamsTransformFn' is defined
  -- separately.
  transform :: forall (m :: * -> *).
MonadError TransformErrorBundle m =>
TransformFn QueryParams
-> TransformCtx QueryParams -> QueryParams -> m QueryParams
transform (QueryParamsTransformFn_ QueryParamsTransformFn
fn) (TransformCtx RequestTransformCtx
reqCtx) = QueryParamsTransformFn
-> RequestTransformCtx -> QueryParams -> m QueryParams
forall (m :: * -> *).
MonadError TransformErrorBundle m =>
QueryParamsTransformFn
-> RequestTransformCtx -> QueryParams -> m QueryParams
applyQueryParamsTransformFn QueryParamsTransformFn
fn RequestTransformCtx
reqCtx

  -- NOTE: GHC does not let us attach Haddock documentation to typeclass
  -- method implementations, so 'validateQueryParamsTransformFn' is defined
  -- separately.
  validate :: TemplatingEngine
-> TransformFn QueryParams -> Validation TransformErrorBundle ()
validate TemplatingEngine
engine (QueryParamsTransformFn_ QueryParamsTransformFn
fn) =
    TemplatingEngine
-> QueryParamsTransformFn -> Validation TransformErrorBundle ()
validateQueryParamsTransformFn TemplatingEngine
engine QueryParamsTransformFn
fn

-- | Provide an implementation for the transformations defined by
-- 'QueryParamsTransformFn'.
--
-- If one views 'QueryParamsTransformFn' as an interface describing HTTP method
-- transformations, this can be seen as an implementation of these
-- transformations as normal Haskell functions.
applyQueryParamsTransformFn ::
  (MonadError TransformErrorBundle m) =>
  QueryParamsTransformFn ->
  RequestTransformCtx ->
  QueryParams ->
  m QueryParams
applyQueryParamsTransformFn :: forall (m :: * -> *).
MonadError TransformErrorBundle m =>
QueryParamsTransformFn
-> RequestTransformCtx -> QueryParams -> m QueryParams
applyQueryParamsTransformFn QueryParamsTransformFn
fn RequestTransformCtx
context QueryParams
_oldQueryParams = case QueryParamsTransformFn
fn of
  AddOrReplace [(UnescapedTemplate, Maybe UnescapedTemplate)]
addOrReplaceParams -> do
    -- NOTE: We use `ApplicativeDo` here to take advantage of Validation's
    -- applicative sequencing
    [Maybe (ByteString, Maybe ByteString)]
queryParams <- Either TransformErrorBundle [Maybe (ByteString, Maybe ByteString)]
-> m [Maybe (ByteString, Maybe ByteString)]
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither
      (Either TransformErrorBundle [Maybe (ByteString, Maybe ByteString)]
 -> m [Maybe (ByteString, Maybe ByteString)])
-> (Validation
      TransformErrorBundle [Maybe (ByteString, Maybe ByteString)]
    -> Either
         TransformErrorBundle [Maybe (ByteString, Maybe ByteString)])
-> Validation
     TransformErrorBundle [Maybe (ByteString, Maybe ByteString)]
-> m [Maybe (ByteString, Maybe ByteString)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation
  TransformErrorBundle [Maybe (ByteString, Maybe ByteString)]
-> Either
     TransformErrorBundle [Maybe (ByteString, Maybe ByteString)]
forall e a. Validation e a -> Either e a
V.toEither
      (Validation
   TransformErrorBundle [Maybe (ByteString, Maybe ByteString)]
 -> m [Maybe (ByteString, Maybe ByteString)])
-> Validation
     TransformErrorBundle [Maybe (ByteString, Maybe ByteString)]
-> m [Maybe (ByteString, Maybe ByteString)]
forall a b. (a -> b) -> a -> b
$ [(UnescapedTemplate, Maybe UnescapedTemplate)]
-> ((UnescapedTemplate, Maybe UnescapedTemplate)
    -> Validation
         TransformErrorBundle (Maybe (ByteString, Maybe ByteString)))
-> Validation
     TransformErrorBundle [Maybe (ByteString, Maybe ByteString)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [(UnescapedTemplate, Maybe UnescapedTemplate)]
addOrReplaceParams \(UnescapedTemplate
rawKey, Maybe UnescapedTemplate
rawValue) -> do
        ByteString
key <- RequestTransformCtx
-> UnescapedTemplate -> Validation TransformErrorBundle ByteString
runUnescapedRequestTemplateTransform' RequestTransformCtx
context UnescapedTemplate
rawKey
        Maybe ByteString
value <- (UnescapedTemplate -> Validation TransformErrorBundle ByteString)
-> Maybe UnescapedTemplate
-> Validation TransformErrorBundle (Maybe ByteString)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (RequestTransformCtx
-> UnescapedTemplate -> Validation TransformErrorBundle ByteString
runUnescapedRequestTemplateTransform' RequestTransformCtx
context) Maybe UnescapedTemplate
rawValue
        pure
          $ if ByteString
key ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"null" Bool -> Bool -> Bool
|| Maybe ByteString
value Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"null"
            then Maybe (ByteString, Maybe ByteString)
forall a. Maybe a
Nothing
            else (ByteString, Maybe ByteString)
-> Maybe (ByteString, Maybe ByteString)
forall a. a -> Maybe a
Just (ByteString
key, Maybe ByteString
value)
    pure $ Query -> QueryParams
QueryParams ([Maybe (ByteString, Maybe ByteString)] -> Query
forall a. [Maybe a] -> [a]
forall (f :: * -> *) a. Filterable f => f (Maybe a) -> f a
catMaybes [Maybe (ByteString, Maybe ByteString)]
queryParams)
  ParamTemplate UnescapedTemplate
template -> do
    ByteString
resolvedValue <- Either TransformErrorBundle ByteString -> m ByteString
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either TransformErrorBundle ByteString -> m ByteString)
-> (Validation TransformErrorBundle ByteString
    -> Either TransformErrorBundle ByteString)
-> Validation TransformErrorBundle ByteString
-> m ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation TransformErrorBundle ByteString
-> Either TransformErrorBundle ByteString
forall e a. Validation e a -> Either e a
V.toEither (Validation TransformErrorBundle ByteString -> m ByteString)
-> Validation TransformErrorBundle ByteString -> m ByteString
forall a b. (a -> b) -> a -> b
$ RequestTransformCtx
-> UnescapedTemplate -> Validation TransformErrorBundle ByteString
runUnescapedRequestTemplateTransform' RequestTransformCtx
context UnescapedTemplate
template
    pure $ Query -> QueryParams
QueryParams (ByteString -> Query
parseQuery ByteString
resolvedValue)

-- | Validate that the provided 'QueryParamsTransformFn' is correct in the
-- context of a particular 'TemplatingEngine'.
--
-- This is a product of the fact that the correctness of a given transformation
-- may be dependent on zero, one, or more of the templated transformations
-- encoded within the given 'QueryParamsTransformFn'.
validateQueryParamsTransformFn ::
  TemplatingEngine ->
  QueryParamsTransformFn ->
  Validation TransformErrorBundle ()
validateQueryParamsTransformFn :: TemplatingEngine
-> QueryParamsTransformFn -> Validation TransformErrorBundle ()
validateQueryParamsTransformFn TemplatingEngine
engine = \case
  AddOrReplace [(UnescapedTemplate, Maybe UnescapedTemplate)]
addOrReplaceParams ->
    -- NOTE: We use `ApplicativeDo` here to take advantage of
    -- Validation's applicative sequencing
    [(UnescapedTemplate, Maybe UnescapedTemplate)]
-> ((UnescapedTemplate, Maybe UnescapedTemplate)
    -> Validation TransformErrorBundle ())
-> Validation TransformErrorBundle ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [(UnescapedTemplate, Maybe UnescapedTemplate)]
addOrReplaceParams \(UnescapedTemplate
key, Maybe UnescapedTemplate
val) -> do
      TemplatingEngine
-> UnescapedTemplate -> Validation TransformErrorBundle ()
validateRequestUnescapedTemplateTransform' TemplatingEngine
engine UnescapedTemplate
key
      (UnescapedTemplate -> Validation TransformErrorBundle ())
-> Maybe UnescapedTemplate -> Validation TransformErrorBundle ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (TemplatingEngine
-> UnescapedTemplate -> Validation TransformErrorBundle ()
validateRequestUnescapedTemplateTransform' TemplatingEngine
engine) Maybe UnescapedTemplate
val
      -- NOTE: There's a bug in `ApplicativeDo` which infers a `Monad`
      -- constraint on this block if it doens't end with `pure ()`
      pure ()
  ParamTemplate UnescapedTemplate
template -> do
    TemplatingEngine
-> UnescapedTemplate -> Validation TransformErrorBundle ()
validateRequestUnescapedTemplateTransform' TemplatingEngine
engine UnescapedTemplate
template
    pure ()
{-# ANN validateQueryParamsTransformFn ("HLint: ignore Redundant pure" :: String) #-}