1 {-# LANGUAGE TemplateHaskell, QuasiQuotes, RecordWildCards, OverloadedStrings, ScopedTypeVariables, DataKinds #-} 2 module Databrary.Model.AssetSegment 3 ( module Databrary.Model.AssetSegment.Types 4 , lookupAssetSegment 5 , lookupSlotAssetSegment 6 , lookupAssetSlotSegment 7 , lookupOrigSlotAssetSegment 8 , lookupSlotSegmentThumb 9 , auditAssetSegmentDownload 10 , assetSegmentJSON 11 , assetSegmentInterp 12 ) where 13 14 import Control.Applicative (pure, empty) 15 import Data.Monoid ((<>)) 16 import Database.PostgreSQL.Typed (pgSQL) 17 import Database.PostgreSQL.Typed.Query 18 import Database.PostgreSQL.Typed.Types 19 import qualified Data.ByteString 20 import Data.ByteString (ByteString) 21 import qualified Data.String 22 23 import Databrary.Ops 24 import Databrary.Has (peek, view) 25 import qualified Databrary.JSON as JSON 26 import Databrary.Service.DB 27 import Databrary.Model.SQL 28 import Databrary.Model.Audit 29 import Databrary.Model.Id 30 import Databrary.Model.Party.Types 31 import Databrary.Model.Identity 32 import Databrary.Model.Permission 33 import Databrary.Model.Segment 34 import Databrary.Model.Volume.Types 35 import Databrary.Model.Container.Types 36 import Databrary.Model.Slot.Types 37 import Databrary.Model.Format.Types 38 import Databrary.Model.Asset.Types 39 import Databrary.Model.AssetSlot 40 import Databrary.Model.AssetSegment.Types 41 import Databrary.Model.AssetSegment.SQL 42 43 lookupAssetSegment :: (MonadHasIdentity c m, MonadDB c m) => Segment -> Id Asset -> m (Maybe AssetSegment) 44 lookupAssetSegment seg ai = do 45 ident :: Identity <- peek 46 dbQuery1 $(selectQuery (selectAssetSegment 'ident 'seg) "$WHERE slot_asset.asset = ${ai} AND slot_asset.segment && ${seg}") 47 48 lookupSlotAssetSegment :: (MonadHasIdentity c m, MonadDB c m) => Id Slot -> Id Asset -> m (Maybe AssetSegment) 49 lookupSlotAssetSegment (Id (SlotId ci seg)) ai = do 50 ident :: Identity <- peek 51 dbQuery1 $(selectQuery (selectAssetSegment 'ident 'seg) 52 "$WHERE slot_asset.container = ${ci} AND slot_asset.asset = ${ai} AND slot_asset.segment && ${seg}") 53 54 lookupOrigSlotAssetSegment :: (MonadHasIdentity c m, MonadDB c m) => Id Slot -> Id Asset -> m (Maybe AssetSegment) 55 lookupOrigSlotAssetSegment (Id (SlotId ci seg)) ai = do 56 ident :: Identity <- peek 57 dbQuery1 $(selectQuery (selectAssetSegment 'ident 'seg) 58 "$inner join asset_revision ar on ar.asset = asset.id WHERE slot_asset.container = ${ci} AND slot_asset.asset = ${ai} AND slot_asset.segment && ${seg}") 59 60 61 lookupAssetSlotSegment :: MonadDB c m => AssetSlot -> Segment -> m (Maybe AssetSegment) 62 lookupAssetSlotSegment a s = 63 (segmentEmpty seg) `unlessReturn` (as <$> 64 dbQuery1 $(selectQuery excerptRow "$WHERE asset = ${view a :: Id Asset} AND segment @> ${seg}")) 65 where 66 as = makeExcerpt a s 67 seg = assetSegment $ as Nothing 68 69 lookupSlotSegmentThumb :: MonadDB c m => Slot -> m (Maybe AssetSegment) 70 lookupSlotSegmentThumb (Slot c s) = do 71 dbQuery1 $ assetSegmentInterp 0.25 . ($ c) <$> $(selectQuery (selectContainerAssetSegment 's) "$\ 72 \JOIN format ON asset.format = format.id \ 73 \WHERE slot_asset.container = ${containerId $ containerRow c} AND slot_asset.segment && ${s} \ 74 \AND COALESCE(asset.release, ${containerRelease c}) >= ${readRelease (view c)}::release \ 75 \AND (asset.duration IS NOT NULL AND format.mimetype LIKE 'video/%' OR format.mimetype LIKE 'image/%') \ 76 \LIMIT 1") 77 78 mapQuery :: ByteString -> ([PGValue] -> a) -> PGSimpleQuery a 79 mapQuery qry mkResult = 80 fmap mkResult (rawPGSimpleQuery qry) 81 82 auditAssetSegmentDownload :: MonadAudit c m => Bool -> AssetSegment -> m () 83 auditAssetSegmentDownload success AssetSegment{ segmentAsset = AssetSlot{ slotAsset = a, assetSlot = as }, assetSegment = seg } = do 84 ai <- getAuditIdentity 85 let _tenv_a9v9T = unknownPGTypeEnv 86 maybe 87 (dbExecute1' 88 {- [pgSQL|INSERT INTO audit.asset (audit_action, audit_user, audit_ip, id, volume, format, release) VALUES 89 (${act}, ${auditWho ai}, ${auditIp ai}, ${assetId $ assetRow a}, ${volumeId $ volumeRow $ assetVolume a}, ${formatId $ assetFormat $ assetRow a}, ${assetRelease $ assetRow a})|] -} 90 (mapQuery 91 ((\ _p_a9v9U _p_a9v9V _p_a9v9W _p_a9v9X _p_a9v9Y _p_a9v9Z _p_a9va0 -> 92 (Data.ByteString.concat 93 [Data.String.fromString 94 "INSERT INTO audit.asset (audit_action, audit_user, audit_ip, id, volume, format, release) VALUES\n\ 95 \ (", 96 Database.PostgreSQL.Typed.Types.pgEscapeParameter 97 _tenv_a9v9T 98 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 99 Database.PostgreSQL.Typed.Types.PGTypeName "audit.action") 100 _p_a9v9U, 101 Data.String.fromString ", ", 102 Database.PostgreSQL.Typed.Types.pgEscapeParameter 103 _tenv_a9v9T 104 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 105 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 106 _p_a9v9V, 107 Data.String.fromString ", ", 108 Database.PostgreSQL.Typed.Types.pgEscapeParameter 109 _tenv_a9v9T 110 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 111 Database.PostgreSQL.Typed.Types.PGTypeName "inet") 112 _p_a9v9W, 113 Data.String.fromString ", ", 114 Database.PostgreSQL.Typed.Types.pgEscapeParameter 115 _tenv_a9v9T 116 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 117 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 118 _p_a9v9X, 119 Data.String.fromString ", ", 120 Database.PostgreSQL.Typed.Types.pgEscapeParameter 121 _tenv_a9v9T 122 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 123 Database.PostgreSQL.Typed.Types.PGTypeName "integer") 124 _p_a9v9Y, 125 Data.String.fromString ", ", 126 Database.PostgreSQL.Typed.Types.pgEscapeParameter 127 _tenv_a9v9T 128 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 129 Database.PostgreSQL.Typed.Types.PGTypeName "smallint") 130 _p_a9v9Z, 131 Data.String.fromString ", ", 132 Database.PostgreSQL.Typed.Types.pgEscapeParameter 133 _tenv_a9v9T 134 (Database.PostgreSQL.Typed.Types.PGTypeProxy :: 135 Database.PostgreSQL.Typed.Types.PGTypeName "release") 136 _p_a9va0, 137 Data.String.fromString ")"])) 138 act 139 (auditWho ai) 140 (auditIp ai) 141 (assetId $ assetRow a) 142 (volumeId $ volumeRow $ assetVolume a) 143 (formatId $ assetFormat $ assetRow a) 144 (assetRelease $ assetRow a)) 145 (\[] -> ()))) 146 (\s -> dbExecute1' [pgSQL|$INSERT INTO audit.slot_asset (audit_action, audit_user, audit_ip, container, segment, asset) VALUES 147 (${act}, ${auditWho ai}, ${auditIp ai}, ${containerId $ containerRow $ slotContainer s}, ${seg}, ${assetId $ assetRow a})|]) 148 as 149 where act | success = AuditActionOpen 150 | otherwise = AuditActionAttempt 151 152 assetSegmentJSON :: JSON.ToObject o => AssetSegment -> o 153 assetSegmentJSON as@AssetSegment{..} = 154 "segment" JSON..= assetSegment 155 <> "format" `JSON.kvObjectOrEmpty` (if view segmentAsset == fmt then empty else pure (formatId fmt)) 156 -- "release" `JSON.kvObjectOrEmpty` (view as :: Maybe Release) 157 <> "permission" JSON..= dataPermission4 getAssetSegmentRelease2 getAssetSegmentVolumePermission2 as 158 <> "excerpt" `JSON.kvObjectOrEmpty` (excerptRelease <$> assetExcerpt) 159 where fmt = view as 160 161 assetSegmentInterp :: Float -> AssetSegment -> AssetSegment 162 assetSegmentInterp f as = as{ assetSegment = segmentInterp f $ assetSegment as }