1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
|
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE UnboxedTuples #-}
{-# LANGUAGE UnliftedFFITypes #-}
module ZNC.Parser (
Nick, Event(..),
parseLog,
RawEvents, rawNumEvents, realiseEvents, realiseEventsRange, parseLogRaw,
) where
import Data.Array.Byte
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.ByteString.Unsafe qualified as BSU
import Data.Text (Text)
import Data.Text.Encoding qualified as TE
import Foreign.C.Types
import Foreign.Ptr
import GHC.Exts
import GHC.IO (IO(IO))
import GHC.Word
import System.IO.Unsafe (unsafePerformIO)
import Util
foreign import ccall unsafe "tirclogv_count_lines"
-- file buf length num events
c_count_lines :: Ptr CChar -> CSize -> IO CSize
foreign import ccall unsafe "tirclogv_parse_znc"
-- events buffer evbufsz file buf length actual num events
c_parse_znc :: MutableByteArray# RealWorld -> CSize -> Ptr CChar -> CSize -> IO CSize
type Nick = Text
-- Adapted from clogparse by Keegan McAllister (BSD3) (https://hackage.haskell.org/package/clogparse).
data Event
= Join Nick Text -- ^ User joined.
| Part Nick Text Text -- ^ User left the channel. (address, reason)
| Quit Nick Text Text -- ^ User quit the server. (address, reason)
| ReNick Nick Nick -- ^ User changed from one to another nick.
| Talk Nick Text -- ^ User spoke (@PRIVMSG@).
| Notice Nick Text -- ^ User spoke (@NOTICE@).
| Act Nick Text -- ^ User acted (@CTCP ACTION@).
| Kick Nick Nick Text -- ^ User was kicked by user. (kicked, kicker, reason)
| Mode Nick Text -- ^ User set mode on the channel.
| Topic Nick Text -- ^ Topic change.
| ParseError
| Compressed Text -- ^ Fake event generated when compressing multiple meta events in "Index"
deriving (Show)
-- For each event: (`struct event` on the C sode; total 22 bytes)
-- * 1 byte hour
-- * 1 byte minute
-- * 1 byte second
-- * 1 byte event kind
-- * 4 bytes text pointer 1
-- * 4 bytes text pointer 2
-- * 4 bytes text pointer 3
-- * 2 bytes text length 1
-- * 2 bytes text length 2
-- * 2 bytes text length 3
evRepSz :: Int
evRepSz = 22
-- | Retains the original ByteString.
data RawEvents = RawEvents
ByteString -- original data parsed
Int -- actual number of events (may be smaller than allocated capacity in ByteArray#)
ByteArray# -- parsed array of `struct event`; pinned
parseLog :: ByteString -> [(HMS, Event)]
parseLog = realiseEvents . parseLogRaw
rawNumEvents :: RawEvents -> Int
rawNumEvents (RawEvents _ nev _) = nev
-- | This is a good list producer.
{-# INLINE realiseEvents #-}
realiseEvents :: RawEvents -> [(HMS, Event)]
realiseEvents raw@(RawEvents _ nev _) = realiseEventsRange raw (0, nev)
-- | This is a good list producer. Range is (inclusive, exclusive).
{-# INLINE realiseEventsRange #-}
realiseEventsRange :: RawEvents -> (Int, Int) -> [(HMS, Event)]
realiseEventsRange (RawEvents bs _ ba#) (startidx, endidx) =
[(deserialiseHMS i, deserialiseEvent i) | i <- [startidx .. endidx - 1]]
where
-- These INLINE and NOINLINE are to ensure the produced list, as well as
-- the contained tuples, can get fused into the consumer, without bloating
-- up the consumer code.
{-# NOINLINE deserialiseHMS #-}
deserialiseHMS :: Int -> HMS
deserialiseHMS i = HMS (byte 0) (byte 1) (byte 2)
where
byte :: Int -> Word8
byte off = readWord8 (i * evRepSz + off)
{-# NOINLINE deserialiseEvent #-}
deserialiseEvent :: Int -> Event
deserialiseEvent i =
case byte 3 of
1 -> Join (textfield 0) (textfield 1)
2 -> Part (textfield 0) (textfield 1) (textfield 2)
3 -> Quit (textfield 0) (textfield 1) (textfield 2)
4 -> ReNick (textfield 0) (textfield 1)
5 -> Talk (textfield 0) (textfield 1)
6 -> Notice (textfield 0) (textfield 1)
7 -> Act (textfield 0) (textfield 1)
8 -> Kick (textfield 0) (textfield 1) (textfield 2)
9 -> Mode (textfield 0) (textfield 1)
10 -> Topic (textfield 0) (textfield 1)
_ {- includes 0 -} -> ParseError
where
byte :: Int -> Word8
byte off = readWord8 (i * evRepSz + off)
textfield :: Int -> Text
textfield n =
let offset = fromIntegral @Word32 @Int (readWord32 (i * evRepSz + 4 + 4 * n))
len = fromIntegral @Word16 @Int (readWord16 (i * evRepSz + 16 + 2 * n))
in TE.decodeUtf8Lenient (BS.take len (BS.drop offset bs))
readWord32 :: Int -> Word32
readWord32 (I# i#) = W32# (indexWord8ArrayAsWord32# ba# i#)
readWord16 :: Int -> Word16
readWord16 (I# i#) = W16# (indexWord8ArrayAsWord16# ba# i#)
readWord8 :: Int -> Word8
readWord8 (I# i#) = W8# (indexWord8Array# ba# i#)
-- | The 'ByteString' is retained inside the 'RawEvents'.
{-# NOINLINE parseLogRaw #-}
parseLogRaw :: ByteString -> RawEvents
parseLogRaw bs = unsafePerformIO $
BSU.unsafeUseAsCStringLen bs $ \(bsptr, bslen) -> do
let bslenCS = fromIntegral @Int @CSize bslen
numev <- c_count_lines bsptr bslenCS
let !(I# numbytes#) = fromIntegral @CSize @Int numev * evRepSz
MutableByteArray dst# <-
IO $ \s -> case newPinnedByteArray# numbytes# s of
(# s', mba# #) -> (# s', MutableByteArray mba# #)
realnumev <- c_parse_znc dst# numev bsptr bslenCS
IO $ \s -> case unsafeFreezeByteArray# dst# s of
(# s', ba# #) -> (# s', RawEvents bs (fromIntegral @CSize @Int realnumev) ba# #)
|
