|
| 1 | +-- | Slog-related types. |
| 2 | + |
| 3 | +module Pos.Chain.Block.Slog.LastBlkSlots |
| 4 | + ( LastBlkSlots |
| 5 | + , LastSlotInfo (..) |
| 6 | + |
| 7 | + -- * Create LastBlkSlots |
| 8 | + , create |
| 9 | + , fromList |
| 10 | + |
| 11 | + -- * Access LastBlkSlots components |
| 12 | + , getList |
| 13 | + , lbsCount |
| 14 | + , lbsList |
| 15 | + , lbsMap |
| 16 | + |
| 17 | + -- * LastBlkSlots operations |
| 18 | + , getKeyCount |
| 19 | + , isFull |
| 20 | + , listLength |
| 21 | + , mapSize |
| 22 | + , totalKeyCount |
| 23 | + , update |
| 24 | + , updateMany |
| 25 | + , updateManyR |
| 26 | + ) where |
| 27 | + |
| 28 | +import Universum |
| 29 | + |
| 30 | +import qualified Data.List as List |
| 31 | +import qualified Data.Map.Strict as Map |
| 32 | +import Formatting (bprint, build, int, (%)) |
| 33 | +import qualified Formatting.Buildable as Buildable |
| 34 | + |
| 35 | +import Pos.Binary.Class (Cons (..), Field (..), deriveSimpleBi) |
| 36 | +import Pos.Core (AddressHash, FlatSlotId) |
| 37 | +import Pos.Core.Chrono (OldestFirst (..)) |
| 38 | +import Pos.Crypto (PublicKey (..)) |
| 39 | + |
| 40 | + |
| 41 | +-- Make sure its the actual genesis keys that are being counted. |
| 42 | + |
| 43 | +data LastSlotInfo = LastSlotInfo |
| 44 | + { lsiFlatSlotId :: !FlatSlotId |
| 45 | + -- ^ The flattened SlotId of this block. |
| 46 | + , lsiLeaderPubkeyHash :: !(AddressHash PublicKey) |
| 47 | + -- ^ The hash of the public key of the slot leader for this slot. |
| 48 | + } deriving (Eq, Show, Generic) |
| 49 | + |
| 50 | +instance Buildable LastSlotInfo where |
| 51 | + build (LastSlotInfo i ahpk) = |
| 52 | + bprint ( "LastSlotInfo "% int %" "% build) i ahpk |
| 53 | + |
| 54 | +instance NFData LastSlotInfo |
| 55 | + |
| 56 | +-- | This type contains 'FlatSlotId's of the blocks whose depth is |
| 57 | +-- less than 'blkSecurityParam'. 'FlatSlotId' is chosen in favor of |
| 58 | +-- 'SlotId', because the main use case is chain quality calculation, |
| 59 | +-- for which flat slot is more convenient. |
| 60 | +-- Version 1 of this data type was: |
| 61 | +-- type LastBlkSlots = OldestFirst [] FlatSlotId |
| 62 | +-- Version 2 of this data type was: |
| 63 | +-- data LastBlkSlots = LastBlkSlots |
| 64 | +-- { lbsList :: !(OldestFirst [] LastSlotInfo) |
| 65 | +-- , lbsMap :: !(Map (AddressHash PublicKey) Int) |
| 66 | +-- } deriving (Eq, Show, Generic) |
| 67 | +data LastBlkSlots = LastBlkSlots |
| 68 | + { lbsCount :: !Int |
| 69 | + , lbsList :: !(OldestFirst [] LastSlotInfo) |
| 70 | + , lbsMap :: !(Map (AddressHash PublicKey) Int) |
| 71 | + } deriving (Eq, Show, Generic) |
| 72 | + |
| 73 | +instance NFData LastBlkSlots |
| 74 | + |
| 75 | +create :: Int -> LastBlkSlots |
| 76 | +create k = LastBlkSlots k (OldestFirst []) mempty |
| 77 | + |
| 78 | +getKeyCount :: LastBlkSlots -> AddressHash PublicKey -> Int |
| 79 | +getKeyCount lbs key = |
| 80 | + fromMaybe 0 $ Map.lookup key (lbsMap lbs) |
| 81 | + |
| 82 | +totalKeyCount :: LastBlkSlots -> Int |
| 83 | +totalKeyCount = |
| 84 | + sum . map snd . Map.toList . lbsMap |
| 85 | + |
| 86 | +isFull :: LastBlkSlots -> Bool |
| 87 | +isFull lbs = |
| 88 | + length (getList lbs) == lbsCount lbs |
| 89 | + |
| 90 | +-- | Update LastBlkSlots with a single LastSlotInfo |
| 91 | +update :: LastBlkSlots -> LastSlotInfo -> LastBlkSlots |
| 92 | +update (LastBlkSlots k (OldestFirst lst) mp) lsi = |
| 93 | + if length lst < k |
| 94 | + then LastBlkSlots k (OldestFirst $ lst ++ [lsi]) (increment mp $ lsiLeaderPubkeyHash lsi) |
| 95 | + else case lst of |
| 96 | + [] -> error "Pos.Chain.Block.Slog.LastBlkSlots: Impossible empty list" |
| 97 | + (x:xs) -> |
| 98 | + LastBlkSlots k |
| 99 | + (OldestFirst $ xs ++ [lsi]) |
| 100 | + (increment (decrement mp (lsiLeaderPubkeyHash x)) $ lsiLeaderPubkeyHash lsi) |
| 101 | + |
| 102 | +-- | Update 'LastBlkSlots' with the elements from the list (head first). |
| 103 | +updateMany :: LastBlkSlots -> OldestFirst [] LastSlotInfo -> LastBlkSlots |
| 104 | +updateMany lbs = List.foldl' update lbs . getOldestFirst |
| 105 | + |
| 106 | +-- | Like 'updateMany` but returns a tuple of the new 'LastBlkSlots' and a list |
| 107 | +-- of the elements removed. |
| 108 | +updateManyR :: LastBlkSlots -> OldestFirst [] LastSlotInfo -> (LastBlkSlots, OldestFirst [] LastSlotInfo) |
| 109 | +updateManyR lbs (OldestFirst xs) = |
| 110 | + let removed = List.take (length xs + listLength lbs - lbsCount lbs) (getList lbs ++ xs) |
| 111 | + in (List.foldl' update lbs xs, OldestFirst removed) |
| 112 | + |
| 113 | +getList :: LastBlkSlots -> [LastSlotInfo] |
| 114 | +getList = getOldestFirst . lbsList |
| 115 | + |
| 116 | +listLength :: LastBlkSlots -> Int |
| 117 | +listLength = length . lbsList |
| 118 | + |
| 119 | +mapSize :: LastBlkSlots -> Int |
| 120 | +mapSize = Map.size . lbsMap |
| 121 | + |
| 122 | +fromList :: Int -> OldestFirst [] LastSlotInfo -> LastBlkSlots |
| 123 | +fromList k = List.foldl' update (create k) . getOldestFirst |
| 124 | + |
| 125 | +-- ----------------------------------------------------------------------------- |
| 126 | +-- Private |
| 127 | + |
| 128 | +increment :: Map (AddressHash PublicKey) Int -> AddressHash PublicKey -> Map (AddressHash PublicKey) Int |
| 129 | +increment m k = |
| 130 | + Map.alter incr k m |
| 131 | + where |
| 132 | + incr Nothing = Just 1 |
| 133 | + incr (Just x) = Just $ x + 1 |
| 134 | + |
| 135 | +decrement :: Map (AddressHash PublicKey) Int -> AddressHash PublicKey -> Map (AddressHash PublicKey) Int |
| 136 | +decrement m k = |
| 137 | + Map.alter decr k m |
| 138 | + where |
| 139 | + decr Nothing = Nothing |
| 140 | + decr (Just x) |
| 141 | + | x > 1 = Just $ x - 1 |
| 142 | + | otherwise = Nothing |
| 143 | + |
| 144 | +-- ----------------------------------------------------------------------------- |
| 145 | +-- TH derived instances at the end of the file. |
| 146 | + |
| 147 | +deriveSimpleBi ''LastSlotInfo [ |
| 148 | + Cons 'LastSlotInfo [ |
| 149 | + Field [| lsiFlatSlotId :: FlatSlotId |], |
| 150 | + Field [| lsiLeaderPubkeyHash :: AddressHash PublicKey |] |
| 151 | + ] |
| 152 | + ] |
![iohk-bors[bot]](https://avatars.githubusercontent.com/in/17473?v=4&size=40){kind=avatar}
0 commit comments