diff --git a/DEPENDENCY-LICENSES.org b/DEPENDENCY-LICENSES.org new file mode 100644 --- /dev/null +++ b/DEPENDENCY-LICENSES.org @@ -0,0 +1,126 @@ +# BSD3 + +- HUnit +- MonadCatchIO-transformers +- aeson +- array +- attoparsec +- base +- base64-bytestring +- bifunctors +- binary +- blaze-builder +- blaze-builder-enumerator +- blaze-html +- blaze-markup +- byteable +- bytestring +- bytestring-mmap +- case-insensitive +- cereal +- cipher-aes +- clientsession +- comonad +- configurator +- containers +- contravariant +- cookie +- cprng-aes +- crypto-api +- crypto-cipher-types +- crypto-random +- cryptohash +- data-default +- data-default-class +- data-default-instances-base +- data-default-instances-containers +- data-default-instances-dlist +- data-default-instances-old-locale +- deepseq +- directory +- directory-tree +- distributive +- dlist +- either +- entropy +- errors +- exceptions +- extensible-exceptions +- filepath +- free +- ghc-prim +- hashable +- heist +- http-types +- influxdb +- integer-gmp +- lens +- logict +- map-syntax +- monad-control +- monads-tf +- mtl +- mwc-random +- nats +- network +- network-uri +- old-locale +- parallel +- parsec +- prelude-extras +- pretty +- primitive +- process +- profunctors +- publicsuffixlist +- pwstore-fast +- random +- reflection +- regex-base +- regex-posix +- retry +- rts +- safe +- scientific +- securemem +- semigroupoids +- semigroups +- skein +- snap +- snap-core +- snap-server +- split +- stm +- syb +- tagged +- template-haskell +- text +- time +- transformers +- transformers-base +- transformers-compat +- unix +- unix-compat +- unordered-containers +- utf8-string +- vector +- vector-algorithms +- void +- xmlhtml +- zlib +- zlib-bindings + +# OtherLicense + +- MonadRandom + +# MIT + +- attoparsec-enumerator +- enumerator +- http-client +- mime-types +- setenv +- streaming-commons +- zlib-enum + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,28 @@ +Copyright (c) 2014, Parnell Springmeyer +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + +* Redistributions of source code must retain the above copyright notice, this + list of conditions and the following disclaimer. + +* Redistributions in binary form must reproduce the above copyright notice, + this list of conditions and the following disclaimer in the documentation + and/or other materials provided with the distribution. + +* Neither the name of the {organization} nor the names of its + contributors may be used to endorse or promote products derived from + this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" +AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE +IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE +DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE +FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL +DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR +SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER +CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, +OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. + diff --git a/README.org b/README.org new file mode 100644 --- /dev/null +++ b/README.org @@ -0,0 +1,75 @@ +* Welcome! + [[https://hackage.haskell.org/package/snaplet-influxdb][https://img.shields.io/hackage/v/snaplet-influxdb.svg?style=flat]] + [[https://travis-ci.org/ixmatus/snaplet-influxdb][https://travis-ci.org/ixmatus/snaplet-influxdb.svg?branch=master]] + + =snaplet-influxdb= provides a convenience interface to the Haskell + InfluxDB package. + + **NOTE:** this code only builds a pool with the one server + description provided in the config. When I get around to it the + configuration will be more advanced allowing you to specify a pool + of servers for the InfluxDB client to use. + + Usage is simple, make sure you've configured the connections + correctly in the InfluxDB snaplet: + + #+BEGIN_SRC + {-# LANGUAGE FlexibleInstances #-} + {-# LANGUAGE OverloadedStrings #-} + {-# LANGUAGE RecordWildCards #-} + {-# LANGUAGE TemplateHaskell #-} + + module Main where + + ------------------------------------------------------------------------------ + import Control.Lens + import Data.ByteString.Char8 as C8 + import Database.InfluxDB + import Snap + import Snap.Snaplet.InfluxDB + + ------------------------------------------------------------------------------ + data App = App + { _influx :: Snaplet InfluxState + } + + makeLenses ''App + + instance HasInfluxPool (Handler b App) where + getInfluxPool = with influx getInfluxPool + + ------------------------------------------------------------------------------ + -- | The application's routes. + routes :: [(ByteString, Handler App App ())] + routes = [ ("/" , writeText "hello") + , ("test", fooHandler) + ] + + fooHandler :: Handler App App () + fooHandler = do + + -- If you want full control over the type of post, precision, + -- maybe even the db to post to... + + runInflux $ \c -> do + post c "db" $ writeSeries "myseries" "somevalue" + + -- OR if you want to use the database you've configured with a + -- default precision of Seconds... + + runInfluxPost $ writeSeries "myseries" "somevalue" + + modifyResponse $ setResponseCode 204 + + + ------------------------------------------------------------------------------ + -- | The application initializer. + app :: SnapletInit App App + app = makeSnaplet "app" "An snaplet example application." Nothing $ do + m <- nestSnaplet "influx" influx $ initInflux + addRoutes routes + return $ App m + + main :: IO () + main = serveSnaplet defaultConfig app + #+END_SRC diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/resources/influxdb/devel.cfg b/resources/influxdb/devel.cfg new file mode 100644 --- /dev/null +++ b/resources/influxdb/devel.cfg @@ -0,0 +1,6 @@ +host = "localhost" +port = 5672 +ssl = False +db = "default" +user = "root" +pass = "root" diff --git a/snaplet-influxdb.cabal b/snaplet-influxdb.cabal new file mode 100644 --- /dev/null +++ b/snaplet-influxdb.cabal @@ -0,0 +1,62 @@ +Name: snaplet-influxdb +Version: 1.0.0.0 +Synopsis: Snap framework snaplet for the InfluxDB library +Homepage: https://github.com/ixmatus/snaplet-influxdb +License: BSD3 +License-file: LICENSE +Author: Parnell Springmeyer +Maintainer: parnell@digitalmentat.com +Copyright: (c) 2014 Parnell Springmeyer +Category: Web +Build-type: Simple +Stability: stable +Bug-reports: https://github.com/ixmatus/snaplet-influxdb/issues +Package-url: http://hackage.haskell.org/package/snaplet-influxdb +Tested-with: GHC == 7.6.3 +Cabal-version: >=1.14.0 + +description: + `snaplet-influxdb` is a snaplet for the Snap web framework providing + convenience functions and state management for the Haskell InfluxDB + package. + . + Please refer to the README for an example - Cabal descriptions don't + make it easy to do so. + +Extra-source-files: + LICENSE + DEPENDENCY-LICENSES.org + README.org + +Data-files: + resources/influxdb/devel.cfg + +Library + Default-Language: Haskell2010 + HS-Source-Dirs: src + Ghc-options: -Wall -fwarn-tabs -funbox-strict-fields + -fno-warn-orphans -fno-warn-unused-do-bind + + Exposed-Modules: + Snap.Snaplet.InfluxDB + + Other-Modules: + Paths_snaplet_influxdb + + Build-Depends: + base >= 4.4 && < 5, + snap >= 0.13 && < 0.14, + monad-control >= 0.3 && < 0.4, + text >= 1.0 && < 2.0, + http-client >= 0.3 && < 0.4, + influxdb >= 0.7 && < 0.8, + bytestring >= 0.9 && < 11, + lens >= 4 && < 5, + transformers >= 0.4 && < 0.5, + configurator >= 0.3 && < 0.4, + network >= 2.5 && < 2.7, + mtl >= 2 && < 3 + +Source-Repository head + Type: git + Location: https://github.com/ixmatus/snaplet-influxdb diff --git a/src/Snap/Snaplet/InfluxDB.hs b/src/Snap/Snaplet/InfluxDB.hs new file mode 100644 --- /dev/null +++ b/src/Snap/Snaplet/InfluxDB.hs @@ -0,0 +1,99 @@ +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} + +module Snap.Snaplet.InfluxDB + ( initInflux + , runInflux + , runInfluxPost + , mkInfluxPool + , InfluxState (..) + , HasInfluxPool (..) + ) where + +import Control.Monad.State +import Control.Monad.Trans.Reader +import Data.Configurator +import Data.Configurator.Types as CT +import Data.Text (Text) +import Database.InfluxDB as IN +import Network.HTTP.Client +import Paths_snaplet_influxdb +import Snap.Snaplet + +------------------------------------------------------------------------------- +data InfluxPool = InfluxPool DB IN.Config + +type DB = Text + +newtype InfluxState = InfluxState { influxPool :: InfluxPool } + +------------------------------------------------------------------------------- +class MonadIO m => HasInfluxPool m where + getInfluxPool :: m InfluxPool + +instance HasInfluxPool (Handler b InfluxState) where + getInfluxPool = gets influxPool + +instance MonadIO m => HasInfluxPool (ReaderT InfluxPool m) where + getInfluxPool = ask + +-- | Initialize the Influx Snaplet. +initInflux :: SnapletInit b InfluxState +initInflux = makeSnaplet "influx" description datadir $ do + p <- mkSnapletInfluxPool + + let (InfluxPool _ c) = p + mgr = configHttpManager c + + onUnload (closeManager mgr) + + return $ InfluxState p + + where + description = "Snaplet for the InfluxDB library" + datadir = Just $ liftM (++"/resources/influxdb") getDataDir + +------------------------------------------------------------------------------- +-- | Constructs a connection in a snaplet context. +mkSnapletInfluxPool :: (MonadIO (m b v), MonadSnaplet m) => m b v InfluxPool +mkSnapletInfluxPool = do + conf <- getSnapletUserConfig + mkInfluxPool conf + +------------------------------------------------------------------------------- +-- | Constructs a connect from Config. +mkInfluxPool :: MonadIO m => CT.Config -> m InfluxPool +mkInfluxPool conf = do + host' <- liftIO $ require conf "host" + port' <- liftIO $ require conf "port" + ssl <- liftIO $ require conf "ssl" + db <- liftIO $ require conf "db" + user <- liftIO $ require conf "user" + pass <- liftIO $ require conf "pass" + + mgr <- liftIO $ newManager defaultManagerSettings + pool <- liftIO $ newServerPool (Server host' port' ssl) [] + + let cnf = Config (Credentials user pass) pool mgr + + return $ InfluxPool db cnf + +------------------------------------------------------------------------------- +-- | Runs an INFLUX action in any monad with a HasInfluxPoolonn instance. +runInflux :: (HasInfluxPool m) => (IN.Config -> IO ()) -> m () +runInflux action = do + (InfluxPool _ pool) <- getInfluxPool + liftIO $! action pool + +------------------------------------------------------------------------------- +-- | Runs an INFLUX action in any monad with a HasInfluxPoolonn instance. +runInfluxPost :: (HasInfluxPool m) => (IN.Config -> IO ()) -> m () +runInfluxPost action = do + (InfluxPool db pool) <- getInfluxPool + liftIO $ postWithPrecision pool db SecondsPrecision $ do + liftIO $! action pool