module Hasura.RQL.DDL.ApiLimit
  ( runRemoveApiLimits,
    runSetApiLimits,
    warningMessage,
    compareTimeLimitWith,
  )
where

import Control.Lens ((.~))
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DDL.Warnings
import Hasura.RQL.Types.ApiLimit
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.Metadata.Object
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.Server.Types (MonadGetPolicies (..))

runSetApiLimits ::
  (MonadError QErr m, MetadataM m, CacheRWM m, MonadGetPolicies m) =>
  ApiLimit ->
  m EncJSON
runSetApiLimits :: forall (m :: * -> *).
(MonadError QErr m, MetadataM m, CacheRWM m, MonadGetPolicies m) =>
ApiLimit -> m EncJSON
runSetApiLimits ApiLimit
al = do
  let userTimeLimitAPILimit :: Maybe MaxTime
userTimeLimitAPILimit = Limit MaxTime -> MaxTime
forall a. Limit a -> a
_lGlobal (Limit MaxTime -> MaxTime)
-> Maybe (Limit MaxTime) -> Maybe MaxTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApiLimit -> Maybe (Limit MaxTime)
_alTimeLimit ApiLimit
al
  -- If both user time limit and cloud limit are present then check if the user time limit API limit is greater than the
  -- cloud time limit API limit. Otheriwse, apply the API limit configuration (without the warning).
  Either MetadataWarning ()
warningResultEither <- Maybe MaxTime -> m (Either MetadataWarning ())
forall (m :: * -> *).
MonadGetPolicies m =>
Maybe MaxTime -> m (Either MetadataWarning ())
compareTimeLimitWith Maybe MaxTime
userTimeLimitAPILimit
  case Either MetadataWarning ()
warningResultEither of
    Left MetadataWarning
warning -> do
      EncJSON
successMsgWithWarning <- StateT MetadataWarnings m () -> m EncJSON
forall (m :: * -> *).
Monad m =>
StateT MetadataWarnings m () -> m EncJSON
successMsgWithWarnings (StateT MetadataWarnings m () -> m EncJSON)
-> StateT MetadataWarnings m () -> m EncJSON
forall a b. (a -> b) -> a -> b
$ MetadataWarning -> StateT MetadataWarnings m ()
forall (m :: * -> *). MonadWarnings m => MetadataWarning -> m ()
warn MetadataWarning
warning
      EncJSON -> m EncJSON
setApiLimit EncJSON
successMsgWithWarning
    Right ()
_ -> EncJSON -> m EncJSON
setApiLimit EncJSON
successMsg
  where
    setApiLimit :: EncJSON -> m EncJSON
