1 {-# LANGUAGE OverloadedStrings #-}
    2 module Databrary.Controller.Excerpt
    3   ( postExcerpt
    4   , deleteExcerpt
    5   ) where
    6 
    7 import Control.Monad (unless, when)
    8 import Data.Maybe (isNothing)
    9 import qualified Data.Text as T
   10 import Network.HTTP.Types (conflict409)
   11 
   12 import Databrary.Has
   13 import qualified Databrary.JSON as JSON
   14 import Databrary.Model.Id
   15 import Databrary.Model.Permission
   16 import Databrary.Model.Release (EffectiveRelease(..))
   17 import Databrary.Model.Slot
   18 import Databrary.Model.Asset
   19 import Databrary.Model.AssetSegment
   20 import Databrary.Model.Excerpt
   21 import Databrary.Model.Notification.Types
   22 import Databrary.HTTP.Form.Deform
   23 import Databrary.HTTP.Path.Parser
   24 import Databrary.Action
   25 import Databrary.Controller.Permission
   26 import Databrary.Controller.Paths
   27 import Databrary.Controller.Form
   28 import Databrary.Controller.Notification
   29 import Databrary.Controller.AssetSegment
   30 
   31 pathExcerpt :: PathParser (Id Slot, Id Asset)
   32 pathExcerpt = pathJSON >/> pathSlotId </> pathId </< "excerpt"
   33 
   34 postExcerpt :: ActionRoute (Id Slot, Id Asset)
   35 postExcerpt = action POST pathExcerpt $ \(si, ai) -> withAuth $ do
   36   as <- getAssetSegment False PermissionEDIT False Nothing si ai
   37   e <- runForm Nothing $ do
   38     csrfForm
   39     Excerpt as <$> ("release" .:> deformNonEmpty deform)
   40   r <- changeExcerpt e
   41   unless r $ result $
   42     response conflict409 [] ("The requested excerpt overlaps an existing excerpt." :: T.Text)
   43   let notice t = createVolumeNotification (view e) $ \n -> (n t)
   44         { notificationContainerId = Just $ view e
   45         , notificationSegment = Just $ view e
   46         , notificationAssetId = Just $ view e
   47         , notificationRelease = excerptRelease e
   48         }
   49   when (isNothing $ assetExcerpt as) $
   50     notice NoticeExcerptVolume
   51   when (any ((effRelPublic . getAssetSegmentRelease2) as <) $ excerptRelease e) $
   52     notice NoticeReleaseExcerpt
   53   return $ okResponse [] $ JSON.pairs $ assetSegmentJSON (if r then as{ assetExcerpt = Just e } else as)
   54 
   55 deleteExcerpt :: ActionRoute (Id Slot, Id Asset)
   56 deleteExcerpt = action DELETE pathExcerpt $ \(si, ai) -> withAuth $ do
   57   guardVerfHeader
   58   as <- getAssetSegment False PermissionEDIT False Nothing si ai
   59   r <- removeExcerpt as
   60   return $ okResponse [] $ JSON.pairs $ assetSegmentJSON (if r then as{ assetExcerpt = Nothing } else as)