src/Graylog/UDP.hs

   1 -- | UDP Chunked support for sending messages to graylog.
   2 module Graylog.UDP
   3    ( sendLog
   4
   5    , module Export
   6    ) where
   7
   8 import           Data.Aeson
   9 import           Data.ByteString.Builder
  10 import qualified Data.ByteString.Lazy           as LBS
  11 import           Data.Monoid
  12 import           Data.Word
  13 import           Network.Socket.ByteString.Lazy
  14 import           System.Random
  15
  16 import           Graylog.Gelf                   as Export
  17 import           Graylog.Types                  as Export
  18
  19 sendLog :: Graylog -> GELF -> IO ()
  20 sendLog glog msg = do
  21    cks <- chunky glog raw
  22    mapM_ (send $ _graylogSocket glog) cks
  23    where
  24       raw = encode msg
  25
  26 chunky :: Graylog -> LBS.ByteString -> IO [LBS.ByteString]
  27 chunky glog raw = do
  28    groupId <- randomIO
  29    let groups = divide totalNum raw
  30    return $ append groupId groups seqNums
  31    where
  32       magic           = word8 0x1e <> word8 0x0f
  33       seqNums         = [0..] :: [Word8]
  34       totalNum        = if excess > 0 then count + 1 else count
  35       (count, excess) = quotRem (LBS.length raw) gsize
  36       hlen            = 12
  37       gsize           = (fromIntegral (_graylogChunkSize glog)) - hlen
  38
  39       divide   0 dat = [dat]
  40       divide num dat = let (pre, post) = LBS.splitAt gsize dat
  41                         in pre : divide (num - 1) post
  42
  43       append _   []     _      = []
  44       append _   _      []     = error "the impossible has happened."
  45       append gid (g:gs) (s:ss) = (toLazyByteString
  46          $ magic
  47         <> word64BE gid
  48         <> word8 s
  49         <> word8 (fromIntegral totalNum)
  50         <> lazyByteString g) : append gid gs ss