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)