💾 Archived View for gemini.thegonz.net › resumeTest.hs captured on 2024-02-05 at 10:00:46.
⬅️ Previous capture (2022-03-01)
-=-=-=-=-=-=-
{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Concurrent (threadDelay) import Data.Default.Class (def) import Data.Maybe (fromMaybe) import Data.PEM import Data.X509 import Data.X509.Validation import Network.Socket import Network.TLS import Network.TLS.Extra.Cipher import Control.Monad.Trans.Maybe (MaybeT (..), runMaybeT) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BL import qualified Data.ByteString.Lazy.Char8 as BLC import qualified Network.Simple.TCP as TCP import qualified Network.TLS.SessionManager as SM main = do Right cred <- credentialLoadX509 "test.cert" "test.key" serve cred "1956" serve :: Credential -> String -- ^Port -> IO () serve cred port = do sessionManager <- SM.newSessionManager SM.defaultConfig let params = def { serverShared = def { sharedSessionManager = sessionManager , sharedCredentials = Credentials [cred] } , serverEarlyDataSize = 1024 , serverSupported = def { supportedCiphers = gemini_ciphersuite } , serverHooks = def { onUnverifiedClientCert = return True , onClientCertificate = \_ -> return CertificateUsageAccept } , serverWantClientCert = False } TCP.serve TCP.HostAny port $ \(sock,_) -> do context <- contextNew sock params handshake context recvData context Just info <- contextGetInformation context mode <- runMaybeT $ do info <- MaybeT $ contextGetInformation context MaybeT . return $ infoTLS13HandshakeMode info sendData context . BLC.pack $ "20 text/gemini\r\nHandshake type: " <> case mode of Just FullHandshake -> "Full handshake.\r\nThis is the most expensive way to make a request. To see if your client supports resuming, refresh this page and see if it uses a different handshake type." Just HelloRetryRequest -> "Full handshake with hello retry request.\r\nWeird." Just PreSharedKey -> "Pre-shared key.\r\nGood! This is the basic type of TLS resumption, much cheaper than a full handshake. For bonus points, you might consider getting your client to support RTT0 (early data)." Just RTT0 -> "RTT0 (early data).\r\nNice. This is the cheapest and fastest way to make a request." _ -> "BUG!" bye context gracefulClose sock 5000 gemini_ciphersuite :: [Cipher] gemini_ciphersuite = [ -- First the PFS + GCM + SHA2 ciphers cipher_ECDHE_ECDSA_AES128GCM_SHA256, cipher_ECDHE_ECDSA_AES256GCM_SHA384 , cipher_ECDHE_ECDSA_CHACHA20POLY1305_SHA256 , cipher_ECDHE_RSA_AES128GCM_SHA256, cipher_ECDHE_RSA_AES256GCM_SHA384 , cipher_ECDHE_RSA_CHACHA20POLY1305_SHA256 , cipher_DHE_RSA_AES128GCM_SHA256, cipher_DHE_RSA_AES256GCM_SHA384 , cipher_DHE_RSA_CHACHA20POLY1305_SHA256 , -- Next the PFS + CCM + SHA2 ciphers cipher_ECDHE_ECDSA_AES128CCM_SHA256, cipher_ECDHE_ECDSA_AES256CCM_SHA256 , cipher_DHE_RSA_AES128CCM_SHA256, cipher_DHE_RSA_AES256CCM_SHA256 -- Next the PFS + CBC + SHA2 ciphers , cipher_ECDHE_ECDSA_AES128CBC_SHA256, cipher_ECDHE_ECDSA_AES256CBC_SHA384 , cipher_ECDHE_RSA_AES128CBC_SHA256, cipher_ECDHE_RSA_AES256CBC_SHA384 , cipher_DHE_RSA_AES128_SHA256, cipher_DHE_RSA_AES256_SHA256 -- TLS13 (listed at the end but version is negotiated first) , cipher_TLS13_AES128GCM_SHA256 , cipher_TLS13_AES256GCM_SHA384 , cipher_TLS13_CHACHA20POLY1305_SHA256 , cipher_TLS13_AES128CCM_SHA256 ]