{-# LANGUAGE TemplateHaskell #-}

module Hasura.Backends.MySQL.SQL
  ( runSQL,
    RunSQL (..),
  )
where

import Data.Aeson qualified as J
import Data.Aeson.TH
import Data.ByteString hiding (null, reverse)
import Data.Pool (withResource)
import Data.String (fromString)
import Data.Text qualified as T
import Data.Text.Encoding (decodeUtf8With)
import Data.Text.Encoding.Error (lenientDecode)
import Database.MySQL.Base (fetchFields, query, storeResult)
import Database.MySQL.Base.Types (Field (fieldName))
import Hasura.Backends.MySQL.Connection (fetchAllRows)
import Hasura.Backends.MySQL.Types (SourceConfig (..))
import Hasura.Base.Error
import Hasura.EncJSON
import Hasura.Prelude
import Hasura.RQL.DDL.Schema (RunSQLRes (..))
import Hasura.RQL.Types.Common
import Hasura.RQL.Types.Metadata
import Hasura.RQL.Types.SchemaCache
import Hasura.RQL.Types.SchemaCache.Build
import Hasura.SQL.Backend

data RunSQL = RunSQL
  { RunSQL -> Text
_Sql :: Text,
    RunSQL -> SourceName
_Source :: SourceName
  }
  deriving (Int -> RunSQL -> ShowS
[RunSQL] -> ShowS
RunSQL -> String
(Int -> RunSQL -> ShowS)
-> (RunSQL -> String) -> ([RunSQL] -> ShowS) -> Show RunSQL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RunSQL] -> ShowS
$cshowList :: [RunSQL] -> ShowS
show :: RunSQL -> String
$cshow :: RunSQL -> String
showsPrec :: Int -> RunSQL -> ShowS
$cshowsPrec :: Int -> RunSQL -> ShowS
Show, RunSQL -> RunSQL -> Bool
(RunSQL -> RunSQL -> Bool)
-> (RunSQL -> RunSQL -> Bool) -> Eq RunSQL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RunSQL -> RunSQL -> Bool
$c/= :: RunSQL -> RunSQL -> Bool
== :: RunSQL -> RunSQL -> Bool
$c== :: RunSQL -> RunSQL -> Bool
Eq)

$(deriveJSON hasuraJSON ''RunSQL)

runSQL :: (MonadIO m, CacheRWM m, MonadError QErr m, MetadataM m) => RunSQL -> m EncJSON
runSQL :: RunSQL -> m EncJSON
runSQL (RunSQL Text
sql SourceName
source) = do
  Pool Connection
pool <- SourceConfig -> Pool Connection
scConnectionPool (SourceConfig -> Pool Connection)
-> m SourceConfig -> m (Pool Connection)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SourceName -> m (SourceConfig 'MySQL)
forall (b :: BackendType) (m :: * -> *).
(CacheRM m, MonadError QErr m, Backend b, MetadataM m) =>
SourceName -> m (SourceConfig b)
askSourceConfig @'MySQL SourceName
source
  [[Maybe ByteString]]
result :: [[Maybe ByteString]] <- IO [[Maybe ByteString]] -> m [[Maybe ByteString]]
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO [[Maybe ByteString]] -> m [[Maybe ByteString]])
-> IO [[Maybe ByteString]] -> m [[Maybe ByteString]]
forall a b. (a -> b) -> a -> b
$
    Pool Connection
-> (Connection -> IO [[Maybe ByteString]])
-> IO [[Maybe ByteString]]
forall (m :: * -> *) a b.
MonadBaseControl IO m =>
Pool a -> (a -> m b) -> m b
withResource Pool Connection
pool ((Connection -> IO [[Maybe ByteString]])
 -> IO [[Maybe ByteString]])
-> (Connection -> IO [[Maybe ByteString]])
-> IO [[Maybe ByteString]]
forall a b. (a -> b) -> a -> b
$ \Connection
conn -> do
      Connection -> ByteString -> IO ()
query Connection
conn (String -> ByteString
forall a. IsString a => String -> a
fromString (String -> ByteString) -> (Text -> String) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ Text
sql)
      Result
r <- Connection -> IO Result
storeResult Connection
conn
      [Maybe ByteString]
fieldNames <- (Field -> Maybe ByteString) -> [Field] -> [Maybe ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (Field -> ByteString) -> Field -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Field -> ByteString
fieldName) ([Field] -> [Maybe ByteString])
-> IO [Field] -> IO [Maybe ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Result -> IO [Field]
fetchFields Result
r -- fieldNames as Maybes for convenience
      [[Maybe ByteString]]
rows <- Result -> IO [[Maybe ByteString]]
fetchAllRows Result
r
      [[Maybe ByteString]] -> IO [[Maybe ByteString]]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Maybe ByteString]
fieldNames [Maybe ByteString] -> [[Maybe ByteString]] -> [[Maybe ByteString]]
forall a. a -> [a] -> [a]
: [[Maybe ByteString]]
rows)
  EncJSON -> m EncJSON
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EncJSON -> m EncJSON)
-> (RunSQLRes -> EncJSON) -> RunSQLRes -> m EncJSON
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RunSQLRes -> EncJSON
forall a. ToJSON a => a -> EncJSON
encJFromJValue (RunSQLRes -> m EncJSON) -> RunSQLRes -> m EncJSON
forall a b. (a -> b) -> a -> b
$
    if [[Maybe ByteString]] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[Maybe ByteString]]
result
      then Text -> Value -> RunSQLRes
RunSQLRes Text
"CommandOK" Value
J.Null
      else Text -> Value -> RunSQLRes
RunSQLRes Text
"TuplesOk" (Value -> RunSQLRes)
-> ([[Maybe ByteString]] -> Value)
-> [[Maybe ByteString]]
-> RunSQLRes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Maybe Text]] -> Value
forall a. ToJSON a => a -> Value
J.toJSON ([[Maybe Text]] -> Value)
-> ([[Maybe ByteString]] -> [[Maybe Text]])
-> [[Maybe ByteString]]
-> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (([Maybe ByteString] -> [Maybe Text])
-> [[Maybe ByteString]] -> [[Maybe Text]]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (([Maybe ByteString] -> [Maybe Text])
 -> [[Maybe ByteString]] -> [[Maybe Text]])
-> ((ByteString -> Text) -> [Maybe ByteString] -> [Maybe Text])
-> (ByteString -> Text)
-> [[Maybe ByteString]]
-> [[Maybe Text]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> Maybe Text)
-> [Maybe ByteString] -> [Maybe Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((Maybe ByteString -> Maybe Text)
 -> [Maybe ByteString] -> [Maybe Text])
-> ((ByteString -> Text) -> Maybe ByteString -> Maybe Text)
-> (ByteString -> Text)
-> [Maybe ByteString]
-> [Maybe Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Text) -> Maybe ByteString -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (OnDecodeError -> ByteString -> Text
decodeUtf8With OnDecodeError
lenientDecode) ([[Maybe ByteString]] -> RunSQLRes)
-> [[Maybe ByteString]] -> RunSQLRes
forall a b. (a -> b) -> a -> b
$ [[Maybe ByteString]]
result