peyotls

Currently implement the TLS1.2 protocol (RFC 5246, RFC 4492) only, and support the following cipher suites.

• TLS_RSA_WITH_AES_128_CBC_SHA

• TLS_RSA_WITH_AES_128_CBC_SHA256

• TLS_DHE_RSA_WITH_AES_128_CBC_SHA

• TLS_DHE_RSA_WITH_AES_128_CBC_SHA256

• TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA

• TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256

• TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA

• TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256

implement the following curves

• SEC p256r1

And support client certificate with the following algorithms.

• RSA with SHA256

• ECDSA with SHA256

And support secure renegotiation (RFC 5746)

Currently not implement the following features.

• session resumption (RFC 5077)

• curves other than SEC p256r1

Server sample

• file: examples/simpleServer.hs

localhost.key: key file

-----BEGIN RSA PRIVATE KEY-----
...
-----END RSA PRIVATE KEY-----

localhost.crt: certificate file

-----BEGIN CERTIFICATE-----
...
-----END CERTIFICATE-----

examples/simpleServer.hs

extensions

• OverloadedStrings

• PackageImports

 import Control.Applicative
 import Control.Monad
 import "monads-tf" Control.Monad.State
 import Control.Concurrent
 import Data.HandleLike
 import Network
 import Network.PeyoTLS.Server
 import Network.PeyoTLS.ReadFile
 import "crypto-random" Crypto.Random

 import qualified Data.ByteString as BS
 import qualified Data.ByteString.Char8 as BSC

 main :: IO ()
 main = do
	k <- readKey "localhost.key"
	c <- readCertificateChain ["localhost.crt"]
	g0 <- cprgCreate <$> createEntropyPool :: IO SystemRNG
	soc <- listenOn $ PortNumber 443
	void . (`runStateT` g0) . forever $ do
		(h, _, _) <- liftIO $ accept soc
		g <- StateT $ return . cprgFork
		liftIO . forkIO . (`run` g) $ do
			p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(k, c)]
				Nothing
			doUntil BS.null (hlGetLine p) >>= liftIO . mapM_ BSC.putStrLn
			hlPut p $ BS.concat [
				"HTTP/1.1 200 OK\r\n",
				"Transfer-Encoding: chunked\r\n",
				"Content-Type: text/plain\r\n\r\n",
				"5\r\nHello0\r\n\r\n" ]
			hlClose p

 doUntil :: Monad m => (a -> Bool) -> m a -> m [a]
 doUntil p rd = rd >>= \x ->
	(if p x then return . (: []) else (`liftM` doUntil p rd) . (:)) x

Client sample (only show HTTP header)

• file: examples/simpleClient.hs

cacert.pem: self-signed root certificate to validate server

-----BEGIN CERTIFICATE-----
...
-----END CERTIFICATE-----

examples/simpleClient.hs

extensions

• OverloadedStrings

• PackageImports

 import Control.Applicative
 import Control.Monad
 import "monads-tf" Control.Monad.Trans
 import Data.HandleLike
 import Network
 import Network.PeyoTLS.ReadFile
 import Network.PeyoTLS.Client
 import "crypto-random" Crypto.Random

 import qualified Data.ByteString.Char8 as BSC

 main :: IO ()
 main = do
 	ca <- readCertificateStore ["cacert.pem"]
 	h <- connectTo "localhost" $ PortNumber 443
 	g <- cprgCreate <$> createEntropyPool :: IO SystemRNG
 	(`run` g) $ do
 		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca
		nms <- getNames p
 		hlPut p "GET / HTTP/1.1 \r\n"
 		hlPut p "Host: localhost\r\n\r\n"
 		doUntil BSC.null (hlGetLine p) >>= liftIO . mapM_ BSC.putStrLn
 		hlClose p

 doUntil :: Monad m => (a -> Bool) -> m a -> m [a]
 doUntil p rd = rd >>= \x ->
 	(if p x then return . (: []) else (`liftM` doUntil p rd) . (:)) x

Client certificate server

• file: examples/clcertServer.hs

% diff examples/simpleServer.hs examples/clcertServer.hs
19a20
>	ca <- readCertificateStore ["cacert.pem"]
27c28
<				Nothing
---
>				$ Just ca

Client certificate client (RSA certificate)

• file: examples/clcertClient.hs

% diff examples/simpleClient.hs examples/clcertClient.hs
15a16,17
>	rk <- readKey "client_rsa.key"
>	rc <- readCertificateChain ["client_rsa.crt"]
20c22
<		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca
---
>		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(rk, rc)] ca

Client certificate client (ECDSA or RSA certificate)

• file: examples/clcertEcdsaClient.hs

% diff examples/clcertClient.hs examples/clcertEcdsaClient.hs
17a18,19
>	ek <- readKey "client_ecdsa.key"
>	ec <- readCertificateChain ["client_ecdsa.crt"]
22c24
<		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(rk, rc)] ca
---
>		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(ek, ec), (rk, rc)] ca

ECC server (use ECC or RSA depending on client)

• file: examples/eccServer.hs

% diff examples/simpleServer.hs examples/eccServer.hs
15a16,26
> cipherSuites :: [CipherSuite]
> cipherSuites = [
>       "TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256",
>       "TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA",
>       "TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256",
>       "TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA",
>       "TLS_DHE_RSA_WITH_AES_128_CBC_SHA256",
>       "TLS_DHE_RSA_WITH_AES_128_CBC_SHA",
>       "TLS_RSA_WITH_AES_128_CBC_SHA256",
>       "TLS_RSA_WITH_AES_128_CBC_SHA" ]
>
18,19c29,32
<       k <- readKey "localhost.key"
<       c <- readCertificateChain ["localhost.crt"]
---
>       rk <- readKey "localhost.key"
>       rc <- readCertificateChain ["localhost.crt"]
>       ek <- readKey "localhost_ecdsa.key"
>       ec <- readCertificateChain ["localhost_ecdsa.crt"]
26c39
<                       p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(k, c)]
---
>                       p <- open h cipherSuites [(rk, rc), (ek, ec)]

ECC client (use ECC or RSA depending on server)

• file: examples/eccClient.hs

% diff examples/simpleClient.hs examples/eccClient.hs
13a14,24
> cipherSuites :: [CipherSuite]
> cipherSuites = [
>       "TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA256",
>       "TLS_ECDHE_ECDSA_WITH_AES_128_CBC_SHA",
>       "TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA256",
>       "TLS_ECDHE_RSA_WITH_AES_128_CBC_SHA",
>       "TLS_DHE_RSA_WITH_AES_128_CBC_SHA256",
>       "TLS_DHE_RSA_WITH_AES_128_CBC_SHA",
>       "TLS_RSA_WITH_AES_128_CBC_SHA256",
>       "TLS_RSA_WITH_AES_128_CBC_SHA" ]
>
20c31
<               p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca
---
>               p <- open' h "localhost" cipherSuites [] ca