{-# LANGUAGE ApplicativeDo #-}

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

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

import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as J
import Data.HashMap.Strict qualified as M
import Data.Validation (Validation)
import Data.Validation qualified as V
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Hasura.RQL.DDL.Webhook.Transform.Class
  ( RequestTransformCtx (..),
    TemplatingEngine,
    Transform (..),
    TransformErrorBundle (..),
    UnescapedTemplate (..),
    runUnescapedRequestTemplateTransform',
    validateRequestUnescapedTemplateTransform',
  )
import Network.HTTP.Client.Transformable qualified as HTTP

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

-- | The actual query params we are transforming.
--
-- This newtype is necessary because otherwise we end up with an
-- orphan instance.
newtype QueryParams = QueryParams {QueryParams -> Query
unQueryParams :: HTTP.Query}

instance Transform QueryParams where
  -- NOTE: GHC does not let us attach Haddock documentation to data family
  -- instances, so 'QueryParamsTransformFn' is defined separately from this
  -- wrapper.
  newtype TransformFn QueryParams
    = QueryParamsTransformFn_ QueryParamsTransformFn
    deriving stock (Int -> TransformFn QueryParams -> ShowS
[TransformFn QueryParams] -> ShowS
TransformFn QueryParams -> String
(Int -> TransformFn QueryParams -> ShowS)
-> (TransformFn QueryParams -> String)
-> ([TransformFn QueryParams] -> ShowS)
-> Show (TransformFn QueryParams)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TransformFn QueryParams] -> ShowS
$cshowList :: [TransformFn QueryParams] -> ShowS
show :: TransformFn QueryParams -> String
$cshow :: TransformFn QueryParams -> String
showsPrec :: Int -> TransformFn QueryParams -> ShowS
$cshowsPrec :: Int -> TransformFn QueryParams -> ShowS
Show, TransformFn QueryParams -> TransformFn QueryParams -> Bool
(TransformFn QueryParams -> TransformFn QueryParams -> Bool)
-> (TransformFn QueryParams -> TransformFn QueryParams -> Bool)
-> Eq (TransformFn QueryParams)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TransformFn QueryParams -> TransformFn QueryParams -> Bool
$c/= :: TransformFn QueryParams -> TransformFn QueryParams -> Bool
== :: TransformFn QueryParams -> TransformFn QueryParams -> Bool
$c== :: TransformFn QueryParams -> TransformFn QueryParams -> Bool
Eq, (forall x.
 TransformFn QueryParams -> Rep (TransformFn QueryParams) x)
-> (forall x.
    Rep (TransformFn QueryParams) x -> TransformFn QueryParams)
-> Generic (TransformFn QueryParams)
forall x.
Rep (TransformFn QueryParams) x -> TransformFn QueryParams
forall x.
TransformFn QueryParams -> Rep (TransformFn QueryParams) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep (TransformFn QueryParams) x -> TransformFn QueryParams
$cfrom :: forall x.
TransformFn QueryParams -> Rep (TransformFn QueryParams) x
Generic)
    deriving newtype (TransformFn QueryParams -> ()
(TransformFn QueryParams -> ()) -> NFData (TransformFn QueryParams)
forall a. (a -> ()) -> NFData a
rnf :: TransformFn QueryParams -> ()
$crnf :: TransformFn QueryParams -> ()
NFData, Eq (TransformFn QueryParams)
Eq (TransformFn QueryParams)
-> (Accesses
    -> TransformFn QueryParams -> TransformFn QueryParams -> Bool)
-> Cacheable (TransformFn QueryParams)
Accesses
-> TransformFn QueryParams -> TransformFn QueryParams -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses
-> TransformFn QueryParams -> TransformFn QueryParams -> Bool
$cunchanged :: Accesses
-> TransformFn QueryParams -> TransformFn QueryParams -> Bool
$cp1Cacheable :: Eq (TransformFn QueryParams)
Cacheable, Value -> Parser [TransformFn QueryParams]
Value -> Parser (TransformFn QueryParams)
(Value -> Parser (TransformFn QueryParams))
-> (Value -> Parser [TransformFn QueryParams])
-> FromJSON (TransformFn QueryParams)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TransformFn QueryParams]
$cparseJSONList :: Value -> Parser [TransformFn QueryParams]
parseJSON :: Value -> Parser (TransformFn QueryParams)
$cparseJSON :: Value -> Parser (TransformFn QueryParams)
FromJSON, [TransformFn QueryParams] -> Value
[TransformFn QueryParams] -> Encoding
TransformFn QueryParams -> Value
TransformFn QueryParams -> Encoding
(TransformFn QueryParams -> Value)
-> (TransformFn QueryParams -> Encoding)
-> ([TransformFn QueryParams] -> Value)
-> ([TransformFn QueryParams] -> Encoding)
-> ToJSON (TransformFn QueryParams)
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TransformFn QueryParams] -> Encoding
$ctoEncodingList :: [TransformFn QueryParams] -> Encoding
toJSONList :: [TransformFn QueryParams] -> Value
$ctoJSONList :: [TransformFn QueryParams] -> Value
toEncoding :: TransformFn QueryParams -> Encoding
$ctoEncoding :: TransformFn QueryParams -> Encoding
toJSON :: TransformFn QueryParams -> Value
$ctoJSON :: TransformFn QueryParams -> Value
ToJSON)

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

  -- 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_ fn) =
    TemplatingEngine
