UUIDs are fixed-length strings at which we either look completely or not at all. Moreover, we do not do any computations on them. Therefore, we can chose a more compact representation on them, resulting in reduced memory foot print.
Signed-off-by: Klaus Aehlig <[email protected]> --- src/Ganeti/DataCollectors/InstStatus.hs | 3 ++- src/Ganeti/JQScheduler/Filtering.hs | 7 +++++-- src/Ganeti/Objects.hs | 11 ++++++----- src/Ganeti/Objects/Disk.hs | 3 ++- src/Ganeti/Objects/Instance.hs | 3 ++- src/Ganeti/Objects/Lens.hs | 18 +++++++++++++----- src/Ganeti/Objects/Nic.hs | 5 ++++- src/Ganeti/Query/Server.hs | 3 ++- src/Ganeti/THH/Field.hs | 3 ++- test/hs/Test/Ganeti/JQScheduler.hs | 5 +++-- test/hs/Test/Ganeti/Objects.hs | 15 +++++++++++---- test/hs/Test/Ganeti/Query/Instance.hs | 3 ++- 12 files changed, 54 insertions(+), 25 deletions(-) diff --git a/src/Ganeti/DataCollectors/InstStatus.hs b/src/Ganeti/DataCollectors/InstStatus.hs index 578819b..1e7f3a8 100644 --- a/src/Ganeti/DataCollectors/InstStatus.hs +++ b/src/Ganeti/DataCollectors/InstStatus.hs @@ -46,6 +46,7 @@ module Ganeti.DataCollectors.InstStatus import Control.Exception.Base +import qualified Data.ByteString.UTF8 as UTF8 import Data.List import Data.Maybe import qualified Data.Map as Map @@ -167,7 +168,7 @@ buildStatus domains uptimes inst = do return $ InstStatus name - (realInstUuid inst) + (UTF8.toString $ realInstUuid inst) adminState actualState uptime diff --git a/src/Ganeti/JQScheduler/Filtering.hs b/src/Ganeti/JQScheduler/Filtering.hs index 8c98083..34e55bb 100644 --- a/src/Ganeti/JQScheduler/Filtering.hs +++ b/src/Ganeti/JQScheduler/Filtering.hs @@ -42,6 +42,7 @@ module Ganeti.JQScheduler.Filtering , matches ) where +import qualified Data.ByteString as BS import Data.List import Data.Maybe import qualified Data.Map as Map @@ -167,7 +168,7 @@ applyingFilter filters job = -- | SlotMap for filter rule rate limiting, having `FilterRule` UUIDs as keys. -type RateLimitSlotMap = SlotMap String +type RateLimitSlotMap = SlotMap BS.ByteString -- We would prefer FilterRule here but that has no Ord instance (yet). @@ -179,7 +180,9 @@ data FilterChainState = FilterChainState -- | Update a `FilterChainState` if the given `CountMap` fits into its -- filtering SlotsMap. -tryFitSlots :: FilterChainState -> CountMap String -> Maybe FilterChainState +tryFitSlots :: FilterChainState + -> CountMap BS.ByteString + -> Maybe FilterChainState tryFitSlots st@FilterChainState{ rateLimitSlotMap = slotMap } countMap = if slotMap `hasSlotsFor` countMap then Just st{ rateLimitSlotMap = slotMap `occupySlots` countMap } diff --git a/src/Ganeti/Objects.hs b/src/Ganeti/Objects.hs index 9817900..c4c4cda 100644 --- a/src/Ganeti/Objects.hs +++ b/src/Ganeti/Objects.hs @@ -108,6 +108,7 @@ module Ganeti.Objects import Control.Applicative import Control.Arrow (first) import Control.Monad.State +import qualified Data.ByteString.UTF8 as UTF8 import Data.List (foldl', intercalate) import Data.Maybe import qualified Data.Map as Map @@ -268,7 +269,7 @@ instance TagsObject Network where tagsOf = networkTags instance UuidObject Network where - uuidOf = networkUuid + uuidOf = UTF8.toString . networkUuid instance TimeStampObject Network where cTimeOf = networkCtime @@ -428,7 +429,7 @@ instance TimeStampObject Node where mTimeOf = nodeMtime instance UuidObject Node where - uuidOf = nodeUuid + uuidOf = UTF8.toString . nodeUuid instance SerialNoObject Node where serialOf = nodeSerial @@ -467,7 +468,7 @@ instance TimeStampObject NodeGroup where mTimeOf = groupMtime instance UuidObject NodeGroup where - uuidOf = groupUuid + uuidOf = UTF8.toString . groupUuid instance SerialNoObject NodeGroup where serialOf = groupSerial @@ -548,7 +549,7 @@ $(buildObject "FilterRule" "fr" $ ++ uuidFields) instance UuidObject FilterRule where - uuidOf = frUuid + uuidOf = UTF8.toString . frUuid -- | Order in which filter rules are evaluated, according to @@ -689,7 +690,7 @@ instance TimeStampObject Cluster where mTimeOf = clusterMtime instance UuidObject Cluster where - uuidOf = clusterUuid + uuidOf = UTF8.toString . clusterUuid instance SerialNoObject Cluster where serialOf = clusterSerial diff --git a/src/Ganeti/Objects/Disk.hs b/src/Ganeti/Objects/Disk.hs index 4da84b0..0a2e6db 100644 --- a/src/Ganeti/Objects/Disk.hs +++ b/src/Ganeti/Objects/Disk.hs @@ -37,6 +37,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.Objects.Disk where import Control.Applicative ((<*>), (<$>)) +import qualified Data.ByteString.UTF8 as UTF8 import Data.Char (isAsciiLower, isAsciiUpper, isDigit) import Data.List (isPrefixOf, isInfixOf) import Language.Haskell.TH.Syntax @@ -257,7 +258,7 @@ $(buildObjectWithForthcoming "Disk" "disk" $ ++ timeStampFields) instance UuidObject Disk where - uuidOf = diskUuid + uuidOf = UTF8.toString . diskUuid instance ForthcomingObject Disk where isForthcoming = diskForthcoming diff --git a/src/Ganeti/Objects/Instance.hs b/src/Ganeti/Objects/Instance.hs index 238898f..fd8c3d9 100644 --- a/src/Ganeti/Objects/Instance.hs +++ b/src/Ganeti/Objects/Instance.hs @@ -36,6 +36,7 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.Objects.Instance where +import qualified Data.ByteString.UTF8 as UTF8 import Data.Monoid import Ganeti.JSON (emptyContainer) @@ -88,7 +89,7 @@ instance TimeStampObject Instance where mTimeOf = instMtime instance UuidObject Instance where - uuidOf = instUuid + uuidOf = UTF8.toString . instUuid instance SerialNoObject Instance where serialOf = instSerial diff --git a/src/Ganeti/Objects/Lens.hs b/src/Ganeti/Objects/Lens.hs index b1b170d..11413a2 100644 --- a/src/Ganeti/Objects/Lens.hs +++ b/src/Ganeti/Objects/Lens.hs @@ -36,12 +36,20 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.Objects.Lens where +import qualified Data.ByteString as BS +import qualified Data.ByteString.UTF8 as UTF8 +import Control.Lens (Simple) +import Control.Lens.Iso (Iso, iso) import qualified Data.Set as Set import System.Time (ClockTime(..)) import Ganeti.Lens (makeCustomLenses, Lens') import Ganeti.Objects +-- | Isomorphism between Strings and bytestrings +stringL :: Simple Iso BS.ByteString String +stringL = iso UTF8.toString UTF8.fromString + -- | Class of objects that have timestamps. class TimeStampObject a => TimeStampObjectL a where mTimeL :: Lens' a ClockTime @@ -69,7 +77,7 @@ instance TagsObjectL Network where tagsL = networkTagsL instance UuidObjectL Network where - uuidL = networkUuidL + uuidL = networkUuidL . stringL instance TimeStampObjectL Network where mTimeL = networkMtimeL @@ -84,7 +92,7 @@ instance TimeStampObjectL Instance where mTimeL = instMtimeL instance UuidObjectL Instance where - uuidL = instUuidL + uuidL = instUuidL . stringL instance SerialNoObjectL Instance where serialL = instSerialL @@ -104,7 +112,7 @@ instance TimeStampObjectL Node where mTimeL = nodeMtimeL instance UuidObjectL Node where - uuidL = nodeUuidL + uuidL = nodeUuidL . stringL instance SerialNoObjectL Node where serialL = nodeSerialL @@ -118,7 +126,7 @@ instance TimeStampObjectL NodeGroup where mTimeL = groupMtimeL instance UuidObjectL NodeGroup where - uuidL = groupUuidL + uuidL = groupUuidL . stringL instance SerialNoObjectL NodeGroup where serialL = groupSerialL @@ -132,7 +140,7 @@ instance TimeStampObjectL Cluster where mTimeL = clusterMtimeL instance UuidObjectL Cluster where - uuidL = clusterUuidL + uuidL = clusterUuidL . stringL instance SerialNoObjectL Cluster where serialL = clusterSerialL diff --git a/src/Ganeti/Objects/Nic.hs b/src/Ganeti/Objects/Nic.hs index 1c6f9bb..270151d 100644 --- a/src/Ganeti/Objects/Nic.hs +++ b/src/Ganeti/Objects/Nic.hs @@ -36,6 +36,8 @@ SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. module Ganeti.Objects.Nic where +import qualified Data.ByteString.UTF8 as UTF8 + import Ganeti.THH import Ganeti.THH.Field import Ganeti.Types @@ -55,5 +57,6 @@ $(buildObject "PartialNic" "nic" $ ] ++ uuidFields) instance UuidObject PartialNic where - uuidOf = nicUuid + uuidOf = UTF8.toString . nicUuid + diff --git a/src/Ganeti/Query/Server.hs b/src/Ganeti/Query/Server.hs index 36e3b01..056d59c 100644 --- a/src/Ganeti/Query/Server.hs +++ b/src/Ganeti/Query/Server.hs @@ -50,6 +50,7 @@ import Control.Monad.Error (MonadError) import Control.Monad.IO.Class import Control.Monad.Trans (lift) import Control.Monad.Trans.Maybe +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Set as Set (toList) import Data.IORef import Data.List (intersperse) @@ -342,7 +343,7 @@ handleCall _ status _ (ReplaceFilter mUuid priority predicates action , frPredicates = predicates , frAction = action , frReasonTrail = reason ++ [luxidReason] - , frUuid = uuid + , frUuid = UTF8.fromString uuid } writeConfig cid . (configFiltersL . alterContainerL uuid .~ Just rule) diff --git a/src/Ganeti/THH/Field.hs b/src/Ganeti/THH/Field.hs index 42c8fc1..6047ca4 100644 --- a/src/Ganeti/THH/Field.hs +++ b/src/Ganeti/THH/Field.hs @@ -50,6 +50,7 @@ module Ganeti.THH.Field ) where import Control.Monad +import qualified Data.ByteString as BS import qualified Data.Set as Set import Language.Haskell.TH import qualified Text.JSON as JSON @@ -118,7 +119,7 @@ serialFields = -- | UUID fields description. uuidFields :: [Field] -uuidFields = [ presentInForthcoming $ simpleField "uuid" [t| String |] ] +uuidFields = [ presentInForthcoming $ simpleField "uuid" [t| BS.ByteString |] ] -- | Tag set type alias. type TagSet = Set.Set String diff --git a/test/hs/Test/Ganeti/JQScheduler.hs b/test/hs/Test/Ganeti/JQScheduler.hs index a0aa650..77eb2ac 100644 --- a/test/hs/Test/Ganeti/JQScheduler.hs +++ b/test/hs/Test/Ganeti/JQScheduler.hs @@ -39,6 +39,7 @@ module Test.Ganeti.JQScheduler (testJQScheduler) where import Control.Applicative import Control.Lens ((&), (.~), _2) +import qualified Data.ByteString.UTF8 as UTF8 import Data.List (inits) import Data.Maybe import qualified Data.Map as Map @@ -396,7 +397,7 @@ case_jobFiltering = do jid3 <- makeJobId 3 jid4 <- makeJobId 4 unsetPrio <- mkNonNegative 1234 - uuid1 <- newUUID + uuid1 <- fmap UTF8.fromString newUUID let j1 = nullJobWithStat QueuedJob @@ -448,7 +449,7 @@ case_jobFiltering = do -- Gives the rule a new UUID. rule fr = do - uuid <- newUUID + uuid <- fmap UTF8.fromString newUUID return fr{ frUuid = uuid } -- Helper to create filter chains: assigns the filters in the list diff --git a/test/hs/Test/Ganeti/Objects.hs b/test/hs/Test/Ganeti/Objects.hs index dcb12bc..f048ea7 100644 --- a/test/hs/Test/Ganeti/Objects.hs +++ b/test/hs/Test/Ganeti/Objects.hs @@ -54,6 +54,8 @@ import qualified Test.HUnit as HUnit import Control.Applicative import Control.Monad +import qualified Data.ByteString as BS +import qualified Data.ByteString.UTF8 as UTF8 import Data.Char import qualified Data.List as List import qualified Data.Map as Map @@ -89,6 +91,9 @@ instance Arbitrary (Container DataCollectorConfig) where return GenericContainer { fromContainer = Map.fromList $ zip names configs } +instance Arbitrary BS.ByteString where + arbitrary = fmap UTF8.fromString arbitrary + $(genArbitrary ''PartialNDParams) instance Arbitrary Node where @@ -96,7 +101,8 @@ instance Arbitrary Node where <*> arbitrary <*> arbitrary <*> arbitrary <*> genFQDN <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary <*> arbitrary - <*> genFQDN <*> arbitrary <*> (Set.fromList <$> genTags) + <*> fmap UTF8.fromString genUUID <*> arbitrary + <*> (Set.fromList <$> genTags) $(genArbitrary ''BlockDriver) @@ -278,7 +284,7 @@ genDiskWithChildren num_children = do name <- genMaybe genName spindles <- arbitrary params <- arbitrary - uuid <- genName + uuid <- fmap UTF8.fromString genUUID serial <- arbitrary time <- arbitrary return . RealDisk $ @@ -370,7 +376,7 @@ instance Arbitrary FilterRule where <*> arbitrary <*> arbitrary <*> arbitrary - <*> genUUID + <*> fmap UTF8.fromString genUUID -- | Generates a network instance with minimum netmasks of /24. Generating -- bigger networks slows down the tests, because long bit strings are generated @@ -636,7 +642,8 @@ genNodeGroup = do serial <- arbitrary tags <- Set.fromList <$> genTags let group = NodeGroup name members ndparams alloc_policy ipolicy diskparams - net_map hv_state disk_state ctime mtime uuid serial tags + net_map hv_state disk_state ctime mtime (UTF8.fromString uuid) + serial tags return group instance Arbitrary NodeGroup where diff --git a/test/hs/Test/Ganeti/Query/Instance.hs b/test/hs/Test/Ganeti/Query/Instance.hs index 404843c..6a961c4 100644 --- a/test/hs/Test/Ganeti/Query/Instance.hs +++ b/test/hs/Test/Ganeti/Query/Instance.hs @@ -38,6 +38,7 @@ module Test.Ganeti.Query.Instance ( testQuery_Instance ) where +import qualified Data.ByteString.UTF8 as UTF8 import qualified Data.Map as Map import qualified Data.Set as Set import System.Time (ClockTime(..)) @@ -63,7 +64,7 @@ createInstance name pnodeUuid adminState adminStateSource = (PartialBeParams Nothing Nothing Nothing Nothing Nothing Nothing) (GenericContainer Map.empty) (GenericContainer Map.empty) adminState adminStateSource [] [] False Nothing epochTime epochTime - "" 0 Set.empty + (UTF8.fromString "") 0 Set.empty where epochTime = TOD 0 0 -- | A fake InstanceInfo to be used to check values. -- 2.6.0.rc2.230.g3dd15c0
