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