-- | The large-object interface, implemented over the server's @lo_*@ SQL
-- functions (rather than libpq's fast-path protocol) - identical results, far
-- less machinery. As with libpq, the open\/read\/write\/close operations must be
-- run inside a transaction managed by the caller.
module Pqi.Native.LargeObject
  ( loCreat,
    loCreate,
    loImport,
    loImportWithOid,
    loExport,
    loOpen,
    loWrite,
    loRead,
    loSeek,
    loTell,
    loTruncate,
    loClose,
    loUnlink,
  )
where

import qualified Data.ByteString.Char8 as ByteString.Char8
import Pqi (Format (..))
import Pqi.Native.Connection (Connection)
import Pqi.Native.Prelude
import qualified Pqi.Native.Query as Query
import Pqi.Native.Types (NativeResult (..))
import System.IO (IOMode (..), SeekMode (..))

loCreat :: Connection -> IO (Maybe Word32)
loCreat :: Connection -> IO (Maybe Word32)
loCreat Connection
connection =
  (Maybe ByteString -> (ByteString -> Maybe Word32) -> Maybe Word32
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Word32
parseOid) (Maybe ByteString -> Maybe Word32)
-> IO (Maybe ByteString) -> IO (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_creat($1 :: integer)" [Int -> Maybe (Word32, ByteString, Format)
intParam (-Int
1)]

loCreate :: Connection -> Word32 -> IO (Maybe Word32)
loCreate :: Connection -> Word32 -> IO (Maybe Word32)
loCreate Connection
connection Word32
oid =
  (Maybe ByteString -> (ByteString -> Maybe Word32) -> Maybe Word32
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Word32
parseOid) (Maybe ByteString -> Maybe Word32)
-> IO (Maybe ByteString) -> IO (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_create($1 :: oid)" [Word32 -> Maybe (Word32, ByteString, Format)
oidParam Word32
oid]

loImport :: Connection -> FilePath -> IO (Maybe Word32)
loImport :: Connection -> FilePath -> IO (Maybe Word32)
loImport Connection
connection FilePath
path =
  (Maybe ByteString -> (ByteString -> Maybe Word32) -> Maybe Word32
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Word32
parseOid) (Maybe ByteString -> Maybe Word32)
-> IO (Maybe ByteString) -> IO (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_import($1)" [ByteString -> Maybe (Word32, ByteString, Format)
textParam (FilePath -> ByteString
ByteString.Char8.pack FilePath
path)]

loImportWithOid :: Connection -> FilePath -> Word32 -> IO (Maybe Word32)
loImportWithOid :: Connection -> FilePath -> Word32 -> IO (Maybe Word32)
loImportWithOid Connection
connection FilePath
path Word32
oid =
  (Maybe ByteString -> (ByteString -> Maybe Word32) -> Maybe Word32
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Word32
parseOid)
    (Maybe ByteString -> Maybe Word32)
-> IO (Maybe ByteString) -> IO (Maybe Word32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_import($1, $2 :: oid)" [ByteString -> Maybe (Word32, ByteString, Format)
textParam (FilePath -> ByteString
ByteString.Char8.pack FilePath
path), Word32 -> Maybe (Word32, ByteString, Format)
oidParam Word32
oid]

loExport :: Connection -> Word32 -> FilePath -> IO (Maybe ())
loExport :: Connection -> Word32 -> FilePath -> IO (Maybe ())
loExport Connection
connection Word32
oid FilePath
path =
  Maybe ByteString -> Maybe ()
succeeded (Maybe ByteString -> Maybe ())
-> IO (Maybe ByteString) -> IO (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_export($1 :: oid, $2)" [Word32 -> Maybe (Word32, ByteString, Format)
oidParam Word32
oid, ByteString -> Maybe (Word32, ByteString, Format)
textParam (FilePath -> ByteString
ByteString.Char8.pack FilePath
path)]

loOpen :: Connection -> Word32 -> IOMode -> IO (Maybe Int32)
loOpen :: Connection -> Word32 -> IOMode -> IO (Maybe Int32)
loOpen Connection
connection Word32
oid IOMode
mode =
  (Int -> Int32) -> Maybe Int -> Maybe Int32
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Int32
forall a b. (Integral a, Num b) => a -> b
fromIntegral
    (Maybe Int -> Maybe Int32)
-> (Maybe ByteString -> Maybe Int)
-> Maybe ByteString
-> Maybe Int32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Int
parseInt)
    (Maybe ByteString -> Maybe Int32)
-> IO (Maybe ByteString) -> IO (Maybe Int32)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_open($1 :: oid, $2 :: integer)" [Word32 -> Maybe (Word32, ByteString, Format)
oidParam Word32
oid, Int -> Maybe (Word32, ByteString, Format)
intParam (IOMode -> Int
ioModeFlag IOMode
mode)]

