diff --git a/DEBT b/DEBT --- a/DEBT +++ b/DEBT @@ -3,4 +3,9 @@ This file is a log (in org-mode format) for all of the areas of the application, including devops, that need refactoring attention. - +1. [ ] The Query string params are just a list of pairs but it's super + cumbersome and I think we can clean it up bit with some custom data + types and a serializer. +2. [ ] The IdOrKey translation into the correct path string is messy + and I'm repeating the same where functions in many different + functions (which is bad!). diff --git a/src/Database/Tempodb/Methods.hs b/src/Database/Tempodb/Methods.hs --- a/src/Database/Tempodb/Methods.hs +++ b/src/Database/Tempodb/Methods.hs @@ -1,11 +1,13 @@ module Database.Tempodb.Methods ( module Database.Tempodb.Methods.Series +, module Database.Tempodb.Methods.Read +, module Database.Tempodb.Methods.Write ) where +import Database.Tempodb.Methods.Read import Database.Tempodb.Methods.Series ---import Database.Tempodb.Methods.Read ---import Database.Tempodb.Methods.Write +import Database.Tempodb.Methods.Write --import Database.Tempodb.Methods.Increment --import Database.Tempodb.Methods.Single --import Database.Tempodb.Methods.Delete diff --git a/src/Database/Tempodb/Methods/Read.hs b/src/Database/Tempodb/Methods/Read.hs --- a/src/Database/Tempodb/Methods/Read.hs +++ b/src/Database/Tempodb/Methods/Read.hs @@ -1,19 +1,37 @@ {-# LANGUAGE OverloadedStrings #-} module Database.Tempodb.Methods.Read ---( readOne +( readOne --, readMulti ---) +) where import Control.Monad.Reader import Data.Aeson as A import Data.ByteString.Char8 as C8 -import Data.ByteString.Lazy (fromStrict, toStrict) +import Data.ByteString.Lazy (fromStrict) import Data.Monoid import Database.Tempodb.Types import Database.Tempodb.Util import Network.HTTP.Base (urlEncodeVars) import Network.Http.Client ---readOne :: IdOrKey -> Tempodb (Maybe Series) +readOne :: IdOrKey -> Maybe QueryArgs -> Tempodb (Maybe SeriesData) +readOne q qa = do + auth <- ask + req <- liftIO . buildRequest $ do + http GET path + auth + + (_,result) <- liftIO $ runRequest req Nothing + return . A.decode $ fromStrict result + + where + ident (SeriesId i) = "/id/" <> i + ident (SeriesKey k) = "/key/" <> k + + path = rootpath <> "/series" <> (ident q) <> "/data" <> query + + query = case qa of + Nothing -> mempty + Just qry -> "?" <> (C8.pack $ urlEncodeVars qry) diff --git a/src/Database/Tempodb/Methods/Series.hs b/src/Database/Tempodb/Methods/Series.hs --- a/src/Database/Tempodb/Methods/Series.hs +++ b/src/Database/Tempodb/Methods/Series.hs @@ -39,7 +39,7 @@ setContentLength . fromIntegral $ C8.length postdata auth - result <- liftIO . runRequest req $ Just postdata + (_,result) <- liftIO . runRequest req $ Just postdata return . A.decode $ fromStrict result seriesGet :: IdOrKey -> Tempodb (Maybe Series) @@ -49,7 +49,7 @@ http GET path auth - result <- liftIO $ runRequest req Nothing + (_,result) <- liftIO $ runRequest req Nothing return . A.decode $ fromStrict result where @@ -60,10 +60,10 @@ seriesList :: Maybe QueryArgs -> Tempodb (Maybe [Series]) seriesList q = do req <- seriesCommon q GET - result <- liftIO $ runRequest req Nothing + (_,result) <- liftIO $ runRequest req Nothing return . A.decode $ fromStrict result -seriesDelete :: Maybe QueryArgs -> Tempodb ByteString +seriesDelete :: Maybe QueryArgs -> Tempodb (Int,ByteString) seriesDelete q = do req <- seriesCommon q DELETE liftIO $ runRequest req Nothing @@ -91,7 +91,7 @@ setContentLength . fromIntegral $ C8.length postdata auth - result <- liftIO . runRequest req $ Just postdata + (_,result) <- liftIO . runRequest req $ Just postdata return . A.decode $ fromStrict result where 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 @@ -3,15 +3,17 @@ module Database.Tempodb.Types where -import Prelude as P - import Control.Applicative import Control.Monad import Control.Monad.Reader import Data.Aeson import Data.ByteString.Char8 as C8 import Data.Map (Map) +import qualified Data.Text as T +import Data.Time import Network.Http.Client +import Prelude as P +import System.Locale -- | It's easy to mix up which one is first so let's newtype these -- suckers to make it explicit. @@ -63,8 +65,78 @@ , "attributes" .= a ] --- data SeriesData = SeriesData --- { series :: Series --- , start :: --- , end :: --- } +data Data = Data + { timestamp :: UTCTime + , value :: Double + } deriving (Show, Eq, Ord) + +data Rollup = Rollup + { interval :: ByteString + , function :: ByteString + , tz :: ByteString + } deriving (Show, Eq, Ord) + +data Summary = Summary + { mean :: Double + , sum :: Double + , min :: Double + , max :: Double + , stddev :: Double + , ss :: Double + , count :: Int + } deriving (Show, Eq, Ord) + +data SeriesData = SeriesData + { series :: Series + , start :: UTCTime + , end :: UTCTime + , values :: [Data] + , rollup :: Maybe Rollup + , summary :: Summary + } deriving (Show, Eq, Ord) + +instance FromJSON SeriesData where + parseJSON (Object o) = SeriesData <$> + o .: "series" <*> + o .: "start" <*> + o .: "end" <*> + o .: "data" <*> + o .: "rollup" <*> + o .: "summary" + + parseJSON _ = mzero + +instance FromJSON Data where + parseJSON (Object o) = Data <$> + o .: "t" <*> + o .: "v" + 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 FromJSON Rollup where + parseJSON (Object o) = Rollup <$> + o .: "interval" <*> + o .: "function" <*> + o .: "tz" + parseJSON _ = mzero + +instance FromJSON Summary where + parseJSON (Object o) = Summary <$> + o .: "mean" <*> + o .: "sum" <*> + o .: "min" <*> + o .: "max" <*> + o .: "stddev" <*> + o .: "ss" <*> + o .: "count" + parseJSON _ = mzero diff --git a/src/Database/Tempodb/Util.hs b/src/Database/Tempodb/Util.hs --- a/src/Database/Tempodb/Util.hs +++ b/src/Database/Tempodb/Util.hs @@ -1,12 +1,16 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE TupleSections #-} module Database.Tempodb.Util where import Blaze.ByteString.Builder.ByteString (fromByteString) +import Control.Exception (Exception, throw) import Data.ByteString.Char8 as C8 +import Data.Typeable import Network.Http.Client import OpenSSL (withOpenSSL) -import System.IO.Streams (write) +import System.IO.Streams (InputStream, write) type QueryArgs = [(String, String)] @@ -15,7 +19,7 @@ rootpath = "/v1" -- | Run a constructed request. -runRequest :: Request -> Maybe ByteString -> IO ByteString +runRequest :: Request -> Maybe ByteString -> IO (Int,ByteString) runRequest r b = withOpenSSL $ do withConnection (establishConnection "https://api.tempo-db.com") go where @@ -24,4 +28,21 @@ Just v -> (\o -> write (Just $ fromByteString v) o) go c = do sendRequest c r body - receiveResponse c concatHandler' + receiveResponse c concatHandlerSt' + +concatHandlerSt' :: Response -> InputStream ByteString -> IO (StatusCode,ByteString) +concatHandlerSt' p i = + if s >= 300 + then throw (HttpClientError s m) + else (concatHandler p i) >>= return . (s,) + where + s = getStatusCode p + m = getStatusMessage p + +data HttpClientError = HttpClientError Int ByteString + deriving (Typeable) + +instance Exception HttpClientError + +instance Show HttpClientError where + show (HttpClientError s msg) = Prelude.show s ++ " " ++ C8.unpack msg diff --git a/tempodb.cabal b/tempodb.cabal --- a/tempodb.cabal +++ b/tempodb.cabal @@ -1,5 +1,5 @@ name: tempodb -version: 0.1.1.1 +version: 0.2.0.0 synopsis: A small Haskell wrapper around the TempoDB api. description: TempoDB is a time-series database as-a-service with a @@ -36,7 +36,10 @@ aeson >= 0.6.2.1, io-streams >= 1.1.2.0, blaze-builder >= 0.3.2.0, - containers >= 0.5.0.0 + containers >= 0.5.0.0, + time >= 1.4.0.1, + old-locale >= 1.0.0.5, + text >= 0.11.3.1 default-language: Haskell2010