1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, RecordWildCards, DataKinds #-} 2 module Databrary.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 Databrary.Has (view) 16 import qualified Databrary.JSON as JSON 17 import Databrary.Service.DB 18 import Databrary.Model.SQL 19 import Databrary.Model.Permission 20 import Databrary.Model.Audit 21 import Databrary.Model.Volume.Types 22 import Databrary.Model.Container.Types 23 import Databrary.Model.Slot.Types 24 import Databrary.Model.Asset.Types 25 import Databrary.Model.AssetSlot.Types 26 import Databrary.Model.AssetSegment 27 import Databrary.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) = do 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 = do 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