setApiLimit EncJSON
successMessage = do
      m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
        (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache
        (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
        ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (ApiLimit -> Identity ApiLimit) -> Metadata -> Identity Metadata
Lens' Metadata ApiLimit
metaApiLimits
        ((ApiLimit -> Identity ApiLimit) -> Metadata -> Identity Metadata)
-> ApiLimit -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ApiLimit
al
      EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMessage

-- This function compares the user time_limit and the cloud time_limit (used in both set_api_limit and replace_metadata
-- APIs). The function returns either a metadata warning or `()`
compareTimeLimitWith :: (MonadGetPolicies m) => Maybe MaxTime -> m (Either MetadataWarning ())
compareTimeLimitWith :: forall (m :: * -> *).
MonadGetPolicies m =>
Maybe MaxTime -> m (Either MetadataWarning ())
compareTimeLimitWith Maybe MaxTime
userTimeLimitMaybe = do
  Maybe MaxTime
cloudApiTimeLimit <- m (Maybe MaxTime)
forall (m :: * -> *). MonadGetPolicies m => m (Maybe MaxTime)
runGetApiTimeLimit
  let compareTimeLimitResultEither :: Either MetadataWarning ()
compareTimeLimitResultEither =
        case (Maybe MaxTime
userTimeLimitMaybe, Maybe MaxTime
cloudApiTimeLimit) of
          (Just MaxTime
userTimeLimitAPILimit, Just MaxTime
cloudTimeLimit) -> do
            if MaxTime
userTimeLimitAPILimit MaxTime -> MaxTime -> Bool
forall a. Ord a => a -> a -> Bool
> MaxTime
cloudTimeLimit
              then MetadataWarning -> Either MetadataWarning ()
forall a b. a -> Either a b
Left (MetadataWarning -> Either MetadataWarning ())
-> MetadataWarning -> Either MetadataWarning ()
forall a b. (a -> b) -> a -> b
$ MaxTime -> MaxTime -> MetadataWarning
warningMessage MaxTime
userTimeLimitAPILimit MaxTime
cloudTimeLimit
              else () -> Either MetadataWarning ()
forall a b. b -> Either a b
Right ()
          (Maybe MaxTime, Maybe MaxTime)
_ -> () -> Either MetadataWarning ()
forall a b. b -> Either a b
Right ()
  Either MetadataWarning () -> m (Either MetadataWarning ())
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Either MetadataWarning ()
compareTimeLimitResultEither

-- warning message if the user time limit API limit is greater than the cloud time limit API limit
warningMessage :: MaxTime -> MaxTime -> MetadataWarning
warningMessage :: MaxTime -> MaxTime -> MetadataWarning
warningMessage MaxTime
userTimeLimit MaxTime
cloudTimeLimit =
  WarningCode -> MetadataObjId -> Text -> MetadataWarning
MetadataWarning WarningCode
WCTimeLimitExceededSystemLimit (SourceName -> MetadataObjId
MOSource SourceName
defaultSource)
    (Text -> MetadataWarning) -> Text -> MetadataWarning
forall a b. (a -> b) -> a -> b
$ Text
"the configured time limit: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiffTime -> Text
forall a. Show a => a -> Text
tshow (Seconds -> DiffTime
seconds (Seconds -> DiffTime) -> Seconds -> DiffTime
forall a b. (a -> b) -> a -> b
$ MaxTime -> Seconds
unMaxTime MaxTime
userTimeLimit)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" exceeds the project time limit: "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiffTime -> Text
forall a. Show a => a -> Text
tshow (Seconds -> DiffTime
seconds (Seconds -> DiffTime) -> Seconds -> DiffTime
forall a b. (a -> b) -> a -> b
$ MaxTime -> Seconds
unMaxTime MaxTime
cloudTimeLimit)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
". Time limit of "
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> DiffTime -> Text
forall a. Show a => a -> Text
tshow (Seconds -> DiffTime
seconds (Seconds -> DiffTime) -> Seconds -> DiffTime
forall a b. (a -> b) -> a -> b
$ MaxTime -> Seconds
unMaxTime MaxTime
cloudTimeLimit)
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" will be applied"

runRemoveApiLimits ::
  (MonadError QErr m, MetadataM m, CacheRWM m) =>
  m EncJSON
runRemoveApiLimits :: forall (m :: * -> *).
(MonadError QErr m, MetadataM m, CacheRWM m) =>
m EncJSON
runRemoveApiLimits = do
  m () -> m ()
forall (m :: * -> *) a. (QErrM m, CacheRM m) => m a -> m a
withNewInconsistentObjsCheck
    (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ MetadataModifier -> m ()
forall (m :: * -> *).
(MetadataM m, CacheRWM m) =>
MetadataModifier -> m ()
buildSchemaCache
    (MetadataModifier -> m ()) -> MetadataModifier -> m ()
forall a b. (a -> b) -> a -> b
$ (Metadata -> Metadata) -> MetadataModifier
MetadataModifier
    ((Metadata -> Metadata) -> MetadataModifier)
-> (Metadata -> Metadata) -> MetadataModifier
forall a b. (a -> b) -> a -> b
$ (ApiLimit -> Identity ApiLimit) -> Metadata -> Identity Metadata
Lens' Metadata ApiLimit
metaApiLimits
    ((ApiLimit -> Identity ApiLimit) -> Metadata -> Identity Metadata)
-> ApiLimit -> Metadata -> Metadata
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ApiLimit
emptyApiLimit
  EncJSON -> m EncJSON
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return EncJSON
successMsg