1 {-# LANGUAGE OverloadedStrings, TemplateHaskell, QuasiQuotes, RecordWildCards, DataKinds #-}
    2 module Databrary.Model.AssetSlot
    3   ( module Databrary.Model.AssetSlot.Types
    4   , lookupAssetSlot
    5   , lookupOrigAssetSlot 
    6   , lookupAssetAssetSlot
    7   , lookupSlotAssets
    8   , lookupOrigSlotAssets
    9   , lookupContainerAssets
   10   , lookupOrigContainerAssets
   11   , lookupVolumeAssetSlots
   12   -- , lookupOrigVolumeAssetSlots
   13   , lookupOrigVolumeAssetSlots'
   14   , lookupVolumeAssetSlotIds
   15   -- , lookupOrigVolumeAssetSlotIds
   16   , changeAssetSlot
   17   , changeAssetSlotDuration
   18   , fixAssetSlotDuration
   19   , findAssetContainerEnd
   20   , assetSlotName
   21   , assetSlotJSON
   22   ) where
   23 
   24 import Control.Monad (when, guard)
   25 import qualified Data.ByteString
   26 import Data.Maybe (fromMaybe, isNothing)
   27 import Data.Monoid ((<>))
   28 import Data.Maybe (fromJust, catMaybes)
   29 import Data.String
   30 import qualified Data.Text as T
   31 -- import Database.PostgreSQL.Typed (pgSQL)
   32 import Database.PostgreSQL.Typed.Types
   33 
   34 import Databrary.Ops
   35 import Databrary.Has (peek, view)
   36 import qualified Databrary.JSON as JSON
   37 import Databrary.Service.DB
   38 import Databrary.Model.Offset
   39 import Databrary.Model.Permission
   40 import Databrary.Model.Segment
   41 import Databrary.Model.Id
   42 import Databrary.Model.Party.Types
   43 import Databrary.Model.Identity.Types
   44 import Databrary.Model.Volume.Types
   45 import Databrary.Model.Container.Types
   46 import Databrary.Model.Slot.Types
   47 import Databrary.Model.Asset
   48 import Databrary.Model.Audit
   49 import Databrary.Model.SQL
   50 import Databrary.Model.AssetSlot.Types
   51 import Databrary.Model.AssetSlot.SQL
   52 import Databrary.Model.Format.Types
   53 import Databrary.Model.Format (getFormat')
   54 import Databrary.Model.PermissionUtil (maskRestrictedString)
   55 
   56 lookupAssetSlot :: (MonadHasIdentity c m, MonadDB c m) => Id Asset -> m (Maybe AssetSlot)
   57 lookupAssetSlot ai = do
   58   ident <- peek
   59   dbQuery1 $(selectQuery (selectAssetSlot 'ident) "$WHERE asset.id = ${ai}")
   60 
   61 lookupOrigAssetSlot :: (MonadHasIdentity c m, MonadDB c m) => Id Asset -> m (Maybe AssetSlot)
   62 lookupOrigAssetSlot ai = do
   63   initAsset <- lookupAssetSlot ai
   64   let format = formatName . assetFormat . assetRow . slotAsset $ fromJust initAsset
   65   case format of 
   66     ".pdf" -> lookupAssetSlot ai --TODO format name should support all doc types
   67     _ -> do 
   68       ident <- peek
   69       dbQuery1 $(selectQuery (selectAssetSlot 'ident) "$left join transcode tc on tc.orig = asset.id WHERE tc.asset = ${ai}")
   70 
   71 lookupAssetAssetSlot :: (MonadDB c m) => Asset -> m AssetSlot
   72 lookupAssetAssetSlot a = fromMaybe assetNoSlot
   73   <$> dbQuery1 $(selectQuery selectAssetSlotAsset "$WHERE slot_asset.asset = ${assetId $ assetRow a} AND container.volume = ${volumeId $ volumeRow $ assetVolume a}")
   74   <*> return a
   75 
   76 lookupSlotAssets :: (MonadDB c m) => Slot -> m [AssetSlot]
   77 lookupSlotAssets (Slot c s) =
   78   dbQuery $ ($ c) <$> $(selectQuery selectContainerSlotAsset "$WHERE slot_asset.container = ${containerId $ containerRow c} AND slot_asset.segment && ${s} AND asset.volume = ${volumeId $ volumeRow $ containerVolume c}")
   79 
   80 lookupOrigSlotAssets :: (MonadDB c m) => Slot -> m [AssetSlot]
   81 lookupOrigSlotAssets slot@(Slot c _) = do
   82   let _tenv_ablno = unknownPGTypeEnv
   83   xs <-  dbQuery {- [pgSQL|
   84     SELECT asset.id,asset.format,output_asset.release,asset.duration,asset.name,asset.sha1,asset.size 
   85     FROM slot_asset 
   86     INNER JOIN transcode ON slot_asset.asset = transcode.asset
   87     INNER JOIN asset ON transcode.orig = asset.id
   88     INNER JOIN asset output_asset ON transcode.asset = output_asset.id
   89     WHERE slot_asset.container = ${containerId $ containerRow c}
   90     |] -}
   91    (mapQuery2
   92     ((\ _p_ablnp ->
   93                     (Data.ByteString.concat
   94                        [fromString
   95                           "\n\
   96                           \    SELECT asset.id,asset.format,output_asset.release,asset.duration,asset.name,asset.sha1,asset.size \n\
   97                           \    FROM slot_asset \n\
   98                           \    INNER JOIN transcode ON slot_asset.asset = transcode.asset\n\
   99                           \    INNER JOIN asset ON transcode.orig = asset.id\n\
  100                           \    INNER JOIN asset output_asset ON transcode.asset = output_asset.id\n\
  101                           \    WHERE slot_asset.container = ",
  102                         pgEscapeParameter
  103                           _tenv_ablno (PGTypeProxy :: PGTypeName "integer") _p_ablnp,
  104                         fromString
  105                           "\n\
  106                           \    "]))
  107      (containerId $ containerRow c))
  108             (\
  109                [_cid_ablnq,
  110                 _cformat_ablnr,
  111                 _crelease_ablns,
  112                 _cduration_ablnt,
  113                 _cname_ablnu,
  114                 _csha1_ablnv,
  115                 _csize_ablnw]
  116                -> (pgDecodeColumnNotNull
  117                      _tenv_ablno (PGTypeProxy :: PGTypeName "integer") _cid_ablnq, 
  118                    pgDecodeColumnNotNull
  119                      _tenv_ablno (PGTypeProxy :: PGTypeName "smallint") _cformat_ablnr, 
  120                    pgDecodeColumn
  121                      _tenv_ablno (PGTypeProxy :: PGTypeName "release") _crelease_ablns, 
  122                    pgDecodeColumn
  123                      _tenv_ablno
  124                      (PGTypeProxy :: PGTypeName "interval")
  125                      _cduration_ablnt, 
  126                    pgDecodeColumn
  127                      _tenv_ablno (PGTypeProxy :: PGTypeName "text") _cname_ablnu, 
  128                    pgDecodeColumn
  129                      _tenv_ablno (PGTypeProxy :: PGTypeName "bytea") _csha1_ablnv, 
  130                    pgDecodeColumn
  131                      _tenv_ablno (PGTypeProxy :: PGTypeName "bigint") _csize_ablnw)))
  132   return $ flip fmap xs $ \(assetId,formatId,release,duration,name,sha1,size) ->
  133     -- this format value is only used to differentiate between audio/video or not
  134     -- so it is okay that it is hardcoded to mp4, under the assumption that everything with an original
  135     -- was an audio/video file that went through transcoding
  136     let format = getFormat' formatId
  137           -- Format (Id (-800)) "video/mp4" [] "" {-fromJust . getFormatByExtension $ encodeUtf8 $ fromJust name-}
  138         assetRow = AssetRow (Id assetId) format release duration name sha1 size
  139     in AssetSlot (Asset assetRow (containerVolume c)) (Just slot)
  140 
  141 lookupContainerAssets :: (MonadDB c m) => Container -> m [AssetSlot]
  142 lookupContainerAssets = lookupSlotAssets . containerSlot
  143 
  144 lookupOrigContainerAssets :: (MonadDB c m) => Container -> m [AssetSlot]
  145 lookupOrigContainerAssets = lookupOrigSlotAssets . containerSlot
  146 
  147 lookupVolumeAssetSlots :: (MonadDB c m) => Volume -> Bool -> m [AssetSlot]
  148 lookupVolumeAssetSlots v top =
  149   dbQuery $ ($ v) <$> $(selectQuery selectVolumeSlotAsset "$WHERE asset.volume = ${volumeId $ volumeRow v} AND (container.top OR ${not top}) ORDER BY container.id")
  150 
  151 {- lookupOrigVolumeAssetSlots :: (MonadDB c m, MonadHasIdentity c m) => Volume -> Bool -> m [AssetSlot]
  152 lookupOrigVolumeAssetSlots v top = do
  153   fromVol <- lookupVolumeAssetSlots v top
  154   lookupOrigVolumeAssetSlots' fromVol -}
  155 
  156 lookupOrigVolumeAssetSlots' :: (MonadDB c m, MonadHasIdentity c m) => [AssetSlot] -> m [AssetSlot]
  157 lookupOrigVolumeAssetSlots' slotList = do
  158   catMaybes <$> mapM originFinder slotList
  159   where 
  160     originFinder (AssetSlot { slotAsset = Asset {assetRow = AssetRow { assetId = aid }}}) = lookupOrigAssetSlot aid
  161 
  162 lookupVolumeAssetSlotIds :: (MonadDB c m) => Volume -> m [(Asset, SlotId)]
  163 lookupVolumeAssetSlotIds v =
  164   dbQuery $ ($ v) <$> $(selectQuery selectVolumeSlotIdAsset "$WHERE asset.volume = ${volumeId $ volumeRow v} ORDER BY container")
  165 
  166 {- lookupOrigVolumeAssetSlotIds :: (MonadDB c m) => Volume -> m [(Asset, SlotId)]
  167 lookupOrigVolumeAssetSlotIds v =
  168   dbQuery $ ($ v) <$> $(selectQuery selectVolumeSlotIdAsset "$left join asset_revision ar on ar.orig = asset.id WHERE asset.volume = ${volumeId $ volumeRow v} ORDER BY container") -}
  169 
  170 changeAssetSlot :: (MonadAudit c m) => AssetSlot -> m Bool
  171 changeAssetSlot as = do
  172   ident <- getAuditIdentity
  173   let _tenv_a8II3 = unknownPGTypeEnv
  174   if isNothing (assetSlot as)
  175     then dbExecute1 -- (deleteSlotAsset 'ident 'as)
  176       (mapQuery2
  177           ((\ _p_a8II4 _p_a8II5 _p_a8II6 ->
  178                           (Data.ByteString.concat
  179                              [Data.String.fromString
  180                                 "WITH audit_row AS (DELETE FROM slot_asset WHERE asset=",
  181                               Database.PostgreSQL.Typed.Types.pgEscapeParameter
  182                                 _tenv_a8II3
  183                                 (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  184                                    Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  185                                 _p_a8II4,
  186                               Data.String.fromString
  187                                 " RETURNING *) INSERT INTO audit.slot_asset SELECT CURRENT_TIMESTAMP, ",
  188                               Database.PostgreSQL.Typed.Types.pgEscapeParameter
  189                                 _tenv_a8II3
  190                                 (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  191                                    Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  192                                 _p_a8II5,
  193                               Data.String.fromString ", ",
  194                               Database.PostgreSQL.Typed.Types.pgEscapeParameter
  195                                 _tenv_a8II3
  196                                 (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  197                                    Database.PostgreSQL.Typed.Types.PGTypeName "inet")
  198                                 _p_a8II6,
  199                               Data.String.fromString
  200                                 ", 'remove'::audit.action, * FROM audit_row"]))
  201               (assetId $ assetRow $ slotAsset as)
  202               (auditWho ident)
  203               (auditIp ident))
  204           (\ [] -> ()))
  205     else do
  206       let _tenv_a8IMD = unknownPGTypeEnv
  207           _tenv_a8IPn = unknownPGTypeEnv
  208       (r, _) <- updateOrInsert
  209         -- (updateSlotAsset 'ident 'as)
  210         (mapQuery2
  211            ((\ _p_a8IME _p_a8IMF _p_a8IMG _p_a8IMH _p_a8IMI ->
  212                            (Data.ByteString.concat
  213                               [Data.String.fromString
  214                                  "WITH audit_row AS (UPDATE slot_asset SET container=",
  215                                Database.PostgreSQL.Typed.Types.pgEscapeParameter
  216                                  _tenv_a8IMD
  217                                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  218                                     Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  219                                  _p_a8IME,
  220                                Data.String.fromString ",segment=",
  221                                Database.PostgreSQL.Typed.Types.pgEscapeParameter
  222                                  _tenv_a8IMD
  223                                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  224                                     Database.PostgreSQL.Typed.Types.PGTypeName "segment")
  225                                  _p_a8IMF,
  226                                Data.String.fromString " WHERE asset=",
  227                                Database.PostgreSQL.Typed.Types.pgEscapeParameter
  228                                  _tenv_a8IMD
  229                                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  230                                     Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  231                                  _p_a8IMG,
  232                                Data.String.fromString
  233                                  " RETURNING *) INSERT INTO audit.slot_asset SELECT CURRENT_TIMESTAMP, ",
  234                                Database.PostgreSQL.Typed.Types.pgEscapeParameter
  235                                  _tenv_a8IMD
  236                                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  237                                     Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  238                                  _p_a8IMH,
  239                                Data.String.fromString ", ",
  240                                Database.PostgreSQL.Typed.Types.pgEscapeParameter
  241                                  _tenv_a8IMD
  242                                  (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  243                                     Database.PostgreSQL.Typed.Types.PGTypeName "inet")
  244                                  _p_a8IMI,
  245                                Data.String.fromString
  246                                  ", 'change'::audit.action, * FROM audit_row"]))
  247              (containerId . containerRow . slotContainer <$> assetSlot as)
  248              (slotSegment <$> assetSlot as)
  249              (assetId $ assetRow $ slotAsset as)
  250              (auditWho ident)
  251              (auditIp ident))
  252             (\[] -> ()))
  253         -- (insertSlotAsset 'ident 'as)
  254         (mapQuery2
  255           ((\ _p_a8IPo _p_a8IPp _p_a8IPq _p_a8IPr _p_a8IPs ->
  256                           (Data.ByteString.concat
  257                              [Data.String.fromString
  258                                 "WITH audit_row AS (INSERT INTO slot_asset (asset,container,segment) VALUES (",
  259                               Database.PostgreSQL.Typed.Types.pgEscapeParameter
  260                                 _tenv_a8IPn
  261                                 (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  262                                    Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  263                                 _p_a8IPo,
  264                               Data.String.fromString ",",
  265                               Database.PostgreSQL.Typed.Types.pgEscapeParameter
  266                                 _tenv_a8IPn
  267                                 (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  268                                    Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  269                                 _p_a8IPp,
  270                               Data.String.fromString ",",
  271                               Database.PostgreSQL.Typed.Types.pgEscapeParameter
  272                                 _tenv_a8IPn
  273                                 (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  274                                    Database.PostgreSQL.Typed.Types.PGTypeName "segment")
  275                                 _p_a8IPq,
  276                               Data.String.fromString
  277                                 ") RETURNING *) INSERT INTO audit.slot_asset SELECT CURRENT_TIMESTAMP, ",
  278                               Database.PostgreSQL.Typed.Types.pgEscapeParameter
  279                                 _tenv_a8IPn
  280                                 (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  281                                    Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  282                                 _p_a8IPr,
  283                               Data.String.fromString ", ",
  284                               Database.PostgreSQL.Typed.Types.pgEscapeParameter
  285                                 _tenv_a8IPn
  286                                 (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  287                                    Database.PostgreSQL.Typed.Types.PGTypeName "inet")
  288                                 _p_a8IPs,
  289                               Data.String.fromString ", 'add'::audit.action, * FROM audit_row"]))
  290                 (assetId $ assetRow $ slotAsset as)
  291                 (containerId . containerRow . slotContainer <$> assetSlot as)
  292                 (slotSegment <$> assetSlot as)
  293                 (auditWho ident)
  294                 (auditIp ident))
  295             (\[] -> ()))
  296       when (r /= 1) $ fail $ "changeAssetSlot: " ++ show r ++ " rows"
  297       return True
  298 
  299 changeAssetSlotDuration :: MonadDB c m => Asset -> m Bool
  300 changeAssetSlotDuration a
  301   | Just dur <- assetDuration $ assetRow a = do
  302      let _tenv_ablLj = unknownPGTypeEnv
  303      dbExecute1 -- [pgSQL|UPDATE slot_asset SET segment = segment(lower(segment), lower(segment) + ${dur}) WHERE asset = ${assetId $ assetRow a}|]
  304       (mapQuery2
  305         ((\ _p_ablLk _p_ablLl ->
  306                         (Data.ByteString.concat
  307                            [fromString
  308                               "UPDATE slot_asset SET segment = segment(lower(segment), lower(segment) + ",
  309                             pgEscapeParameter
  310                               _tenv_ablLj (PGTypeProxy :: PGTypeName "interval") _p_ablLk,
  311                             fromString ") WHERE asset = ",
  312                             pgEscapeParameter
  313                               _tenv_ablLj (PGTypeProxy :: PGTypeName "integer") _p_ablLl]))
  314           dur (assetId $ assetRow a))
  315         (\[] -> ()))
  316   | otherwise = return False
  317 
  318 fixAssetSlotDuration :: AssetSlot -> AssetSlot
  319 fixAssetSlotDuration as
  320   | Just dur <- assetDuration $ assetRow $ slotAsset as = as{ assetSlot = (\s -> s{ slotSegment = segmentSetDuration dur (slotSegment s) }) <$> assetSlot as }
  321   | otherwise = as
  322 
  323 findAssetContainerEnd :: MonadDB c m => Container -> m Offset
  324 findAssetContainerEnd c = do
  325   let _tenv_ablQT = unknownPGTypeEnv
  326   fromMaybe 0 <$>
  327     dbQuery1' -- [pgSQL|SELECT max(upper(segment))+'1s' FROM slot_asset WHERE container = ${containerId $ containerRow c}|]
  328      (mapQuery2
  329       ((\ _p_ablQU ->
  330                       (Data.ByteString.concat
  331                          [fromString
  332                             "SELECT max(upper(segment))+'1s' FROM slot_asset WHERE container = ",
  333                           pgEscapeParameter
  334                             _tenv_ablQT (PGTypeProxy :: PGTypeName "integer") _p_ablQU]))
  335         (containerId $ containerRow c))
  336               (\[_ccolumn_ablQV]
  337                  -> (pgDecodeColumn
  338                        _tenv_ablQT
  339                        (PGTypeProxy :: PGTypeName "interval")
  340                        _ccolumn_ablQV)))
  341 
  342 assetSlotName :: AssetSlot -> Maybe T.Text
  343 assetSlotName a =
  344   guard
  345     (any (containerTop . containerRow . slotContainer) (assetSlot a)
  346      || canReadData2 getAssetSlotRelease2 getAssetSlotVolumePermission2 a)
  347   >> assetName (assetRow $ slotAsset a)
  348 
  349 assetSlotJSON :: JSON.ToObject o => Bool -> AssetSlot -> JSON.Record (Id Asset) o
  350 assetSlotJSON publicRestricted as@AssetSlot{..} = assetJSON publicRestricted slotAsset `JSON.foldObjectIntoRec`
  351  (foldMap (segmentJSON . slotSegment) assetSlot
  352   --  "release" `JSON.kvObjectOrEmpty` (view as :: Maybe Release)
  353   <> "name" `JSON.kvObjectOrEmpty` (if publicRestricted then fmap maskRestrictedString (assetSlotName as) else assetSlotName as)
  354   <> "permission" JSON..= p
  355   <> "size" `JSON.kvObjectOrEmpty` (z `useWhen` (p > PermissionNONE && any (0 <=) z)))
  356   where
  357   p = dataPermission4 getAssetSlotRelease2 getAssetSlotVolumePermission2 as
  358   z = assetSize $ assetRow slotAsset
  359 
  360 {-
  361 assetSlotJSONRestricted :: JSON.ToObject o => AssetSlot -> JSON.Record (Id Asset) o
  362 assetSlotJSONRestricted as@AssetSlot{..} = assetJSONRestricted slotAsset JSON..<>
  363   foldMap (segmentJSON . slotSegment) assetSlot
  364   --  "release" `JSON.kvObjectOrEmpty` (view as :: Maybe Release)
  365   <> "name" `JSON.kvObjectOrEmpty` (fmap maskRestrictedString (assetSlotName as))
  366   <> "permission" JSON..= p
  367   <> "size" `JSON.kvObjectOrEmpty` (z <? p > PermissionNONE && any (0 <=) z)
  368   where
  369   p = dataPermission as
  370   z = assetSize $ assetRow slotAsset
  371 -}