-- | Warnings for metadata APIs
--
-- This module provides a mechanism for metadata APIs to emit warnings. An example use of @MonadWarnings@ to emit
-- warnings with success message is given below:
--
-- > import Hasura.RQL.DDL.Warnings
-- >
-- > someMetadataAPIHandler :: args -> m EncJSON
-- > someMetadataAPIHandler args = successMsgWithWarnings $ do
-- >   -- do some stuff
-- >   let warning = MetadataWarning (MOSource defaultSource) "some warning message"
-- >   warn $ warning
-- >   -- do some more stuff
-- >   pure ()
-- >
module Hasura.RQL.DDL.Warnings
  ( AllowWarnings (..),
    MetadataWarning (..),
    MetadataWarnings,
    MonadWarnings (..),
    runMetadataWarnings,
    mkSuccessResponseWithWarnings,
    successMsgWithWarnings,
    WarningCode (..),
  )
where

import Data.Aeson (FromJSON, ToJSON)
import Data.Aeson qualified as J
import Data.Aeson.Extended ((.=))
import Data.Sequence qualified as Seq
import Hasura.EncJSON (EncJSON, encJFromJValue)
import Hasura.Prelude
import Hasura.RQL.Types.Metadata.Object

{- Note [Warnings in metadata API]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
The metadata API handlers return EncJSON, which is just a Bytestring Builder. Now, in order to add warnings to the API
response, we cannot use the `runMetadataWarnings` at the top level (i.e. in `runMetadataQueryM`) as appending something
to the EncJSON will require us to parse the JSON and then re-serialize it. This is wasteful and we should avoid it.

As a result, we are using the `MonadWarnings` class to add warnings at the API handler level, i.e., the API handler will
use the runMetadataWarnings function to run the handler and get the warnings. Then, the API handler will use the warnings
to construct the response.

We can however avoid this by changing the return type of the metadata API handlers to something like:

> data MetadataAPIOutput =
>     RawOutput EncJSON
>   | SuccessWithWarnings MetadataWarnings
>   | InconsistentMetadataWithWarnings MetadataWarnings

This will allow us to cater to the metadata APIs:
- That contacts some external service and passes the raw response (like the export_metadata API).
- That returns a success message with warnings (like the replace_metadata v1 API).
- That returns inconsistent metadata with warnings (like the replace_metadata v2 API).

Also, we can expand the scope of `MetadataAPIOutput` to include other types of responses as well in the future.
-}

-- | Allow/Disallow metadata warnings
data AllowWarnings
  = AllowWarnings
  | DisallowWarnings
  deriving (Int -> AllowWarnings -> ShowS
[AllowWarnings] -> ShowS
AllowWarnings -> String
(Int -> AllowWarnings -> ShowS)
-> (AllowWarnings -> String)
-> ([AllowWarnings] -> ShowS)
-> Show AllowWarnings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AllowWarnings -> ShowS
showsPrec :: Int -> AllowWarnings -> ShowS
$cshow :: AllowWarnings -> String
show :: AllowWarnings -> String
$cshowList :: [AllowWarnings] -> ShowS
showList :: [AllowWarnings] -> ShowS
Show, AllowWarnings -> AllowWarnings -> Bool
(AllowWarnings -> AllowWarnings -> Bool)
-> (AllowWarnings -> AllowWarnings -> Bool) -> Eq AllowWarnings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AllowWarnings -> AllowWarnings -> Bool
== :: AllowWarnings -> AllowWarnings -> Bool
$c/= :: AllowWarnings -> AllowWarnings -> Bool
/= :: AllowWarnings -> AllowWarnings -> Bool
Eq)

instance FromJSON AllowWarnings where
  parseJSON :: Value -> Parser AllowWarnings
parseJSON =
    String
-> (Bool -> Parser AllowWarnings) -> Value -> Parser AllowWarnings
forall a. String -> (Bool -> Parser a) -> Value -> Parser a
J.withBool String
"AllowWarnings"
      ((Bool -> Parser AllowWarnings) -> Value -> Parser AllowWarnings)
-> (Bool -> Parser AllowWarnings) -> Value -> Parser AllowWarnings
forall a b. (a -> b) -> a -> b
$ AllowWarnings -> Parser AllowWarnings
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (AllowWarnings -> Parser AllowWarnings)
-> (Bool -> AllowWarnings) -> Bool -> Parser AllowWarnings
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowWarnings -> AllowWarnings -> Bool -> AllowWarnings
forall a. a -> a -> Bool -> a
bool AllowWarnings
DisallowWarnings AllowWarnings
AllowWarnings