-> QueryParamsTransformFn -> Validation TransformErrorBundle ()
validateQueryParamsTransformFn TemplatingEngine
engine QueryParamsTransformFn
fn

-- | The defunctionalized transformation 'QueryParams'
newtype QueryParamsTransformFn
  = AddOrReplace [(UnescapedTemplate, Maybe UnescapedTemplate)]
  deriving stock (QueryParamsTransformFn -> QueryParamsTransformFn -> Bool
(QueryParamsTransformFn -> QueryParamsTransformFn -> Bool)
-> (QueryParamsTransformFn -> QueryParamsTransformFn -> Bool)
-> Eq QueryParamsTransformFn
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: QueryParamsTransformFn -> QueryParamsTransformFn -> Bool
$c/= :: QueryParamsTransformFn -> QueryParamsTransformFn -> Bool
== :: QueryParamsTransformFn -> QueryParamsTransformFn -> Bool
$c== :: QueryParamsTransformFn -> QueryParamsTransformFn -> Bool
Eq, (forall x. QueryParamsTransformFn -> Rep QueryParamsTransformFn x)
-> (forall x.
    Rep QueryParamsTransformFn x -> QueryParamsTransformFn)
-> Generic QueryParamsTransformFn
forall x. Rep QueryParamsTransformFn x -> QueryParamsTransformFn
forall x. QueryParamsTransformFn -> Rep QueryParamsTransformFn x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep QueryParamsTransformFn x -> QueryParamsTransformFn
$cfrom :: forall x. QueryParamsTransformFn -> Rep QueryParamsTransformFn x
Generic, Int -> QueryParamsTransformFn -> ShowS
[QueryParamsTransformFn] -> ShowS
QueryParamsTransformFn -> String
(Int -> QueryParamsTransformFn -> ShowS)
-> (QueryParamsTransformFn -> String)
-> ([QueryParamsTransformFn] -> ShowS)
-> Show QueryParamsTransformFn
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [QueryParamsTransformFn] -> ShowS
$cshowList :: [QueryParamsTransformFn] -> ShowS
show :: QueryParamsTransformFn -> String
$cshow :: QueryParamsTransformFn -> String
showsPrec :: Int -> QueryParamsTransformFn -> ShowS
$cshowsPrec :: Int -> QueryParamsTransformFn -> ShowS
Show)
  deriving newtype (Eq QueryParamsTransformFn
Eq QueryParamsTransformFn
-> (Accesses
    -> QueryParamsTransformFn -> QueryParamsTransformFn -> Bool)
-> Cacheable QueryParamsTransformFn
Accesses
-> QueryParamsTransformFn -> QueryParamsTransformFn -> Bool
forall a. Eq a -> (Accesses -> a -> a -> Bool) -> Cacheable a
unchanged :: Accesses
-> QueryParamsTransformFn -> QueryParamsTransformFn -> Bool
$cunchanged :: Accesses
-> QueryParamsTransformFn -> QueryParamsTransformFn -> Bool
$cp1Cacheable :: Eq QueryParamsTransformFn
Cacheable, QueryParamsTransformFn -> ()
(QueryParamsTransformFn -> ()) -> NFData QueryParamsTransformFn
forall a. (a -> ()) -> NFData a
rnf :: QueryParamsTransformFn -> ()
$crnf :: QueryParamsTransformFn -> ()
NFData)

