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