LGTM, thanks On Wed, 11 Nov 2015 at 17:27 'Klaus Aehlig' via ganeti-devel < [email protected]> wrote:
> 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 > > -- Helga Velroyen Software Engineer [email protected] Google Germany GmbH Dienerstraße 12 80331 München Geschäftsführer: Matthew Scott Sucherman, Paul Terence Manicle Registergericht und -nummer: Hamburg, HRB 86891 Sitz der Gesellschaft: Hamburg Diese E-Mail ist vertraulich. Wenn Sie nicht der richtige Adressat sind, leiten Sie diese bitte nicht weiter, informieren Sie den Absender und löschen Sie die E-Mail und alle Anhänge. Vielen Dank. This e-mail is confidential. If you are not the right addressee please do not forward it, please inform the sender, and please erase this e-mail including any attachments. Thanks.
