{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

{-# HLINT ignore "Use maybe" #-}
{-# HLINT ignore "Avoid lambda" #-}
{-# HLINT ignore "Replace case with maybe" #-}

module AirGQL.Servant.Database (
  apiDatabaseSchemaGetHandler,
  apiDatabaseVacuumPostHandler,
) where

import Protolude (
  Applicative (pure),
  MonadIO (liftIO),
  Monoid (mempty),
  ($),
 )

import Data.Aeson (Object)
import Data.Text (Text)
import Database.SQLite.Simple qualified as SS
import Servant.Server qualified as Servant

import AirGQL.ExternalAppContext (ExternalAppContext)
import AirGQL.Utils (
  getMainDbPath,
  runSqliteCommand,
  withRetryConn,
 )


apiDatabaseSchemaGetHandler
  :: ExternalAppContext
  -> Text
  -> Servant.Handler Text
apiDatabaseSchemaGetHandler :: ExternalAppContext -> Text -> Handler Text
apiDatabaseSchemaGetHandler ExternalAppContext
ctx Text
dbId = do
  ExternalAppContext -> FilePath -> ByteString -> Handler Text
runSqliteCommand ExternalAppContext
ctx (Text -> FilePath
getMainDbPath Text
dbId) ByteString
".schema"


apiDatabaseVacuumPostHandler
  :: Text
  -> Servant.Handler Object
apiDatabaseVacuumPostHandler :: Text -> Handler Object
apiDatabaseVacuumPostHandler Text
dbId = do
  IO () -> Handler ()
forall a. IO a -> Handler a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> Handler ()) -> IO () -> Handler ()
forall a b. (a -> b) -> a -> b
$ FilePath -> (Connection -> IO ()) -> IO ()
forall a. FilePath -> (Connection -> IO a) -> IO a
withRetryConn (Text -> FilePath
getMainDbPath Text
dbId) ((Connection -> IO ()) -> IO ()) -> (Connection -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Connection
conn ->
    Connection -> Query -> IO ()
SS.execute_ Connection
conn Query
"VACUUM"
  Object -> Handler Object
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Object
forall a. Monoid a => a
mempty