1-- |
2-- Module      : Network.TLS.Wire
3-- License     : BSD-style
4-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
5-- Stability   : experimental
6-- Portability : unknown
7--
8-- the Wire module is a specialized marshalling/unmarshalling package related to the TLS protocol.
9-- all multibytes values are written as big endian.
10--
11module Network.TLS.Wire
12    ( Get
13    , GetResult(..)
14    , GetContinuation
15    , runGet
16    , runGetErr
17    , runGetMaybe
18    , tryGet
19    , remaining
20    , getWord8
21    , getWords8
22    , getWord16
23    , getWords16
24    , getWord24
25    , getWord32
26    , getWord64
27    , getBytes
28    , getOpaque8
29    , getOpaque16
30    , getOpaque24
31    , getInteger16
32    , getBigNum16
33    , getList
34    , processBytes
35    , isEmpty
36    , Put
37    , runPut
38    , putWord8
39    , putWords8
40    , putWord16
41    , putWords16
42    , putWord24
43    , putWord32
44    , putWord64
45    , putBytes
46    , putOpaque8
47    , putOpaque16
48    , putOpaque24
49    , putInteger16
50    , putBigNum16
51    , encodeWord16
52    , encodeWord32
53    , encodeWord64
54    ) where
55
56import Data.Serialize.Get hiding (runGet)
57import qualified Data.Serialize.Get as G
58import Data.Serialize.Put
59import qualified Data.ByteString as B
60import Network.TLS.Struct
61import Network.TLS.Imports
62import Network.TLS.Util.Serialization
63
64type GetContinuation a = ByteString -> GetResult a
65data GetResult a =
66      GotError TLSError
67    | GotPartial (GetContinuation a)
68    | GotSuccess a
69    | GotSuccessRemaining a ByteString
70
71runGet :: String -> Get a -> ByteString -> GetResult a
72runGet lbl f = toGetResult <$> G.runGetPartial (label lbl f)
73  where toGetResult (G.Fail err _)    = GotError (Error_Packet_Parsing err)
74        toGetResult (G.Partial cont)  = GotPartial (toGetResult <$> cont)
75        toGetResult (G.Done r bsLeft)
76            | B.null bsLeft = GotSuccess r
77            | otherwise     = GotSuccessRemaining r bsLeft
78
79runGetErr :: String -> Get a -> ByteString -> Either TLSError a
80runGetErr lbl getter b = toSimple $ runGet lbl getter b
81  where toSimple (GotError err) = Left err
82        toSimple (GotPartial _) = Left (Error_Packet_Parsing (lbl ++ ": parsing error: partial packet"))
83        toSimple (GotSuccessRemaining _ _) = Left (Error_Packet_Parsing (lbl ++ ": parsing error: remaining bytes"))
84        toSimple (GotSuccess r) = Right r
85
86runGetMaybe :: Get a -> ByteString -> Maybe a
87runGetMaybe f = either (const Nothing) Just . G.runGet f
88
89tryGet :: Get a -> ByteString -> Maybe a
90tryGet f = either (const Nothing) Just . G.runGet f
91
92getWords8 :: Get [Word8]
93getWords8 = getWord8 >>= \lenb -> replicateM (fromIntegral lenb) getWord8
94
95getWord16 :: Get Word16
96getWord16 = getWord16be
97
98getWords16 :: Get [Word16]
99getWords16 = getWord16 >>= \lenb -> replicateM (fromIntegral lenb `div` 2) getWord16
100
101getWord24 :: Get Int
102getWord24 = do
103    a <- fromIntegral <$> getWord8
104    b <- fromIntegral <$> getWord8
105    c <- fromIntegral <$> getWord8
106    return $ (a `shiftL` 16) .|. (b `shiftL` 8) .|. c
107
108getWord32 :: Get Word32
109getWord32 = getWord32be
110
111getWord64 :: Get Word64
112getWord64 = getWord64be
113
114getOpaque8 :: Get ByteString
115getOpaque8 = getWord8 >>= getBytes . fromIntegral
116
117getOpaque16 :: Get ByteString
118getOpaque16 = getWord16 >>= getBytes . fromIntegral
119
120getOpaque24 :: Get ByteString
121getOpaque24 = getWord24 >>= getBytes
122
123getInteger16 :: Get Integer
124getInteger16 = os2ip <$> getOpaque16
125
126getBigNum16 :: Get BigNum
127getBigNum16 = BigNum <$> getOpaque16
128
129getList :: Int -> Get (Int, a) -> Get [a]
130getList totalLen getElement = isolate totalLen (getElements totalLen)
131  where getElements len
132            | len < 0     = error "list consumed too much data. should never happen with isolate."
133            | len == 0    = return []
134            | otherwise   = getElement >>= \(elementLen, a) -> (:) a <$> getElements (len - elementLen)
135
136processBytes :: Int -> Get a -> Get a
137processBytes i f = isolate i f
138
139putWords8 :: [Word8] -> Put
140putWords8 l = do
141    putWord8 $ fromIntegral (length l)
142    mapM_ putWord8 l
143
144putWord16 :: Word16 -> Put
145putWord16 = putWord16be
146
147putWord32 :: Word32 -> Put
148putWord32 = putWord32be
149
150putWord64 :: Word64 -> Put
151putWord64 = putWord64be
152
153putWords16 :: [Word16] -> Put
154putWords16 l = do
155    putWord16 $ 2 * fromIntegral (length l)
156    mapM_ putWord16 l
157
158putWord24 :: Int -> Put
159putWord24 i = do
160    let a = fromIntegral ((i `shiftR` 16) .&. 0xff)
161    let b = fromIntegral ((i `shiftR` 8) .&. 0xff)
162    let c = fromIntegral (i .&. 0xff)
163    mapM_ putWord8 [a,b,c]
164
165putBytes :: ByteString -> Put
166putBytes = putByteString
167
168putOpaque8 :: ByteString -> Put
169putOpaque8 b = putWord8 (fromIntegral $ B.length b) >> putBytes b
170
171putOpaque16 :: ByteString -> Put
172putOpaque16 b = putWord16 (fromIntegral $ B.length b) >> putBytes b
173
174putOpaque24 :: ByteString -> Put
175putOpaque24 b = putWord24 (B.length b) >> putBytes b
176
177putInteger16 :: Integer -> Put
178putInteger16 = putOpaque16 . i2osp
179
180putBigNum16 :: BigNum -> Put
181putBigNum16 (BigNum b) = putOpaque16 b
182
183encodeWord16 :: Word16 -> ByteString
184encodeWord16 = runPut . putWord16
185
186encodeWord32 :: Word32 -> ByteString
187encodeWord32 = runPut . putWord32
188
189encodeWord64 :: Word64 -> ByteString
190encodeWord64 = runPut . putWord64be
191