Merge pull request #10 from anchor/use-instance-status

Update Fold + Env to allow for filters for instance status

ceilometer-common.cabal

@@ -1,5 +1,5 @@
 name:                ceilometer-common
-version:             0.1.0
+version:             0.2.0
 synopsis:            Common Haskell types and encoding for ceilometer
 description:         Provides a set of common types for use with ceilometer related packages.
 homepage:            https://github.com/anchor/ceilometer-common
@@ -74,3 +74,4 @@ test-suite unit
                      , text >= 1.2
                      , transformers >= 0.3
                      , vaultaire-common >= 2.8.3
+                     , data-ordlist >= 0.4.7

lib/Ceilometer/Client.hs

@@ -47,7 +47,7 @@ decodeFold
   -> Producer SimplePoint m ()  -- ^ The raw data points to parse and aggregate.
   -> m (Maybe FoldResult)       -- ^ Result
 
-decodeFold env@(Env _ sd _ _) raw = do
+decodeFold env@(Env _ sd _ _ _) raw = do
   let x = do
         name <- lookupMetricName sd
 

lib/Ceilometer/Fold.hs

@@ -104,44 +104,56 @@ instance Known PDImagePollster where
 
 instance Known PDVolume where
   mkPrism _ = prCompoundEvent . pdVolume
-  mkFold (Env _ _ (TimeStamp s) (TimeStamp e))
+  mkFold (Env _ _ _ (TimeStamp s) (TimeStamp e))
     = after RSingle (foldVolume (s,e))
 
 instance Known PDSSD where
   mkPrism _  = prCompoundEvent . pdSSD
-  mkFold (Env _ _ (TimeStamp s) (TimeStamp e))
+  mkFold (Env _ _ _ (TimeStamp s) (TimeStamp e))
     = after RSingle (foldSSD (s,e))
 
 instance Known PDImage where
   mkPrism _  = prCompoundEvent . pdImage
-  mkFold (Env _ _ (TimeStamp s) (TimeStamp e))
+  mkFold (Env _ _ _ (TimeStamp s) (TimeStamp e))
     = after RSingle (foldImage (s,e))
 
 instance Known PDSnapshot where
   mkPrism _  = prCompoundEvent . pdSnapshot
-  mkFold (Env _ _ (TimeStamp s) (TimeStamp e))
+  mkFold (Env _ _ _ (TimeStamp s) (TimeStamp e))
     = after RSingle (foldSnapshot (s,e))
 
 instance Known PDIP where
   mkPrism _  = prCompoundEvent . pdIP
-  mkFold (Env _ _ (TimeStamp s) (TimeStamp e))
+  mkFold (Env _ _ _ (TimeStamp s) (TimeStamp e))
     = after RSingle (foldIP (s,e))
 
 instance Known PDInstanceVCPU where
-  mkPrism _ = prCompoundPollster . pdInstanceVCPU
-  mkFold  _ = after RMapNum32 (generalizeFold foldInstanceVCPU)
+  mkPrism _                = prCompoundPollster . pdInstanceVCPU
+  mkFold  (Env _ _  f _ _) = after RMapNum32
+                                   ( generalizeFold   $
+                                     foldInstanceVCPU $
+                                     filterByInstanceStatus f (\(PDInstanceVCPU s _) -> s))
 
 instance Known PDInstanceRAM where
-  mkPrism _ = prCompoundPollster . pdInstanceRAM
-  mkFold  _ = after RMapNum32 (generalizeFold foldInstanceRAM)
+  mkPrism _                = prCompoundPollster . pdInstanceRAM
+  mkFold  (Env _ _  f _ _) = after RMapNum32
+                                   ( generalizeFold  $
+                                     foldInstanceRAM $
+                                     filterByInstanceStatus f (\(PDInstanceRAM s _) -> s))
 
 instance Known PDInstanceDisk where
   mkPrism _ = prCompoundPollster . pdInstanceDisk
-  mkFold  _ = after RMapNum32 (generalizeFold foldInstanceDisk)
+  mkFold  (Env _ _  f _ _) = after RMapNum32
+                                   ( generalizeFold   $
+                                     foldInstanceDisk $
+                                     filterByInstanceStatus f (\(PDInstanceDisk s _) -> s))
 
 instance Known PDInstanceFlavor where