loWrite :: Connection -> Int32 -> ByteString -> IO (Maybe Int)
loWrite :: Connection -> Int32 -> ByteString -> IO (Maybe Int)
loWrite Connection
connection Int32
fd ByteString
payload =
  (Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Int
parseInt) (Maybe ByteString -> Maybe Int)
-> IO (Maybe ByteString) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lowrite($1 :: integer, $2 :: bytea)" [Int -> Maybe (Word32, ByteString, Format)
intParam (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
fd), ByteString -> Maybe (Word32, ByteString, Format)
byteaParam ByteString
payload]

loRead :: Connection -> Int32 -> Int -> IO (Maybe ByteString)
loRead :: Connection -> Int32 -> Int -> IO (Maybe ByteString)
loRead Connection
connection Int32
fd Int
len =
  Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callBinary Connection
connection ByteString
"select loread($1 :: integer, $2 :: integer)" [Int -> Maybe (Word32, ByteString, Format)
intParam (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
fd), Int -> Maybe (Word32, ByteString, Format)
intParam Int
len]

loSeek :: Connection -> Int32 -> SeekMode -> Int -> IO (Maybe Int)
loSeek :: Connection -> Int32 -> SeekMode -> Int -> IO (Maybe Int)
loSeek Connection
connection Int32
fd SeekMode
whence Int
offset =
  (Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Int
parseInt)
    (Maybe ByteString -> Maybe Int)
-> IO (Maybe ByteString) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_lseek($1 :: integer, $2 :: integer, $3 :: integer)" [Int -> Maybe (Word32, ByteString, Format)
intParam (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
fd), Int -> Maybe (Word32, ByteString, Format)
intParam Int
offset, Int -> Maybe (Word32, ByteString, Format)
intParam (SeekMode -> Int
seekFlag SeekMode
whence)]

loTell :: Connection -> Int32 -> IO (Maybe Int)
loTell :: Connection -> Int32 -> IO (Maybe Int)
loTell Connection
connection Int32
fd =
  (Maybe ByteString -> (ByteString -> Maybe Int) -> Maybe Int
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ByteString -> Maybe Int
parseInt) (Maybe ByteString -> Maybe Int)
-> IO (Maybe ByteString) -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_tell($1 :: integer)" [Int -> Maybe (Word32, ByteString, Format)
intParam (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
fd)]

loTruncate :: Connection -> Int32 -> Int -> IO (Maybe ())
loTruncate :: Connection -> Int32 -> Int -> IO (Maybe ())
loTruncate Connection
connection Int32
fd Int
len =
  Maybe ByteString -> Maybe ()
succeeded (Maybe ByteString -> Maybe ())
-> IO (Maybe ByteString) -> IO (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_truncate($1 :: integer, $2 :: integer)" [Int -> Maybe (Word32, ByteString, Format)
intParam (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
fd), Int -> Maybe (Word32, ByteString, Format)
intParam Int
len]

loClose :: Connection -> Int32 -> IO (Maybe ())
loClose :: Connection -> Int32 -> IO (Maybe ())
loClose Connection
connection Int32
fd =
  Maybe ByteString -> Maybe ()
succeeded (Maybe ByteString -> Maybe ())
-> IO (Maybe ByteString) -> IO (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_close($1 :: integer)" [Int -> Maybe (Word32, ByteString, Format)
intParam (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
fd)]

loUnlink :: Connection -> Word32 -> IO (Maybe ())
loUnlink :: Connection -> Word32 -> IO (Maybe ())
loUnlink Connection
connection Word32
oid =
  Maybe ByteString -> Maybe ()
