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)