prepare source for NPN.

Network/TLS/Context.hs

@@ -75,8 +75,9 @@ data TLSParams = TLSParams
 	, pCompressions      :: [Compression]       -- ^ all compression supported ordered by priority.
 	, pWantClientCert    :: Bool                -- ^ request a certificate from client.
 	                                            -- use by server only.
-	, pUseSecureRenegotiation :: Bool           -- notify that we want to use secure renegotation
-	, pUseSession             :: Bool           -- generate new session if specified
+	, pUseSecureRenegotiation :: Bool           -- ^ notify that we want to use secure renegotation
+	, pUseNextProtocolNegociation :: Bool       -- ^ use draft Next Protocol Negociation extension.
+	, pUseSession             :: Bool           -- ^ generate new session if specified
 	, pCertificates      :: [(X509, Maybe PrivateKey)] -- ^ the cert chain for this context with the associated keys if any.
 	, pLogging           :: TLSLogging          -- ^ callback for logging
 	, onHandshake        :: Measurement -> IO Bool -- ^ callback on a beggining of handshake

Network/TLS/Core.hs

@@ -424,6 +424,9 @@ handshakeServerWith ctx clientHello@(ClientHello ver _ clientSession ciphers com
 		expectChangeCipher ChangeCipherSpec = return $ RecvStateHandshake expectFinish
 		expectChangeCipher p                = unexpected (show p) (Just "change cipher")
 
+		expectNPN (NextProtocolNegociation _) = return $ RecvStateHandshake expectFinish
+		expectNPN p                           = unexpected (show p) (Just "Handshake NextProtocolNegociation")
+
 		expectFinish (Finished _) = return RecvStateDone
 		expectFinish p            = unexpected (show p) (Just "Handshake Finished")
 		---

Network/TLS/Packet.hs

@@ -72,6 +72,7 @@ import qualified Crypto.Hash.MD5 as MD5
 data CurrentParams = CurrentParams
 	{ cParamsVersion     :: Version               -- ^ current protocol version
 	, cParamsKeyXchgType :: CipherKeyExchangeType -- ^ current key exchange type
+	, cParamsSupportNPN  :: Bool                  -- ^ support Next Protocol Negociation extension
 	} deriving (Show,Eq)
 
 runGetErr :: String -> Get a -> ByteString -> Either TLSError a
@@ -173,6 +174,9 @@ decodeHandshake cp ty = runGetErr "handshake" $ case ty of
 	HandshakeType_CertVerify      -> decodeCertVerify
 	HandshakeType_ClientKeyXchg   -> decodeClientKeyXchg
 	HandshakeType_Finished        -> decodeFinished
+	HandshakeType_NPN             -> do
+		unless (cParamsSupportNPN cp) $ fail "unsupported handshake type"
+		decodeNextProtocolNegociation
 
 decodeHelloRequest :: Get Handshake
 decodeHelloRequest = return HelloRequest
@@ -217,6 +221,12 @@ decodeCertificates = do
 decodeFinished :: Get Handshake
 decodeFinished = Finished <$> (remaining >>= getBytes)
 
+decodeNextProtocolNegociation :: Get Handshake
+decodeNextProtocolNegociation = do
+	opaque <- getOpaque8
+	_      <- getOpaque8
+	return $ NextProtocolNegociation opaque
+
 getSignatureHashAlgorithm :: Get (HashAlgorithm, SignatureAlgorithm)
 getSignatureHashAlgorithm = do
 	h <- fromJust . valToType <$> getWord8
@@ -333,6 +343,11 @@ encodeHandshakeContent (CertVerify _) = undefined
 
 encodeHandshakeContent (Finished opaque) = putBytes opaque
 
+encodeHandshakeContent (NextProtocolNegociation protocol) = do
+	putOpaque8 protocol
+	putOpaque8 $ B.replicate paddingLen 0
+	where paddingLen = 32 - ((B.length protocol + 2) `mod` 32)
+
 {- FIXME make sure it return error if not 32 available -}
 getRandom32 :: Get Bytes
 getRandom32 = getBytes 32

Network/TLS/Receiving.hs

@@ -46,6 +46,7 @@ processPacket (Record ProtocolType_Handshake ver fragment) = do
 	let currentparams = CurrentParams
 		{ cParamsVersion     = ver
 		, cParamsKeyXchgType = maybe CipherKeyExchange_RSA id $ keyxchg
+		, cParamsSupportNPN  = False
 		}
 	handshakes <- returnEither (decodeHandshakes $ fragmentGetBytes fragment)
 	hss <- forM handshakes $ \(ty, content) -> do

Network/TLS/State.hs

@@ -114,6 +114,7 @@ data TLSState = TLSState
 	, stSecureRenegotiation :: Bool  -- RFC 5746
 	, stClientVerifiedData  :: Bytes -- RFC 5746
 	, stServerVerifiedData  :: Bytes -- RFC 5746
+	, stExtensionNPN        :: Bool  -- NPN draft extension
 	} deriving (Show)
 
 newtype TLSSt a = TLSSt { runTLSSt :: ErrorT TLSError (State TLSState) a }