-- | 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 :: 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
    Query
queryParams <- Either TransformErrorBundle Query -> m Query
forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither (Either TransformErrorBundle Query -> m Query)
-> (Validation TransformErrorBundle Query
    -> Either TransformErrorBundle Query)
-> Validation TransformErrorBundle Query
-> m Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Validation TransformErrorBundle Query
-> Either TransformErrorBundle Query
forall e a. Validation e a -> Either e a
V.toEither (Validation TransformErrorBundle Query -> m Query)
-> Validation TransformErrorBundle Query -> m Query
forall a b. (a -> b) -> a -> b
$
      [(UnescapedTemplate, Maybe UnescapedTemplate)]
-> ((UnescapedTemplate, Maybe UnescapedTemplate)
    -> Validation TransformErrorBundle (ByteString, Maybe ByteString))
-> Validation TransformErrorBundle Query
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)
traverse (RequestTransformCtx
-> UnescapedTemplate -> Validation TransformErrorBundle ByteString
runUnescapedRequestTemplateTransform' RequestTransformCtx
context) Maybe UnescapedTemplate
rawValue
        pure (ByteString
key, Maybe ByteString
value)
    pure $ Query -> QueryParams
QueryParams Query
queryParams

-- | 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 ()
{-# ANN validateQueryParamsTransformFn ("HLint: ignore Redundant pure" :: String) #-}

instance J.ToJSON QueryParamsTransformFn where
  toJSON :: QueryParamsTransformFn -> Value
toJSON (AddOrReplace [(UnescapedTemplate, Maybe UnescapedTemplate)]
addOrReplace) = HashMap UnescapedTemplate (Maybe UnescapedTemplate) -> Value
forall a. ToJSON a => a -> Value
J.toJSON (HashMap UnescapedTemplate (Maybe UnescapedTemplate) -> Value)
-> HashMap UnescapedTemplate (Maybe UnescapedTemplate) -> Value
forall a b. (a -> b) -> a -> b
$ [(UnescapedTemplate, Maybe UnescapedTemplate)]
-> HashMap UnescapedTemplate (Maybe UnescapedTemplate)
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
M.fromList [(UnescapedTemplate, Maybe UnescapedTemplate)]
addOrReplace

instance J.FromJSON QueryParamsTransformFn where
  parseJSON :: Value -> Parser QueryParamsTransformFn
parseJSON Value
v = [(UnescapedTemplate, Maybe UnescapedTemplate)]
-> QueryParamsTransformFn
AddOrReplace ([(UnescapedTemplate, Maybe UnescapedTemplate)]
 -> QueryParamsTransformFn)
-> (HashMap UnescapedTemplate (Maybe UnescapedTemplate)
    -> [(UnescapedTemplate, Maybe UnescapedTemplate)])
-> HashMap UnescapedTemplate (Maybe UnescapedTemplate)
-> QueryParamsTransformFn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap UnescapedTemplate (Maybe UnescapedTemplate)
-> [(UnescapedTemplate, Maybe UnescapedTemplate)]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap UnescapedTemplate (Maybe UnescapedTemplate)
 -> QueryParamsTransformFn)
-> Parser (HashMap UnescapedTemplate (Maybe UnescapedTemplate))
-> Parser QueryParamsTransformFn
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value
-> Parser (HashMap UnescapedTemplate (Maybe UnescapedTemplate))
forall a. FromJSON a => Value -> Parser a
J.parseJSON Value
v