-  mkPrism (Env fm _ _ _) = prCompoundPollster . pdInstanceFlavor fm
-  mkFold _               = after RMapText (generalizeFold foldInstanceFlavor)
+  mkPrism (Env fm _ _ _ _) = prCompoundPollster . pdInstanceFlavor fm
+  mkFold  (Env _ _  f _ _) = after RMapText
+                                   ( generalizeFold   $
+                                     foldInstanceFlavor $
+                                     filterByInstanceStatus f (\(PDInstanceFlavor s _) -> s))
 
 
 -- Fold ------------------------------------------------------------------------
@@ -216,21 +228,24 @@ foldIP window = PFold step bEvent (eEvent window ipEventFolder)
         go end acc (Just x) = M.insertWith (+) (x ^. value) (end - x ^. time) acc
         go _   acc  Nothing = acc
 
-foldInstanceFlavor :: L.Fold (Timed PDInstanceFlavor) (Map PFValueText Word64)
-foldInstanceFlavor =  L.Fold sGaugePollster bGaugePollster snd
+foldInstanceFlavor   :: (PDInstanceFlavor -> Bool)
+                     -> L.Fold (Timed PDInstanceFlavor) (Map PFValueText Word64)
+foldInstanceFlavor f =  L.Fold (sGaugePollster f) bGaugePollster snd
 
-foldInstanceVCPU   :: L.Fold (Timed PDInstanceVCPU)   (Map PFValue32 Word64)
-foldInstanceVCPU   =  L.Fold sGaugePollster bGaugePollster snd
+foldInstanceVCPU     :: (PDInstanceVCPU -> Bool)
+                     -> L.Fold (Timed PDInstanceVCPU) (Map PFValue32 Word64)
+foldInstanceVCPU   f =  L.Fold (sGaugePollster f) bGaugePollster snd
 
-foldInstanceRAM    :: L.Fold (Timed PDInstanceRAM)    (Map PFValue32 Word64)
-foldInstanceRAM    =  L.Fold sGaugePollster bGaugePollster snd
+foldInstanceRAM      :: (PDInstanceRAM -> Bool)
+                     -> L.Fold (Timed PDInstanceRAM)    (Map PFValue32 Word64)
+foldInstanceRAM    f =  L.Fold (sGaugePollster f) bGaugePollster snd
 
-foldInstanceDisk   :: L.Fold (Timed PDInstanceDisk)   (Map PFValue32 Word64)
-foldInstanceDisk   =  L.Fold sGaugePollster bGaugePollster snd
+foldInstanceDisk     :: (PDInstanceDisk -> Bool)
+                     -> L.Fold (Timed PDInstanceDisk)   (Map PFValue32 Word64)
+foldInstanceDisk   f =  L.Fold (sGaugePollster f) bGaugePollster snd
 
 foldImagePollster  :: L.Fold (Timed PDImagePollster)  (Map PFValue64 Word64)
-foldImagePollster  =  L.Fold sGaugePollster bGaugePollster snd
-
+foldImagePollster  =  L.Fold (sGaugePollster $ const True) bGaugePollster snd
 
 -- Utilities -------------------------------------------------------------------
 
