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