ceilometer-common (empty) → 0.2.2
raw patch · 18 files changed
+1628/−0 lines, 18 filesdep +QuickCheckdep +basedep +bimapsetup-changed
Dependencies added: QuickCheck, base, bimap, binary, bytestring, containers, data-ordlist, foldl, hspec, lens, lens-properties, mtl, pipes, siphash, template-haskell, text, transformers, vaultaire-common
Files
- LICENSE +30/−0
- Setup.hs +2/−0
- ceilometer-common.cabal +76/−0
- lib/Ceilometer/Client.hs +141/−0
- lib/Ceilometer/Fold.hs +351/−0
- lib/Ceilometer/Tags.hs +50/−0
- lib/Ceilometer/Types.hs +185/−0
- lib/Ceilometer/Types/Base.hs +125/−0
- lib/Ceilometer/Types/CPU.hs +24/−0
- lib/Ceilometer/Types/Disk.hs +31/−0
- lib/Ceilometer/Types/IP.hs +78/−0
- lib/Ceilometer/Types/Image.hs +81/−0
- lib/Ceilometer/Types/Instance.hs +131/−0
- lib/Ceilometer/Types/Neutron.hs +31/−0
- lib/Ceilometer/Types/Snapshot.hs +70/−0
- lib/Ceilometer/Types/TH.hs +111/−0
- lib/Ceilometer/Types/Volume.hs +103/−0
- tests/Main.hs +8/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2015, Anchor Engineering++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Anchor Engineering nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ ceilometer-common.cabal view
@@ -0,0 +1,76 @@+name: ceilometer-common+version: 0.2.2+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+license: BSD3+license-file: LICENSE+author: Anchor Engineering <engineering@anchor.com.au>+maintainer: Anchor Engineering <engineering@anchor.com.au>+copyright: © 2015 Anchor Systems, Pty Ltd and Others+category: Development+build-type: Simple+cabal-version: >=1.18++source-repository head+ type: git+ location: git@github.com:anchor/ceilometer-common.git++library+ exposed-modules: Ceilometer.Types+ Ceilometer.Fold+ Ceilometer.Client+ Ceilometer.Tags++ other-modules: Ceilometer.Types.TH+ Ceilometer.Types.Base+ Ceilometer.Types.CPU+ Ceilometer.Types.Disk+ Ceilometer.Types.Volume+ Ceilometer.Types.Image+ Ceilometer.Types.Instance+ Ceilometer.Types.IP+ Ceilometer.Types.Neutron+ Ceilometer.Types.Snapshot++ build-depends: base >=4.7 && < 5+ , bimap >= 0.2+ , binary >= 0.7+ , bytestring >= 0.10+ , containers >= 0.5+ , foldl >= 1.0+ , lens >= 4.7+ , pipes >= 4.1+ , siphash >= 1.0+ , template-haskell >= 2.9+ , text >= 1.2+ , vaultaire-common >= 2.8.3++ hs-source-dirs: lib+ default-language: Haskell2010++test-suite unit+ type: exitcode-stdio-1.0+ default-language: Haskell2010+ hs-source-dirs: tests,lib++ main-is: Main.hs++ build-depends: base >=4.7 && < 5+ , QuickCheck >= 2.7+ , bimap >= 0.2+ , binary >= 0.7+ , bytestring >= 0.10+ , containers >= 0.5+ , foldl >= 1.0+ , hspec >= 2.1+ , lens >= 4.7+ , lens-properties >= 4.7+ , mtl >= 2.1+ , pipes >= 4.1+ , siphash >= 1.0+ , template-haskell >= 2.9+ , text >= 1.2+ , transformers >= 0.3+ , vaultaire-common >= 2.8.3+ , data-ordlist >= 0.4.7
+ lib/Ceilometer/Client.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+--+-- This module defines a convienient interface for clients+-- of Ceilometer.+--+-- For flexibility use the Collector and Fold modules.+--+module Ceilometer.Client+ ( -- * Interface+ decodeFold+ , decodeFold_++ -- * Re-exports+ , module C+ ) where++import Control.Applicative+import Control.Foldl+import Control.Lens+import Control.Monad+import qualified Data.Traversable as T+import Pipes+import qualified Pipes.Prelude as P++import Ceilometer.Fold as C+import Ceilometer.Tags+import Ceilometer.Types as C+import Vaultaire.Types+++decodeFold+ :: (Monad m, Applicative m)+ => Env -- ^ @SourceDict@ to infer the resource type.+ -> Producer SimplePoint m () -- ^ The raw data points to parse and aggregate.+ -> m (Maybe FoldResult) -- ^ Result++decodeFold env@(Env _ sd _ _ _) raw = do+ let x = do+ name <- lookupMetricName sd++ if | name == valCPU+ -> return (decodeFold_ (undefined :: proxy PDCPU) env raw)++ | name == valDiskReads+ -> return (decodeFold_ (undefined :: proxy PDDiskRead) env raw)++ | name == valDiskWrites+ -> return (decodeFold_ (undefined :: proxy PDDiskWrite) env raw)++ | name == valNeutronIn+ -> return (decodeFold_ (undefined :: proxy PDNeutronRx) env raw)++ | name == valNeutronOut+ -> return (decodeFold_ (undefined :: proxy PDNeutronTx) env raw)++ | name == valVolume -> do+ voltype <- lookupVolumeType sd++ if | voltype == valVolumeBlock+ -> return (decodeFold_ (undefined :: proxy PDVolume) env raw)++ | voltype == valVolumeFast+ -> return (decodeFold_ (undefined :: proxy PDSSD) env raw)++ | otherwise -> mzero++ | name == valInstanceFlavor -> do+ compound <- lookupCompound sd+ event <- lookupEvent sd++ if | compound == valTrue && event == valFalse+ -> return (decodeFold_ (undefined :: proxy PDInstanceFlavor) env raw)++ | otherwise -> mzero++ | name == valInstanceVCPU+ -> return (decodeFold_ (undefined :: proxy PDInstanceVCPU) env raw)++ | name == valInstanceRAM+ -> return (decodeFold_ (undefined :: proxy PDInstanceRAM) env raw)++ | name == valImage ->+ if | isEvent sd+ -> return (decodeFold_ (undefined :: proxy PDImage) env raw)+ | otherwise+ -> return (decodeFold_ (undefined :: proxy PDImagePollster) env raw)++ | name == valSnapshot+ -> return (decodeFold_ (undefined :: proxy PDSnapshot) env raw)++ | name == valIP+ -> return (decodeFold_ (undefined :: proxy PDIP) env raw)++ | otherwise -> mzero+ T.sequence x++decodeFold_+ :: forall proxy a m . (Known a, Applicative m, Monad m)+ => proxy a+ -> Env+ -> Producer SimplePoint m ()+ -> m FoldResult+decodeFold_ _ env raw+ = foldDecoded env (raw >-> (decode env :: Pipe SimplePoint (Maybe (Timed a)) m ()) >-> blowup)++decode+ :: (Known a, Monad m)+ => Env+ -> Pipe SimplePoint (Maybe (Timed a)) m ()+decode env = forever $ do+ SimplePoint _ (TimeStamp t) v <- await+ yield $ T.sequence $ Timed t $ v ^? clonePrism (mkPrism env)++foldDecoded+ :: (Known a, Monad m)+ => Env+ -> Producer (Timed a) m ()+ -> m FoldResult+foldDecoded env = impurely P.foldM (generalize $ mkFold env)++-- | Abort the entire pipeline when encoutering malformed data in the Vault.+--+blowup :: Monad m => Pipe (Maybe x) x m r+blowup = forever $ do+ x <- await+ maybe (error "fatal: unparseable point") yield x
+ lib/Ceilometer/Fold.hs view
@@ -0,0 +1,351 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines folding methods for Ceilometer types,+-- to be used by clients such as Borel.+--++{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE BangPatterns #-}++{-# OPTIONS -fno-warn-missing-signatures #-}++module Ceilometer.Fold+ ( -- * Generic folds (and Decode)+ Known(..)+ , FoldResult(..)++ -- * Low-level folds+ , foldCPU+ , foldDiskRead+ , foldDiskWrite+ , foldNeutronRx+ , foldNeutronTx+ , foldVolume+ , foldSSD+ , foldImage+ , foldImagePollster+ , foldInstanceFlavor+ , foldInstanceVCPU+ , foldInstanceRAM+ , foldInstanceDisk+ , foldIP+ , foldSnapshot+ -- * Utilities+ , timewrapFold+ ) where+++import qualified Control.Foldl as L+import Control.Lens hiding (Fold, Simple)+import Data.Map.Strict (Map)+import qualified Data.Map.Strict as M+import Data.Word++import Ceilometer.Types+import Vaultaire.Types+++--------------------------------------------------------------------------------++-- | A universial wrapper of fold results to expose to the user.+--+-- For simplicity, it's not associated with the @Known@ class. If the need to do+-- that arises, use Typeable and Constraint tricks to pattern match.+--+data FoldResult+ = RSingle !Word64+ | RMapNum32 !(Map PFValue32 Word64)+ | RMapNum64 !(Map PFValue64 Word64)+ | RMapText !(Map PFValueText Word64)++-- | An OpenStack measured known to Ceilometer. We can determine how to decode+-- and aggregate Vaultaire data for it.+--+class Known a where+ mkPrism :: Env -> APrism' Word64 a+ mkFold :: Env -> L.Fold (Timed a) FoldResult++instance Known PDCPU where+ mkPrism _ = prSimple . pdCPU+ mkFold _ = fmap RSingle (timewrapFold foldCPU)++instance Known PDDiskRead where+ mkPrism _ = prSimple . pdDiskRead+ mkFold _ = fmap RSingle (timewrapFold foldDiskRead)++instance Known PDDiskWrite where+ mkPrism _ = prSimple . pdDiskWrite+ mkFold _ = fmap RSingle (timewrapFold foldDiskWrite)++instance Known PDNeutronTx where+ mkPrism _ = prSimple . pdNeutronTx+ mkFold _ = fmap RSingle (timewrapFold foldNeutronTx)++instance Known PDNeutronRx where+ mkPrism _ = prSimple . pdNeutronRx+ mkFold _ = fmap RSingle (timewrapFold foldNeutronRx)++instance Known PDImagePollster where+ mkPrism _ = prSimple . pdImagePollster+ mkFold _ = fmap RMapNum64 foldImagePollster++instance Known PDVolume where+ mkPrism _ = prCompoundEvent . pdVolume+ mkFold (Env _ _ _ (TimeStamp s) (TimeStamp e))+ = fmap RSingle (foldVolume (s,e))++instance Known PDSSD where+ mkPrism _ = prCompoundEvent . pdSSD+ mkFold (Env _ _ _ (TimeStamp s) (TimeStamp e))+ = fmap RSingle (foldSSD (s,e))++instance Known PDImage where+ mkPrism _ = prCompoundEvent . pdImage+ mkFold (Env _ _ _ (TimeStamp s) (TimeStamp e))+ = fmap RSingle (foldImage (s,e))++instance Known PDSnapshot where+ mkPrism _ = prCompoundEvent . pdSnapshot+ mkFold (Env _ _ _ (TimeStamp s) (TimeStamp e))+ = fmap RSingle (foldSnapshot (s,e))++instance Known PDIP where+ mkPrism _ = prCompoundEvent . pdIP+ mkFold (Env _ _ _ (TimeStamp s) (TimeStamp e))+ = fmap RSingle (foldIP (s,e))++instance Known PDInstanceVCPU where+ mkPrism _ = prCompoundPollster . pdInstanceVCPU+ mkFold (Env _ _ f _ _) = fmap RMapNum32+ $ foldInstanceVCPU+ $ filterByInstanceStatus f (\(PDInstanceVCPU s _) -> s)++instance Known PDInstanceRAM where+ mkPrism _ = prCompoundPollster . pdInstanceRAM+ mkFold (Env _ _ f _ _) = fmap RMapNum32+ $ foldInstanceRAM + $ filterByInstanceStatus f (\(PDInstanceRAM s _) -> s)++instance Known PDInstanceDisk where+ mkPrism _ = prCompoundPollster . pdInstanceDisk+ mkFold (Env _ _ f _ _) = fmap RMapNum32+ $ foldInstanceDisk + $ filterByInstanceStatus f (\(PDInstanceDisk s _) -> s)++instance Known PDInstanceFlavor where+ mkPrism (Env fm _ _ _ _) = prCompoundPollster . pdInstanceFlavor fm+ mkFold (Env _ _ f _ _) = fmap RMapText+ $ foldInstanceFlavor + $ filterByInstanceStatus f (\(PDInstanceFlavor s _) -> s)+++-- Fold ------------------------------------------------------------------------+++foldCPU :: L.Fold PDCPU Word64+foldCPU = L.Fold sCumulative bCumulative eCumulative+{-# INLINE foldCPU #-}++foldDiskRead :: L.Fold PDDiskRead Word64+foldDiskRead = L.Fold sCumulative bCumulative eCumulative+{-# INLINE foldDiskRead #-}++foldDiskWrite :: L.Fold PDDiskWrite Word64+foldDiskWrite = L.Fold sCumulative bCumulative eCumulative+{-# INLINE foldDiskWrite #-}++foldNeutronTx :: L.Fold PDNeutronTx Word64+foldNeutronTx = L.Fold sCumulative bCumulative eCumulative+{-# INLINE foldNeutronTx #-}++foldNeutronRx :: L.Fold PDNeutronRx Word64+foldNeutronRx = L.Fold sCumulative bCumulative eCumulative+{-# INLINE foldNeutronRx #-}++foldVolume :: Window -> L.Fold (Timed PDVolume) Word64+foldVolume window = L.Fold step bEvent (eEvent window standardEventFolder)+ where step (prev, acc) (Timed end (PDVolume _ VolumeDelete _ _)) = (Nothing, go end acc prev)+ step a x = sEvent window a x+ -- adds until delete+ go end acc (Just x) = insertVal x (end - x ^. time) acc+ go _ acc Nothing = acc+{-# INLINE foldVolume #-}++foldSSD :: Window -> L.Fold (Timed PDSSD) Word64+foldSSD window = L.Fold step bEvent (eEvent window standardEventFolder)+ where step (prev, acc) (Timed end (PDSSD _ VolumeDelete _ _)) = (Nothing, go end acc prev)+ step a x = sEvent window a x+ -- adds until delete+ go end acc (Just x) = insertVal x (end - x ^. time) acc+ go _ acc Nothing = acc+{-# INLINE foldSSD #-}++foldImage :: Window -> L.Fold (Timed PDImage) Word64+foldImage window = L.Fold step bEvent (eEvent window standardEventFolder)+ where step (prev, acc) (Timed end (PDImage _ ImageDelete _ _)) = (Nothing, go end acc prev)+ step a x = sEvent window a x+ -- adds until delete+ go end acc (Just x) = insertVal x (end - x ^. time) acc+ go _ acc Nothing = acc+{-# INLINE foldImage #-}++foldSnapshot :: Window -> L.Fold (Timed PDSnapshot) Word64+foldSnapshot window = L.Fold step bEvent (eEvent window standardEventFolder)+ where step (prev, acc) (Timed end (PDSnapshot _ SnapshotDelete _ _)) = (Nothing, go end acc prev)+ step a x = sEvent window a x+ -- adds until delete+ go end acc (Just x) = insertVal x (end - x ^. time) acc+ go _ acc Nothing = acc+{-# INLINE foldSnapshot #-}++foldIP :: Window -> L.Fold (Timed PDIP) Word64+foldIP window = L.Fold step bEvent (eEvent window ipEventFolder)+ where step (prev, acc) (Timed end (PDIP _ IPDelete _ _)) = (Nothing, go end acc prev)+ step a x = sEvent window a x+ -- adds until delete+ go end acc (Just x) = insertVal x (end - x ^. time) acc+ go _ acc Nothing = acc+{-# INLINE foldIP #-}++foldInstanceFlavor :: (PDInstanceFlavor -> Bool)+ -> L.Fold (Timed PDInstanceFlavor) (Map PFValueText Word64)+foldInstanceFlavor f = L.Fold (sGaugePollster f) bGaugePollster snd+{-# INLINE foldInstanceFlavor #-}++foldInstanceVCPU :: (PDInstanceVCPU -> Bool)+ -> L.Fold (Timed PDInstanceVCPU) (Map PFValue32 Word64)+foldInstanceVCPU f = L.Fold (sGaugePollster f) bGaugePollster snd+{-# INLINE foldInstanceVCPU #-}++foldInstanceRAM :: (PDInstanceRAM -> Bool)+ -> L.Fold (Timed PDInstanceRAM) (Map PFValue32 Word64)+foldInstanceRAM f = L.Fold (sGaugePollster f) bGaugePollster snd+{-# INLINE foldInstanceRAM #-}++foldInstanceDisk :: (PDInstanceDisk -> Bool)+ -> L.Fold (Timed PDInstanceDisk) (Map PFValue32 Word64)+foldInstanceDisk f = L.Fold (sGaugePollster f) bGaugePollster snd+{-# INLINE foldInstanceDisk #-}++foldImagePollster :: L.Fold (Timed PDImagePollster) (Map PFValue64 Word64)+foldImagePollster = L.Fold (sGaugePollster $ const True) bGaugePollster snd+{-# INLINE foldImagePollster #-}+++-- Utilities -------------------------------------------------------------------++-- | Wrap a fold that doens't depend on time.+--+-- +timewrapFold :: L.Fold x y -> L.Fold (Timed x) y+timewrapFold (L.Fold s b e) = L.Fold (\a (Timed _ x) -> s a x) b e+{-# INLINE timewrapFold #-}+++-- Common Steps ----------------------------------------------------------------++-- The above folds are built from these common fold steps++type Window = (Word64, Word64)+insertVal x = M.insertWith (+) (x ^. value)+{-# INLINE insertVal #-}+++--------------------------------------------------------------------------------++-- | Openstack cumulative data is from last startup.+-- So when we process cumulative data we need to account for this.+-- Since (excluding restarts) each point is strictly non-decreasing,+-- we simply use a modified fold to deal with the case where the latest point+-- is less than the second latest point (indicating a restart)+--+-- note: copied from vaultaire-query+--+type ACumulative x = ( Maybe ( PFValue x -- first+ , PFValue x) -- latest+ , Word64 ) -- sum++sCumulative :: (Valued x, Ord (PFValue x), Integral (PFValue x))+ => ACumulative x -> x -> ACumulative x+sCumulative (Nothing, acc) x | v <- x ^. value = (Just (v, v), acc)+sCumulative (Just (f, latest), acc) x | v <- x ^. value =+ if v < latest+ then (Just (f, v), acc + fromIntegral latest)+ else (Just (f, v), acc)+{-# INLINE sCumulative #-}++bCumulative = (Nothing, 0)+{-# INLINE bCumulative #-}++eCumulative (Just (first, latest), acc) = acc + latest - first+eCumulative (_, acc) = acc+{-# INLINE eCumulative #-}++--------------------------------------------------------------------------------+++type AGaugePollster x = ( Maybe (Timed x) -- latest+ , Map (PFValue x) Word64 ) -- accumulated map++-- | 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))+ => (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+ !acc' = if isBillable v1+ then insertVal v1 (fromIntegral delta) acc+ else acc+ in (Just x, acc')+{-# INLINE sGaugePollster #-}++bGaugePollster = (Nothing, M.empty)+{-# INLINE bGaugePollster #-}++--------------------------------------------------------------------------------++type AEvent x = ( Maybe (Timed x) -- latest+ , Map (PFValue x) Word64 ) -- accumulated map++bEvent = (Nothing, M.empty)+{-# INLINE bEvent #-}++-- | Time-lapse for each value from a stream of events.+--+sEvent :: (Valued x, Ord (PFValue x), Show (PFValue x))+ => Window -> AEvent x -> Timed x -> AEvent x+sEvent _ (Nothing, acc) x = (Just x, acc)+sEvent (start, end) (Just prev, acc) x+ = if | prev ^. time > end -> (Nothing, acc) -- last step went past the end of the window+ | prev ^. time < start -> (Just x, acc) -- last step hasn't gone in the window+ | d <= 0 -> (Nothing, acc) -- this step went past the window+ | otherwise -> (Just x, insertVal prev d acc)+ where s = max start (prev ^. time)+ e = min end (x ^. time)+ d = e - s+{-# INLINE sEvent #-}++eEvent (start, end) f = M.foldlWithKey f 0 . go+ where s x = max start (x ^. time)+ -- deal with the dangling last event+ go (Just x, acc)+ | d <- end - s x, d > 0 = insertVal x d acc+ go a@_ = snd a+{-# INLINE eEvent #-}++standardEventFolder a k v = a + (fromIntegral k * v)+ipEventFolder a _ v = a + v+
+ lib/Ceilometer/Tags.hs view
@@ -0,0 +1,50 @@+-- | Copyright 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines the hard-coded tags and values used by the+-- Ceilometer collector as well as clients of Ceilometer.+--+{-# OPTIONS -fno-warn-missing-signatures #-}++module Ceilometer.Tags where++import Data.Maybe+import Data.Text+import Vaultaire.Types++keyMetricName = pack "metric_name"+keyTenancyID = pack "project_id"+keyResourceID = pack "resource_id"+keyEvent = pack "_event"+keyCompound = pack "_compound"+keyVolumeType = pack "volume_type"++valTrue = pack "1"+valFalse = pack "0"++valCPU = pack "cpu"+valDiskWrites = pack "disk.write.bytes"+valDiskReads = pack "disk.read.bytes"+valIP = pack "ip.floating"+valImage = pack "image.size"+valInstanceFlavor = pack "instance_flavor"+valInstanceRAM = pack "instance_ram"+valInstanceVCPU = pack "instance_vcpus"+valNeutronIn = pack "network.incoming.bytes"+valNeutronOut = pack "network.outgoing.bytes"+valSnapshot = pack "snapshot.size"+valVolume = pack "volume.size"++valVolumeBlock = pack "7a522201-7c27-4eaa-9d95-d70cfaaeb16a"+valVolumeFast = pack "f7797fba-2ce2-4d19-a607-29f4bc2acb3f"++lookupMetricName = lookupSource keyMetricName+lookupEvent = lookupSource keyEvent+lookupVolumeType = lookupSource keyVolumeType+lookupCompound = lookupSource keyCompound+isEvent = maybe False (== valTrue) . lookupEvent
+ lib/Ceilometer/Types.hs view
@@ -0,0 +1,185 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module exports the public-facing Ceilometer types+-- and the interface for them.+--+{-# LANGUAGE DeriveFoldable #-}+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE DeriveTraversable #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}++{-# OPTIONS -fno-warn-unused-binds #-}++module Ceilometer.Types+ ( -- * Payload Raws+ PRSimple(PRSimple), prSimple+ , PRCompoundEvent(PRCompoundEvent), prCompoundEvent+ , PRCompoundPollster(PRCompoundPollster), prCompoundPollster++ -- * Payload Decoded Fields+ , PFValue, PFValue64, PFValue32, PFValueText+ , PFEndpoint(..), pfEndpoint+ , PFVolumeStatus(..), pfVolumeStatus+ , PFVolumeVerb(..), pfVolumeVerb+ , PFInstanceStatus(..), pfInstanceStatus+ , PFImageStatus(..), pfImageStatus+ , PFImageVerb(..), pfImageVerb+ , PFSnapshotStatus(..), pfSnapshotStatus+ , PFSnapshotVerb(..), pfSnapshotVerb+ , PFIPStatus(..), pfIPStatus+ , PFIPVerb(..), pfIPVerb+ , PFIPAlloc(..), pfIPAlloc++ -- * Payload Decoded Points+ , PDVolume(PDVolume), pdVolume+ , PDSSD(PDSSD), pdSSD+ , PDCPU(PDCPU), pdCPU+ , PDDiskRead(..), pdDiskRead+ , PDDiskWrite(..), pdDiskWrite+ , PDNeutronTx(..), pdNeutronTx+ , PDNeutronRx(..), pdNeutronRx+ , PDInstanceVCPU(PDInstanceVCPU), pdInstanceVCPU+ , PDInstanceRAM(PDInstanceRAM), pdInstanceRAM+ , PDInstanceDisk(PDInstanceDisk), pdInstanceDisk+ , PDInstanceFlavor(PDInstanceFlavor), pdInstanceFlavor+ , PDImage(PDImage), pdImage+ , PDImagePollster(PDImagePollster), pdImagePollster+ , PDSnapshot(PDSnapshot), pdSnapshot+ , PDIP(PDIP), pdIP++ -- * Values+ , Valued, value+ , Timed(Timed), time++ -- * Interface+ , Env(..), Filters(..)+ , Flavor, FlavorMap+ , siphashID+ , filterByInstanceStatus+ ) where++import Control.Applicative+import Control.Lens hiding (Fold, Simple)+import Data.Binary (Word64)+import Data.Foldable++import Ceilometer.Types.Base+import Ceilometer.Types.CPU+import Ceilometer.Types.Disk+import Ceilometer.Types.Image+import Ceilometer.Types.Instance+import Ceilometer.Types.IP+import Ceilometer.Types.Neutron+import Ceilometer.Types.Snapshot+import Ceilometer.Types.Volume+import Vaultaire.Types+++--------------------------------------------------------------------------------++-- | Information needed to parse/fold Ceilometer types, supplied by users.+--+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++--------------------------------------------------------------------------------++-- | Values with a TimeStamp.+--+data Timed value = Timed { _time :: !Word64, _val :: value }+ deriving (Show, Functor, Foldable, Traversable)++makeLenses ''Timed++-- | A family of lens that allows viewing/updating the payload value of decoded+-- Ceilometer points.+--+-- note: this is a Lens and not just a Getter since we wish to reuse the logic+-- for collector (making the points) and user (reading the points).+--+class Valued a where+ type PFValue a+ value :: Lens' a (PFValue a)++instance Valued a => Valued (Timed a) where+ type PFValue (Timed a) = PFValue a+ value f (Timed t x) = Timed t <$> value f x++instance Valued PDCPU where+ type PFValue PDCPU = PFValue64+ value f (PDCPU x) = PDCPU <$> f x++instance Valued PDDiskRead where+ type PFValue PDDiskRead = PFValue64+ value f (PDDiskRead x) = PDDiskRead <$> f x++instance Valued PDDiskWrite where+ type PFValue PDDiskWrite = PFValue64+ value f (PDDiskWrite x) = PDDiskWrite <$> f x++instance Valued PDNeutronTx where+ type PFValue PDNeutronTx = PFValue64+ value f (PDNeutronTx x) = PDNeutronTx <$> f x++instance Valued PDNeutronRx where+ type PFValue PDNeutronRx = PFValue64+ value f (PDNeutronRx x) = PDNeutronRx <$> f x++instance Valued PDVolume where+ type PFValue PDVolume = PFValue32+ value f (PDVolume a b c x) = PDVolume a b c <$> f x++instance Valued PDSSD where+ type PFValue PDSSD = PFValue32+ value f (PDSSD a b c x) = PDSSD a b c <$> f x++instance Valued PDInstanceFlavor where+ type PFValue PDInstanceFlavor = PFValueText+ value f (PDInstanceFlavor s x) = PDInstanceFlavor s <$> f x++instance Valued PDInstanceVCPU where+ type PFValue PDInstanceVCPU = PFValue32+ value f (PDInstanceVCPU s x) = PDInstanceVCPU s <$> f x++instance Valued PDInstanceRAM where+ type PFValue PDInstanceRAM = PFValue32+ value f (PDInstanceRAM s x) = PDInstanceRAM s <$> f x++instance Valued PDInstanceDisk where+ type PFValue PDInstanceDisk = PFValue32+ value f (PDInstanceDisk s x) = PDInstanceDisk s <$> f x++instance Valued PDImage where+ type PFValue PDImage = PFValue32+ value f (PDImage s v e x) = PDImage s v e <$> f x++instance Valued PDImagePollster where+ type PFValue PDImagePollster = PFValue64+ value f (PDImagePollster x) = PDImagePollster <$> f x++instance Valued PDSnapshot where+ type PFValue PDSnapshot = PFValue32+ value f (PDSnapshot a b c x) = PDSnapshot a b c <$> f x++instance Valued PDIP where+ type PFValue PDIP = PFIPAlloc+ value f (PDIP a b c x) = PDIP a b c <$> f x
+ lib/Ceilometer/Types/Base.hs view
@@ -0,0 +1,125 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- Common Ceilometer field types.+--+{-# LANGUAGE TemplateHaskell #-}++module Ceilometer.Types.Base+ ( -- * Payload Raws+ PRSimple(..), prSimple+ , PRCompoundEvent(..), prCompoundEvent+ , eventVal, eventEndpoint, eventVerb, eventStatus+ , PRCompoundPollster(..), prCompoundPollster+ , pollsterVal, pollsterStatus++ -- * Decoded Payload Fields (common)+ , PFEndpoint(..), pfEndpoint+ , PFValue64, PFValue32, PFValueString, PFValueText++ -- * Instance Flavour Config+ , Flavor, FlavorMap+ ) where++import Control.Lens hiding (Fold, Simple)+import Data.Bimap (Bimap)+import Data.Binary (Word32, Word64, Word8)+import qualified Data.Binary as B+import qualified Data.Binary.Get as B+import qualified Data.Binary.Put as B+import Data.Text (Text)++import Ceilometer.Types.TH++type Flavor = Text+type FlavorMap = Bimap Flavor Word32++-- Raw Payload Types -----------------------------------------------------------++-- | Payload Raw Simple+newtype PRSimple = PRSimple { _prSimpleVal :: Word64 }+ deriving (Show, Read, Eq)++prSimple :: Iso' Word64 PRSimple+prSimple = iso PRSimple _prSimpleVal++-- | Payload Raw Compound Event+--+data PRCompoundEvent = PRCompoundEvent+ { _eventVal :: {-# UNPACK #-} !Word32 -- ^ Payload+ , _eventEndpoint :: {-# UNPACK #-} !Word8 -- ^ PFEndpoint+ , _eventVerb :: {-# UNPACK #-} !Word8 -- ^ Verb+ , _eventStatus :: {-# UNPACK #-} !Word8 -- ^ Status+ } deriving (Show, Eq)++makeLenses ''PRCompoundEvent++-- | An "improper" iso to convert between a Word64 and the raw compound.+--+-- It is improper because the reserved 8 bytes are ignored on parsing/printing.+-- So it doesn't satisfy a "roundtrip" between the serialised Word64 and the+-- decoded Compound raw. This is fine since we don't care about the reserved bytes.+--+prCompoundEvent :: Iso' Word64 PRCompoundEvent+prCompoundEvent = iso getIt putIt+ where getIt bytes = flip B.runGet (B.encode bytes) $ do+ a <- B.getWord32be+ _ <- B.getWord8 -- reserved bytes+ c <- B.getWord8+ d <- B.getWord8+ e <- B.getWord8+ return $ PRCompoundEvent a c d e+ putIt x = B.decode $ B.runPut $ do+ B.putWord32be $ x ^. eventVal+ B.putWord8 0+ B.putWord8 $ x ^. eventEndpoint+ B.putWord8 $ x ^. eventVerb+ B.putWord8 $ x ^. eventStatus++data PRCompoundPollster = PRCompoundPollster+ { _pollsterVal :: {-# UNPACK #-} !Word32 -- ^ Payload+ , _pollsterStatus :: {-# UNPACK #-} !Word8+ } deriving (Eq, Show)++makeLenses ''PRCompoundPollster++-- | An "improper" iso to convert between a Word64 and the raw compound.+--+-- It is improper because we only preserve the value and status in a "roundtrip".+-- This is fine for pollster since that's all we care about.+--+prCompoundPollster :: Iso' Word64 PRCompoundPollster+prCompoundPollster = iso getIt putIt+ where getIt bytes = flip B.runGet (B.encode bytes) $ do+ a <- B.getWord32be+ _ <- B.getWord8 -- reserved bytes+ _ <- B.getWord8 -- endpoint+ _ <- B.getWord8 -- verb+ e <- B.getWord8+ return $ PRCompoundPollster a e+ putIt x = B.decode $ B.runPut $ do+ B.putWord32be $ x ^. pollsterVal+ B.putWord8 0+ B.putWord8 0+ B.putWord8 0+ B.putWord8 $ x ^. pollsterStatus+++-- Decoded Payload Fields ------------------------------------------------------++type PFValue64 = Word64+type PFValue32 = Word32+type PFValueString = String+type PFValueText = Text++$(declarePF "" ("Endpoint", ''Word8)+ [ ("Instant", 0)+ , ("Start", 1)+ , ("End", 2) ]+ [ ''Show, ''Read, ''Eq, ''Bounded, ''Enum ])
+ lib/Ceilometer/Types/CPU.hs view
@@ -0,0 +1,24 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines the Ceilometer CPU type.++module Ceilometer.Types.CPU+ ( PDCPU(..), pdCPU+ ) where++import Control.Lens++import Ceilometer.Types.Base++newtype PDCPU = PDCPU { _pdCPUVal :: PFValue64 }+ deriving (Show, Read, Eq)++pdCPU :: Iso' PRSimple PDCPU+pdCPU = iso (PDCPU . _prSimpleVal) (PRSimple . _pdCPUVal)
+ lib/Ceilometer/Types/Disk.hs view
@@ -0,0 +1,31 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines the Ceilometer Disk Traffic type.++module Ceilometer.Types.Disk+ ( PDDiskRead(..), pdDiskRead+ , PDDiskWrite(..), pdDiskWrite+ ) where++import Control.Lens++import Ceilometer.Types.Base++newtype PDDiskRead = PDDiskRead { _pdDiskReadVal :: PFValue64 }+ deriving (Show, Read, Eq)++newtype PDDiskWrite = PDDiskWrite { _pdDiskWriteVal :: PFValue64 }+ deriving (Show, Read, Eq)++pdDiskRead :: Iso' PRSimple PDDiskRead+pdDiskRead = iso (PDDiskRead . _prSimpleVal) (PRSimple . _pdDiskReadVal)++pdDiskWrite :: Iso' PRSimple PDDiskWrite+pdDiskWrite = iso (PDDiskWrite . _prSimpleVal) (PRSimple . _pdDiskWriteVal)
+ lib/Ceilometer/Types/IP.hs view
@@ -0,0 +1,78 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines the Ceilometer IP type.+--+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Ceilometer.Types.IP+ ( -- * Fields+ PFIPStatus(..), pfIPStatus+ , PFIPVerb(..), pfIPVerb+ , PFIPAlloc(..), pfIPAlloc+ , PDIP(..), pdIP+ , ipStatus, ipVerb, ipEndpoint, ipVal+ ) where++import Control.Applicative+import Control.Lens+import Data.Binary (Word32, Word8)+import Data.Text (Text)++import Ceilometer.Types.Base+import Ceilometer.Types.TH+import Vaultaire.Types+++$(declarePF "IP"+ ("Status", ''Word8)+ [ ("None" , 0)+ , ("Active" , 1)+ , ("Down" , 2) ]+ [ ''Show, ''Read, ''Eq, ''Bounded, ''Enum ])++$(declarePF "IP"+ ("Verb", ''Word8)+ [ ("Create" , 1)+ , ("Update" , 2)+ , ("Delete" , 3) ]+ [ ''Show, ''Read, ''Eq, ''Bounded, ''Enum ])++$(declarePF "IP"+ ("Alloc", ''Word32)+ [ ("Alloc", 1) ]+ [ ''Show, ''Read, ''Eq, ''Bounded, ''Enum, ''Ord ])+++data PDIP = PDIP+ { _ipStatus :: PFIPStatus+ , _ipVerb :: PFIPVerb+ , _ipEndpoint :: PFEndpoint+ , _ipVal :: PFIPAlloc+ }+ deriving (Eq, Show, Read)++$(makeLenses ''PDIP)++pdIP :: Prism' PRCompoundEvent PDIP+pdIP = prism' pretty parse+ where parse raw+ = PDIP+ <$> (raw ^? eventStatus . pfIPStatus)+ <*> (raw ^? eventVerb . pfIPVerb)+ <*> (raw ^? eventEndpoint . pfEndpoint)+ <*> (raw ^? eventVal . pfIPAlloc)+ pretty (PDIP status verb ep x)+ = PRCompoundEvent+ (x ^. re pfIPAlloc)+ (ep ^. re pfEndpoint)+ (verb ^. re pfIPVerb)+ (status ^. re pfIPStatus)
+ lib/Ceilometer/Types/Image.hs view
@@ -0,0 +1,81 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines the Ceilometer Image type.+--+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Ceilometer.Types.Image+ ( -- * Fields+ PFImageStatus(..), pfImageStatus+ , PFImageVerb(..), pfImageVerb+ , PDImage(..), pdImage+ , PDImagePollster(..), pdImagePollster+ , imageStatus, imageVerb, imageVal+ ) where++import Control.Applicative+import Control.Lens+import Data.Binary (Word8)+import Data.Text (Text)++import Ceilometer.Types.Base+import Ceilometer.Types.TH+import Vaultaire.Types++$(declarePF "Image"+ ("Status", ''Word8)+ [ ("Active" , 1)+ , ("Saving" , 2)+ , ("Deleted" , 3)+ , ("Queued" , 4)+ , ("PendingDelete", 5)+ , ("Killed" , 6) ]+ [ ''Show, ''Read, ''Eq, ''Bounded, ''Enum ])++$(declarePF "Image"+ ("Verb", ''Word8)+ [ ("Serve" , 1)+ , ("Update" , 2)+ , ("Upload" , 3)+ , ("Download", 4)+ , ("Delete" , 5) ]+ [ ''Show, ''Read, ''Eq, ''Bounded, ''Enum ])++data PDImage = PDImage+ { _imageStatus :: PFImageStatus+ , _imageVerb :: PFImageVerb+ , _imageEndpoint :: PFEndpoint+ , _imageVal :: PFValue32 }+ deriving (Eq, Show, Read)++$(makeLenses ''PDImage)++pdImage :: Prism' PRCompoundEvent PDImage+pdImage = prism' pretty parse+ where parse raw+ = PDImage+ <$> (raw ^? eventStatus . pfImageStatus)+ <*> (raw ^? eventVerb . pfImageVerb)+ <*> (raw ^? eventEndpoint . pfEndpoint)+ <*> (raw ^? eventVal )+ pretty (PDImage status verb ep val)+ = PRCompoundEvent+ val+ (ep ^. re pfEndpoint)+ (verb ^. re pfImageVerb)+ (status ^. re pfImageStatus)++newtype PDImagePollster = PDImagePollster { _pdImagePollsterVal :: PFValue64 }+ deriving (Show, Read, Eq)++pdImagePollster :: Iso' PRSimple PDImagePollster+pdImagePollster = iso (PDImagePollster . _prSimpleVal) (PRSimple . _pdImagePollsterVal)
+ lib/Ceilometer/Types/Instance.hs view
@@ -0,0 +1,131 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines the Ceilometer Instance-related types.+--+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TemplateHaskell #-}++module Ceilometer.Types.Instance+ ( PFInstanceStatus(..), pfInstanceStatus+ , PDInstanceVCPU(..), pdInstanceVCPU+ , PDInstanceRAM(..), pdInstanceRAM+ , PDInstanceDisk(..), pdInstanceDisk+ , PDInstanceFlavor(..), pdInstanceFlavor+ , siphashID+ ) where++import Control.Applicative+import Control.Lens+import Crypto.MAC.SipHash+import qualified Data.Bimap as BM+import Data.Binary (Word32, Word64, Word8)+import Data.Bits+import Data.ByteString (ByteString)+import qualified Data.Text.Encoding as T++import Ceilometer.Types.Base+import Ceilometer.Types.TH++-- These instance metrics are the same but reported separately and differently.++$(declarePF "Instance"+ ("Status", ''Word8)+ [ ("Error", 0 )+ , ("Active", 1 )+ , ("Shutoff", 2 )+ , ("Build", 3 )+ , ("Rebuild", 4 )+ , ("Deleted", 5 )+ , ("SoftDeleted", 6 )+ , ("Shelved", 7 )+ , ("ShelvedOffloaded", 8 )+ , ("Reboot", 9 )+ , ("HardReboot", 10)+ , ("Password", 11)+ , ("Resize", 12)+ , ("VerifyResize", 13)+ , ("RevertResize", 14)+ , ("Paused", 15)+ , ("Suspended", 16)+ , ("Rescue", 17)+ , ("Migrating", 18) ]+ [''Show, ''Read, ''Eq, ''Enum, ''Bounded] )++-- BOILERPLATE GALORE++data PDInstanceVCPU = PDInstanceVCPU PFInstanceStatus PFValue32+ deriving (Eq, Show, Read)++pdInstanceVCPU :: Prism' PRCompoundPollster PDInstanceVCPU+pdInstanceVCPU = prism' pretty parse+ where parse raw+ = PDInstanceVCPU+ <$> (raw ^? pollsterStatus . pfInstanceStatus)+ <*> (raw ^? pollsterVal )+ pretty (PDInstanceVCPU status val)+ = PRCompoundPollster+ val+ (status ^. re pfInstanceStatus)++data PDInstanceRAM = PDInstanceRAM PFInstanceStatus PFValue32+ deriving (Eq, Show, Read)++pdInstanceRAM :: Prism' PRCompoundPollster PDInstanceRAM+pdInstanceRAM = prism' pretty parse+ where parse raw+ = PDInstanceRAM+ <$> (raw ^? pollsterStatus . pfInstanceStatus)+ <*> (raw ^? pollsterVal )+ pretty (PDInstanceRAM status val)+ = PRCompoundPollster+ val+ (status ^. re pfInstanceStatus)++data PDInstanceDisk = PDInstanceDisk PFInstanceStatus PFValue32+ deriving (Eq, Show, Read)++pdInstanceDisk :: Prism' PRCompoundPollster PDInstanceDisk+pdInstanceDisk = prism' pretty parse+ where parse raw+ = PDInstanceDisk+ <$> (raw ^? pollsterStatus . pfInstanceStatus)+ <*> (raw ^? pollsterVal )+ pretty (PDInstanceDisk status val)+ = PRCompoundPollster+ val+ (status ^. re pfInstanceStatus)++data PDInstanceFlavor = PDInstanceFlavor PFInstanceStatus PFValueText+ deriving (Eq, Show, Read)++pdInstanceFlavor :: FlavorMap -> Prism' PRCompoundPollster PDInstanceFlavor+pdInstanceFlavor fm = prism' pretty parse+ where parse raw+ = PDInstanceFlavor+ <$> (raw ^? pollsterStatus . pfInstanceStatus)+ <*> (raw ^? pollsterVal >>= flip BM.lookupR fm)+ pretty (PDInstanceFlavor status val)+ = PRCompoundPollster+ (siphashID val)+ (status ^. re pfInstanceStatus)+++-- FROM COLLECTOR CODE++-- | Canonical siphash with key = 0+siphash :: ByteString -> Word64+siphash x = let (SipHash h) = hash (SipKey 0 0) x in h++-- | Canonical siphash with key = 0, truncated to 32 bits+siphash32 :: ByteString -> Word32+siphash32 = fromIntegral . (`shift` (-32)) . siphash++siphashID :: PFValueText -> Word32+siphashID = siphash32 . T.encodeUtf8
+ lib/Ceilometer/Types/Neutron.hs view
@@ -0,0 +1,31 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines the Ceilometer Neutron Traffic type.++module Ceilometer.Types.Neutron+ ( PDNeutronTx(..), pdNeutronTx+ , PDNeutronRx(..), pdNeutronRx+ ) where++import Control.Lens++import Ceilometer.Types.Base++newtype PDNeutronTx = PDNeutronTx { _pdNeutronTxVal :: PFValue64 }+ deriving (Show, Read, Eq)++newtype PDNeutronRx = PDNeutronRx { _pdNeutronRxVal :: PFValue64 }+ deriving (Show, Read, Eq)++pdNeutronTx :: Iso' PRSimple PDNeutronTx+pdNeutronTx = iso (PDNeutronTx . _prSimpleVal) (PRSimple . _pdNeutronTxVal)++pdNeutronRx :: Iso' PRSimple PDNeutronRx+pdNeutronRx = iso (PDNeutronRx . _prSimpleVal) (PRSimple . _pdNeutronRxVal)
+ lib/Ceilometer/Types/Snapshot.hs view
@@ -0,0 +1,70 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines the Ceilometer Snapshot type.+--+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Ceilometer.Types.Snapshot+ ( -- * Fields+ PFSnapshotStatus(..), pfSnapshotStatus+ , PFSnapshotVerb(..), pfSnapshotVerb+ , PDSnapshot(..), pdSnapshot+ , snapshotStatus, snapshotVerb, snapshotEndpoint, snapshotVal+ ) where++import Control.Applicative+import Control.Lens+import Data.Binary (Word8)+import Data.Text (Text)++import Ceilometer.Types.Base+import Ceilometer.Types.TH+import Vaultaire.Types++$(declarePF "Snapshot"+ ("Status", ''Word8)+ [ ("Error", 0)+ , ("Available", 1)+ , ("Creating", 2)+ , ("Deleting", 3) ]+ [ ''Show, ''Read, ''Eq, ''Bounded, ''Enum ])++$(declarePF "Snapshot"+ ("Verb", ''Word8)+ [ ("Create", 1)+ , ("Update", 2)+ , ("Delete", 3) ]+ [ ''Show, ''Read, ''Eq, ''Bounded, ''Enum ])++data PDSnapshot = PDSnapshot+ { _snapshotStatus :: PFSnapshotStatus+ , _snapshotVerb :: PFSnapshotVerb+ , _snapshotEndpoint :: PFEndpoint+ , _snapshotVal :: PFValue32 }+ deriving (Eq, Show, Read)++$(makeLenses ''PDSnapshot)++pdSnapshot :: Prism' PRCompoundEvent PDSnapshot+pdSnapshot = prism' pretty parse+ where parse raw+ = PDSnapshot+ <$> (raw ^? eventStatus . pfSnapshotStatus)+ <*> (raw ^? eventVerb . pfSnapshotVerb)+ <*> (raw ^? eventEndpoint . pfEndpoint)+ <*> (raw ^? eventVal )+ pretty (PDSnapshot status verb ep val)+ = PRCompoundEvent+ val+ (ep ^. re pfEndpoint)+ (verb ^. re pfSnapshotVerb)+ (status ^. re pfSnapshotStatus)
+ lib/Ceilometer/Types/TH.hs view
@@ -0,0 +1,111 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines TH to define Ceilometer types internally.+-- DO NOT EXPORT.+--++module Ceilometer.Types.TH+ ( declarePF+ ) where++import Control.Applicative+import Data.Char+import Data.Maybe+import Language.Haskell.TH++-- | Declare a Payload Field data type and create a prism for it+-- with the mapping provided.+--+-- The type must be non-parametrised.+--+-- /e.g./+--+-- @+-- declarePF "Volume"+-- ("Verb", ''Word8)+-- [ ("Create", 1)+-- , ("Resize", 2) ]+-- [ ''Show, ''Eq, ''Bounded, ''Enum ]+-- @+--+-- will create:+--+-- @+-- data PFVolumeVerb = VolumeCreate | VolumeResize+-- deriving (Show, Eq, Enum, Bounded)+--+-- pfVolumeVerb :: Prism' Word8 PFVolumeVerb+-- pfVolumeVerb = prism' pretty parse+-- where pretty VolumeCreate = 1+-- pretty VolumeResize = 2+-- parse 1 = Just VolumeCreate+-- parse 2 = Just VolumeResize+-- parse _ = Nothing+-- @+--+-- This is useful if you want parsing/print prisms for a non-parametric type.+--+declarePF :: String -- ^ Field prefix, e.g. Volume+ -> (String, Name) -- ^ Type constructors to be declared and parsed from,+ -- the type from which we parse must have literal values.+ -> [(String, Integer)] -- ^ Data constructors and their mapping+ -> [Name] -- ^ Derived classes+ -> Q [Dec]+declarePF = declareWith "pf"++declareWith :: String -> String -> (String, Name) -> [(String, Integer)] -> [Name] -> Q [Dec]+declareWith prefix field (tyconStr, mappedType) ds derives = do+ pfunc <- lookupPrismFunc+ pty <- lookupPrismTyCon+ just <- lookupJust+ nothing <- lookupNothing+ let tycon = mkName $ map toUpper prefix ++ field ++ tyconStr+ dacons = map (mkName . (field ++) . fst) ds+ dec = DataD [] tycon [] (map (flip NormalC []) dacons) derives++ p = mkName (prefix ++ field ++ tyconStr)+ vals = map (IntegerL . snd) ds+ -- make pattern: pretty VolumeCreate = 1+ pretties = zipWith mkClause+ (map ((:[]) . flip ConP []) dacons)+ (map (NormalB . LitE) vals)+ pretty = mkName "pretty"+ -- make pattern: parse 1 = Just VolumeCreate+ parses = zipWith mkClause+ (map ((:[]) . LitP) vals)+ (map (NormalB . AppE (ConE just) . ConE) dacons)+ ++ [Clause [WildP] (NormalB (ConE nothing)) []]+ parse = mkName "parse"+ -- make clause: prism' pretty parse where ...+ cases = Clause []+ (NormalB $ AppE (AppE (VarE pfunc) (VarE pretty)) (VarE parse))+ [FunD pretty pretties, FunD parse parses]+ -- declare the prism+ sig = SigD p (AppT (AppT (ConT pty) (ConT mappedType)) (ConT tycon))+ def = FunD p [cases]+ return [dec, sig, def]++mkClause :: [Pat] -> Body -> Clause+mkClause x y = Clause x y []++-- | These Will throw a first-stage compile-time error if not in scope.+--+lookupPrismFunc, lookupPrismTyCon :: Q Name+lookupJust, lookupNothing :: Q Name+lookupPrismFunc = lookupV "prism'"+lookupPrismTyCon = lookupT "Prism'"+lookupJust = lookupV "Just"+lookupNothing = lookupV "Nothing"++lookupT :: String -> Q Name+lookupT x = fromMaybe (error $ "TH: not in scope " ++ x) <$> lookupTypeName x++lookupV :: String -> Q Name+lookupV x = fromMaybe (error $ "TH: not in scope " ++ x) <$> lookupValueName x
+ lib/Ceilometer/Types/Volume.hs view
@@ -0,0 +1,103 @@+--+-- Copyright © 2013-2015 Anchor Systems, Pty Ltd and Others+--+-- The code in this file, and the program it is a part of, is+-- made available to you by its authors as open source software:+-- you can redistribute it and/or modify it under the terms of+-- the 3-clause BSD licence.+--+-- /Description/+-- This module defines the Ceilometer Volume type.+--+{-# LANGUAGE MultiWayIf #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Ceilometer.Types.Volume+ ( -- * Fields+ PFVolumeStatus(..), pfVolumeStatus+ , PFVolumeVerb(..), pfVolumeVerb+ , PDVolume(..), pdVolume+ , PDSSD(..), pdSSD+ , volumeStatus, volumeVerb, volumeEndpoint, volumeVal+ ) where++import Control.Applicative+import Control.Lens+import Data.Binary (Word8)+import Data.Text (Text)++import Ceilometer.Types.Base+import Ceilometer.Types.TH+import Vaultaire.Types++$(declarePF "Volume"+ ("Status", ''Word8)+ [ ("Error", 0)+ , ("Available", 1)+ , ("Creating", 2)+ , ("Extending", 3)+ , ("Deleting", 4)+ , ("Attaching", 5)+ , ("Detaching", 6)+ , ("InUse", 7)+ , ("Retyping", 8)+ , ("Uploading", 9) ]+ [ ''Show, ''Read, ''Eq, ''Bounded, ''Enum ])++$(declarePF "Volume"+ ("Verb", ''Word8)+ [ ("Create", 1)+ , ("Resize", 2)+ , ("Delete", 3)+ , ("Attach", 4)+ , ("Detach", 5)+ , ("Update", 6) ]+ [ ''Show, ''Read, ''Eq, ''Bounded, ''Enum ])++data PDVolume = PDVolume+ { _volumeStatus :: PFVolumeStatus+ , _volumeVerb :: PFVolumeVerb+ , _volumeEndpoint :: PFEndpoint+ , _volumeVal :: PFValue32 }+ deriving (Eq, Show, Read)++data PDSSD = PDSSD+ { _ssdStatus :: PFVolumeStatus+ , _ssdVerb :: PFVolumeVerb+ , _ssdEndpoint :: PFEndpoint+ , _ssdVal :: PFValue32 }+ deriving (Eq, Show, Read)++$(makeLenses ''PDVolume)+$(makeLenses ''PDSSD)++pdVolume :: Prism' PRCompoundEvent PDVolume+pdVolume = prism' pretty parse+ where parse raw+ = PDVolume+ <$> (raw ^? eventStatus . pfVolumeStatus)+ <*> (raw ^? eventVerb . pfVolumeVerb)+ <*> (raw ^? eventEndpoint . pfEndpoint)+ <*> (raw ^? eventVal )+ pretty (PDVolume status verb ep val)+ = PRCompoundEvent+ val+ (ep ^. re pfEndpoint)+ (verb ^. re pfVolumeVerb)+ (status ^. re pfVolumeStatus)++pdSSD :: Prism' PRCompoundEvent PDSSD+pdSSD = prism' pretty parse+ where parse raw+ = PDSSD+ <$> (raw ^? eventStatus . pfVolumeStatus)+ <*> (raw ^? eventVerb . pfVolumeVerb)+ <*> (raw ^? eventEndpoint . pfEndpoint)+ <*> (raw ^? eventVal )+ pretty (PDSSD status verb ep val)+ = PRCompoundEvent+ val+ (ep ^. re pfEndpoint)+ (verb ^. re pfVolumeVerb)+ (status ^. re pfVolumeStatus)
+ tests/Main.hs view
@@ -0,0 +1,8 @@+import qualified Fold as TF+import qualified Prisms as TP+import Test.Hspec++main :: IO ()+main = do+ hspec TP.suite+ hspec TF.suite