{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeFamilies #-}

module Instrument.Types
  ( createInstrumentPool,
    Samplers,
    Counters,
    Instrument (..),
    InstrumentConfig (..),
    SubmissionPacket (..),
    MetricName (..),
    DimensionName (..),
    DimensionValue (..),
    Dimensions,
    Payload (..),
    Aggregated (..),
    AggPayload (..),
    Stats (..),
    hostDimension,
    HostDimensionPolicy (..),
    Quantile (..),
  )
where

-------------------------------------------------------------------------------
import Control.Applicative as A
import qualified Data.ByteString.Char8 as B
import Data.Default
import Data.IORef
import qualified Data.Map as M
import Data.Monoid as Monoid
import qualified Data.SafeCopy as SC
import Data.Serialize as Ser
import Data.Serialize.Text ()
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import           Database.Redis        as R
import GHC.Generics
-------------------------------------------------------------------------------
import qualified Instrument.Counter as C
import qualified Instrument.Sampler as S
import Network.HostName

-------------------------------------------------------------------------------

-------------------------------------------------------------------------------
createInstrumentPool :: ConnectInfo -> IO Connection
createInstrumentPool :: ConnectInfo -> IO Connection
createInstrumentPool ConnectInfo
ci =
    ConnectInfo -> IO Connection
connect
      ConnectInfo
ci
        { connectMaxIdleTime :: NominalDiffTime
connectMaxIdleTime = NominalDiffTime
15,
          connectMaxConnections :: Int
connectMaxConnections = Int
1
        }

-------------------------------------------------------------------------------

newtype DimensionName = DimensionName
  { DimensionName -> Text
dimensionName :: Text
  }
  deriving (DimensionName -> DimensionName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DimensionName -> DimensionName -> Bool
$c/= :: DimensionName -> DimensionName -> Bool
== :: DimensionName -> DimensionName -> Bool
$c== :: DimensionName -> DimensionName -> Bool
Eq, Eq DimensionName
DimensionName -> DimensionName -> Bool
DimensionName -> DimensionName -> Ordering
DimensionName -> DimensionName -> DimensionName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DimensionName -> DimensionName -> DimensionName
$cmin :: DimensionName -> DimensionName -> DimensionName
max :: DimensionName -> DimensionName -> DimensionName
$cmax :: DimensionName -> DimensionName -> DimensionName
>= :: DimensionName -> DimensionName -> Bool
$c>= :: DimensionName -> DimensionName -> Bool
> :: DimensionName -> DimensionName -> Bool
$c> :: DimensionName -> DimensionName -> Bool
<= :: DimensionName -> DimensionName -> Bool
$c<= :: DimensionName -> DimensionName -> Bool
< :: DimensionName -> DimensionName -> Bool
$c< :: DimensionName -> DimensionName -> Bool
compare :: DimensionName -> DimensionName -> Ordering
$ccompare :: DimensionName -> DimensionName -> Ordering
Ord, Int -> DimensionName -> ShowS
[DimensionName] -> ShowS
DimensionName -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [DimensionName] -> ShowS
$cshowList :: [DimensionName] -> ShowS
show :: DimensionName -> HostName
$cshow :: DimensionName -> HostName
showsPrec :: Int -> DimensionName -> ShowS
$cshowsPrec :: Int -> DimensionName -> ShowS
Show, forall x. Rep DimensionName x -> DimensionName
forall x. DimensionName -> Rep DimensionName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DimensionName x -> DimensionName
$cfrom :: forall x. DimensionName -> Rep DimensionName x
Generic, Get DimensionName
Putter DimensionName
forall t. Putter t -> Get t -> Serialize t
get :: Get DimensionName
$cget :: Get DimensionName
put :: Putter DimensionName
$cput :: Putter DimensionName
Serialize, HostName -> DimensionName
forall a. (HostName -> a) -> IsString a
fromString :: HostName -> DimensionName
$cfromString :: HostName -> DimensionName
IsString)

$(SC.deriveSafeCopy 0 'SC.base ''DimensionName)

-- | Convention for the dimension of the hostname. Used in the client
-- to inject hostname into the parameters map
hostDimension :: DimensionName
hostDimension :: DimensionName
hostDimension = DimensionName
"host"

newtype DimensionValue = DimensionValue
  { DimensionValue -> Text
dimensionValue :: Text
  }
  deriving (DimensionValue -> DimensionValue -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DimensionValue -> DimensionValue -> Bool
$c/= :: DimensionValue -> DimensionValue -> Bool
== :: DimensionValue -> DimensionValue -> Bool
$c== :: DimensionValue -> DimensionValue -> Bool
Eq, Eq DimensionValue
DimensionValue -> DimensionValue -> Bool
DimensionValue -> DimensionValue -> Ordering
DimensionValue -> DimensionValue -> DimensionValue
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DimensionValue -> DimensionValue -> DimensionValue
$cmin :: DimensionValue -> DimensionValue -> DimensionValue
max :: DimensionValue -> DimensionValue -> DimensionValue
$cmax :: DimensionValue -> DimensionValue -> DimensionValue
>= :: DimensionValue -> DimensionValue -> Bool
$c>= :: DimensionValue -> DimensionValue -> Bool
> :: DimensionValue -> DimensionValue -> Bool
$c> :: DimensionValue -> DimensionValue -> Bool
<= :: DimensionValue -> DimensionValue -> Bool
$c<= :: DimensionValue -> DimensionValue -> Bool
< :: DimensionValue -> DimensionValue -> Bool
$c< :: DimensionValue -> DimensionValue -> Bool
compare :: DimensionValue -> DimensionValue -> Ordering
$ccompare :: DimensionValue -> DimensionValue -> Ordering
Ord, Int -> DimensionValue -> ShowS
[DimensionValue] -> ShowS
DimensionValue -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [DimensionValue] -> ShowS
$cshowList :: [DimensionValue] -> ShowS
show :: DimensionValue -> HostName
$cshow :: DimensionValue -> HostName
showsPrec :: Int -> DimensionValue -> ShowS
$cshowsPrec :: Int -> DimensionValue -> ShowS
Show, forall x. Rep DimensionValue x -> DimensionValue
forall x. DimensionValue -> Rep DimensionValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DimensionValue x -> DimensionValue
$cfrom :: forall x. DimensionValue -> Rep DimensionValue x
Generic, Get DimensionValue
Putter DimensionValue
forall t. Putter t -> Get t -> Serialize t
get :: Get DimensionValue
$cget :: Get DimensionValue
put :: Putter DimensionValue
$cput :: Putter DimensionValue
Serialize, HostName -> DimensionValue
forall a. (HostName -> a) -> IsString a
fromString :: HostName -> DimensionValue
$cfromString :: HostName -> DimensionValue
IsString)

$(SC.deriveSafeCopy 0 'SC.base ''DimensionValue)

newtype MetricName = MetricName
  { MetricName -> HostName
metricName :: String
  }
  deriving (MetricName -> MetricName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MetricName -> MetricName -> Bool
$c/= :: MetricName -> MetricName -> Bool
== :: MetricName -> MetricName -> Bool
$c== :: MetricName -> MetricName -> Bool
Eq, Int -> MetricName -> ShowS
[MetricName] -> ShowS
MetricName -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [MetricName] -> ShowS
$cshowList :: [MetricName] -> ShowS
show :: MetricName -> HostName
$cshow :: MetricName -> HostName
showsPrec :: Int -> MetricName -> ShowS
$cshowsPrec :: Int -> MetricName -> ShowS
Show, forall x. Rep MetricName x -> MetricName
forall x. MetricName -> Rep MetricName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MetricName x -> MetricName
$cfrom :: forall x. MetricName -> Rep MetricName x
Generic, Eq MetricName
MetricName -> MetricName -> Bool
MetricName -> MetricName -> Ordering
MetricName -> MetricName -> MetricName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MetricName -> MetricName -> MetricName
$cmin :: MetricName -> MetricName -> MetricName
max :: MetricName -> MetricName -> MetricName
$cmax :: MetricName -> MetricName -> MetricName
>= :: MetricName -> MetricName -> Bool
$c>= :: MetricName -> MetricName -> Bool
> :: MetricName -> MetricName -> Bool
$c> :: MetricName -> MetricName -> Bool
<= :: MetricName -> MetricName -> Bool
$c<= :: MetricName -> MetricName -> Bool
< :: MetricName -> MetricName -> Bool
$c< :: MetricName -> MetricName -> Bool
compare :: MetricName -> MetricName -> Ordering
$ccompare :: MetricName -> MetricName -> Ordering
Ord, HostName -> MetricName
forall a. (HostName -> a) -> IsString a
fromString :: HostName -> MetricName
$cfromString :: HostName -> MetricName
IsString, Get MetricName
Putter MetricName
forall t. Putter t -> Get t -> Serialize t
get :: Get MetricName
$cget :: Get MetricName
put :: Putter MetricName
$cput :: Putter MetricName
Serialize)

$(SC.deriveSafeCopy 0 'SC.base ''MetricName)

-------------------------------------------------------------------------------

-- Map of user-defined samplers.
type Samplers = M.Map (MetricName, Dimensions) S.Sampler

-- Map of user-defined counters.
type Counters = M.Map (MetricName, Dimensions) C.Counter

type Dimensions = M.Map DimensionName DimensionValue

data Payload_v0
  = Samples_v0 {Payload_v0 -> [Double]
unSamples_v0 :: [Double]}
  | Counter_v0 {Payload_v0 -> Int
unCounter_v0 :: Int}
  deriving (Payload_v0 -> Payload_v0 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Payload_v0 -> Payload_v0 -> Bool
$c/= :: Payload_v0 -> Payload_v0 -> Bool
== :: Payload_v0 -> Payload_v0 -> Bool
$c== :: Payload_v0 -> Payload_v0 -> Bool
Eq, Int -> Payload_v0 -> ShowS
[Payload_v0] -> ShowS
Payload_v0 -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Payload_v0] -> ShowS
$cshowList :: [Payload_v0] -> ShowS
show :: Payload_v0 -> HostName
$cshow :: Payload_v0 -> HostName
showsPrec :: Int -> Payload_v0 -> ShowS
$cshowsPrec :: Int -> Payload_v0 -> ShowS
Show, forall x. Rep Payload_v0 x -> Payload_v0
forall x. Payload_v0 -> Rep Payload_v0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Payload_v0 x -> Payload_v0
$cfrom :: forall x. Payload_v0 -> Rep Payload_v0 x
Generic)

instance Serialize Payload_v0

data Payload
  = Samples {Payload -> [Double]
unSamples :: [Double]}
  | Counter {Payload -> Integer
unCounter :: Integer}
  deriving (Payload -> Payload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Payload -> Payload -> Bool
$c/= :: Payload -> Payload -> Bool
== :: Payload -> Payload -> Bool
$c== :: Payload -> Payload -> Bool
Eq, Int -> Payload -> ShowS
[Payload] -> ShowS
Payload -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Payload] -> ShowS
$cshowList :: [Payload] -> ShowS
show :: Payload -> HostName
$cshow :: Payload -> HostName
showsPrec :: Int -> Payload -> ShowS
$cshowsPrec :: Int -> Payload -> ShowS
Show, forall x. Rep Payload x -> Payload
forall x. Payload -> Rep Payload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Payload x -> Payload
$cfrom :: forall x. Payload -> Rep Payload x
Generic)

instance Serialize Payload

$(SC.deriveSafeCopy 0 'SC.base ''Payload_v0)
$(SC.deriveSafeCopy 1 'SC.extension ''Payload)

instance SC.Migrate Payload where
  type MigrateFrom Payload = Payload_v0
  migrate :: MigrateFrom Payload -> Payload
migrate (Samples_v0 [Double]
n) = [Double] -> Payload
Samples [Double]
n
  migrate (Counter_v0 Int
n) = Integer -> Payload
Counter forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

data Instrument = I
  { Instrument -> HostName
hostName :: HostName,
    Instrument -> IORef Samplers
samplers :: !(IORef Samplers),
    Instrument -> IORef Counters
counters :: !(IORef Counters),
    Instrument -> Connection
redis :: Connection
  }

data InstrumentConfig = ICfg
  { InstrumentConfig -> Maybe Integer
redisQueueBound :: Maybe Integer
  }

instance Default InstrumentConfig where
  def :: InstrumentConfig
def = Maybe Integer -> InstrumentConfig
ICfg forall a. Maybe a
Nothing

-- | Submitted package of collected samples
data SubmissionPacket_v0 = SP_v0
  { -- | Timing of this submission
    SubmissionPacket_v0 -> Double
spTimeStamp_v0 :: !Double,
    -- | Who sent it
    SubmissionPacket_v0 -> HostName
spHostName_v0 :: !HostName,
    -- | Metric name
    SubmissionPacket_v0 -> HostName
spName_v0 :: String,
    -- | Collected values
    SubmissionPacket_v0 -> Payload
spPayload_v0 :: Payload
  }
  deriving (SubmissionPacket_v0 -> SubmissionPacket_v0 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubmissionPacket_v0 -> SubmissionPacket_v0 -> Bool
$c/= :: SubmissionPacket_v0 -> SubmissionPacket_v0 -> Bool
== :: SubmissionPacket_v0 -> SubmissionPacket_v0 -> Bool
$c== :: SubmissionPacket_v0 -> SubmissionPacket_v0 -> Bool
Eq, Int -> SubmissionPacket_v0 -> ShowS
[SubmissionPacket_v0] -> ShowS
SubmissionPacket_v0 -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [SubmissionPacket_v0] -> ShowS
$cshowList :: [SubmissionPacket_v0] -> ShowS
show :: SubmissionPacket_v0 -> HostName
$cshow :: SubmissionPacket_v0 -> HostName
showsPrec :: Int -> SubmissionPacket_v0 -> ShowS
$cshowsPrec :: Int -> SubmissionPacket_v0 -> ShowS
Show, forall x. Rep SubmissionPacket_v0 x -> SubmissionPacket_v0
forall x. SubmissionPacket_v0 -> Rep SubmissionPacket_v0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubmissionPacket_v0 x -> SubmissionPacket_v0
$cfrom :: forall x. SubmissionPacket_v0 -> Rep SubmissionPacket_v0 x
Generic)

instance Serialize SubmissionPacket_v0

data SubmissionPacket_v1 = SP_v1
  { -- | Timing of this submission
    SubmissionPacket_v1 -> Double
spTimeStamp_v1 :: !Double,
    -- | Metric name
    SubmissionPacket_v1 -> MetricName
spName_v1 :: !MetricName,
    -- | Collected values
    SubmissionPacket_v1 -> Payload_v0
spPayload_v1 :: !Payload_v0,
    -- | Defines slices that this packet belongs to. This allows
    -- drill-down on the backends. For instance, you could do
    -- "server_name" "app1" or "queue_name" "my_queue"
    SubmissionPacket_v1 -> Dimensions
spDimensions_v1 :: !Dimensions
  }
  deriving (SubmissionPacket_v1 -> SubmissionPacket_v1 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubmissionPacket_v1 -> SubmissionPacket_v1 -> Bool
$c/= :: SubmissionPacket_v1 -> SubmissionPacket_v1 -> Bool
== :: SubmissionPacket_v1 -> SubmissionPacket_v1 -> Bool
$c== :: SubmissionPacket_v1 -> SubmissionPacket_v1 -> Bool
Eq, Int -> SubmissionPacket_v1 -> ShowS
[SubmissionPacket_v1] -> ShowS
SubmissionPacket_v1 -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [SubmissionPacket_v1] -> ShowS
$cshowList :: [SubmissionPacket_v1] -> ShowS
show :: SubmissionPacket_v1 -> HostName
$cshow :: SubmissionPacket_v1 -> HostName
showsPrec :: Int -> SubmissionPacket_v1 -> ShowS
$cshowsPrec :: Int -> SubmissionPacket_v1 -> ShowS
Show, forall x. Rep SubmissionPacket_v1 x -> SubmissionPacket_v1
forall x. SubmissionPacket_v1 -> Rep SubmissionPacket_v1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubmissionPacket_v1 x -> SubmissionPacket_v1
$cfrom :: forall x. SubmissionPacket_v1 -> Rep SubmissionPacket_v1 x
Generic)

instance Serialize SubmissionPacket_v1

data SubmissionPacket = SP
  { -- | Timing of this submission
    SubmissionPacket -> Double
spTimeStamp :: !Double,
    -- | Metric name
    SubmissionPacket -> MetricName
spName :: !MetricName,
    -- | Collected values
    SubmissionPacket -> Payload
spPayload :: !Payload,
    -- | Defines slices that this packet belongs to. This allows
    -- drill-down on the backends. For instance, you could do
    -- "server_name" "app1" or "queue_name" "my_queue"
    SubmissionPacket -> Dimensions
spDimensions :: !Dimensions
  }
  deriving (SubmissionPacket -> SubmissionPacket -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SubmissionPacket -> SubmissionPacket -> Bool
$c/= :: SubmissionPacket -> SubmissionPacket -> Bool
== :: SubmissionPacket -> SubmissionPacket -> Bool
$c== :: SubmissionPacket -> SubmissionPacket -> Bool
Eq, Int -> SubmissionPacket -> ShowS
[SubmissionPacket] -> ShowS
SubmissionPacket -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [SubmissionPacket] -> ShowS
$cshowList :: [SubmissionPacket] -> ShowS
show :: SubmissionPacket -> HostName
$cshow :: SubmissionPacket -> HostName
showsPrec :: Int -> SubmissionPacket -> ShowS
$cshowsPrec :: Int -> SubmissionPacket -> ShowS
Show, forall x. Rep SubmissionPacket x -> SubmissionPacket
forall x. SubmissionPacket -> Rep SubmissionPacket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SubmissionPacket x -> SubmissionPacket
$cfrom :: forall x. SubmissionPacket -> Rep SubmissionPacket x
Generic)

instance Serialize SubmissionPacket where
  get :: Get SubmissionPacket
get = (forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. GSerializeGet f => Get (f a)
gGet)  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (SubmissionPacket_v1 -> SubmissionPacket
upgradeSP1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
Ser.get) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (SubmissionPacket_v0 -> SubmissionPacket
upgradeSP0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
Ser.get)

upgradeSP0 :: SubmissionPacket_v0 -> SubmissionPacket
upgradeSP0 :: SubmissionPacket_v0 -> SubmissionPacket
upgradeSP0 SP_v0 {Double
HostName
Payload
spPayload_v0 :: Payload
spName_v0 :: HostName
spHostName_v0 :: HostName
spTimeStamp_v0 :: Double
spPayload_v0 :: SubmissionPacket_v0 -> Payload
spName_v0 :: SubmissionPacket_v0 -> HostName
spHostName_v0 :: SubmissionPacket_v0 -> HostName
spTimeStamp_v0 :: SubmissionPacket_v0 -> Double
..} =
  SP
    { spTimeStamp :: Double
spTimeStamp = Double
spTimeStamp_v0,
      spName :: MetricName
spName = HostName -> MetricName
MetricName HostName
spName_v0,
      spPayload :: Payload
spPayload = Payload
spPayload_v0,
      spDimensions :: Dimensions
spDimensions = forall k a. k -> a -> Map k a
M.singleton DimensionName
hostDimension (Text -> DimensionValue
DimensionValue (HostName -> Text
T.pack HostName
spHostName_v0))
    }

upgradeSP1 :: SubmissionPacket_v1 -> SubmissionPacket
upgradeSP1 :: SubmissionPacket_v1 -> SubmissionPacket
upgradeSP1 SP_v1 {Double
Dimensions
MetricName
Payload_v0
spDimensions_v1 :: Dimensions
spPayload_v1 :: Payload_v0
spName_v1 :: MetricName
spTimeStamp_v1 :: Double
spDimensions_v1 :: SubmissionPacket_v1 -> Dimensions
spPayload_v1 :: SubmissionPacket_v1 -> Payload_v0
spName_v1 :: SubmissionPacket_v1 -> MetricName
spTimeStamp_v1 :: SubmissionPacket_v1 -> Double
..} =
  SP
    { spTimeStamp :: Double
spTimeStamp = Double
spTimeStamp_v1,
      spName :: MetricName
spName = MetricName
spName_v1,
      spPayload :: Payload
spPayload = case Payload_v0
spPayload_v1 of
        Samples_v0 [Double]
n -> [Double] -> Payload
Samples [Double]
n
        Counter_v0 Int
n -> Integer -> Payload
Counter forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n,
      spDimensions :: Dimensions
spDimensions = Dimensions
spDimensions_v1
    }

$(SC.deriveSafeCopy 0 'SC.base ''SubmissionPacket_v0)
$(SC.deriveSafeCopy 1 'SC.extension ''SubmissionPacket)

instance SC.Migrate SubmissionPacket where
  type MigrateFrom SubmissionPacket = SubmissionPacket_v0
  migrate :: MigrateFrom SubmissionPacket -> SubmissionPacket
migrate = SubmissionPacket_v0 -> SubmissionPacket
upgradeSP0

-------------------------------------------------------------------------------

-- | Should we automatically pull the host and add it as a
-- dimension. Used at the call site of the various metrics ('timeI',
-- 'sampleI', etc). Hosts are basically grandfathered in as a
-- dimension and the functionality of automatically injecting them is
-- useful, but it is not relevant to some metrics and actually makes
-- some metrics difficult to use depending on the backend, so we made
-- them opt-in.
data HostDimensionPolicy
  = AddHostDimension
  | DoNotAddHostDimension
  deriving (Int -> HostDimensionPolicy -> ShowS
[HostDimensionPolicy] -> ShowS
HostDimensionPolicy -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [HostDimensionPolicy] -> ShowS
$cshowList :: [HostDimensionPolicy] -> ShowS
show :: HostDimensionPolicy -> HostName
$cshow :: HostDimensionPolicy -> HostName
showsPrec :: Int -> HostDimensionPolicy -> ShowS
$cshowsPrec :: Int -> HostDimensionPolicy -> ShowS
Show, HostDimensionPolicy -> HostDimensionPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: HostDimensionPolicy -> HostDimensionPolicy -> Bool
$c/= :: HostDimensionPolicy -> HostDimensionPolicy -> Bool
== :: HostDimensionPolicy -> HostDimensionPolicy -> Bool
$c== :: HostDimensionPolicy -> HostDimensionPolicy -> Bool
Eq)

-------------------------------------------------------------------------------
data Stats = Stats
  { Stats -> Double
smean :: Double,
    Stats -> Double
ssum :: Double,
    Stats -> Int
scount :: Int,
    Stats -> Double
smax :: Double,
    Stats -> Double
smin :: Double,
    Stats -> Double
srange :: Double,
    Stats -> Double
sstdev :: Double,
    Stats -> Double
sskewness :: Double,
    Stats -> Double
skurtosis :: Double,
    Stats -> Map Int Double
squantiles :: M.Map Int Double
  }
  deriving (Stats -> Stats -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Stats -> Stats -> Bool
$c/= :: Stats -> Stats -> Bool
== :: Stats -> Stats -> Bool
$c== :: Stats -> Stats -> Bool
Eq, Int -> Stats -> ShowS
[Stats] -> ShowS
Stats -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Stats] -> ShowS
$cshowList :: [Stats] -> ShowS
show :: Stats -> HostName
$cshow :: Stats -> HostName
showsPrec :: Int -> Stats -> ShowS
$cshowsPrec :: Int -> Stats -> ShowS
Show, forall x. Rep Stats x -> Stats
forall x. Stats -> Rep Stats x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Stats x -> Stats
$cfrom :: forall x. Stats -> Rep Stats x
Generic)

instance Default Stats where
  def :: Stats
def = Double
-> Double
-> Int
-> Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Map Int Double
-> Stats
Stats Double
0 Double
0 Int
0 Double
0 Double
0 Double
0 Double
0 Double
0 Double
0 forall a. Monoid a => a
mempty

instance Serialize Stats

$(SC.deriveSafeCopy 0 'SC.base ''Stats)

-------------------------------------------------------------------------------
-- | Resulting payload for metrics aggregation
data AggPayload_v0
  = AggStats_v0 Stats
  | AggCount_v0 Int
  deriving (AggPayload_v0 -> AggPayload_v0 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AggPayload_v0 -> AggPayload_v0 -> Bool
$c/= :: AggPayload_v0 -> AggPayload_v0 -> Bool
== :: AggPayload_v0 -> AggPayload_v0 -> Bool
$c== :: AggPayload_v0 -> AggPayload_v0 -> Bool
Eq, Int -> AggPayload_v0 -> ShowS
[AggPayload_v0] -> ShowS
AggPayload_v0 -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [AggPayload_v0] -> ShowS
$cshowList :: [AggPayload_v0] -> ShowS
show :: AggPayload_v0 -> HostName
$cshow :: AggPayload_v0 -> HostName
showsPrec :: Int -> AggPayload_v0 -> ShowS
$cshowsPrec :: Int -> AggPayload_v0 -> ShowS
Show, forall x. Rep AggPayload_v0 x -> AggPayload_v0
forall x. AggPayload_v0 -> Rep AggPayload_v0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AggPayload_v0 x -> AggPayload_v0
$cfrom :: forall x. AggPayload_v0 -> Rep AggPayload_v0 x
Generic)

instance Serialize AggPayload_v0

data AggPayload
  = AggStats Stats
  | AggCount Integer
  deriving (AggPayload -> AggPayload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AggPayload -> AggPayload -> Bool
$c/= :: AggPayload -> AggPayload -> Bool
== :: AggPayload -> AggPayload -> Bool
$c== :: AggPayload -> AggPayload -> Bool
Eq, Int -> AggPayload -> ShowS
[AggPayload] -> ShowS
AggPayload -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [AggPayload] -> ShowS
$cshowList :: [AggPayload] -> ShowS
show :: AggPayload -> HostName
$cshow :: AggPayload -> HostName
showsPrec :: Int -> AggPayload -> ShowS
$cshowsPrec :: Int -> AggPayload -> ShowS
Show, forall x. Rep AggPayload x -> AggPayload
forall x. AggPayload -> Rep AggPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AggPayload x -> AggPayload
$cfrom :: forall x. AggPayload -> Rep AggPayload x
Generic)

instance Serialize AggPayload

instance Default AggPayload where
  def :: AggPayload
def = Stats -> AggPayload
AggStats forall a. Default a => a
def

$(SC.deriveSafeCopy 0 'SC.base ''AggPayload_v0)
$(SC.deriveSafeCopy 1 'SC.extension ''AggPayload)

instance SC.Migrate AggPayload where
  type MigrateFrom AggPayload = AggPayload_v0
  migrate :: MigrateFrom AggPayload -> AggPayload
migrate (AggStats_v0 Stats
n) = Stats -> AggPayload
AggStats Stats
n
  migrate (AggCount_v0 Int
n) = Integer -> AggPayload
AggCount forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n

-------------------------------------------------------------------------------
data Aggregated = Aggregated
  { -- | Timestamp for this aggregation
    Aggregated -> Double
aggTS :: Double,
    -- | Name of the metric
    Aggregated -> MetricName
aggName :: MetricName,
    -- | Calculated stats for the metric
    Aggregated -> AggPayload
aggPayload :: AggPayload,
    Aggregated -> Dimensions
aggDimensions :: Dimensions
  }
  deriving (Aggregated -> Aggregated -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aggregated -> Aggregated -> Bool
$c/= :: Aggregated -> Aggregated -> Bool
== :: Aggregated -> Aggregated -> Bool
$c== :: Aggregated -> Aggregated -> Bool
Eq, Int -> Aggregated -> ShowS
[Aggregated] -> ShowS
Aggregated -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Aggregated] -> ShowS
$cshowList :: [Aggregated] -> ShowS
show :: Aggregated -> HostName
$cshow :: Aggregated -> HostName
showsPrec :: Int -> Aggregated -> ShowS
$cshowsPrec :: Int -> Aggregated -> ShowS
Show, forall x. Rep Aggregated x -> Aggregated
forall x. Aggregated -> Rep Aggregated x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Aggregated x -> Aggregated
$cfrom :: forall x. Aggregated -> Rep Aggregated x
Generic)

instance Serialize Aggregated where
  get :: Get Aggregated
get = (forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. GSerializeGet f => Get (f a)
gGet) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Aggregated_v2 -> Aggregated
upgradeAggregated_v2 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
Ser.get) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Aggregated_v2 -> Aggregated
upgradeAggregated_v2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Aggregated_v1 -> Aggregated_v2
upgradeAggregated_v1 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
Ser.get)

instance Default Aggregated where
  def :: Aggregated
def = Double -> MetricName -> AggPayload -> Dimensions -> Aggregated
Aggregated Double
0 MetricName
"" forall a. Default a => a
def forall a. Monoid a => a
mempty

data Aggregated_v2 = Aggregated_v2
  { -- | Timestamp for this aggregation
    Aggregated_v2 -> Double
aggTS_v2 :: Double,
    -- | Name of the metric
    Aggregated_v2 -> MetricName
aggName_v2 :: MetricName,
    -- | Calculated stats for the metric
    Aggregated_v2 -> AggPayload_v0
aggPayload_v2 :: AggPayload_v0,
    Aggregated_v2 -> Dimensions
aggDimensions_v2 :: Dimensions
  }
  deriving (Aggregated_v2 -> Aggregated_v2 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aggregated_v2 -> Aggregated_v2 -> Bool
$c/= :: Aggregated_v2 -> Aggregated_v2 -> Bool
== :: Aggregated_v2 -> Aggregated_v2 -> Bool
$c== :: Aggregated_v2 -> Aggregated_v2 -> Bool
Eq, Int -> Aggregated_v2 -> ShowS
[Aggregated_v2] -> ShowS
Aggregated_v2 -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Aggregated_v2] -> ShowS
$cshowList :: [Aggregated_v2] -> ShowS
show :: Aggregated_v2 -> HostName
$cshow :: Aggregated_v2 -> HostName
showsPrec :: Int -> Aggregated_v2 -> ShowS
$cshowsPrec :: Int -> Aggregated_v2 -> ShowS
Show, forall x. Rep Aggregated_v2 x -> Aggregated_v2
forall x. Aggregated_v2 -> Rep Aggregated_v2 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Aggregated_v2 x -> Aggregated_v2
$cfrom :: forall x. Aggregated_v2 -> Rep Aggregated_v2 x
Generic)

instance Serialize Aggregated_v2

upgradeAggregated_v2 :: Aggregated_v2 -> Aggregated
upgradeAggregated_v2 :: Aggregated_v2 -> Aggregated
upgradeAggregated_v2 Aggregated_v2
a =
  Aggregated
    { aggTS :: Double
aggTS = Aggregated_v2 -> Double
aggTS_v2 Aggregated_v2
a,
      aggName :: MetricName
aggName = Aggregated_v2 -> MetricName
aggName_v2 Aggregated_v2
a,
      aggPayload :: AggPayload
aggPayload = forall a. Migrate a => MigrateFrom a -> a
SC.migrate (Aggregated_v2 -> AggPayload_v0
aggPayload_v2 Aggregated_v2
a),
      aggDimensions :: Dimensions
aggDimensions = Aggregated_v2 -> Dimensions
aggDimensions_v2 Aggregated_v2
a
    }

data Aggregated_v1 = Aggregated_v1
  { -- | Timestamp for this aggregation
    Aggregated_v1 -> Double
aggTS_v1 :: Double,
    -- | Name of the metric
    Aggregated_v1 -> MetricName
aggName_v1 :: MetricName,
    -- | The aggregation level/group for this stat
    Aggregated_v1 -> ByteString
aggGroup_v1 :: B.ByteString,
    -- | Calculated stats for the metric
    Aggregated_v1 -> AggPayload_v0
aggPayload_v1 :: AggPayload_v0
  }
  deriving (Aggregated_v1 -> Aggregated_v1 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aggregated_v1 -> Aggregated_v1 -> Bool
$c/= :: Aggregated_v1 -> Aggregated_v1 -> Bool
== :: Aggregated_v1 -> Aggregated_v1 -> Bool
$c== :: Aggregated_v1 -> Aggregated_v1 -> Bool
Eq, Int -> Aggregated_v1 -> ShowS
[Aggregated_v1] -> ShowS
Aggregated_v1 -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Aggregated_v1] -> ShowS
$cshowList :: [Aggregated_v1] -> ShowS
show :: Aggregated_v1 -> HostName
$cshow :: Aggregated_v1 -> HostName
showsPrec :: Int -> Aggregated_v1 -> ShowS
$cshowsPrec :: Int -> Aggregated_v1 -> ShowS
Show, forall x. Rep Aggregated_v1 x -> Aggregated_v1
forall x. Aggregated_v1 -> Rep Aggregated_v1 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Aggregated_v1 x -> Aggregated_v1
$cfrom :: forall x. Aggregated_v1 -> Rep Aggregated_v1 x
Generic)

upgradeAggregated_v1 :: Aggregated_v1 -> Aggregated_v2
upgradeAggregated_v1 :: Aggregated_v1 -> Aggregated_v2
upgradeAggregated_v1 Aggregated_v1
a =
  Aggregated_v2
    { aggTS_v2 :: Double
aggTS_v2 = Aggregated_v1 -> Double
aggTS_v1 Aggregated_v1
a,
      aggName_v2 :: MetricName
aggName_v2 = Aggregated_v1 -> MetricName
aggName_v1 Aggregated_v1
a,
      aggPayload_v2 :: AggPayload_v0
aggPayload_v2 = Aggregated_v1 -> AggPayload_v0
aggPayload_v1 Aggregated_v1
a,
      aggDimensions_v2 :: Dimensions
aggDimensions_v2 = forall a. Monoid a => a
Monoid.mempty
    }

data Aggregated_v0 = Aggregated_v0
  { -- | Timestamp for this aggregation
    Aggregated_v0 -> Double
aggTS_v0 :: Double,
    -- | Name of the metric
    Aggregated_v0 -> HostName
aggName_v0 :: String,
    -- | The aggregation level/group for this stat
    Aggregated_v0 -> ByteString
aggGroup_v0 :: B.ByteString,
    -- | Calculated stats for the metric
    Aggregated_v0 -> AggPayload_v0
aggPayload_v0 :: AggPayload_v0
  }
  deriving (Aggregated_v0 -> Aggregated_v0 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Aggregated_v0 -> Aggregated_v0 -> Bool
$c/= :: Aggregated_v0 -> Aggregated_v0 -> Bool
== :: Aggregated_v0 -> Aggregated_v0 -> Bool
$c== :: Aggregated_v0 -> Aggregated_v0 -> Bool
Eq, Int -> Aggregated_v0 -> ShowS
[Aggregated_v0] -> ShowS
Aggregated_v0 -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Aggregated_v0] -> ShowS
$cshowList :: [Aggregated_v0] -> ShowS
show :: Aggregated_v0 -> HostName
$cshow :: Aggregated_v0 -> HostName
showsPrec :: Int -> Aggregated_v0 -> ShowS
$cshowsPrec :: Int -> Aggregated_v0 -> ShowS
Show, forall x. Rep Aggregated_v0 x -> Aggregated_v0
forall x. Aggregated_v0 -> Rep Aggregated_v0 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Aggregated_v0 x -> Aggregated_v0
$cfrom :: forall x. Aggregated_v0 -> Rep Aggregated_v0 x
Generic)

instance Serialize Aggregated_v0

upgradeAggregated_v0 :: Aggregated_v0 -> Aggregated_v1
upgradeAggregated_v0 :: Aggregated_v0 -> Aggregated_v1
upgradeAggregated_v0 Aggregated_v0
a =
  Aggregated_v1
    { aggTS_v1 :: Double
aggTS_v1 = Aggregated_v0 -> Double
aggTS_v0 Aggregated_v0
a,
      aggName_v1 :: MetricName
aggName_v1 = HostName -> MetricName
MetricName (Aggregated_v0 -> HostName
aggName_v0 Aggregated_v0
a),
      aggGroup_v1 :: ByteString
aggGroup_v1 = Aggregated_v0 -> ByteString
aggGroup_v0 Aggregated_v0
a,
      aggPayload_v1 :: AggPayload_v0
aggPayload_v1 = Aggregated_v0 -> AggPayload_v0
aggPayload_v0 Aggregated_v0
a
    }

instance Serialize Aggregated_v1 where
  get :: Get Aggregated_v1
get = (forall a x. Generic a => Rep a x -> a
to forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. GSerializeGet f => Get (f a)
gGet) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Aggregated_v0 -> Aggregated_v1
upgradeAggregated_v0 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall t. Serialize t => Get t
Ser.get)

$(SC.deriveSafeCopy 0 'SC.base ''Aggregated_v0)

instance SC.Migrate Aggregated_v1 where
  type MigrateFrom Aggregated_v1 = Aggregated_v0
  migrate :: MigrateFrom Aggregated_v1 -> Aggregated_v1
migrate = Aggregated_v0 -> Aggregated_v1
upgradeAggregated_v0

$(SC.deriveSafeCopy 1 'SC.extension ''Aggregated_v1)

instance SC.Migrate Aggregated_v2 where
  type MigrateFrom Aggregated_v2 = Aggregated_v1
  migrate :: MigrateFrom Aggregated_v2 -> Aggregated_v2
migrate = Aggregated_v1 -> Aggregated_v2
upgradeAggregated_v1

$(SC.deriveSafeCopy 2 'SC.extension ''Aggregated_v2)

instance SC.Migrate Aggregated where
  type MigrateFrom Aggregated = Aggregated_v2
  migrate :: MigrateFrom Aggregated -> Aggregated
migrate = Aggregated_v2 -> Aggregated
upgradeAggregated_v2

$(SC.deriveSafeCopy 3 'SC.extension ''Aggregated)

-------------------------------------------------------------------------------

-- | Integer quantile, valid values range from 1-99, inclusive.
newtype Quantile = Q {Quantile -> Int
quantile :: Int} deriving (Int -> Quantile -> ShowS
[Quantile] -> ShowS
Quantile -> HostName
forall a.
(Int -> a -> ShowS) -> (a -> HostName) -> ([a] -> ShowS) -> Show a
showList :: [Quantile] -> ShowS
$cshowList :: [Quantile] -> ShowS
show :: Quantile -> HostName
$cshow :: Quantile -> HostName
showsPrec :: Int -> Quantile -> ShowS
$cshowsPrec :: Int -> Quantile -> ShowS
Show, Quantile -> Quantile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Quantile -> Quantile -> Bool
$c/= :: Quantile -> Quantile -> Bool
== :: Quantile -> Quantile -> Bool
$c== :: Quantile -> Quantile -> Bool
Eq, Eq Quantile
Quantile -> Quantile -> Bool
Quantile -> Quantile -> Ordering
Quantile -> Quantile -> Quantile
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Quantile -> Quantile -> Quantile
$cmin :: Quantile -> Quantile -> Quantile
max :: Quantile -> Quantile -> Quantile
$cmax :: Quantile -> Quantile -> Quantile
>= :: Quantile -> Quantile -> Bool
$c>= :: Quantile -> Quantile -> Bool
> :: Quantile -> Quantile -> Bool
$c> :: Quantile -> Quantile -> Bool
<= :: Quantile -> Quantile -> Bool
$c<= :: Quantile -> Quantile -> Bool
< :: Quantile -> Quantile -> Bool
$c< :: Quantile -> Quantile -> Bool
compare :: Quantile -> Quantile -> Ordering
$ccompare :: Quantile -> Quantile -> Ordering
Ord)

instance Bounded Quantile where
  minBound :: Quantile
minBound = Int -> Quantile
Q Int
1
  maxBound :: Quantile
maxBound = Int -> Quantile
Q Int
99