1 {-# LANGUAGE TemplateHaskell, QuasiQuotes, DataKinds, RecordWildCards, OverloadedStrings #-}
    2 module Databrary.Model.Notification
    3   ( module Databrary.Model.Notification.Types
    4   , module Databrary.Model.Notification.Notify
    5   , addNotification
    6   , addBroadcastNotification
    7   , changeNotificationsDelivery
    8   , lookupUserNotifications
    9   , countUserNotifications
   10   , lookupUndeliveredNotifications
   11   , removeNotification
   12   , removeNotifications
   13   , cleanNotifications
   14   , removeMatchingNotifications
   15   , notificationJSON
   16   ) where
   17 
   18 import Control.Monad (mfilter)
   19 import Data.Int (Int64)
   20 import Data.Maybe (fromMaybe)
   21 import Data.Monoid ((<>))
   22 import Database.PostgreSQL.Typed (pgSQL)
   23 
   24 import Databrary.Has
   25 import qualified Databrary.JSON as JSON
   26 import Databrary.Service.DB
   27 import Databrary.Model.SQL
   28 import Databrary.Model.Id.Types
   29 import Databrary.Model.Party
   30 import Databrary.Model.Volume.Types
   31 import Databrary.Model.Segment
   32 import Databrary.Model.Tag.Types
   33 import Databrary.Model.Notification.Types
   34 import Databrary.Model.Notification.Notify
   35 import Databrary.Model.Notification.SQL
   36 
   37 useTDB
   38 
   39 addNotification :: (MonadDB c m, MonadHas Party c m) => Notification -> m Notification
   40 addNotification n@Notification{..} = do
   41   u <- peeks partyRow
   42   (i, t) <- dbQuery1' [pgSQL|INSERT INTO notification (target, notice, delivered, agent, party, volume, container, segment, asset, comment, tag, permission, release) VALUES (${partyId $ partyRow $ accountParty notificationTarget}, ${notificationNotice}, ${notificationDelivered}, ${partyId u}, ${partyId <$> notificationParty}, ${volumeId <$> notificationVolume}, ${notificationContainerId}, ${notificationSegment}, ${notificationAssetId}, ${notificationCommentId}, ${tagId <$> notificationTag}, ${notificationPermission}, ${notificationRelease}) RETURNING id, time|]
   43   return n
   44     { notificationId = i
   45     , notificationTime = t
   46     , notificationAgent = u
   47     }
   48 
   49 addBroadcastNotification :: (MonadDB c m, MonadHas Party c m) => Notification -> m Int
   50 addBroadcastNotification Notification{..} = do
   51   u <- peeks (partyId . partyRow)
   52   dbExecute [pgSQL|INSERT INTO notification (target, notice, delivered, agent, party, volume, container, segment, asset, comment, tag, permission, release) SELECT target, notice, ${notificationDelivered}, ${u}, ${partyId <$> notificationParty}, ${volumeId <$> notificationVolume}, ${notificationContainerId}, ${notificationSegment}, ${notificationAssetId}, ${notificationCommentId}, ${tagId <$> notificationTag}, ${notificationPermission}, ${notificationRelease} FROM notify_view WHERE notice = ${notificationNotice} AND delivery > 'none' AND target <> ${u}|]
   53 
   54 changeNotificationsDelivery :: MonadDB c m => [Notification] -> Delivery -> m Int
   55 changeNotificationsDelivery nl d =
   56   dbExecute [pgSQL|UPDATE notification SET delivered = ${d} WHERE id = ANY (${map notificationId nl}) AND delivered < ${d}|]
   57 
   58 lookupUserNotifications :: (MonadDB c m, MonadHas Account c m) => m [Notification]
   59 lookupUserNotifications = do
   60   u <- peek
   61   dbQuery $ ($ u) <$> $(selectQuery selectTargetNotification "$WHERE target = ${view u :: Id Party} ORDER BY notification.id DESC")
   62 
   63 countUserNotifications :: (MonadDB c m, MonadHas (Id Party) c m) => m Int64
   64 countUserNotifications = do
   65   u <- peek
   66   dbQuery1' $ fromMaybe 0 <$> [pgSQL|$SELECT count(id) FROM notification WHERE target = ${u :: Id Party} AND delivered = 'none'|]
   67 
   68 lookupUndeliveredNotifications :: MonadDB c m => Delivery -> m [Notification]
   69 lookupUndeliveredNotifications d =
   70   dbQuery $(selectQuery selectNotification "JOIN notify_view USING (target, notice) WHERE delivery >= ${d} AND delivered = 'none' ORDER BY notification.target, notification.id")
   71 
   72 removeNotification :: (MonadDB c m, MonadHas (Id Party) c m) => Id Notification -> m Bool
   73 removeNotification i = do
   74   p <- peek
   75   dbExecute1 [pgSQL|DELETE FROM notification WHERE id = ${i} AND target = ${p :: Id Party}|]
   76 
   77 removeNotifications :: (MonadDB c m, MonadHas (Id Party) c m) => m Int
   78 removeNotifications = do
   79   p <- peek
   80   dbExecute [pgSQL|DELETE FROM notification WHERE target = ${p :: Id Party} AND agent <> ${partyId $ partyRow nobodyParty}|]
   81 
   82 cleanNotifications :: MonadDB c m => m Int
   83 cleanNotifications =
   84   dbExecute [pgSQL|DELETE FROM notification WHERE delivered > 'none' AND time < CURRENT_TIMESTAMP - interval '30 days'|]
   85 
   86 removeMatchingNotifications :: MonadDB c m => Notification -> m Int
   87 removeMatchingNotifications Notification{..} =
   88   dbExecute [pgSQL|DELETE FROM notification
   89     WHERE notice = ${notificationNotice}
   90       AND target = COALESCE(${mfilter (no /=) $ Just $ partyId $ partyRow $ accountParty notificationTarget}, target) 
   91       AND agent = COALESCE(${mfilter (no /=) $ Just $ partyId notificationAgent}, agent) 
   92       AND COALESCE(party, -1) = COALESCE(${partyId <$> notificationParty}, party, -1)
   93       AND COALESCE(volume, -1) = COALESCE(${volumeId <$> notificationVolume}, volume, -1)
   94       AND COALESCE(container, -1) = COALESCE(${notificationContainerId}, container, -1)
   95       AND COALESCE(segment, 'empty') <@ ${fromMaybe fullSegment notificationSegment} 
   96       AND COALESCE(asset, -1) = COALESCE(${notificationAssetId}, asset, -1)
   97       AND COALESCE(comment, -1) = COALESCE(${notificationCommentId}, comment, -1)
   98       AND COALESCE(tag, -1) = COALESCE(${tagId <$> notificationTag}, tag, -1)
   99     |]
  100   where
  101   no :: Num (IdType a) => Id a
  102   no = Id $ -1
  103 
  104 notificationJSON :: JSON.ToNestedObject o u => Notification -> JSON.Record (Id Notification) o
  105 notificationJSON Notification{..} = JSON.Record notificationId $
  106      "notice" JSON..= notificationNotice
  107   <> "time" JSON..= notificationTime
  108   <> "delivered" JSON..= notificationDelivered
  109   <> "agent" JSON..=. JSON.recordObject ({-on (==) partyId notificationAgent (partyRow (accountParty notificationTarget)) ?!>-} partyRowJSON notificationAgent)
  110   <> "party" `JSON.kvObjectOrEmpty` (partyId <$> notificationParty)
  111   <> "permission" `JSON.kvObjectOrEmpty` notificationPermission
  112   <> "volume" `JSON.kvObjectOrEmpty` (volumeId <$> notificationVolume)
  113   <> "container" `JSON.kvObjectOrEmpty` notificationContainerId
  114   <> "segment" `JSON.kvObjectOrEmpty` notificationSegment
  115   <> "asset" `JSON.kvObjectOrEmpty` notificationAssetId
  116   <> "comment" `JSON.kvObjectOrEmpty` notificationCommentId
  117   <> "tag" `JSON.kvObjectOrEmpty` (tagName <$> notificationTag)