-- | Planning MySQL queries and subscriptions.
module Hasura.Backends.MySQL.Plan
  ( planQuery,
    queryToActionForest,
  )
where

import Control.Monad.Validate
import Data.Aeson qualified as J
import Data.ByteString.Lazy (toStrict)
import Data.Text.Extended
import Data.Tree
import Hasura.Backends.MySQL.DataLoader.Plan qualified as DataLoader
import Hasura.Backends.MySQL.FromIr
import Hasura.Backends.MySQL.Types
import Hasura.Base.Error
import Hasura.Prelude hiding (first)
import Hasura.RQL.IR
import Hasura.RQL.Types.Column qualified as RQL
import Hasura.SQL.Backend
import Hasura.Session

-- | Plan the query and then produce a forest of actions for the executor.
queryToActionForest ::
  MonadError QErr m =>
  UserInfo ->
  QueryDB 'MySQL Void (UnpreparedValue 'MySQL) ->
  m (DataLoader.HeadAndTail, Forest DataLoader.PlannedAction)
queryToActionForest :: UserInfo
-> QueryDB 'MySQL Void (UnpreparedValue 'MySQL)
-> m (HeadAndTail, Forest PlannedAction)
queryToActionForest UserInfo
userInfo QueryDB 'MySQL Void (UnpreparedValue 'MySQL)
qrf = do
  Select
select <- SessionVariables
-> QueryDB 'MySQL Void (UnpreparedValue 'MySQL) -> m Select
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables
-> QueryDB 'MySQL Void (UnpreparedValue 'MySQL) -> m Select
planQuery (UserInfo -> SessionVariables
_uiSession UserInfo
userInfo) QueryDB 'MySQL Void (UnpreparedValue 'MySQL)
qrf
  let (!HeadAndTail
headAndTail, ![PlannedAction]
plannedActionsList) =
        Plan HeadAndTail -> (HeadAndTail, [PlannedAction])
forall r. Plan r -> (r, [PlannedAction])
DataLoader.runPlan
          (Maybe Relationship -> Maybe Text -> Select -> Plan HeadAndTail
DataLoader.planSelectHeadAndTail Maybe Relationship
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Select
select)
      !actionsForest :: Forest PlannedAction
actionsForest = (Graph -> Graph) -> [PlannedAction] -> Forest PlannedAction
DataLoader.actionsForest Graph -> Graph
forall a. a -> a
id [PlannedAction]
plannedActionsList
  (HeadAndTail, Forest PlannedAction)
-> m (HeadAndTail, Forest PlannedAction)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HeadAndTail
headAndTail, Forest PlannedAction
actionsForest)

planQuery ::
  MonadError QErr m =>
  SessionVariables ->
  QueryDB 'MySQL Void (UnpreparedValue 'MySQL) ->
  m Select
planQuery :: SessionVariables
-> QueryDB 'MySQL Void (UnpreparedValue 'MySQL) -> m Select
planQuery SessionVariables
sessionVariables QueryDB 'MySQL Void (UnpreparedValue 'MySQL)
queryDB = do
  QueryDB 'MySQL Void Expression
rootField <- (UnpreparedValue 'MySQL -> m Expression)
-> QueryDB 'MySQL Void (UnpreparedValue 'MySQL)
-> m (QueryDB 'MySQL Void Expression)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (SessionVariables -> UnpreparedValue 'MySQL -> m Expression
forall (m :: * -> *).
MonadError QErr m =>
SessionVariables -> UnpreparedValue 'MySQL -> m Expression
prepareValueQuery SessionVariables
sessionVariables) QueryDB 'MySQL Void (UnpreparedValue 'MySQL)
queryDB
  Validate (NonEmpty Error) Select -> Either (NonEmpty Error) Select
forall e a. Validate e a -> Either e a
runValidate (FromIr Select -> Validate (NonEmpty Error) Select
forall a. FromIr a -> Validate (NonEmpty Error) a
runFromIr (QueryDB 'MySQL Void Expression -> FromIr Select
fromRootField QueryDB 'MySQL Void Expression
rootField))
    Either (NonEmpty Error) Select
-> (NonEmpty Error -> m Select) -> m Select
forall (m :: * -> *) e a.
Applicative m =>
Either e a -> (e -> m a) -> m a
`onLeft` (Code -> Text -> m Select
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotSupported (Text -> m Select)
-> (NonEmpty Error -> Text) -> NonEmpty Error -> m Select
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty Error -> Text
forall a. Show a => a -> Text
tshow)

-- | Prepare a value without any query planning; we just execute the
-- query with the values embedded.
prepareValueQuery ::
  MonadError QErr m =>
  SessionVariables ->
  UnpreparedValue 'MySQL ->
  m Expression
prepareValueQuery :: SessionVariables -> UnpreparedValue 'MySQL -> m Expression
prepareValueQuery SessionVariables
sessionVariables =
  \case
    UVLiteral SQLExpression 'MySQL
x -> Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure SQLExpression 'MySQL
Expression
x
    UnpreparedValue 'MySQL
UVSession -> Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ ScalarValue -> Expression
ValueExpression (ScalarValue -> Expression) -> ScalarValue -> Expression
forall a b. (a -> b) -> a -> b
$ ByteString -> ScalarValue
BinaryValue (ByteString -> ScalarValue) -> ByteString -> ScalarValue
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
toStrict (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ SessionVariables -> ByteString
forall a. ToJSON a => a -> ByteString
J.encode SessionVariables
sessionVariables
    UVParameter Maybe VariableInfo
_ RQL.ColumnValue {ScalarValue 'MySQL
ColumnType 'MySQL
cvValue :: forall (b :: BackendType). ColumnValue b -> ScalarValue b
cvType :: forall (b :: BackendType). ColumnValue b -> ColumnType b
cvValue :: ScalarValue 'MySQL
cvType :: ColumnType 'MySQL
..} -> Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ ScalarValue -> Expression
ValueExpression ScalarValue 'MySQL
ScalarValue
cvValue
    UVSessionVar SessionVarType 'MySQL
_typ SessionVariable
sessionVariable -> do
      Text
value <-
        SessionVariable -> SessionVariables -> Maybe Text
getSessionVariableValue SessionVariable
sessionVariable SessionVariables
sessionVariables
          Maybe Text -> m Text -> m Text
forall (m :: * -> *) a. Applicative m => Maybe a -> m a -> m a
`onNothing` Code -> Text -> m Text
forall (m :: * -> *) a. QErrM m => Code -> Text -> m a
throw400 Code
NotFound (Text
"missing session variable: " Text -> SessionVariable -> Text
forall t. ToTxt t => Text -> t -> Text
<>> SessionVariable
sessionVariable)
      Expression -> m Expression
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Expression -> m Expression) -> Expression -> m Expression
forall a b. (a -> b) -> a -> b
$ ScalarValue -> Expression
ValueExpression (ScalarValue -> Expression) -> ScalarValue -> Expression
forall a b. (a -> b) -> a -> b
$ Text -> ScalarValue
TextValue Text
value