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.
Related
Let’s say I have this:
main = do
void (forkIO (forever $ (threadDelay 10000) >> callCommand "hwclock --systohc"))
let loop = do
mytime <- getCurrentTime
if (mytime > (fromJust(parseISO8601 “2021-12-10T13:10:09+0000”))) then (print “hello”) else ((threadDelay 100) >> loop)
loop
Is there any serious issue that can happen here relating to the time potentially being synced at the same time as when I request the time with getCurrentTime?
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.
Consider something like this:
...
handleShutdown :: ThreadId -> IO ()
handleShutdown tid = doSomethingFunny >> throwTo tid ExitSuccess
main = do
...
installHandler sigTERM (Catch $ myThreadId >>= handleShutdown) Nothing
forever $ do
stuff
...
If sigINT (Ctrl+C) is handled in this manner, the process finishes nicely. However, it seems like sigTERM is being used by Haskell internally and the code above doesn't exit from the main process at all. Is there a way to exit the process from a sigTERM handler without using an MVar and a custom loop? I couldn't find any information on the sigTERM handling anywhere (didn't read ghc sources, that's just too much for me to handle).
Update:
The following works:
main = do
...
tid <- myThreadId -- This moved out of the Catch handler below.
installHandler sigTERM (Catch $ handleShutdown tid) Nothing
forever $ do
stuff
...
Sorry for short answer, but on mobile.
You want to run myThreadId from outside of the handler itself to get the main thread's ID. You're currently getting the ID of the signal handler itself.
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
My main function has one infinite loop and I'd like to execute each loop of it every 100 millisecond. I know it's done by some concurrent or parallel method, but I've never done such things before and have no idea even where to start from. How would you implement such function?
Assuming your loop body takes negligible time, just use threadDelay from Control.Concurrent:
import Control.Concurrent
main = forever $ do
mainBody
threadDelay (100*1000) -- value in microseconds
Update: To account for the time of your loop body, use this:
import Data.Time.Clock
import Control.Concurrent
import Control.Monad
mainBody :: IO ()
mainBody = putStrLn "hi"
main = forever $ do
start <- getCurrentTime
mainBody
end <- getCurrentTime
let diff = diffUTCTime end start
usecs = floor (toRational diff * 1000000) :: Int
delay = 100*1000 - usecs
if delay > 0
then threadDelay delay
else return ()
Haskell's threads are light-weight, so a quick solution would be to fork on each cycle. Thus you'll end up using the main thread as a manager of worker threads, which ensures that a worker gets spawned every 100 micros.
import Control.Concurrent
main =
forever $ do
forkIO $ loopCycle
threadDelay $ 100 * 10^3
In case you care about exceptions not getting lost and getting reraised in the main thread instead, I recommend taking a look at the "slave-thread" package. Actually, I'd recommend to use that package instead of forkIO and brothers by default, but then I'm the author so I might be subjective.
Also note that the above solution might cause an accumulation of worker threads in case the loopCycle will take longer than 100 micros to execute too often. To protect against such a scenario, you can implement a strategy in the manager thread, which will ensure that the number of active workers is limited. Following is how such a strategy could be implemented:
-- From the "SafeSemaphore" package
import qualified Control.Concurrent.SSem as Sem
main =
manager 12 (100 * 10^3) $ putStrLn "Implement me!"
manager :: Int -> Int -> IO () -> IO ()
manager limit delay worker =
do
sem <- Sem.new limit
forever $ do
forkIO $ Sem.withSem sem $ worker
threadDelay delay
You could use sleep to pause the loop at the end of every iteration for 100 milliseconds. https://www.haskell.org/hoogle/?q=sleep