re-indent
This commit is contained in:
Vincent Hanquez
parent
67f01872dd
commit
fb8629a807
14 changed files with 793 additions and 803 deletions
|
|
@ -7,9 +7,9 @@
|
|||
--
|
||||
|
||||
module Network.TLS.Cap
|
||||
( hasHelloExtensions
|
||||
, hasExplicitBlockIV
|
||||
) where
|
||||
( hasHelloExtensions
|
||||
, hasExplicitBlockIV
|
||||
) where
|
||||
|
||||
import Network.TLS.Struct
|
||||
|
||||
|
|
|
|||
|
|
@ -8,17 +8,17 @@
|
|||
-- Portability : unknown
|
||||
--
|
||||
module Network.TLS.Cipher
|
||||
( BulkFunctions(..)
|
||||
, CipherKeyExchangeType(..)
|
||||
, Bulk(..)
|
||||
, Hash(..)
|
||||
, Cipher(..)
|
||||
, CipherID
|
||||
, cipherKeyBlockSize
|
||||
, Key
|
||||
, IV
|
||||
, cipherExchangeNeedMoreData
|
||||
) where
|
||||
( BulkFunctions(..)
|
||||
, CipherKeyExchangeType(..)
|
||||
, Bulk(..)
|
||||
, Hash(..)
|
||||
, Cipher(..)
|
||||
, CipherID
|
||||
, cipherKeyBlockSize
|
||||
, Key
|
||||
, IV
|
||||
, cipherExchangeNeedMoreData
|
||||
) where
|
||||
|
||||
import Network.TLS.Types (CipherID)
|
||||
import Network.TLS.Struct (Version(..))
|
||||
|
|
@ -30,58 +30,58 @@ type Key = B.ByteString
|
|||
type IV = B.ByteString
|
||||
|
||||
data BulkFunctions =
|
||||
BulkBlockF (Key -> IV -> B.ByteString -> B.ByteString)
|
||||
(Key -> IV -> B.ByteString -> B.ByteString)
|
||||
| BulkStreamF (Key -> IV)
|
||||
(IV -> B.ByteString -> (B.ByteString, IV))
|
||||
(IV -> B.ByteString -> (B.ByteString, IV))
|
||||
BulkBlockF (Key -> IV -> B.ByteString -> B.ByteString)
|
||||
(Key -> IV -> B.ByteString -> B.ByteString)
|
||||
| BulkStreamF (Key -> IV)
|
||||
(IV -> B.ByteString -> (B.ByteString, IV))
|
||||
(IV -> B.ByteString -> (B.ByteString, IV))
|
||||
|
||||
data CipherKeyExchangeType =
|
||||
CipherKeyExchange_RSA
|
||||
| CipherKeyExchange_DH_Anon
|
||||
| CipherKeyExchange_DHE_RSA
|
||||
| CipherKeyExchange_ECDHE_RSA
|
||||
| CipherKeyExchange_DHE_DSS
|
||||
| CipherKeyExchange_DH_DSS
|
||||
| CipherKeyExchange_DH_RSA
|
||||
| CipherKeyExchange_ECDH_ECDSA
|
||||
| CipherKeyExchange_ECDH_RSA
|
||||
| CipherKeyExchange_ECDHE_ECDSA
|
||||
deriving (Show,Eq)
|
||||
CipherKeyExchange_RSA
|
||||
| CipherKeyExchange_DH_Anon
|
||||
| CipherKeyExchange_DHE_RSA
|
||||
| CipherKeyExchange_ECDHE_RSA
|
||||
| CipherKeyExchange_DHE_DSS
|
||||
| CipherKeyExchange_DH_DSS
|
||||
| CipherKeyExchange_DH_RSA
|
||||
| CipherKeyExchange_ECDH_ECDSA
|
||||
| CipherKeyExchange_ECDH_RSA
|
||||
| CipherKeyExchange_ECDHE_ECDSA
|
||||
deriving (Show,Eq)
|
||||
|
||||
data Bulk = Bulk
|
||||
{ bulkName :: String
|
||||
, bulkKeySize :: Int
|
||||
, bulkIVSize :: Int
|
||||
, bulkBlockSize :: Int
|
||||
, bulkF :: BulkFunctions
|
||||
}
|
||||
{ bulkName :: String
|
||||
, bulkKeySize :: Int
|
||||
, bulkIVSize :: Int
|
||||
, bulkBlockSize :: Int
|
||||
, bulkF :: BulkFunctions
|
||||
}
|
||||
|
||||
data Hash = Hash
|
||||
{ hashName :: String
|
||||
, hashSize :: Int
|
||||
, hashF :: B.ByteString -> B.ByteString
|
||||
}
|
||||
{ hashName :: String
|
||||
, hashSize :: Int
|
||||
, hashF :: B.ByteString -> B.ByteString
|
||||
}
|
||||
|
||||
-- | Cipher algorithm
|
||||
data Cipher = Cipher
|
||||
{ cipherID :: CipherID
|
||||
, cipherName :: String
|
||||
, cipherHash :: Hash
|
||||
, cipherBulk :: Bulk
|
||||
, cipherKeyExchange :: CipherKeyExchangeType
|
||||
, cipherMinVer :: Maybe Version
|
||||
}
|
||||
{ cipherID :: CipherID
|
||||
, cipherName :: String
|
||||
, cipherHash :: Hash
|
||||
, cipherBulk :: Bulk
|
||||
, cipherKeyExchange :: CipherKeyExchangeType
|
||||
, cipherMinVer :: Maybe Version
|
||||
}
|
||||
|
||||
cipherKeyBlockSize :: Cipher -> Int
|
||||
cipherKeyBlockSize cipher = 2 * (hashSize (cipherHash cipher) + bulkIVSize bulk + bulkKeySize bulk)
|
||||
where bulk = cipherBulk cipher
|
||||
where bulk = cipherBulk cipher
|
||||
|
||||
instance Show Cipher where
|
||||
show c = cipherName c
|
||||
show c = cipherName c
|
||||
|
||||
instance Eq Cipher where
|
||||
(==) c1 c2 = cipherID c1 == cipherID c2
|
||||
(==) c1 c2 = cipherID c1 == cipherID c2
|
||||
|
||||
cipherExchangeNeedMoreData :: CipherKeyExchangeType -> Bool
|
||||
cipherExchangeNeedMoreData CipherKeyExchange_RSA = False
|
||||
|
|
|
|||
|
|
@ -8,20 +8,20 @@
|
|||
-- Portability : unknown
|
||||
--
|
||||
module Network.TLS.Compression
|
||||
( CompressionC(..)
|
||||
, Compression(..)
|
||||
, CompressionID
|
||||
, nullCompression
|
||||
, NullCompression
|
||||
( CompressionC(..)
|
||||
, Compression(..)
|
||||
, CompressionID
|
||||
, nullCompression
|
||||
, NullCompression
|
||||
|
||||
-- * member redefined for the class abstraction
|
||||
, compressionID
|
||||
, compressionDeflate
|
||||
, compressionInflate
|
||||
-- * member redefined for the class abstraction
|
||||
, compressionID
|
||||
, compressionDeflate
|
||||
, compressionInflate
|
||||
|
||||
-- * helper
|
||||
, compressionIntersectID
|
||||
) where
|
||||
-- * helper
|
||||
, compressionIntersectID
|
||||
) where
|
||||
|
||||
import Data.Word
|
||||
import Network.TLS.Types (CompressionID)
|
||||
|
|
@ -30,9 +30,9 @@ import Control.Arrow (first)
|
|||
|
||||
-- | supported compression algorithms need to be part of this class
|
||||
class CompressionC a where
|
||||
compressionCID :: a -> CompressionID
|
||||
compressionCDeflate :: a -> ByteString -> (a, ByteString)
|
||||
compressionCInflate :: a -> ByteString -> (a, ByteString)
|
||||
compressionCID :: a -> CompressionID
|
||||
compressionCDeflate :: a -> ByteString -> (a, ByteString)
|
||||
compressionCInflate :: a -> ByteString -> (a, ByteString)
|
||||
|
||||
-- | every compression need to be wrapped in this, to fit in structure
|
||||
data Compression = forall a . CompressionC a => Compression a
|
||||
|
|
@ -52,7 +52,7 @@ compressionInflate :: ByteString -> Compression -> (Compression, ByteString)
|
|||
compressionInflate bytes (Compression c) = first Compression $ compressionCInflate c bytes
|
||||
|
||||
instance Show Compression where
|
||||
show = show . compressionID
|
||||
show = show . compressionID
|
||||
|
||||
-- | intersect a list of ids commonly given by the other side with a list of compression
|
||||
-- the function keeps the list of compression in order, to be able to find quickly the prefered
|
||||
|
|
@ -64,9 +64,9 @@ compressionIntersectID l ids = filter (\c -> elem (compressionID c) ids) l
|
|||
data NullCompression = NullCompression
|
||||
|
||||
instance CompressionC NullCompression where
|
||||
compressionCID _ = 0
|
||||
compressionCDeflate s b = (s, b)
|
||||
compressionCInflate s b = (s, b)
|
||||
compressionCID _ = 0
|
||||
compressionCDeflate s b = (s, b)
|
||||
compressionCInflate s b = (s, b)
|
||||
|
||||
-- | default null compression
|
||||
nullCompression :: Compression
|
||||
|
|
|
|||
|
|
@ -1,28 +1,28 @@
|
|||
{-# OPTIONS_HADDOCK hide #-}
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
module Network.TLS.Crypto
|
||||
( HashCtx(..)
|
||||
, hashInit
|
||||
, hashUpdate
|
||||
, hashUpdateSSL
|
||||
, hashFinal
|
||||
( HashCtx(..)
|
||||
, hashInit
|
||||
, hashUpdate
|
||||
, hashUpdateSSL
|
||||
, hashFinal
|
||||
|
||||
-- * constructor
|
||||
, hashMD5SHA1
|
||||
, hashSHA256
|
||||
-- * constructor
|
||||
, hashMD5SHA1
|
||||
, hashSHA256
|
||||
|
||||
-- * key exchange generic interface
|
||||
, PubKey(..)
|
||||
, PrivKey(..)
|
||||
, PublicKey
|
||||
, PrivateKey
|
||||
, HashDescr(..)
|
||||
, kxEncrypt
|
||||
, kxDecrypt
|
||||
, kxSign
|
||||
, kxVerify
|
||||
, KxError(..)
|
||||
) where
|
||||
-- * key exchange generic interface
|
||||
, PubKey(..)
|
||||
, PrivKey(..)
|
||||
, PublicKey
|
||||
, PrivateKey
|
||||
, HashDescr(..)
|
||||
, kxEncrypt
|
||||
, kxDecrypt
|
||||
, kxSign
|
||||
, kxVerify
|
||||
, KxError(..)
|
||||
) where
|
||||
|
||||
import qualified Crypto.Hash.SHA256 as SHA256
|
||||
import qualified Crypto.Hash.SHA1 as SHA1
|
||||
|
|
@ -46,35 +46,35 @@ data KxError =
|
|||
deriving (Show)
|
||||
|
||||
class HashCtxC a where
|
||||
hashCName :: a -> String
|
||||
hashCInit :: a -> a
|
||||
hashCUpdate :: a -> B.ByteString -> a
|
||||
hashCUpdateSSL :: a -> (B.ByteString,B.ByteString) -> a
|
||||
hashCFinal :: a -> B.ByteString
|
||||
hashCName :: a -> String
|
||||
hashCInit :: a -> a
|
||||
hashCUpdate :: a -> B.ByteString -> a
|
||||
hashCUpdateSSL :: a -> (B.ByteString,B.ByteString) -> a
|
||||
hashCFinal :: a -> B.ByteString
|
||||
|
||||
data HashCtx = forall h . HashCtxC h => HashCtx h
|
||||
|
||||
instance Show HashCtx where
|
||||
show (HashCtx c) = hashCName c
|
||||
show (HashCtx c) = hashCName c
|
||||
|
||||
{- MD5 & SHA1 joined -}
|
||||
data HashMD5SHA1 = HashMD5SHA1 SHA1.Ctx MD5.Ctx
|
||||
|
||||
instance HashCtxC HashMD5SHA1 where
|
||||
hashCName _ = "MD5-SHA1"
|
||||
hashCInit _ = HashMD5SHA1 SHA1.init MD5.init
|
||||
hashCUpdate (HashMD5SHA1 sha1ctx md5ctx) b = HashMD5SHA1 (SHA1.update sha1ctx b) (MD5.update md5ctx b)
|
||||
hashCUpdateSSL (HashMD5SHA1 sha1ctx md5ctx) (b1,b2) = HashMD5SHA1 (SHA1.update sha1ctx b2) (MD5.update md5ctx b1)
|
||||
hashCFinal (HashMD5SHA1 sha1ctx md5ctx) = B.concat [MD5.finalize md5ctx, SHA1.finalize sha1ctx]
|
||||
hashCName _ = "MD5-SHA1"
|
||||
hashCInit _ = HashMD5SHA1 SHA1.init MD5.init
|
||||
hashCUpdate (HashMD5SHA1 sha1ctx md5ctx) b = HashMD5SHA1 (SHA1.update sha1ctx b) (MD5.update md5ctx b)
|
||||
hashCUpdateSSL (HashMD5SHA1 sha1ctx md5ctx) (b1,b2) = HashMD5SHA1 (SHA1.update sha1ctx b2) (MD5.update md5ctx b1)
|
||||
hashCFinal (HashMD5SHA1 sha1ctx md5ctx) = B.concat [MD5.finalize md5ctx, SHA1.finalize sha1ctx]
|
||||
|
||||
data HashSHA256 = HashSHA256 SHA256.Ctx
|
||||
|
||||
instance HashCtxC HashSHA256 where
|
||||
hashCName _ = "SHA256"
|
||||
hashCInit _ = HashSHA256 SHA256.init
|
||||
hashCUpdate (HashSHA256 ctx) b = HashSHA256 (SHA256.update ctx b)
|
||||
hashCUpdateSSL _ _ = undefined
|
||||
hashCFinal (HashSHA256 ctx) = SHA256.finalize ctx
|
||||
hashCName _ = "SHA256"
|
||||
hashCInit _ = HashSHA256 SHA256.init
|
||||
hashCUpdate (HashSHA256 ctx) b = HashSHA256 (SHA256.update ctx b)
|
||||
hashCUpdateSSL _ _ = undefined
|
||||
hashCFinal (HashSHA256 ctx) = SHA256.finalize ctx
|
||||
|
||||
-- functions to use the hidden class.
|
||||
hashInit :: HashCtx -> HashCtx
|
||||
|
|
|
|||
|
|
@ -29,13 +29,12 @@ import qualified Control.Exception as E
|
|||
-- This is to be called at the beginning of a connection, and during renegotiation
|
||||
handshake :: MonadIO m => Context -> m ()
|
||||
handshake ctx = do
|
||||
let handshakeF = case roleParams $ ctxParams ctx of
|
||||
Server sparams -> handshakeServer sparams
|
||||
Client cparams -> handshakeClient cparams
|
||||
liftIO $ handleException $ handshakeF ctx
|
||||
where
|
||||
handleException f = E.catch f $ \exception -> do
|
||||
let tlserror = maybe (Error_Misc $ show exception) id $ fromException exception
|
||||
setEstablished ctx False
|
||||
sendPacket ctx (errorToAlert tlserror)
|
||||
handshakeFailed tlserror
|
||||
let handshakeF = case roleParams $ ctxParams ctx of
|
||||
Server sparams -> handshakeServer sparams
|
||||
Client cparams -> handshakeClient cparams
|
||||
liftIO $ handleException $ handshakeF ctx
|
||||
where handleException f = E.catch f $ \exception -> do
|
||||
let tlserror = maybe (Error_Misc $ show exception) id $ fromException exception
|
||||
setEstablished ctx False
|
||||
sendPacket ctx (errorToAlert tlserror)
|
||||
handshakeFailed tlserror
|
||||
|
|
|
|||
|
|
@ -17,13 +17,10 @@ import Network.TLS.Struct
|
|||
import Control.Monad.State
|
||||
|
||||
getHashAndASN1 :: MonadIO m => (HashAlgorithm, SignatureAlgorithm) -> m HashDescr
|
||||
getHashAndASN1 hashSig = do
|
||||
case hashSig of
|
||||
getHashAndASN1 hashSig = case hashSig of
|
||||
(HashSHA1, SignatureRSA) -> return hashDescrSHA1
|
||||
(HashSHA224, SignatureRSA) -> return hashDescrSHA224
|
||||
(HashSHA256, SignatureRSA) -> return hashDescrSHA256
|
||||
(HashSHA384, SignatureRSA) -> return hashDescrSHA384
|
||||
(HashSHA512, SignatureRSA) -> return hashDescrSHA512
|
||||
_ -> throwCore $ Error_Misc "unsupported hash/sig algorithm"
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -7,13 +7,13 @@
|
|||
-- Portability : unknown
|
||||
--
|
||||
module Network.TLS.Internal
|
||||
( module Network.TLS.Struct
|
||||
, module Network.TLS.Packet
|
||||
, module Network.TLS.Receiving
|
||||
, module Network.TLS.Sending
|
||||
, sendPacket
|
||||
, recvPacket
|
||||
) where
|
||||
( module Network.TLS.Struct
|
||||
, module Network.TLS.Packet
|
||||
, module Network.TLS.Receiving
|
||||
, module Network.TLS.Sending
|
||||
, sendPacket
|
||||
, recvPacket
|
||||
) where
|
||||
|
||||
import Network.TLS.Struct
|
||||
import Network.TLS.Packet
|
||||
|
|
|
|||
|
|
@ -6,16 +6,16 @@
|
|||
-- Portability : unknown
|
||||
--
|
||||
module Network.TLS.MAC
|
||||
( hmacMD5
|
||||
, hmacSHA1
|
||||
, hmacSHA256
|
||||
, macSSL
|
||||
, hmac
|
||||
, prf_MD5
|
||||
, prf_SHA1
|
||||
, prf_SHA256
|
||||
, prf_MD5SHA1
|
||||
) where
|
||||
( hmacMD5
|
||||
, hmacSHA1
|
||||
, hmacSHA256
|
||||
, macSSL
|
||||
, hmac
|
||||
, prf_MD5
|
||||
, prf_SHA1
|
||||
, prf_SHA256
|
||||
, prf_MD5SHA1
|
||||
) where
|
||||
|
||||
import qualified Crypto.Hash.MD5 as MD5
|
||||
import qualified Crypto.Hash.SHA1 as SHA1
|
||||
|
|
@ -29,21 +29,18 @@ type HMAC = ByteString -> ByteString -> ByteString
|
|||
macSSL :: (ByteString -> ByteString) -> HMAC
|
||||
macSSL f secret msg = f $! B.concat [ secret, B.replicate padlen 0x5c,
|
||||
f $! B.concat [ secret, B.replicate padlen 0x36, msg ] ]
|
||||
where
|
||||
-- get the type of algorithm out of the digest length by using the hash fct.
|
||||
padlen = if (B.length $ f B.empty) == 16 then 48 else 40
|
||||
where -- get the type of algorithm out of the digest length by using the hash fct.
|
||||
padlen = if (B.length $ f B.empty) == 16 then 48 else 40
|
||||
|
||||
hmac :: (ByteString -> ByteString) -> Int -> HMAC
|
||||
hmac f bl secret msg =
|
||||
f $! B.append opad (f $! B.append ipad msg)
|
||||
where
|
||||
opad = B.map (xor 0x5c) k'
|
||||
ipad = B.map (xor 0x36) k'
|
||||
f $! B.append opad (f $! B.append ipad msg)
|
||||
where opad = B.map (xor 0x5c) k'
|
||||
ipad = B.map (xor 0x36) k'
|
||||
|
||||
k' = B.append kt pad
|
||||
where
|
||||
kt = if B.length secret > fromIntegral bl then f secret else secret
|
||||
pad = B.replicate (fromIntegral bl - B.length kt) 0
|
||||
k' = B.append kt pad
|
||||
where kt = if B.length secret > fromIntegral bl then f secret else secret
|
||||
pad = B.replicate (fromIntegral bl - B.length kt) 0
|
||||
|
||||
hmacMD5 :: HMAC
|
||||
hmacMD5 secret msg = hmac MD5.hash 64 secret msg
|
||||
|
|
@ -56,12 +53,12 @@ hmacSHA256 secret msg = hmac SHA256.hash 64 secret msg
|
|||
|
||||
hmacIter :: HMAC -> ByteString -> ByteString -> ByteString -> Int -> [ByteString]
|
||||
hmacIter f secret seed aprev len =
|
||||
let an = f secret aprev in
|
||||
let out = f secret (B.concat [an, seed]) in
|
||||
let digestsize = fromIntegral $ B.length out in
|
||||
if digestsize >= len
|
||||
then [ B.take (fromIntegral len) out ]
|
||||
else out : hmacIter f secret seed an (len - digestsize)
|
||||
let an = f secret aprev in
|
||||
let out = f secret (B.concat [an, seed]) in
|
||||
let digestsize = fromIntegral $ B.length out in
|
||||
if digestsize >= len
|
||||
then [ B.take (fromIntegral len) out ]
|
||||
else out : hmacIter f secret seed an (len - digestsize)
|
||||
|
||||
prf_SHA1 :: ByteString -> ByteString -> Int -> ByteString
|
||||
prf_SHA1 secret seed len = B.concat $ hmacIter hmacSHA1 secret seed seed len
|
||||
|
|
@ -71,11 +68,10 @@ prf_MD5 secret seed len = B.concat $ hmacIter hmacMD5 secret seed seed len
|
|||
|
||||
prf_MD5SHA1 :: ByteString -> ByteString -> Int -> ByteString
|
||||
prf_MD5SHA1 secret seed len =
|
||||
B.pack $ B.zipWith xor (prf_MD5 s1 seed len) (prf_SHA1 s2 seed len)
|
||||
where
|
||||
slen = B.length secret
|
||||
s1 = B.take (slen `div` 2 + slen `mod` 2) secret
|
||||
s2 = B.drop (slen `div` 2) secret
|
||||
B.pack $ B.zipWith xor (prf_MD5 s1 seed len) (prf_SHA1 s2 seed len)
|
||||
where slen = B.length secret
|
||||
s1 = B.take (slen `div` 2 + slen `mod` 2) secret
|
||||
s2 = B.drop (slen `div` 2) secret
|
||||
|
||||
prf_SHA256 :: ByteString -> ByteString -> Int -> ByteString
|
||||
prf_SHA256 secret seed len = B.concat $ hmacIter hmacSHA256 secret seed seed len
|
||||
|
|
|
|||
|
|
@ -10,45 +10,45 @@
|
|||
-- with only explicit parameters, no TLS state is involved here.
|
||||
--
|
||||
module Network.TLS.Packet
|
||||
(
|
||||
-- * params for encoding and decoding
|
||||
CurrentParams(..)
|
||||
-- * marshall functions for header messages
|
||||
, decodeHeader
|
||||
, decodeDeprecatedHeaderLength
|
||||
, decodeDeprecatedHeader
|
||||
, encodeHeader
|
||||
, encodeHeaderNoVer -- use for SSL3
|
||||
(
|
||||
-- * params for encoding and decoding
|
||||
CurrentParams(..)
|
||||
-- * marshall functions for header messages
|
||||
, decodeHeader
|
||||
, decodeDeprecatedHeaderLength
|
||||
, decodeDeprecatedHeader
|
||||
, encodeHeader
|
||||
, encodeHeaderNoVer -- use for SSL3
|
||||
|
||||
-- * marshall functions for alert messages
|
||||
, decodeAlert
|
||||
, decodeAlerts
|
||||
, encodeAlerts
|
||||
-- * marshall functions for alert messages
|
||||
, decodeAlert
|
||||
, decodeAlerts
|
||||
, encodeAlerts
|
||||
|
||||
-- * marshall functions for handshake messages
|
||||
, decodeHandshakes
|
||||
, decodeHandshake
|
||||
, decodeDeprecatedHandshake
|
||||
, encodeHandshake
|
||||
, encodeHandshakes
|
||||
, encodeHandshakeHeader
|
||||
, encodeHandshakeContent
|
||||
-- * marshall functions for handshake messages
|
||||
, decodeHandshakes
|
||||
, decodeHandshake
|
||||
, decodeDeprecatedHandshake
|
||||
, encodeHandshake
|
||||
, encodeHandshakes
|
||||
, encodeHandshakeHeader
|
||||
, encodeHandshakeContent
|
||||
|
||||
-- * marshall functions for change cipher spec message
|
||||
, decodeChangeCipherSpec
|
||||
, encodeChangeCipherSpec
|
||||
-- * marshall functions for change cipher spec message
|
||||
, decodeChangeCipherSpec
|
||||
, encodeChangeCipherSpec
|
||||
|
||||
, decodePreMasterSecret
|
||||
, encodePreMasterSecret
|
||||
, decodePreMasterSecret
|
||||
, encodePreMasterSecret
|
||||
|
||||
-- * generate things for packet content
|
||||
, generateMasterSecret
|
||||
, generateKeyBlock
|
||||
, generateClientFinished
|
||||
, generateServerFinished
|
||||
-- * generate things for packet content
|
||||
, generateMasterSecret
|
||||
, generateKeyBlock
|
||||
, generateClientFinished
|
||||
, generateServerFinished
|
||||
|
||||
, generateCertificateVerify_SSL
|
||||
) where
|
||||
, generateCertificateVerify_SSL
|
||||
) where
|
||||
|
||||
import Network.TLS.Struct
|
||||
import Network.TLS.Wire
|
||||
|
|
@ -84,8 +84,8 @@ getVersion = do
|
|||
major <- getWord8
|
||||
minor <- getWord8
|
||||
case verOfNum (major, minor) of
|
||||
Nothing -> fail ("invalid version : " ++ show major ++ "," ++ show minor)
|
||||
Just v -> return v
|
||||
Nothing -> fail ("invalid version : " ++ show major ++ "," ++ show minor)
|
||||
Just v -> return v
|
||||
|
||||
putVersion :: Version -> Put
|
||||
putVersion ver = putWord8 major >> putWord8 minor
|
||||
|
|
|
|||
|
|
@ -29,9 +29,9 @@ import Network.TLS.Crypto
|
|||
-}
|
||||
makeRecord :: Packet -> RecordM (Record Plaintext)
|
||||
makeRecord pkt = do
|
||||
ver <- stVersion <$> get
|
||||
content <- writePacketContent pkt
|
||||
return $ Record (packetType pkt) ver (fragmentPlaintext content)
|
||||
ver <- stVersion <$> get
|
||||
content <- writePacketContent pkt
|
||||
return $ Record (packetType pkt) ver (fragmentPlaintext content)
|
||||
|
||||
{-
|
||||
- ChangeCipherSpec state change need to be handled after encryption otherwise
|
||||
|
|
@ -40,7 +40,7 @@ makeRecord pkt = do
|
|||
-}
|
||||
postprocessRecord :: Record Ciphertext -> RecordM (Record Ciphertext)
|
||||
postprocessRecord record@(Record ProtocolType_ChangeCipherSpec _ _) =
|
||||
switchTxEncryption >> return record
|
||||
switchTxEncryption >> return record
|
||||
postprocessRecord record = return record
|
||||
|
||||
{-
|
||||
|
|
@ -48,7 +48,7 @@ postprocessRecord record = return record
|
|||
-}
|
||||
encodeRecord :: Record Ciphertext -> RecordM ByteString
|
||||
encodeRecord record = return $ B.concat [ encodeHeader hdr, content ]
|
||||
where (hdr, content) = recordToRaw record
|
||||
where (hdr, content) = recordToRaw record
|
||||
|
||||
{-
|
||||
- just update TLS state machine
|
||||
|
|
@ -58,11 +58,11 @@ preProcessPacket (Alert _) = return ()
|
|||
preProcessPacket (AppData _) = return ()
|
||||
preProcessPacket (ChangeCipherSpec) = return ()
|
||||
preProcessPacket (Handshake hss) = forM_ hss $ \hs -> do
|
||||
case hs of
|
||||
Finished fdata -> updateVerifiedData True fdata
|
||||
_ -> return ()
|
||||
when (certVerifyHandshakeMaterial hs) $ addHandshakeMessage $ encodeHandshake hs
|
||||
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) (updateHandshakeDigest $ encodeHandshake hs)
|
||||
case hs of
|
||||
Finished fdata -> updateVerifiedData True fdata
|
||||
_ -> return ()
|
||||
when (certVerifyHandshakeMaterial hs) $ addHandshakeMessage $ encodeHandshake hs
|
||||
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) (updateHandshakeDigest $ encodeHandshake hs)
|
||||
|
||||
{-
|
||||
- writePacket transform a packet into marshalled data related to current state
|
||||
|
|
|
|||
|
|
@ -10,73 +10,73 @@
|
|||
-- which is use by the Receiving module and the Sending module.
|
||||
--
|
||||
module Network.TLS.State
|
||||
( TLSState(..)
|
||||
, TLSSt
|
||||
, RecordState(..)
|
||||
, RecordM
|
||||
, getRecordState
|
||||
, runTLSState
|
||||
, runRecordStateSt
|
||||
, TLSHandshakeState(..)
|
||||
, TLSCryptState(..)
|
||||
, TLSMacState(..)
|
||||
, newTLSState
|
||||
, genTLSRandom
|
||||
, withTLSRNG
|
||||
, withCompression
|
||||
, assert -- FIXME move somewhere else (Internal.hs ?)
|
||||
, updateVerifiedData
|
||||
, finishHandshakeTypeMaterial
|
||||
, finishHandshakeMaterial
|
||||
, certVerifyHandshakeTypeMaterial
|
||||
, certVerifyHandshakeMaterial
|
||||
, makeDigest
|
||||
, setMasterSecret
|
||||
, setMasterSecretFromPre
|
||||
, getMasterSecret
|
||||
, setPublicKey
|
||||
, setPrivateKey
|
||||
, setClientPublicKey
|
||||
, setClientPrivateKey
|
||||
, setClientCertSent
|
||||
, getClientCertSent
|
||||
, setCertReqSent
|
||||
, getCertReqSent
|
||||
, setClientCertChain
|
||||
, getClientCertChain
|
||||
, setClientCertRequest
|
||||
, getClientCertRequest
|
||||
, setKeyBlock
|
||||
, setVersion
|
||||
, setCipher
|
||||
, setServerRandom
|
||||
, setSecureRenegotiation
|
||||
, getSecureRenegotiation
|
||||
, setExtensionNPN
|
||||
, getExtensionNPN
|
||||
, setNegotiatedProtocol
|
||||
, getNegotiatedProtocol
|
||||
, setServerNextProtocolSuggest
|
||||
, getServerNextProtocolSuggest
|
||||
, getClientCertificateChain
|
||||
, setClientCertificateChain
|
||||
, getVerifiedData
|
||||
, setSession
|
||||
, getSession
|
||||
, getSessionData
|
||||
, isSessionResuming
|
||||
, needEmptyPacket
|
||||
, switchTxEncryption
|
||||
, switchRxEncryption
|
||||
, getCipherKeyExchangeType
|
||||
, isClientContext
|
||||
, startHandshakeClient
|
||||
, addHandshakeMessage
|
||||
, updateHandshakeDigest
|
||||
, getHandshakeDigest
|
||||
, getHandshakeMessages
|
||||
, endHandshake
|
||||
) where
|
||||
( TLSState(..)
|
||||
, TLSSt
|
||||
, RecordState(..)
|
||||
, RecordM
|
||||
, getRecordState
|
||||
, runTLSState
|
||||
, runRecordStateSt
|
||||
, TLSHandshakeState(..)
|
||||
, TLSCryptState(..)
|
||||
, TLSMacState(..)
|
||||
, newTLSState
|
||||
, genTLSRandom
|
||||
, withTLSRNG
|
||||
, withCompression
|
||||
, assert -- FIXME move somewhere else (Internal.hs ?)
|
||||
, updateVerifiedData
|
||||
, finishHandshakeTypeMaterial
|
||||
, finishHandshakeMaterial
|
||||
, certVerifyHandshakeTypeMaterial
|
||||
, certVerifyHandshakeMaterial
|
||||
, makeDigest
|
||||
, setMasterSecret
|
||||
, setMasterSecretFromPre
|
||||
, getMasterSecret
|
||||
, setPublicKey
|
||||
, setPrivateKey
|
||||
, setClientPublicKey
|
||||
, setClientPrivateKey
|
||||
, setClientCertSent
|
||||
, getClientCertSent
|
||||
, setCertReqSent
|
||||
, getCertReqSent
|
||||
, setClientCertChain
|
||||
, getClientCertChain
|
||||
, setClientCertRequest
|
||||
, getClientCertRequest
|
||||
, setKeyBlock
|
||||
, setVersion
|
||||
, setCipher
|
||||
, setServerRandom
|
||||
, setSecureRenegotiation
|
||||
, getSecureRenegotiation
|
||||
, setExtensionNPN
|
||||
, getExtensionNPN
|
||||
, setNegotiatedProtocol
|
||||
, getNegotiatedProtocol
|
||||
, setServerNextProtocolSuggest
|
||||
, getServerNextProtocolSuggest
|
||||
, getClientCertificateChain
|
||||
, setClientCertificateChain
|
||||
, getVerifiedData
|
||||
, setSession
|
||||
, getSession
|
||||
, getSessionData
|
||||
, isSessionResuming
|
||||
, needEmptyPacket
|
||||
, switchTxEncryption
|
||||
, switchRxEncryption
|
||||
, getCipherKeyExchangeType
|
||||
, isClientContext
|
||||
, startHandshakeClient
|
||||
, addHandshakeMessage
|
||||
, updateHandshakeDigest
|
||||
, getHandshakeDigest
|
||||
, getHandshakeMessages
|
||||
, endHandshake
|
||||
) where
|
||||
|
||||
import Data.Word
|
||||
import Data.Maybe (isNothing)
|
||||
|
|
@ -98,102 +98,102 @@ import Data.X509 (CertificateChain)
|
|||
|
||||
assert :: Monad m => String -> [(String,Bool)] -> m ()
|
||||
assert fctname list = forM_ list $ \ (name, assumption) -> do
|
||||
when assumption $ fail (fctname ++ ": assumption about " ++ name ++ " failed")
|
||||
when assumption $ fail (fctname ++ ": assumption about " ++ name ++ " failed")
|
||||
|
||||
data TLSCryptState = TLSCryptState
|
||||
{ cstKey :: !Bytes
|
||||
, cstIV :: !Bytes
|
||||
, cstMacSecret :: !Bytes
|
||||
} deriving (Show)
|
||||
{ cstKey :: !Bytes
|
||||
, cstIV :: !Bytes
|
||||
, cstMacSecret :: !Bytes
|
||||
} deriving (Show)
|
||||
|
||||
data TLSMacState = TLSMacState
|
||||
{ msSequence :: Word64
|
||||
} deriving (Show)
|
||||
{ msSequence :: Word64
|
||||
} deriving (Show)
|
||||
|
||||
type ClientCertRequestData = ([CertificateType],
|
||||
Maybe [(HashAlgorithm, SignatureAlgorithm)],
|
||||
[DistinguishedName])
|
||||
|
||||
data TLSHandshakeState = TLSHandshakeState
|
||||
{ hstClientVersion :: !(Version)
|
||||
, hstClientRandom :: !ClientRandom
|
||||
, hstServerRandom :: !(Maybe ServerRandom)
|
||||
, hstMasterSecret :: !(Maybe Bytes)
|
||||
, hstRSAPublicKey :: !(Maybe PubKey)
|
||||
, hstRSAPrivateKey :: !(Maybe PrivKey)
|
||||
, hstRSAClientPublicKey :: !(Maybe PubKey)
|
||||
, hstRSAClientPrivateKey :: !(Maybe PrivKey)
|
||||
, hstHandshakeDigest :: !HashCtx
|
||||
, hstHandshakeMessages :: [Bytes]
|
||||
, hstClientCertRequest :: !(Maybe ClientCertRequestData) -- ^ Set to Just-value when certificate request was received
|
||||
, hstClientCertSent :: !Bool -- ^ Set to true when a client certificate chain was sent
|
||||
, hstCertReqSent :: !Bool -- ^ Set to true when a certificate request was sent
|
||||
, hstClientCertChain :: !(Maybe CertificateChain)
|
||||
} deriving (Show)
|
||||
{ hstClientVersion :: !(Version)
|
||||
, hstClientRandom :: !ClientRandom
|
||||
, hstServerRandom :: !(Maybe ServerRandom)
|
||||
, hstMasterSecret :: !(Maybe Bytes)
|
||||
, hstRSAPublicKey :: !(Maybe PubKey)
|
||||
, hstRSAPrivateKey :: !(Maybe PrivKey)
|
||||
, hstRSAClientPublicKey :: !(Maybe PubKey)
|
||||
, hstRSAClientPrivateKey :: !(Maybe PrivKey)
|
||||
, hstHandshakeDigest :: !HashCtx
|
||||
, hstHandshakeMessages :: [Bytes]
|
||||
, hstClientCertRequest :: !(Maybe ClientCertRequestData) -- ^ Set to Just-value when certificate request was received
|
||||
, hstClientCertSent :: !Bool -- ^ Set to true when a client certificate chain was sent
|
||||
, hstCertReqSent :: !Bool -- ^ Set to true when a certificate request was sent
|
||||
, hstClientCertChain :: !(Maybe CertificateChain)
|
||||
} deriving (Show)
|
||||
|
||||
data StateRNG = forall g . CPRG g => StateRNG g
|
||||
|
||||
instance Show StateRNG where
|
||||
show _ = "rng[..]"
|
||||
show _ = "rng[..]"
|
||||
|
||||
data RecordState = RecordState
|
||||
{ stClientContext :: Bool
|
||||
, stVersion :: !Version
|
||||
, stTxEncrypted :: Bool
|
||||
, stRxEncrypted :: Bool
|
||||
, stActiveTxCryptState :: !(Maybe TLSCryptState)
|
||||
, stActiveRxCryptState :: !(Maybe TLSCryptState)
|
||||
, stPendingTxCryptState :: !(Maybe TLSCryptState)
|
||||
, stPendingRxCryptState :: !(Maybe TLSCryptState)
|
||||
, stActiveTxMacState :: !(Maybe TLSMacState)
|
||||
, stActiveRxMacState :: !(Maybe TLSMacState)
|
||||
, stPendingTxMacState :: !(Maybe TLSMacState)
|
||||
, stPendingRxMacState :: !(Maybe TLSMacState)
|
||||
, stActiveTxCipher :: Maybe Cipher
|
||||
, stActiveRxCipher :: Maybe Cipher
|
||||
, stPendingCipher :: Maybe Cipher
|
||||
, stCompression :: Compression
|
||||
, stRandomGen :: StateRNG
|
||||
} deriving (Show)
|
||||
{ stClientContext :: Bool
|
||||
, stVersion :: !Version
|
||||
, stTxEncrypted :: Bool
|
||||
, stRxEncrypted :: Bool
|
||||
, stActiveTxCryptState :: !(Maybe TLSCryptState)
|
||||
, stActiveRxCryptState :: !(Maybe TLSCryptState)
|
||||
, stPendingTxCryptState :: !(Maybe TLSCryptState)
|
||||
, stPendingRxCryptState :: !(Maybe TLSCryptState)
|
||||
, stActiveTxMacState :: !(Maybe TLSMacState)
|
||||
, stActiveRxMacState :: !(Maybe TLSMacState)
|
||||
, stPendingTxMacState :: !(Maybe TLSMacState)
|
||||
, stPendingRxMacState :: !(Maybe TLSMacState)
|
||||
, stActiveTxCipher :: Maybe Cipher
|
||||
, stActiveRxCipher :: Maybe Cipher
|
||||
, stPendingCipher :: Maybe Cipher
|
||||
, stCompression :: Compression
|
||||
, stRandomGen :: StateRNG
|
||||
} deriving (Show)
|
||||
|
||||
newtype RecordM a = RecordM { runRecordM :: ErrorT TLSError (State RecordState) a }
|
||||
deriving (Monad, MonadError TLSError)
|
||||
deriving (Monad, MonadError TLSError)
|
||||
|
||||
instance Functor RecordM where
|
||||
fmap f = RecordM . fmap f . runRecordM
|
||||
fmap f = RecordM . fmap f . runRecordM
|
||||
|
||||
instance MonadState RecordState RecordM where
|
||||
put x = RecordM (lift $ put x)
|
||||
get = RecordM (lift get)
|
||||
put x = RecordM (lift $ put x)
|
||||
get = RecordM (lift get)
|
||||
#if MIN_VERSION_mtl(2,1,0)
|
||||
state f = RecordM (lift $ state f)
|
||||
state f = RecordM (lift $ state f)
|
||||
#endif
|
||||
|
||||
data TLSState = TLSState
|
||||
{ stHandshake :: !(Maybe TLSHandshakeState)
|
||||
, stSession :: Session
|
||||
, stSessionResuming :: Bool
|
||||
, stRecordState :: RecordState
|
||||
, stSecureRenegotiation :: Bool -- RFC 5746
|
||||
, stClientVerifiedData :: Bytes -- RFC 5746
|
||||
, stServerVerifiedData :: Bytes -- RFC 5746
|
||||
, stExtensionNPN :: Bool -- NPN draft extension
|
||||
, stNegotiatedProtocol :: Maybe B.ByteString -- NPN protocol
|
||||
, stServerNextProtocolSuggest :: Maybe [B.ByteString]
|
||||
, stClientCertificateChain :: Maybe CertificateChain
|
||||
} deriving (Show)
|
||||
{ stHandshake :: !(Maybe TLSHandshakeState)
|
||||
, stSession :: Session
|
||||
, stSessionResuming :: Bool
|
||||
, stRecordState :: RecordState
|
||||
, stSecureRenegotiation :: Bool -- RFC 5746
|
||||
, stClientVerifiedData :: Bytes -- RFC 5746
|
||||
, stServerVerifiedData :: Bytes -- RFC 5746
|
||||
, stExtensionNPN :: Bool -- NPN draft extension
|
||||
, stNegotiatedProtocol :: Maybe B.ByteString -- NPN protocol
|
||||
, stServerNextProtocolSuggest :: Maybe [B.ByteString]
|
||||
, stClientCertificateChain :: Maybe CertificateChain
|
||||
} deriving (Show)
|
||||
|
||||
newtype TLSSt a = TLSSt { runTLSSt :: ErrorT TLSError (State TLSState) a }
|
||||
deriving (Monad, MonadError TLSError)
|
||||
deriving (Monad, MonadError TLSError)
|
||||
|
||||
instance Functor TLSSt where
|
||||
fmap f = TLSSt . fmap f . runTLSSt
|
||||
fmap f = TLSSt . fmap f . runTLSSt
|
||||
|
||||
instance MonadState TLSState TLSSt where
|
||||
put x = TLSSt (lift $ put x)
|
||||
get = TLSSt (lift get)
|
||||
put x = TLSSt (lift $ put x)
|
||||
get = TLSSt (lift get)
|
||||
#if MIN_VERSION_mtl(2,1,0)
|
||||
state f = TLSSt (lift $ state f)
|
||||
state f = TLSSt (lift $ state f)
|
||||
#endif
|
||||
|
||||
runTLSState :: TLSSt a -> TLSState -> (Either TLSError a, TLSState)
|
||||
|
|
@ -218,39 +218,39 @@ runRecordStateSt f = do
|
|||
|
||||
newTLSState :: CPRG g => g -> Bool -> TLSState
|
||||
newTLSState rng clientContext = TLSState
|
||||
{ stHandshake = Nothing
|
||||
, stSession = Session Nothing
|
||||
, stSessionResuming = False
|
||||
, stRecordState = newRecordState rng clientContext
|
||||
, stSecureRenegotiation = False
|
||||
, stClientVerifiedData = B.empty
|
||||
, stServerVerifiedData = B.empty
|
||||
, stExtensionNPN = False
|
||||
, stNegotiatedProtocol = Nothing
|
||||
, stServerNextProtocolSuggest = Nothing
|
||||
, stClientCertificateChain = Nothing
|
||||
}
|
||||
{ stHandshake = Nothing
|
||||
, stSession = Session Nothing
|
||||
, stSessionResuming = False
|
||||
, stRecordState = newRecordState rng clientContext
|
||||
, stSecureRenegotiation = False
|
||||
, stClientVerifiedData = B.empty
|
||||
, stServerVerifiedData = B.empty
|
||||
, stExtensionNPN = False
|
||||
, stNegotiatedProtocol = Nothing
|
||||
, stServerNextProtocolSuggest = Nothing
|
||||
, stClientCertificateChain = Nothing
|
||||
}
|
||||
|
||||
newRecordState :: CPRG g => g -> Bool -> RecordState
|
||||
newRecordState rng clientContext = RecordState
|
||||
{ stClientContext = clientContext
|
||||
, stVersion = TLS10
|
||||
, stTxEncrypted = False
|
||||
, stRxEncrypted = False
|
||||
, stActiveTxCryptState = Nothing
|
||||
, stActiveRxCryptState = Nothing
|
||||
, stPendingTxCryptState = Nothing
|
||||
, stPendingRxCryptState = Nothing
|
||||
, stActiveTxMacState = Nothing
|
||||
, stActiveRxMacState = Nothing
|
||||
, stPendingTxMacState = Nothing
|
||||
, stPendingRxMacState = Nothing
|
||||
, stActiveTxCipher = Nothing
|
||||
, stActiveRxCipher = Nothing
|
||||
, stPendingCipher = Nothing
|
||||
, stCompression = nullCompression
|
||||
, stRandomGen = StateRNG rng
|
||||
}
|
||||
{ stClientContext = clientContext
|
||||
, stVersion = TLS10
|
||||
, stTxEncrypted = False
|
||||
, stRxEncrypted = False
|
||||
, stActiveTxCryptState = Nothing
|
||||
, stActiveRxCryptState = Nothing
|
||||
, stPendingTxCryptState = Nothing
|
||||
, stPendingRxCryptState = Nothing
|
||||
, stActiveTxMacState = Nothing
|
||||
, stActiveRxMacState = Nothing
|
||||
, stPendingTxMacState = Nothing
|
||||
, stPendingRxMacState = Nothing
|
||||
, stActiveTxCipher = Nothing
|
||||
, stActiveRxCipher = Nothing
|
||||
, stPendingCipher = Nothing
|
||||
, stCompression = nullCompression
|
||||
, stRandomGen = StateRNG rng
|
||||
}
|
||||
|
||||
withTLSRNG :: StateRNG -> (forall g . CPRG g => g -> (a,g)) -> (a, StateRNG)
|
||||
withTLSRNG (StateRNG rng) f = let (a, rng') = f rng
|
||||
|
|
@ -258,43 +258,43 @@ withTLSRNG (StateRNG rng) f = let (a, rng') = f rng
|
|||
|
||||
withCompression :: (Compression -> (Compression, a)) -> RecordM a
|
||||
withCompression f = do
|
||||
st <- get
|
||||
let (nc, a) = f (stCompression st)
|
||||
put $ st { stCompression = nc }
|
||||
return a
|
||||
st <- get
|
||||
let (nc, a) = f (stCompression st)
|
||||
put $ st { stCompression = nc }
|
||||
return a
|
||||
|
||||
genTLSRandom :: (MonadState RecordState m, MonadError TLSError m) => Int -> m Bytes
|
||||
genTLSRandom n = do
|
||||
st <- get
|
||||
case withTLSRNG (stRandomGen st) (genRandomBytes n) of
|
||||
(bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes
|
||||
st <- get
|
||||
case withTLSRNG (stRandomGen st) (genRandomBytes n) of
|
||||
(bytes, rng') -> put (st { stRandomGen = rng' }) >> return bytes
|
||||
|
||||
makeDigest :: MonadState RecordState m => Bool -> Header -> Bytes -> m Bytes
|
||||
makeDigest w hdr content = do
|
||||
st <- get
|
||||
let ver = stVersion st
|
||||
let cst = fromJust "crypt state" $ if w then stActiveTxCryptState st else stActiveRxCryptState st
|
||||
let ms = fromJust "mac state" $ if w then stActiveTxMacState st else stActiveRxMacState st
|
||||
let cipher = fromJust "cipher" $ if w then stActiveTxCipher st else stActiveRxCipher st
|
||||
let hashf = hashF $ cipherHash cipher
|
||||
st <- get
|
||||
let ver = stVersion st
|
||||
let cst = fromJust "crypt state" $ if w then stActiveTxCryptState st else stActiveRxCryptState st
|
||||
let ms = fromJust "mac state" $ if w then stActiveTxMacState st else stActiveRxMacState st
|
||||
let cipher = fromJust "cipher" $ if w then stActiveTxCipher st else stActiveRxCipher st
|
||||
let hashf = hashF $ cipherHash cipher
|
||||
|
||||
let (macF, msg) =
|
||||
if ver < TLS10
|
||||
then (macSSL hashf, B.concat [ encodeWord64 $ msSequence ms, encodeHeaderNoVer hdr, content ])
|
||||
else (hmac hashf 64, B.concat [ encodeWord64 $ msSequence ms, encodeHeader hdr, content ])
|
||||
let digest = macF (cstMacSecret cst) msg
|
||||
let (macF, msg) =
|
||||
if ver < TLS10
|
||||
then (macSSL hashf, B.concat [ encodeWord64 $ msSequence ms, encodeHeaderNoVer hdr, content ])
|
||||
else (hmac hashf 64, B.concat [ encodeWord64 $ msSequence ms, encodeHeader hdr, content ])
|
||||
let digest = macF (cstMacSecret cst) msg
|
||||
|
||||
let newms = ms { msSequence = (msSequence ms) + 1 }
|
||||
let newms = ms { msSequence = (msSequence ms) + 1 }
|
||||
|
||||
modify (\_ -> if w then st { stActiveTxMacState = Just newms } else st { stActiveRxMacState = Just newms })
|
||||
return digest
|
||||
modify (\_ -> if w then st { stActiveTxMacState = Just newms } else st { stActiveRxMacState = Just newms })
|
||||
return digest
|
||||
|
||||
updateVerifiedData :: MonadState TLSState m => Bool -> Bytes -> m ()
|
||||
updateVerifiedData sending bs = do
|
||||
cc <- isClientContext
|
||||
if cc /= sending
|
||||
then modify (\st -> st { stServerVerifiedData = bs })
|
||||
else modify (\st -> st { stClientVerifiedData = bs })
|
||||
cc <- isClientContext
|
||||
if cc /= sending
|
||||
then modify (\st -> st { stServerVerifiedData = bs })
|
||||
else modify (\st -> st { stClientVerifiedData = bs })
|
||||
|
||||
finishHandshakeTypeMaterial :: HandshakeType -> Bool
|
||||
finishHandshakeTypeMaterial HandshakeType_ClientHello = True
|
||||
|
|
@ -343,24 +343,23 @@ setServerRandom ran = updateHandshake "srand" (\hst -> hst { hstServerRandom = J
|
|||
|
||||
setMasterSecret :: MonadState TLSState m => Bytes -> m ()
|
||||
setMasterSecret masterSecret = do
|
||||
hasValidHandshake "master secret"
|
||||
hasValidHandshake "master secret"
|
||||
|
||||
updateHandshake "master secret" (\hst -> hst { hstMasterSecret = Just masterSecret } )
|
||||
setKeyBlock
|
||||
return ()
|
||||
updateHandshake "master secret" (\hst -> hst { hstMasterSecret = Just masterSecret } )
|
||||
setKeyBlock
|
||||
return ()
|
||||
|
||||
setMasterSecretFromPre :: MonadState TLSState m => Bytes -> m ()
|
||||
setMasterSecretFromPre premasterSecret = do
|
||||
hasValidHandshake "generate master secret"
|
||||
st <- get
|
||||
setMasterSecret $ genSecret st
|
||||
where
|
||||
genSecret st =
|
||||
let hst = fromJust "handshake" $ stHandshake st in
|
||||
generateMasterSecret (stVersion $ stRecordState st)
|
||||
premasterSecret
|
||||
(hstClientRandom hst)
|
||||
(fromJust "server random" $ hstServerRandom hst)
|
||||
hasValidHandshake "generate master secret"
|
||||
st <- get
|
||||
setMasterSecret $ genSecret st
|
||||
where genSecret st =
|
||||
let hst = fromJust "handshake" $ stHandshake st in
|
||||
generateMasterSecret (stVersion $ stRecordState st)
|
||||
premasterSecret
|
||||
(hstClientRandom hst)
|
||||
(fromJust "server random" $ hstServerRandom hst)
|
||||
|
||||
getMasterSecret :: MonadState TLSState m => m (Maybe Bytes)
|
||||
getMasterSecret = gets (stHandshake >=> hstMasterSecret)
|
||||
|
|
@ -403,12 +402,12 @@ getClientCertRequest = gets (stHandshake >=> hstClientCertRequest)
|
|||
|
||||
getSessionData :: MonadState TLSState m => m (Maybe SessionData)
|
||||
getSessionData = get >>= \st -> return (stHandshake st >>= hstMasterSecret >>= wrapSessionData st)
|
||||
where wrapSessionData st masterSecret = do
|
||||
return $ SessionData
|
||||
{ sessionVersion = stVersion $ stRecordState st
|
||||
, sessionCipher = cipherID $ fromJust "cipher" $ stActiveTxCipher $ stRecordState st
|
||||
, sessionSecret = masterSecret
|
||||
}
|
||||
where wrapSessionData st masterSecret = do
|
||||
return $ SessionData
|
||||
{ sessionVersion = stVersion $ stRecordState st
|
||||
, sessionCipher = cipherID $ fromJust "cipher" $ stActiveTxCipher $ stRecordState st
|
||||
, sessionSecret = masterSecret
|
||||
}
|
||||
|
||||
setSession :: MonadState TLSState m => Session -> Bool -> m ()
|
||||
setSession session resuming = modify (\st -> st { stSession = session, stSessionResuming = resuming })
|
||||
|
|
@ -421,9 +420,9 @@ isSessionResuming = gets stSessionResuming
|
|||
|
||||
needEmptyPacket :: MonadState RecordState m => m Bool
|
||||
needEmptyPacket = gets f
|
||||
where f st = (stVersion st <= TLS10)
|
||||
&& stClientContext st
|
||||
&& (maybe False (\c -> bulkBlockSize (cipherBulk c) > 0) (stActiveTxCipher st))
|
||||
where f st = (stVersion st <= TLS10)
|
||||
&& stClientContext st
|
||||
&& (maybe False (\c -> bulkBlockSize (cipherBulk c) > 0) (stActiveTxCipher st))
|
||||
|
||||
setKeyBlock :: MonadState TLSState m => m ()
|
||||
setKeyBlock = modify setPendingState
|
||||
|
|
@ -509,59 +508,59 @@ isClientContext = getRecordState stClientContext
|
|||
-- create a new empty handshake state
|
||||
newEmptyHandshake :: Version -> ClientRandom -> HashCtx -> TLSHandshakeState
|
||||
newEmptyHandshake ver crand digestInit = TLSHandshakeState
|
||||
{ hstClientVersion = ver
|
||||
, hstClientRandom = crand
|
||||
, hstServerRandom = Nothing
|
||||
, hstMasterSecret = Nothing
|
||||
, hstRSAPublicKey = Nothing
|
||||
, hstRSAPrivateKey = Nothing
|
||||
, hstRSAClientPublicKey = Nothing
|
||||
, hstRSAClientPrivateKey = Nothing
|
||||
, hstHandshakeDigest = digestInit
|
||||
, hstHandshakeMessages = []
|
||||
, hstClientCertRequest = Nothing
|
||||
, hstClientCertSent = False
|
||||
, hstCertReqSent = False
|
||||
, hstClientCertChain = Nothing
|
||||
}
|
||||
{ hstClientVersion = ver
|
||||
, hstClientRandom = crand
|
||||
, hstServerRandom = Nothing
|
||||
, hstMasterSecret = Nothing
|
||||
, hstRSAPublicKey = Nothing
|
||||
, hstRSAPrivateKey = Nothing
|
||||
, hstRSAClientPublicKey = Nothing
|
||||
, hstRSAClientPrivateKey = Nothing
|
||||
, hstHandshakeDigest = digestInit
|
||||
, hstHandshakeMessages = []
|
||||
, hstClientCertRequest = Nothing
|
||||
, hstClientCertSent = False
|
||||
, hstCertReqSent = False
|
||||
, hstClientCertChain = Nothing
|
||||
}
|
||||
|
||||
startHandshakeClient :: MonadState TLSState m => Version -> ClientRandom -> m ()
|
||||
startHandshakeClient ver crand = do
|
||||
-- FIXME check if handshake is already not null
|
||||
let initCtx = if ver < TLS12 then hashMD5SHA1 else hashSHA256
|
||||
chs <- get >>= return . stHandshake
|
||||
when (isNothing chs) $
|
||||
modify (\st -> st { stHandshake = Just $ newEmptyHandshake ver crand initCtx })
|
||||
-- FIXME check if handshake is already not null
|
||||
let initCtx = if ver < TLS12 then hashMD5SHA1 else hashSHA256
|
||||
chs <- get >>= return . stHandshake
|
||||
when (isNothing chs) $
|
||||
modify (\st -> st { stHandshake = Just $ newEmptyHandshake ver crand initCtx })
|
||||
|
||||
hasValidHandshake :: MonadState TLSState m => String -> m ()
|
||||
hasValidHandshake name = get >>= \st -> assert name [ ("valid handshake", isNothing $ stHandshake st) ]
|
||||
|
||||
updateHandshake :: MonadState TLSState m => String -> (TLSHandshakeState -> TLSHandshakeState) -> m ()
|
||||
updateHandshake n f = do
|
||||
hasValidHandshake n
|
||||
modify (\st -> st { stHandshake = f <$> stHandshake st })
|
||||
hasValidHandshake n
|
||||
modify (\st -> st { stHandshake = f <$> stHandshake st })
|
||||
|
||||
addHandshakeMessage :: MonadState TLSState m => Bytes -> m ()
|
||||
addHandshakeMessage content = updateHandshake "add handshake message" $ \hs ->
|
||||
hs { hstHandshakeMessages = content : hstHandshakeMessages hs}
|
||||
hs { hstHandshakeMessages = content : hstHandshakeMessages hs}
|
||||
|
||||
getHandshakeMessages :: MonadState TLSState m => m [Bytes]
|
||||
getHandshakeMessages = do
|
||||
st <- get
|
||||
let hst = fromJust "handshake" $ stHandshake st
|
||||
return $ reverse $ hstHandshakeMessages hst
|
||||
st <- get
|
||||
let hst = fromJust "handshake" $ stHandshake st
|
||||
return $ reverse $ hstHandshakeMessages hst
|
||||
|
||||
updateHandshakeDigest :: MonadState TLSState m => Bytes -> m ()
|
||||
updateHandshakeDigest content = updateHandshake "update digest" $ \hs ->
|
||||
hs { hstHandshakeDigest = hashUpdate (hstHandshakeDigest hs) content }
|
||||
hs { hstHandshakeDigest = hashUpdate (hstHandshakeDigest hs) content }
|
||||
|
||||
getHandshakeDigest :: MonadState TLSState m => Bool -> m Bytes
|
||||
getHandshakeDigest client = do
|
||||
st <- get
|
||||
let hst = fromJust "handshake" $ stHandshake st
|
||||
let hashctx = hstHandshakeDigest hst
|
||||
let msecret = fromJust "master secret" $ hstMasterSecret hst
|
||||
return $ (if client then generateClientFinished else generateServerFinished) (stVersion $ stRecordState st) msecret hashctx
|
||||
st <- get
|
||||
let hst = fromJust "handshake" $ stHandshake st
|
||||
let hashctx = hstHandshakeDigest hst
|
||||
let msecret = fromJust "master secret" $ hstMasterSecret hst
|
||||
return $ (if client then generateClientFinished else generateServerFinished) (stVersion $ stRecordState st) msecret hashctx
|
||||
|
||||
endHandshake :: MonadState TLSState m => m ()
|
||||
endHandshake = modify (\st -> st { stHandshake = Nothing })
|
||||
|
|
|
|||
|
|
@ -10,44 +10,44 @@
|
|||
-- the Struct module contains all definitions and values of the TLS protocol
|
||||
--
|
||||
module Network.TLS.Struct
|
||||
( Bytes
|
||||
, Version(..)
|
||||
, ConnectionEnd(..)
|
||||
, CipherType(..)
|
||||
, CipherData(..)
|
||||
, ExtensionID
|
||||
, ExtensionRaw
|
||||
, CertificateType(..)
|
||||
, HashAlgorithm(..)
|
||||
, SignatureAlgorithm(..)
|
||||
, HashAndSignatureAlgorithm
|
||||
, ProtocolType(..)
|
||||
, TLSError(..)
|
||||
, DistinguishedName
|
||||
, ServerDHParams(..)
|
||||
, ServerRSAParams(..)
|
||||
, ServerKeyXchgAlgorithmData(..)
|
||||
, Packet(..)
|
||||
, Header(..)
|
||||
, ServerRandom(..)
|
||||
, ClientRandom(..)
|
||||
, serverRandom
|
||||
, clientRandom
|
||||
, FinishedData
|
||||
, SessionID
|
||||
, Session(..)
|
||||
, SessionData(..)
|
||||
, CertVerifyData(..)
|
||||
, AlertLevel(..)
|
||||
, AlertDescription(..)
|
||||
, HandshakeType(..)
|
||||
, Handshake(..)
|
||||
, numericalVer
|
||||
, verOfNum
|
||||
, TypeValuable, valOfType, valToType
|
||||
, packetType
|
||||
, typeOfHandshake
|
||||
) where
|
||||
( Bytes
|
||||
, Version(..)
|
||||
, ConnectionEnd(..)
|
||||
, CipherType(..)
|
||||
, CipherData(..)
|
||||
, ExtensionID
|
||||
, ExtensionRaw
|
||||
, CertificateType(..)
|
||||
, HashAlgorithm(..)
|
||||
, SignatureAlgorithm(..)
|
||||
, HashAndSignatureAlgorithm
|
||||
, ProtocolType(..)
|
||||
, TLSError(..)
|
||||
, DistinguishedName
|
||||
, ServerDHParams(..)
|
||||
, ServerRSAParams(..)
|
||||
, ServerKeyXchgAlgorithmData(..)
|
||||
, Packet(..)
|
||||
, Header(..)
|
||||
, ServerRandom(..)
|
||||
, ClientRandom(..)
|
||||
, serverRandom
|
||||
, clientRandom
|
||||
, FinishedData
|
||||
, SessionID
|
||||
, Session(..)
|
||||
, SessionData(..)
|
||||
, CertVerifyData(..)
|
||||
, AlertLevel(..)
|
||||
, AlertDescription(..)
|
||||
, HandshakeType(..)
|
||||
, Handshake(..)
|
||||
, numericalVer
|
||||
, verOfNum
|
||||
, TypeValuable, valOfType, valToType
|
||||
, packetType
|
||||
, typeOfHandshake
|
||||
) where
|
||||
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as B (length)
|
||||
|
|
@ -60,80 +60,79 @@ import Network.TLS.Types
|
|||
|
||||
type Bytes = ByteString
|
||||
|
||||
|
||||
data ConnectionEnd = ConnectionServer | ConnectionClient
|
||||
data CipherType = CipherStream | CipherBlock | CipherAEAD
|
||||
|
||||
data CipherData = CipherData
|
||||
{ cipherDataContent :: Bytes
|
||||
, cipherDataMAC :: Maybe Bytes
|
||||
, cipherDataPadding :: Maybe Bytes
|
||||
} deriving (Show,Eq)
|
||||
{ cipherDataContent :: Bytes
|
||||
, cipherDataMAC :: Maybe Bytes
|
||||
, cipherDataPadding :: Maybe Bytes
|
||||
} deriving (Show,Eq)
|
||||
|
||||
data CertificateType =
|
||||
CertificateType_RSA_Sign -- TLS10
|
||||
| CertificateType_DSS_Sign -- TLS10
|
||||
| CertificateType_RSA_Fixed_DH -- TLS10
|
||||
| CertificateType_DSS_Fixed_DH -- TLS10
|
||||
| CertificateType_RSA_Ephemeral_DH -- TLS12
|
||||
| CertificateType_DSS_Ephemeral_DH -- TLS12
|
||||
| CertificateType_fortezza_dms -- TLS12
|
||||
| CertificateType_Unknown Word8
|
||||
deriving (Show,Eq)
|
||||
CertificateType_RSA_Sign -- TLS10
|
||||
| CertificateType_DSS_Sign -- TLS10
|
||||
| CertificateType_RSA_Fixed_DH -- TLS10
|
||||
| CertificateType_DSS_Fixed_DH -- TLS10
|
||||
| CertificateType_RSA_Ephemeral_DH -- TLS12
|
||||
| CertificateType_DSS_Ephemeral_DH -- TLS12
|
||||
| CertificateType_fortezza_dms -- TLS12
|
||||
| CertificateType_Unknown Word8
|
||||
deriving (Show,Eq)
|
||||
|
||||
data HashAlgorithm =
|
||||
HashNone
|
||||
| HashMD5
|
||||
| HashSHA1
|
||||
| HashSHA224
|
||||
| HashSHA256
|
||||
| HashSHA384
|
||||
| HashSHA512
|
||||
| HashOther Word8
|
||||
deriving (Show,Eq)
|
||||
HashNone
|
||||
| HashMD5
|
||||
| HashSHA1
|
||||
| HashSHA224
|
||||
| HashSHA256
|
||||
| HashSHA384
|
||||
| HashSHA512
|
||||
| HashOther Word8
|
||||
deriving (Show,Eq)
|
||||
|
||||
data SignatureAlgorithm =
|
||||
SignatureAnonymous
|
||||
| SignatureRSA
|
||||
| SignatureDSS
|
||||
| SignatureECDSA
|
||||
| SignatureOther Word8
|
||||
deriving (Show,Eq)
|
||||
SignatureAnonymous
|
||||
| SignatureRSA
|
||||
| SignatureDSS
|
||||
| SignatureECDSA
|
||||
| SignatureOther Word8
|
||||
deriving (Show,Eq)
|
||||
|
||||
type HashAndSignatureAlgorithm = (HashAlgorithm, SignatureAlgorithm)
|
||||
|
||||
data ProtocolType =
|
||||
ProtocolType_ChangeCipherSpec
|
||||
| ProtocolType_Alert
|
||||
| ProtocolType_Handshake
|
||||
| ProtocolType_AppData
|
||||
| ProtocolType_DeprecatedHandshake
|
||||
deriving (Eq, Show)
|
||||
ProtocolType_ChangeCipherSpec
|
||||
| ProtocolType_Alert
|
||||
| ProtocolType_Handshake
|
||||
| ProtocolType_AppData
|
||||
| ProtocolType_DeprecatedHandshake
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | TLSError that might be returned through the TLS stack
|
||||
data TLSError =
|
||||
Error_Misc String -- ^ mainly for instance of Error
|
||||
| Error_Protocol (String, Bool, AlertDescription)
|
||||
| Error_Certificate String
|
||||
| Error_HandshakePolicy String -- ^ handshake policy failed.
|
||||
| Error_EOF
|
||||
| Error_Packet String
|
||||
| Error_Packet_unexpected String String
|
||||
| Error_Packet_Parsing String
|
||||
deriving (Eq, Show, Typeable)
|
||||
Error_Misc String -- ^ mainly for instance of Error
|
||||
| Error_Protocol (String, Bool, AlertDescription)
|
||||
| Error_Certificate String
|
||||
| Error_HandshakePolicy String -- ^ handshake policy failed.
|
||||
| Error_EOF
|
||||
| Error_Packet String
|
||||
| Error_Packet_unexpected String String
|
||||
| Error_Packet_Parsing String
|
||||
deriving (Eq, Show, Typeable)
|
||||
|
||||
instance Error TLSError where
|
||||
noMsg = Error_Misc ""
|
||||
strMsg = Error_Misc
|
||||
noMsg = Error_Misc ""
|
||||
strMsg = Error_Misc
|
||||
|
||||
instance Exception TLSError
|
||||
|
||||
data Packet =
|
||||
Handshake [Handshake]
|
||||
| Alert [(AlertLevel, AlertDescription)]
|
||||
| ChangeCipherSpec
|
||||
| AppData ByteString
|
||||
deriving (Show,Eq)
|
||||
Handshake [Handshake]
|
||||
| Alert [(AlertLevel, AlertDescription)]
|
||||
| ChangeCipherSpec
|
||||
| AppData ByteString
|
||||
deriving (Show,Eq)
|
||||
|
||||
data Header = Header ProtocolType Version Word16 deriving (Show,Eq)
|
||||
|
||||
|
|
@ -146,7 +145,7 @@ type ExtensionID = Word16
|
|||
type ExtensionRaw = (ExtensionID, Bytes)
|
||||
|
||||
newtype CertVerifyData = CertVerifyData Bytes
|
||||
deriving (Show, Eq)
|
||||
deriving (Show, Eq)
|
||||
|
||||
constrRandom32 :: (Bytes -> a) -> Bytes -> Maybe a
|
||||
constrRandom32 constr l = if B.length l == 32 then Just (constr l) else Nothing
|
||||
|
|
@ -158,91 +157,91 @@ clientRandom :: Bytes -> Maybe ClientRandom
|
|||
clientRandom l = constrRandom32 ClientRandom l
|
||||
|
||||
data AlertLevel =
|
||||
AlertLevel_Warning
|
||||
| AlertLevel_Fatal
|
||||
deriving (Show,Eq)
|
||||
AlertLevel_Warning
|
||||
| AlertLevel_Fatal
|
||||
deriving (Show,Eq)
|
||||
|
||||
data AlertDescription =
|
||||
CloseNotify
|
||||
| UnexpectedMessage
|
||||
| BadRecordMac
|
||||
| DecryptionFailed -- ^ deprecated alert, should never be sent by compliant implementation
|
||||
| RecordOverflow
|
||||
| DecompressionFailure
|
||||
| HandshakeFailure
|
||||
| BadCertificate
|
||||
| UnsupportedCertificate
|
||||
| CertificateRevoked
|
||||
| CertificateExpired
|
||||
| CertificateUnknown
|
||||
| IllegalParameter
|
||||
| UnknownCa
|
||||
| AccessDenied
|
||||
| DecodeError
|
||||
| DecryptError
|
||||
| ExportRestriction
|
||||
| ProtocolVersion
|
||||
| InsufficientSecurity
|
||||
| InternalError
|
||||
| UserCanceled
|
||||
| NoRenegotiation
|
||||
| UnsupportedExtension
|
||||
| CertificateUnobtainable
|
||||
| UnrecognizedName
|
||||
| BadCertificateStatusResponse
|
||||
| BadCertificateHashValue
|
||||
deriving (Show,Eq)
|
||||
CloseNotify
|
||||
| UnexpectedMessage
|
||||
| BadRecordMac
|
||||
| DecryptionFailed -- ^ deprecated alert, should never be sent by compliant implementation
|
||||
| RecordOverflow
|
||||
| DecompressionFailure
|
||||
| HandshakeFailure
|
||||
| BadCertificate
|
||||
| UnsupportedCertificate
|
||||
| CertificateRevoked
|
||||
| CertificateExpired
|
||||
| CertificateUnknown
|
||||
| IllegalParameter
|
||||
| UnknownCa
|
||||
| AccessDenied
|
||||
| DecodeError
|
||||
| DecryptError
|
||||
| ExportRestriction
|
||||
| ProtocolVersion
|
||||
| InsufficientSecurity
|
||||
| InternalError
|
||||
| UserCanceled
|
||||
| NoRenegotiation
|
||||
| UnsupportedExtension
|
||||
| CertificateUnobtainable
|
||||
| UnrecognizedName
|
||||
| BadCertificateStatusResponse
|
||||
| BadCertificateHashValue
|
||||
deriving (Show,Eq)
|
||||
|
||||
data HandshakeType =
|
||||
HandshakeType_HelloRequest
|
||||
| HandshakeType_ClientHello
|
||||
| HandshakeType_ServerHello
|
||||
| HandshakeType_Certificate
|
||||
| HandshakeType_ServerKeyXchg
|
||||
| HandshakeType_CertRequest
|
||||
| HandshakeType_ServerHelloDone
|
||||
| HandshakeType_CertVerify
|
||||
| HandshakeType_ClientKeyXchg
|
||||
| HandshakeType_Finished
|
||||
| HandshakeType_NPN -- Next Protocol Negotiation extension
|
||||
deriving (Show,Eq)
|
||||
HandshakeType_HelloRequest
|
||||
| HandshakeType_ClientHello
|
||||
| HandshakeType_ServerHello
|
||||
| HandshakeType_Certificate
|
||||
| HandshakeType_ServerKeyXchg
|
||||
| HandshakeType_CertRequest
|
||||
| HandshakeType_ServerHelloDone
|
||||
| HandshakeType_CertVerify
|
||||
| HandshakeType_ClientKeyXchg
|
||||
| HandshakeType_Finished
|
||||
| HandshakeType_NPN -- Next Protocol Negotiation extension
|
||||
deriving (Show,Eq)
|
||||
|
||||
data ServerDHParams = ServerDHParams
|
||||
{ dh_p :: Integer -- ^ prime modulus
|
||||
, dh_g :: Integer -- ^ generator
|
||||
, dh_Ys :: Integer -- ^ public value (g^X mod p)
|
||||
} deriving (Show,Eq)
|
||||
{ dh_p :: Integer -- ^ prime modulus
|
||||
, dh_g :: Integer -- ^ generator
|
||||
, dh_Ys :: Integer -- ^ public value (g^X mod p)
|
||||
} deriving (Show,Eq)
|
||||
|
||||
data ServerRSAParams = ServerRSAParams
|
||||
{ rsa_modulus :: Integer
|
||||
, rsa_exponent :: Integer
|
||||
} deriving (Show,Eq)
|
||||
{ rsa_modulus :: Integer
|
||||
, rsa_exponent :: Integer
|
||||
} deriving (Show,Eq)
|
||||
|
||||
data ServerKeyXchgAlgorithmData =
|
||||
SKX_DH_Anon ServerDHParams
|
||||
| SKX_DHE_DSS ServerDHParams [Word8]
|
||||
| SKX_DHE_RSA ServerDHParams [Word8]
|
||||
| SKX_RSA (Maybe ServerRSAParams)
|
||||
| SKX_DH_DSS (Maybe ServerRSAParams)
|
||||
| SKX_DH_RSA (Maybe ServerRSAParams)
|
||||
| SKX_Unknown Bytes
|
||||
deriving (Show,Eq)
|
||||
SKX_DH_Anon ServerDHParams
|
||||
| SKX_DHE_DSS ServerDHParams [Word8]
|
||||
| SKX_DHE_RSA ServerDHParams [Word8]
|
||||
| SKX_RSA (Maybe ServerRSAParams)
|
||||
| SKX_DH_DSS (Maybe ServerRSAParams)
|
||||
| SKX_DH_RSA (Maybe ServerRSAParams)
|
||||
| SKX_Unknown Bytes
|
||||
deriving (Show,Eq)
|
||||
|
||||
type DeprecatedRecord = ByteString
|
||||
|
||||
data Handshake =
|
||||
ClientHello !Version !ClientRandom !Session ![CipherID] ![CompressionID] [ExtensionRaw] (Maybe DeprecatedRecord)
|
||||
| ServerHello !Version !ServerRandom !Session !CipherID !CompressionID [ExtensionRaw]
|
||||
| Certificates CertificateChain
|
||||
| HelloRequest
|
||||
| ServerHelloDone
|
||||
| ClientKeyXchg Bytes
|
||||
| ServerKeyXchg ServerKeyXchgAlgorithmData
|
||||
| CertRequest [CertificateType] (Maybe [ HashAndSignatureAlgorithm ]) [DistinguishedName]
|
||||
| CertVerify (Maybe HashAndSignatureAlgorithm) CertVerifyData
|
||||
| Finished FinishedData
|
||||
| HsNextProtocolNegotiation Bytes -- NPN extension
|
||||
deriving (Show,Eq)
|
||||
ClientHello !Version !ClientRandom !Session ![CipherID] ![CompressionID] [ExtensionRaw] (Maybe DeprecatedRecord)
|
||||
| ServerHello !Version !ServerRandom !Session !CipherID !CompressionID [ExtensionRaw]
|
||||
| Certificates CertificateChain
|
||||
| HelloRequest
|
||||
| ServerHelloDone
|
||||
| ClientKeyXchg Bytes
|
||||
| ServerKeyXchg ServerKeyXchgAlgorithmData
|
||||
| CertRequest [CertificateType] (Maybe [ HashAndSignatureAlgorithm ]) [DistinguishedName]
|
||||
| CertVerify (Maybe HashAndSignatureAlgorithm) CertVerifyData
|
||||
| Finished FinishedData
|
||||
| HsNextProtocolNegotiation Bytes -- NPN extension
|
||||
deriving (Show,Eq)
|
||||
|
||||
packetType :: Packet -> ProtocolType
|
||||
packetType (Handshake _) = ProtocolType_Handshake
|
||||
|
|
@ -279,181 +278,181 @@ verOfNum (3, 3) = Just TLS12
|
|||
verOfNum _ = Nothing
|
||||
|
||||
class TypeValuable a where
|
||||
valOfType :: a -> Word8
|
||||
valToType :: Word8 -> Maybe a
|
||||
valOfType :: a -> Word8
|
||||
valToType :: Word8 -> Maybe a
|
||||
|
||||
instance TypeValuable ConnectionEnd where
|
||||
valOfType ConnectionServer = 0
|
||||
valOfType ConnectionClient = 1
|
||||
valOfType ConnectionServer = 0
|
||||
valOfType ConnectionClient = 1
|
||||
|
||||
valToType 0 = Just ConnectionServer
|
||||
valToType 1 = Just ConnectionClient
|
||||
valToType _ = Nothing
|
||||
valToType 0 = Just ConnectionServer
|
||||
valToType 1 = Just ConnectionClient
|
||||
valToType _ = Nothing
|
||||
|
||||
instance TypeValuable CipherType where
|
||||
valOfType CipherStream = 0
|
||||
valOfType CipherBlock = 1
|
||||
valOfType CipherAEAD = 2
|
||||
valOfType CipherStream = 0
|
||||
valOfType CipherBlock = 1
|
||||
valOfType CipherAEAD = 2
|
||||
|
||||
valToType 0 = Just CipherStream
|
||||
valToType 1 = Just CipherBlock
|
||||
valToType 2 = Just CipherAEAD
|
||||
valToType _ = Nothing
|
||||
valToType 0 = Just CipherStream
|
||||
valToType 1 = Just CipherBlock
|
||||
valToType 2 = Just CipherAEAD
|
||||
valToType _ = Nothing
|
||||
|
||||
instance TypeValuable ProtocolType where
|
||||
valOfType ProtocolType_ChangeCipherSpec = 20
|
||||
valOfType ProtocolType_Alert = 21
|
||||
valOfType ProtocolType_Handshake = 22
|
||||
valOfType ProtocolType_AppData = 23
|
||||
valOfType ProtocolType_DeprecatedHandshake = 128 -- unused
|
||||
valOfType ProtocolType_ChangeCipherSpec = 20
|
||||
valOfType ProtocolType_Alert = 21
|
||||
valOfType ProtocolType_Handshake = 22
|
||||
valOfType ProtocolType_AppData = 23
|
||||
valOfType ProtocolType_DeprecatedHandshake = 128 -- unused
|
||||
|
||||
valToType 20 = Just ProtocolType_ChangeCipherSpec
|
||||
valToType 21 = Just ProtocolType_Alert
|
||||
valToType 22 = Just ProtocolType_Handshake
|
||||
valToType 23 = Just ProtocolType_AppData
|
||||
valToType _ = Nothing
|
||||
valToType 20 = Just ProtocolType_ChangeCipherSpec
|
||||
valToType 21 = Just ProtocolType_Alert
|
||||
valToType 22 = Just ProtocolType_Handshake
|
||||
valToType 23 = Just ProtocolType_AppData
|
||||
valToType _ = Nothing
|
||||
|
||||
instance TypeValuable HandshakeType where
|
||||
valOfType HandshakeType_HelloRequest = 0
|
||||
valOfType HandshakeType_ClientHello = 1
|
||||
valOfType HandshakeType_ServerHello = 2
|
||||
valOfType HandshakeType_Certificate = 11
|
||||
valOfType HandshakeType_ServerKeyXchg = 12
|
||||
valOfType HandshakeType_CertRequest = 13
|
||||
valOfType HandshakeType_ServerHelloDone = 14
|
||||
valOfType HandshakeType_CertVerify = 15
|
||||
valOfType HandshakeType_ClientKeyXchg = 16
|
||||
valOfType HandshakeType_Finished = 20
|
||||
valOfType HandshakeType_NPN = 67
|
||||
valOfType HandshakeType_HelloRequest = 0
|
||||
valOfType HandshakeType_ClientHello = 1
|
||||
valOfType HandshakeType_ServerHello = 2
|
||||
valOfType HandshakeType_Certificate = 11
|
||||
valOfType HandshakeType_ServerKeyXchg = 12
|
||||
valOfType HandshakeType_CertRequest = 13
|
||||
valOfType HandshakeType_ServerHelloDone = 14
|
||||
valOfType HandshakeType_CertVerify = 15
|
||||
valOfType HandshakeType_ClientKeyXchg = 16
|
||||
valOfType HandshakeType_Finished = 20
|
||||
valOfType HandshakeType_NPN = 67
|
||||
|
||||
valToType 0 = Just HandshakeType_HelloRequest
|
||||
valToType 1 = Just HandshakeType_ClientHello
|
||||
valToType 2 = Just HandshakeType_ServerHello
|
||||
valToType 11 = Just HandshakeType_Certificate
|
||||
valToType 12 = Just HandshakeType_ServerKeyXchg
|
||||
valToType 13 = Just HandshakeType_CertRequest
|
||||
valToType 14 = Just HandshakeType_ServerHelloDone
|
||||
valToType 15 = Just HandshakeType_CertVerify
|
||||
valToType 16 = Just HandshakeType_ClientKeyXchg
|
||||
valToType 20 = Just HandshakeType_Finished
|
||||
valToType 67 = Just HandshakeType_NPN
|
||||
valToType _ = Nothing
|
||||
valToType 0 = Just HandshakeType_HelloRequest
|
||||
valToType 1 = Just HandshakeType_ClientHello
|
||||
valToType 2 = Just HandshakeType_ServerHello
|
||||
valToType 11 = Just HandshakeType_Certificate
|
||||
valToType 12 = Just HandshakeType_ServerKeyXchg
|
||||
valToType 13 = Just HandshakeType_CertRequest
|
||||
valToType 14 = Just HandshakeType_ServerHelloDone
|
||||
valToType 15 = Just HandshakeType_CertVerify
|
||||
valToType 16 = Just HandshakeType_ClientKeyXchg
|
||||
valToType 20 = Just HandshakeType_Finished
|
||||
valToType 67 = Just HandshakeType_NPN
|
||||
valToType _ = Nothing
|
||||
|
||||
instance TypeValuable AlertLevel where
|
||||
valOfType AlertLevel_Warning = 1
|
||||
valOfType AlertLevel_Fatal = 2
|
||||
valOfType AlertLevel_Warning = 1
|
||||
valOfType AlertLevel_Fatal = 2
|
||||
|
||||
valToType 1 = Just AlertLevel_Warning
|
||||
valToType 2 = Just AlertLevel_Fatal
|
||||
valToType _ = Nothing
|
||||
valToType 1 = Just AlertLevel_Warning
|
||||
valToType 2 = Just AlertLevel_Fatal
|
||||
valToType _ = Nothing
|
||||
|
||||
instance TypeValuable AlertDescription where
|
||||
valOfType CloseNotify = 0
|
||||
valOfType UnexpectedMessage = 10
|
||||
valOfType BadRecordMac = 20
|
||||
valOfType DecryptionFailed = 21
|
||||
valOfType RecordOverflow = 22
|
||||
valOfType DecompressionFailure = 30
|
||||
valOfType HandshakeFailure = 40
|
||||
valOfType BadCertificate = 42
|
||||
valOfType UnsupportedCertificate = 43
|
||||
valOfType CertificateRevoked = 44
|
||||
valOfType CertificateExpired = 45
|
||||
valOfType CertificateUnknown = 46
|
||||
valOfType IllegalParameter = 47
|
||||
valOfType UnknownCa = 48
|
||||
valOfType AccessDenied = 49
|
||||
valOfType DecodeError = 50
|
||||
valOfType DecryptError = 51
|
||||
valOfType ExportRestriction = 60
|
||||
valOfType ProtocolVersion = 70
|
||||
valOfType InsufficientSecurity = 71
|
||||
valOfType InternalError = 80
|
||||
valOfType UserCanceled = 90
|
||||
valOfType NoRenegotiation = 100
|
||||
valOfType UnsupportedExtension = 110
|
||||
valOfType CertificateUnobtainable = 111
|
||||
valOfType UnrecognizedName = 112
|
||||
valOfType BadCertificateStatusResponse = 113
|
||||
valOfType BadCertificateHashValue = 114
|
||||
valOfType CloseNotify = 0
|
||||
valOfType UnexpectedMessage = 10
|
||||
valOfType BadRecordMac = 20
|
||||
valOfType DecryptionFailed = 21
|
||||
valOfType RecordOverflow = 22
|
||||
valOfType DecompressionFailure = 30
|
||||
valOfType HandshakeFailure = 40
|
||||
valOfType BadCertificate = 42
|
||||
valOfType UnsupportedCertificate = 43
|
||||
valOfType CertificateRevoked = 44
|
||||
valOfType CertificateExpired = 45
|
||||
valOfType CertificateUnknown = 46
|
||||
valOfType IllegalParameter = 47
|
||||
valOfType UnknownCa = 48
|
||||
valOfType AccessDenied = 49
|
||||
valOfType DecodeError = 50
|
||||
valOfType DecryptError = 51
|
||||
valOfType ExportRestriction = 60
|
||||
valOfType ProtocolVersion = 70
|
||||
valOfType InsufficientSecurity = 71
|
||||
valOfType InternalError = 80
|
||||
valOfType UserCanceled = 90
|
||||
valOfType NoRenegotiation = 100
|
||||
valOfType UnsupportedExtension = 110
|
||||
valOfType CertificateUnobtainable = 111
|
||||
valOfType UnrecognizedName = 112
|
||||
valOfType BadCertificateStatusResponse = 113
|
||||
valOfType BadCertificateHashValue = 114
|
||||
|
||||
valToType 0 = Just CloseNotify
|
||||
valToType 10 = Just UnexpectedMessage
|
||||
valToType 20 = Just BadRecordMac
|
||||
valToType 21 = Just DecryptionFailed
|
||||
valToType 22 = Just RecordOverflow
|
||||
valToType 30 = Just DecompressionFailure
|
||||
valToType 40 = Just HandshakeFailure
|
||||
valToType 42 = Just BadCertificate
|
||||
valToType 43 = Just UnsupportedCertificate
|
||||
valToType 44 = Just CertificateRevoked
|
||||
valToType 45 = Just CertificateExpired
|
||||
valToType 46 = Just CertificateUnknown
|
||||
valToType 47 = Just IllegalParameter
|
||||
valToType 48 = Just UnknownCa
|
||||
valToType 49 = Just AccessDenied
|
||||
valToType 50 = Just DecodeError
|
||||
valToType 51 = Just DecryptError
|
||||
valToType 60 = Just ExportRestriction
|
||||
valToType 70 = Just ProtocolVersion
|
||||
valToType 71 = Just InsufficientSecurity
|
||||
valToType 80 = Just InternalError
|
||||
valToType 90 = Just UserCanceled
|
||||
valToType 100 = Just NoRenegotiation
|
||||
valToType 110 = Just UnsupportedExtension
|
||||
valToType 111 = Just CertificateUnobtainable
|
||||
valToType 112 = Just UnrecognizedName
|
||||
valToType 113 = Just BadCertificateStatusResponse
|
||||
valToType 114 = Just BadCertificateHashValue
|
||||
valToType _ = Nothing
|
||||
valToType 0 = Just CloseNotify
|
||||
valToType 10 = Just UnexpectedMessage
|
||||
valToType 20 = Just BadRecordMac
|
||||
valToType 21 = Just DecryptionFailed
|
||||
valToType 22 = Just RecordOverflow
|
||||
valToType 30 = Just DecompressionFailure
|
||||
valToType 40 = Just HandshakeFailure
|
||||
valToType 42 = Just BadCertificate
|
||||
valToType 43 = Just UnsupportedCertificate
|
||||
valToType 44 = Just CertificateRevoked
|
||||
valToType 45 = Just CertificateExpired
|
||||
valToType 46 = Just CertificateUnknown
|
||||
valToType 47 = Just IllegalParameter
|
||||
valToType 48 = Just UnknownCa
|
||||
valToType 49 = Just AccessDenied
|
||||
valToType 50 = Just DecodeError
|
||||
valToType 51 = Just DecryptError
|
||||
valToType 60 = Just ExportRestriction
|
||||
valToType 70 = Just ProtocolVersion
|
||||
valToType 71 = Just InsufficientSecurity
|
||||
valToType 80 = Just InternalError
|
||||
valToType 90 = Just UserCanceled
|
||||
valToType 100 = Just NoRenegotiation
|
||||
valToType 110 = Just UnsupportedExtension
|
||||
valToType 111 = Just CertificateUnobtainable
|
||||
valToType 112 = Just UnrecognizedName
|
||||
valToType 113 = Just BadCertificateStatusResponse
|
||||
valToType 114 = Just BadCertificateHashValue
|
||||
valToType _ = Nothing
|
||||
|
||||
instance TypeValuable CertificateType where
|
||||
valOfType CertificateType_RSA_Sign = 1
|
||||
valOfType CertificateType_DSS_Sign = 2
|
||||
valOfType CertificateType_RSA_Fixed_DH = 3
|
||||
valOfType CertificateType_DSS_Fixed_DH = 4
|
||||
valOfType CertificateType_RSA_Ephemeral_DH = 5
|
||||
valOfType CertificateType_DSS_Ephemeral_DH = 6
|
||||
valOfType CertificateType_fortezza_dms = 20
|
||||
valOfType (CertificateType_Unknown i) = i
|
||||
valOfType CertificateType_RSA_Sign = 1
|
||||
valOfType CertificateType_DSS_Sign = 2
|
||||
valOfType CertificateType_RSA_Fixed_DH = 3
|
||||
valOfType CertificateType_DSS_Fixed_DH = 4
|
||||
valOfType CertificateType_RSA_Ephemeral_DH = 5
|
||||
valOfType CertificateType_DSS_Ephemeral_DH = 6
|
||||
valOfType CertificateType_fortezza_dms = 20
|
||||
valOfType (CertificateType_Unknown i) = i
|
||||
|
||||
valToType 1 = Just CertificateType_RSA_Sign
|
||||
valToType 2 = Just CertificateType_DSS_Sign
|
||||
valToType 3 = Just CertificateType_RSA_Fixed_DH
|
||||
valToType 4 = Just CertificateType_DSS_Fixed_DH
|
||||
valToType 5 = Just CertificateType_RSA_Ephemeral_DH
|
||||
valToType 6 = Just CertificateType_DSS_Ephemeral_DH
|
||||
valToType 20 = Just CertificateType_fortezza_dms
|
||||
valToType i = Just (CertificateType_Unknown i)
|
||||
valToType 1 = Just CertificateType_RSA_Sign
|
||||
valToType 2 = Just CertificateType_DSS_Sign
|
||||
valToType 3 = Just CertificateType_RSA_Fixed_DH
|
||||
valToType 4 = Just CertificateType_DSS_Fixed_DH
|
||||
valToType 5 = Just CertificateType_RSA_Ephemeral_DH
|
||||
valToType 6 = Just CertificateType_DSS_Ephemeral_DH
|
||||
valToType 20 = Just CertificateType_fortezza_dms
|
||||
valToType i = Just (CertificateType_Unknown i)
|
||||
|
||||
instance TypeValuable HashAlgorithm where
|
||||
valOfType HashNone = 0
|
||||
valOfType HashMD5 = 1
|
||||
valOfType HashSHA1 = 2
|
||||
valOfType HashSHA224 = 3
|
||||
valOfType HashSHA256 = 4
|
||||
valOfType HashSHA384 = 5
|
||||
valOfType HashSHA512 = 6
|
||||
valOfType (HashOther i) = i
|
||||
valOfType HashNone = 0
|
||||
valOfType HashMD5 = 1
|
||||
valOfType HashSHA1 = 2
|
||||
valOfType HashSHA224 = 3
|
||||
valOfType HashSHA256 = 4
|
||||
valOfType HashSHA384 = 5
|
||||
valOfType HashSHA512 = 6
|
||||
valOfType (HashOther i) = i
|
||||
|
||||
valToType 0 = Just HashNone
|
||||
valToType 1 = Just HashMD5
|
||||
valToType 2 = Just HashSHA1
|
||||
valToType 3 = Just HashSHA224
|
||||
valToType 4 = Just HashSHA256
|
||||
valToType 5 = Just HashSHA384
|
||||
valToType 6 = Just HashSHA512
|
||||
valToType i = Just (HashOther i)
|
||||
valToType 0 = Just HashNone
|
||||
valToType 1 = Just HashMD5
|
||||
valToType 2 = Just HashSHA1
|
||||
valToType 3 = Just HashSHA224
|
||||
valToType 4 = Just HashSHA256
|
||||
valToType 5 = Just HashSHA384
|
||||
valToType 6 = Just HashSHA512
|
||||
valToType i = Just (HashOther i)
|
||||
|
||||
instance TypeValuable SignatureAlgorithm where
|
||||
valOfType SignatureAnonymous = 0
|
||||
valOfType SignatureRSA = 1
|
||||
valOfType SignatureDSS = 2
|
||||
valOfType SignatureECDSA = 3
|
||||
valOfType (SignatureOther i) = i
|
||||
valOfType SignatureAnonymous = 0
|
||||
valOfType SignatureRSA = 1
|
||||
valOfType SignatureDSS = 2
|
||||
valOfType SignatureECDSA = 3
|
||||
valOfType (SignatureOther i) = i
|
||||
|
||||
valToType 0 = Just SignatureAnonymous
|
||||
valToType 1 = Just SignatureRSA
|
||||
valToType 2 = Just SignatureDSS
|
||||
valToType 3 = Just SignatureECDSA
|
||||
valToType i = Just (SignatureOther i)
|
||||
valToType 0 = Just SignatureAnonymous
|
||||
valToType 1 = Just SignatureRSA
|
||||
valToType 2 = Just SignatureDSS
|
||||
valToType 3 = Just SignatureECDSA
|
||||
valToType i = Just (SignatureOther i)
|
||||
|
|
|
|||
|
|
@ -26,10 +26,10 @@ type SessionID = ByteString
|
|||
|
||||
-- | Session data to resume
|
||||
data SessionData = SessionData
|
||||
{ sessionVersion :: Version
|
||||
, sessionCipher :: CipherID
|
||||
, sessionSecret :: ByteString
|
||||
}
|
||||
{ sessionVersion :: Version
|
||||
, sessionCipher :: CipherID
|
||||
, sessionSecret :: ByteString
|
||||
}
|
||||
|
||||
-- | Cipher identification
|
||||
type CipherID = Word16
|
||||
|
|
|
|||
|
|
@ -9,37 +9,37 @@
|
|||
-- all multibytes values are written as big endian.
|
||||
--
|
||||
module Network.TLS.Wire
|
||||
( Get
|
||||
, runGet
|
||||
, runGetErr
|
||||
, runGetMaybe
|
||||
, remaining
|
||||
, getWord8
|
||||
, getWords8
|
||||
, getWord16
|
||||
, getWords16
|
||||
, getWord24
|
||||
, getBytes
|
||||
, getOpaque8
|
||||
, getOpaque16
|
||||
, getOpaque24
|
||||
, getList
|
||||
, processBytes
|
||||
, isEmpty
|
||||
, Put
|
||||
, runPut
|
||||
, putWord8
|
||||
, putWords8
|
||||
, putWord16
|
||||
, putWords16
|
||||
, putWord24
|
||||
, putBytes
|
||||
, putOpaque8
|
||||
, putOpaque16
|
||||
, putOpaque24
|
||||
, encodeWord16
|
||||
, encodeWord64
|
||||
) where
|
||||
( Get
|
||||
, runGet
|
||||
, runGetErr
|
||||
, runGetMaybe
|
||||
, remaining
|
||||
, getWord8
|
||||
, getWords8
|
||||
, getWord16
|
||||
, getWords16
|
||||
, getWord24
|
||||
, getBytes
|
||||
, getOpaque8
|
||||
, getOpaque16
|
||||
, getOpaque24
|
||||
, getList
|
||||
, processBytes
|
||||
, isEmpty
|
||||
, Put
|
||||
, runPut
|
||||
, putWord8
|
||||
, putWords8
|
||||
, putWord16
|
||||
, putWords16
|
||||
, putWord24
|
||||
, putBytes
|
||||
, putOpaque8
|
||||
, putOpaque16
|
||||
, putOpaque24
|
||||
, encodeWord16
|
||||
, encodeWord64
|
||||
) where
|
||||
|
||||
import Data.Serialize.Get hiding (runGet)
|
||||
import qualified Data.Serialize.Get as G
|
||||
|
|
@ -71,10 +71,10 @@ getWords16 = getWord16 >>= \lenb -> replicateM (fromIntegral lenb `div` 2) getWo
|
|||
|
||||
getWord24 :: Get Int
|
||||
getWord24 = do
|
||||
a <- fromIntegral <$> getWord8
|
||||
b <- fromIntegral <$> getWord8
|
||||
c <- fromIntegral <$> getWord8
|
||||
return $ (a `shiftL` 16) .|. (b `shiftL` 8) .|. c
|
||||
a <- fromIntegral <$> getWord8
|
||||
b <- fromIntegral <$> getWord8
|
||||
c <- fromIntegral <$> getWord8
|
||||
return $ (a `shiftL` 16) .|. (b `shiftL` 8) .|. c
|
||||
|
||||
getOpaque8 :: Get Bytes
|
||||
getOpaque8 = getWord8 >>= getBytes . fromIntegral
|
||||
|
|
@ -87,7 +87,7 @@ getOpaque24 = getWord24 >>= getBytes
|
|||
|
||||
getList :: Int -> (Get (Int, a)) -> Get [a]
|
||||
getList totalLen getElement = isolate totalLen (getElements totalLen)
|
||||
where getElements len
|
||||
where getElements len
|
||||
| len < 0 = error "list consumed too much data. should never happen with isolate."
|
||||
| len == 0 = return []
|
||||
| otherwise = getElement >>= \(elementLen, a) -> liftM ((:) a) (getElements (len - elementLen))
|
||||
|
|
@ -97,23 +97,23 @@ processBytes i f = isolate i f
|
|||
|
||||
putWords8 :: [Word8] -> Put
|
||||
putWords8 l = do
|
||||
putWord8 $ fromIntegral (length l)
|
||||
mapM_ putWord8 l
|
||||
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
|
||||
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]
|
||||
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue