2010-09-09 21:47:19 +00:00
|
|
|
-- |
|
|
|
|
-- Module : Network.TLS.Wire
|
|
|
|
-- License : BSD-style
|
|
|
|
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
|
|
|
-- Stability : experimental
|
|
|
|
-- Portability : unknown
|
|
|
|
--
|
2011-04-24 12:43:18 +00:00
|
|
|
-- the Wire module is a specialized marshalling/unmarshalling package related to the TLS protocol.
|
2010-09-09 21:47:19 +00:00
|
|
|
-- all multibytes values are written as big endian.
|
|
|
|
--
|
|
|
|
module Network.TLS.Wire
|
|
|
|
( Get
|
|
|
|
, runGet
|
|
|
|
, remaining
|
|
|
|
, getWord8
|
|
|
|
, getWords8
|
|
|
|
, getWord16
|
|
|
|
, getWords16
|
|
|
|
, getWord24
|
|
|
|
, getBytes
|
|
|
|
, processBytes
|
|
|
|
, isEmpty
|
|
|
|
, Put
|
|
|
|
, runPut
|
|
|
|
, putWord8
|
|
|
|
, putWords8
|
|
|
|
, putWord16
|
|
|
|
, putWords16
|
|
|
|
, putWord24
|
2010-09-26 09:34:47 +00:00
|
|
|
, putBytes
|
2010-09-09 21:47:19 +00:00
|
|
|
, encodeWord64
|
|
|
|
) where
|
|
|
|
|
2011-06-12 20:38:42 +00:00
|
|
|
import Data.Serialize.Get hiding (runGet)
|
|
|
|
import qualified Data.Serialize.Get as G
|
2011-04-24 08:44:18 +00:00
|
|
|
import Data.Serialize.Put
|
2010-09-19 09:49:42 +00:00
|
|
|
import Control.Applicative ((<$>))
|
2010-09-09 21:47:19 +00:00
|
|
|
import Control.Monad.Error
|
|
|
|
import Data.Word
|
|
|
|
import Data.Bits
|
|
|
|
import Network.TLS.Struct
|
|
|
|
|
2011-06-12 20:38:42 +00:00
|
|
|
runGet lbl f = G.runGet (label lbl f)
|
|
|
|
|
2010-09-09 21:47:19 +00:00
|
|
|
getWords8 :: Get [Word8]
|
|
|
|
getWords8 = getWord8 >>= \lenb -> replicateM (fromIntegral lenb) getWord8
|
|
|
|
|
|
|
|
getWord16 :: Get Word16
|
2011-04-24 08:44:18 +00:00
|
|
|
getWord16 = getWord16be
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
getWords16 :: Get [Word16]
|
|
|
|
getWords16 = getWord16 >>= \lenb -> replicateM (fromIntegral lenb `div` 2) getWord16
|
|
|
|
|
|
|
|
getWord24 :: Get Int
|
|
|
|
getWord24 = do
|
2010-09-19 09:49:42 +00:00
|
|
|
a <- fromIntegral <$> getWord8
|
|
|
|
b <- fromIntegral <$> getWord8
|
|
|
|
c <- fromIntegral <$> getWord8
|
2010-09-09 21:47:19 +00:00
|
|
|
return $ (a `shiftL` 16) .|. (b `shiftL` 8) .|. c
|
|
|
|
|
|
|
|
processBytes :: Int -> Get a -> Get a
|
2011-04-24 08:44:18 +00:00
|
|
|
processBytes i f = isolate i f
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
putWords8 :: [Word8] -> Put
|
|
|
|
putWords8 l = do
|
2011-04-24 08:44:18 +00:00
|
|
|
putWord8 $ fromIntegral (length l)
|
|
|
|
mapM_ putWord8 l
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
putWord16 :: Word16 -> Put
|
2011-04-24 08:44:18 +00:00
|
|
|
putWord16 = putWord16be
|
2010-09-09 21:47:19 +00:00
|
|
|
|
|
|
|
putWords16 :: [Word16] -> Put
|
|
|
|
putWords16 l = do
|
|
|
|
putWord16 $ 2 * (fromIntegral $ length l)
|
|
|
|
mapM_ putWord16 l
|
|
|
|
|
|
|
|
putWord24 :: Int -> Put
|
|
|
|
putWord24 i = do
|
|
|
|
let a = fromIntegral ((i `shiftR` 16) .&. 0xff)
|
|
|
|
let b = fromIntegral ((i `shiftR` 8) .&. 0xff)
|
|
|
|
let c = fromIntegral (i .&. 0xff)
|
2011-04-24 08:44:18 +00:00
|
|
|
mapM_ putWord8 [a,b,c]
|
2010-09-26 09:34:47 +00:00
|
|
|
|
|
|
|
putBytes :: Bytes -> Put
|
2011-04-24 08:44:18 +00:00
|
|
|
putBytes = putByteString
|
2010-09-09 21:47:19 +00:00
|
|
|
|
2010-09-26 09:34:47 +00:00
|
|
|
encodeWord64 :: Word64 -> Bytes
|
2011-04-24 08:44:18 +00:00
|
|
|
encodeWord64 = runPut . putWord64be
|