graylog (empty) → 0.1.0.0
raw patch · 8 files changed
+316/−0 lines, 8 filesdep +aesondep +aeson-casingdep +basesetup-changed
Dependencies added: aeson, aeson-casing, base, bytestring, file-embed, graylog, network, random, scientific, tasty, tasty-hunit, text, time, vector
Files
- LICENSE +13/−0
- Setup.hs +2/−0
- graylog.cabal +64/−0
- src/Graylog/Gelf.hs +72/−0
- src/Graylog/Types.hs +62/−0
- src/Graylog/UDP.hs +50/−0
- test/Main.hs +12/−0
- test/Test/Graylog/UDP.hs +41/−0
+ LICENSE view
@@ -0,0 +1,13 @@+ DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+ Version 2, December 2004++ Copyright (C) 2016 Andrew Rademacher <andrewrademacher@gmail.com>++ Everyone is permitted to copy and distribute verbatim or modified+ copies of this license document, and changing it is allowed as long+ as the name is changed.++ DO WHAT THE FUCK YOU WANT TO PUBLIC LICENSE+ TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION++ 0. You just DO WHAT THE FUCK YOU WANT TO.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ graylog.cabal view
@@ -0,0 +1,64 @@+name: graylog+version: 0.1.0.0+synopsis: Support for graylog output.+description: Support for sending GELF formatted messages to graylog over+ chunked UDP.+homepage: https://github.com/AndrewRademacher/haskell-graylog+license: OtherLicense+license-file: LICENSE+author: Andrew Rademacher+maintainer: andrewrademacher@gmail.com+copyright: 2016 Andrew Rademacher+category: Web+build-type: Simple+cabal-version: >=1.10++library + hs-source-dirs: src+ default-language: Haskell2010++ exposed-modules: Graylog.Gelf+ , Graylog.UDP++ other-modules: Graylog.Types++ ghc-options: -Wall -rtsopts++ build-depends: base ==4.*+ + , aeson+ , aeson-casing+ , bytestring+ , network+ , random+ , scientific+ , text+ , time+ , vector++test-suite test-state+ type: exitcode-stdio-1.0+ main-is: Main.hs+ hs-source-dirs: test+ default-language: Haskell2010++ ghc-options: -Wall -threaded -with-rtsopts=-N -rtsopts++ other-modules: Test.Graylog.UDP++ build-depends: base ==4.*++ , graylog++ , aeson+ , aeson-casing+ , bytestring+ , file-embed+ , network+ , scientific+ , tasty+ , tasty-hunit+ , text+ , time+ , vector+
+ src/Graylog/Gelf.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Default formatting for Graylog messages,+-- see http://docs.graylog.org/en/latest/pages/gelf.html+module Graylog.Gelf where++import Data.Aeson (ToJSON (..), Value (..), genericToJSON,+ toJSON)+import Data.Aeson.Casing+import Data.Text (Text)+import Data.Time+import Data.Typeable+import GHC.Generics++data GELF+ = GELF+ { _gelfVersion :: Version+ , _gelfHost :: Text+ , _gelfShortMessage :: Text+ , _gelfFullMessage :: Maybe Text+ , _gelfTimestamp :: Maybe UTCTime+ , _gelfLevel :: Maybe SyslogLevel+ , _gelfLine :: Maybe Word+ , _gelfFile :: Maybe Text+ }+ deriving (Show, Typeable, Generic)++instance ToJSON GELF where+ toJSON = genericToJSON $ aesonPrefix snakeCase++--++data Version+ = Version1x1+ deriving (Eq, Show, Typeable, Generic)++instance ToJSON Version where+ toJSON Version1x1 = String "1.1"++--++data SyslogLevel+ = Emergency+ | Alert+ | Critical+ | Error+ | Warning+ | Notice+ | Informational+ | Debug+ deriving (Eq, Ord, Show, Typeable, Generic)++instance ToJSON SyslogLevel where+ toJSON Emergency = Number 0+ toJSON Alert = Number 1+ toJSON Critical = Number 2+ toJSON Error = Number 3+ toJSON Warning = Number 4+ toJSON Notice = Number 5+ toJSON Informational = Number 6+ toJSON Debug = Number 7++--++simpleGelf+ :: Text -- ^ Hostname+ -> Text -- ^ Short message+ -> GELF+simpleGelf host short =+ GELF Version1x1 host short Nothing Nothing Nothing Nothing Nothing
+ src/Graylog/Types.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE RecordWildCards #-}++module Graylog.Types+ ( Graylog+ , _graylogHost+ , _graylogPort+ , _graylogAddress+ , _graylogSocket+ , _graylogHostName+ , _graylogChunkSize+ , ChunkSize++ , defaultChunkSize+ , openGraylog+ , closeGraylog+ ) where++import Data.List+import Data.Text (Text)+import qualified Data.Text as T+import Network.BSD+import Network.Socket++-- | The maximum size of each datagram when using UDP transit methods.+type ChunkSize = Word++-- | Handle for a socket connected to Graylog. In some cases this socket+-- is UDP and will not have a maintained session.+data Graylog+ = Graylog+ { _graylogHost :: String+ , _graylogPort :: String+ , _graylogAddress :: AddrInfo+ , _graylogSocket :: Socket+ , _graylogHostName :: Text+ , _graylogChunkSize :: ChunkSize+ }++defaultChunkSize :: ChunkSize+defaultChunkSize = 8192++openGraylog+ :: HostName -- ^ The host on which graylog is running.+ -> ServiceName -- ^ The port on which graylog is running.+ -> ChunkSize -- ^ The maximum size of each UDP datagram.+ -> IO (Either String Graylog)+openGraylog h p cksize+ | cksize < 1024 = return $ Left "ChunkSize must be at least 1024."+ | otherwise = getAddrInfo Nothing (Just h) (Just p) >>= \case+ [] -> return $ Left "No address info found."+ infos ->+ case find (\i -> addrSocketType i == Datagram) infos of+ Nothing -> return $ Left "No datagram info found for address."+ Just i -> do+ sock <- socket (addrFamily i) Datagram defaultProtocol+ connect sock (addrAddress i)+ hostname <- getHostName+ return $ Right $ Graylog h p i sock (T.pack hostname) cksize++closeGraylog :: Graylog -> IO ()+closeGraylog Graylog{..} = close _graylogSocket
+ src/Graylog/UDP.hs view
@@ -0,0 +1,50 @@+-- | UDP Chunked support for sending messages to graylog.+module Graylog.UDP+ ( sendLog++ , module Export+ ) where++import Data.Aeson+import Data.ByteString.Builder+import qualified Data.ByteString.Lazy as LBS+import Data.Monoid+import Data.Word+import Network.Socket.ByteString.Lazy+import System.Random++import Graylog.Gelf as Export+import Graylog.Types as Export++sendLog :: Graylog -> GELF -> IO ()+sendLog glog msg = do+ cks <- chunky glog raw+ mapM_ (send $ _graylogSocket glog) cks+ where+ raw = encode msg++chunky :: Graylog -> LBS.ByteString -> IO [LBS.ByteString]+chunky glog raw = do+ groupId <- randomIO+ let groups = divide totalNum raw+ return $ append groupId groups seqNums+ where+ magic = word8 0x1e <> word8 0x0f+ seqNums = [0..] :: [Word8]+ totalNum = if excess > 0 then count + 1 else count+ (count, excess) = quotRem (LBS.length raw) gsize+ hlen = 12+ gsize = (fromIntegral (_graylogChunkSize glog)) - hlen++ divide 0 dat = [dat]+ divide num dat = let (pre, post) = LBS.splitAt gsize dat+ in pre : divide (num - 1) post++ append _ [] _ = []+ append _ _ [] = error "the impossible has happened."+ append gid (g:gs) (s:ss) = (toLazyByteString+ $ magic+ <> word64BE gid+ <> word8 s+ <> word8 (fromIntegral totalNum)+ <> lazyByteString g) : append gid gs ss
+ test/Main.hs view
@@ -0,0 +1,12 @@+import qualified Test.Graylog.UDP (tests)++import Test.Tasty++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Graylog Library"+ [ Test.Graylog.UDP.tests+ ]+
+ test/Test/Graylog/UDP.hs view
@@ -0,0 +1,41 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TemplateHaskell #-}++module Test.Graylog.UDP where++import qualified Data.ByteString as BS+import Data.FileEmbed+import qualified Data.Text.Encoding as T+import Test.Tasty+import Test.Tasty.HUnit++import Graylog.UDP++largeSample :: BS.ByteString+largeSample = $(embedFile "./test/Test/Graylog/UDP/large-sample.json")++tests :: TestTree+tests = testGroup "Test.Graylog.UDP"+ [ testCase "Send sample message." case_sendSample+ , testCase "Send large sample message." case_sendLargeSample+ ]++case_sendSample :: IO ()+case_sendSample = do+ eglog <- openGraylog "192.168.99.100" "12201" defaultChunkSize+ case eglog of+ Left e -> assertFailure e+ Right g -> sendLog g sample >> closeGraylog g+ where+ sample = simpleGelf "localhost" "hello world!"++case_sendLargeSample :: IO ()+case_sendLargeSample = do+ eglog <- openGraylog "192.168.99.100" "12201" defaultChunkSize+ case eglog of+ Left e -> assertFailure e+ Right g -> sendLog g sample >> closeGraylog g+ where+ sample = (simpleGelf "localhost" "hello world!")+ { _gelfFullMessage = Just $ T.decodeUtf8 largeSample }+