packages feed

librato (empty) → 0.1.0.0

raw patch · 8 files changed

+337/−0 lines, 8 filesdep +aesondep +attoparsecdep +basesetup-changed

Dependencies added: aeson, attoparsec, base, bytestring, either, http-client, http-conduit, http-types, mtl, resourcet, text, unordered-containers, uri-templater, vector

Files

+ LICENSE view
@@ -0,0 +1,20 @@+The MIT License (MIT)++Copyright (c) 2013 SaneTracker++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.
+ README.md view
@@ -0,0 +1,4 @@+librato+=======++Haskell bindings to the Librato API
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ librato.cabal view
@@ -0,0 +1,52 @@+-- Initial librato.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                librato+version:             0.1.0.0+synopsis:            Bindings to the Librato API+-- description:         +homepage:            https://github.com/SaneTracker/librato+license:             MIT+license-file:        LICENSE+author:              Ian Duncan+maintainer:          ian@iankduncan.com+-- copyright:           +category:            Network+build-type:          Simple+extra-source-files:  README.md+cabal-version:       >=1.10++library+  exposed-modules:     Librato.Types,+                       Librato.Internal,+                       Librato,+                       -- Librato.Alerts,+                       -- Librato.Annotations,+                       -- Librato.ApiTokens,+                       -- Librato.ChartTokens,+                       -- Librato.Dashboards,+                       -- Librato.Instruments,+                       -- Librato.Jobs,+                       Librato.Metrics+                       -- Librato.Services,+                       -- Librato.Sources,+                       -- Librato.Tags,+                       -- Librato.Users+  -- other-modules:       +  -- other-extensions:    +  build-depends:       base < 5,+                       bytestring,+                       http-client,+                       http-conduit,+                       text,+                       aeson,+                       vector,+                       unordered-containers,+                       resourcet,+                       mtl,+                       http-types,+                       attoparsec,+                       uri-templater == 0.1.*,+                       either+  hs-source-dirs:      src+  default-language:    Haskell2010
+ src/Librato.hs view
@@ -0,0 +1,36 @@+module Librato (+  withLibrato,+  module Librato.Metrics,+  module Librato.Types+) where+import Librato.Internal+import Librato.Types+import Librato.Metrics++--data DisplayAttribute+--  = Color+--  | DisplayMax+--  | DisplayMin+--  | DisplayUnitsLong+--  | DisplayUnitsShort+--  | DisplayStacked+--  | DisplayTransform++--data GaugeAttribute+--  = SummarizeFunction+--  | Aggregate++--data Metric =+--  Gauge+--    { +--    ,+--    }+--  Counter+--    {    }++--data Measurement = Measurement+--  { name+--  , value+--  , measureTime+--  , source+--  , }
+ src/Librato/Internal.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}+module Librato.Internal where+import Control.Applicative+import Control.Monad.Reader+import Control.Monad.Trans.Either+import Control.Monad.Trans.Resource+import Data.Aeson+import qualified Data.ByteString as B (ByteString)+import Data.ByteString.Lazy (ByteString)+import Data.Maybe+import Data.Monoid+import Librato.Types+import Network.HTTP.Conduit+import Network.HTTP.Types.Method+import Network.HTTP.Types.URI (Query, renderQuery, urlEncode)++newtype Librato a = Librato+  { fromLibrato :: EitherT LibratoError (ReaderT (Request, Manager) (ResourceT IO)) a+  } deriving (Functor, Applicative, Monad, MonadIO)++withLibrato :: B.ByteString -> B.ByteString -> (LibratoConfig -> ResourceT IO a) -> IO a+withLibrato username token f = withManager $ \m -> f $ LibratoConfig username token m++librato :: LibratoConfig -> Librato a -> ResourceT IO (Either LibratoError a)+librato s m = runReaderT (runEitherT (fromLibrato m)) $ (request s, libratoManager s)++addUserAgent :: Request -> Request+addUserAgent r = r+  { requestHeaders = ("User-Agent", "librato/0.0.1 (Haskell)") : requestHeaders r+  }++libratoRequest :: Request+libratoRequest = fromJust $ parseUrl "https://metrics-api.librato.com/v1/"++request :: LibratoConfig -> Request+request (LibratoConfig account token _) = useJSON $ addUserAgent $ applyBasicAuth account token $ libratoRequest++--libratoTest :: (LibratoConfig -> ResourceT IO a) -> ResourceT IO a++getResponse :: (Request -> Request) -> Librato (Response ByteString)+getResponse f = Librato $ do+  (req, man) <- lift $ ask+  let modifiedReq = f req+  lift $ lift $ httpLbs modifiedReq man++decodeResponse :: Response ByteString -> Librato Value+decodeResponse resp = Librato $ case decodeToJSON resp of+    Left err -> left $ JsonError err+    Right val -> return val++useJSON :: Request -> Request+useJSON r = r+  { requestHeaders = ("Content-Type", "application/json") : ("Accept", "application/json") : requestHeaders r+  }++decodeToJSON :: Response ByteString -> Either String Value+decodeToJSON = eitherDecode . responseBody++appendUrl :: B.ByteString -> Request -> Request+appendUrl b r = r+  { path = path r <> b+  }++get :: B.ByteString -> Request -> Request+get b r = appendUrl b $ r+  { method = methodGet+  }++put :: B.ByteString -> Request -> Request+put b r = appendUrl b $ r+  { method = methodPut+  }++post :: B.ByteString -> Request -> Request+post b r = appendUrl b $ r+  { method = methodPost+  }++delete :: B.ByteString -> Request -> Request+delete b r = appendUrl b $ r+  { method = methodDelete+  }++query :: Query -> Request -> Request+query q r = r+  { queryString = renderQuery True q+  }++jsonBody :: ToJSON a => a -> Request -> Request+jsonBody x r = r+  { requestBody = RequestBodyLBS $ encode x+  }++segment :: B.ByteString -> B.ByteString+segment = urlEncode False
+ src/Librato/Metrics.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE OverloadedStrings #-}+module Librato.Metrics where+import Data.Aeson+import Data.ByteString (ByteString)+import Data.Monoid ((<>))+import Data.Text (Text)+import Data.Vector (Vector)+import Librato.Internal+import Librato.Types+import Network.HTTP.Types.URI++metrics :: ByteString+metrics = "metrics"++metric :: ByteString -> ByteString+metric name = "metrics/" <> segment name++data ListMetricsRequest = ListMetricsRequest+  { lmreqName :: Text+  , lmreqTag :: [Text]+  }++data Metric = GaugeMetric | CounterMetric++data ListMetricsResponse = ListMetricsResponse+  { lmrespQuery :: PaginationInfo+  , lmrespMetrics :: Vector Metric+  }++data Measurement = Measurement+  { mName :: Text+  , mValue :: Double+  , mSource :: Maybe Text+  , mMeasureTime :: Maybe Int+  } deriving (Show)++--data Gauge = Gauge+--  { gName+--  , gValue+--  , gSource+--  , gMeasureTime+--  , gCount+--  , gSum+--  , gMax+--  , gMin+--  , gSumSquares+--  }++type Gauge = Measurement+type Counter = Measurement++instance ToJSON Measurement where+  toJSON m = object+    [ "name" .= mName m+    , "value" .= mValue m+    , "source" .= mSource m+    , "measure_time" .= mMeasureTime m+    ]++listMetrics :: ListMetricsRequest -> PaginationParameters -> Librato Value+listMetrics _ _ = getResponse (get metrics) >>= decodeResponse++submitMetrics :: Vector Gauge -> Vector Counter -> Librato ()+submitMetrics gauges counters = do+  getResponse (post metrics . jsonBody json)+  return ()+  where+    json = object ["gauges" .= gauges, "counters" .= counters]++--updateMetrics :: -> Librato (Maybe (JobId ()))+--updateMetrics = put metrics++--deleteMetrics :: -> Librato (Maybe (JobId ()))+--deleteMetrics = delete metrics++--getMetric :: MetricName -> Librato (Maybe Metric)+--getMetric name = get (metric name)++--createMetric :: -> Librato (Maybe Metric)+--createMetric name = put (metric name)++--updateMetric :: -> Librato Bool+--updateMetric name = put (metric name)++--deleteMetric :: MetricName -> Librato Bool+--deleteMetric name = delete (metric name)
+ src/Librato/Types.hs view
@@ -0,0 +1,42 @@+module Librato.Types where+import Data.ByteString (ByteString)+import Data.HashMap.Strict (HashMap)+import Data.Text (Text)+import Data.Vector (Vector)+import Network.HTTP.Conduit (Manager)++data SortOrder = Ascending | Descending++data PaginationParameters = PaginationParameters+  { paginationOffset :: Maybe Int+  , paginationLength :: Maybe Int+  , paginationSort :: Maybe SortOrder+  }++data PaginationInfo = PaginationInfo+  { paginationInfoLength :: Int+  , paginationInfoOffset :: Int+  , paginationInfoTotal :: Int+  , paginationInfoFound :: Int+  }++data LibratoError+  = ParamErrors+    { paramErrors :: HashMap Text (Vector Text)+    }+  | RequestErrors+    { requestErrors :: Vector Text+    }+  | SystemErrors+    { systemErrors :: Vector Text+    }+  | JsonError+    { decodingError :: String+    }+  deriving (Show)++data LibratoConfig = LibratoConfig+  { libratoAccount :: ByteString+  , libratoToken :: ByteString+  , libratoManager :: Manager+  }