diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2012, Simon Marechal + +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 Simon Marechal nor the names of other + 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 +OWNER 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/Logstash/IO.hs b/Logstash/IO.hs new file mode 100644 --- /dev/null +++ b/Logstash/IO.hs @@ -0,0 +1,30 @@ +{-| This module needs a lot of work. It will contain all the functions that +are needed to send some "LogstashMessage" to a Logstash server. +-} +module Logstash.IO where + +import Logstash.Message +import Network +import qualified Data.ByteString.Lazy as BSL +import System.IO +import Data.Aeson + +{-| This very simple function lets you send a single message to a Logstash +server, using the tcp input, configured in the following way: + +> input { +> tcp { +> debug => "true" +> port => "12345" +> data_timeout => -1 +> format => "json_event" +> type => "somemessages" +> } +> } +-} +sendSingleMessage :: HostName -> PortID -> LogstashMessage -> IO () +sendSingleMessage h p m = do + handle <- connectTo h p + BSL.hPutStr handle (encode m) + hClose handle + diff --git a/Logstash/Message.hs b/Logstash/Message.hs new file mode 100644 --- /dev/null +++ b/Logstash/Message.hs @@ -0,0 +1,70 @@ +module Logstash.Message where + +import Data.Aeson +import qualified Data.Text as T +import Control.Applicative +import Control.Monad +import qualified Data.HashMap.Strict as HM +import qualified Data.Vector as V + +{-| The Logstash message, as described in . +Please not there is no timestamp, as the logstash server will add it. +-} +data LogstashMessage = LogstashMessage + { logStashType :: T.Text + , logStashSource :: T.Text + , logStashTags :: [T.Text] + , logStashFields :: Value + , logStashContent :: T.Text + } deriving (Show) + +instance FromJSON LogstashMessage where + parseJSON (Object v) = LogstashMessage + <$> v .: "@type" + <*> v .: "@source" + <*> v .: "@tags" + <*> v .: "@fields" + <*> v .: "@message" + parseJSON _ = mzero + +{-| As the name implies, this creates a dummy Logstash message, only +updating the message field. +-} +emptyLSMessage :: T.Text -> LogstashMessage +emptyLSMessage m = LogstashMessage "empty" "dummy" [] Null m + +instance ToJSON LogstashMessage where + toJSON (LogstashMessage ty s ta f c) = object [ "@type" .= ty + , "@source" .= s + , "@tags" .= ta + , "@fields" .= f + , "@message" .= c + ] + +{-| This will try to convert an arbitrary JSON value into +a "LogstashMessage". +-} +value2logstash :: Value -> Maybe LogstashMessage +value2logstash (Object m) = + let mtype = HM.lookup "@type" m + msrc = HM.lookup "@source" m + mflds = case HM.lookup "@fields" m of + Just x -> x + Nothing -> Null + mtags = case HM.lookup "@tags" m of + Just (Array v) -> toTags (V.toList v) + Nothing -> Nothing + mmsg = case HM.lookup "@message" m of + Just (String x) -> x + _ -> "" + toTags :: [Value] -> Maybe [T.Text] + toTags v = + let isString (String _) = True + isString _ = False + toText (String x) = x + in if null (filter (not . isString) v) + then Just (map toText v) + else Nothing + in case (mtype, msrc, mtags) of + (Just (String t), Just (String s), Just tags) -> Just $ LogstashMessage t s tags mflds mmsg + _ -> Nothing 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/hslogstash.cabal b/hslogstash.cabal new file mode 100644 --- /dev/null +++ b/hslogstash.cabal @@ -0,0 +1,21 @@ +-- Initial hslogstash.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/ + +name: hslogstash +version: 0.1.0.0 +synopsis: A library to write structured messages to a logstash server. +-- description: +license: BSD3 +license-file: LICENSE +author: Simon Marechal +maintainer: bartavelle@gmail.com +-- copyright: +category: System +build-type: Simple +cabal-version: >=1.8 + +library + exposed-modules: Logstash.Message, Logstash.IO + extensions: OverloadedStrings + -- other-modules: + build-depends: base <5, aeson, network, bytestring, text, vector, unordered-containers