1 {-# LANGUAGE OverloadedStrings, RecordWildCards #-} 2 module Databrary.View.Notification 3 ( mailNotifications 4 , htmlNotification 5 ) where 6 7 import Control.Arrow (second) 8 import qualified Data.ByteString.Builder as BSB 9 import qualified Data.ByteString.Char8 as BSC 10 import Data.Function (on) 11 import Data.Maybe (fromMaybe, isJust) 12 import Data.Monoid ((<>)) 13 import qualified Data.Text.Encoding as TE 14 import qualified Data.Text.Lazy as TL 15 import qualified Data.Text.Lazy.Encoding as TLE 16 import qualified Text.Blaze.Html5 as H 17 import qualified Text.Blaze.Html5.Attributes as HA 18 19 import Databrary.Ops 20 import Databrary.Model.Permission 21 import Databrary.Model.Id.Types 22 import Databrary.Model.Party 23 import Databrary.Model.Volume.Types 24 import Databrary.Model.Segment 25 import Databrary.Model.Slot.Types 26 import Databrary.Model.Tag.Types 27 import Databrary.Model.Notification 28 import Databrary.Service.Messages 29 import Databrary.HTTP.Route 30 import Databrary.Action.Route 31 import Databrary.Controller.Paths 32 import {-# SOURCE #-} Databrary.Controller.Party 33 import {-# SOURCE #-} Databrary.Controller.Volume 34 import {-# SOURCE #-} Databrary.Controller.Slot 35 import {-# SOURCE #-} Databrary.Controller.AssetSegment 36 import Databrary.View.Authorize (authorizeSiteTitle) 37 import Databrary.View.Party (htmlPartyViewLink) 38 import Databrary.View.Volume (htmlVolumeViewLink) 39 import Databrary.View.VolumeAccess (volumeAccessTitle, volumeAccessPresetTitle) 40 import Databrary.View.Container (releaseTitle) 41 import Databrary.View.Html 42 43 mailLink :: Route r a -> a -> [(BSC.ByteString, BSC.ByteString)] -> TL.Text 44 mailLink u a q = TLE.decodeLatin1 $ BSB.toLazyByteString $ "https://databrary.org" <> actionURL Nothing u a (map (second Just) q :: Query) 45 46 partyEditLink :: (ActionRoute PartyTarget -> PartyTarget -> t) -> PartyRow -> PartyRow -> t 47 partyEditLink link target p = link viewPartyEdit (if on (==) partyId p target then TargetProfile else TargetParty (partyId p)) 48 49 mailNotification :: Messages -> Notification -> TL.Text 50 mailNotification msg Notification{..} = case notificationNotice of 51 NoticeAccountChange -> 52 party'S <> " email or password has been changed. If you made this change, you may ignore this email. To review or update your account information, go to: " 53 <> partyEdit (fromMaybe target notificationParty) [("page", "account")] 54 <> "\nIf you did not make this change, please contact us immediately." 55 NoticeAuthorizeRequest -> 56 agent <> " requested authorization from " <> party <> ". To review the status of this request, go to: " 57 <> partyEdit target [("page", "apply"), partyq] 58 NoticeAuthorizeGranted 59 | Just p <- notificationPermission -> 60 "You have been authorized under " <> party <> ", " 61 <> if p == PermissionNONE then "for group/lab-only access." 62 else "as a Databrary " <> TL.fromStrict (authorizeSiteTitle p msg) <> ". \ 63 \Your authorization allows you to access all the shared data in Databrary. \ 64 \Our primary goal is to inspire you to reuse shared videos on Databrary to ask new questions outside the scope of the original study. \ 65 \You will also find illustrative video excerpts that you can use for teaching and to learn about other researchers' methods and procedures.\ 66 \\n\n\ 67 \Databrary's unique \"active curation\" functionality allows you to upload your videos as you collect them so that your data are backed up and preserved in our free, secure library, your videos are immediately available to you and your collaborators offsite, and your data are organized and ready for sharing. \ 68 \Your data will remain private and accessible only to your lab members and collaborators until you are ready to share with the Databrary community. \ 69 \When you are ready, sharing is as easy as clicking a button!\ 70 \\n\n\ 71 \You can use our template Databrary release form to obtain permission for sharing the data you collect from your participants, which can be found here: http://databrary.org/access/policies/release-template.html.\n\ 72 \The release form can be added to new or existing IRB protocols. \ 73 \It is completely adaptable and can be customized to suit your needs. \ 74 \We also offer additional information and helpful tips about managing and sharing your video data in our User Guide: http://databrary.org/access/guide. \ 75 \Information about downloading data from Databrary and other useful instructions can be found in the Frequently Asked Questions: https://www.databrary.org/resources/faq.html.\n\ 76 \As soon as your protocol is amended to allow you to share data, you can start uploading your data from each new session. \ 77 \Don't wait until your study is complete to upload your videos. \ 78 \It's much easier to upload data after each data collection while your study is in progress!\ 79 \\n\n\ 80 \We are dedicated to providing assistance to the Databrary community. \ 81 \Please contact us at support@databrary.org with questions or for help getting started.\ 82 \\n" 83 | otherwise -> 84 "Your authorization under " <> party <> " has been revoked. To review and apply for authorizations, go to: " 85 <> partyEdit target [("page", "apply")] 86 NoticeAuthorizeExpiring -> 87 "Your authorization under " <> party <> " will expire within a week. Please contact them and request that they renew your authorization." 88 NoticeAuthorizeExpired -> 89 "Your authorization under " <> party <> " has expired. Please contact them and request that they renew your authorization." 90 NoticeAuthorizeChildRequest -> 91 agent <> " has requested to be authorized through " <> party <> ". To approve or reject this authorization request, go to: " 92 <> partyEdit (fromMaybe target notificationParty) [("page", "grant"), personq $ Just notificationAgent] 93 NoticeAuthorizeChildGranted -> 94 agent <> " " <> granted <> " authorization to " <> party <> ". To review this authorization, go to: " 95 <> partyEdit target [("page", "grant"), partyq] 96 NoticeAuthorizeChildExpiring -> 97 party'S <> " authorization will expire within a week. If you would like to renew their authorization, go to: " 98 <> partyEdit target [("page", "grant"), partyq] 99 NoticeAuthorizeChildExpired -> 100 party'S <> " authorization has expired. If you would like to renew their authorization, go to: " 101 <> partyEdit target [("page", "grant"), partyq] 102 NoticeVolumeAssist -> 103 agent <> " requested assistance with your volume, " <> volume <> ". To review this request, go to: " 104 <> volumeEdit [("page", "assist")] 105 NoticeVolumeCreated -> 106 agent <> " created a volume, " <> volume <> ", on " <> party's <> " behalf. To review this volume, go to: " 107 <> mailLink viewVolume (HTML, maybe noId volumeId notificationVolume) [] 108 NoticeVolumeSharing -> 109 agent <> " changed your volume, " <> volume <> ", to " <> TL.fromStrict (volumeAccessPresetTitle (PermissionNONE < perm) msg) <> ". To review this change, go to: " 110 <> volumeEdit [("page", "access")] 111 NoticeVolumeAccessOther -> 112 agent <> " set " <> party's <> " access to " <> TL.fromStrict (volumeAccessTitle perm msg) <> " on your volume, " <> volume <> ". To review this change, go to: " 113 <> volumeEdit [("page", "access"), partyq] 114 NoticeVolumeAccess -> 115 agent <> " set " <> party's <> " access to " <> TL.fromStrict (volumeAccessTitle perm msg) <> " on your volume, " <> volume <> ". To review this change, go to: " 116 <> volumeEdit [("page", "access")] 117 NoticeReleaseSlot -> 118 agent <> " set the release level of a folder in " <> volume <> " to " <> TL.fromStrict (releaseTitle notificationRelease msg) <> ". To review this change, go to: " 119 <> mailLink (viewSlot False) (HTML, (volumeId <$> notificationVolume, slot)) [] 120 NoticeReleaseAsset -> 121 agent <> " set the release level of a file in your volume (" <> volume <> ") to " <> TL.fromStrict (releaseTitle notificationRelease msg) <> ". To review this change, go to: " 122 <> mailLink (viewSlot False) (HTML, (volumeId <$> notificationVolume, slot)) [("asset", foldMap (BSC.pack . show) notificationAssetId)] 123 NoticeReleaseExcerpt -> 124 agent <> " set the release level of a highlight in your volume (" <> volume <> ") to " <> TL.fromStrict (releaseTitle notificationRelease msg) <> ". To review this change, go to: " 125 <> assetSegment 126 NoticeExcerptVolume -> 127 agent <> " created a highlight in your volume (" <> volume <> "). To review this highlight, go to: " 128 <> assetSegment 129 NoticeCommentVolume -> 130 agent <> " commented on your volume (" <> volume <> "). To review or reply, go to: " 131 <> slotVolume [] <> "#comment-" <> foldMap (TL.pack . show) notificationCommentId 132 NoticeCommentReply -> -- high risk information disclosure of volume name 133 agent <> " replied to your comment on the volume, " <> volume <> ". To review or reply, go to: " 134 <> slotVolume [] <> "#comment-" <> foldMap (TL.pack . show) notificationCommentId 135 NoticeTagVolume -> 136 agent <> " tagged the volume, " <> volume <> ", with \"" <> foldMap (TL.fromStrict . TE.decodeLatin1 . tagNameBS . tagName) notificationTag <> "\". To review tags, go to: " 137 <> slotVolume [("tag", foldMap (tagNameBS . tagName) notificationTag)] <> "#panel-tags" 138 NoticeSharedVolume -> 139 agent <> " shared the following volume, " <> volume <> ", on Databrary. To review, go to: " 140 <> mailLink viewVolume (HTML, maybe noId volumeId notificationVolume) [] 141 NoticeNewsletter -> 142 "A new Databrary newsletter has been posted. Te see it, go to: http://databrary.org/news.html" 143 where 144 target = partyRow (accountParty notificationTarget) 145 person p = (on (/=) partyId p target) `thenUse` (TL.fromStrict (partyName p)) 146 agent = fromMaybe "You" $ person notificationAgent 147 partyp = person =<< notificationParty 148 party = fromMaybe "you" partyp 149 party'sOr your = maybe your (<> "'s") partyp 150 party's = party'sOr "your" 151 party'S = party'sOr "Your" 152 personq p = ("party", maybe "" (BSC.pack . show . partyId) p) 153 partyq = personq notificationParty 154 partyEdit = partyEditLink mailLink target 155 granted = maybe "revoked" (const "granted") notificationPermission 156 volume = maybe "<VOLUME>" (TL.fromStrict . volumeName) notificationVolume 157 volumeEdit = mailLink viewVolumeEdit (maybe noId volumeId notificationVolume) 158 perm = fromMaybe PermissionNONE notificationPermission 159 slot = Id $ SlotId (fromMaybe noId notificationContainerId) (fromMaybe fullSegment notificationSegment) 160 assetSegment = mailLink (viewAssetSegment False) (HTML, volumeId <$> notificationVolume, slot, fromMaybe noId notificationAssetId) [] 161 slotVolume 162 | isJust notificationContainerId = mailLink (viewSlot False) (HTML, (volumeId <$> notificationVolume, slot)) 163 | otherwise = mailLink viewVolume (HTML, maybe noId volumeId notificationVolume) 164 165 mailNotifications :: Messages -> [Notification] -> TL.Text 166 mailNotifications msg ~l@(Notification{ notificationTarget = u }:_) = 167 TL.fromChunks ["Dear ", partyName target, ",\n"] 168 <> foldMap (\n -> '\n' `TL.cons` mailNotification msg n `TL.snoc` '\n') l 169 <> "\nYou can change your notification settings or unsubscribe here: " 170 <> partyEditLink mailLink target target [("page", "notifications")] `TL.snoc` '\n' 171 where 172 target = partyRow (accountParty u) 173 174 htmlNotification :: Messages -> Notification -> H.Html 175 htmlNotification msg Notification{..} = case notificationNotice of 176 NoticeAccountChange -> 177 agent >> " changed " >> party's >> " " 178 >> partyEdit (fromMaybe target notificationParty) [("page", "account")] "account information" >> "." 179 NoticeAuthorizeRequest -> 180 agent >> " requested " 181 >> partyEdit target [("page", "apply"), partyq] "authorization" >> " from " >> party >> "." 182 NoticeAuthorizeGranted -> 183 "Your " >> partyEdit target [("page", "apply"), partyq] "authorization" 184 >> " under " >> fromMaybe "yourself" (person =<< notificationParty) >> " has been " >> granted >> "." 185 NoticeAuthorizeExpiring -> 186 "Your " >> partyEdit target [("page", "apply"), partyq] "authorization" >> " through " >> party >> " will expire soon." 187 NoticeAuthorizeExpired -> 188 "Your " >> partyEdit target [("page", "apply"), partyq] "authorization" >> " through " >> party >> " is expired." 189 NoticeAuthorizeChildRequest -> 190 agent >> " requested " 191 >> partyEdit (fromMaybe target notificationParty) [("page", "grant"), personq $ Just notificationAgent] "authorization" >> " from " >> party >> "." 192 NoticeAuthorizeChildGranted -> 193 agent >> " " >> granted >> " " 194 >> partyEdit target [("page", "grant"), partyq] "authorization" >> " to " >> party >> "." 195 NoticeAuthorizeChildExpiring -> 196 party'S >> " " >> partyEdit target [("page", "grant"), partyq] "authorization" >> " will expire soon." 197 NoticeAuthorizeChildExpired -> 198 party'S >> " " >> partyEdit target [("page", "grant"), partyq] "authorization" >> " is expired." 199 NoticeVolumeAssist -> 200 agent >> " requested " >> volumeEdit [("page", "assist")] "assistance" >> " with " >> volume >> "." 201 NoticeVolumeCreated -> 202 agent >> " created " >> volume >> " on " >> party's >> " behalf." 203 NoticeVolumeSharing -> 204 agent >> " changed " >> volume >> " to " 205 >> H.text (volumeAccessPresetTitle (PermissionNONE < perm) msg) >> "." 206 NoticeVolumeAccessOther -> 207 agent >> " set " >> party's >> " " 208 >> volumeEdit [("page", "access"), partyq] "access" >> " to " >> H.text (volumeAccessTitle perm msg) >> " on " >> volume >> "." 209 NoticeVolumeAccess -> 210 agent >> " set " >> party's >> " " 211 >> volumeEdit [("page", "access")] "access" >> " to " >> H.text (volumeAccessTitle perm msg) >> " on " >> volume >> "." 212 NoticeReleaseSlot -> 213 agent >> " set a " >> link (viewSlot False) (HTML, (volumeId <$> notificationVolume, slot)) [] "folder" 214 >> " in " >> volume >> " to " >> H.text (releaseTitle notificationRelease msg) >> "." 215 NoticeReleaseAsset -> 216 agent >> " set a " >> link (viewSlot False) (HTML, (volumeId <$> notificationVolume, slot)) [("asset", foldMap (BSC.pack . show) notificationAssetId)] "file" 217 >> " in " >> volume >> " to " >> H.text (releaseTitle notificationRelease msg) >> "." 218 NoticeReleaseExcerpt -> 219 agent >> " set a " >> assetSegment "highlight" 220 >> " in " >> volume >> " to " >> H.text (releaseTitle notificationRelease msg) >> "." 221 NoticeExcerptVolume -> 222 agent >> " created a " >> assetSegment "highlight" 223 >> " in " >> volume >> "." 224 NoticeCommentVolume -> 225 agent >> " " >> (slotVolume [] ("#comment-" <> foldMap (H.toValue . unId) notificationCommentId)) "commented" 226 >> " on " >> volume >> "." 227 NoticeCommentReply -> 228 agent >> " " >> (slotVolume [] ("#comment-" <> foldMap (H.toValue . unId) notificationCommentId)) "replied" 229 >> " to your comment on " >> volume >> "." 230 NoticeTagVolume -> 231 agent >> " " >> (slotVolume [("tag", foldMap (tagNameBS . tagName) notificationTag)] "#panel-tags") "tagged" 232 >> " " >> volume >> " with " >> H.em (mapM_ (byteStringHtml . tagNameBS . tagName) notificationTag) >> "." 233 NoticeSharedVolume -> 234 agent >> " shared " >> volume >> "." 235 NoticeNewsletter -> 236 "A new " >> (H.a H.! HA.href "//databrary.org/news.html") "Databrary newsletter" >> " has been posted." 237 where 238 target = partyRow (accountParty notificationTarget) 239 person p = (on (/=) partyId p target) `thenUse` (htmlPartyViewLink p ([] :: Query)) 240 agent = fromMaybe "You" $ person notificationAgent 241 partyp = fmap ((any (on (/=) partyId notificationAgent) notificationParty) `thenUse`) $ person =<< notificationParty 242 party = maybe "you" (fromMaybe "themselves") partyp 243 party'sOr your their = maybe your (maybe their (>> "'s")) partyp 244 party's = party'sOr "your" "their own" 245 party'S = party'sOr "Your" "Their own" 246 personq p = ("party", maybe "" (BSC.pack . show . partyId) p) 247 partyq = personq notificationParty 248 link u a q h = H.a H.! actionLink u a (map (second Just) q :: Query) $ h 249 partyEdit = partyEditLink link target 250 granted = maybe "revoked" (const "granted") notificationPermission 251 volume = maybe "<VOLUME>" (\v -> htmlVolumeViewLink v ([] :: Query)) notificationVolume 252 volumeEdit = link viewVolumeEdit (maybe noId volumeId notificationVolume) 253 perm = fromMaybe PermissionNONE notificationPermission 254 slot = Id $ SlotId (fromMaybe noId notificationContainerId) (fromMaybe fullSegment notificationSegment) 255 assetSegment = link (viewAssetSegment False)(HTML, volumeId <$> notificationVolume, slot, fromMaybe noId notificationAssetId) [] 256 slotVolume q t = H.a H.! HA.href (if isJust notificationContainerId 257 then actionValue (viewSlot False) (HTML, (volumeId <$> notificationVolume, slot)) (q :: [(BSC.ByteString, BSC.ByteString)]) <> t 258 else actionValue viewVolume (HTML, maybe noId volumeId notificationVolume) q <> t) 259 260 noId :: Num (IdType a) => Id a 261 noId = (Id $ -1)