@@ -285,11 +300,15 @@ type AGaugePollster x = ( Maybe (Timed x)          -- latest
 -- | Finds the length of time allocated to each "state" of the resource.
 --   e.g. time a @Volume@ spent at 10GB, then at 20GB (if resized), etc.
 sGaugePollster :: (Valued x, Ord (PFValue x))
-          => AGaugePollster x -> Timed x -> AGaugePollster x
-sGaugePollster (Nothing,            acc) x =  (Just x, acc)
-sGaugePollster (Just (Timed t1 v1), acc) x@(Timed t2 _)
+          => (x -> Bool) -> AGaugePollster x -> Timed x -> AGaugePollster x
+sGaugePollster _          (Nothing,            acc) x =  (Just x, acc)
+sGaugePollster isBillable (Just (Timed t1 v1), acc) x@(Timed t2 _)
   = let delta = t2 - t1
-    in  (Just x, M.insertWith (+) (v1 ^. value) (fromIntegral delta) acc)
+        acc'  = if isBillable v1 then
+                    M.insertWith (+) (v1 ^. value) (fromIntegral delta) acc
+                else
+                    acc
+    in (Just x, acc')
 
 bGaugePollster = (Nothing, M.empty)
 

lib/Ceilometer/Types.hs

@@ -61,9 +61,10 @@ module Ceilometer.Types
   , Timed(Timed), time
 
     -- * Interface
-  , Env(..)
+  , Env(..), Filters(..)
   , Flavor, FlavorMap
   , siphashID
+  , filterByInstanceStatus
   ) where
 
 import           Control.Applicative
@@ -90,9 +91,16 @@ import           Vaultaire.Types
 --
 data Env = Env { _flavormap  :: FlavorMap
                , _sourcedict :: SourceDict
+               , _filters    :: Filters
                , _start      :: TimeStamp
                , _end        :: TimeStamp }
 
+data Filters = Filters {
+    instanceStatusFilter :: PFInstanceStatus -> Bool
+}
+
+filterByInstanceStatus :: Filters -> (a -> PFInstanceStatus) -> a -> Bool
+filterByInstanceStatus (Filters f) g = f . g
 
 --------------------------------------------------------------------------------
 

tests/Fold.hs

@@ -85,7 +85,10 @@ suite = do
   -- "Gauge Pollster" resources
   describe "Folding points for POLLSTER resource: INSTANCE FLAVOR" $
     it "ok for example payload"
-      $ L.fold foldInstanceFlavor flavorTimedPDs `shouldBe` M.fromList flavorTimedPDsResult
+      $ L.fold (foldInstanceFlavor $ const True) flavorTimedPDs `shouldBe` M.fromList flavorTimedPDsResult
+
+  describe "Filtering instance statuses" $
+      prop "is sane" propSafetyInstance
 
   describe "Folding points for POLLSTER resource: IMAGE POLLSTER" $
     it "ok for example payload"

tests/Prisms.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE RankNTypes #-}
 module Prisms where
 
-import           Control.Lens          hiding (elements)
+import           Control.Lens            hiding (elements)
 import           Control.Lens.Properties
 import           Test.Hspec
 import           Test.Hspec.QuickCheck

tests/SampleData.hs

@@ -1,6 +1,8 @@
 -- This module defines hard-coded sample data
 -- for parsing/printing and folding.
 --
+{-# LANGUAGE FlexibleInstances    #-}
+{-# LANGUAGE OverlappingInstances #-}
 {-# LANGUAGE OverloadedStrings    #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
@@ -10,16 +12,21 @@
 module SampleData where
 
 import           Control.Applicative
+import qualified Control.Foldl             as L
 import           Control.Lens              hiding (elements)
+import           Control.Monad
 import qualified Data.Bimap                as BM
 import           Data.Binary               (Word64)
 import           Data.Bits
+import           Data.List.Ordered
 import           Data.Map                  (Map)
 import qualified Data.Map                  as M
+import           Data.Maybe
 import           Data.Word
 import           Test.QuickCheck
 import           Test.QuickCheck.Function
 
+import           Ceilometer.Fold
 import           Ceilometer.Types
 import           Ceilometer.Types.Image    (imageVerb)
 import           Ceilometer.Types.Instance (siphashID)
@@ -51,6 +58,13 @@ instance Function PDInstanceRAM    where function = functionShow
 instance Function PDInstanceDisk   where function = functionShow
 instance Function PDInstanceFlavor where function = functionShow
 
+instance Arbitrary a => Arbitrary [Timed a] where
+  arbitrary = do
+    bigNumber <- choose (1, 10000)
+    let ts = [1..bigNumber]
+    vs <- replicateM (fromIntegral bigNumber) arbitrary
+    return $ zipWith Timed ts vs
+
 instance Arbitrary PRSimple        where
   arbitrary = PRSimple <$> arbitrary
 instance Arbitrary PRCompoundEvent where
@@ -193,6 +207,26 @@ flavorTimedPDsResult :: [(PFValue PDInstanceFlavor, Word64)]
 flavorTimedPDsResult = [ (flavorID1, 9)
                        , (flavorID2, 4) ]
 
+
+-- | Basic safety properties for filtered folding.
+--   The set of keys in the result of the filtered fold should be a subset of
+--   the result of the non-filtered fold.
+--   For each defined key in the filtered result, the corresponding value
+--   should be no larger than in the non-filtered result.
+propSafetyInstance :: [Timed PDInstanceFlavor] -> Bool
+propSafetyInstance x =
+    let testPred (PDInstanceFlavor InstanceActive _) = True
+        testPred _                                   = False
+        fullResult     = L.fold (foldInstanceFlavor (const True)) x
+        filteredResult = L.fold (foldInstanceFlavor testPred    ) x
+        fullKeys       = M.keys fullResult
+        filteredKeys   = M.keys filteredResult
+    in  subset filteredKeys fullKeys &&
+        all (\k -> isJust $ do
+                v  <- M.lookup k fullResult
+                v' <- M.lookup k filteredResult
+                return $ v' <= v) filteredKeys
+
 -- CPU -------------------------------------------------------------------------
 
 cumulativeIncreasing = [30, 40, 50, 60]