{-# LANGUAGE CPP #-}{-# LANGUAGE NamedFieldPuns #-}{-# LANGUAGE RecordWildCards #-}------------------------------------------------------------------------------- |-- Module : Database.PostgreSQL.Simple.Notification-- Copyright : (c) 2011-2012 Leon P Smith-- License : BSD3---- Maintainer : leon@melding-monads.com-- Stability : experimental---- Support for receiving asynchronous notifications via PostgreSQL's-- Listen/Notify mechanism. See-- <http://www.postgresql.org/docs/9.1/static/sql-notify.html> for more-- information.---- Note that on Windows, @getNotification@ currently uses a polling loop-- of 1 second to check for more notifications, due to some inadequacies-- in GHC's IO implementation and interface on that platform. See GHC-- issue #7353 for more information. While this workaround is less than-- ideal, notifications are still better than polling the database directly.-- Notifications do not create any extra work for the backend, and are-- likely cheaper on the client side as well.---- <http://hackage.haskell.org/trac/ghc/ticket/7353>-------------------------------------------------------------------------------moduleDatabase.PostgreSQL.Simple.Notification(Notification(..),getNotification,getNotificationNonBlocking,getBackendPID)whereimportControl.ConcurrentimportControl.Monad(when)importControl.Exception(throwIO)importqualifiedData.ByteStringasBimportDatabase.PostgreSQL.Simple.InternalimportqualifiedDatabase.PostgreSQL.LibPQasPQimportSystem.Posix.Types(CPid)dataNotification=Notification{notificationPid::!CPid,notificationChannel::!B.ByteString,notificationData::!B.ByteString}convertNotice::PQ.Notify->NotificationconvertNoticePQ.Notify{..}=Notification{notificationPid=notifyBePid,notificationChannel=notifyRelname,notificationData=notifyExtra}-- | Returns a single notification. If no notifications are available,-- 'getNotification' blocks until one arrives.getNotification::Connection->IONotificationgetNotificationconn=loopFalsewherefuncName="Database.PostgreSQL.Simple.Notification.getNotification"loopdoConsume=dores<-withConnectionconn$\c->dowhendoConsume(PQ.consumeInputc>>return())mmsg<-PQ.notifiesccasemmsgofNothing->domfd<-PQ.socketccasemfdofNothing->throwIO$fdErrorfuncNameJustfd->return(Leftfd)Justmsg->return(Rightmsg)-- FIXME? what happens if the connection is closed/reset right here?caseresof#if defined(mingw32_HOST_OS)-- threadWaitRead doesn't work for sockets on Windows, so just poll-- for input every second (PQconsumeInput is non-blocking).---- We could call select(), but FFI calls can't be interrupted with-- async exceptions, whereas threadDelay can.Left_fd->threadDelay1000000>>loopTrue#elseLeftfd->threadWaitReadfd>>loopTrue#endifRightmsg->return$!convertNoticemsg-- | Non-blocking variant of 'getNotification'. Returns a single notification,-- if available. If no notifications are available, returns 'Nothing'.getNotificationNonBlocking::Connection->IO(MaybeNotification)getNotificationNonBlockingconn=withConnectionconn$\c->dommsg<-PQ.notifiesccasemmsgofJustmsg->return$!Just$!convertNoticemsgNothing->do_<-PQ.consumeInputcmmsg'<-PQ.notifiesccasemmsg'ofJustmsg->return$!Just$!convertNoticemsgNothing->returnNothing-- | Returns the process 'CPid' of the backend server process-- handling this connection.---- The backend PID is useful for debugging purposes and for comparison-- to NOTIFY messages (which include the PID of the notifying backend-- process). Note that the PID belongs to a process executing on the-- database server host, not the local host!getBackendPID::Connection->IOCPidgetBackendPIDconn=withConnectionconnPQ.backendPID