content: -- For embedded SQL queries
  {-# LANGUAGE QuasiQuotes #-}
  {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
  
  {-# HLINT ignore "Use maybe" #-}
  -- HLint can't figure out where TemplateHaskell is used,
  -- even though it throws an error without the pragma.
  {-# HLINT ignore "Unused LANGUAGE pragma" #-}
  
  module AirGQL.Utils (
    collectAllErrorsAsText,
    collectErrorList,
    colToFileUrl,
    escDoubleQuotes,
    escSingleQuotes,
    getDbDir,
    getGraphiQLVersion,
    getMainDbPath,
    getOrderOfLinkedList,
    getReadOnlyFilePath,
    getDbIdFromReadOnlyId,
    getSqliteBinaryVersion,
    getSqliteEmbeddedVersion,
    headerJsonContent,
    quoteKeyword,
    quoteText,
    removeIfExists,
    runSqliteCommand,
    throwErr400WithMsg,
    throwErr404WithMsg,
    throwErr500WithMsg,
    withRetryConn,
    DiffKind (..),
  ) where
  
  import Protolude (
    Applicative (pure),
    ExitCode (ExitFailure, ExitSuccess),
    FilePath,
    IO,
    Maybe (Just, Nothing),
    Monoid (mempty),
    Semigroup ((<>)),
    Text,
    catch,
    liftIO,
    not,
    show,
    throwError,
    throwIO,
    when,
    ($),
    (&),
    (.),
    (/=),
    (<&>),
   )
  import Protolude qualified as P
  
  import Control.Monad.Catch (catchAll)
  import Data.Aeson (KeyValue ((.=)), Value (String), encode, object)
  import Data.ByteString qualified as BS
  import Data.ByteString.Builder (toLazyByteString)
  import Data.ByteString.Lazy qualified as BL
  import Data.Either.Extra (mapLeft)
  import Data.List qualified as List
  import Data.Text qualified as T
  import Data.Text.Encoding qualified as T
  import Database.SQLite.Simple (Connection)
  import Database.SQLite.Simple qualified as SS
  import Network.HTTP.Types (HeaderName, encodePathSegments)
  import Servant.Server (
    ServerError (errBody, errHeaders),
    err400,
    err404,
    err500,
   )
  import Servant.Server qualified as Servant
  import System.Directory (removeFile)
  import System.FilePath (takeFileName, (</>))
  import System.IO.Error (IOError, isDoesNotExistError)
  import System.Posix.Files (readSymbolicLink)
  import System.Process (readProcess)
  import System.Process.Typed (
    byteStringInput,
    createPipe,
    proc,
    readProcessInterleaved,
    setStderr,
    setStdin,
    setStdout,
   )
  
  import AirGQL.ExternalAppContext (ExternalAppContext (sqlite))
  
  
  getDbDir :: Text -> FilePath
  getDbDir dbId =
    "data"
      </> "databases"
      </> T.unpack dbId
  
  
  getMainDbPath :: Text -> FilePath
  getMainDbPath dbId =
    getDbDir dbId
      </> "main.sqlite"
  
  
  getReadOnlyFilePath :: Text -> FilePath
  getReadOnlyFilePath readonlyId =
    "data" </> "readonly" </> T.unpack readonlyId
  
  
  getSqliteEmbeddedVersion :: Connection -> IO Text
  getSqliteEmbeddedVersion conn = do
    sqliteEmbeddedVersion <-
      SS.query_
        conn
        "select sqlite_version()"
        :: IO [[SS.SQLData]]
    case sqliteEmbeddedVersion of
      [[SS.SQLText verTxt]] -> pure verTxt
      _ -> pure mempty
  
  
  getSqliteBinaryVersion :: ExternalAppContext -> IO Text
  getSqliteBinaryVersion ctx = do
    P.fmap (T.strip . T.pack) $
      readProcess
        ctx.sqlite
        ["--safe", ":memory:"]
        (T.unpack "select sqlite_version()")
  
  
  getGraphiQLVersion :: IO Text
  getGraphiQLVersion = do
    -- let packageJson :: BL.ByteString =
    --       $( "package.json"
    --           & makeRelativeToProject
    --           P.>>= embedStringFile
    --        )
    --
    -- pure $
    --   (Aeson.decode packageJson :: Maybe Object)
    --     P.>>= KeyMap.lookup "dependencies"
    --     P.>>= ( \case
    --               Aeson.Object o -> KeyMap.lookup "graphiql" o
    --               _ -> Nothing
    --           )
    --     P.>>= ( \case
    --               Aeson.String s -> Just s
    --               _ -> Nothing
    --           )
    --     & fromMaybe ""
    pure "TODO"
  
  
  -- | Escape double quotes in SQL strings
  escDoubleQuotes :: Text -> Text
  escDoubleQuotes =
    T.replace "\"" "\"\""
  
  
  -- | Quote a keyword in an SQL query
  quoteKeyword :: Text -> Text
  quoteKeyword keyword =
    keyword
      & escDoubleQuotes
      & (\word -> "\"" <> word <> "\"")
  
  
  -- | Escape single quotes in SQL strings
  escSingleQuotes :: Text -> Text
  escSingleQuotes =
    T.replace "'" "''"
  
  
  -- | Quote literal text in an SQL query
  quoteText :: Text -> Text
  quoteText keyword =
    keyword
      & escSingleQuotes
      & (\word -> "'" <> word <> "'")
  
  
  headerJsonContent :: [(HeaderName, BS.ByteString)]
  headerJsonContent =
    [("Content-Type", "application/json;charset=utf-8")]
  
  
  -- | Throw the specified server error with a message
  throwServerErrorWithMsg :: ServerError -> Text -> Servant.Handler a
  throwServerErrorWithMsg serverError errorMsg =
    throwError $
      serverError
        { errHeaders = headerJsonContent
        , errBody =
            encode $
              object
                ["errors" .= [String errorMsg]]
        }
  
  
  -- | Throw an "400 Bad Request" error with a message
  throwErr400WithMsg :: Text -> Servant.Handler a
  throwErr400WithMsg = throwServerErrorWithMsg err400
  
  
  -- | Throw an "404 Not Found" error with a message
  throwErr404WithMsg :: Text -> Servant.Handler a
  throwErr404WithMsg = throwServerErrorWithMsg err404
  
  
  -- | Throw an "500 Internal Server Error" error with a message
  throwErr500WithMsg :: Text -> Servant.Handler a
  throwErr500WithMsg = throwServerErrorWithMsg err500
  
  
  {-| Get the order of a linked list.
   | Each tuple is `(name, previous name in list)`.
   | The first's element previous name is `Nothing`.
   | Tries to find the longest chain of elements if no start element is found.
   | It's quite complicated to also handle incomplete orderings correctly.
  -}
  getOrderOfLinkedList :: [(Text, Maybe Text)] -> [Text]
  getOrderOfLinkedList tables =
    let
      findAfter :: [(Text, Maybe Text)] -> (Text, Maybe Text) -> [Text]
      findAfter remaining (tableName, previousTableMb) =
        P.maybeToList previousTableMb
          <> case P.find ((P.== Just tableName) P.. P.snd) remaining of
            Just found@(name, _) ->
              let remaining' = List.filter (/= found) remaining
              in  tableName : findAfter remaining' (name, Nothing)
            Nothing -> [tableName]
    in
      if P.null tables
        then []
        else
          let
            sortByLength :: [[Text]] -> [[Text]]
            sortByLength =
              P.sortBy (\x y -> P.compare (P.length y) (P.length x))
  
            chainsByLength =
              tables
                <&> findAfter tables
                & sortByLength
  
            -- First table ist always the (x, Nothing) table entry
            firstElement =
              case P.find ((P.== Nothing) P.. P.snd) tables of
                Just tableEntry -> [P.fst tableEntry]
                Nothing -> []
          in
            -- Sort them by length, combine them, and remove duplicates
            ([firstElement] <> chainsByLength)
              & P.concat
              & List.nub
  
  
  getDbIdFromReadOnlyId :: Text -> IO (Maybe Text)
  getDbIdFromReadOnlyId readOnlyId = do
    catchAll
      ( do
          dbId <- liftIO $ readSymbolicLink $ getReadOnlyFilePath readOnlyId
          pure $ Just $ T.pack $ takeFileName dbId
      )
      ( \err -> do
          when (not $ "does not exist" `P.isInfixOf` show err) $ do
            P.putErrText $ "Error while reading readonly symlink:\n" <> show err
          pure Nothing
      )
  
  
  colToFileUrl :: Text -> Text -> Text -> Text -> Text
  colToFileUrl readonlyId tableName colName rowid =
    T.decodeUtf8 $
      BL.toStrict $
        toLazyByteString $
          encodePathSegments
            [ "readonly"
            , readonlyId
            , "tables"
            , tableName
            , "columns"
            , colName
            , "files"
            , "rowid"
            , rowid
            ]
  
  
  removeIfExists :: FilePath -> IO ()
  removeIfExists fileName =
    let
      handleExists :: IOError -> IO ()
      handleExists e
        | isDoesNotExistError e = pure ()
        | P.otherwise = throwIO e
    in
      removeFile fileName `catch` handleExists
  
  
  runSqliteCommand :: ExternalAppContext -> FilePath -> BL.ByteString -> Servant.Handler Text
  runSqliteCommand ctx dbPath command = do
    let
      processConfig =
        setStdin
          (byteStringInput command)
          $ setStdout createPipe
          $ setStderr createPipe
          $ proc ctx.sqlite [dbPath]
  
    (exitCode, output) <- readProcessInterleaved processConfig
  
    let outputText = P.decodeUtf8 $ BS.toStrict output
  
    case exitCode of
      ExitSuccess ->
        pure outputText
      ExitFailure _ ->
        throwErr500WithMsg outputText
  
  
  -- | Similar to `sequence`, except it doesn't stop on the first error.
  collectErrorList :: [P.Either e b] -> P.Either [e] [b]
  collectErrorList results =
    case P.lefts results of
      [] -> P.Right (P.rights results)
      lefts -> P.Left lefts
  
  
  {-|
  Similar to `sequence`, except it doesn't stop on the first error.
  What differentiates this from `collectErrorList` is
  that it also merges the errors into a single error message.
  -}
  collectAllErrorsAsText :: [P.Either Text b] -> P.Either Text [b]
  collectAllErrorsAsText results =
    collectErrorList results
      & mapLeft
        ( \lefts ->
            "Multiple errors occurred:\n" <> P.unlines lefts
        )
  
  
  data DiffKind = Added | Removed | Kept
    deriving (P.Eq, P.Ord, P.Show)
  
  
  {-| Run an action with a connection, retrying if the database is busy.
  | Necessary because of WAL mode:
  | https://sqlite.org/wal.html#sometimes_queries_return_sqlite_busy_in_wal_mode
  -}
  withRetryConn :: FilePath -> (Connection -> IO a) -> IO a
  withRetryConn filePath action = do
    SS.withConnection filePath $ \conn -> do
      SS.execute_ conn "PRAGMA busy_timeout = 5000;" -- 5 seconds
      SS.execute_ conn "PRAGMA foreign_keys = True"
      action conn
  