--
-- 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