{-# 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 qualified Control.Exception as E
import qualified Data.ByteString.Char8 as BS
import qualified Data.Text as T
import qualified Data.Text.Encoding 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Channel -> Channel -> Bool
$c/= :: Channel -> Channel -> Bool
== :: Channel -> Channel -> Bool
$c== :: Channel -> Channel -> Bool
Eq, Eq 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
min :: Channel -> Channel -> Channel
$cmin :: Channel -> Channel -> Channel
max :: Channel -> Channel -> Channel
$cmax :: Channel -> Channel -> Channel
>= :: Channel -> Channel -> Bool
$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
compare :: Channel -> Channel -> Ordering
$ccompare :: Channel -> Channel -> Ordering
Ord)

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

instance Show Channel where
  showsPrec :: Int -> Channel -> ShowS
showsPrec Int
n (Channel RawSQL ()
chan) = (String
"Channel " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Notification -> Notification -> Bool
$c/= :: Notification -> Notification -> Bool
== :: Notification -> Notification -> Bool
$c== :: Notification -> Notification -> Bool
Eq, Eq 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
min :: Notification -> Notification -> Notification
$cmin :: Notification -> Notification -> Notification
max :: Notification -> Notification -> Notification
$cmax :: Notification -> Notification -> Notification
>= :: Notification -> Notification -> Bool
$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
compare :: Notification -> Notification -> Ordering
$ccompare :: Notification -> Notification -> Ordering
Ord, Int -> Notification -> ShowS
[Notification] -> ShowS
Notification -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Notification] -> ShowS
$cshowList :: [Notification] -> ShowS
show :: Notification -> String
$cshow :: Notification -> String
showsPrec :: Int -> Notification -> ShowS
$cshowsPrec :: Int -> 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 <- return . 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" #-}
    return Notification{..}
  poke :: Ptr Notification -> Notification -> IO ()
poke Ptr Notification
_ Notification
_ = 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 = forall a. Int -> IO a -> IO (Maybe a)
timeout Int
n forall a b. (a -> b) -> a -> b
$ do
  forall r.
Connection
-> String -> (ConnectionData -> IO (ConnectionData, r)) -> IO r
withConnectionData (forall (m :: * -> *). DBState m -> Connection
dbConnection DBState m
st) String
fname forall a b. (a -> b) -> a -> b
$ \ConnectionData
cd -> forall a. (a -> a) -> a
fix 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return (ConnectionData
cd, Notification
msg)
      Maybe Notification
Nothing -> do
        Fd
fd <- Ptr PGconn -> IO Fd
c_PQsocket Ptr PGconn
conn
        if Fd
fd forall a. Eq a => a -> a -> Bool
== -Fd
1
          then forall a. String -> IO a
hpqTypesError forall a b. (a -> b) -> a -> b
$ String
fname 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
            forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
res forall a. Eq a => a -> a -> Bool
/= CInt
1) forall a b. (a -> b) -> a -> b
$ do
              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 = forall a. IO a -> IO a
E.mask_ 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 forall a. Eq a => a -> a -> Bool
/= forall a. Ptr a
nullPtr
        then do
          Notification
msg <- forall a. Storable a => Ptr a -> IO a
peek Ptr Notification
ptr
          forall a. Ptr a -> IO ()
c_PQfreemem Ptr Notification
ptr
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Notification
msg
        else forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing