I am using the wuss library ( a wrapper around websockets) to create a websocket connection. How would one create loop to reconnect if for whatever reason the web socket disconnects?
ws :: ClientApp ()
ws connection = do
putStrLn "Connected!"
sendTextData connection msgSubscribe -- defined elsewhere
let loop = do
message <- receiveData connection
print (message)
loop
loop
sendClose connection (pack "Bye!")
main :: IO ()
main = runSecureClient "ws.kraken.com" 443 "/" ws -- retry at this point?
How to "retry" is protocol dependent. If you literally just want to retry from start when there's a connection failure you could just do
{-# LANGUAGE ScopedTypeVariables #-}
import Control.Exception (catch)
-- ...
-- the rest of your code
-- ...
retryOnFailure ws = runSecureClient "ws.kraken.com" 443 "/" ws
`catch` (\e ->
if e == ConnectionClosed
then retryOnFailure ws
else return ())
but note that this is a "dumb" retry in that it'll literally just start over from scratch if the remote connection is closed unexpectedly (expected closes will lead to the program ending). If you want to maintain any sort of state or anything like that you'll have to figure out how to do that for whatever protocol you're following, but this should be enough if you're just listening for data over some flaky connection.
Related
I'm running into an error of *** Exception: Network.Socket.sendBuf: invalid argument (Transport endpoint is not connected) when calling Network.Socket.ByteString.sendAll (hackage docs - sendall) from the socket server (to send to the socket client).
I'm not sure why I get this error? Seems I can only send the data one way?
I also run into the same error when using netcat, instead of the Haskell client:
echo 'test' | nc -N -U /tmp2/test2.soc
Output from client:
*Server Main> main
Hello, Haskell!2
"sent ping....."
Output from the server:
*Server> serv
"begin"
"Running daemon"
"begin2"
<socket: 13>
"Got message:"
"ping"
"Sending pong...."
*** Exception: Network.Socket.sendBuf: invalid argument (Transport endpoint is not connected)
Complete project: https://github.com/chrissound/UnixSocketPingPongHaskellTest
Full source code:
client:
{-# Language OverloadedStrings #-}
module Main where
import Network.Socket hiding (send)
import Network.Socket.ByteString as NBS
import Control.Concurrent
import Control.Monad
main :: IO ()
main = do
putStrLn "Hello, Haskell!2"
withSocketsDo $ do
soc <- socket AF_UNIX Stream 0
connect (soc) (SockAddrUnix "/tmp2/test2.soc")
forever $ do
send soc ("ping")
threadDelay $ 1 * 10^6
print "sent ping....."
threadDelay $ 1 * 10^6
msg <- NBS.recv soc 400000
print msg
print "got reply to ping...."
close soc
server:
{-# Language OverloadedStrings #-}
module Server where
import Network.Socket hiding (send)
import Network.Socket.ByteString as NBS
import Control.Concurrent
import Control.Monad
serv :: IO ()
serv = do
print "begin"
print "Running daemon"
soc <- socket AF_UNIX Stream 0
bind soc . SockAddrUnix $ "/tmp2/test2.soc"
listen soc maxListenQueue
accept soc >>= (\(x,y)-> do
print "begin2"
print x
print y
forever $ do
msg <- NBS.recv x 400000
print "Sending pong...."
NBS.sendAll soc "ppong"
print "alll done"
threadDelay $ 3 * 10^6
)
You are sending on the listening socket; you probably want to send on the accepted socket instead.
listen soc maxListenQueue
accept soc >>= (\(x,y)-> do
...
NBS.sendAll soc "ppong" -- should be sendAll x "ppong"
I'm currently authoring an application in Haskell that relies on Yesod and its web sockets implementation.
I was wondering what is the correct way to acquire and release resources for a WebSocketT handler.
For example, in the following naive case...
chatApp :: WebSocketsT Handler ()
chatApp = do
let outgoingFlow = forever $ deliverOutgoingMessages
let incomingFlow = forever $ deliverIncomingMessages
bracket_ acquireResource
releaseResource
(race_ outgoingFlow incomingFlow)
... releaseResource does not seem to be called when a client disconnects abruptly or purposefully.
This is what I ended up doing over the weekend. This is essentially a replication of how web socket background ping process works, apart for the fact that I'm not swallowing the ping send exception when the other end is no longer reachable, but rather using it to detect the disconnection.
echoApp' :: WebSocketsT Handler ()
echoApp' = do
conn <- ask
let acquire = putStrLn "Acquiring..."
release = putStrLn "Releasing"
hardWork = (threadDelay 600000000)
ping i = do
threadDelay (30 * 1000 * 1000)
WS.sendPing conn (T.pack $ show i)
ping (i + 1)
liftIO $ bracket_ acquire release $ race_ hardWork (ping 1)
The downside of this approach is that there's still an up to 30 seconds window when the web socket process is lingering, but at least the resource gets eventually released in a more or less controllable way.
We have some code to send metrics to a SOCK_DGRAM where another daemon listens and aggregates/proxies these messages. Opening the socket looks like:
sock <- socket
(ai :: AddressInfo Inet Datagram UDP):_ <- getAddressInfo (Just "127.0.0.1") Nothing aiNumericHost
connect s (socketAddress ai) { port }
return sock
And at the moment we write to it like:
send sock payload mempty
I want to ensure the call above doesn't block for very long (or at the very least doesn't block indefinitely), but my understanding of unix sockets is not very deep and I'm having trouble understanding how exactly send blocks, looking at internals here and here.
There is a related question here that was helpful: When a non-blocking send() only transfers partial data, can we assume it would return EWOULDBLOCK the next call?
So my questions specifically are:
General socket question: I see in this implementation send is going to block (after busy-waiting) until there is room in the buffer. How exactly is this buffer related to the consumer? Does this mean send may block indefinitely if our listen-ing daemon is slow or stalls?
If I would rather abort and never block, do I need to make my own fork of System.Socket.Unsafe, or am I missing something?
I'm only concerned with linux here.
EDIT: Also, and what probably got me started with all of this is I find that when the metrics collector is not running, that every other of my send calls above throws a "connection refused" exception. So why that is, or whether it's normal is another question I have.
EDIT2: Here's a complete example illustrating the connection refused issue if anyone would like to help repro:
import Data.Functor
import System.Socket
import System.Socket.Family.Inet
repro :: IO ()
repro = do
let port = 6565
(s :: Socket Inet Datagram UDP) <- socket
(ai :: AddressInfo Inet Datagram UDP):_ <- getAddressInfo (Just "127.0.0.1") Nothing aiNumericHost
connect s (socketAddress ai) { port }
putStrLn "Starting send"
void $ send s "FOO" mempty
void $ send s "BAR" mempty
putStrLn "done"
I'm using socket-0.5.3.0.
EDIT3: this seems to be due to the connect call, somehow. (Testing on sockets latest):
{-# LANGUAGE ScopedTypeVariables, OverloadedStrings, NamedFieldPuns #-}
import Data.Functor
import System.Socket
import System.Socket.Protocol.UDP
import System.Socket.Type.Datagram
import System.Socket.Family.Inet
repro :: IO ()
repro = do
(s :: Socket Inet Datagram UDP) <- socket
-- Uncommenting raises eConnectionRefused, everytime:
-- connect s (SocketAddressInet inetLoopback 6565 :: SocketAddress Inet)
putStrLn "Starting send"
void $ sendTo s "FOO" mempty (SocketAddressInet inetLoopback 6565 :: SocketAddress Inet)
void $ sendTo s "BAR" mempty (SocketAddressInet inetLoopback 6565 :: SocketAddress Inet)
putStrLn "done"
As I understand it we should be able to use connect (at least the underlying syscall) to set the default send address. I haven't dug into the implementation of connect in the library yet.
I've opened this: https://github.com/lpeterse/haskell-socket/issues/55
This isn't a Haskell issue -- it's expected behavior on Linux when sending two UDP packets to a localhost port with no listening process. The following C program:
#include <stdio.h>
#include <sys/socket.h>
#include <sys/types.h>
#include <netinet/in.h>
#include <netinet/udp.h>
int main()
{
int s = socket(AF_INET, SOCK_DGRAM, 0);
struct sockaddr_in dstaddr = { AF_INET, htons(6565), {htonl(0x7f000001)} };
if (connect(s, (struct sockaddr*) &dstaddr, sizeof(dstaddr)))
perror("connect");
if (send(s, "FOO", 3, 0) == -1)
perror("first send");
if (send(s, "BAR", 3, 0) == -1)
perror("second send");
return 0;
}
will print second send: Connection refused, assuming nothing is listening on localhost port 6565.
If you do any one of the following -- (i) send to a non-local host, (ii) drop the connect call and replace the sends with sendtos, or (iii) send packets to a port with a process listening for UDP packets -- then you won't get the error.
The behavior is a little complex and not well documented anywhere, though the manpages for udp(7) hint at it.
You may find the discussion in this Stack Overflow question helpful.
I would like to stream stdin over an HTTP connection using text/event-stream. The Network.Wai.EventSource thing looks like a good candidate.
I tried using this code:
import Network.Wai
import Network.Wai.EventSource
import Network.Wai.Middleware.AddHeaders
import Network.Wai.Handler.Warp (run)
import qualified Data.ByteString.Lazy as L
import qualified Data.ByteString.Lazy.Char8 as C
import Blaze.ByteString.Builder.ByteString
toEvent :: [L.ByteString] -> ServerEvent
toEvent s = ServerEvent {
eventName = Nothing,
eventId = Nothing,
eventData = map fromLazyByteString s
}
createWaiApp :: IO L.ByteString -> Application
createWaiApp input = eventSourceAppIO $ fmap (toEvent . C.lines) input
main :: IO ()
main = run 1337 $ createWaiApp L.getContents
Which (I think) does:
Reads stdin as a Lazy ByteStream
Splits the ByteStream into lines
Produces one ServerEvent for all the lines (this feels wrong - there should presumably be multiple events?)
Builds a WAI Application from the IO ServerEvent
Binds the Application to port 1337
When I run this (e.g. using ping -c 5 example.com | stack exec test-exe) it doesn't respond until the whole of stdin has been read.
How do I build a Wai application that flushes out the HTTP connection every time it reads a line from stdin?
L.getContents is a single IO action, so only one event will be created.
Here is an example of eventSourcEventAppIO where multiple events are created:
import Blaze.ByteString.Builder.Char8 (fromString)
...same imports as above...
nextEvent :: IO ServerEvent
nextEvent = do
s <- getLine
let event = if s == ""
then CloseEvent
else ServerEvent
{ eventName = Nothing
, eventId = Nothing
, eventData = [ fromString s ]
}
case event of
CloseEvent -> putStrLn "<close event>"
ServerEvent _ _ _ -> putStrLn "<server event>"
return event
main :: IO ()
main = run 1337 $ eventSourceAppIO nextEvent
To test, in one window start up the server and in another run the command curl -v http://localhost:1337. For each line you enter in the server window you will get a data frame from curl. Entering a blank line will close the HTTP connection but the server will remain running allowing you to connect to it again.
http://zguide.zeromq.org/hs:asyncsrv
hope to terminate the program by press q to exit
main :: IO ()
main =
runZMQ $ do
async $ clientTask "A"
async $ clientTask "B"
async $ clientTask "C"
async serverTask
liftIO $ threadDelay $ 5 * 1000 * 1000
Process-to-process message passing is the very power of the ZeroMQ, so use it:
design a central aKbdMONITOR-thread, that monitors Keyboard and scans for Q | q
async $ clientTask "C"
async $ aKbdMONITOR -- Add central-service async thread
equip this aKbdMONITOR-thread with a PUB service to broadcast to any SUB-side an appearance of such event
aKbdSCANNER <- socket Pub -- PUB-side adequate ZeroMQ Archetype
bind aKbdSCANNER "tcp://*:8123" -- yes, can serve even for remote hosts
equip all other threads with a SUB pattern part and review any subsequent arriving event-notification from aKbdMONITOR-thread to decide locally about self-termination in case aKbdMONITOR-thread announces such case as requested above to exit
aKbdSCANNER <- socket Sub -- SUB-side adequate ZeroMQ Archetype
connect aKbdSCANNER "tcp://ipKBD:8123" -- tcp transport-class remote ipKBD
--
-- + do not forget to subscribe
-- + use poll to scan