{-# 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 GHC.Stack
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.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 :: HasCallStack => Connection -> Int -> IO (Maybe Notification)
getNotificationIO :: HasCallStack => Connection -> Int -> IO (Maybe Notification)
getNotificationIO Connection
conn 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
$ (IO Notification -> IO Notification) -> IO Notification
forall a. (a -> a) -> a
fix ((IO Notification -> IO Notification) -> IO Notification)
-> (IO Notification -> IO Notification) -> IO Notification
forall a b. (a -> b) -> a -> b
$ \IO Notification
loop -> do
  mmsg <- Ptr PGconn -> IO (Maybe Notification)
tryGet (Ptr PGconn -> IO (Maybe Notification))
-> Ptr PGconn -> IO (Maybe Notification)
forall a b. (a -> b) -> a -> b
$ Connection -> Ptr PGconn
connPtr Connection
conn
  case mmsg of
    Just Notification
msg -> Notification -> IO Notification
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Notification
msg
    Maybe Notification
Nothing -> do
      fd <- Ptr PGconn -> IO Fd
c_PQsocket (Ptr PGconn -> IO Fd) -> Ptr PGconn -> IO Fd
forall a b. (a -> b) -> a -> b
$ Connection -> Ptr PGconn
connPtr Connection
conn
      if fd == -1
        then hpqTypesError $ fname ++ ": invalid file descriptor"
        else do
          threadWaitRead fd
          res <- c_PQconsumeInput $ connPtr conn
          when (res /= 1) $ do
            throwLibPQError (connPtr conn) fname
          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 <- Ptr PGconn -> IO (Ptr Notification)
c_PQnotifies Ptr PGconn
connPtr
      if ptr /= nullPtr
        then do
          msg <- peek ptr
          c_PQfreemem ptr
          pure $ Just msg
        else pure Nothing