Running websockets Haskell example, show below, obviously does not work since there is no main function.
running ghc --make Main.hs -o Main confirms that
Meow function requires websockets connection. How to open the connection?
The library used is https://github.com/jaspervdj/websockets.
{-# LANGUAGE OverloadedStrings #-}
import Control.Monad (forever)
import qualified Data.Text as T
import qualified Network.WebSockets as WS
meow :: WS.Connection -> IO ()
meow conn = forever $ do
msg <- WS.receiveData conn
WS.sendTextData conn $ msg `T.append` ", meow"
If you have a look at the example folder:
https://github.com/jaspervdj/websockets/blob/master/example/client.hs
main = withSocketsDo $ WS.runClient "echo.websocket.org"
80 "/" app
app is of type app :: WS.ClientApp () which is a synonym for Connection -> IO a
runClient will open the socket connection for you. If you want to know how, take a look at the source of the function (https://hackage.haskell.org/package/websockets-0.9.3.0/docs/src/Network-WebSockets-Client.html#runClient).
As an aside, withSocketDo belongs to socket. You will find the explanation here: https://hackage.haskell.org/package/network-2.6.0.2/docs/Network-Socket.html#v:withSocketsDo
There are other examples here: http://jaspervdj.be/websockets/example.html
I haven't used websocket and it is usually not such a good idea to answer unfamiliar topic. Hope to be of some help.
Related
I tried building a simple client-server program following this tutorial about Haskell's network-conduit library.
This is the client, which concurrently sends a file to the server and receives the answer:
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent.Async (concurrently)
import Data.Functor (void)
import Conduit
import Data.Conduit.Network
main = runTCPClient (clientSettings 4000 "localhost") $ \server ->
void $ concurrently
(runConduitRes $ sourceFile "input.txt" .| appSink server)
(runConduit $ appSource server .| stdoutC)
And this is the server, which counts the occurrences of each word and sends the result back to the client:
{-# LANGUAGE OverloadedStrings #-}
import Data.ByteString.Char8 (pack)
import Data.Foldable (toList)
import Data.HashMap.Lazy (empty, insertWith)
import Data.Word8 (isAlphaNum)
import Conduit
import Data.Conduit.Network
import qualified Data.Conduit.Combinators as CC
main = runTCPServer (serverSettings 4000 "*") $ \appData -> do
hashMap <- runConduit $ appSource appData
.| CC.splitOnUnboundedE (not . isAlphaNum)
.| foldMC insertInHashMap empty
runConduit $ yield (pack $ show $ toList hashMap)
.| iterMC print
.| appSink appData
insertInHashMap x v = do
return (insertWith (+) v 1 x)
The problem is that the server doesn't reach the yield phase until I manually shut down the client and therefore never answers to it. I noticed that removing the concurrency from the client and keeping only the part in which it sends data to the server, everything works fine.
So, how can I preserve the receiving part of the client without breaking the flow?
You have a deadlock: the client is waiting for the server to respond before it closes the connection, but the server is unaware that the client is done sending data and is waiting for more. This is basically the problem described at https://cr.yp.to/tcpip/twofd.html:
When the generate-data program finishes, the same fd is still open in the consume-data program, so the kernel has no idea that it should send a FIN.
In your case, the fix needs to go on the client side. You need to call shutdown with ShutdownSend on the socket once conduit is done sending the contents of input.txt over it.
Here's one way to do so (I'm not sure if there's a nicer one):
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent.Async (concurrently)
import Data.Functor (void)
import Data.Foldable (traverse_)
import Conduit
import Data.Conduit.Network
import Data.Streaming.Network (appRawSocket)
import Network.Socket (shutdown, ShutdownCmd(..))
main = runTCPClient (clientSettings 4000 "localhost") $ \server ->
void $ concurrently
((runConduitRes $ sourceFile "input.txt" .| appSink server) >> doneWriting server)
(runConduit $ appSource server .| stdoutC)
doneWriting = traverse_ (`shutdown` ShutdownSend) . appRawSocket
Side note: you don't really need concurrency in the client in this case, since there will never be anything to read from the server until you're done writing to the server. You could just do the reading after the writing and shutdown.
I have a simple forked conduit setup, with two inputs feeding one single output....
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent (threadDelay)
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import qualified Data.ByteString as B
import Data.Conduit
import Data.Conduit.TMChan
import Data.Conduit.Network
main::IO ()
main = do
runTCPClient (clientSettings 3000 "127.0.0.1") $ \server -> do
runResourceT $ do
input <- mergeSources [
transPipe liftIO (appSource server),
infiniteSource
] 2
input $$ transPipe liftIO (appSink server)
infiniteSource::MonadIO m=>Source m B.ByteString
infiniteSource = do
liftIO $ threadDelay 10000000
yield "infinite source"
infiniteSource
(here I connect to a tcp socket, then combine the socket input with a timed infinite source, then respond back to the socket)
This works great, until the connection is dropped.... Because the second input still exists, the conduit keeps running. (In this case, the program does end when the timed input fires and there is no socket to write to, but this isn't always the case in my real example).
What is the proper way to shut down the full conduit when one of the inputs is closed?
I tried to brute force a crash by adding the following
crashOnEndOfStream::MonadIO m=>Conduit B.ByteString m B.ByteString
crashOnEndOfStream = do
awaitForever $ yield
error "the peer connection has disconnected" --tried with error
liftIO $ exitWith ExitSuccess --also tried with exitWith
but because the input conduit runs in a thread, the executable was immune to runtime exceptions shutting it down (plus, there is probably a smoother way to shut stuff down than halting the program).
the Source created by mergeSources keeps a count of unclosed sources. It's only closed when the count reaches 0 i.e. every upstream source is closed. This mechanism and the underlying TBMChannel is hidden from user code so you have no way to change its behavior.
One possible solution is to create the channel and the source manually with some medium-level functions exported by Data.Conduit.TMChan, so you can finalize the source by closing the TBMChannel. I haven't tested the code below since your program is not runnable on my machine.
{-# LANGUAGE OverloadedStrings #-}
import Control.Concurrent (threadDelay)
import Control.Monad.IO.Class
import Control.Monad.Trans.Resource
import qualified Data.ByteString as B
import Data.Conduit
import Data.Conduit.Network
import Data.Conduit.TMChan
main::IO ()
main = do
runTCPClient (clientSettings 3000 "127.0.0.1") $ \server -> do
runResourceT $ do
-- create the TBMChannel
chan <- liftIO $ newTBMChanIO 2
let
-- everything piped to the sink will appear at the source
chanSink = sinkTBMChan chan True
chanSource = sourceTBMChan chan
tid1 <- resourceForkIO $ appSource server $$ chanSink
tid2 <- resourceForkIO $ infiniteSource $$ chanSink
chanSource $$ transPipe liftIO (appSink server)
-- and call 'closeTBMChan chan' when you want to exit.
-- 'chanSource' will be closed when the underlying TBMChannel is closed.
infiniteSource :: MonadIO m => Source m B.ByteString
infiniteSource = do
liftIO $ threadDelay 10000000
yield "infinite source"
infiniteSource
I am experimenting with Conduit Network and I cannot compile this code because it is cannot find the data constructor: HostAny
conduit-extra is installed so I am very puzzled why it cannot find it?
{-# LANGUAGE ScopedTypeVariables #-}
import Data.Conduit
import Data.Conduit.Network
serverApp :: AppData -> IO ()
serverApp d = do appSource d $$ appSink d
main :: IO()
main = runTCPServer (serverSettings 8900 HostAny) serverApp
Here's the GHC error:
pez#devbox:~/dev$ runhaskell server.hs
server.hs:10:42: Not in scope: data constructor `HostAny'
If you look at the documentation for conduit-extras, you'll see
data HostPreference
Which host to bind.
Note: The IsString instance recognizes the following special values:
* means HostAny
*4 means HostIPv4
!4 means HostIPv4Only
*6 means HostIPv6
!6 means HostIPv6Only
Which tells me that you should be using the extension OverloadedStrings and then you can just write your code as
main = runTCPServer (serverSettings 8900 "*") serverApp
Although I have to say that is a strange API this library has chosen. I personally would much rather have the ability to use IsString or an explicit constructor in cases where I don't want to use OverloadedStrings for whatever reason.
Using the websockets library in the following way
{-# LANGUAGE OverloadedStrings #-}
module Main where
import System.IO
import System.IO.Unsafe
import Network.Socket hiding (recv)
import Network.WebSockets
import Network.Socket.ByteString
import qualified Data.ByteString.Char8 as B
import Debug.Trace
import Control.Applicative
fetch :: IO B.ByteString
fetch = do
B.putStrLn "connected"
[v4] <- getAddrInfo Nothing (Just "127.0.0.1") (Just "3000")
c <- socket (addrFamily v4) Stream 0x6
c `connect` (addrAddress v4)
recv c 512000
proxy :: TextProtocol p => WebSockets p ()
proxy = sendTextData . unsafePerformIO $! fetch
app :: Request -> WebSockets Hybi00 ()
app r = acceptRequest r >> r `traceShow` proxy
main :: IO ()
main = withSocketsDo $! runServer "0.0.0.0" 4000 app
causes fetch to occur only once and all websocket clients receive the same not fresh data.
How can I do arbitrary IO with websockets?
How can I get the above example to work with fresh fetches?
I would love to hear any suggestions or complete solutions. A way of doing it without touching iteratee would be exceptionally appreciated.
The WebSockets monad is an instance of the MonadIO typeclass, so you can do arbitrary IO-operations with the liftIO function.
In this case I'm guessing you want to do
proxy = liftIO fetch >>= sendTextData
You also need to add the import
import Control.Monad.IO.Class
I'm trying to understand how to write a web service using warp that has a long lived resource that I want access to from all my requests (i.e. I want the resource to exist for the life time of server, not per request). I'm assuming this is a use for ResourceT, but I'm unsure how I actually do this.
My particular use is that I want to expose a file handle, that I currently have wrapped up in the state monad. I'm happy to change this approach, if this doesn't make sense when using warp and ResourceT. An early version of this code can be seen on code review: https://codereview.stackexchange.com/questions/9177/my-simple-haskell-key-value-file-store
Thanks in advance,
Matt
The most obvious way is to pass the file handle in as a parameter to the Application.
import Control.Monad.Trans (liftIO)
import Data.ByteString.Lazy as Bl
import Network.HTTP.Types
import Network.Wai
import Network.Wai.Handler.Warp as Warp
import System.IO
doSomethingWithAFileHandle :: Handle -> IO ()
doSomethingWithAFileHandle =
undefined -- insert your logic here
app :: Handle -> Application
app h req = do
let headers = []
body = Bl.empty
liftIO $ doSomethingWithAFileHandle h
return $! responseLBS ok200 headers body
main :: IO ()
main =
-- get some file handle
withBinaryFile "/dev/random" ReadMode $ \ h ->
-- and then partially apply it to get an Application
Warp.run 3000 (app h)