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