@@ -148,6 +149,7 @@ newTLSState rng = TLSState
 	, stSecureRenegotiation = False
 	, stClientVerifiedData  = B.empty
 	, stServerVerifiedData  = B.empty
+	, stExtensionNPN        = False
 	}
 
 withTLSRNG :: StateRNG -> (forall g . CryptoRandomGen g => g -> Either e (a,g)) -> Either e (a, StateRNG)
@@ -207,6 +209,7 @@ finishHandshakeTypeMaterial HandshakeType_ServerKeyXchg   = True
 finishHandshakeTypeMaterial HandshakeType_CertRequest     = True
 finishHandshakeTypeMaterial HandshakeType_CertVerify      = False
 finishHandshakeTypeMaterial HandshakeType_Finished        = True
+finishHandshakeTypeMaterial HandshakeType_NPN             = True
 
 finishHandshakeMaterial :: Handshake -> Bool
 finishHandshakeMaterial = finishHandshakeTypeMaterial . typeOfHandshake

Network/TLS/Struct.hs

@@ -205,6 +205,7 @@ data HandshakeType =
 	| HandshakeType_CertVerify
 	| HandshakeType_ClientKeyXchg
 	| HandshakeType_Finished
+	| HandshakeType_NPN -- Next Protocol Negociation extension
 	deriving (Show,Eq)
 
 data ServerDHParams = ServerDHParams
@@ -239,6 +240,7 @@ data Handshake =
 	| CertRequest [CertificateType] (Maybe [ (HashAlgorithm, SignatureAlgorithm) ]) [Word8]
 	| CertVerify [Word8]
 	| Finished FinishedData
+	| NextProtocolNegociation Bytes -- NPN extension
 	deriving (Show,Eq)
 
 packetType :: Packet -> ProtocolType
@@ -248,16 +250,17 @@ packetType ChangeCipherSpec = ProtocolType_ChangeCipherSpec
 packetType (AppData _)      = ProtocolType_AppData
 
 typeOfHandshake :: Handshake -> HandshakeType
-typeOfHandshake (ClientHello _ _ _ _ _ _) = HandshakeType_ClientHello
-typeOfHandshake (ServerHello _ _ _ _ _ _) = HandshakeType_ServerHello
-typeOfHandshake (Certificates _)          = HandshakeType_Certificate
-typeOfHandshake (HelloRequest)            = HandshakeType_HelloRequest
-typeOfHandshake (ServerHelloDone)         = HandshakeType_ServerHelloDone
-typeOfHandshake (ClientKeyXchg _)         = HandshakeType_ClientKeyXchg
-typeOfHandshake (ServerKeyXchg _)         = HandshakeType_ServerKeyXchg
-typeOfHandshake (CertRequest _ _ _)       = HandshakeType_CertRequest
-typeOfHandshake (CertVerify _)            = HandshakeType_CertVerify
-typeOfHandshake (Finished _)              = HandshakeType_Finished
+typeOfHandshake (ClientHello {})             = HandshakeType_ClientHello
+typeOfHandshake (ServerHello {})             = HandshakeType_ServerHello
+typeOfHandshake (Certificates {})            = HandshakeType_Certificate
+typeOfHandshake HelloRequest                 = HandshakeType_HelloRequest
+typeOfHandshake (ServerHelloDone)            = HandshakeType_ServerHelloDone
+typeOfHandshake (ClientKeyXchg {})           = HandshakeType_ClientKeyXchg
+typeOfHandshake (ServerKeyXchg {})           = HandshakeType_ServerKeyXchg
+typeOfHandshake (CertRequest {})             = HandshakeType_CertRequest
+typeOfHandshake (CertVerify {})              = HandshakeType_CertVerify
+typeOfHandshake (Finished {})                = HandshakeType_Finished
+typeOfHandshake (NextProtocolNegociation {}) = HandshakeType_Finished
 
 numericalVer :: Version -> (Word8, Word8)
 numericalVer SSL2  = (2, 0)
@@ -319,6 +322,7 @@ instance TypeValuable HandshakeType where
 	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

README.md

@@ -21,5 +21,5 @@ Features
 * supported versions: SSL3, TLS1.0, TLS1.1, TLS1.2.
 * key exchange supported: only RSA.
 * bulk algorithm supported: any stream or block ciphers.
-* supported extensions: secure renegociation
+* supported extensions: secure renegociation, next protocol renegociation (draft 2)