Connect to Unix domain socket as client in Haskel - haskell

I can't find a good info on dealing with Unix Domain sockets in Haskell.
I need a simple function to open a socket and write a command to it.
Can anyone help me with an advice of where to read about this or maybe give an example?
Basically, I need to port this simple Ruby function (if it helps to understand what I mean):
def monitor(string_command)
require "socket"
socket = File.join($vbase, #name, "monitor.soc")
raise RuntimeError, "Monitor socket does not exst!" unless File.exist? socket
begin
UNIXSocket.open(socket) do |s|
s.puts string_command
s.flush
end
rescue
return false
end
true
end
All it does opens socket and writes a command to it returning true upon success.
Thank you.

I think I figured it out. Well, it works and does what I need so I guess it should do for now.
Here is the snippet (without any error checks) if some one needs a similar thing:
monitor n c = do
soc <- socket AF_UNIX Stream 0
connect soc (SockAddrUnix (vmBaseDir </> n </> "monitor.soc"))
send soc (c ++ "\n")
sClose soc

Here is a full example:
{-# Language OverloadedStrings #-}
module Main where
import Network.Socket hiding (send)
import Network.Socket.ByteString
main :: IO ()
main = do
withSocketsDo $ do
soc <- socket AF_UNIX Stream 0
connect (soc) (SockAddrUnix "/tmp2/test2.soc")
send soc ("test123")
close soc

Related

Haskell broken pipe error when working with streams

I'm trying to build a player using streams. The main idea is to have a thread running a player that reads from bytes that come from another thread that downloads youtube audio concurrently. The code works for a while and the content is streamed correctly, but after a few seconds I always got this error:
Exception: fd:13: hPutBuf: resource vanished (Broken pipe).
I guess I'm missing something, because even when using the connect function the result is the same. Here's the code (simplified):
import Control.Concurrent
import System.IO.Streams
import Data.ByteString
main = do
(sink,_,_,_) <- runInteractiveCommand "mplayer -novideo - cache 5096 -"
mainSink <- lockingOutputStream sink -- main audio stream, goes straight to player
(_,source,_,_) <- runInteractiveCommand "yt-dlp \"https://www.youtube.com/watch?v=uFtfDK39ZhI\" -f bv+ba -o -"
loop mainSink source
loop :: OutputStream ByteString -> InputStream ByteString -> IO ()
loop sink src = do
sourceBytes <- peek src
case sourceBytes of
Nothing -> do loop sink src
Just _ -> do
audioBytes <- read src
write audioBytes sink
loop sink src
The problem appears to be that mplayer is generating its usual verbose terminal output on stdout and stderr, while yt-dlp is similarly generating output on stderr. Since you toss these handles away and never drain them, eventually the pipe buffers fill, and the processes get stuck. I can't say precisely why one or both of the processes dies instead of just hanging, but that's what's happening. Here's a simple example that redirects the unneeded output to /dev/null and appears to work:
import System.IO.Streams
main = do
(sink,_,_,_) <- runInteractiveCommand "mplayer -cache 5096 - 2>/dev/null >&2"
(_,source,_,_) <- runInteractiveCommand "yt-dlp \"https://www.youtube.com/watch?v=uFtfDK39ZhI\" -f bv+ba -o - 2>/dev/null"
connect source sink

Warp / Scotty not terminating thread / resources at end of request

I'm running into an issue where my Scotty app does not seem to terminate old HTTP request threads. And eventually, after a large number (10-20) of concurrent requests, I run into an error with too many DB connections libpq: failed (FATAL: sorry, too many clients already).
{-# LANGUAGE OverloadedStrings #-}
import Web.Scotty
import Database.PostgreSQL.Simple
import Control.Monad.IO.Class
connection :: IO Connection
connection = connect defaultConnectInfo
{ connectHost = "localhost", connectUser="postgres", connectPassword="mysecretpassword" }
main :: IO ()
main = scotty 8000 $ do
get "/" $ do
c <- liftIO $ connection
text "test"
This also happens with a Warp application (which Scotty):
{-# LANGUAGE OverloadedStrings #-}
import Network.Wai
import Network.Wai.Handler.Warp (run)
import Network.HTTP.Types (status200)
import Network.HTTP.Types.Header (hContentType)
import Database.PostgreSQL.Simple
import Control.Monad.IO.Class
connection :: IO Connection
connection = connect defaultConnectInfo
{ connectHost = "localhost", connectUser="postgres", connectPassword="mysecretpassword" }
main = run 8000 app
app :: Application
app req respond = do
respond $ responseStream status200 [] $ \write flush -> do
print "test"
con <- connection
flush
write $ "World\n"
Why is this happening? Is there an simple way to "finalize" the request at the end?
I can manually close the connection, but ideally I think killing the thread with any other related resources would be ideal.
I've verified that it keeps the connection open by running the following in postgres:
SELECT sum(numbackends) FROM pg_stat_database;
Scotty seems to take a few seconds until it closes it automatically (after the request is completed).
postgresql-simple provides the close :: Connection -> IO () function which closes the connection and free associated resources. You need to close the connection after you are done with it.
But a common problem is the following: what happens if the code between opening and closing the connection throws an exception? How to ensure that the connection is closed even in that case, so that we don't leak connections?
In Haskell, this is solved using the bracket :: IO a -> (a -> IO b) -> (a -> IO c) -> IO c function. You pass it an IO action that allocates some resource (in this case, a connection) a function that frees the allocated resource once we are we are done with it (in our case, the close function) and a function that says what we actually want to do with the allocated resource (in this case, perform a query).
bracket is somewhat similar to try-with-resources in Java or the "using" statement in C#.
Instead of opening and closing a connection on each request, a better approach would be so use some kind of connection pool shared between request threads. persistent-postgresql uses resource-pool for example.

basic mqtt with haskell

I moved mqtt-hs to LTS-5.13 and compiled just fine with stack. Then I created the following subscriber to listen on a topic hierarchy. This is the subscriber code
{-# LANGUAGE OverloadedStrings #-}
module Main(main) where
import Control.Concurrent (threadWaitRead)
import System.Posix.Types
import Network.MQTT
import Network.MQTT.Logger
main :: IO ()
main = do
conn <- connect defaultConfig { cLogger = warnings stdLogger, cHost = "192.168.0.1" }
qos <- subscribe conn Confirm "/something" callback
putStrLn "control-c to finish"
threadWaitRead $ Fd 1
callback topic payload = putStrLn $ "A message was published to " ++ show topic ++ ": " ++ show payload
When I send something to the topic (using a simple Haskell publisher too), I am getting this in the console of this program:
control-c to finish
[Error] {handle: <socket: 3>}: recvLoop: end of file
[Error] recvLoop: No reconnect, terminating.
but no other output.
Both publisher and subscriber connect to a broker (Mosquitto). The subscriber seems to be Ok, the above happens only when receiving the message from the publisher. The above message also occurs when I stop the broker.
Any ideas?
Update
I cloned most recent mqtt-hs (0.3.0) and introduced this change
--- a/Network/MQTT.hs
+++ b/Network/MQTT.hs
## -448,9 +448,10 ## recvLoop :: MQTT -> IO ()
recvLoop m = loopWithReconnect m "recvLoop" $ \mqtt -> do
h <- readMVar (handle mqtt)
eof <- hIsEOF h
- if eof
- then ioError $ mkIOError eofErrorType "" (Just h) Nothing
- else getMessage mqtt >>= dispatchMessage mqtt
+ getMessage mqtt >>= dispatchMessage mqtt
+ -- if eof
+ -- then ioError $ mkIOError eofErrorType "" (Just h) Nothing
+ -- else getMessage mqtt >>= dispatchMessage mqtt
`catch`
\e -> logWarning mqtt $ "recvLoop: Caught " ++ show (e :: MQTTException)
i.e, I disabled the EOF checking. Now the message is printed to the console, but the subscriber enters into a loop throwing [Warning] recvLoop: Caught EOF as fast as it can.
Is this a mosquito error or bug in mqtt-hs?
Update 2
I can confirm it works with ActiveMQ without the hack. Having said this, it is better if mqtt-hs could recover from broker closing connection to a subscriber.
I believe that you might have it misconfigured. I'm currently using mqtt-hs in production and have almost no issues with it (barring a bug that has already been corrected in the project's github). The new update uses a TChan to have the messages delivered correctly as in a persistent connection, there is a chance the that some messages may be lost as the handler has not yet been made available.
You define the connection to the broker, but you don't tell the client about how the reconnections should be handled. For reference, I'm using something like the following at the moment:
mqttConfig :: HostName -> MQTTConfig
mqttConfig host = defaultConfig { cClean = False
, cClientID = "myClientId"
, cHost = host
, cUsername = Just "username"
, cPassword = Just "password"
, cKeepAlive = Just 10
, cReconnPeriod = Just 1
, cLogger = stdLogger }
Even though the version in use here is slightly updated, very little needed to change and reconnctions happen as needed when the broker (mosquitto as well here) goes down and then later recovers.

Accepting specific certificate with http-client-tls or tls?

I'm probably just overlooking something basic in the documentation of http-client-tls and tls, but: how can I establish an HTTPS connection to a server and only accept one particular certificate, specified by me, that is potentially not in the system certificate store?
I see that this is an old question, but I just spent some time writing code to do this and figured I'd post it here for posterity... and in the hopes of getting some code review from the community. Snoyman's comment is helpful, but there are so many code interdependencies here, and X.509 and TLS are so boil the ocean, that it's hard to debug and to know for sure that you're not screwing something up without digging pretty deep into the various libraries. I figured a more complete explanation with working code was in order.
Anyways, here's what I've come up with (this is a stack script so you can run it easily yourself) --
#!/usr/bin/env stack
{- stack --resolver lts-7.16 runghc -}
import qualified Data.ByteString as B
import Data.ByteString.Lazy (ByteString)
import Data.Default.Class (def)
import Data.String (fromString)
import Data.X509.CertificateStore (CertificateStore, readCertificateStore)
import Network.HTTP.Client (httpLbs, newManager, ManagerSettings)
import Network.HTTP.Client.TLS (mkManagerSettings)
import Network.Connection (TLSSettings(TLSSettings))
import qualified Network.TLS as TLS
import qualified Network.TLS.Extra.Cipher as TLS
import System.Environment (getArgs, getProgName)
managerSettings :: CertificateStore -> ManagerSettings
managerSettings store = mkManagerSettings settings Nothing
where settings = TLSSettings params
params = (TLS.defaultParamsClient "" B.empty) {
TLS.clientUseServerNameIndication = True
, TLS.clientShared = def {
TLS.sharedCAStore = store
}
, TLS.clientSupported = def {
TLS.supportedCiphers = TLS.ciphersuite_default
}
}
get :: FilePath -> String -> IO ()
get ca url = do
mstore <- readCertificateStore ca
case mstore of
Just store -> do
manager <- newManager $ managerSettings store
response <- httpLbs (fromString url) manager
putStrLn (show response)
Nothing -> do
putStrLn $ "error: invalid certificate store " ++ ca
main :: IO ()
main = do
args <- getArgs
case args of
ca:url:[] -> get ca url
_ -> do
name <- getProgName
putStrLn $ "usage: " ++ name ++ " ca url"
A couple notes:
The TLS.sharedCAStore settings is where the magic happens. If you want to add your CA to the system store (vs. using only your CA) you can load the system store using getSystemCertificateStore from System.X509, then use Data.X509.CertificateStore to convert back and forth between CertificateStore and [SignedCertificate] to create a store with the system certificates along with your own.
TLS.defaultParamsClient takes a hostname and server id, used for TLS server name indication (SNI), a TLS extension that allows a server to host multiple sites on a single IP (similar to how HTTP/1.1 host headers work). We don't necessarily know what to set this to when we're creating a manager. Fortunately, Network.Connection (used by http-client-tls) appears to override whatever settings we use, so it doesn't matter.
The default for TLS.supportedCiphers is an empty list, so this setting is required (unless you turn off validation or something). Network.Connection defaults to ciphersuite_all but that includes some "not recommended last resource cipher suites" so I opted to use ciphersuite_default instead.
I think you're looking for ClientHooks. You can create a TLSSettings value with that by using the TLSSettings constructor, and then create a ManagerSettings using mkManagerSettings.

Haskell ZeroMQ binding not working for REQ socket

So here i was, barely able to install the libzmq on a windows desktop and then zeromq-haskell with cabal. I wanted to test the api by binding a python program with a haskell program in a hello-world type application.
So the most basic pattern i see is the request-reply pattern . First i tried to make the server in haskell (REP) and the client in python (REQ), witch failed miserably no matter what i did. The generated exception message was Exception: receive: failed (No error).
So i look inside the System.ZMQ and System.ZMQ.Base source code and i see that receive throws an error on calling c_zmq_recv , witch in turn maps directly to a ffi (?) call to the C api. So i think perhaps i didn't do the installation properly , but then i try to make the client in Haskell and the server in python and i notice it works without any problem, so perhaps the recv interface isn't the problem here.
Here is the haskell code below , with both client and server functions
import System.ZMQ
import Control.Monad (forM_,forever)
import Data.ByteString.Char8 (pack,unpack)
import Control.Concurrent (threadDelay)
clientMain :: IO ()
clientMain = withContext 1 (\context->do
putStrLn "Connecting to server"
withSocket context Req $ (\socket-> do
connect socket "tcp://127.0.0.1:5554"
putStrLn $ unwords ["Sending request"]
send socket (pack "Hello...") []
threadDelay (1*1000*1000)
reply<-receive socket []
putStrLn $ unwords ["Received response : ",unpack reply]))
serverMain :: IO ()
serverMain = withContext 1 (\context-> do
putStrLn "Listening at 5554"
withSocket context Rep $ (\socket-> do
connect socket "tcp://127.0.0.1:5554"
forever $ do
message<-receive socket [] -- this throws an IO Exception
putStrLn $ unwords ["Received request : ",unpack message]
threadDelay (1*1000*1000)
send socket (pack "World") [] ))
main :: IO ()
main = serverMain -- replace with clientMain and it works
Now i really didn't get around to testing all other modes of communication (push/pull, subscribe/publish, pair etc.) and for what i need the python server/haskell client is probably better but i am curious about weather i'm doing something wrong or if any part of my code is broken in any way.
Thanks in advance
You need to make one of the sockets (usually the server) bind, you seem to have them both connecting.
Try changing connect socket "tcp://127.0.0.1:5554" to bind socket "tcp://127.0.0.1:5554" in the serverMain function.

Resources