{-# LANGUAGE OverloadedStrings #-}
module System.ZMQ4.Utils
( bindFromRangeRandom
, bindFromRangeRandomM
, authManager
, closeZeroLinger
)
where
import Control.Monad ( forever )
import Control.Monad.Catch
import Control.Concurrent.Async
import Data.ByteString
import Data.List.NonEmpty
import System.Random ( randomRIO )
import Text.Printf
import System.ZMQ4.Monadic
( ZMQ
)
import qualified System.ZMQ4.Monadic as M
import System.ZMQ4
( Context
, errno
)
import qualified System.ZMQ4 as P
-- | Bind socket to the random port in a given range.
bindFromRangeRandomM :: M.Socket z t
-> String -- ^ Address
-> Int -- ^ Min port
-> Int -- ^ Max port
-> Int -- ^ Max tries
-> ZMQ z Int
bindFromRangeRandomM sock addr mI mA tr = go tr
where
go 0 = error "!" -- XXX: throw correct error
go x = do
port <- M.liftIO $ randomRIO (mI,mA)
result <- try $ M.bind sock (printf "%s:%i" addr port)
case result of
Left e
| errno e == -1 -> go (x - 1)
| otherwise -> throwM e
Right () -> return port
bindFromRangeRandom :: P.Socket t
-> String -- ^ Address
-> Int -- ^ Min port
-> Int -- ^ Max port
-> Int -- ^ Max tries
-> IO Int
bindFromRangeRandom sock addr mI mA tr = go tr
where
go 0 = error "!" -- XXX: throw correct error
go x = do
port <- randomRIO (mI,mA)
result <- try $ P.bind sock (printf "%s:%i" addr port)
case result of
Left e
| errno e == -1 -> go (x - 1)
| otherwise -> throwM e
Right () -> return port
-- | One possible password authentification
authManager :: P.Context -> ByteString -> ByteString -> IO (Async ())
authManager ctx user pass = do
req <- P.socket ctx P.Rep
P.bind req "inproc://zeromq.zap.01"
async $ forever $ do
("1.0":requestId:domain:ipAddress:identity:mech:xs) <- P.receiveMulti req
case mech of
"PLAIN" -> case xs of
(pass':user':_)
| user == user' && pass == pass' -> do
P.sendMulti req $ "1.0" :| [requestId, "200", "OK", "", ""]
| otherwise -> P.sendMulti req $ "1.0" :| [requestId, "400", "Credentials are not implemented", "", ""]
_ -> P.sendMulti req $ "1.0" :| [requestId, "500", "Method not implemented", "", ""]
_ -> P.sendMulti req $ "1.0" :| [requestId, "500", "Method not implemented", "", ""]
-- | Close socket immideately.
closeZeroLinger :: P.Socket a -> IO ()
closeZeroLinger sock = do
P.setLinger (P.restrict 0) sock
P.close sock