1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, RecordWildCards, DataKinds #-} 2 module Model.Excerpt 3 ( lookupAssetExcerpts 4 , lookupSlotExcerpts 5 , lookupVolumeExcerpts 6 , lookupSlotThumb 7 , lookupVolumeThumb 8 , changeExcerpt 9 , removeExcerpt 10 , excerptJSON 11 ) where 12 13 import Control.Monad (guard) 14 15 import Has (view) 16 import qualified JSON 17 import Service.DB 18 import Model.SQL 19 import Model.Permission 20 import Model.Audit 21 import Model.Volume.Types 22 import Model.Container.Types 23 import Model.Slot.Types 24 import Model.Asset.Types 25 import Model.AssetSlot.Types 26 import Model.AssetSegment 27 import Model.Excerpt.SQL 28 29 lookupAssetExcerpts :: MonadDB c m => AssetSlot -> m [Excerpt] 30 lookupAssetExcerpts a = 31 dbQuery $ ($ a) <$> $(selectQuery selectAssetSlotExcerpt "$WHERE excerpt.asset = ${assetId $ assetRow $ slotAsset a}") 32 33 lookupSlotExcerpts :: MonadDB c m => Slot -> m [Excerpt] 34 lookupSlotExcerpts (Slot c s) = 35 dbQuery $ ($ c) <$> $(selectQuery selectContainerExcerpt "$WHERE slot_asset.container = ${containerId $ containerRow c} AND excerpt.segment && ${s}") 36 37 lookupVolumeExcerpts :: MonadDB c m => Volume -> m [Excerpt] 38 lookupVolumeExcerpts v = 39 dbQuery $ ($ v) <$> $(selectQuery selectVolumeExcerpt "$WHERE asset.volume = ${volumeId $ volumeRow v}") 40 41 lookupSlotThumb :: MonadDB c m => Slot -> m (Maybe AssetSegment) 42 lookupSlotThumb (Slot c s) = 43 dbQuery1 $ assetSegmentInterp 0 . excerptAsset . ($ c) <$> $(selectQuery selectContainerExcerpt "$\ 44 \JOIN format ON asset.format = format.id \ 45 \WHERE slot_asset.container = ${containerId $ containerRow c} AND excerpt.segment && ${s} \ 46 \AND COALESCE(GREATEST(excerpt.release, asset.release), ${containerRelease c}) >= ${readRelease (view c)}::release \ 47 \AND (asset.duration IS NOT NULL AND format.mimetype LIKE 'video/%' OR format.mimetype LIKE 'image/%') \ 48 \AND asset.sha1 IS NOT NULL \ 49 \LIMIT 1") 50 51 lookupVolumeThumb :: MonadDB c m => Volume -> m (Maybe AssetSegment) 52 lookupVolumeThumb v = 53 dbQuery1 $ assetSegmentInterp 0 . excerptAsset . ($ v) <$> $(selectQuery selectVolumeExcerpt "$\ 54 \JOIN format ON asset.format = format.id \ 55 \WHERE asset.volume = ${volumeId $ volumeRow v} \ 56 \AND COALESCE(GREATEST(excerpt.release, asset.release), slot_release.release) >= ${readRelease (view v)}::release \ 57 \AND (asset.duration IS NOT NULL AND format.mimetype LIKE 'video/%' OR format.mimetype LIKE 'image/%') \ 58 \AND asset.sha1 IS NOT NULL \ 59 \ORDER BY container.top DESC LIMIT 1") 60 61 changeExcerpt :: MonadAudit c m => Excerpt -> m Bool 62 changeExcerpt e = do 63 ident <- getAuditIdentity 64 either (const False) ((0 <) . fst) <$> tryUpdateOrInsert (guard . isExclusionViolation) 65 $(updateExcerpt 'ident 'e) 66 $(insertExcerpt 'ident 'e) 67 68 removeExcerpt :: MonadAudit c m => AssetSegment -> m Bool 69 removeExcerpt e = do 70 ident <- getAuditIdentity 71 dbExecute1 $(deleteExcerpt 'ident 'e) 72 73 excerptJSON :: JSON.ToObject o => Excerpt -> o 74 excerptJSON = assetSegmentJSON . excerptAsset