diff --git a/peyotls-codec.cabal b/peyotls-codec.cabal --- a/peyotls-codec.cabal +++ b/peyotls-codec.cabal @@ -2,7 +2,7 @@ cabal-version: >= 1.8 name: peyotls-codec -version: 0.1.0.0 +version: 0.2.0.0 stability: Experimental author: Yoshikuni Jujo maintainer: Yoshikuni Jujo @@ -22,14 +22,14 @@ source-repository this type: git location: git://github.com/YoshikuniJujo/peyotls.git - tag: peyotls-0.1.6.7 + tag: peyotls-0.1.6.8 library hs-source-dirs: src exposed-modules: - Network.PeyoTLS.Codec, - Network.PeyoTLS.Codec.ContentTypes + Network.PeyoTLS.Codec other-modules: + Network.PeyoTLS.Codec.ContentTypes Network.PeyoTLS.Codec.Hello, Network.PeyoTLS.Codec.Extension, Network.PeyoTLS.Codec.Certificate Network.PeyoTLS.Codec.HSAlg diff --git a/src/Network/PeyoTLS/Codec.hs b/src/Network/PeyoTLS/Codec.hs --- a/src/Network/PeyoTLS/Codec.hs +++ b/src/Network/PeyoTLS/Codec.hs @@ -1,15 +1,25 @@ {-# LANGUAGE OverloadedStrings #-} module Network.PeyoTLS.Codec ( - Handshake(..), HandshakeItem(..), + -- * Fragment + ContType(..), PrtVrsn(..), + -- * Cipher Suite, Compression Method, Signature Algorithm + CipherSuite(..), KeyEx(..), BulkEnc(..), CmpMtd(..), + HSAlg(..), SignAlg(..), HashAlg(..), + -- * Handshake + Handshake(HCCSpec, HHelloReq), HandshakeItem(..), + CCSpec(..), + -- ** Hello ClHello(..), SvHello(..), SssnId(..), - CipherSuite(..), KeyEx(..), BulkEnc(..), - CmpMtd(..), Extension(..), isRnInfo, emptyRnInfo, + Extension(..), isRnInfo, emptyRnInfo, + -- ** Server Key Exchange SvKeyEx(..), SvKeyExDhe(..), SvKeyExEcdhe(..), - CertReq(..), certReq, ClCertType(..), SignAlg(..), HashAlg(..), + -- ** Others + CertReq(..), certReq, ClCertType(..), SHDone(..), ClKeyEx(..), Epms(..), - DigitSigned(..), Finished(..), - CCSpec(..), ) where + DigitSigned(..), + Finished(..), + ) where import Control.Applicative ((<$>), (<*>)) import Control.Monad (unless) @@ -23,9 +33,10 @@ import qualified Crypto.Types.PubKey.ECC as ECC import Network.PeyoTLS.Codec.Hello ( - ClHello(..), SvHello(..), SssnId(..), + ContType(..), + ClHello(..), SvHello(..), PrtVrsn(..), SssnId(..), CipherSuite(..), KeyEx(..), BulkEnc(..), - CmpMtd(..), HashAlg(..), SignAlg(..), + CmpMtd(..), HSAlg(..), HashAlg(..), SignAlg(..), Extension(..), isRnInfo, emptyRnInfo ) import Network.PeyoTLS.Codec.Certificate ( CertReq(..), certReq, ClCertType(..), ClKeyEx(..), DigitSigned(..) ) @@ -33,8 +44,9 @@ modNm :: String modNm = "Network.PeyoTLS.Types" --- RFC 5246 7.4 Handshake Protocol +-- | RFC 5246 7.4 Handshake Protocol -- +-- @ -- enum { -- hello_request(0), client_hello(1), server_hello(2), -- certificate(11), server_key_exchange(12), @@ -59,6 +71,7 @@ -- case finished: Finished; -- } body; -- } Handshake; +-- @ data Handshake = HCCSpec | HHelloReq diff --git a/src/Network/PeyoTLS/Codec/Certificate.hs b/src/Network/PeyoTLS/Codec/Certificate.hs --- a/src/Network/PeyoTLS/Codec/Certificate.hs +++ b/src/Network/PeyoTLS/Codec/Certificate.hs @@ -59,15 +59,15 @@ either (fail . show) return . ASN1.decodeASN1' ASN1.DER =<< B.take =<< B.take 2) -data ClCertType = CTRsaSign | CTEcdsaSign | CTRaw Word8 deriving (Show, Eq) +data ClCertType = CTRsaSign | CTEcdsaSign | CertTypeRaw Word8 deriving (Show, Eq) instance B.Bytable ClCertType where encode CTRsaSign = "\x01" encode CTEcdsaSign = "\x40" - encode (CTRaw w) = BS.pack [w] + encode (CertTypeRaw w) = BS.pack [w] decode bs = case BS.unpack bs of [w] -> Right $ case w of - 1 -> CTRsaSign; 64 -> CTEcdsaSign; _ -> CTRaw w + 1 -> CTRsaSign; 64 -> CTEcdsaSign; _ -> CertTypeRaw w _ -> Left $ modNm ++ ": ClCertType.decode" data ClKeyEx = ClKeyEx BS.ByteString deriving Show diff --git a/src/Network/PeyoTLS/Codec/ContentTypes.hs b/src/Network/PeyoTLS/Codec/ContentTypes.hs --- a/src/Network/PeyoTLS/Codec/ContentTypes.hs +++ b/src/Network/PeyoTLS/Codec/ContentTypes.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module Network.PeyoTLS.Codec.ContentTypes (ProtocolVersion, ContType(..)) where +module Network.PeyoTLS.Codec.ContentTypes (PrtVrsn(..), ContType(..)) where import Data.Word @@ -10,25 +10,31 @@ modNm :: String modNm = "Network.PeyoTLS.Codec.ContentTypes" --- RFC 5246 6.2.1 +-- | RFC 5246 6.2.1 Fragmentation -- +-- @ -- struct { -- uint8 major; -- uint8 minor; -- } ProtocolVersion; +-- @ + +data PrtVrsn = PrtVrsn Word8 Word8 deriving (Show, Eq, Ord) + +instance B.Bytable PrtVrsn where + encode (PrtVrsn mj mn) = BS.pack [mj, mn] + decode mjmn = case BS.unpack mjmn of + [mj, mn] -> Right $ PrtVrsn mj mn + _ -> Left $ modNm ++ ": PrtVrsn.decode" + +-- | RFC 5246 6.2.1 Fragmentation -- +-- @ -- enum { -- change_cipher_spec(20), alert(21), handshake(22), -- application_data(23), (255) -- } ContentType; - -data ProtocolVersion = ProtocolVersion Word8 Word8 deriving (Show, Eq) - -instance B.Bytable ProtocolVersion where - encode (ProtocolVersion mj mn) = BS.pack [mj, mn] - decode mjmn = case BS.unpack mjmn of - [mj, mn] -> Right $ ProtocolVersion mj mn - _ -> Left $ modNm ++ ": ProtocolVersion.decode" +-- @ data ContType = CTCCSpec | CTAlert | CTHandshake | CTAppData | CTNull | CTRaw Word8 deriving (Show, Eq) diff --git a/src/Network/PeyoTLS/Codec/Extension.hs b/src/Network/PeyoTLS/Codec/Extension.hs --- a/src/Network/PeyoTLS/Codec/Extension.hs +++ b/src/Network/PeyoTLS/Codec/Extension.hs @@ -2,7 +2,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Network.PeyoTLS.Codec.Extension ( - Extension(..), isRnInfo, emptyRnInfo, SignAlg(..), HashAlg(..) ) where + Extension(..), isRnInfo, emptyRnInfo, HSAlg(..), SignAlg(..), HashAlg(..) ) where import Control.Applicative ((<$>), (<*>)) import Data.Bits (shiftL, (.|.)) @@ -13,21 +13,23 @@ import qualified Crypto.Types.PubKey.DH as DH import qualified Crypto.Types.PubKey.ECC as ECC -import Network.PeyoTLS.Codec.HSAlg(HSAlg, HashAlg(..), SignAlg(..)) +import Network.PeyoTLS.Codec.HSAlg(HSAlg(..), HashAlg(..), SignAlg(..)) modNm :: String modNm = "Network.PeyoTLS.Codec.Extension" --- RFC 5246 7.4.1.4. Hello Wxtensions +-- | RFC 5246 7.4.1.4. Hello Wxtensions -- +-- @ -- struct { -- ExtensionType extension_type; --- opaque extension_data<0..2^16-1>; +-- opaque extension_data\<0..2^16-1>; -- } Extension; -- -- enum { -- signature_algorithms(13), (65535) -- } ExtensionType +-- @ data Extension = ESName [SName] diff --git a/src/Network/PeyoTLS/Codec/HSAlg.hs b/src/Network/PeyoTLS/Codec/HSAlg.hs --- a/src/Network/PeyoTLS/Codec/HSAlg.hs +++ b/src/Network/PeyoTLS/Codec/HSAlg.hs @@ -1,6 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} -module Network.PeyoTLS.Codec.HSAlg (HSAlg, SignAlg(..), HashAlg(..)) where +module Network.PeyoTLS.Codec.HSAlg (HSAlg(..), SignAlg(..), HashAlg(..)) where import Control.Applicative import Data.Word (Word8) @@ -11,12 +11,14 @@ modNm :: String modNm = "Network.PeyoTLS.Codec.HSAlg" --- RFC 5246 7.4.1.4.1. +-- | RFC 5246 7.4.1.4.1. -- +-- @ -- struct { -- HashAlgorithm hash; -- SignatureAlgorithm signature; -- } SignatureAndHashAlgorithm; +-- @ data HSAlg = HSAlg HashAlg SignAlg deriving (Show, Eq) @@ -25,20 +27,22 @@ decode hasa = let (ha, sa) = BS.splitAt 1 hasa in HSAlg <$> B.decode ha <*> B.decode sa --- RFC 5246 7.4.1.4.1. +-- | RFC 5246 7.4.1.4.1. -- +-- @ -- enum { -- none(0), md5(1), sha1(2), sha224(3), sha256(4), sha384(5), -- sha512(6), (255) -- } HashAlgorithm; +-- @ data HashAlg - = HNone | Md5 | Sha1 | Sha224 | Sha256 | Sha384 | Sha512 + = HANone | Md5 | Sha1 | Sha224 | Sha256 | Sha384 | Sha512 | HARaw Word8 deriving (Show, Eq) instance B.Bytable HashAlg where - encode HNone = "\x00" + encode HANone = "\x00" encode Md5 = "\x01" encode Sha1 = "\x02" encode Sha224 = "\x03" @@ -48,15 +52,17 @@ encode (HARaw w) = BS.pack [w] decode bs = case BS.unpack bs of [ha] -> Right $ case ha of - 0 -> HNone ; 1 -> Md5 + 0 -> HANone ; 1 -> Md5 2 -> Sha1 ; 3 -> Sha224; 4 -> Sha256 5 -> Sha384; 6 -> Sha512; _ -> HARaw ha _ -> Left $ modNm ++ ": HashAlg.decode" instance B.Parsable HashAlg where parse = B.take 1 --- RFC 5246 7.4.1.4.1. +-- | RFC 5246 7.4.1.4.1. -- +-- @ -- enum { anonymous(0), rsa(1), dsa(2), ecdsa(3), (255) } +-- @ data SignAlg = SAnon | Rsa | Dsa | Ecdsa | SARaw Word8 deriving (Show, Eq) diff --git a/src/Network/PeyoTLS/Codec/Hello.hs b/src/Network/PeyoTLS/Codec/Hello.hs --- a/src/Network/PeyoTLS/Codec/Hello.hs +++ b/src/Network/PeyoTLS/Codec/Hello.hs @@ -1,9 +1,10 @@ {-# LANGUAGE OverloadedStrings #-} module Network.PeyoTLS.Codec.Hello ( - ClHello(..), SvHello(..), SssnId(..), + ContType(..), + ClHello(..), SvHello(..), PrtVrsn(..), SssnId(..), CipherSuite(..), KeyEx(..), BulkEnc(..), - CmpMtd(..), SignAlg(..), HashAlg(..), + CmpMtd(..), HSAlg(..), SignAlg(..), HashAlg(..), Extension(..), isRnInfo, emptyRnInfo ) where import Control.Applicative ((<$>), (<*>)) @@ -13,20 +14,22 @@ import qualified Codec.Bytable.BigEndian as B import Network.PeyoTLS.Codec.Extension ( - Extension(..), isRnInfo, emptyRnInfo, SignAlg(..), HashAlg(..) ) + Extension(..), isRnInfo, emptyRnInfo, HSAlg(..), SignAlg(..), HashAlg(..) ) +import Network.PeyoTLS.Codec.ContentTypes (ContType(..), PrtVrsn(..)) import Network.PeyoTLS.CipherSuite (CipherSuite(..), KeyEx(..), BulkEnc(..)) modNm :: String modNm = "Network.PeyoTLS.Codec.Hello" --- RFC 5246 7.4.1.2. Client Hello +-- | RFC 5246 7.4.1.2. Client Hello -- +-- @ -- struct { -- uint32 gmt_unix_time; -- opaque random_bytes[28]; -- } Random -- --- opaque SessionID<0..32>; +-- opaque SessionID\<0..32>; -- -- uint8 CipherSuite[2]; -- @@ -36,38 +39,40 @@ -- ProtocolVersion client_version; -- Random random; -- SessionID session_id; --- CipherSuite cipher_suites<2..2^16-2>; --- CompressionMethod compression_methods<1..2^8-1>; +-- CipherSuite cipher_suites\<2..2^16-2>; +-- CompressionMethod compression_methods\<1..2^8-1>; -- select (extensions_present) { -- case false: struct {}; --- case true: Extension extensions<0..2^16-1>; +-- case true: Extension extensions\<0..2^16-1>; -- }; -- } ClientHello; +-- @ data ClHello - = ClHello (Word8, Word8) BS.ByteString SssnId [CipherSuite] [CmpMtd] + = ClHello PrtVrsn BS.ByteString SssnId [CipherSuite] [CmpMtd] (Maybe [Extension]) | ClHelloRaw BS.ByteString deriving Show instance B.Bytable ClHello where decode = B.evalBytableM $ ClHello - <$> ((,) <$> B.head <*> B.head) + <$> B.take 2 <*> B.take 32 <*> (B.take =<< B.take 1) <*> (flip B.list (B.take 2) =<< B.take 2) <*> (flip B.list (B.take 1) =<< B.take 1) <*> do nl <- B.null if nl then return Nothing else Just <$> (flip B.list B.parse =<< B.take 2) - encode (ClHello (vj, vn) r sid css cms mel) = BS.concat [ - B.encode vj, B.encode vn, B.encode r, B.addLen w8 $ B.encode sid, + encode (ClHello vjvn r sid css cms mel) = BS.concat [ + B.encode vjvn, B.encode r, B.addLen w8 $ B.encode sid, B.addLen w16 . BS.concat $ map B.encode css, B.addLen w8 . BS.concat $ map B.encode cms, maybe "" (B.addLen w16 . BS.concat . map B.encode) mel ] encode (ClHelloRaw bs) = bs --- RFC 5246 7.4.1.3. Server Hello +-- | RFC 5246 7.4.1.3. Server Hello -- +-- @ -- struct { -- ProtocolVersion server_version; -- Random random; @@ -76,25 +81,26 @@ -- CompressionMethod compression_method; -- select (extensions_present) { -- case false: struct {}; --- case true: Extension extensions<0..2^16-1>; +-- case true: Extension extensions\<0..2^16-1>; -- }; -- } ServerHello; +-- @ data SvHello - = SvHello (Word8, Word8) BS.ByteString SssnId CipherSuite CmpMtd + = SvHello PrtVrsn BS.ByteString SssnId CipherSuite CmpMtd (Maybe [Extension]) | SvHelloRaw BS.ByteString deriving Show instance B.Bytable SvHello where decode = B.evalBytableM $ SvHello - <$> ((,) <$> B.head <*> B.head) + <$> B.take 2 <*> B.take 32 <*> (B.take =<< B.take 1) <*> B.take 2 <*> B.take 1 <*> do n <- B.null if n then return Nothing else Just <$> (flip B.list B.parse =<< B.take 2) - encode (SvHello (vj, vn) r sid cs cm mes) = BS.concat [ - B.encode vj, B.encode vn, B.encode r, B.addLen w8 $ B.encode sid, + encode (SvHello vjvn r sid cs cm mes) = BS.concat [ + B.encode vjvn, B.encode r, B.addLen w8 $ B.encode sid, B.encode cs, B.encode cm, maybe "" (B.addLen w16 . BS.concat . map B.encode) mes ] encode (SvHelloRaw sh) = sh