{-# LINE 1 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
module Database.PostgreSQL.PQTypes.Internal.Notification
  ( Channel(..)
  , Notification(..)
  , getNotificationIO
  ) where

import Control.Concurrent
import Control.Monad
import Control.Monad.Fix
import Data.String
import Foreign.Ptr
import Foreign.Storable
import System.Posix.Types
import System.Timeout
import Control.Exception qualified as E
import Data.ByteString.Char8 qualified as BS
import Data.Text qualified as T
import Data.Text.Encoding qualified as T

import Database.PostgreSQL.PQTypes.Internal.C.Interface
import Database.PostgreSQL.PQTypes.Internal.C.Types
import Database.PostgreSQL.PQTypes.Internal.Connection
import Database.PostgreSQL.PQTypes.Internal.State
import Database.PostgreSQL.PQTypes.Internal.Utils
import Database.PostgreSQL.PQTypes.SQL.Raw



foreign import ccall unsafe "PQnotifies"
  c_PQnotifies :: Ptr PGconn -> IO (Ptr Notification)

----------------------------------------

-- | Representation of notification channel.
newtype Channel = Channel (RawSQL ())
  deriving (Channel -> Channel -> Bool
(Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool) -> Eq Channel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Channel -> Channel -> Bool
== :: Channel -> Channel -> Bool
$c/= :: Channel -> Channel -> Bool
/= :: Channel -> Channel -> Bool
Eq, Eq Channel
Eq Channel =>
(Channel -> Channel -> Ordering)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Bool)
-> (Channel -> Channel -> Channel)
-> (Channel -> Channel -> Channel)
-> Ord Channel
Channel -> Channel -> Bool
Channel -> Channel -> Ordering
Channel -> Channel -> Channel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Channel -> Channel -> Ordering
compare :: Channel -> Channel -> Ordering
$c< :: Channel -> Channel -> Bool
< :: Channel -> Channel -> Bool
$c<= :: Channel -> Channel -> Bool
<= :: Channel -> Channel -> Bool
$c> :: Channel -> Channel -> Bool
> :: Channel -> Channel -> Bool
$c>= :: Channel -> Channel -> Bool
>= :: Channel -> Channel -> Bool
$cmax :: Channel -> Channel -> Channel
max :: Channel -> Channel -> Channel
$cmin :: Channel -> Channel -> Channel
min :: Channel -> Channel -> Channel
Ord)

instance IsString Channel where
  fromString :: String -> Channel
fromString = RawSQL () -> Channel
Channel (RawSQL () -> Channel)
-> (String -> RawSQL ()) -> String -> Channel
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> RawSQL ()
forall a. IsString a => String -> a
fromString

instance Show Channel where
  showsPrec :: Int -> Channel -> ShowS
showsPrec Int
n (Channel RawSQL ()
chan) = (String
"Channel " String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
n (RawSQL () -> Text
unRawSQL RawSQL ()
chan)

----------------------------------------

-- | Representation of a notification sent by PostgreSQL.
data Notification = Notification
  { -- | Process ID of notifying server.
    Notification -> CPid
ntPID     :: !CPid
    -- | Notification channel name.
  , Notification -> Channel
ntChannel :: !Channel
    -- | Notification payload string.
  , Notification -> Text
ntPayload :: !T.Text
  } deriving (Notification -> Notification -> Bool
(Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool) -> Eq Notification
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Notification -> Notification -> Bool
== :: Notification -> Notification -> Bool
$c/= :: Notification -> Notification -> Bool
/= :: Notification -> Notification -> Bool
Eq, Eq Notification
Eq Notification =>
(Notification -> Notification -> Ordering)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Bool)
-> (Notification -> Notification -> Notification)
-> (Notification -> Notification -> Notification)
-> Ord Notification
Notification -> Notification -> Bool
Notification -> Notification -> Ordering
Notification -> Notification -> Notification
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Notification -> Notification -> Ordering
compare :: Notification -> Notification -> Ordering
$c< :: Notification -> Notification -> Bool
< :: Notification -> Notification -> Bool
$c<= :: Notification -> Notification -> Bool
<= :: Notification -> Notification -> Bool
$c> :: Notification -> Notification -> Bool
> :: Notification -> Notification -> Bool
$c>= :: Notification -> Notification -> Bool
>= :: Notification -> Notification -> Bool
$cmax :: Notification -> Notification -> Notification
max :: Notification -> Notification -> Notification
$cmin :: Notification -> Notification -> Notification
min :: Notification -> Notification -> Notification
Ord, Int -> Notification -> ShowS
[Notification] -> ShowS
Notification -> String
(Int -> Notification -> ShowS)
-> (Notification -> String)
-> ([Notification] -> ShowS)
-> Show Notification
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Notification -> ShowS
showsPrec :: Int -> Notification -> ShowS
$cshow :: Notification -> String
show :: Notification -> String
$cshowList :: [Notification] -> ShowS
showList :: [Notification] -> ShowS
Show)

instance Storable Notification where
  sizeOf :: Notification -> Int
