/
Packet.hs
307 lines (253 loc) · 11.1 KB
/
Packet.hs
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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
--
-- Module : Packet
-- Copyright : (c) Conrad Parker 2006
-- License : BSD-style
-- Maintainer : conradp@cse.unsw.edu.au
-- Stability : experimental
-- Portability : portable
module Codec.Container.Ogg.Packet (
OggPacket (..),
OggSegment (..),
uncutPage,
uncutPacket,
packetsToPages,
pagesToPackets,
packetToBS
) where
import Codec.Container.Ogg.ContentType
import Codec.Container.Ogg.Dump
import Codec.Container.Ogg.Granulepos
import Codec.Container.Ogg.Page
import Codec.Container.Ogg.Serial
import Codec.Container.Ogg.Track
import Codec.Container.Ogg.Timestamp
import Data.List as List
import Data.Map as Map
import Data.Word (Word32)
import qualified Data.ByteString.Lazy as L (take, length, append, drop, ByteString)
import qualified Data.ByteString.Lazy.Char8 as C
------------------------------------------------------------
-- Data
--
data OggPacket =
OggPacket {
packetData :: !(L.ByteString),
packetTrack :: !OggTrack,
packetGranulepos :: !Granulepos,
packetBOS :: !Bool,
packetEOS :: !Bool,
packetSegments :: !(Maybe [OggSegment])
}
data OggSegment =
OggSegment {
segmentLength :: !Int,
segmentPageIx :: !Int, -- ^ page index (NOT seqno) of this segment
segmentEndsPage :: !Bool -- ^ whether or not the segment ends a page
}
------------------------------------------------------------
-- Custom Instances
--
instance ContentTyped OggPacket where
contentTypeIs t p = contentTypeIs t (packetTrack p)
contentTypeOf p = trackType (packetTrack p)
instance Serialled OggPacket where
serialOf p = serialOf (packetTrack p)
instance Timestampable OggPacket where
timestampOf p = gpToTimestamp gp track
where
gp = packetGranulepos p
track = packetTrack p
------------------------------------------------------------
-- Helpers
--
-- | Create a page which contains only a single complete packet
uncutPage :: L.ByteString -> OggTrack -> Granulepos -> OggPage
uncutPage d t gp = head $ packetsToPages [uncutPacket d t gp]
-- | Create a packet which spans a single page, ie. consists of only
-- one segment
uncutPacket :: L.ByteString -> OggTrack -> Granulepos -> OggPacket
uncutPacket d t gp = OggPacket d t gp False False segs
where segs = Just [s]
s = OggSegment (fromIntegral l) 0 True
l = L.length d
------------------------------------------------------------
-- packetsToPages
--
-- A map from track to seqno
type SeqnoMap = Map.Map OggTrack Word32
data CarryPage = CarryPage {
_carryPageIx :: Int,
carryPagePage :: OggPage
}
instance Eq CarryPage where
(==) (CarryPage ix1 _) (CarryPage ix2 _) = (==) ix1 ix2
instance Ord CarryPage where
compare (CarryPage ix1 _) (CarryPage ix2 _) = compare ix1 ix2
type CarryPages = Map.Map OggTrack CarryPage
-- | Pack packets into pages
packetsToPages :: [OggPacket] -> [OggPage]
packetsToPages = packetsToPages_ Map.empty Map.empty 0 []
packetsToPages_ :: CarryPages -> SeqnoMap -> Int -> [CarryPage] -> [OggPacket] -> [OggPage]
packetsToPages_ carry _ _ q [] = List.map carryPagePage (q ++ (elems carry))
packetsToPages_ carry sqMap ix pageQueue (p:ps)
= newPages ++ packetsToPages_ newCarry newSqMap newIx newQueue ps
where
(newIx, newPages, newQueue) = dequeuePages ix [] tmpQueue
(tmpQueue, newCarry, newSqMap) = segsToPages pageQueue carry False sqMap p
dequeuePages :: Int -> [OggPage] -> [CarryPage] -> (Int, [OggPage], [CarryPage])
dequeuePages ix oldPages [] = (ix, oldPages, [])
dequeuePages ix oldPages oldQueue@((CarryPage qix qg):qs)
| ix == qix = dequeuePages (ix+1) (oldPages++[qg]) qs
| otherwise = (ix, oldPages, oldQueue)
-- | Convert segments of a packet into pages, and maybe a carry page
segsToPages :: [CarryPage] -> CarryPages -> Bool -> SeqnoMap -> OggPacket
-> ([CarryPage], CarryPages, SeqnoMap)
segsToPages pages carry _ sqMap (OggPacket _ _ _ _ _ Nothing) =
(pages, carry, sqMap)
segsToPages pages carry _ sqMap (OggPacket _ _ _ _ _ (Just [])) =
(pages, carry, sqMap)
segsToPages pages carry cont sqMap p@(OggPacket _ track _ _ _ (Just [s]))
| segmentEndsPage s = (newPages, deleteCarry, newSqMap)
| otherwise = (pages, replaceCarry, sqMap)
where
newPages = List.insert newPage pages
newPage = appendToCarry carryPage (segmentPageIx s) cont seqno p
seqno = Map.findWithDefault 0 track sqMap
newSqMap = Map.insert track (seqno+1) sqMap
carryPage = Map.lookup track carry
deleteCarry = Map.delete track carry
replaceCarry = Map.insert track newPage carry
segsToPages pages carry cont sqMap
p@(OggPacket d track gp _ eos (Just (s:ss)))
= segsToPages newPages deleteCarry True newSqMap dropPacket
where
newPages = List.insert newPage pages
dropPacket = OggPacket rest track gp False eos (Just ss)
rest = L.drop (fromIntegral $ segmentLength s) d
seqno = Map.findWithDefault 0 track sqMap
newSqMap = Map.insert track (seqno+1) sqMap
deleteCarry = Map.delete track carry
newPage = appendToCarry carryPage (segmentPageIx s) cont seqno p
carryPage = Map.lookup track carry
-- | Append the first segment of a packet to (maybe) a carry page
appendToCarry :: Maybe CarryPage -> Int -> Bool -> Word32 -> OggPacket -> CarryPage
-- Case of no carry page, packet has only one segment
appendToCarry Nothing ix cont seqno (OggPacket d track gp bos eos (Just [_]))
= CarryPage ix (OggPage 0 track cont False bos eos gp seqno [d])
-- Case of no carry page, packet has >1 segment
appendToCarry Nothing ix cont seqno (OggPacket d track _ bos _ (Just (s:_)))
= CarryPage ix (OggPage 0 track cont True bos False (Granulepos Nothing) seqno [seg])
where
seg = L.take (fromIntegral $ segmentLength s) d
-- Case of a carry page, packet has only one segment
appendToCarry (Just (CarryPage ix (OggPage o track cont _ bos _ _ seqno segs))) _ _ _
(OggPacket d _ gp _ eos (Just [_]))
= CarryPage ix (OggPage o track cont False bos eos gp seqno (segs++[d]))
-- Case of a carry page, packet has >1 segment
appendToCarry (Just (CarryPage ix (OggPage o track cont _ bos _ gp seqno segs))) _ _ _
(OggPacket d _ _ _ eos (Just (s:_)))
= CarryPage ix (OggPage o track cont True bos eos gp seqno (segs++[seg]))
where seg = L.take (fromIntegral $ segmentLength s) d
-- For completeness
appendToCarry _ _ _ _ _ = error "appendToCarry{Ogg.Packet}: nothing to append"
------------------------------------------------------------
-- pagesToPackets
--
type CarryPackets = Map.Map OggTrack OggPacket
-- | Pull the packets out of pages
pagesToPackets :: [OggPage] -> [OggPacket]
pagesToPackets = {-#SCC "pagesToPackets" #-}_pagesToPackets Map.empty 0
_pagesToPackets :: CarryPackets -> Int -> [OggPage] -> [OggPacket]
_pagesToPackets carry _ [] = elems carry
_pagesToPackets carry ix [g] = prependCarry carry (pageToPackets ix g)
_pagesToPackets carry ix (g:gs)
| incplt && length ps == 1 =
_pagesToPackets (appendCarry carry track p) (ix+1) gs
| otherwise =
s ++ _pagesToPackets newcarry (ix+1) gs
where s = prependCarry carry ns
newcarry = if incplt then Map.insert track (last ps) carry
else Map.delete track carry
track = pageTrack g
ns = if incplt then init ps else ps
ps = pageToPackets ix g
[p] = ps
incplt = pageIncomplete g
-- | Construct (partial) packets from the segments of a page
pageToPackets :: Int -> OggPage -> [OggPacket]
pageToPackets ix page = setLastSegmentEnds p3
where p3 = setGranulepos p2 (pageGranulepos page) (pageIncomplete page)
p2 = setEOS p1 (pageEOS page)
p1 = setBOS p0 (pageBOS page)
p0 = List.map (packetBuild (pageTrack page) ix) (pageSegments page)
setLastSegmentEnds :: [OggPacket] -> [OggPacket]
setLastSegmentEnds [] = []
setLastSegmentEnds ps = (init ps) ++ [setSegmentEnds (last ps)]
setSegmentEnds :: OggPacket -> OggPacket
setSegmentEnds p@(OggPacket _ _ _ _ _ (Just [s])) =
p{packetSegments = (Just [s{segmentEndsPage = True}])}
setSegmentEnds p = p
setGranulepos :: [OggPacket] -> Granulepos -> Bool -> [OggPacket]
setGranulepos [] _ _ = []
setGranulepos [p] gp False = [p{packetGranulepos = gp}]
setGranulepos [p] _ True = [p] -- singleton segment, continued
setGranulepos [p,pl] gp True = [p{packetGranulepos = gp}]++[pl]
setGranulepos (p:ps) gp co = [p] ++ setGranulepos ps gp co
setBOS :: [OggPacket] -> Bool -> [OggPacket]
setBOS [] _ = []
setBOS ps False = ps
setBOS (p:ps) True = p{packetBOS = True}:ps
setEOS :: [OggPacket] -> Bool -> [OggPacket]
setEOS [] _ = []
setEOS ps False = ps
setEOS ps True = (init ps)++[(last ps){packetEOS = True}]
-- | Build a partial packet given a track, seqno and a segment
packetBuild :: OggTrack -> Int -> L.ByteString -> OggPacket
packetBuild track ix r = OggPacket r track (Granulepos Nothing) False False (Just [seg])
where seg = OggSegment (fromIntegral l) ix False
l = L.length r
-- | Concatenate data of two (partial) packets into one (partial) packet
packetConcat :: OggPacket -> OggPacket -> OggPacket
packetConcat (OggPacket r1 s1 _ b1 _ (Just x1)) (OggPacket r2 _ g2 _ e2 (Just x2)) =
OggPacket (L.append r1 r2) s1 g2 b1 e2 (Just (x1++x2))
-- If either of the packets have unknown segmentation, ditch all segmentation
packetConcat (OggPacket r1 s1 _ b1 _ _) (OggPacket r2 _ g2 _ e2 _) =
OggPacket (L.append r1 r2) s1 g2 b1 e2 Nothing
appendCarry :: CarryPackets -> OggTrack -> OggPacket -> CarryPackets
appendCarry oldCarry track p = Map.insert track combinedCarry oldCarry
where combinedCarry = concatTo $ Map.lookup track oldCarry
concatTo Nothing = p
concatTo (Just c) = packetConcat c p
prependCarry :: CarryPackets -> [OggPacket] -> [OggPacket]
prependCarry oldCarry [] = elems oldCarry
prependCarry oldCarry segs@(s:ss) = newPackets
where track = packetTrack s
newPackets = appendTo $ Map.lookup track oldCarry
appendTo Nothing = segs
appendTo (Just c) = (packetConcat c s):ss
-- | Create a dump of a packet, as used by "hogg dump"
packetToBS :: OggPacket -> C.ByteString
packetToBS p@(OggPacket d track gp bos eos _) = {-# SCC "packetToBS" #-}
C.concat [C.pack pHdr, pDump, C.singleton '\n']
where
pHdr = ts ++ ": " ++ t ++ " serialno " ++ show (trackSerialno track) ++ ", granulepos " ++ gpe ++ flags ++ ": " ++ show (L.length d) ++ " bytes\n"
gpe = gpExplain gp track
flags = ifb ++ ife
ifb = if bos then " *** bos" else ""
ife = if eos then " *** eos" else ""
ts = maybe "--:--:--::--" show (timestampOf p)
t = maybe "(Unknown)" show (trackType track)
pDump = hexDump d
------------------------------------------------------------
-- Show
--
instance Show OggPacket where
show p@(OggPacket d track gp bos eos _) = {-# SCC "showOggPacket" #-}
ts ++ ": " ++ t ++ " serialno " ++ show (trackSerialno track) ++ ", granulepos " ++ gpe ++ flags ++ ": " ++ show (L.length d) ++ " bytes\n"
-- ++ (hexDump d) ++ "\n"
where gpe = gpExplain gp track
flags = ifb ++ ife
ifb = if bos then " *** bos" else ""
ife = if eos then " *** eos" else ""
ts = maybe "--:--:--::--" show (timestampOf p)
t = maybe "(Unknown)" show (trackType track)