@hackage peyotls0.0.0.18

Currently implemente the TLS1.2 protocol 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

And support client certificate with the following algorithms.

• RSA (SHA1 or SHA256 depending on the agreed cipher suite)

• ECDSA (SHA1 or SHA256 depending on the agreed cipher suite)

And support secure renegotiation partially

• server can recieve client-initiated renegotiation

• can not send renegotiation from my client

• no server-initiated renegotiation

Currently not implemente the following features.

• session resumption (RFC 5077)

• renegotiation (RFC 5746): partially

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 ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca
		unless ("localhost" `elem` names p) $
			error "certificate name mismatch"
		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 ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca
---
>		p <- open h ["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 ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(rk, rc)] ca
---
>		p <- open h ["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 ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca
---
>               p <- open h cipherSuites [] ca