summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlexanderBondarenko <>2015-01-24 09:59:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2015-01-24 09:59:00 (GMT)
commit833d0f21d2d6e4572dc032f548496a0f1ed1a215 (patch)
treee9ccb4f622cc206dc3b9f3ebf6a41f1fd48cacab
version 0.2.0.0HEAD0.2.0.0master
-rw-r--r--CHANGELOG.md3
-rw-r--r--LICENSE20
-rw-r--r--Setup.hs2
-rw-r--r--examples/dd-event.hs9
-rw-r--r--src/Network/StatsD.hs11
-rw-r--r--src/Network/StatsD/Datagram.hs68
-rw-r--r--src/Network/StatsD/Event.hs68
-rw-r--r--src/Network/StatsD/Metric.hs91
-rw-r--r--src/Network/StatsD/Socket.hs56
-rw-r--r--src/Network/StatsD/Tags.hs31
-rw-r--r--statsd-datadog.cabal51
11 files changed, 410 insertions, 0 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..6c2cc5f
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,3 @@
+## 0.2.0.0
+
+ * Initial import.
diff --git a/LICENSE b/LICENSE
new file mode 100644
index 0000000..0675015
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,20 @@
+Copyright (c) 2015 Alexander Bondarenko
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/examples/dd-event.hs b/examples/dd-event.hs
new file mode 100644
index 0000000..9a74209
--- /dev/null
+++ b/examples/dd-event.hs
@@ -0,0 +1,9 @@
+import Network.StatsD
+import qualified Data.Text as T
+
+main :: IO ()
+main = do
+ sd <- connectStatsD "localhost" "81250"
+ sendStatsDIO sd (event "title" "text")
+ { eSourceType = Just "console"
+ }
diff --git a/src/Network/StatsD.hs b/src/Network/StatsD.hs
new file mode 100644
index 0000000..ff7f296
--- /dev/null
+++ b/src/Network/StatsD.hs
@@ -0,0 +1,11 @@
+module Network.StatsD
+ ( module Network.StatsD.Socket
+ , module Network.StatsD.Metric
+ , module Network.StatsD.Event
+ , module Network.StatsD.Tags
+ ) where
+
+import Network.StatsD.Socket (StatsD, connectStatsD, sendStatsDIO, withStatsD, statsd)
+import Network.StatsD.Metric (gauge, gaugeInc, gaugeDec, counter, counter_, histogram, timer, Metric(..))
+import Network.StatsD.Event (event, Event(..))
+import Network.StatsD.Tags (tagged)
diff --git a/src/Network/StatsD/Datagram.hs b/src/Network/StatsD/Datagram.hs
new file mode 100644
index 0000000..c17f3e2
--- /dev/null
+++ b/src/Network/StatsD/Datagram.hs
@@ -0,0 +1,68 @@
+module Network.StatsD.Datagram
+ ( -- * Extensible serialization class.
+ ToDatagram(..), Datagram(..)
+ , renderDatagram
+ -- * Some helpers.
+ , fromDouble
+ , prefixed, mprefixed
+ , tags
+ ) where
+
+import Data.List (intersperse)
+import Data.Monoid
+import qualified Data.ByteString.Char8 as BS
+import qualified Data.Text as T
+import qualified Data.Text.Encoding as T
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Builder as TB
+import Text.Printf (printf)
+
+newtype Datagram = Datagram TB.Builder
+
+class ToDatagram a where
+ toDatagram :: a -> Datagram
+
+instance ToDatagram Datagram where
+ toDatagram = id
+
+-- | Collect builder data and prepare it to be sent on a wire.
+renderDatagram :: ToDatagram a => a -> BS.ByteString
+renderDatagram x =
+ let (Datagram lb) = toDatagram x
+ in T.encodeUtf8 . TL.toStrict $ TB.toLazyText lb
+
+-- | For debug purposes only.
+instance Show Datagram where
+ show (Datagram lb) = TL.unpack $ TB.toLazyText lb
+
+-- * Helpers
+
+fromDouble :: Double -> T.Text
+fromDouble = T.pack . printf "%f"
+
+prefixed :: Char -> T.Text -> TB.Builder
+prefixed p value = mconcat
+ [ TB.singleton '|'
+ , TB.singleton p
+ , TB.singleton ':'
+ , TB.fromText value
+ ]
+
+mprefixed :: Char -> Maybe T.Text -> TB.Builder
+mprefixed p = maybe mempty (prefixed p)
+
+tags :: [(T.Text, T.Text)] -> TB.Builder
+tags ts =
+ let tag (k, v)
+ | v == T.empty = TB.fromText k
+ | otherwise =
+ TB.fromText k <>
+ TB.singleton ':' <>
+ TB.fromText v
+
+ in mconcat $ case ts of
+ [] -> mempty
+ _ -> TB.fromText "|#" :
+ ( intersperse (TB.singleton ',')
+ $ map tag ts
+ )
diff --git a/src/Network/StatsD/Event.hs b/src/Network/StatsD/Event.hs
new file mode 100644
index 0000000..9d441e6
--- /dev/null
+++ b/src/Network/StatsD/Event.hs
@@ -0,0 +1,68 @@
+-- | Datadog extension to statsd protocol for custom events to appear in your HQ.
+
+module Network.StatsD.Event
+ ( Event(..), event
+ ) where
+
+import Network.StatsD.Datagram
+import Network.StatsD.Tags
+
+import Data.Monoid
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Lazy.Builder as TB
+
+-- | Set event fields for fancy effects in event log.
+data Event = Event
+ { eTitle :: Text
+ , eText :: Text
+ , eDate :: Maybe Text
+ , eHostname :: Maybe Text
+ , eAggrKey :: Maybe Text
+ , ePriority :: Maybe Text
+ , eSourceType :: Maybe Text
+ , eAlertType :: Maybe Text
+ , eTags :: [(Text, Text)]
+ } deriving (Show)
+
+-- | Construct a basic event.
+event :: Text -> Text -> Event
+event title text = Event
+ { eTitle = title
+ , eText = text
+ , eDate = Nothing
+ , eHostname = Nothing
+ , eAggrKey = Nothing
+ , ePriority = Nothing
+ , eSourceType = Nothing
+ , eAlertType = Nothing
+ , eTags = []
+ }
+
+instance ToDatagram Event where
+ toDatagram (Event{..}) =
+ let header =
+ [ TB.fromText "_e{"
+ , TB.fromString . show $ T.length eTitle
+ , TB.singleton ','
+ , TB.fromString . show $ T.length eText
+ , TB.fromText "}:"
+ , TB.fromText eTitle
+ , TB.singleton '|'
+ , TB.fromText eText
+ ]
+
+ in Datagram $ mconcat
+ [ mconcat header
+ , mprefixed 'd' eDate
+ , mprefixed 'h' eHostname
+ , mprefixed 'k' eAggrKey
+ , mprefixed 'p' ePriority
+ , mprefixed 's' eSourceType
+ , mprefixed 't' eAlertType
+ , tags eTags
+ ]
+
+instance Tagged Event where
+ getTags = eTags
+ setTags e ts = e { eTags = ts }
diff --git a/src/Network/StatsD/Metric.hs b/src/Network/StatsD/Metric.hs
new file mode 100644
index 0000000..f9c1c82
--- /dev/null
+++ b/src/Network/StatsD/Metric.hs
@@ -0,0 +1,91 @@
+module Network.StatsD.Metric
+ ( -- * Metric constructors
+
+ -- ** Gauge
+ gauge, gaugeInc, gaugeDec
+
+ -- ** Counter
+ , counter, counter_
+
+ -- ** Histogram
+ , histogram, timer
+
+ -- ** Set
+ , set
+
+ -- * Metric container
+ , Metric(..), metric
+
+ ) where
+
+import Network.StatsD.Datagram
+import Network.StatsD.Tags
+
+import Data.Monoid
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Text.Lazy.Builder as TB
+import Text.Printf (printf)
+
+-- | Generic StatsD metric.
+data Metric = Metric
+ { mName :: Text
+ , mValue :: Text
+ , mType :: Text
+ , mSampleRate :: Maybe Double
+ , mTags :: Tags
+ } deriving (Show)
+
+-- | Create a basic Metric for custom type.
+metric :: Text -> Text -> Text -> Metric
+metric n v t = Metric
+ { mName = n
+ , mValue = v
+ , mType = t
+ , mSampleRate = Nothing
+ , mTags = []
+ }
+
+instance ToDatagram Metric where
+ toDatagram (Metric{..}) =
+ let base = [ TB.fromText mName
+ , TB.singleton ':'
+ , TB.fromText mValue
+ , TB.singleton '|'
+ , TB.fromText mType
+ ]
+
+ sr = case mSampleRate of
+ Nothing -> mempty
+ Just rate -> TB.fromText "|@" <>
+ TB.fromString (printf "%f" rate)
+
+ in Datagram $ mconcat base <> sr <> tags mTags
+
+instance Tagged Metric where
+ getTags = mTags
+ setTags m ts = m { mTags = ts }
+
+gauge :: Text -> Double -> Metric
+gauge name value = metric name (fromDouble value) "g"
+
+gaugeInc :: Text -> Double -> Metric
+gaugeInc name value = metric name ("+" <> fromDouble value) "g"
+
+gaugeDec :: Text -> Double -> Metric
+gaugeDec name value = metric name ("-" <> fromDouble value) "g"
+
+counter :: Text -> Integer -> Metric
+counter name value = metric name (T.pack $ show value) "c"
+
+counter_ :: Text -> Metric
+counter_ name = counter name 1
+
+histogram :: Text -> Double -> Metric
+histogram name value = metric name (fromDouble value) "h"
+
+timer :: Text -> Double -> Metric
+timer name value = metric name (fromDouble value) "ms"
+
+set :: Text -> Text -> Metric
+set name item = metric name item "s"
diff --git a/src/Network/StatsD/Socket.hs b/src/Network/StatsD/Socket.hs
new file mode 100644
index 0000000..0c635f9
--- /dev/null
+++ b/src/Network/StatsD/Socket.hs
@@ -0,0 +1,56 @@
+module Network.StatsD.Socket
+ ( connectStatsD, sendStatsDIO, StatsD
+ , withStatsD, HasStatsD(..)
+ , statsd
+ ) where
+
+import Network.StatsD.Datagram
+
+import Control.Monad.Base
+import Control.Monad.Trans.Control
+import qualified Network.Socket as S
+import qualified Network.Socket.ByteString as SB
+
+-- * Basic types and actions
+
+-- | Socket container.
+data StatsD = StatsD
+ { sdSocket :: S.Socket
+ , sdSockAddr :: S.SockAddr
+ }
+
+-- | Initialize a StatsD container.
+connectStatsD :: String -> String -> IO StatsD
+connectStatsD hostname port = do
+ ais <- S.getAddrInfo Nothing (Just hostname) (Just port)
+ addr <- case ais of
+ ai:_ -> return ai
+ _ -> fail "StatsD connection failed: bad address."
+
+ sock <- S.socket (S.addrFamily addr) S.Datagram S.defaultProtocol
+
+ return $ StatsD sock (S.addrAddress addr)
+
+-- | Send a metric or an event to a connected statsd.
+sendStatsDIO :: ToDatagram a => StatsD -> a -> IO ()
+sendStatsDIO sd x = do
+ let payload = renderDatagram $ toDatagram x
+ SB.sendAllTo (sdSocket sd) payload (sdSockAddr sd)
+
+-- * StatsD-providing monads
+
+class (MonadBaseControl IO m) => HasStatsD m where
+ getStatsD :: m StatsD
+
+-- | Extract a StatsD state from application monad stack.
+withStatsD :: (HasStatsD m, MonadBaseControl IO m)
+ => (StatsD -> m a)
+ -> m a
+withStatsD action = getStatsD >>= action
+
+-- | Send a metric or an event from application monad.
+statsd :: (HasStatsD m, ToDatagram a)
+ => a
+ -> m ()
+statsd payload = withStatsD $ \sd ->
+ liftBase (sendStatsDIO sd payload)
diff --git a/src/Network/StatsD/Tags.hs b/src/Network/StatsD/Tags.hs
new file mode 100644
index 0000000..2dc768f
--- /dev/null
+++ b/src/Network/StatsD/Tags.hs
@@ -0,0 +1,31 @@
+module Network.StatsD.Tags
+ ( Tags
+ , tagged
+ , Tagged(..)
+ , ToTag(..)
+ ) where
+
+import Data.Text (Text)
+import Data.Monoid
+
+type Tags = [(Text, Text)]
+
+class Tagged a where
+ getTags :: a -> Tags
+ setTags :: a -> Tags -> a
+
+class ToTag a where
+ toTag :: a -> (Text, Text)
+
+instance ToTag (Text, Text) where
+ toTag = id
+
+instance ToTag Text where
+ toTag t = (t, "")
+
+-- | Add tags (with or without values). Due to OverloadedStrings instances interference you have to pin types using `Data.Text.pack` or @::@.
+--
+-- > counter_ "pings" `tagged` [ T.pack "success", "icmp" :: Text, "default" ]
+-- > `tagged` [ (T.pack "valued", "42" :: Text), ("it", "works") ]
+tagged :: (Tagged a, ToTag t) => a -> [t] -> a
+tagged a ts = setTags a (getTags a <> map toTag ts)
diff --git a/statsd-datadog.cabal b/statsd-datadog.cabal
new file mode 100644
index 0000000..96991c4
--- /dev/null
+++ b/statsd-datadog.cabal
@@ -0,0 +1,51 @@
+name: statsd-datadog
+version: 0.2.0.0
+synopsis: DataDog-flavored StatsD client.
+description:
+ StatsD client for UDP protocol.
+ .
+ > import Network.StatsD
+ >
+ > main = do
+ > sd <- connectStatsD "localhost" "8125"
+ > sendStatsDIO sd (counter_ "launches")
+ > sendStatsDIO sd (event "Datadog extensions" "DD Agent provides a statsd protocol extension for events.")
+
+homepage: https://bitbucket.org/dpwiz/statsd-datadog
+license: MIT
+license-file: LICENSE
+author: Alexander Bondarenko
+maintainer: aenor.realm@gmail.com
+copyright: (c) 2015 Alexander Bondarenko
+category: Network
+build-type: Simple
+extra-source-files: CHANGELOG.md
+ examples/*.hs
+cabal-version: >=1.10
+
+library
+ exposed-modules: Network.StatsD
+ , Network.StatsD.Socket
+ , Network.StatsD.Metric
+ , Network.StatsD.Event
+ , Network.StatsD.Datagram
+ , Network.StatsD.Tags
+
+ hs-source-dirs: src
+ ghc-options: -Wall
+ default-language: Haskell2010
+ default-extensions: FlexibleContexts
+ , FlexibleInstances
+ , RecordWildCards
+ , OverloadedStrings
+
+ build-depends: base >=4.7 && <5
+ , monad-control
+ , transformers-base
+ , network
+ , bytestring
+ , text
+
+source-repository head
+ type: git
+ location: git@bitbucket.org:dpwiz/statsd-datadog.git