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)