9f3714dd1c
- use fail instead of throwerror, since cereal do not raise but return an either. - remove the get monad definition - add some helper - remove dependency on binary and use cereal exclusively.
89 lines
2 KiB
Haskell
89 lines
2 KiB
Haskell
{-# LANGUAGE GeneralizedNewtypeDeriving,FlexibleInstances #-}
|
|
|
|
-- |
|
|
-- Module : Network.TLS.Wire
|
|
-- License : BSD-style
|
|
-- Maintainer : Vincent Hanquez <vincent@snarc.org>
|
|
-- Stability : experimental
|
|
-- Portability : unknown
|
|
--
|
|
-- the Wire module is a specialized Binary package related to the TLS protocol.
|
|
-- 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
|
|
, putBytes
|
|
, encodeWord64
|
|
) where
|
|
|
|
import Data.Serialize.Get
|
|
import Data.Serialize.Put
|
|
import qualified Data.ByteString as B
|
|
import qualified Data.ByteString.Lazy as L
|
|
import Control.Applicative ((<$>))
|
|
import Control.Monad.Error
|
|
import Data.Word
|
|
import Data.Bits
|
|
import Network.TLS.Struct
|
|
|
|
getWords8 :: Get [Word8]
|
|
getWords8 = getWord8 >>= \lenb -> replicateM (fromIntegral lenb) getWord8
|
|
|
|
getWord16 :: Get Word16
|
|
getWord16 = getWord16be
|
|
|
|
getWords16 :: Get [Word16]
|
|
getWords16 = getWord16 >>= \lenb -> replicateM (fromIntegral lenb `div` 2) getWord16
|
|
|
|
getWord24 :: Get Int
|
|
getWord24 = do
|
|
a <- fromIntegral <$> getWord8
|
|
b <- fromIntegral <$> getWord8
|
|
c <- fromIntegral <$> getWord8
|
|
return $ (a `shiftL` 16) .|. (b `shiftL` 8) .|. c
|
|
|
|
processBytes :: Int -> Get a -> Get a
|
|
processBytes i f = isolate i f
|
|
|
|
putWords8 :: [Word8] -> Put
|
|
putWords8 l = do
|
|
putWord8 $ fromIntegral (length l)
|
|
mapM_ putWord8 l
|
|
|
|
putWord16 :: Word16 -> Put
|
|
putWord16 = putWord16be
|
|
|
|
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)
|
|
mapM_ putWord8 [a,b,c]
|
|
|
|
putBytes :: Bytes -> Put
|
|
putBytes = putByteString
|
|
|
|
encodeWord64 :: Word64 -> Bytes
|
|
encodeWord64 = runPut . putWord64be
|