module System.Metrics.Json
(
BeatEvent(..)
, Beat(..)
, BulkRequest(..)
, CreateBulk(..)
, sampleToJson
, valueToJson
, sampleBeatEvents
, beat, timestamp, beatTags, ekg, rtt
, Sample(..)
, Value(..)
) where
import Control.Lens hiding ((.=))
import Data.Aeson ((.=))
import qualified Data.Aeson as A
import qualified Data.Aeson.Types as A
import qualified Data.ByteString.Lazy as LBS
import qualified Data.HashMap.Strict as M
import Data.Int (Int64)
import Data.Monoid ((<>))
import Data.Text (Text)
import qualified Data.Text as T
import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime)
import GHC.Generics (Generic)
import Network.HostName (getHostName)
import Network.HTTP.Client (RequestBody (..), requestBody)
import Network.Wreq.Types
import qualified System.Metrics as Metrics
import qualified System.Metrics.Distribution as Distribution
data Beat = Beat {
hostname :: !Text
, name :: !Text
, version :: !Text
} deriving (Generic)
instance A.ToJSON Beat
newtype CreateBulk = CreateBulk { _index :: Text }
instance A.ToJSON CreateBulk where
toJSON (CreateBulk idx) = A.object
[ "index" .= A.object [ "_index" .= idx
, "_type" .= ("metricsets" :: Text)
]
]
data BeatEvent = BeatEvent {
_beat :: !Beat
, _timestamp :: !POSIXTime
, _beatTags :: ![Text]
, _rtt :: !Int
, _ekg :: !Metrics.Sample
}
makeLenses ''BeatEvent
instance A.ToJSON BeatEvent where
toJSON b =
A.object
[ "beat" .= (b ^. beat)
, "metricset" .= metricset
, "@timestamp" .= (floor . (*1000) $ b ^. timestamp :: Integer)
, "ekg" .= sampleToJson (b ^. ekg)
, "type" .= ("metricsets" :: Text)
]
where
metricset = A.object
[ "module" .= ("ekg" :: Text)
, "name" .= ("ekg" :: Text)
, "rtt" .= (b ^. rtt)
]
newtype BulkRequest = BulkRequest [(CreateBulk, BeatEvent)]
instance Postable BulkRequest where
postPayload (BulkRequest docs) req = return $ req { requestBody = RequestBodyLBS body}
where
body = (<> "\n") . LBS.intercalate "\n" . concatMap encodeBoth $ docs
encodeBoth (cb, be) = [A.encode cb, A.encode be]
sampleBeatEvents :: Metrics.Store -> [Text] -> IO [BeatEvent]
sampleBeatEvents store extraTags = do
now <- getPOSIXTime
sample <- Metrics.sampleAll store
host <- T.pack <$> getHostName
finish <- getPOSIXTime
let took = floor $ (finish now) * 1000
theBeat = Beat host "ekg" "0.1"
mkBeatEvt evts k v = BeatEvent theBeat now extraTags took (M.singleton k v) : evts
return $ M.foldlWithKey' mkBeatEvt [] sample
sampleToJson :: Metrics.Sample -> A.Value
sampleToJson metrics =
buildOne metrics A.emptyObject
where
buildOne :: M.HashMap T.Text Metrics.Value -> A.Value -> A.Value
buildOne m o = M.foldlWithKey' build o m
build :: A.Value -> T.Text -> Metrics.Value -> A.Value
build m key = go m (T.splitOn "." key)
go :: A.Value -> [T.Text] -> Metrics.Value -> A.Value
go (A.Object m) [str] val = A.Object $ M.insert str metric m
where metric = valueToJson val
go (A.Object m) (str:rest) val = case M.lookup str m of
Nothing -> A.Object $ M.insert str (go A.emptyObject rest val) m
Just m' -> A.Object $ M.insert str (go m' rest val) m
go v _ _ = typeMismatch "Object" v
typeMismatch :: String
-> A.Value
-> a
typeMismatch expected actual =
error $ "when expecting a " ++ expected ++ ", encountered " ++ typ ++
" instead"
where
typ = case actual of
A.Object _ -> "Object"
A.Array _ -> "Array"
A.String _ -> "String"
A.Number _ -> "Number"
A.Bool _ -> "Boolean"
A.Null -> "Null"
valueToJson :: Metrics.Value -> A.Value
valueToJson (Metrics.Counter n) = scalarToJson n CounterType
valueToJson (Metrics.Gauge n) = scalarToJson n GaugeType
valueToJson (Metrics.Label l) = scalarToJson l LabelType
valueToJson (Metrics.Distribution l) = distrubtionToJson l
scalarToJson :: A.ToJSON a => a -> MetricType -> A.Value
scalarToJson val ty = A.object
[metricType ty .= val]
data MetricType =
CounterType
| GaugeType
| LabelType
| DistributionType
metricType :: MetricType -> T.Text
metricType CounterType = "count"
metricType GaugeType = "gauge"
metricType LabelType = "label"
metricType DistributionType = "dist"
distrubtionToJson :: Distribution.Stats -> A.Value
distrubtionToJson stats = A.object
[ "mean" .= Distribution.mean stats
, "variance" .= Distribution.variance stats
, "count" .= Distribution.count stats
, "sum" .= Distribution.sum stats
, "min" .= Distribution.min stats
, "max" .= Distribution.max stats
]
newtype Sample = Sample Metrics.Sample
deriving Show
instance A.ToJSON Sample where
toJSON (Sample s) = sampleToJson s
newtype Value = Value Metrics.Value
deriving Show
instance A.ToJSON Value where
toJSON (Value v) = valueToJson v