1 {-# LANGUAGE OverloadedStrings, RecordWildCards, TemplateHaskell, QuasiQuotes, DataKinds #-}
    2 module Databrary.Model.Asset
    3   ( module Databrary.Model.Asset.Types
    4   -- , blankAsset
    5   , assetBacked
    6   , lookupAsset
    7   , lookupOrigAsset
    8   , lookupVolumeAsset
    9   , addAsset
   10   , changeAsset
   11   , assetCreation
   12   , assetRowJSON
   13   , assetJSON
   14   -- , assetJSONRestricted
   15   ) where
   16 
   17 import Control.Arrow (first)
   18 import Data.Maybe (isNothing, isJust)
   19 import Data.Monoid ((<>))
   20 import qualified Data.Text as T
   21 import Database.PostgreSQL.Typed (pgSQL)
   22 import Database.PostgreSQL.Typed.Query
   23 import Database.PostgreSQL.Typed.Types
   24 import qualified Data.ByteString
   25 import Data.ByteString (ByteString)
   26 import qualified Data.String
   27 
   28 import Databrary.Ops
   29 import Databrary.Has (view, peek)
   30 import qualified Databrary.JSON as JSON
   31 import Databrary.Service.DB
   32 import Databrary.Files
   33 import Databrary.Store.Types
   34 import Databrary.Store.Asset
   35 import Databrary.Model.SQL
   36 import Databrary.Model.Time
   37 import Databrary.Model.Audit
   38 import Databrary.Model.Id
   39 import Databrary.Model.Identity
   40 import Databrary.Model.Party
   41 import Databrary.Model.Volume
   42 import Databrary.Model.Format
   43 import Databrary.Model.Asset.Types
   44 import Databrary.Model.Asset.SQL
   45 
   46 mapQuery :: ByteString -> ([PGValue] -> a) -> PGSimpleQuery a
   47 mapQuery qry mkResult =
   48   fmap mkResult (rawPGSimpleQuery qry)
   49 
   50 assetBacked :: Asset -> Bool
   51 assetBacked = isJust . assetSHA1 . assetRow
   52 
   53 lookupAsset :: (MonadHasIdentity c m, MonadDB c m) => Id Asset -> m (Maybe Asset)
   54 lookupAsset ai = do
   55   ident <- peek
   56   dbQuery1 $(selectQuery (selectAsset 'ident) "$WHERE asset.id = ${ai}")
   57 
   58 lookupOrigAsset :: (MonadHasIdentity c m, MonadDB c m) => Id Asset -> m (Maybe Asset)
   59 lookupOrigAsset ai = do
   60   ident <- peek
   61   dbQuery1 $(selectQuery (selectAsset 'ident) "$left join transcode tc on tc.orig = asset.id WHERE asset.id = ${ai}")
   62 
   63 lookupVolumeAsset :: (MonadDB c m) => Volume -> Id Asset -> m (Maybe Asset)
   64 lookupVolumeAsset vol ai = do
   65   let _tenv_a87rh = unknownPGTypeEnv
   66   dbQuery1 $ (`Asset` vol) <$> -- .(selectQuery selectAssetRow "WHERE asset.id = ${ai} AND asset.volume = ${volumeId $ volumeRow vol}")
   67     fmap
   68       (\ (vid_a87qZ, vformat_a87r0, vrelease_a87r1, vduration_a87r2,
   69           vname_a87r3, vc_a87r4, vsize_a87r5)
   70          -> makeAssetRow
   71               vid_a87qZ
   72               vformat_a87r0
   73               vrelease_a87r1
   74               vduration_a87r2
   75               vname_a87r3
   76               vc_a87r4
   77               vsize_a87r5)
   78       (mapQuery
   79         ((\ _p_a87ri _p_a87rj ->
   80                        (Data.ByteString.concat
   81                           [Data.String.fromString
   82                              "SELECT asset.id,asset.format,asset.release,asset.duration,asset.name,asset.sha1,asset.size FROM asset WHERE asset.id = ",
   83                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
   84                              _tenv_a87rh
   85                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
   86                                 Database.PostgreSQL.Typed.Types.PGTypeName "integer")
   87                              _p_a87ri,
   88                            Data.String.fromString " AND asset.volume = ",
   89                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
   90                              _tenv_a87rh
   91                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
   92                                 Database.PostgreSQL.Typed.Types.PGTypeName "integer")
   93                              _p_a87rj]))
   94          ai (volumeId $ volumeRow vol))
   95                 (\
   96                   [_cid_a87rk,
   97                    _cformat_a87rl,
   98                    _crelease_a87rm,
   99                    _cduration_a87rn,
  100                    _cname_a87ro,
  101                    _csha1_a87rp,
  102                    _csize_a87rq]
  103                   -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull
  104                         _tenv_a87rh
  105                         (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  106                            Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  107                         _cid_a87rk, 
  108                       Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull
  109                         _tenv_a87rh
  110                         (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  111                            Database.PostgreSQL.Typed.Types.PGTypeName "smallint")
  112                         _cformat_a87rl, 
  113                       Database.PostgreSQL.Typed.Types.pgDecodeColumn
  114                         _tenv_a87rh
  115                         (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  116                            Database.PostgreSQL.Typed.Types.PGTypeName "release")
  117                         _crelease_a87rm, 
  118                       Database.PostgreSQL.Typed.Types.pgDecodeColumn
  119                         _tenv_a87rh
  120                         (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  121                            Database.PostgreSQL.Typed.Types.PGTypeName "interval")
  122                         _cduration_a87rn, 
  123                       Database.PostgreSQL.Typed.Types.pgDecodeColumn
  124                         _tenv_a87rh
  125                         (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  126                            Database.PostgreSQL.Typed.Types.PGTypeName "text")
  127                         _cname_a87ro, 
  128                       Database.PostgreSQL.Typed.Types.pgDecodeColumn
  129                         _tenv_a87rh
  130                         (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  131                            Database.PostgreSQL.Typed.Types.PGTypeName "bytea")
  132                         _csha1_a87rp, 
  133                       Database.PostgreSQL.Typed.Types.pgDecodeColumn
  134                         _tenv_a87rh
  135                         (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  136                            Database.PostgreSQL.Typed.Types.PGTypeName "bigint")
  137                         _csize_a87rq)))
  138 
  139 addAsset :: (MonadAudit c m, MonadStorage c m) => Asset -> Maybe RawFilePath -> m Asset
  140 addAsset ba fp = do
  141   ident <- getAuditIdentity
  142   ba' <- maybe (return ba) (storeAssetFile ba) fp
  143   let _tenv_a87Hi = unknownPGTypeEnv
  144   dbQuery1' -- .(insertAsset 'ident 'ba')
  145     (fmap
  146       (\ (vid_a87Bv)
  147          -> setAssetId ba' vid_a87Bv)
  148       (mapQuery
  149         ((\ _p_a87Hj
  150           _p_a87Hk
  151           _p_a87Hr
  152           _p_a87Hv
  153           _p_a87Hw
  154           _p_a87Hx
  155           _p_a87Hy
  156           _p_a87Hz
  157           _p_a87HB ->
  158                        (Data.ByteString.concat
  159                           [Data.String.fromString
  160                              "WITH audit_row AS (INSERT INTO asset (volume,format,release,duration,name,sha1,size) VALUES (",
  161                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
  162                              _tenv_a87Hi
  163                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  164                                 Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  165                              _p_a87Hj,
  166                            Data.String.fromString ",",
  167                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
  168                              _tenv_a87Hi
  169                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  170                                 Database.PostgreSQL.Typed.Types.PGTypeName "smallint")
  171                              _p_a87Hk,
  172                            Data.String.fromString ",",
  173                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
  174                              _tenv_a87Hi
  175                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  176                                 Database.PostgreSQL.Typed.Types.PGTypeName "release")
  177                              _p_a87Hr,
  178                            Data.String.fromString ",",
  179                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
  180                              _tenv_a87Hi
  181                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  182                                 Database.PostgreSQL.Typed.Types.PGTypeName "interval")
  183                              _p_a87Hv,
  184                            Data.String.fromString ",",
  185                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
  186                              _tenv_a87Hi
  187                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  188                                 Database.PostgreSQL.Typed.Types.PGTypeName "text")
  189                              _p_a87Hw,
  190                            Data.String.fromString ",",
  191                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
  192                              _tenv_a87Hi
  193                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  194                                 Database.PostgreSQL.Typed.Types.PGTypeName "bytea")
  195                              _p_a87Hx,
  196                            Data.String.fromString ",",
  197                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
  198                              _tenv_a87Hi
  199                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  200                                 Database.PostgreSQL.Typed.Types.PGTypeName "bigint")
  201                              _p_a87Hy,
  202                            Data.String.fromString
  203                              ") RETURNING *) INSERT INTO audit.asset SELECT CURRENT_TIMESTAMP, ",
  204                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
  205                              _tenv_a87Hi
  206                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  207                                 Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  208                              _p_a87Hz,
  209                            Data.String.fromString ", ",
  210                            Database.PostgreSQL.Typed.Types.pgEscapeParameter
  211                              _tenv_a87Hi
  212                              (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  213                                 Database.PostgreSQL.Typed.Types.PGTypeName "inet")
  214                              _p_a87HB,
  215                            Data.String.fromString
  216                              ", 'add'::audit.action, * FROM audit_row RETURNING asset.id"]))
  217          (volumeId $ volumeRow $ assetVolume ba')
  218          (formatId $ assetFormat $ assetRow ba')
  219          (assetRelease $ assetRow ba')
  220          (assetDuration $ assetRow ba')
  221          (assetName $ assetRow ba')
  222          (assetSHA1 $ assetRow ba')
  223          (assetSize $ assetRow ba')
  224          (auditWho ident)
  225          (auditIp ident))
  226                (\ [_cid_a87HC]
  227                   -> (Database.PostgreSQL.Typed.Types.pgDecodeColumnNotNull
  228                         _tenv_a87Hi
  229                         (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  230                            Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  231                         _cid_a87HC))))
  232 
  233 changeAsset :: (MonadAudit c m, MonadStorage c m) => Asset -> Maybe RawFilePath -> m Asset
  234 changeAsset a fp = do
  235   ident <- getAuditIdentity
  236   a2 <- maybe (return a) (storeAssetFile a) fp
  237   let _tenv_a87Mj = unknownPGTypeEnv
  238   dbExecute1' -- .(updateAsset 'ident 'a2)
  239     (mapQuery
  240       ((\ _p_a87Mk
  241        _p_a87Ml
  242        _p_a87Mm
  243        _p_a87Mn
  244        _p_a87Mo
  245        _p_a87Mp
  246        _p_a87Mq
  247        _p_a87Mr
  248        _p_a87Ms
  249        _p_a87Mt ->
  250                     (Data.ByteString.concat
  251                        [Data.String.fromString
  252                           "WITH audit_row AS (UPDATE asset SET volume=",
  253                         Database.PostgreSQL.Typed.Types.pgEscapeParameter
  254                           _tenv_a87Mj
  255                           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  256                              Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  257                           _p_a87Mk,
  258                         Data.String.fromString ",format=",
  259                         Database.PostgreSQL.Typed.Types.pgEscapeParameter
  260                           _tenv_a87Mj
  261                           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  262                              Database.PostgreSQL.Typed.Types.PGTypeName "smallint")
  263                           _p_a87Ml,
  264                         Data.String.fromString ",release=",
  265                         Database.PostgreSQL.Typed.Types.pgEscapeParameter
  266                           _tenv_a87Mj
  267                           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  268                              Database.PostgreSQL.Typed.Types.PGTypeName "release")
  269                           _p_a87Mm,
  270                         Data.String.fromString ",duration=",
  271                         Database.PostgreSQL.Typed.Types.pgEscapeParameter
  272                           _tenv_a87Mj
  273                           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  274                              Database.PostgreSQL.Typed.Types.PGTypeName "interval")
  275                           _p_a87Mn,
  276                         Data.String.fromString ",name=",
  277                         Database.PostgreSQL.Typed.Types.pgEscapeParameter
  278                           _tenv_a87Mj
  279                           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  280                              Database.PostgreSQL.Typed.Types.PGTypeName "text")
  281                           _p_a87Mo,
  282                         Data.String.fromString ",sha1=",
  283                         Database.PostgreSQL.Typed.Types.pgEscapeParameter
  284                           _tenv_a87Mj
  285                           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  286                              Database.PostgreSQL.Typed.Types.PGTypeName "bytea")
  287                           _p_a87Mp,
  288                         Data.String.fromString ",size=",
  289                         Database.PostgreSQL.Typed.Types.pgEscapeParameter
  290                           _tenv_a87Mj
  291                           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  292                              Database.PostgreSQL.Typed.Types.PGTypeName "bigint")
  293                           _p_a87Mq,
  294                         Data.String.fromString " WHERE id=",
  295                         Database.PostgreSQL.Typed.Types.pgEscapeParameter
  296                           _tenv_a87Mj
  297                           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  298                              Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  299                           _p_a87Mr,
  300                         Data.String.fromString
  301                           " RETURNING *) INSERT INTO audit.asset SELECT CURRENT_TIMESTAMP, ",
  302                         Database.PostgreSQL.Typed.Types.pgEscapeParameter
  303                           _tenv_a87Mj
  304                           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  305                              Database.PostgreSQL.Typed.Types.PGTypeName "integer")
  306                           _p_a87Ms,
  307                         Data.String.fromString ", ",
  308                         Database.PostgreSQL.Typed.Types.pgEscapeParameter
  309                           _tenv_a87Mj
  310                           (Database.PostgreSQL.Typed.Types.PGTypeProxy ::
  311                              Database.PostgreSQL.Typed.Types.PGTypeName "inet")
  312                           _p_a87Mt,
  313                         Data.String.fromString
  314                           ", 'change'::audit.action, * FROM audit_row"]))
  315       (volumeId $ volumeRow $ assetVolume a2)
  316       (formatId $ assetFormat $ assetRow a2)
  317       (assetRelease $ assetRow a2)
  318       (assetDuration $ assetRow a2)
  319       (assetName $ assetRow a2)
  320       (assetSHA1 $ assetRow a2)
  321       (assetSize $ assetRow a2)
  322       (assetId $ assetRow a2)
  323       (auditWho ident)
  324       (auditIp ident))
  325             (\[] -> ()))
  326   return a2
  327 
  328 assetCreation :: MonadDB c m => Asset -> m (Maybe Timestamp, Maybe T.Text)
  329 assetCreation a = maybe (Nothing, Nothing) (first Just) <$>
  330   dbQuery1 [pgSQL|$SELECT audit_time, name FROM audit.asset WHERE id = ${assetId $ assetRow a} AND audit_action = 'add' ORDER BY audit_time DESC LIMIT 1|]
  331 
  332 assetRowJSON :: JSON.ToObject o => AssetRow -> JSON.Record (Id Asset) o
  333 assetRowJSON AssetRow{..} = JSON.Record assetId $
  334      "format" JSON..= formatId assetFormat
  335   <> "classification" `JSON.kvObjectOrEmpty` assetRelease
  336   <> "duration" `JSON.kvObjectOrEmpty` assetDuration
  337   <> "pending" `JSON.kvObjectOrEmpty` ((isNothing assetSize) `useWhen` (isNothing assetSHA1))
  338 
  339 assetJSON :: JSON.ToObject o => Bool -> Asset -> JSON.Record (Id Asset) o
  340 assetJSON _ Asset{..} = assetRowJSON assetRow -- first parameter is publicRestricted
  341 
  342 -- assetJSONRestricted :: JSON.ToObject o => Asset -> JSON.Record (Id Asset) o
  343 -- assetJSONRestricted Asset{..} = assetRowJSON assetRow