{-# 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
#if MIN_VERSION_hedis(0,12,0)
import           Database.Redis        as R
#else
import           Database.Redis        as R hiding (HostName, time)
#endif
import GHC.Generics
-------------------------------------------------------------------------------
import qualified Instrument.Counter as C
import qualified Instrument.Sampler as S
import Network.HostName

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

-------------------------------------------------------------------------------
createInstrumentPool :: ConnectInfo -> IO Connection
createInstrumentPool ci = do
  c <-
    connect
      ci
        { connectMaxIdleTime = 15,
          connectMaxConnections = 1
        }
  return c

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

newtype MetricName = MetricName
  { metricName :: String
  }
  deriving (Eq, Show, Generic, Ord, IsString, Serialize)

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

data InstrumentConfig = ICfg
  { redisQueueBound :: Maybe Integer
  }

instance Default InstrumentConfig where
  def = ICfg Nothing

-- | Submitted package of collected samples
data SubmissionPacket_v0 = SP_v0
  { -- | Timing of this submission
    spTimeStamp_v0 :: !Double,
    -- | Who sent it
    spHostName_v0 :: !HostName,
    -- | Metric name
    spName_v0 :: String,
    -- | Collected values
    spPayload_v0 :: Payload
  }
  deriving (Eq, Show, Generic)

instance Serialize SubmissionPacket_v0

data SubmissionPacket = SP
  { -- | Timing of this submission
    spTimeStamp :: !Double,
    -- | Metric name
    spName :: !MetricName,
    -- | Collected values
    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"
    spDimensions :: !Dimensions
  }
  deriving (Eq, Show, Generic)

instance Serialize SubmissionPacket where
  get = (to <$> gGet) <|> (upgradeSP0 <$> Ser.get)

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

upgradeSP0 :: SubmissionPacket_v0 -> SubmissionPacket
upgradeSP0 SP_v0 {..} =
  SP
    { spTimeStamp = spTimeStamp_v0,
      spName = MetricName spName_v0,
      spPayload = spPayload_v0,
      spDimensions = M.singleton hostDimension (DimensionValue (T.pack spHostName_v0))
    }

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

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

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

-- | 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 (Show, Eq)

-------------------------------------------------------------------------------
newtype DimensionName = DimensionName
  { dimensionName :: Text
  }
  deriving (Eq, Ord, Show, Generic, Serialize, IsString)

-------------------------------------------------------------------------------
newtype DimensionValue = DimensionValue
  { dimensionValue :: Text
  }
  deriving (Eq, Ord, Show, Generic, Serialize, IsString)

-------------------------------------------------------------------------------
data Payload
  = Samples {unSamples :: [Double]}
  | Counter {unCounter :: Int}
  deriving (Eq, Show, Generic)

instance Serialize Payload

-------------------------------------------------------------------------------
data Aggregated_v0 = Aggregated_v0
  { -- | Timestamp for this aggregation
    aggTS_v0 :: Double,
    -- | Name of the metric
    aggName_v0 :: String,
    -- | The aggregation level/group for this stat
    aggGroup_v0 :: B.ByteString,
    -- | Calculated stats for the metric
    aggPayload_v0 :: AggPayload
  }
  deriving (Eq, Show, Generic)

instance Serialize Aggregated_v0

data Aggregated_v1 = Aggregated_v1
  { -- | Timestamp for this aggregation
    aggTS_v1 :: Double,
    -- | Name of the metric
    aggName_v1 :: MetricName,
    -- | The aggregation level/group for this stat
    aggGroup_v1 :: B.ByteString,
    -- | Calculated stats for the metric
    aggPayload_v1 :: AggPayload
  }
  deriving (Eq, Show, Generic)

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

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

instance Serialize Aggregated_v1 where
  get = (to <$> gGet) <|> (upgradeAggregated_v0 <$> Ser.get)

data Aggregated = Aggregated
  { -- | Timestamp for this aggregation
    aggTS :: Double,
    -- | Name of the metric
    aggName :: MetricName,
    -- | Calculated stats for the metric
    aggPayload :: AggPayload,
    aggDimensions :: Dimensions
  }
  deriving (Eq, Show, Generic)

upgradeAggregated_v1 :: Aggregated_v1 -> Aggregated
upgradeAggregated_v1 a =
  Aggregated
    { aggTS = aggTS_v1 a,
      aggName = aggName_v1 a,
      aggPayload = aggPayload_v1 a,
      aggDimensions = Monoid.mempty
    }

instance SC.Migrate Aggregated where
  type MigrateFrom Aggregated = Aggregated_v1
  migrate = upgradeAggregated_v1

instance Serialize Aggregated where
  get = (to <$> gGet) <|> (upgradeAggregated_v1 <$> Ser.get)

-- | Resulting payload for metrics aggregation
data AggPayload
  = AggStats Stats
  | AggCount Int
  deriving (Eq, Show, Generic)

instance Serialize AggPayload

instance Default AggPayload where
  def = AggStats def

instance Default Aggregated where
  def = Aggregated 0 "" def mempty

-------------------------------------------------------------------------------
data Stats = Stats
  { smean :: Double,
    ssum :: Double,
    scount :: Int,
    smax :: Double,
    smin :: Double,
    srange :: Double,
    sstdev :: Double,
    sskewness :: Double,
    skurtosis :: Double,
    squantiles :: M.Map Int Double
  }
  deriving (Eq, Show, Generic)

instance Default Stats where
  def = Stats 0 0 0 0 0 0 0 0 0 mempty

instance Serialize Stats

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

-- | Integer quantile, valid values range from 1-99, inclusive.
newtype Quantile = Q {quantile :: Int} deriving (Show, Eq, Ord)

instance Bounded Quantile where
  minBound = Q 1
  maxBound = Q 99

-------------------------------------------------------------------------------
$(SC.deriveSafeCopy 0 'SC.base ''Payload)
$(SC.deriveSafeCopy 0 'SC.base ''SubmissionPacket_v0)
$(SC.deriveSafeCopy 1 'SC.extension ''SubmissionPacket)
$(SC.deriveSafeCopy 0 'SC.base ''AggPayload)
$(SC.deriveSafeCopy 0 'SC.base ''Aggregated_v0)
$(SC.deriveSafeCopy 1 'SC.extension ''Aggregated_v1)
$(SC.deriveSafeCopy 2 'SC.extension ''Aggregated)
$(SC.deriveSafeCopy 0 'SC.base ''Stats)
$(SC.deriveSafeCopy 0 'SC.base ''DimensionName)
$(SC.deriveSafeCopy 0 'SC.base ''DimensionValue)
$(SC.deriveSafeCopy 0 'SC.base ''MetricName)