sizeOf Notification
_ = (Int
32)
{-# LINE 58 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
  alignment _ = 8
{-# LINE 59 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
  peek ptr = do
    ntPID <- pure . CPid
      =<< (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
{-# LINE 62 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
    ntChannel <- fmap (Channel . flip rawSQL () . T.decodeUtf8) . BS.packCString
      =<< (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
{-# LINE 64 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
    ntPayload <- fmap T.decodeUtf8 . BS.packCString
      =<< (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
{-# LINE 66 "src/Database/PostgreSQL/PQTypes/Internal/Notification.hsc" #-}
    pure Notification{..}
  poke :: Ptr Notification -> Notification -> IO ()
poke Ptr Notification
_ Notification
_ = String -> IO ()
forall a. HasCallStack => String -> a
error String
"Storable Notification: poke is not supposed to be used"

----------------------------------------

-- | Low-level function that waits for a notification for a given
-- number of microseconds (it uses 'timeout' function internally).
getNotificationIO :: DBState m -> Int -> IO (Maybe Notification)
getNotificationIO :: forall (m :: * -> *). DBState m -> Int -> IO (Maybe Notification)
getNotificationIO DBState m
st Int
n = Int -> IO Notification -> IO (Maybe Notification)
forall a. Int -> IO a -> IO (Maybe a)
timeout Int
n (IO Notification -> IO (Maybe Notification))
-> IO Notification -> IO (Maybe Notification)
forall a b. (a -> b) -> a -> b
$ do
  Connection
-> String
-> (ConnectionData -> IO (ConnectionData, Notification))
-> IO Notification
forall r.
Connection
-> String -> (ConnectionData -> IO (ConnectionData, r)) -> IO r
withConnectionData (DBState m -> Connection
forall (m :: * -> *). DBState m -> Connection
dbConnection DBState m
st) String
fname ((ConnectionData -> IO (ConnectionData, Notification))
 -> IO Notification)
-> (ConnectionData -> IO (ConnectionData, Notification))
-> IO Notification
forall a b. (a -> b) -> a -> b
$ \ConnectionData
cd -> (IO (ConnectionData, Notification)
 -> IO (ConnectionData, Notification))
-> IO (ConnectionData, Notification)
forall a. (a -> a) -> a
fix ((IO (ConnectionData, Notification)
  -> IO (ConnectionData, Notification))
 -> IO (ConnectionData, Notification))
-> (IO (ConnectionData, Notification)
    -> IO (ConnectionData, Notification))
-> IO (ConnectionData, Notification)
forall a b. (a -> b) -> a -> b
$ \IO (ConnectionData, Notification)
loop -> do
    let conn :: Ptr PGconn
conn = ConnectionData -> Ptr PGconn
cdPtr ConnectionData
cd
    Maybe Notification
mmsg <- Ptr PGconn -> IO (Maybe Notification)
tryGet Ptr PGconn
conn
    case Maybe Notification
mmsg of
      Just Notification
msg -> (ConnectionData, Notification) -> IO (ConnectionData, Notification)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConnectionData
cd, Notification
msg)
      Maybe Notification
Nothing -> do
        Fd
fd <- Ptr PGconn -> IO Fd
c_PQsocket Ptr PGconn
conn
        if Fd
fd Fd -> Fd -> Bool
forall a. Eq a => a -> a -> Bool
== -Fd
1
          then String -> IO (ConnectionData, Notification)
forall a. String -> IO a
hpqTypesError (String -> IO (ConnectionData, Notification))
-> String -> IO (ConnectionData, Notification)
forall a b. (a -> b) -> a -> b
$ String
fname String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": invalid file descriptor"
          else do
            Fd -> IO ()
threadWaitRead Fd
fd
            CInt
res <- Ptr PGconn -> IO CInt
c_PQconsumeInput Ptr PGconn
conn
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
res CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              Ptr PGconn -> String -> IO ()
forall a. Ptr PGconn -> String -> IO a
throwLibPQError Ptr PGconn
conn String
fname
            IO (ConnectionData, Notification)
loop
  where
    fname :: String
    fname :: String
fname = String
"getNotificationIO"

    tryGet :: Ptr PGconn -> IO (Maybe Notification)
    tryGet :: Ptr PGconn -> IO (Maybe Notification)
tryGet Ptr PGconn
connPtr = IO (Maybe Notification) -> IO (Maybe Notification)
forall a. IO a -> IO a
E.mask_ (IO (Maybe Notification) -> IO (Maybe Notification))
-> IO (Maybe Notification) -> IO (Maybe Notification)
forall a b. (a -> b) -> a -> b
$ do
      Ptr Notification
ptr <- Ptr PGconn -> IO (Ptr Notification)
c_PQnotifies Ptr PGconn
connPtr
      if Ptr Notification
ptr Ptr Notification -> Ptr Notification -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr Notification
forall a. Ptr a
nullPtr
        then do
          Notification
msg <- Ptr Notification -> IO Notification
forall a. Storable a => Ptr a -> IO a
peek Ptr Notification
ptr
          Ptr Notification -> IO ()
forall a. Ptr a -> IO ()
c_PQfreemem Ptr Notification
ptr
          Maybe Notification -> IO (Maybe Notification)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Notification -> IO (Maybe Notification))
-> Maybe Notification -> IO (Maybe Notification)
forall a b. (a -> b) -> a -> b
$ Notification -> Maybe Notification
forall a. a -> Maybe a
Just Notification
msg
        else Maybe Notification -> IO (Maybe Notification)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Notification
forall a. Maybe a
Nothing