{-|
Module      : Gargantext.Database.Prelude
Description : Specific Prelude for Database management
Copyright   : (c) CNRS, 2017-Present
License     : AGPL + CECILL v3
Maintainer  : team@gargantext.org
Stability   : experimental
Portability : POSIX

-}

{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE ConstraintKinds     #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections       #-}

module Gargantext.Database.Prelude
  ( -- * Types and Constraints
    -- $typesAndConstraints
    --
    -- ** Environment Constraints
    HasConnectionPool(..)
  , IsDBEnv
  , IsDBEnvExtra
    -- ** Command Monad Constraints
  , IsCmd
  , IsDBCmd
  , IsDBCmdExtra
    -- ** Existential Versions of the Above Constraints, for Convenience
  , Cmd
  , CmdRandom
  , DBCmd
  , DBCmdWithEnv
  , DBCmdExtra
    -- ** Miscellaneous Type(s)
  , JSONB
    -- * Functions
    -- ** Executing DB transactions
  , module Gargantext.Database.Transactional
    -- ** Other Functions
  , runCmd
  , createDBIfNotExists
  , dbCheck
  , debugFormatPGSQuery
  , fromField'
  , restrictMaybe
  , createLargeObject
  , readLargeObject
  , readLargeObjectViaTempFile
  , removeLargeObject
  )
where

import Control.Exception.Safe qualified as CES
import Control.Lens (view)
import Data.Aeson (Result(..))
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as BSL
import Data.List qualified as DL
import Data.Pool (withResource)
import Data.Profunctor.Product.Default (Default)
import Database.PostgreSQL.Simple (Connection)
import Database.PostgreSQL.Simple qualified as PGS
import Database.PostgreSQL.Simple.FromField ( Conversion, ResultError(ConversionFailed), fromField, returnError)
import Database.PostgreSQL.Simple.Internal  (Field)
import Database.PostgreSQL.Simple.LargeObjects qualified as PSQL
import Gargantext.Database.Class
import Gargantext.Database.Transactional
import Gargantext.Prelude
import Opaleye (SqlJsonb, DefaultFromField, toFields, matchMaybe, MaybeFields)
import Opaleye.Internal.Constant qualified
import Opaleye.Internal.Operators qualified
import Shelly qualified as SH
import System.Directory (removeFile)
import System.IO.Temp (emptySystemTempFile)


type JSONB = DefaultFromField SqlJsonb

-- FIXME(adinapoli): Using this function is dangerous and it should
-- eventualaly be removed. This function allows embedding /any/ IO computation
-- into a 'DBCmd' with a given 'Connection', which weans we can completely
-- bypass the transactional API. This function should /NOT/ be exported, but
-- rather used here carefully on a case-by-case analysis, like the functions
-- dealing with large objects.
withConn :: (Connection -> IO a) -> DBCmd err a
withConn k = do
  pool <- view connPool
  liftBase $ withResource pool (liftBase . k)

runCmd :: (Show err, Typeable err)
       => env
       -> CmdRandom env err a
       -> IO (Either err a)
runCmd env m = runExceptT $ runReaderT m env

debugFormatPGSQuery :: PGS.ToRow a => PGS.Query -> a -> DBCmd err BS.ByteString
debugFormatPGSQuery q a = withConn $ \conn -> PGS.formatQuery conn q a
  where

fromField' :: (Typeable b, FromJSON b) => Field -> Maybe BS.ByteString -> Conversion b
fromField' field mb = do
    v <- fromField field mb
    valueToHyperdata v
      where
          valueToHyperdata v = case fromJSON v of
             Success a  -> pure a
             Error err -> returnError ConversionFailed field
                         $ DL.unwords [ "cannot parse hyperdata for JSON: "
                                      , show v
                                      , err
                                      ]

dbCheck :: DBCmd err Bool
dbCheck = runDBQuery $ do
  r :: [PGS.Only Text] <- mkPGQuery "select username from public.auth_user" ()
  case r of
    [] -> pure False
    _  -> pure True

restrictMaybe :: ( Default Opaleye.Internal.Operators.IfPP b b
                 , (Default Opaleye.Internal.Constant.ToFields Bool b))
              => MaybeFields a -> (a -> b) -> b
restrictMaybe v cond = matchMaybe v $ \case
  Nothing -> toFields True
  Just v' -> cond v'


-- | Creates a PostgreSQL DB if it doesn't exist.
--   Accepts a pg connection string and db name as argument.
createDBIfNotExists :: Text -> Text -> IO ()
createDBIfNotExists connStr dbName = do
  -- For the \gexec trick, see:
  -- https://stackoverflow.com/questions/18389124/simulate-create-database-if-not-exists-for-postgresql
  (_res, _ec) <- SH.shelly $ SH.silently $ SH.escaping False $ do
    let sql = "\"SELECT 'CREATE DATABASE " <> dbName <> "' WHERE NOT EXISTS (SELECT FROM pg_database WHERE datname = '" <> dbName <> "')\\gexec\""
    result <- SH.run "echo" [sql, "|", "psql", "-d", "\"" <> connStr <> "\""]
    (result,) <$> SH.lastExitCode
    
  return ()


------------------------------
-- PostgreSQL Large Object functionality
-- https://www.postgresql.org/docs/17/largeobjects.html

-- NOTE: During development of this feature, I had problems (in tests)
-- with a hanging transaction. After debugging, it turned out this
-- was, for some reason, conflicting with our `logLocM` (though I'm no
-- sure why). Please be careful when adding debug info to large
-- objects and if you do, make sure the tests run.

createLargeObject :: BS.ByteString -> DBCmd err PSQL.Oid
createLargeObject bs = withConn $ \c -> PGS.withTransaction c $ do
  oId <- PSQL.loCreat c
  loFd <- PSQL.loOpen c oId PSQL.WriteMode
  _ <- PSQL.loWrite c loFd bs
  PSQL.loClose c loFd
  pure oId

-- | Read a large object directly, given an oid. We read it in a
-- single transaction, looping by given chunk size
readLargeObject :: PSQL.Oid -> DBCmd err BS.ByteString
readLargeObject oId = withConn $ \c -> PGS.withTransaction c $ do
  loFd <- PSQL.loOpen c oId PSQL.ReadMode
  let chunkSize = 1024
  let readChunks tell = do
        c' <- PSQL.loRead c loFd chunkSize
        tell' <- PSQL.loTell c loFd
        if tell == tell' then
          pure ([c'], tell)
        else do
          (cs', tell'') <- readChunks tell'
          pure (c':cs', tell'')
  (chunks, _size) <- readChunks 0
  let s = force BSL.toStrict $ BSL.fromChunks chunks
  PSQL.loClose c loFd
  pure s

-- | Read large object by exporting it to a temporary file, then
-- reading that file. The difference from 'readLargeObject' is that we
-- have only 1 call inside a transaction
readLargeObjectViaTempFile :: (CES.MonadMask m, IsDBCmd env err m)
                           => PSQL.Oid -> m BS.ByteString
readLargeObjectViaTempFile oId = do
  CES.bracket (liftBase $ emptySystemTempFile "large-object")
    (liftBase . removeFile)
    (\fp -> do
      withConn $ \c -> withTransaction c $ \_ -> PSQL.loExport c oId fp
      !contents <- liftBase $ BS.readFile fp
      pure contents)
  where
    withTransaction c = CES.bracket (PGS.begin c) (\_ -> PGS.rollback c)

removeLargeObject :: Int -> DBCmd err ()
removeLargeObject oId = withConn $ \c -> do
  PSQL.loUnlink c $ PSQL.Oid $ fromIntegral oId
