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