module Model.Notification.Notify
( lookupNotify
, lookupAccountNotify
, NoticeMap
, changeNotify
, removeNotify
, lookupNoticePartyAuthorization
) where
import Control.Monad (when)
import qualified Data.Aeson as JSON
import qualified Data.Vector as V
import qualified Data.Vector.Mutable as VM
import Database.PostgreSQL.Typed.Query (pgSQL)
import Has (peek)
import Service.DB
import Model.SQL
import Model.Id
import Model.Permission
import Model.Party.Types
import Model.Identity.Types
import Model.Notification.Notice
import Model.Notification.SQL
useTDB
lookupNotify :: MonadDB c m => Account -> Notice -> m Delivery
lookupNotify a n = fromMaybeDelivery <$>
dbQuery1 $(selectQuery selectNotifyDelivery "$WHERE target = ${partyId $ partyRow $ accountParty a} AND notice = ${n}")
lookupAccountNotify :: MonadDB c m => Account -> m (NoticeMap Delivery)
lookupAccountNotify a = NoticeMap <$>
dbQuery [pgSQL|!SELECT notice, delivery FROM notify_view WHERE target = ${partyId $ partyRow $ accountParty a} ORDER BY notice|]
changeNotify :: MonadDB c m => Account -> Notice -> Delivery -> m ()
changeNotify a n d = do
(r, _) <- updateOrInsert
[pgSQL|UPDATE notify SET delivery = ${d} WHERE target = ${partyId $ partyRow $ accountParty a} AND notice = ${n}|]
[pgSQL|INSERT INTO notify (target, notice, delivery) VALUES (${partyId $ partyRow $ accountParty a}, ${n}, ${d})|]
when (r /= 1) $ fail $ "changeNotify: " ++ show r ++ " rows"
removeNotify :: MonadDB c m => Account -> Notice -> m Bool
removeNotify a n =
dbExecute1 [pgSQL|DELETE FROM notify WHERE target = ${partyId $ partyRow $ accountParty a} AND notice = ${n}|]
lookupNoticePartyAuthorization :: (MonadHasIdentity c m, MonadDB c m) => Notice -> m [(Party, Maybe Permission, Delivery)]
lookupNoticePartyAuthorization n = do
ident <- peek
dbQuery $(selectQuery (selectPartyAuthorizationNotify 'ident) "WHERE notice = ${n} AND account.password IS NOT NULL")
newtype NoticeMap a = NoticeMap [(Notice, a)]
noticeInt :: Notice -> Int
noticeInt = fromIntegral . unId . noticeId
noticeMapToList :: NoticeMap a -> [Maybe a]
noticeMapToList (NoticeMap m) = pop 0 m where
pop _ [] = []
pop i nl@((n,x):l) = case i `compare` noticeInt n of
LT -> Nothing : pop (succ i) nl
EQ -> Just x : pop (succ i) l
GT -> error "NoticeMap: out of order"
instance JSON.ToJSON a => JSON.ToJSON (NoticeMap a) where
toJSON (NoticeMap m) = JSON.Array $ V.create $ do
v <- VM.replicate (succ (noticeInt maxBound)) JSON.Null
mapM_ (\(n,x) -> VM.write v (noticeInt n) $ JSON.toJSON x) m
return v
toEncoding = JSON.foldable . noticeMapToList