instance ToJSON AllowWarnings where
  toJSON :: AllowWarnings -> Value
toJSON = Bool -> Value
forall a. ToJSON a => a -> Value
J.toJSON (Bool -> Value)
-> (AllowWarnings -> Bool) -> AllowWarnings -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AllowWarnings -> Bool
toBool
    where
      toBool :: AllowWarnings -> Bool
toBool AllowWarnings
AllowWarnings = Bool
True
      toBool AllowWarnings
DisallowWarnings = Bool
False

data WarningCode
  = WCSourceCleanupFailed
  | WCIllegalEventTriggerName
  | WCTimeLimitExceededSystemLimit
  | WCTrackTableFailed
  | WCUntrackTableFailed
  deriving (WarningCode -> WarningCode -> Bool
(WarningCode -> WarningCode -> Bool)
-> (WarningCode -> WarningCode -> Bool) -> Eq WarningCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WarningCode -> WarningCode -> Bool
== :: WarningCode -> WarningCode -> Bool
$c/= :: WarningCode -> WarningCode -> Bool
/= :: WarningCode -> WarningCode -> Bool
Eq, Eq WarningCode
Eq WarningCode
-> (WarningCode -> WarningCode -> Ordering)
-> (WarningCode -> WarningCode -> Bool)
-> (WarningCode -> WarningCode -> Bool)
-> (WarningCode -> WarningCode -> Bool)
-> (WarningCode -> WarningCode -> Bool)
-> (WarningCode -> WarningCode -> WarningCode)
-> (WarningCode -> WarningCode -> WarningCode)
-> Ord WarningCode
WarningCode -> WarningCode -> Bool
WarningCode -> WarningCode -> Ordering
WarningCode -> WarningCode -> WarningCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: WarningCode -> WarningCode -> Ordering
compare :: WarningCode -> WarningCode -> Ordering
$c< :: WarningCode -> WarningCode -> Bool
< :: WarningCode -> WarningCode -> Bool
$c<= :: WarningCode -> WarningCode -> Bool
<= :: WarningCode -> WarningCode -> Bool
$c> :: WarningCode -> WarningCode -> Bool
> :: WarningCode -> WarningCode -> Bool
$c>= :: WarningCode -> WarningCode -> Bool
>= :: WarningCode -> WarningCode -> Bool
$cmax :: WarningCode -> WarningCode -> WarningCode
max :: WarningCode -> WarningCode -> WarningCode
$cmin :: WarningCode -> WarningCode -> WarningCode
min :: WarningCode -> WarningCode -> WarningCode
Ord)

instance ToJSON WarningCode where
  toJSON :: WarningCode -> Value
toJSON WarningCode
WCIllegalEventTriggerName = Value
"illegal-event-trigger-name"
  toJSON WarningCode
WCTimeLimitExceededSystemLimit = Value
"time-limit-exceeded-system-limit"
  toJSON WarningCode
WCSourceCleanupFailed = Value
"source-cleanup-failed"
  toJSON WarningCode
WCTrackTableFailed = Value
"track-table-failed"
  toJSON WarningCode
WCUntrackTableFailed = Value
"untrack-table-failed"

data MetadataWarning = MetadataWarning
  { MetadataWarning -> WarningCode
_mwCode :: WarningCode,
    MetadataWarning -> MetadataObjId
_mwMetadataObj :: MetadataObjId,
    MetadataWarning -> Text
_mwMessage :: Text
  }
  deriving (MetadataWarning -> MetadataWarning -> Bool
(MetadataWarning -> MetadataWarning -> Bool)
-> (MetadataWarning -> MetadataWarning -> Bool)
-> Eq MetadataWarning
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MetadataWarning -> MetadataWarning -> Bool
== :: MetadataWarning -> MetadataWarning -> Bool
$c/= :: MetadataWarning -> MetadataWarning -> Bool
/= :: MetadataWarning -> MetadataWarning -> Bool
Eq, Eq MetadataWarning
Eq MetadataWarning
-> (MetadataWarning -> MetadataWarning -> Ordering)
-> (MetadataWarning -> MetadataWarning -> Bool)
-> (MetadataWarning -> MetadataWarning -> Bool)
-> (MetadataWarning -> MetadataWarning -> Bool)
-> (MetadataWarning -> MetadataWarning -> Bool)
-> (MetadataWarning -> MetadataWarning -> MetadataWarning)
-> (MetadataWarning -> MetadataWarning -> MetadataWarning)
-> Ord MetadataWarning
MetadataWarning -> MetadataWarning -> Bool
MetadataWarning -> MetadataWarning -> Ordering
MetadataWarning -> MetadataWarning -> MetadataWarning
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: MetadataWarning -> MetadataWarning -> Ordering
compare :: MetadataWarning -> MetadataWarning -> Ordering
$c< :: MetadataWarning -> MetadataWarning -> Bool
< :: MetadataWarning -> MetadataWarning -> Bool
$c<= :: MetadataWarning -> MetadataWarning -> Bool
<= :: MetadataWarning -> MetadataWarning -> Bool
$c> :: MetadataWarning -> MetadataWarning -> Bool
> :: MetadataWarning -> MetadataWarning -> Bool
$c>= :: MetadataWarning -> MetadataWarning -> Bool
>= :: MetadataWarning -> MetadataWarning -> Bool
$cmax :: MetadataWarning -> MetadataWarning -> MetadataWarning
max :: MetadataWarning -> MetadataWarning -> MetadataWarning
$cmin :: MetadataWarning -> MetadataWarning -> MetadataWarning
min :: MetadataWarning -> MetadataWarning -> MetadataWarning
Ord)

