diff --git a/src/Database/Tempodb/Methods/Write.hs b/src/Database/Tempodb/Methods/Write.hs new file mode 100644 --- /dev/null +++ b/src/Database/Tempodb/Methods/Write.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Database.Tempodb.Methods.Write +( writeOne +, writeBulk +, writeMulti +) +where + +import Control.Monad.Reader +import Data.Aeson as A +import Data.ByteString.Char8 as C8 +import Data.ByteString.Lazy (fromStrict, toStrict) +import Data.Monoid +import Database.Tempodb.Types as T +import Database.Tempodb.Util +import Network.Http.Client + +writeOne :: IdOrKey -> Data -> Tempodb Bool +writeOne q d = do + let postdata = toStrict $ A.encode d + auth <- ask + req <- liftIO . buildRequest $ do + http POST path + setContentLength . fromIntegral $ C8.length postdata + auth + + liftIO . runRequest req $ Just postdata + + -- It will either throw an exception or return a Bool + return True + where + ident (T.SeriesId i) = "/id/" <> i + ident (T.SeriesKey k) = "/key/" <> k + path = rootpath <> "/series" <> (ident q) + +writeBulk :: Bulk -> Tempodb Bool +writeBulk d = do + let postData = toStrict $ A.encode d + auth <- ask + req <- liftIO . buildRequest $ do + http POST (rootpath <> "/data/") + setContentLength . fromIntegral $ C8.length postData + auth + + liftIO . runRequest req $ Just postData + + return True + +writeMulti :: [Data] -> T.Tempodb (Either (Maybe [Data]) Bool) +writeMulti d = do + let postData = toStrict $ A.encode d + auth <- ask + req <- liftIO . buildRequest $ do + http POST (rootpath <> "/multi/") + setContentLength . fromIntegral $ C8.length postData + auth + + (s, result) <- liftIO . runRequest req $ Just postData + return $ ( + if s < 207 + then Right True + else Left . A.decode $ fromStrict result) diff --git a/src/Database/Tempodb/Types.hs b/src/Database/Tempodb/Types.hs --- a/src/Database/Tempodb/Types.hs +++ b/src/Database/Tempodb/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE OverloadedStrings #-} @@ -7,10 +8,12 @@ import Control.Monad import Control.Monad.Reader import Data.Aeson +import Data.Aeson.Types (Parser) import Data.ByteString.Char8 as C8 import Data.Map (Map) import qualified Data.Text as T import Data.Time +import Data.Typeable (Typeable) import Network.Http.Client import Prelude as P import System.Locale @@ -20,6 +23,10 @@ newtype ApiKey = ApiKey {unKey :: ByteString} deriving (Show, Eq, Ord) newtype ApiSec = ApiSec {unSec :: ByteString} deriving (Show, Eq, Ord) +newtype TempoDBTime = TempoDBTime { + fromTempoDBTime :: UTCTime + } deriving (Eq, Ord, Read, Show, Typeable, FormatTime) + data BasicAuth = BasicAuth ApiKey ApiSec deriving (Show, Eq, Ord) @@ -66,10 +73,16 @@ ] data Data = Data - { timestamp :: UTCTime + { uid :: Maybe IdOrKey + , timestamp :: Maybe TempoDBTime , value :: Double } deriving (Show, Eq, Ord) +data Bulk = Bulk + { timestmp :: TempoDBTime + , bulkValues :: [Data] + } deriving (Show, Eq, Ord) + data Rollup = Rollup { interval :: ByteString , function :: ByteString @@ -88,8 +101,8 @@ data SeriesData = SeriesData { series :: Series - , start :: UTCTime - , end :: UTCTime + , start :: TempoDBTime + , end :: TempoDBTime , values :: [Data] , rollup :: Maybe Rollup , summary :: Summary @@ -106,22 +119,17 @@ parseJSON _ = mzero -instance FromJSON Data where - parseJSON (Object o) = Data <$> +instance FromJSON Bulk where + parseJSON (Object o) = Bulk <$> o .: "t" <*> - o .: "v" + o .: "data" parseJSON _ = mzero -instance ToJSON Data where - toJSON = buildData - -buildData :: Data -> Value -buildData (Data t v) = object - [ timest - , "v" .= v - ] - where - timest = ("t", String . T.pack $ formatTime defaultTimeLocale "%FT%H:%M:%S%Q%z" t) +instance ToJSON Bulk where + toJSON (Bulk t v) = object + [ "t" .= t + , "data" .= v + ] instance FromJSON Rollup where parseJSON (Object o) = Rollup <$> @@ -140,3 +148,50 @@ o .: "ss" <*> o .: "count" parseJSON _ = mzero + +instance ToJSON TempoDBTime where + toJSON (TempoDBTime t) = + String (T.pack (formatTime defaultTimeLocale "%FT%H:%M:%S%Q%z" t)) + +instance FromJSON TempoDBTime where + parseJSON (String t) = + case parseTime defaultTimeLocale "%FT%H:%M:%S%Q%z" (T.unpack t) of + Just d -> pure (TempoDBTime d) + _ -> mzero + parseJSON _ = mzero + +instance FromJSON Data where + parseJSON = parseSeriesData + +parseSeriesData :: Value -> Parser Data +parseSeriesData v = do + case v of + Object o -> do + -- Is the ID there? Or is the key element there? + kid <- (o .:? "id") >>= isUID o + ts <- o .:? "t" + val <- o .: "v" + return $ Data kid ts val + _ -> mzero + where + isUID o i = case i of + Nothing -> (o .:? "key") >>= isKEY + Just idval -> return . Just $ SeriesId idval + isKEY k = case k of + Nothing -> return Nothing + Just idkey -> return . Just $ SeriesKey idkey + +instance ToJSON Data where + toJSON = buildSeriesData + +buildSeriesData :: Data -> Value +buildSeriesData (Data i t v) = object . ts . eid $ ["v" .= v] + where + ts l = case t of + Nothing -> l + + Just tv -> ("t", toJSON tv):l + eid l = case i of + Nothing -> l + Just (SeriesId idv) -> ("id" .= idv):l + Just (SeriesKey kv) -> ("key".= kv) :l diff --git a/tempodb.cabal b/tempodb.cabal --- a/tempodb.cabal +++ b/tempodb.cabal @@ -1,5 +1,5 @@ name: tempodb -version: 0.2.0.2 +version: 0.2.1.0 synopsis: A small Haskell wrapper around the TempoDB api. description: TempoDB is a time-series database as-a-service with a @@ -27,15 +27,16 @@ hs-source-dirs: src cpp-options: -Dcabal ghc-options: -Wall -fno-warn-type-defaults -fno-warn-unused-do-bind + build-depends: base >= 4.6 && <4.7, - http-streams >= 0.6.1.1, + http-streams >= 0.7.0.2, mtl >= 2.1.2, HTTP >= 4000.2.9, HsOpenSSL >= 0.10.3.5, bytestring >= 0.10.4.0, aeson >= 0.6.2.1, io-streams >= 1.1.2.0, - blaze-builder >= 0.3.2.0, + blaze-builder >= 0.3.3.0, containers >= 0.5.0.0, time >= 1.4.0.1, old-locale >= 1.0.0.5, @@ -51,6 +52,7 @@ Database.Tempodb.Methods Database.Tempodb.Methods.Series Database.Tempodb.Methods.Read + Database.Tempodb.Methods.Write source-repository head Type: git