1 module Model.AssetSegment.Types
    2   ( AssetSegment(..)
    3   , getAssetSegmentRelease2
    4   , getAssetSegmentVolumePermission2
    5   , getAssetSegmentVolume
    6   , newAssetSegment
    7   , assetFullSegment
    8   , assetSlotSegment
    9   , assetSegmentFull
   10   , assetSegmentRange
   11   , Excerpt(..)
   12   , newExcerpt
   13   , excerptInSegment
   14   ) where
   15 
   16 import Data.Foldable (fold)
   17 import Data.Maybe (fromMaybe)
   18 import Data.Monoid ((<>))
   19 import qualified Database.PostgreSQL.Typed.Range as Range
   20 
   21 import Ops
   22 import Has (Has(..))
   23 import Model.Offset
   24 import Model.Segment
   25 import Model.Id.Types
   26 import Model.Permission.Types
   27 import Model.Volume.Types
   28 import Model.Release.Types
   29 import Model.Container.Types
   30 import Model.Slot.Types
   31 import Model.Format
   32 import Model.Asset.Types
   33 import Model.AssetSlot.Types
   34 
   35 data AssetSegment = AssetSegment
   36   { segmentAsset :: AssetSlot
   37   , assetSegment :: !Segment
   38   , assetExcerpt :: Maybe Excerpt
   39   }
   40 
   41 assetAssumedSegment :: AssetSlot -> Segment
   42 assetAssumedSegment a
   43   | segmentFull seg = Segment $ Range.bounded 0 $ fromMaybe 0 $ assetDuration $ assetRow $ slotAsset a
   44   | otherwise = seg where seg = view a
   45 
   46 -- |A "fake" (possibly invalid) 'AssetSegment' corresponding to the full 'AssetSlot'
   47 assetSlotSegment :: AssetSlot -> AssetSegment
   48 assetSlotSegment a = AssetSegment a (assetAssumedSegment a) Nothing
   49 
   50 assetFullSegment :: AssetSegment -> AssetSegment
   51 assetFullSegment AssetSegment{ assetExcerpt = Just e } = excerptFullSegment e
   52 assetFullSegment AssetSegment{ segmentAsset = a } = assetSlotSegment a
   53 
   54 newAssetSegment :: AssetSlot -> Segment -> Maybe Excerpt -> AssetSegment
   55 newAssetSegment a s e = AssetSegment a (assetAssumedSegment a `segmentIntersect` s) e
   56 
   57 assetSegmentFull :: AssetSegment -> Bool
   58 assetSegmentFull AssetSegment{ segmentAsset = a, assetSegment = s } = assetAssumedSegment a == s
   59 
   60 assetSegmentRange :: AssetSegment -> Range.Range Offset
   61 assetSegmentRange AssetSegment{ segmentAsset = a, assetSegment = Segment s } =
   62   maybe id (fmap . subtract) (lowerBound $ segmentRange $ assetAssumedSegment a) s
   63 
   64 instance Has AssetSlot AssetSegment where
   65   view = segmentAsset
   66 instance Has Asset AssetSegment where
   67   view = view . segmentAsset
   68 instance Has (Id Asset) AssetSegment where
   69   view = view . segmentAsset
   70 getAssetSegmentVolume :: AssetSegment -> Volume
   71 getAssetSegmentVolume = getAssetSlotVolume . segmentAsset
   72 instance Has Volume AssetSegment where
   73   view = view . segmentAsset
   74 instance Has (Id Volume) AssetSegment where
   75   view = volumeId . volumeRow . assetVolume . slotAsset . segmentAsset
   76 getAssetSegmentVolumePermission2 :: AssetSegment -> VolumeRolePolicy
   77 getAssetSegmentVolumePermission2 = getAssetSlotVolumePermission2 . segmentAsset
   78 
   79 instance Has Slot AssetSegment where
   80   view AssetSegment{ segmentAsset = AssetSlot{ assetSlot = Just s }, assetSegment = seg } = s{ slotSegment = seg }
   81   view _ = error "unlinked AssetSegment"
   82 instance Has Container AssetSegment where
   83   view = slotContainer . view
   84 instance Has (Id Container) AssetSegment where
   85   view = containerId . containerRow . slotContainer . view
   86 instance Has Segment AssetSegment where
   87   view = assetSegment
   88 
   89 instance Has Format AssetSegment where
   90   view AssetSegment{ segmentAsset = a, assetSegment = Segment rng }
   91     | Just s <- formatSample fmt
   92     , Just _ <- assetDuration $ assetRow $ slotAsset a
   93     , Just _ <- Range.getPoint rng = s
   94     | otherwise = fmt
   95     where fmt = getAssetSlotFormat a
   96 instance Has (Id Format) AssetSegment where
   97   view = formatId . view
   98 
   99 -- when the assetslot has lower permissions than the excerpt, then use the excerpt's permissions
  100 -- when no excerpt is present, then assume no access
  101 getAssetSegmentRelease2 :: AssetSegment -> EffectiveRelease
  102 getAssetSegmentRelease2 as =
  103   case as of
  104     AssetSegment{ segmentAsset = a, assetExcerpt = Just e } ->
  105       let
  106         rel =
  107            fold (
  108                 excerptRelease e  -- Maybe Release monoid takes the first just, if both just, then max of values
  109              <> getAssetSlotReleaseMaybe a) -- TODO: should I expose the guts of getAssetSlotRelease2?
  110       in
  111         EffectiveRelease {
  112           effRelPublic = rel
  113         , effRelPrivate = rel
  114         }
  115     AssetSegment{ segmentAsset = a } ->
  116       getAssetSlotRelease2 a
  117 
  118 data Excerpt = Excerpt
  119   { excerptAsset :: !AssetSegment
  120   , excerptRelease :: !(Maybe Release)
  121   }
  122 instance Show Excerpt where
  123   show _ = "Excerpt"
  124 
  125 newExcerpt :: AssetSlot -> Segment -> Maybe Release -> Excerpt
  126 newExcerpt a s r = e where
  127   as = newAssetSegment a s (Just e)
  128   e = Excerpt as r
  129 
  130 excerptInSegment :: Excerpt -> Segment -> AssetSegment
  131 excerptInSegment e@Excerpt{ excerptAsset = AssetSegment{ segmentAsset = a, assetSegment = es } } s
  132   | segmentOverlaps es s = as
  133   | otherwise = error "excerptInSegment: non-overlapping"
  134   where as = newAssetSegment a s ((es `segmentContains` assetSegment as) `thenUse` e)
  135 
  136 excerptFullSegment :: Excerpt -> AssetSegment
  137 excerptFullSegment e = excerptInSegment e fullSegment
  138 
  139 instance Has AssetSegment Excerpt where
  140   view = excerptAsset
  141 instance Has AssetSlot Excerpt where
  142   view = view . excerptAsset
  143 instance Has Asset Excerpt where
  144   view = view . excerptAsset
  145 instance Has (Id Asset) Excerpt where
  146   view = view . excerptAsset
  147 instance Has Volume Excerpt where
  148   view = view . excerptAsset
  149 {- instance Has (Id Volume) Excerpt where
  150   view = view . excerptAsset -}
  151 instance Has Slot Excerpt where
  152   view = view . excerptAsset
  153 instance Has Container Excerpt where
  154   view = view . excerptAsset
  155 instance Has (Id Container) Excerpt where
  156   view = view . excerptAsset
  157 instance Has Segment Excerpt where
  158   view = view . excerptAsset