instance ToJSON MetadataWarning where
  toJSON :: MetadataWarning -> Value
toJSON (MetadataWarning WarningCode
code MetadataObjId
mObj Text
msg) =
    [Pair] -> Value
J.object
      [ Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
msg,
        Key
"type" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= MetadataObjId -> Text
moiTypeName MetadataObjId
mObj,
        Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= MetadataObjId -> Text
moiName MetadataObjId
mObj,
        Key
"code" Key -> WarningCode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= WarningCode
code
      ]

type MetadataWarnings = Seq MetadataWarning

class (Monad m) => MonadWarnings m where
  -- | Add a warning to the current context
  warn :: MetadataWarning -> m ()

instance (Monad m) => MonadWarnings (StateT (MetadataWarnings) m) where
  warn :: MetadataWarning -> StateT MetadataWarnings m ()
warn MetadataWarning
w = (MetadataWarnings -> MetadataWarnings)
-> StateT MetadataWarnings m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (MetadataWarning
w MetadataWarning -> MetadataWarnings -> MetadataWarnings
forall a. a -> Seq a -> Seq a
Seq.:<|)

runMetadataWarnings :: StateT MetadataWarnings m a -> m (a, MetadataWarnings)
runMetadataWarnings :: forall (m :: * -> *) a.
StateT MetadataWarnings m a -> m (a, MetadataWarnings)
runMetadataWarnings = (StateT MetadataWarnings m a
 -> MetadataWarnings -> m (a, MetadataWarnings))
-> MetadataWarnings
-> StateT MetadataWarnings m a
-> m (a, MetadataWarnings)
forall a b c. (a -> b -> c) -> b -> a -> c
flip StateT MetadataWarnings m a
-> MetadataWarnings -> m (a, MetadataWarnings)
forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
runStateT MetadataWarnings
forall a. Monoid a => a
mempty

mkSuccessResponseWithWarnings :: MetadataWarnings -> EncJSON
mkSuccessResponseWithWarnings :: MetadataWarnings -> EncJSON
mkSuccessResponseWithWarnings MetadataWarnings
warnings =
  Value -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue
    (Value -> EncJSON) -> ([Pair] -> Value) -> [Pair] -> EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Pair] -> Value
J.object
    ([Pair] -> EncJSON) -> [Pair] -> EncJSON
forall a b. (a -> b) -> a -> b
$ [ Key
"message" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= (Text
"success" :: Text)
      ]
    [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Key
"warnings" Key -> MetadataWarnings -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= MetadataWarnings
warnings | Bool -> Bool
not (MetadataWarnings -> Bool
forall a. Seq a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null MetadataWarnings
warnings)]

successMsgWithWarnings :: (Monad m) => (StateT MetadataWarnings m ()) -> m EncJSON
successMsgWithWarnings :: forall (m :: * -> *).
Monad m =>
StateT MetadataWarnings m () -> m EncJSON
successMsgWithWarnings StateT MetadataWarnings m ()
action = do
  (()
_, MetadataWarnings
warnings) <- StateT MetadataWarnings m () -> m ((), MetadataWarnings)
forall (m :: * -> *) a.
StateT MetadataWarnings m a -> m (a, MetadataWarnings)
runMetadataWarnings StateT MetadataWarnings m ()
action
  EncJSON -> m EncJSON
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON) -> EncJSON -> m EncJSON
forall a b. (a -> b) -> a -> b
$ MetadataWarnings -> EncJSON
mkSuccessResponseWithWarnings MetadataWarnings
warnings