Stream stdin to a Wai.EventSource - haskell

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.

Related

Haskell sendAll message to socket client results in: `Exception: Network.Socket.sendBuf: invalid argument (Transport endpoint is not connected)`

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"

Reconnect web socket [Haskell]

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.

Silencing GHC API output (stdout)

I'm using the GHC API to parse a module. If the module contains syntax errors the GHC API writes them to stdout. This interferes with my program, which has another way to report errors. Example session:
$ prog ../stack/src/Stack/Package.hs
../stack/src/Stack/Package.hs:669:0:
error: missing binary operator before token "("
#if MIN_VERSION_Cabal(1, 22, 0)
^
../stack/src/Stack/Package.hs:783:0:
error: missing binary operator before token "("
#if MIN_VERSION_Cabal(1, 22, 0)
^
../stack/src/Stack/Package.hs
error: 1:1 argon: phase `C pre-processor' failed (exitcode = 1)
Only the last one should be outputted. How can I make sure the GHC API does not output anything? I'd like to avoid libraries like silently which solve the problem by redirecting stdout to a temporary file.
I already tried to use GHC.defaultErrorHandler, but while I can catch the exception, GHC API still writes to stdout. Relevant code:
-- | Parse a module with specific instructions for the C pre-processor.
parseModuleWithCpp :: CppOptions
-> FilePath
-> IO (Either (Span, String) LModule)
parseModuleWithCpp cppOptions file =
GHC.defaultErrorHandler GHC.defaultFatalMessager (GHC.FlushOut $ return ()) $
GHC.runGhc (Just libdir) $ do
dflags <- initDynFlags file
let useCpp = GHC.xopt GHC.Opt_Cpp dflags
fileContents <-
if useCpp
then getPreprocessedSrcDirect cppOptions file
else GHC.liftIO $ readFile file
return $
case parseFile dflags file fileContents of
GHC.PFailed ss m -> Left (srcSpanToSpan ss, GHC.showSDoc dflags m)
GHC.POk _ pmod -> Right pmod
Moreover, with this approach I cannot catch the error message (I just get ExitFailure). Removing the line with GHC.defaultErrorHandler gives me the output shown above.
Many thanks to #adamse for pointing me in the right direction! I have found the answer in Hint's code.
It suffices to override logging in the dynamic flags:
initDynFlags :: GHC.GhcMonad m => FilePath -> m GHC.DynFlags
initDynFlags file = do
dflags0 <- GHC.getSessionDynFlags
src_opts <- GHC.liftIO $ GHC.getOptionsFromFile dflags0 file
(dflags1, _, _) <- GHC.parseDynamicFilePragma dflags0 src_opts
let dflags2 = dflags1 { GHC.log_action = customLogAction }
void $ GHC.setSessionDynFlags dflags2
return dflags2
customLogAction :: GHC.LogAction
customLogAction dflags severity _ _ msg =
case severity of
GHC.SevFatal -> fail $ GHC.showSDoc dflags msg
_ -> return () -- do nothing in the other cases (debug, info, etc.)
The default implementation of GHC.log_action can be found here:
http://haddock.stackage.org/lts-3.10/ghc-7.10.2/src/DynFlags.html#defaultLogAction
The code for parsing remains the same in my question, after having removed the line about GHC.defaultErrorHandler, which is no longer needed, assuming one catches exceptions himself.
I have seen this question before and then the answer was to temporarily redirect stdout and stderr.
To redirect stdout to a file as an example:
import GHC.IO.Handle
import System.IO
main = do file <- openFile "stdout" WriteMode
stdout' <- hDuplicate stdout -- you might want to keep track
-- of the original stdout
hDuplicateTo file stdout -- makes the second Handle a
-- duplicate of the first
putStrLn "hi"
hClose file

Haskell serialport retrieve data and print

I'm trying the Serialport package to send some AT commands to COM6
import qualified Data.ByteString.Char8 as B
import System.Hardware.Serialport
let port = "COM6" -- Windows
s <- openSerial port defaultSerialSettings { commSpeed = CS2400 }
send s $ B.pack "AT\r"
recv s 10 >>= print
closeSerial s
Does recv s 10 >>= print show me the result of the sent command?
I have tried a few AT commands and couldn't get results.
I'm sure that the openport has succeeded.
After this:
send s $ B.pack "AT\r"
I do get the "\r" as a result.
But when i try send s $ B.pack "AT+CGMI" I get nothing
I have tried to connect with Putty and it works.

Play a wav file with Haskell

Is there a simple, direct way to play a WAV file from Haskell using some library and possibly such that I play many sounds at once?
I'm aware of OpenAL but I'm not writing some advanced audio synthesis program, I just want to play some sounds for a little play thing. Ideally the API might be something like:
readWavFile :: FilePath -> IO Wave
playWave :: Wave -> IO ()
playWaveNonBlocking :: Wave -> IO ()
I'm this close to merely launching mplayer or something. Or trying to cat the wav directly to /dev/snd/ or somesuch.
This is how to play multiple sounds on multiple channels at once with SDL. I think this answers the question criteria. WAV files, simple, Haskell, multiple channels.
import Control.Monad
import Control.Monad.Fix
import Graphics.UI.SDL as SDL
import Graphics.UI.SDL.Mixer as Mix
main = do
SDL.init [SDL.InitAudio]
result <- openAudio audioRate audioFormat audioChannels audioBuffers
classicJungle <- Mix.loadWAV "/home/chris/Samples/ClassicJungle/A4.wav"
realTech <- Mix.loadWAV "/home/chris/Samples/RealTech/A4.wav"
ch1 <- Mix.playChannel anyChannel classicJungle 0
SDL.delay 1000
ch2 <- Mix.playChannel anyChannel realTech 0
fix $ \loop -> do
SDL.delay 50
stillPlaying <- numChannelsPlaying
when (stillPlaying /= 0) loop
Mix.closeAudio
SDL.quit
where audioRate = 22050
audioFormat = Mix.AudioS16LSB
audioChannels = 2
audioBuffers = 4096
anyChannel = (-1)
I realize this is not actually a convenient way to do it, but I had the test code lying around, so...
{-# LANGUAGE NoImplicitPrelude #-}
module Wav (main) where
import Fay.W3C.Events
import Fay.W3C.Html5
import Language.Fay.FFI
import Language.Fay.Prelude
main :: Fay ()
main = addWindowEventListener "load" run
run :: Event -> Fay Bool
run _ = do
aud <- mkAudio
setSrc aud "test.wav"
play aud
return False
mkAudio :: Fay HTMLAudioElement
mkAudio = ffi "new Audio()"
addWindowEventListener :: String -> (Event -> Fay Bool) -> Fay ()
addWindowEventListener = ffi "window['addEventListener'](%1,%2,false)"
There you go--playing a WAV file in Haskell thanks to the power of HTML5! All you have to do is launch a web browser instead of mplayer. :D
using OpenAL through ALUT:
import Control.Monad
import Sound.ALUT
playSound :: IO ()
playSound =
withProgNameAndArgs runALUTUsingCurrentContext $ \_ _ ->
do
(Just device) <- openDevice Nothing
(Just context) <- createContext device []
currentContext $= Just context
buffer1 <- createBuffer $ Sine 440 0 1
buffer2 <- createBuffer HelloWorld
[source] <- genObjectNames 1
queueBuffers source [buffer1,buffer2]
play [source]
sleep 4
closeDevice device
return ()
main = playSound
to load a wav file:
buffer3 <- createBuffer $ File "/path/to/file.wav"
credit goes to Chris Double: http://bluishcoder.co.nz/articles/haskell/openal.html
module Main (main) where
import qualified SDL
import SDL.Mixer
main :: IO ()
main = do
SDL.initialize [SDL.InitAudio]
withAudio defaultAudio 4096 $ do
load "test.wav" >>= play
SDL.delay 1000
SDL.quit
I was trying to play sound with Haskell and I found this board when I searched how to do this. Actually, I want to know some kind of solution in Japanese sites because I am Japanese, but I couldn't find such sites.
I tried the OpenAl one above and with a little revision I succeeded, but I want to have a result with a simpler way.
I use 'sdl2' and 'sdl2-mixer' library. To do this, I had to install sdl2 and sdl2-mixer library into my OS.
I am using DebianOS and I installed 'libsdl2-dev' and 'libsdl2-mixer-dev' with apt command.
sudo apt instll libsdl2-dev libsdl2-mixer-dev
(Because I installed these files many months ago, so my memory is ambiguous.)
I use 'stack' to launch a Haskell project.
stack new myproject
(myproject is the project name)
In the myproject folder I edited the package.yaml file:
dependencies:
- base >= 4.7 && < 5
- sdl2
- sdl2-mixer
and I also edited then Main.hs file in the app folder. That is the above code.
I put the test.wav file in the myproject folder and with the command:
stack run
I could play the test sound.

Resources