diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/ceilometer-common.cabal b/ceilometer-common.cabal new file mode 100644 --- /dev/null +++ b/ceilometer-common.cabal @@ -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 +maintainer: Anchor Engineering +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 diff --git a/lib/Ceilometer/Client.hs b/lib/Ceilometer/Client.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Client.hs @@ -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 diff --git a/lib/Ceilometer/Fold.hs b/lib/Ceilometer/Fold.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Fold.hs @@ -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 + diff --git a/lib/Ceilometer/Tags.hs b/lib/Ceilometer/Tags.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Tags.hs @@ -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 diff --git a/lib/Ceilometer/Types.hs b/lib/Ceilometer/Types.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types.hs @@ -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 diff --git a/lib/Ceilometer/Types/Base.hs b/lib/Ceilometer/Types/Base.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types/Base.hs @@ -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 ]) diff --git a/lib/Ceilometer/Types/CPU.hs b/lib/Ceilometer/Types/CPU.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types/CPU.hs @@ -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) diff --git a/lib/Ceilometer/Types/Disk.hs b/lib/Ceilometer/Types/Disk.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types/Disk.hs @@ -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) diff --git a/lib/Ceilometer/Types/IP.hs b/lib/Ceilometer/Types/IP.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types/IP.hs @@ -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) diff --git a/lib/Ceilometer/Types/Image.hs b/lib/Ceilometer/Types/Image.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types/Image.hs @@ -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) diff --git a/lib/Ceilometer/Types/Instance.hs b/lib/Ceilometer/Types/Instance.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types/Instance.hs @@ -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 diff --git a/lib/Ceilometer/Types/Neutron.hs b/lib/Ceilometer/Types/Neutron.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types/Neutron.hs @@ -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) diff --git a/lib/Ceilometer/Types/Snapshot.hs b/lib/Ceilometer/Types/Snapshot.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types/Snapshot.hs @@ -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) diff --git a/lib/Ceilometer/Types/TH.hs b/lib/Ceilometer/Types/TH.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types/TH.hs @@ -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 diff --git a/lib/Ceilometer/Types/Volume.hs b/lib/Ceilometer/Types/Volume.hs new file mode 100644 --- /dev/null +++ b/lib/Ceilometer/Types/Volume.hs @@ -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) diff --git a/tests/Main.hs b/tests/Main.hs new file mode 100644 --- /dev/null +++ b/tests/Main.hs @@ -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