{-# LANGUAGE TemplateHaskell, OverloadedStrings #-} module SecondTransfer.Http2.OutputTray ( TrayEntry (..) , systemPriority_TyE , streamPriority_TyE , streamOrdinal_TyE , payload_TyE , streamId_TyE , OutputTray (..) , filling_OuT , maxLength_OuT , entries_OuT , newOutputTray , splitOverSize , addEntry , lowestCalmValue ) where import Control.Lens --import Control.Concurrent -- import qualified Data.Vector.Mutable as MVec import qualified Data.Vector as DVec import qualified Data.Vector.Algorithms.Merge as Dam --import qualified Data.ByteString as B import qualified Data.ByteString.Lazy as LB -- | The output tray.... all data is sorted according to the priority -- assigned here .... -- -- -- System priorities: 0 for data frames -- -1 for header and other HTTP/2 low level -- -2 for go-away frame. The deliverer is expected to close -- the connection inmmediately after. -- - something_else for the PingFrame (have to look it put) -- -- Stream Ordinary priorities are assigned by the worker. -- data TrayEntry = TrayEntry { _systemPriority_TyE :: !Int , _streamPriority_TyE :: !Int , _streamOrdinal_TyE :: !Int -- Informative .... , _payload_TyE :: !LB.ByteString , _streamId_TyE :: !Int -- Maybe: delivery callback } deriving (Show) makeLenses ''TrayEntry type EntryListBuilder = [TrayEntry] -> [TrayEntry] data OutputTray = OutputTray { _filling_OuT :: Int , _maxLength_OuT :: Int , _entries_OuT :: !EntryListBuilder } makeLenses ''OutputTray trayCompareKey :: TrayEntry -> (Int, Int) trayCompareKey te = (te ^. systemPriority_TyE, te ^. streamPriority_TyE ) trayEntryCompare :: TrayEntry -> TrayEntry -> Ordering trayEntryCompare te0 te1 = compare (trayCompareKey te0) (trayCompareKey te1) newOutputTray :: Int -> OutputTray newOutputTray max_length = OutputTray { _filling_OuT = 0 , _maxLength_OuT = max_length , _entries_OuT = id } -- You are in carge of protecting the access to the tray! addEntry :: OutputTray -> TrayEntry -> OutputTray addEntry tray entry = let ot1 = over entries_OuT ( . (entry : ) ) tray ot2 = over filling_OuT ( + 1 ) ot1 in ot2 -- Returns the highest value of the calm (aka priority). -- Unfortunately fetching this value drops the structure into a concrete -- state.... lowestCalmValue :: OutputTray -> (OutputTray, Int) lowestCalmValue output_tray = let entries_list = (output_tray ^. entries_OuT) [] result = foldl (\ hc entry -> let stream_priority = entry ^. streamPriority_TyE in if (entry ^. systemPriority_TyE >= 0) && stream_priority < hc then stream_priority else hc ) ( 4000000000 ) entries_list new_tray_fn incoming = foldr (:) incoming entries_list new_tray = set entries_OuT new_tray_fn output_tray in (new_tray, result ) splitOverSize :: Int -> OutputTray -> (OutputTray, [TrayEntry]) splitOverSize sz ot0 = let entries_list = (ot0 ^. entries_OuT) [] -- First let's get a vector from here entries_vector = DVec.fromList entries_list had_entries_count = DVec.length entries_vector -- Then let's sort it, stably so that ordinals are automatically -- kept (otherwise the data will break), but system and high priority -- ones go before everybody else sorted_entries :: DVec.Vector TrayEntry sorted_entries = DVec.modify (\ mvec -> Dam.sortBy trayEntryCompare mvec) entries_vector -- And let' returns the ones which are interesting.... go :: Int -> Int -> Int go taken_size idx | taken_size < sz && idx < DVec.length sorted_entries = go (taken_size + (sorted_entries DVec.! idx) ^. payload_TyE . to (fromIntegral . LB.length) ) (idx+1) | taken_size >= sz = idx | otherwise = idx take_this_many = go 0 0 entries_to_take = DVec.toList . DVec.take take_this_many $ sorted_entries entries_to_leave = DVec.drop take_this_many sorted_entries entries_to_leave_list_builder :: [TrayEntry] -> [TrayEntry] entries_to_leave_list_builder incoming = DVec.foldr' (:) incoming entries_to_leave new_tray = (set filling_OuT (had_entries_count - take_this_many) ) . (set entries_OuT entries_to_leave_list_builder) $ ot0 in (new_tray, entries_to_take)