peyotls 0.1.6.5 → 0.1.6.6
raw patch · 9 files changed
+15/−771 lines, 9 filesdep +peyotls-codec
Dependencies added: peyotls-codec
Files
- peyotls.cabal +3/−7
- src/Network/PeyoTLS/CipherSuite.hs +0/−68
- src/Network/PeyoTLS/Codec.hs +0/−236
- src/Network/PeyoTLS/Codec/Certificate.hs +0/−93
- src/Network/PeyoTLS/Codec/Extension.hs +0/−230
- src/Network/PeyoTLS/Codec/HSAlg.hs +0/−40
- src/Network/PeyoTLS/Codec/Hello.hs +0/−77
- src/Network/PeyoTLS/Run/Handle.hs +9/−0
- src/Network/PeyoTLS/Run/State.hs +3/−20
peyotls.cabal view
@@ -2,7 +2,7 @@ cabal-version: >= 1.8 name: peyotls-version: 0.1.6.5+version: 0.1.6.6 stability: Experimental author: Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer: Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -14,7 +14,7 @@ category: Network synopsis: Pretty Easy YOshikuni-made TLS library description:- Currently implement the TLS1.2 protocol only,+ Currently implement the TLS1.2 protocol (RFC 5246, RFC 4492) only, and support the following cipher suites. . * TLS_RSA_WITH_AES_128_CBC_SHA@@ -292,10 +292,6 @@ other-modules: Network.PeyoTLS.Client.Body, Network.PeyoTLS.Server.Body, Network.PeyoTLS.Base,- Network.PeyoTLS.Codec,- Network.PeyoTLS.Codec.Hello, Network.PeyoTLS.Codec.Extension,- Network.PeyoTLS.CipherSuite, Network.PeyoTLS.Codec.HSAlg,- Network.PeyoTLS.Codec.Certificate, Network.PeyoTLS.Run, Network.PeyoTLS.Run.Handle, Network.PeyoTLS.Run.Monad, Network.PeyoTLS.Run.State,@@ -309,7 +305,7 @@ cryptohash == 0.11.*, crypto-pubkey == 0.2.*, crypto-pubkey-types == 0.4.*, cipher-aes == 0.2.*,- bytable == 0.1.*, handle-like == 0.1.*,+ bytable == 0.1.*, handle-like == 0.1.*, peyotls-codec == 0.0.*, stm == 2.4.*, transformers-base == 0.4.*, monad-control == 0.3.* ghc-options: -Wall extensions: PatternGuards, DoAndIfThenElse
− src/Network/PeyoTLS/CipherSuite.hs
@@ -1,68 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.PeyoTLS.CipherSuite (- CipherSuite(..), KeyEx(..), BulkEnc(..)) where--import Control.Arrow (first, (***))-import Data.Word (Word8)-import Data.String (IsString(..))--import qualified Data.ByteString as BS-import qualified Codec.Bytable.BigEndian as B--modNm :: String-modNm = "Network.PeyoTLS.CipherSuite"--data CipherSuite- = CipherSuite KeyEx BulkEnc- | EMPTY_RENEGOTIATION_INFO- | CipherSuiteRaw Word8 Word8- deriving (Show, Read, Eq)--data KeyEx = RSA | DHE_RSA | ECDHE_RSA | ECDHE_ECDSA | KE_NULL- deriving (Show, Read, Eq)--data BulkEnc = AES_128_CBC_SHA | AES_128_CBC_SHA256 | BE_NULL- deriving (Show, Read, Eq)---instance B.Bytable CipherSuite where- decode = decodeCs- encode = encodeCs--decodeCs :: BS.ByteString -> Either String CipherSuite-decodeCs bs = case BS.unpack bs of- [w1, w2] -> Right $ case (w1, w2) of- (0x00, 0x00) -> CipherSuite KE_NULL BE_NULL- (0x00, 0x2f) -> CipherSuite RSA AES_128_CBC_SHA- (0x00, 0x33) -> CipherSuite DHE_RSA AES_128_CBC_SHA- (0x00, 0x3c) -> CipherSuite RSA AES_128_CBC_SHA256- (0x00, 0x67) -> CipherSuite DHE_RSA AES_128_CBC_SHA256- (0xc0, 0x09) -> CipherSuite ECDHE_ECDSA AES_128_CBC_SHA- (0xc0, 0x13) -> CipherSuite ECDHE_RSA AES_128_CBC_SHA- (0xc0, 0x23) -> CipherSuite ECDHE_ECDSA AES_128_CBC_SHA256- (0xc0, 0x27) -> CipherSuite ECDHE_RSA AES_128_CBC_SHA256- (0x00, 0xff) -> EMPTY_RENEGOTIATION_INFO- _ -> CipherSuiteRaw w1 w2- _ -> Left $ modNm ++ ".decodeCs: not 2 byte"--encodeCs :: CipherSuite -> BS.ByteString-encodeCs (CipherSuite KE_NULL BE_NULL) = "\x00\x00"-encodeCs (CipherSuite RSA AES_128_CBC_SHA) = "\x00\x2f"-encodeCs (CipherSuite DHE_RSA AES_128_CBC_SHA) = "\x00\x33"-encodeCs (CipherSuite RSA AES_128_CBC_SHA256) = "\x00\x3c"-encodeCs (CipherSuite DHE_RSA AES_128_CBC_SHA256) = "\x00\x67"-encodeCs (CipherSuite ECDHE_ECDSA AES_128_CBC_SHA) = "\xc0\x09"-encodeCs (CipherSuite ECDHE_RSA AES_128_CBC_SHA) = "\xc0\x13"-encodeCs (CipherSuite ECDHE_ECDSA AES_128_CBC_SHA256) = "\xc0\x23"-encodeCs (CipherSuite ECDHE_RSA AES_128_CBC_SHA256) = "\xc0\x27"-encodeCs (CipherSuiteRaw w1 w2) = BS.pack [w1, w2]-encodeCs EMPTY_RENEGOTIATION_INFO = "\x00\xff"-encodeCs _ = error $ modNm ++ ".encodeCs: unknown cipher suite"--instance IsString CipherSuite where- fromString = uncurry CipherSuite . (read *** read) . sep . drop 4- where- sep "" = error $ modNm ++ ".separateByWith: parse error"- sep ('_' : 'W' : 'I' : 'T' : 'H' : '_' : be) = ("", be)- sep (k : r) = (k :) `first` sep r
− src/Network/PeyoTLS/Codec.hs
@@ -1,236 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.PeyoTLS.Codec (- Handshake(..), HandshakeItem(..),- ClHello(..), SvHello(..), SssnId(..),- CipherSuite(..), KeyEx(..), BulkEnc(..),- CmpMtd(..), Extension(..), isRnInfo, emptyRnInfo,- SvKeyEx(..), SvKeyExDhe(..), SvKeyExEcdhe(..),- CertReq(..), certReq, ClCertType(..), SignAlg(..), HashAlg(..),- SHDone(..), ClKeyEx(..), Epms(..),- DigitSigned(..), Finished(..),- CCSpec(..), ) where--import Control.Applicative ((<$>), (<*>))-import Control.Monad (unless)-import Data.Word (Word8, Word16)-import Data.Word.Word24 (Word24)--import qualified Data.ByteString as BS-import qualified Data.X509 as X509-import qualified Codec.Bytable.BigEndian as B-import qualified Crypto.PubKey.DH as DH-import qualified Crypto.Types.PubKey.ECC as ECC--import Network.PeyoTLS.Codec.Hello (- ClHello(..), SvHello(..), SssnId(..),- CipherSuite(..), KeyEx(..), BulkEnc(..),- CmpMtd(..), HashAlg(..), SignAlg(..),- Extension(..), isRnInfo, emptyRnInfo )-import Network.PeyoTLS.Codec.Certificate (- CertReq(..), certReq, ClCertType(..), ClKeyEx(..), DigitSigned(..) )--modNm :: String-modNm = "Network.PeyoTLS.Types"--data Handshake- = HCCSpec | HHelloReq- | HClHello ClHello | HSvHello SvHello- | HCert X509.CertificateChain | HSvKeyEx BS.ByteString- | HCertReq CertReq | HSHDone- | HCertVer DigitSigned | HClKeyEx ClKeyEx- | HFinished BS.ByteString | HRaw Type BS.ByteString- deriving Show--instance B.Bytable Handshake where- decode = B.evalBytableM B.parse; encode = encodeH--instance B.Parsable Handshake where- parse = (,) <$> B.take 1 <*> B.take 3 >>= \(t, l) -> case t of- THelloReq -> const HHelloReq <$>- unless (l == 0) (fail $ modNm ++ ": Handshake.parse")- TClHello -> HClHello <$> B.take l- TSvHello -> HSvHello <$> B.take l- TCert -> HCert <$> B.take l- TSvKeyEx -> HSvKeyEx <$> B.take l- TCertReq -> HCertReq <$> B.take l- TSHDone -> const HSHDone <$>- unless (l == 0) (fail $ modNm ++ ": Handshake.parse")- TCertVer -> HCertVer <$> B.take l- TClKeyEx -> HClKeyEx <$> B.take l- TFinished -> HFinished <$> B.take l- _ -> HRaw t <$> B.take l--encodeH :: Handshake -> BS.ByteString-encodeH HHelloReq = encodeH $ HRaw THelloReq ""-encodeH (HClHello ch) = encodeH . HRaw TClHello $ B.encode ch-encodeH (HSvHello sh) = encodeH . HRaw TSvHello $ B.encode sh-encodeH (HCert crts) = encodeH . HRaw TCert $ B.encode crts-encodeH (HSvKeyEx ske) = encodeH $ HRaw TSvKeyEx ske-encodeH (HCertReq cr) = encodeH . HRaw TCertReq $ B.encode cr-encodeH HSHDone = encodeH $ HRaw TSHDone ""-encodeH (HCertVer ds) = encodeH . HRaw TCertVer $ B.encode ds-encodeH (HClKeyEx epms) = encodeH . HRaw TClKeyEx $ B.encode epms-encodeH (HFinished bs) = encodeH $ HRaw TFinished bs-encodeH (HRaw t bs) = B.encode t `BS.append` B.addLen w24 bs-encodeH HCCSpec = B.encode CCSpec--class HandshakeItem hi where- fromHandshake :: Handshake -> Maybe hi; toHandshake :: hi -> Handshake--instance HandshakeItem Handshake where fromHandshake = Just; toHandshake = id--instance (HandshakeItem l, HandshakeItem r) => HandshakeItem (Either l r) where- fromHandshake hs = let l = fromHandshake hs; r = fromHandshake hs in- maybe (Right <$> r) (Just . Left) l- toHandshake (Left l) = toHandshake l- toHandshake (Right r) = toHandshake r--data CCSpec = CCSpec | CCSpecRaw Word8 deriving Show--instance HandshakeItem CCSpec where- fromHandshake HCCSpec = Just CCSpec- fromHandshake _ = Nothing- toHandshake CCSpec = HCCSpec- toHandshake (CCSpecRaw _) = error $ modNm ++ ": CCSpec.toHandshake"--instance B.Bytable CCSpec where- decode bs = case BS.unpack bs of- [1] -> Right CCSpec- [w] -> Right $ CCSpecRaw w- _ -> Left $ modNm ++ ": CCSpec.decode"- encode CCSpec = BS.pack [1]- encode (CCSpecRaw w) = BS.pack [w]--instance HandshakeItem ClHello where- fromHandshake (HClHello ch) = Just ch- fromHandshake _ = Nothing- toHandshake = HClHello--instance HandshakeItem SvHello where- fromHandshake (HSvHello sh) = Just sh- fromHandshake _ = Nothing- toHandshake = HSvHello--instance HandshakeItem X509.CertificateChain where- fromHandshake (HCert cc) = Just cc- fromHandshake _ = Nothing- toHandshake = HCert--data SvKeyEx = SvKeyEx BS.ByteString BS.ByteString HashAlg SignAlg BS.ByteString- deriving Show--instance HandshakeItem SvKeyEx where- fromHandshake = undefined- toHandshake = HSvKeyEx . B.encode--instance B.Bytable SvKeyEx where- decode = undefined- encode (SvKeyEx ps pv h s sn) = BS.concat [- ps, pv, B.encode h, B.encode s, B.addLen w16 sn ]--data SvKeyExDhe = SvKeyExDhe DH.Params DH.PublicNumber HashAlg SignAlg BS.ByteString- deriving Show--instance HandshakeItem SvKeyExDhe where- fromHandshake (HSvKeyEx ske) = either (const Nothing) Just $ B.decode ske- fromHandshake _ = Nothing- toHandshake = HSvKeyEx . B.encode--instance B.Bytable SvKeyExDhe where- encode (SvKeyExDhe ps pn h s sn) = BS.concat [- B.encode ps, B.encode pn, B.encode h, B.encode s, B.addLen w16 sn ]- decode = B.evalBytableM B.parse--instance B.Parsable SvKeyExDhe where- parse = SvKeyExDhe <$> B.parse <*> B.parse- <*> B.parse <*> B.parse <*> (B.take =<< B.take 2)--data SvKeyExEcdhe = SvKeyExEcdhe ECC.Curve ECC.Point HashAlg SignAlg BS.ByteString- deriving Show--instance HandshakeItem SvKeyExEcdhe where- fromHandshake (HSvKeyEx ske) = either (const Nothing) Just $ B.decode ske- fromHandshake _ = Nothing- toHandshake = HSvKeyEx . B.encode--instance B.Bytable SvKeyExEcdhe where- encode (SvKeyExEcdhe cv pnt h s sn) = BS.concat [- B.encode cv, B.encode pnt, B.encode h, B.encode s, B.addLen w16 sn ]- decode = B.evalBytableM B.parse--instance B.Parsable SvKeyExEcdhe where- parse = SvKeyExEcdhe <$> B.parse <*> B.parse- <*> B.parse <*> B.parse <*> (B.take =<< B.take 2)--instance HandshakeItem CertReq where- fromHandshake (HCertReq cr) = Just cr- fromHandshake _ = Nothing- toHandshake = HCertReq--data SHDone = SHDone deriving Show--instance HandshakeItem SHDone where- fromHandshake HSHDone = Just SHDone- fromHandshake _ = Nothing- toHandshake _ = HSHDone--instance HandshakeItem DigitSigned where- fromHandshake (HCertVer ds) = Just ds- fromHandshake _ = Nothing- toHandshake = HCertVer--instance HandshakeItem ClKeyEx where- fromHandshake (HClKeyEx cke) = Just cke- fromHandshake _ = Nothing- toHandshake = HClKeyEx--data Epms = Epms BS.ByteString--instance HandshakeItem Epms where- fromHandshake (HClKeyEx (ClKeyEx cke)) =- case B.runBytableM (B.take =<< B.take 2) cke of- Right (e, "") -> Just $ Epms e- _ -> Nothing- fromHandshake _ = Nothing- toHandshake (Epms epms) = HClKeyEx . ClKeyEx $ B.addLen w16 epms--data Finished = Finished BS.ByteString deriving (Show, Eq)--instance HandshakeItem Finished where- fromHandshake (HFinished f) = Just $ Finished f- fromHandshake _ = Nothing- toHandshake (Finished f) = HFinished f--data Type- = THelloReq | TClHello | TSvHello | TCert | TSvKeyEx | TCertReq | TSHDone- | TCertVer | TClKeyEx | TFinished | TRaw Word8 deriving Show--instance B.Bytable Type where- decode bs = case BS.unpack bs of- [0] -> Right THelloReq- [1] -> Right TClHello- [2] -> Right TSvHello- [11] -> Right TCert- [12] -> Right TSvKeyEx- [13] -> Right TCertReq- [14] -> Right TSHDone- [15] -> Right TCertVer- [16] -> Right TClKeyEx- [20] -> Right TFinished- [ht] -> Right $ TRaw ht- _ -> Left $ modNm ++ ": Type.decode"- encode THelloReq = BS.pack [0]- encode TClHello = BS.pack [1]- encode TSvHello = BS.pack [2]- encode TCert = BS.pack [11]- encode TSvKeyEx = BS.pack [12]- encode TCertReq = BS.pack [13]- encode TSHDone = BS.pack [14]- encode TCertVer = BS.pack [15]- encode TClKeyEx = BS.pack [16]- encode TFinished = BS.pack [20]- encode (TRaw w) = BS.pack [w]--w16 :: Word16; w16 = undefined-w24 :: Word24; w24 = undefined
− src/Network/PeyoTLS/Codec/Certificate.hs
@@ -1,93 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Network.PeyoTLS.Codec.Certificate (- CertReq(..), certReq, ClCertType(..), ClKeyEx(..), DigitSigned(..)) where--import Control.Applicative ((<$>), (<*>))-import Data.Word (Word8, Word16)-import Data.Word.Word24 (Word24)--import qualified Data.ByteString as BS-import qualified Data.ASN1.Types as ASN1-import qualified Data.ASN1.Encoding as ASN1-import qualified Data.ASN1.BinaryEncoding as ASN1-import qualified Data.X509 as X509-import qualified Data.X509.CertificateStore as X509-import qualified Codec.Bytable.BigEndian as B--import Network.PeyoTLS.Codec.HSAlg (HashAlg, SignAlg)--modNm :: String-modNm = "Network.PeyoTLS.Codec.Certificate"--instance B.Bytable X509.CertificateChain where- decode = B.evalBytableM B.parse- encode = B.addLen w24 . cmap (B.addLen w24)- . (\(X509.CertificateChainRaw c) -> c) . X509.encodeCertificateChain- . (\(X509.CertificateChain cs) -> X509.CertificateChain cs)--instance B.Parsable X509.CertificateChain where- parse = X509.decodeCertificateChain . X509.CertificateChainRaw <$>- (flip B.list (B.take =<< B.take 3) =<< B.take 3) >>= \ecc ->- case ecc of- Right (X509.CertificateChain cs) ->- return $ X509.CertificateChain cs- Left (n, em) -> fail $ modNm ++ ": " ++- "X509.CertificateChain.parse" ++ show n ++ " " ++ em--data CertReq = CertReq [ClCertType] [(HashAlg, SignAlg)] [X509.DistinguishedName]- deriving Show--certReq :: [ClCertType] -> [(HashAlg, SignAlg)] -> X509.CertificateStore -> CertReq-certReq t a = CertReq t a- . map (X509.certIssuerDN . X509.signedObject . X509.getSigned)- . X509.listCertificates--instance B.Bytable CertReq where- encode (CertReq t a n) = BS.concat [- B.addLen w8 $ cmap B.encode t,- B.addLen w16 $- cmap (\(h, s) -> B.encode h `BS.append` B.encode s) a,- B.addLen w16 . flip cmap n $ B.addLen w16 .- ASN1.encodeASN1' ASN1.DER . flip ASN1.toASN1 [] ]- decode = B.evalBytableM $ CertReq- <$> (flip B.list (B.take 1) =<< B.take 1)- <*> (flip B.list ((,) <$> B.take 1 <*> B.take 1) =<< B.take 2)- <*> ((B.take 2 >>=) . flip B.list $- either (fail . show) (return . fst) . ASN1.fromASN1 =<<- either (fail . show) return . ASN1.decodeASN1' ASN1.DER =<<- B.take =<< B.take 2)--data ClCertType = CTRsaSign | CTEcdsaSign | CTRaw Word8 deriving (Show, Eq)--instance B.Bytable ClCertType where- encode CTRsaSign = "\x01"- encode CTEcdsaSign = "\x40"- encode (CTRaw w) = BS.pack [w]- decode bs = case BS.unpack bs of- [w] -> Right $ case w of- 1 -> CTRsaSign; 64 -> CTEcdsaSign; _ -> CTRaw w- _ -> Left $ modNm ++ ": ClCertType.decode"--data ClKeyEx = ClKeyEx BS.ByteString deriving Show-instance B.Bytable ClKeyEx where decode = Right . ClKeyEx; encode (ClKeyEx e) = e--data DigitSigned- = DigitSigned (HashAlg, SignAlg) BS.ByteString- | DigitSignedRaw BS.ByteString- deriving Show--instance B.Bytable DigitSigned where- decode = B.evalBytableM $ DigitSigned- <$> ((,) <$> B.take 1 <*> B.take 1) <*> (B.take =<< B.take 2)- encode (DigitSigned (ha, sa) bs) = BS.concat- [B.encode ha, B.encode sa, B.addLen w16 bs]- encode (DigitSignedRaw bs) = bs--cmap :: (a -> BS.ByteString) -> [a] -> BS.ByteString-cmap = (BS.concat .) . map--w8 :: Word8; w8 = undefined-w16 :: Word16; w16 = undefined-w24 :: Word24; w24 = undefined
− src/Network/PeyoTLS/Codec/Extension.hs
@@ -1,230 +0,0 @@-{-# LANGUAGE OverloadedStrings, ScopedTypeVariables #-}-{-# OPTIONS_GHC -fno-warn-orphans #-}--module Network.PeyoTLS.Codec.Extension (- Extension(..), isRnInfo, emptyRnInfo, SignAlg(..), HashAlg(..) ) where--import Control.Applicative ((<$>), (<*>))-import Data.Bits (shiftL, (.|.))-import Data.Word (Word8, Word16)--import qualified Data.ByteString as BS-import qualified Codec.Bytable.BigEndian as B-import qualified Crypto.Types.PubKey.DH as DH-import qualified Crypto.Types.PubKey.ECC as ECC--import Network.PeyoTLS.Codec.HSAlg(HashAlg(..), SignAlg(..))--modNm :: String-modNm = "Network.PeyoTLS.Codec.Extension"--data Extension- = ESName [SName]- | EECrv [ECC.CurveName] | EEPFrmt [EPFrmt]- | ESsnTcktTls BS.ByteString | ENxPrtNego BS.ByteString- | ERnInfo BS.ByteString | ERaw EType BS.ByteString- deriving (Show, Eq)--instance B.Bytable Extension where- encode (ESName n) = B.encode . ERaw TSName . B.addLen w16 $ cmap B.encode n- encode (EECrv c) = B.encode . ERaw TECrv . B.addLen w16 $ cmap B.encode c- encode (EEPFrmt f) = B.encode . ERaw TEPFrmt . B.addLen w8 $ cmap B.encode f- encode (ESsnTcktTls t) = B.encode $ ERaw TSsnTcktTls t- encode (ENxPrtNego n) = B.encode $ ERaw TNxPrtNego n- encode (ERnInfo i) = B.encode . ERaw TRnInfo $ B.addLen w8 i- encode (ERaw t e) = B.encode t `BS.append` B.addLen w16 e- decode = B.evalBytableM B.parse--instance B.Parsable Extension where- parse = (,) <$> B.take 2 <*> B.take 2 >>= \(t, l) -> case t of- TSName -> ESName <$> (flip B.list B.parse =<< B.take 2)- TECrv -> EECrv <$> (flip B.list (B.take 2) =<< B.take 2)- TEPFrmt -> EEPFrmt <$> (flip B.list (B.take 1) =<< B.take 1)- TSsnTcktTls -> ESsnTcktTls <$> B.take l- TNxPrtNego -> ENxPrtNego <$> B.take l- TRnInfo -> ERnInfo <$> (B.take =<< B.take 1)- _ -> ERaw t <$> B.take l--cmap :: (a -> BS.ByteString) -> [a] -> BS.ByteString-cmap = (BS.concat .) . map--data EType- = TSName | TECrv | TEPFrmt | TSsnTcktTls- | TNxPrtNego | TRnInfo | TRaw Word16 deriving (Show, Eq)--instance B.Bytable EType where- encode TSName = B.encode (0 :: Word16)- encode TECrv = B.encode (10 :: Word16)- encode TEPFrmt = B.encode (11 :: Word16)- encode TSsnTcktTls = B.encode (35 :: Word16)- encode TNxPrtNego = B.encode (13172 :: Word16)- encode TRnInfo = B.encode (65281 :: Word16)- encode (TRaw et) = B.encode et- decode bs = case BS.unpack bs of- [w1, w2] -> Right $- case fromIntegral w1 `shiftL` 8 .|. fromIntegral w2 of- 0 -> TSName- 10 -> TECrv- 11 -> TEPFrmt- 35 -> TSsnTcktTls- 13172 -> TNxPrtNego- 65281 -> TRnInfo- et -> TRaw et- _ -> Left $ modNm ++ ": EType.decode"--data SName = SNHName BS.ByteString | SNRaw NType BS.ByteString deriving (Show, Eq)--instance B.Bytable SName where- encode (SNHName nm) = B.encode $ SNRaw NTHName nm- encode (SNRaw nt nm) = B.encode nt `BS.append` B.addLen w16 nm- decode = B.evalBytableM B.parse--instance B.Parsable SName where- parse = (\t n -> case t of NTHName -> SNHName n; _ -> SNRaw t n)- <$> B.take 1 <*> (B.take =<< B.take 2)--data NType = NTHName | NTRaw Word8 deriving (Show, Eq)--instance B.Bytable NType where- encode NTHName = BS.pack [0]- encode (NTRaw t) = BS.pack [t]- decode bs = case BS.unpack bs of- [t] -> Right $ case t of 0 -> NTHName; _ -> NTRaw t- _ -> Left $ modNm ++ ": NType.decode"--instance B.Bytable DH.Params where- encode (DH.Params p g) = BS.concat- [B.addLen w16 $ B.encode p, B.addLen w16 $ B.encode g]- decode = B.evalBytableM B.parse--instance B.Parsable DH.Params where- parse = DH.Params <$> (B.take =<< B.take 2) <*> (B.take =<< B.take 2)--instance B.Bytable DH.PublicNumber where- encode = B.addLen w16 . B.encode . \(DH.PublicNumber pn) -> pn- decode = B.evalBytableM B.parse--instance B.Parsable DH.PublicNumber where- parse = fromInteger <$> (B.take =<< B.take 2)--data ECType = ExpPrm | ExpCh2 | NmdCrv | CRaw Word8 deriving Show--instance B.Bytable ECType where- encode ExpPrm = BS.pack [1]- encode ExpCh2 = BS.pack [2]- encode NmdCrv = BS.pack [3]- encode (CRaw w) = BS.pack [w]- decode = B.evalBytableM B.parse--instance B.Parsable ECType where- parse = (\t -> case t of 1 -> ExpPrm; 2 -> ExpCh2; 3 -> NmdCrv; _ -> CRaw t)- <$> B.head--instance B.Bytable ECC.CurveName where- encode ECC.SEC_t163k1 = B.encode (1 :: Word16)- encode ECC.SEC_t163r1 = B.encode (2 :: Word16)- encode ECC.SEC_t163r2 = B.encode (3 :: Word16)- encode ECC.SEC_t193r1 = B.encode (4 :: Word16)- encode ECC.SEC_t193r2 = B.encode (5 :: Word16)- encode ECC.SEC_t233k1 = B.encode (6 :: Word16)- encode ECC.SEC_t233r1 = B.encode (7 :: Word16)- encode ECC.SEC_t239k1 = B.encode (8 :: Word16)- encode ECC.SEC_t283k1 = B.encode (9 :: Word16)- encode ECC.SEC_t283r1 = B.encode (10 :: Word16)- encode ECC.SEC_t409k1 = B.encode (11 :: Word16)- encode ECC.SEC_t409r1 = B.encode (12 :: Word16)- encode ECC.SEC_t571k1 = B.encode (13 :: Word16)- encode ECC.SEC_t571r1 = B.encode (14 :: Word16)- encode ECC.SEC_p160k1 = B.encode (15 :: Word16)- encode ECC.SEC_p160r1 = B.encode (16 :: Word16)- encode ECC.SEC_p160r2 = B.encode (17 :: Word16)- encode ECC.SEC_p192k1 = B.encode (18 :: Word16)- encode ECC.SEC_p192r1 = B.encode (19 :: Word16)- encode ECC.SEC_p224k1 = B.encode (20 :: Word16)- encode ECC.SEC_p224r1 = B.encode (21 :: Word16)- encode ECC.SEC_p256k1 = B.encode (22 :: Word16)- encode ECC.SEC_p256r1 = B.encode (23 :: Word16)- encode ECC.SEC_p384r1 = B.encode (24 :: Word16)- encode ECC.SEC_p521r1 = B.encode (25 :: Word16)- encode _ = error "Extension.encodeCN: not implemented"- decode bs = case BS.unpack bs of- [w1, w2] -> case fromIntegral w1 `shiftL` 8 .|. fromIntegral w2 of- (1 :: Word16) -> Right ECC.SEC_t163k1- (2 :: Word16) -> Right ECC.SEC_t163r1- (3 :: Word16) -> Right ECC.SEC_t163r2- (4 :: Word16) -> Right ECC.SEC_t193r1- (5 :: Word16) -> Right ECC.SEC_t193r2- (6 :: Word16) -> Right ECC.SEC_t233k1- (7 :: Word16) -> Right ECC.SEC_t233r1- (8 :: Word16) -> Right ECC.SEC_t239k1- (9 :: Word16) -> Right ECC.SEC_t283k1- (10 :: Word16) -> Right ECC.SEC_t283r1- (11 :: Word16) -> Right ECC.SEC_t409k1- (12 :: Word16) -> Right ECC.SEC_t409r1- (13 :: Word16) -> Right ECC.SEC_t571k1- (14 :: Word16) -> Right ECC.SEC_t571r1- (15 :: Word16) -> Right ECC.SEC_p160k1- (16 :: Word16) -> Right ECC.SEC_p160r1- (17 :: Word16) -> Right ECC.SEC_p160r2- (18 :: Word16) -> Right ECC.SEC_p192k1- (19 :: Word16) -> Right ECC.SEC_p192r1- (20 :: Word16) -> Right ECC.SEC_p224k1- (21 :: Word16) -> Right ECC.SEC_p224r1- (22 :: Word16) -> Right ECC.SEC_p256k1- (23 :: Word16) -> Right ECC.SEC_p256r1- (24 :: Word16) -> Right ECC.SEC_p384r1- (25 :: Word16) -> Right ECC.SEC_p521r1- n -> Left $ modNm ++ ": CurveName.decode: unknown crv: " ++- show n- _ -> Left $ modNm ++ ": CurveName.decode: bad format"--instance B.Parsable ECC.CurveName where parse = B.take 2--instance B.Bytable ECC.Curve where- encode c- | c == ECC.getCurveByName ECC.SEC_p256r1 =- B.encode NmdCrv `BS.append` B.encode ECC.SEC_p256r1- | c == ECC.getCurveByName ECC.SEC_p384r1 =- B.encode NmdCrv `BS.append` B.encode ECC.SEC_p384r1- | c == ECC.getCurveByName ECC.SEC_p521r1 =- B.encode NmdCrv `BS.append` B.encode ECC.SEC_p521r1- | otherwise = error $ modNm ++ ": ECC.Curve.encode: not implemented"- decode = B.evalBytableM B.parse--instance B.Parsable ECC.Curve where- parse = (ECC.getCurveByName <$>) $ B.parse >>= \t -> case t of- NmdCrv -> B.parse- _ -> error $ modNm ++ ": ECC.Curve.parse: not implemented"--data EPFrmt = EPFUncomp | EPFRaw Word8 deriving (Show, Eq)--instance B.Bytable EPFrmt where- encode EPFUncomp = BS.pack [0]- encode (EPFRaw f) = BS.pack [f]- decode bs = case BS.unpack bs of- [f] -> Right $ case f of 0 -> EPFUncomp; _ -> EPFRaw f- _ -> Left $ modNm ++ ": Bytable.decode"--instance B.Bytable ECC.Point where- encode (ECC.Point x y) = B.addLen w8 $- 4 `BS.cons` pad 32 0 (B.encode x) `BS.append` pad 32 0 (B.encode y)- where pad n w s = BS.replicate (n - BS.length s) w `BS.append` s- encode ECC.PointO = error $ modNm ++ ": EC.Point.encode"- decode = B.evalBytableM B.parse--instance B.Parsable ECC.Point where- parse = (B.take =<< B.take 1) >>= \bs -> case BS.uncons bs of- Just (4, xy) -> return $ let (x, y) = BS.splitAt 32 xy in ECC.Point- (either error id $ B.decode x)- (either error id $ B.decode y)- _ -> fail $ modNm ++ ": ECC.Point.parse"--isRnInfo :: Extension -> Bool-isRnInfo (ERnInfo _) = True-isRnInfo _ = False--emptyRnInfo :: Extension-emptyRnInfo = ERnInfo ""--w8 :: Word8; w8 = undefined-w16 :: Word16; w16 = undefined
− src/Network/PeyoTLS/Codec/HSAlg.hs
@@ -1,40 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.PeyoTLS.Codec.HSAlg (SignAlg(..), HashAlg(..)) where--import Data.Word (Word8)--import qualified Data.ByteString as BS-import qualified Codec.Bytable.BigEndian as B--modNm :: String-modNm = "Network.PeyoTLS.Codec.HSAlg"--data HashAlg = Sha1 | Sha224 | Sha256 | Sha384 | Sha512 | HARaw Word8 deriving Show--instance B.Bytable HashAlg where- encode Sha1 = "\x02"- encode Sha224 = "\x03"- encode Sha256 = "\x04"- encode Sha384 = "\x05"- encode Sha512 = "\x06"- encode (HARaw w) = BS.pack [w]- decode bs = case BS.unpack bs of- [ha] -> Right $ case ha of- 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--data SignAlg = Rsa | Dsa | Ecdsa | SARaw Word8 deriving (Show, Eq)--instance B.Bytable SignAlg where- encode Rsa = "\x01"- encode Dsa = "\x02"- encode Ecdsa = "\x03"- encode (SARaw w) = BS.pack [w]- decode bs = case BS.unpack bs of- [sa] -> Right $ case sa of- 1 -> Rsa; 2 -> Dsa; 3 -> Ecdsa; _ -> SARaw sa- _ -> Left $ modNm ++ ": SignAlg.decode"-instance B.Parsable SignAlg where parse = B.take 1
− src/Network/PeyoTLS/Codec/Hello.hs
@@ -1,77 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Network.PeyoTLS.Codec.Hello (- ClHello(..), SvHello(..), SssnId(..),- CipherSuite(..), KeyEx(..), BulkEnc(..),- CmpMtd(..), SignAlg(..), HashAlg(..),- Extension(..), isRnInfo, emptyRnInfo ) where--import Control.Applicative ((<$>), (<*>))-import Data.Word (Word8, Word16)--import qualified Data.ByteString as BS-import qualified Codec.Bytable.BigEndian as B--import Network.PeyoTLS.Codec.Extension (- Extension(..), isRnInfo, emptyRnInfo, SignAlg(..), HashAlg(..) )-import Network.PeyoTLS.CipherSuite (CipherSuite(..), KeyEx(..), BulkEnc(..))--modNm :: String-modNm = "Network.PeyoTLS.Codec.Hello"--data ClHello- = ClHello (Word8, Word8) 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 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,- 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--data SvHello- = SvHello (Word8, Word8) 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 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,- B.encode cs, B.encode cm,- maybe "" (B.addLen w16 . BS.concat . map B.encode) mes ]- encode (SvHelloRaw sh) = sh--data SssnId = SssnId BS.ByteString deriving Show--instance B.Bytable SssnId where decode = Right . SssnId; encode (SssnId bs) = bs--data CmpMtd = CmpMtdNull | CmpMtdRaw Word8 deriving (Show, Eq)--instance B.Bytable CmpMtd where- decode bs = case BS.unpack bs of- [cm] -> Right $ case cm of 0 -> CmpMtdNull; _ -> CmpMtdRaw cm- _ -> Left $ modNm ++ ": CmpMtd.decode"- encode CmpMtdNull = "\0"- encode (CmpMtdRaw cm) = BS.pack [cm]--w8 :: Word8; w8 = undefined-w16 :: Word16; w16 = undefined
src/Network/PeyoTLS/Run/Handle.hs view
@@ -186,6 +186,15 @@ c@(t', _) <- getCont h M.setRBuf (pid h) c >> return t' +-- RFC 5246 6.2.1+--+-- struct {+-- ContentType type;+-- ProtocolVersion version;+-- uint16 length;+-- opaque fragment[TLSPalaintext.length];+-- } TLSPlaintext;+ getCont :: (HandleLike h, CPRG g) => HandleBase h g -> M.TlsM h g (M.ContType, BS.ByteString) getCont h = do
src/Network/PeyoTLS/Run/State.hs view
@@ -6,6 +6,7 @@ getRSn, getWSn, rstRSn, rstWSn, sccRSn, sccWSn, getClFinished, setClFinished, getSvFinished, setSvFinished, ContType(..), getRBuf, getWBuf, getAdBuf, setRBuf, setWBuf, setAdBuf,+ ProtocolVersion, CipherSuite(..), BulkEnc(..), RW(..), getCipherSuite, setCipherSuite, flushCipherSuite, Keys(..), getKeys, setKeys,@@ -17,17 +18,17 @@ import Control.Arrow (first) import Data.Maybe (maybeToList) import Data.List (find)-import Data.Word (Word8, Word64)+import Data.Word (Word64) import qualified Data.ByteString as BS import qualified Data.X509 as X509 import qualified Data.X509.CertificateStore as X509-import qualified Codec.Bytable.BigEndian as B import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.ECC.ECDSA as ECDSA import Network.PeyoTLS.CertSecretKey (CertSecretKey(..), isRsaKey, isEcdsaKey) import Network.PeyoTLS.CipherSuite (CipherSuite(..), KeyEx(KE_NULL), BulkEnc(..))+import Network.PeyoTLS.Codec.ContentTypes (ContType(..), ProtocolVersion) modNm :: String modNm = "Network.PeyoTLS.State"@@ -114,24 +115,6 @@ setClFinished, setSvFinished :: PartnerId -> BS.ByteString -> Modify (TlsState h g) setClFinished = setState $ \cf st -> st { rnClFinished = cf } setSvFinished = setState $ \sf st -> st { rnSvFinished = sf }--data ContType = CTCCSpec | CTAlert | CTHandshake | CTAppData | CTNull | CTRaw Word8- deriving (Show, Eq)--instance B.Bytable ContType where- encode CTNull = BS.pack [0]- encode CTCCSpec = BS.pack [20]- encode CTAlert = BS.pack [21]- encode CTHandshake = BS.pack [22]- encode CTAppData = BS.pack [23]- encode (CTRaw ct) = BS.pack [ct]- decode "\0" = Right CTNull- decode "\20" = Right CTCCSpec- decode "\21" = Right CTAlert- decode "\22" = Right CTHandshake- decode "\23" = Right CTAppData- decode bs | [ct] <- BS.unpack bs = Right $ CTRaw ct- decode _ = Left $ modNm ++ ": ContType.decode" getRBuf, getWBuf :: PartnerId -> TlsState h g -> (ContType, BS.ByteString) getRBuf = (rBuffer .) . getState; getWBuf = (wBuffer .) . getState