Skip to content

Instantly share code, notes, and snippets.

Created December 5, 2013 05:32
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
Star You must be signed in to star a gist
What would you like to do?
connects to wss:// fine, but fails with wss://
{-# LANGUAGE OverloadedStrings #-}
import Control.Exception
import Control.Monad
import Control.Monad.IO.Class
import qualified Network.Socket as S
import System.IO (IOMode (ReadWriteMode))
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
import qualified Data.Text as T
import qualified Data.Text.IO as T
import Crypto.Random.AESCtr (makeSystem)
import Network.TLS (TLSCtx)
import qualified Network.TLS as TLS
import qualified Network.TLS.Extra as TLS
import System.IO.Streams (InputStream, OutputStream)
import qualified System.IO.Streams as Streams
import qualified Network.WebSockets as WS
app :: WS.ClientApp ()
app conn = do
putStrLn "connected"
forever $ do
msg <- WS.receiveData conn
liftIO $ T.putStrLn msg
main :: IO ()
main = do
let host = ""
port = 443
path = "/"
sock <- S.socket S.AF_INET S.Stream S.defaultProtocol
addrInfos <- S.getAddrInfo (Just hints) (Just host) (Just $ show port)
S.connect sock (S.addrAddress $ head addrInfos)
handle <- S.socketToHandle sock ReadWriteMode
systemRandom <- makeSystem
tlsctx <- TLS.contextNewOnHandle handle params systemRandom
TLS.handshake tlsctx
prot <- TLS.getNegotiatedProtocol tlsctx
streams <- makeTLSStreams tlsctx
WS.runClientWithStream streams host path opts [] app
TLS.contextClose tlsctx
hints = S.defaultHints { S.addrFamily = S.AF_INET
, S.addrSocketType = S.Stream }
opts = WS.defaultConnectionOptions
params = TLS.defaultParamsClient { TLS.pCiphers = TLS.ciphersuite_all }
makeTLSStreams :: TLSCtx
-> IO (InputStream B.ByteString, OutputStream B.ByteString)
makeTLSStreams tlsctx = do
is <- Streams.makeInputStream input
os <- Streams.makeOutputStream output
return $! (is, os)
input = do
recv <- try $ TLS.recvData tlsctx
case recv of
Right bs -> return $! if B.null bs then Nothing else Just bs
Left e ->
case e of
TLS.Error_EOF -> return Nothing
output Nothing = return $! ()
output (Just bs) = TLS.sendData tlsctx (L.fromStrict bs)
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment