diff --git a/src/Database/Tempodb/Methods.hs b/src/Database/Tempodb/Methods.hs new file mode 100644 --- /dev/null +++ b/src/Database/Tempodb/Methods.hs @@ -0,0 +1,11 @@ +module Database.Tempodb.Methods +( module Database.Tempodb.Methods.Series +) +where + +import Database.Tempodb.Methods.Series +--import Database.Tempodb.Methods.Read +--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 new file mode 100644 --- /dev/null +++ b/src/Database/Tempodb/Methods/Read.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Database.Tempodb.Methods.Read +--( 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.Monoid +import Database.Tempodb.Types +import Database.Tempodb.Util +import Network.HTTP.Base (urlEncodeVars) +import Network.Http.Client + +--readOne :: IdOrKey -> Tempodb (Maybe Series) diff --git a/src/Database/Tempodb/Methods/Series.hs b/src/Database/Tempodb/Methods/Series.hs new file mode 100644 --- /dev/null +++ b/src/Database/Tempodb/Methods/Series.hs @@ -0,0 +1,100 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Database.Tempodb.Methods.Series +( seriesCreate +, seriesGet +, seriesList +, seriesUpdate +, seriesDelete +) +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 +import Database.Tempodb.Util +import Network.HTTP.Base (urlEncodeVars) +import Network.Http.Client + +-- | Top-level API methods are: +-- +-- 1. Series +-- 2. Read +-- 3. Write +-- 4. Increment +-- 5. Single +-- 6. Delete +-- +-- TODO: Docs... + +seriesCreate :: ByteString -> Tempodb (Maybe Series) +seriesCreate k = do + let postdata = "{\"key\": \"" <> k <> "\"}" + auth <- ask + req <- liftIO . buildRequest $ do + http POST $ rootpath <> "/series" + setContentLength . fromIntegral $ C8.length postdata + auth + + result <- liftIO . runRequest req $ Just postdata + return . A.decode $ fromStrict result + +seriesGet :: IdOrKey -> Tempodb (Maybe Series) +seriesGet q = 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) + +seriesList :: Maybe QueryArgs -> Tempodb (Maybe [Series]) +seriesList q = do + req <- seriesCommon q GET + result <- liftIO $ runRequest req Nothing + return . A.decode $ fromStrict result + +seriesDelete :: Maybe QueryArgs -> Tempodb ByteString +seriesDelete q = do + req <- seriesCommon q DELETE + liftIO $ runRequest req Nothing + +seriesCommon :: Maybe QueryArgs -> Method -> Tempodb Request +seriesCommon q method = do + auth <- ask + liftIO . buildRequest $ do + http method path + setContentLength 0 + auth + + where + root = rootpath <> "/series" + path = case q of + Nothing -> root + Just qry -> root <> "?" <> (C8.pack $ urlEncodeVars qry) + +seriesUpdate :: IdOrKey -> Series -> Tempodb (Maybe Series) +seriesUpdate q s = do + let postdata = toStrict $ A.encode s + auth <- ask + req <- liftIO . buildRequest $ do + http PUT path + setContentLength . fromIntegral $ C8.length postdata + auth + + result <- liftIO . runRequest req $ Just postdata + return . A.decode $ fromStrict result + + where + ident (SeriesId i) = "/id/" <> i + ident (SeriesKey k) = "/key/" <> k + path = rootpath <> "/series" <> (ident q) diff --git a/src/Database/Tempodb/Types.hs b/src/Database/Tempodb/Types.hs new file mode 100644 --- /dev/null +++ b/src/Database/Tempodb/Types.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE OverloadedStrings #-} + +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 Network.Http.Client + +-- | It's easy to mix up which one is first so let's newtype these +-- suckers to make it explicit. +newtype ApiKey = ApiKey {unKey :: ByteString} deriving (Show, Eq, Ord) +newtype ApiSec = ApiSec {unSec :: ByteString} deriving (Show, Eq, Ord) + +data BasicAuth = BasicAuth ApiKey ApiSec + deriving (Show, Eq, Ord) + +-- | Custom TempoDB ReaderT monad. +newtype Tempodb a = Tempodb { + runTDB :: ReaderT (RequestBuilder ()) IO a + } deriving (Monad, MonadIO, MonadReader (RequestBuilder ())) + +runTempoDB :: BasicAuth -> Tempodb a -> IO a +runTempoDB auth f = runReaderT (runTDB f) $ baseRequest auth + +baseRequest :: BasicAuth -> RequestBuilder () +baseRequest (BasicAuth k s) = + setAuthorizationBasic (unKey k) (unSec s) + +data IdOrKey = SeriesId ByteString | SeriesKey ByteString + deriving (Show, Eq, Ord) + +-- | Datatype for TempoDB Series Metadata. +data Series = Series + { id :: ByteString + , key :: ByteString + , name :: ByteString + , tags :: [ByteString] + , attributes :: Map ByteString ByteString + } deriving (Show, Eq, Ord) + +instance FromJSON Series where + parseJSON (Object o) = Series <$> + o .: "id" <*> + o .: "key" <*> + o .: "name" <*> + o .: "tags" <*> + o .: "attributes" + parseJSON _ = mzero + +instance ToJSON Series where + toJSON (Series i k n t a) = object + [ "id" .= i + , "key" .= k + , "name" .= n + , "tags" .= t + , "attributes" .= a + ] + +-- data SeriesData = SeriesData +-- { series :: Series +-- , start :: +-- , end :: +-- } diff --git a/src/Database/Tempodb/Util.hs b/src/Database/Tempodb/Util.hs new file mode 100644 --- /dev/null +++ b/src/Database/Tempodb/Util.hs @@ -0,0 +1,27 @@ +{-# LANGUAGE OverloadedStrings #-} + +module Database.Tempodb.Util where + +import Blaze.ByteString.Builder.ByteString (fromByteString) +import Data.ByteString.Char8 as C8 +import Network.Http.Client +import OpenSSL (withOpenSSL) +import System.IO.Streams (write) + +type QueryArgs = [(String, String)] + +-- | Root API version path. +rootpath :: ByteString +rootpath = "/v1" + +-- | Run a constructed request. +runRequest :: Request -> Maybe ByteString -> IO ByteString +runRequest r b = withOpenSSL $ do + withConnection (establishConnection "https://api.tempo-db.com") go + where + body = case b of + Nothing -> emptyBody + Just v -> (\o -> write (Just $ fromByteString v) o) + go c = do + sendRequest c r body + receiveResponse c concatHandler' diff --git a/tempodb.cabal b/tempodb.cabal --- a/tempodb.cabal +++ b/tempodb.cabal @@ -1,5 +1,5 @@ name: tempodb -version: 0.1.1.0 +version: 0.1.1.1 synopsis: A small Haskell wrapper around the TempoDB api. description: TempoDB is a time-series database as-a-service with a @@ -43,6 +43,11 @@ exposed-modules: Database.Tempodb + Database.Tempodb.Util + Database.Tempodb.Types + Database.Tempodb.Methods + Database.Tempodb.Methods.Series + Database.Tempodb.Methods.Read source-repository head Type: git