succeeded (Maybe ByteString -> Maybe ())
-> IO (Maybe ByteString) -> IO (Maybe ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
"select lo_unlink($1 :: oid)" [Word32 -> Maybe (Word32, ByteString, Format)
oidParam Word32
oid]

-- * Helpers

callText :: Connection -> ByteString -> [Maybe (Word32, ByteString, Format)] -> IO (Maybe ByteString)
callText :: Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callText Connection
connection ByteString
sql [Maybe (Word32, ByteString, Format)]
params = (Maybe NativeResult
-> (NativeResult -> Maybe ByteString) -> Maybe ByteString
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NativeResult -> Maybe ByteString
firstValue) (Maybe NativeResult -> Maybe ByteString)
-> IO (Maybe NativeResult) -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> Format
-> IO (Maybe NativeResult)
Query.execParams Connection
connection ByteString
sql [Maybe (Word32, ByteString, Format)]
params Format
Text

callBinary :: Connection -> ByteString -> [Maybe (Word32, ByteString, Format)] -> IO (Maybe ByteString)
callBinary :: Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> IO (Maybe ByteString)
callBinary Connection
connection ByteString
sql [Maybe (Word32, ByteString, Format)]
params = (Maybe NativeResult
-> (NativeResult -> Maybe ByteString) -> Maybe ByteString
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= NativeResult -> Maybe ByteString
firstValue) (Maybe NativeResult -> Maybe ByteString)
-> IO (Maybe NativeResult) -> IO (Maybe ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection
-> ByteString
-> [Maybe (Word32, ByteString, Format)]
-> Format
-> IO (Maybe NativeResult)
Query.execParams Connection
connection ByteString
sql [Maybe (Word32, ByteString, Format)]
params Format
Binary

firstValue :: NativeResult -> Maybe ByteString
firstValue :: NativeResult -> Maybe ByteString
firstValue NativeResult
result = case NativeResult -> [[Maybe ByteString]]
rows NativeResult
result of
  (Maybe ByteString
cell : [Maybe ByteString]
_) : [[Maybe ByteString]]
_ -> Maybe ByteString
cell
  [[Maybe ByteString]]
_ -> Maybe ByteString
forall a. Maybe a
Nothing

succeeded :: Maybe ByteString -> Maybe ()
succeeded :: Maybe ByteString -> Maybe ()
succeeded = (ByteString -> ()) -> Maybe ByteString -> Maybe ()
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (() -> ByteString -> ()
forall a b. a -> b -> a
const ())

intParam :: Int -> Maybe (Word32, ByteString, Format)
intParam :: Int -> Maybe (Word32, ByteString, Format)
intParam Int
value = (Word32, ByteString, Format) -> Maybe (Word32, ByteString, Format)
forall a. a -> Maybe a
Just (Word32
0, FilePath -> ByteString
ByteString.Char8.pack (Int -> FilePath
forall a. Show a => a -> FilePath
show Int
value), Format
Text)

oidParam :: Word32 -> Maybe (Word32, ByteString, Format)
oidParam :: Word32 -> Maybe (Word32, ByteString, Format)
oidParam Word32
value = (Word32, ByteString, Format) -> Maybe (Word32, ByteString, Format)
forall a. a -> Maybe a
Just (Word32
0, FilePath -> ByteString
ByteString.Char8.pack (Word32 -> FilePath
forall a. Show a => a -> FilePath
show Word32
value), Format
Text)

textParam :: ByteString -> Maybe (Word32, ByteString, Format)
textParam :: ByteString -> Maybe (Word32, ByteString, Format)
textParam ByteString
value = (Word32, ByteString, Format) -> Maybe (Word32, ByteString, Format)
forall a. a -> Maybe a
Just (Word32
0, ByteString
value, Format
Text)

byteaParam :: ByteString -> Maybe (Word32, ByteString, Format)
byteaParam :: ByteString -> Maybe (Word32, ByteString, Format)
byteaParam ByteString
value = (Word32, ByteString, Format) -> Maybe (Word32, ByteString, Format)
forall a. a -> Maybe a
Just (Word32
17, ByteString
value, Format
Binary)

parseInt :: ByteString -> Maybe Int
parseInt :: ByteString -> Maybe Int
parseInt = ((Int, ByteString) -> Int) -> Maybe (Int, ByteString) -> Maybe Int
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst (Maybe (Int, ByteString) -> Maybe Int)
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
ByteString.Char8.readInt

parseOid :: ByteString -> Maybe Word32
parseOid :: ByteString -> Maybe Word32
parseOid = ((Int, ByteString) -> Word32)
-> Maybe (Int, ByteString) -> Maybe Word32
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32)
-> ((Int, ByteString) -> Int) -> (Int, ByteString) -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, ByteString) -> Int
forall a b. (a, b) -> a
fst) (Maybe (Int, ByteString) -> Maybe Word32)
-> (ByteString -> Maybe (Int, ByteString))
-> ByteString
-> Maybe Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe (Int, ByteString)
ByteString.Char8.readInt

ioModeFlag :: IOMode -> Int
ioModeFlag :: IOMode -> Int
ioModeFlag = \case
  IOMode
ReadMode -> Int
0x40000 -- INV_READ
  IOMode
WriteMode -> Int
0x20000 -- INV_WRITE
  IOMode
AppendMode -> Int
0x20000
  IOMode
ReadWriteMode -> Int
0x60000 -- INV_READ | INV_WRITE

seekFlag :: SeekMode -> Int
seekFlag :: SeekMode -> Int
seekFlag = \case
  SeekMode
AbsoluteSeek -> Int
0
  SeekMode
RelativeSeek -> Int
1
  SeekMode
SeekFromEnd -> Int
2