├── .gitignore ├── .gitlab-ci.yml ├── .hgignore ├── AUTHORS ├── CHANGELOG.md ├── LICENSE ├── README.md ├── examples ├── Makefile ├── display.hs ├── perf │ ├── Makefile │ ├── local_lat.hs │ ├── local_thr.hs │ ├── remote_lat.hs │ └── remote_thr.hs └── prompt.hs ├── src ├── Data │ └── Restricted.hs └── System │ ├── ZMQ4.hs │ └── ZMQ4 │ ├── Internal.hs │ ├── Internal │ ├── Base.hsc │ └── Error.hs │ └── Monadic.hs ├── tests ├── System │ └── ZMQ4 │ │ └── Test │ │ └── Properties.hs └── tests.hs └── zeromq4-haskell.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | *.swp 2 | *.hi 3 | *.o 4 | dist/ 5 | tags 6 | ID 7 | cabal.sandbox.config 8 | cabal-dev/ 9 | .cabal-sandbox/ 10 | -------------------------------------------------------------------------------- /.gitlab-ci.yml: -------------------------------------------------------------------------------- 1 | before_script: 2 | - apt-get update 3 | - apt-get install -y libstdc++-4.9-dev g++ libzmq3-dev pkg-config 4 | - cabal update 5 | 6 | test:7.10: 7 | image: haskell:7.10 8 | script: 9 | - cabal install --enable-test --only-dep -j 10 | - cabal build 11 | - cabal test 12 | 13 | test:7.8: 14 | image: haskell:7.8 15 | script: 16 | - cabal install --enable-test --only-dep -j 17 | - cabal build 18 | - cabal test 19 | -------------------------------------------------------------------------------- /.hgignore: -------------------------------------------------------------------------------- 1 | ^(?:dist|test/perf/(?:local|remote)_(?:lat|thr))$ 2 | \.(?:hi|o|orig|rej)$ 3 | ~$ 4 | syntax: glob 5 | .\#* 6 | -------------------------------------------------------------------------------- /AUTHORS: -------------------------------------------------------------------------------- 1 | Toralf Wittner original implementation 2 | David Himmelstrup added send' 3 | Nicolas Trangez added support for zmq_device and "queue" test app 4 | Ville Tirronen added support for ZMG_SNDMORE 5 | Jeremy Fitzhardinge integrated with GHC's I/O manager 6 | Bryan O'Sullivan added resource wrappers, socket finalizer 7 | Ben Lever fixed and tweaked some of the test examples 8 | Alexander Vershilov added support for zmq_proxy 9 | -------------------------------------------------------------------------------- /CHANGELOG.md: -------------------------------------------------------------------------------- 1 | 0.6.5 2 | ----------------------------------------------------------------------------- 3 | - `MonadBase` and `MonadBaseControl` instances for ZMQ (by Maciej Woś). 4 | 5 | 0.6.4 6 | ----------------------------------------------------------------------------- 7 | - Update dependencies. 8 | 9 | 0.6.3 10 | ----------------------------------------------------------------------------- 11 | - Make internal modules available. 12 | - Typeable instance for `Context`. 13 | - Update dependencies. 14 | 15 | 0.6.2 16 | ----------------------------------------------------------------------------- 17 | - Bug fixes: #56 (we no longer call zmq_msg_close after successfull sends) 18 | 19 | 0.6.1 20 | ----------------------------------------------------------------------------- 21 | - Bug fixes: #55 22 | - Build fixes for GHC versions < 7.6 23 | 24 | 0.6 25 | ----------------------------------------------------------------------------- 26 | - Update to `exceptions` 0.6 27 | 28 | 0.5.1 29 | ----------------------------------------------------------------------------- 30 | - Constrain `exceptions` dependency to < 0.6 31 | 32 | 0.5 33 | ----------------------------------------------------------------------------- 34 | - bugfix release (#44, PR #47) which exposes `DontWait` flag on Windows 35 | - exports `socketMonitor` 36 | - `Eq`, `Typable` and `Generic` instances of socket types 37 | 38 | 0.4.1 39 | ----------------------------------------------------------------------------- 40 | - adjust dependencies constraints 41 | 42 | 0.4 43 | ----------------------------------------------------------------------------- 44 | - update `exceptions` and rework tests 45 | 46 | 0.3.2 47 | ----------------------------------------------------------------------------- 48 | - adjust dependencies constraints 49 | 50 | 0.3.1 51 | ----------------------------------------------------------------------------- 52 | - preliminary Windows support (#8) 53 | 54 | 0.3 55 | ----------------------------------------------------------------------------- 56 | - remove `MonadCatchIO-transformers` 57 | - use `pkg-config` (except on Windows) 58 | 59 | 0.2 60 | ----------------------------------------------------------------------------- 61 | - add `disconnect` 62 | 63 | 0.1 64 | ----------------------------------------------------------------------------- 65 | - initial release supporting 0MQ 4.x 66 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2010 zeromq-haskell authors 2 | 3 | Permission is hereby granted, free of charge, to any person 4 | obtaining a copy of this software and associated documentation 5 | files (the "Software"), to deal in the Software without 6 | restriction, including without limitation the rights to use, 7 | copy, modify, merge, publish, distribute, sublicense, and/or sell 8 | copies of the Software, and to permit persons to whom the 9 | Software is furnished to do so, subject to the following 10 | conditions: 11 | 12 | The above copyright notice and this permission notice shall be 13 | included in all copies or substantial portions of the Software. 14 | 15 | THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 16 | EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES 17 | OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND 18 | NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT 19 | HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, 20 | WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING 21 | FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR 22 | OTHER DEALINGS IN THE SOFTWARE. 23 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | zeromq4-haskell 2 | --------------- 3 | 4 | This library provides Haskell bindings to [0MQ 4.0](http://zeromq.org). 5 | -------------------------------------------------------------------------------- /examples/Makefile: -------------------------------------------------------------------------------- 1 | all: chat 2 | 3 | chat: display.hs prompt.hs 4 | cabal exec ghc -- --make -threaded display.hs 5 | cabal exec ghc -- --make -threaded prompt.hs 6 | 7 | .PHONY: clean 8 | clean: 9 | -rm -f *.o *.hi 10 | -rm -f display prompt 11 | 12 | -------------------------------------------------------------------------------- /examples/display.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Control.Monad 3 | import System.Exit 4 | import System.IO 5 | import System.Environment 6 | import System.ZMQ4.Monadic 7 | import qualified Data.ByteString.Char8 as CS 8 | 9 | main :: IO () 10 | main = do 11 | args <- getArgs 12 | when (length args < 1) $ do 13 | hPutStrLn stderr "usage: display
[
, ...]" 14 | exitFailure 15 | runZMQ $ do 16 | sub <- socket Sub 17 | subscribe sub "" 18 | mapM_ (connect sub) args 19 | forever $ do 20 | receive sub >>= liftIO . CS.putStrLn 21 | liftIO $ hFlush stdout 22 | -------------------------------------------------------------------------------- /examples/perf/Makefile: -------------------------------------------------------------------------------- 1 | all: lat thr 2 | 3 | lat: local_lat.hs remote_lat.hs 4 | ghc --make -threaded local_lat.hs 5 | ghc --make -threaded remote_lat.hs 6 | 7 | thr: local_thr.hs remote_thr.hs 8 | ghc --make -threaded local_thr.hs 9 | ghc --make -threaded remote_thr.hs 10 | 11 | .PHONY: clean 12 | clean: 13 | -rm -f *.o *.hi 14 | -rm -f local_lat remote_lat local_thr remote_thr 15 | 16 | -------------------------------------------------------------------------------- /examples/perf/local_lat.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import System.IO 3 | import System.Exit 4 | import System.Environment 5 | import System.ZMQ4.Monadic 6 | import qualified Data.ByteString as SB 7 | 8 | main :: IO () 9 | main = do 10 | args <- getArgs 11 | when (length args /= 3) $ do 12 | hPutStrLn stderr usage 13 | exitFailure 14 | let bindTo = args !! 0 15 | size = read $ args !! 1 16 | rounds = read $ args !! 2 17 | runZMQ $ do 18 | s <- socket Rep 19 | bind s bindTo 20 | loop s rounds size 21 | where 22 | loop s r sz = unless (r <= 0) $ do 23 | msg <- receive s 24 | when (SB.length msg /= sz) $ 25 | error "message of incorrect size received" 26 | send s [] msg 27 | loop s (r - 1) sz 28 | 29 | usage :: String 30 | usage = "usage: local_lat " 31 | 32 | -------------------------------------------------------------------------------- /examples/perf/local_thr.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Control.Concurrent 3 | import Control.Monad 4 | import System.IO 5 | import System.Exit 6 | import System.Environment 7 | import Data.Time.Clock 8 | import System.ZMQ4.Monadic 9 | import qualified Data.ByteString as SB 10 | import Text.Printf 11 | 12 | main :: IO () 13 | main = do 14 | args <- getArgs 15 | when (length args /= 3) $ do 16 | hPutStrLn stderr usage 17 | exitFailure 18 | let bindTo = args !! 0 19 | size = read $ args !! 1 20 | count = read $ args !! 2 21 | runZMQ $ do 22 | s <- socket Sub 23 | subscribe s "" 24 | bind s bindTo 25 | receive' s size 26 | start <- liftIO $ getCurrentTime 27 | loop s count size 28 | end <- liftIO $ getCurrentTime 29 | liftIO $ printStat start end size count 30 | where 31 | receive' s sz = do 32 | msg <- receive s 33 | when (SB.length msg /= sz) $ 34 | error "message of incorrect size received" 35 | 36 | loop s c sz = unless (c < 0) $ do 37 | receive' s sz 38 | loop s (c - 1) sz 39 | 40 | printStat :: UTCTime -> UTCTime -> Int -> Int -> IO () 41 | printStat start end size count = do 42 | let elapsed = fromRational . toRational $ diffUTCTime end start :: Double 43 | through = fromIntegral count / elapsed 44 | mbits = (through * fromIntegral size * 8) / 1000000 45 | printf "message size: %d [B]\n" size 46 | printf "message count: %d\n" count 47 | printf "mean throughput: %.3f [msg/s]\n" through 48 | printf "mean throughput: %.3f [Mb/s]\n" mbits 49 | 50 | usage :: String 51 | usage = "usage: local_thr " 52 | 53 | -------------------------------------------------------------------------------- /examples/perf/remote_lat.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import System.IO 3 | import System.Exit 4 | import System.Environment 5 | import Data.Time.Clock 6 | import System.ZMQ4.Monadic 7 | import qualified Data.ByteString as SB 8 | 9 | main :: IO () 10 | main = do 11 | args <- getArgs 12 | when (length args /= 3) $ do 13 | hPutStrLn stderr usage 14 | exitFailure 15 | let connTo = args !! 0 16 | size = read $ args !! 1 17 | rounds = read $ args !! 2 18 | message = SB.replicate size 0x65 19 | runZMQ $ do 20 | s <- socket Req 21 | connect s connTo 22 | start <- liftIO $ getCurrentTime 23 | loop s rounds message 24 | end <- liftIO $ getCurrentTime 25 | liftIO $ print (diffUTCTime end start) 26 | where 27 | loop s r msg = unless (r <= 0) $ do 28 | send s [] msg 29 | msg' <- receive s 30 | when (SB.length msg' /= SB.length msg) $ 31 | error "message of incorrect size received" 32 | loop s (r - 1) msg 33 | 34 | usage :: String 35 | usage = "usage: remote_lat " 36 | 37 | -------------------------------------------------------------------------------- /examples/perf/remote_thr.hs: -------------------------------------------------------------------------------- 1 | import Control.Monad 2 | import Control.Concurrent 3 | import System.IO 4 | import System.Exit 5 | import System.Environment 6 | import System.ZMQ4.Monadic 7 | import qualified Data.ByteString as SB 8 | 9 | main :: IO () 10 | main = do 11 | args <- getArgs 12 | when (length args /= 3) $ do 13 | hPutStrLn stderr usage 14 | exitFailure 15 | let connTo = args !! 0 16 | size = read $ args !! 1 17 | count = read $ args !! 2 18 | message = SB.replicate size 0x65 19 | runZMQ $ do 20 | s <- socket Pub 21 | connect s connTo 22 | replicateM_ count $ send s [] message 23 | liftIO $ threadDelay 10000000 24 | 25 | usage :: String 26 | usage = "usage: remote_thr " 27 | 28 | -------------------------------------------------------------------------------- /examples/prompt.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | import Control.Applicative 3 | import Control.Monad 4 | import Data.Monoid 5 | import Data.String 6 | import System.IO 7 | import System.Exit 8 | import System.Environment 9 | import System.ZMQ4.Monadic 10 | 11 | main :: IO () 12 | main = do 13 | args <- getArgs 14 | when (length args /= 2) $ do 15 | hPutStrLn stderr "usage: prompt
" 16 | exitFailure 17 | let addr = head args 18 | name = fromString (args !! 1) <> ": " 19 | runZMQ $ do 20 | pub <- socket Pub 21 | bind pub addr 22 | forever $ do 23 | line <- liftIO $ fromString <$> getLine 24 | send pub [] (name <> line) 25 | -------------------------------------------------------------------------------- /src/Data/Restricted.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE EmptyDataDecls #-} 2 | {-# LANGUAGE MultiParamTypeClasses #-} 3 | {-# LANGUAGE FlexibleInstances #-} 4 | {-# LANGUAGE UndecidableInstances #-} 5 | {-# LANGUAGE TypeSynonymInstances #-} 6 | {-# LANGUAGE OverloadedStrings #-} 7 | 8 | -- | 9 | -- Module : Data.Restricted 10 | -- Copyright : (c) 2011-2013 Toralf Wittner 11 | -- License : MIT 12 | -- Maintainer : Toralf Wittner 13 | -- Stability : experimental 14 | -- Portability : non-portable 15 | -- 16 | -- Type-level restricted data. 17 | -- This module allows for type declarations which embed certain restrictions, 18 | -- such as value bounds. E.g. @Restricted N0 N1 Int@ denotes an 'Int' which can 19 | -- only have values [0 .. 1]. When creating such a value, the constructor functions 20 | -- 'restrict' or 'toRestricted' ensure that the restrictions are obeyed. Code 21 | -- that consumes restricted types does not need to check the constraints. 22 | -- 23 | -- /N.B./ This module is more or less tailored to be used within 'System.ZMQ3'. 24 | -- Therefore the provided type level restrictions are limited. 25 | module Data.Restricted ( 26 | 27 | Restricted 28 | , Restriction (..) 29 | , rvalue 30 | 31 | , Nneg1 32 | , N1 33 | , N0 34 | , N254 35 | , Inf 36 | , Div4 37 | , Div5 38 | 39 | ) where 40 | 41 | import Data.Int 42 | import Data.ByteString (ByteString) 43 | import qualified Data.ByteString as B 44 | 45 | -- | Type level restriction. 46 | newtype Restricted r v = Restricted v deriving Show 47 | 48 | -- | A uniform way to restrict values. 49 | class Restriction r v where 50 | 51 | -- | Create a restricted value. Returns 'Nothing' if 52 | -- the given value does not satisfy all restrictions. 53 | toRestricted :: v -> Maybe (Restricted r v) 54 | 55 | -- | Create a restricted value. If the given value 56 | -- does not satisfy the restrictions, a modified 57 | -- variant is used instead, e.g. if an integer is 58 | -- larger than the upper bound, the upper bound 59 | -- value is used. 60 | restrict :: v -> Restricted r v 61 | 62 | -- | Get the actual value. 63 | rvalue :: Restricted r v -> v 64 | rvalue (Restricted v) = v 65 | 66 | -- | type level -1 67 | data Nneg1 68 | 69 | -- | type-level 0 70 | data N0 71 | 72 | -- | type-level 1 73 | data N1 74 | 75 | -- | type-level 254 76 | data N254 77 | 78 | -- | type-level infinity 79 | data Inf 80 | 81 | -- | divisable by 4 82 | data Div4 83 | 84 | -- | divisable by 5 85 | data Div5 86 | 87 | instance Show Nneg1 where show _ = "Nneg1" 88 | instance Show N0 where show _ = "N0" 89 | instance Show N1 where show _ = "N1" 90 | instance Show N254 where show _ = "N254" 91 | instance Show Inf where show _ = "Inf" 92 | instance Show Div4 where show _ = "Div4" 93 | instance Show Div5 where show _ = "Div5" 94 | 95 | -- Natural numbers 96 | 97 | instance (Integral a) => Restriction (N0, Inf) a where 98 | toRestricted = toIntRLB 0 99 | restrict = intRLB 0 100 | 101 | instance (Integral a) => Restriction (N0, Int32) a where 102 | toRestricted = toIntR 0 (maxBound :: Int32) 103 | restrict = intR 0 (maxBound :: Int32) 104 | 105 | instance (Integral a) => Restriction (N0, Int64) a where 106 | toRestricted = toIntR 0 (maxBound :: Int64) 107 | restrict = intR 0 (maxBound :: Int64) 108 | 109 | -- Positive natural numbers 110 | 111 | instance (Integral a) => Restriction (N1, Inf) a where 112 | toRestricted = toIntRLB 1 113 | restrict = intRLB 1 114 | 115 | instance (Integral a) => Restriction (N1, Int32) a where 116 | toRestricted = toIntR 1 (maxBound :: Int32) 117 | restrict = intR 1 (maxBound :: Int32) 118 | 119 | instance (Integral a) => Restriction (N1, Int64) a where 120 | toRestricted = toIntR 1 (maxBound :: Int64) 121 | restrict = intR 1 (maxBound :: Int64) 122 | 123 | -- From -1 ranges 124 | 125 | instance (Integral a) => Restriction (Nneg1, Inf) a where 126 | toRestricted = toIntRLB (-1) 127 | restrict = intRLB (-1) 128 | 129 | instance (Integral a) => Restriction (Nneg1, Int32) a where 130 | toRestricted = toIntR (-1) (maxBound :: Int32) 131 | restrict = intR (-1) (maxBound :: Int32) 132 | 133 | instance (Integral a) => Restriction (Nneg1, Int64) a where 134 | toRestricted = toIntR (-1) (maxBound :: Int64) 135 | restrict = intR (-1) (maxBound :: Int64) 136 | 137 | -- Other ranges 138 | 139 | instance Restriction (N1, N254) String where 140 | toRestricted s | check (1, 254) (length s) = Just $ Restricted s 141 | | otherwise = Nothing 142 | 143 | restrict s | length s < 1 = Restricted " " 144 | | otherwise = Restricted (take 254 s) 145 | 146 | instance Restriction (N1, N254) ByteString where 147 | toRestricted s | check (1, 254) (B.length s) = Just $ Restricted s 148 | | otherwise = Nothing 149 | 150 | restrict s | B.length s < 1 = Restricted (B.singleton 0x20) 151 | | otherwise = Restricted (B.take 254 s) 152 | 153 | -- Other constraints 154 | 155 | instance Restriction Div4 ByteString where 156 | toRestricted s | B.length s `mod` 4 == 0 = Just $ Restricted s 157 | | otherwise = Nothing 158 | 159 | restrict = fitByRem 4 160 | 161 | instance Restriction Div5 ByteString where 162 | toRestricted s | B.length s `mod` 5 == 0 = Just $ Restricted s 163 | | otherwise = Nothing 164 | 165 | restrict = fitByRem 5 166 | 167 | -- Helpers 168 | 169 | toIntR :: (Integral i, Integral j) => i -> j -> i -> Maybe (Restricted (a, b) i) 170 | toIntR lb ub i | check (lb, fromIntegral ub) i = Just $ Restricted i 171 | | otherwise = Nothing 172 | 173 | intR :: (Integral i, Integral j) => i -> j -> i -> Restricted (a, b) i 174 | intR lb ub = Restricted . lbfit lb . ubfit (fromIntegral ub) 175 | 176 | toIntRLB :: Integral i => i -> i -> Maybe (Restricted (a, b) i) 177 | toIntRLB lb i | lbcheck lb i = Just $ Restricted i 178 | | otherwise = Nothing 179 | 180 | intRLB :: Integral i => i -> i -> Restricted (a, b) i 181 | intRLB lb = Restricted . lbfit lb 182 | 183 | -- Bounds checks 184 | 185 | lbcheck :: Ord a => a -> a -> Bool 186 | lbcheck lb a = a >= lb 187 | 188 | ubcheck :: Ord a => a -> a -> Bool 189 | ubcheck ub a = a <= ub 190 | 191 | check :: Ord a => (a, a) -> a -> Bool 192 | check (lb, ub) a = lbcheck lb a && ubcheck ub a 193 | 194 | -- Fit 195 | 196 | lbfit :: Integral a => a -> a -> a 197 | lbfit lb a | a >= lb = a 198 | | otherwise = lb 199 | 200 | ubfit :: Integral a => a -> a -> a 201 | ubfit ub a | a <= ub = a 202 | | otherwise = ub 203 | 204 | fitByRem :: Int -> ByteString -> Restricted r ByteString 205 | fitByRem r s = 206 | let len = B.length s 207 | x = len `mod` r 208 | in if x == 0 209 | then Restricted s 210 | else Restricted (B.take (len - x) s) 211 | 212 | -------------------------------------------------------------------------------- /src/System/ZMQ4.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE DeriveDataTypeable #-} 4 | {-# LANGUAGE DeriveGeneric #-} 5 | 6 | -- | 7 | -- Module : System.ZMQ4 8 | -- Copyright : (c) 2010-2013 Toralf Wittner 9 | -- License : MIT 10 | -- Maintainer : Toralf Wittner 11 | -- Stability : experimental 12 | -- Portability : non-portable 13 | -- 14 | -- 0MQ haskell binding. The API closely follows the C-API of 0MQ with 15 | -- the main difference being that sockets are typed. 16 | -- 17 | -- /Notes/ 18 | -- 19 | -- Many option settings use a 'Restriction' to further constrain the 20 | -- range of possible values of their integral types. For example 21 | -- the maximum message size can be given as -1, which means no limit 22 | -- or by greater values, which denote the message size in bytes. The 23 | -- type of 'setMaxMessageSize' is therefore: 24 | -- 25 | -- @setMaxMessageSize :: Integral i 26 | -- => Restricted (Nneg1, Int64) i 27 | -- -> Socket a 28 | -- -> IO ()@ 29 | -- 30 | -- which means any integral value in the range of @-1@ to 31 | -- (@maxBound :: Int64@) can be given. To create a restricted 32 | -- value from plain value, use 'toRestricted' or 'restrict'. 33 | 34 | module System.ZMQ4 35 | ( -- * Type Definitions 36 | -- ** Socket Types 37 | Pair (..) 38 | , Pub (..) 39 | , Sub (..) 40 | , XPub (..) 41 | , XSub (..) 42 | , Req (..) 43 | , Rep (..) 44 | , Dealer (..) 45 | , Router (..) 46 | , XReq 47 | , XRep 48 | , Pull (..) 49 | , Push (..) 50 | , Stream (..) 51 | 52 | -- ** Socket type-classes 53 | , SocketType 54 | , Sender 55 | , Receiver 56 | , Subscriber 57 | , SocketLike 58 | , Conflatable 59 | , SendProbe 60 | 61 | -- ** Various type definitions 62 | , Size 63 | , Context 64 | , Socket 65 | , Flag (..) 66 | , Switch (..) 67 | , Timeout 68 | , Event (..) 69 | , EventType (..) 70 | , EventMsg (..) 71 | , Poll (..) 72 | , KeyFormat (..) 73 | , SecurityMechanism (..) 74 | 75 | -- * General Operations 76 | , withContext 77 | , withSocket 78 | , bind 79 | , unbind 80 | , connect 81 | , disconnect 82 | , send 83 | , send' 84 | , sendMulti 85 | , receive 86 | , receiveMulti 87 | , version 88 | , monitor 89 | , socketMonitor 90 | , poll 91 | 92 | , System.ZMQ4.subscribe 93 | , System.ZMQ4.unsubscribe 94 | 95 | -- * Context Options (Read) 96 | , ioThreads 97 | , maxSockets 98 | 99 | -- * Context Options (Write) 100 | , setIoThreads 101 | , setMaxSockets 102 | 103 | -- * Socket Options (Read) 104 | , System.ZMQ4.affinity 105 | , System.ZMQ4.backlog 106 | , System.ZMQ4.conflate 107 | , System.ZMQ4.curvePublicKey 108 | , System.ZMQ4.curveSecretKey 109 | , System.ZMQ4.curveServerKey 110 | , System.ZMQ4.delayAttachOnConnect 111 | , System.ZMQ4.events 112 | , System.ZMQ4.fileDescriptor 113 | , System.ZMQ4.identity 114 | , System.ZMQ4.immediate 115 | , System.ZMQ4.ipv4Only 116 | , System.ZMQ4.ipv6 117 | , System.ZMQ4.lastEndpoint 118 | , System.ZMQ4.linger 119 | , System.ZMQ4.maxMessageSize 120 | , System.ZMQ4.mcastHops 121 | , System.ZMQ4.mechanism 122 | , System.ZMQ4.moreToReceive 123 | , System.ZMQ4.plainServer 124 | , System.ZMQ4.plainPassword 125 | , System.ZMQ4.plainUserName 126 | , System.ZMQ4.rate 127 | , System.ZMQ4.receiveBuffer 128 | , System.ZMQ4.receiveHighWM 129 | , System.ZMQ4.receiveTimeout 130 | , System.ZMQ4.reconnectInterval 131 | , System.ZMQ4.reconnectIntervalMax 132 | , System.ZMQ4.recoveryInterval 133 | , System.ZMQ4.sendBuffer 134 | , System.ZMQ4.sendHighWM 135 | , System.ZMQ4.sendTimeout 136 | , System.ZMQ4.tcpKeepAlive 137 | , System.ZMQ4.tcpKeepAliveCount 138 | , System.ZMQ4.tcpKeepAliveIdle 139 | , System.ZMQ4.tcpKeepAliveInterval 140 | , System.ZMQ4.zapDomain 141 | 142 | -- * Socket Options (Write) 143 | , setAffinity 144 | , setBacklog 145 | , setConflate 146 | , setCurveServer 147 | , setCurvePublicKey 148 | , setCurveSecretKey 149 | , setCurveServerKey 150 | , setDelayAttachOnConnect 151 | , setIdentity 152 | , setImmediate 153 | , setIpv4Only 154 | , setIpv6 155 | , setLinger 156 | , setMaxMessageSize 157 | , setMcastHops 158 | , setPlainServer 159 | , setPlainPassword 160 | , setPlainUserName 161 | , setProbeRouter 162 | , setRate 163 | , setReceiveBuffer 164 | , setReceiveHighWM 165 | , setReceiveTimeout 166 | , setReconnectInterval 167 | , setReconnectIntervalMax 168 | , setRecoveryInterval 169 | , setReqCorrelate 170 | , setReqRelaxed 171 | , setRouterMandatory 172 | , setSendBuffer 173 | , setSendHighWM 174 | , setSendTimeout 175 | , setTcpAcceptFilter 176 | , setTcpKeepAlive 177 | , setTcpKeepAliveCount 178 | , setTcpKeepAliveIdle 179 | , setTcpKeepAliveInterval 180 | , setXPubVerbose 181 | 182 | -- * Restrictions 183 | , Data.Restricted.restrict 184 | , Data.Restricted.toRestricted 185 | 186 | -- * Error Handling 187 | , ZMQError 188 | , errno 189 | , source 190 | , message 191 | 192 | -- * Low-level Functions 193 | , init 194 | , term 195 | , shutdown 196 | , context 197 | , socket 198 | , close 199 | , waitRead 200 | , waitWrite 201 | , z85Encode 202 | , z85Decode 203 | 204 | -- * Utils 205 | , proxy 206 | , curveKeyPair 207 | ) where 208 | 209 | import Control.Applicative 210 | import Control.Exception 211 | import Control.Monad (unless) 212 | import Control.Monad.IO.Class 213 | import Data.List (intersect, foldl') 214 | import Data.List.NonEmpty (NonEmpty) 215 | import Data.Restricted 216 | import Data.Traversable (forM) 217 | import Data.Typeable 218 | import Foreign hiding (throwIf, throwIf_, throwIfNull, void) 219 | import Foreign.C.String 220 | import Foreign.C.Types (CInt, CShort) 221 | import System.Posix.Types (Fd(..)) 222 | import System.ZMQ4.Internal 223 | import System.ZMQ4.Internal.Base 224 | import System.ZMQ4.Internal.Error 225 | import Prelude hiding (init) 226 | 227 | import qualified Data.ByteString as SB 228 | import qualified Data.ByteString.Lazy as LB 229 | import qualified Data.List.NonEmpty as S 230 | import qualified Prelude as P 231 | import qualified System.ZMQ4.Internal.Base as B 232 | 233 | import GHC.Conc (threadWaitRead) 234 | import GHC.Generics(Generic) 235 | 236 | ----------------------------------------------------------------------------- 237 | -- Socket Types 238 | 239 | -- | 240 | data Pair = Pair deriving (Eq, Typeable, Generic) 241 | 242 | -- | 243 | data Pub = Pub deriving (Eq, Typeable, Generic) 244 | 245 | -- | 246 | data Sub = Sub deriving (Eq, Typeable, Generic) 247 | 248 | -- | 249 | data XPub = XPub deriving (Eq, Typeable, Generic) 250 | 251 | -- | 252 | data XSub = XSub deriving (Eq, Typeable, Generic) 253 | 254 | -- | 255 | data Req = Req deriving (Eq, Typeable, Generic) 256 | 257 | -- | 258 | data Rep = Rep deriving (Eq, Typeable, Generic) 259 | 260 | -- | 261 | data Dealer = Dealer deriving (Eq, Typeable, Generic) 262 | 263 | -- | 264 | data Router = Router deriving (Eq, Typeable, Generic) 265 | 266 | -- | 267 | data Pull = Pull deriving (Eq, Typeable, Generic) 268 | 269 | -- | 270 | data Push = Push deriving (Eq, Typeable, Generic) 271 | 272 | -- | 273 | data Stream = Stream deriving (Eq, Typeable, Generic) 274 | 275 | type XReq = Dealer 276 | {-# DEPRECATED XReq "Use Dealer" #-} 277 | 278 | type XRep = Router 279 | {-# DEPRECATED XRep "Use Router" #-} 280 | 281 | ----------------------------------------------------------------------------- 282 | -- Socket Type Classifications 283 | 284 | -- | Sockets which can 'subscribe'. 285 | class Subscriber a 286 | 287 | -- | Sockets which can 'send'. 288 | class Sender a 289 | 290 | -- | Sockets which can 'receive'. 291 | class Receiver a 292 | 293 | -- | Sockets which can be 'conflate'd. 294 | class Conflatable a 295 | 296 | -- | Sockets which can send probes (cf. 'setProbeRouter'). 297 | class SendProbe a 298 | 299 | instance SocketType Pair where zmqSocketType = const pair 300 | instance Sender Pair 301 | instance Receiver Pair 302 | 303 | instance SocketType Pub where zmqSocketType = const pub 304 | instance Sender Pub 305 | instance Conflatable Pub 306 | 307 | instance SocketType Sub where zmqSocketType = const sub 308 | instance Subscriber Sub 309 | instance Receiver Sub 310 | instance Conflatable Sub 311 | 312 | instance SocketType XPub where zmqSocketType = const xpub 313 | instance Sender XPub 314 | instance Receiver XPub 315 | 316 | instance SocketType XSub where zmqSocketType = const xsub 317 | instance Sender XSub 318 | instance Receiver XSub 319 | 320 | instance SocketType Req where zmqSocketType = const request 321 | instance Sender Req 322 | instance Receiver Req 323 | instance SendProbe Req 324 | 325 | instance SocketType Rep where zmqSocketType = const response 326 | instance Sender Rep 327 | instance Receiver Rep 328 | 329 | instance SocketType Dealer where zmqSocketType = const dealer 330 | instance Sender Dealer 331 | instance Receiver Dealer 332 | instance Conflatable Dealer 333 | instance SendProbe Dealer 334 | 335 | instance SocketType Router where zmqSocketType = const router 336 | instance Sender Router 337 | instance Receiver Router 338 | instance SendProbe Router 339 | 340 | instance SocketType Pull where zmqSocketType = const pull 341 | instance Receiver Pull 342 | instance Conflatable Pull 343 | 344 | instance SocketType Push where zmqSocketType = const push 345 | instance Sender Push 346 | instance Conflatable Push 347 | 348 | instance SocketType Stream where zmqSocketType = const stream 349 | instance Sender Stream 350 | instance Receiver Stream 351 | 352 | ----------------------------------------------------------------------------- 353 | 354 | -- | Socket events. 355 | data Event = 356 | In -- ^ @ZMQ_POLLIN@ (incoming messages) 357 | | Out -- ^ @ZMQ_POLLOUT@ (outgoing messages, i.e. at least 1 byte can be written) 358 | | Err -- ^ @ZMQ_POLLERR@ 359 | deriving (Eq, Ord, Read, Show) 360 | 361 | -- | A 'Poll' value contains the object to poll (a 0MQ socket or a file 362 | -- descriptor), the set of 'Event's which are of interest and--optionally-- 363 | -- a callback-function which is invoked iff the set of interested events 364 | -- overlaps with the actual events. 365 | data Poll s m where 366 | Sock :: s t -> [Event] -> Maybe ([Event] -> m ()) -> Poll s m 367 | File :: Fd -> [Event] -> Maybe ([Event] -> m ()) -> Poll s m 368 | 369 | -- | Return the runtime version of the underlying 0MQ library as a 370 | -- (major, minor, patch) triple. 371 | version :: IO (Int, Int, Int) 372 | version = 373 | with 0 $ \major_ptr -> 374 | with 0 $ \minor_ptr -> 375 | with 0 $ \patch_ptr -> 376 | c_zmq_version major_ptr minor_ptr patch_ptr >> 377 | tupleUp <$> peek major_ptr <*> peek minor_ptr <*> peek patch_ptr 378 | where 379 | tupleUp a b c = (fromIntegral a, fromIntegral b, fromIntegral c) 380 | 381 | init :: Size -> IO Context 382 | init n = do 383 | c <- context 384 | setIoThreads n c 385 | return c 386 | {-# DEPRECATED init "Use context" #-} 387 | 388 | -- | Initialize a 0MQ context. 389 | -- Equivalent to . 390 | context :: IO Context 391 | context = Context <$> throwIfNull "init" c_zmq_ctx_new 392 | 393 | -- | Terminate a 0MQ context. 394 | -- Equivalent to . 395 | term :: Context -> IO () 396 | term c = throwIfMinus1Retry_ "term" . c_zmq_ctx_term . _ctx $ c 397 | 398 | -- | Shutdown a 0MQ context. 399 | -- Equivalent to . 400 | shutdown :: Context -> IO () 401 | shutdown = throwIfMinus1_ "shutdown" . c_zmq_ctx_shutdown . _ctx 402 | 403 | -- | Run an action with a 0MQ context. The 'Context' supplied to your 404 | -- action will /not/ be valid after the action either returns or 405 | -- throws an exception. 406 | withContext :: (Context -> IO a) -> IO a 407 | withContext act = 408 | bracket (throwIfNull "withContext (new)" $ c_zmq_ctx_new) 409 | (throwIfMinus1Retry_ "withContext (term)" . c_zmq_ctx_term) 410 | (act . Context) 411 | 412 | -- | Run an action with a 0MQ socket. The socket will be closed after running 413 | -- the supplied action even if an error occurs. The socket supplied to your 414 | -- action will /not/ be valid after the action terminates. 415 | withSocket :: SocketType a => Context -> a -> (Socket a -> IO b) -> IO b 416 | withSocket c t = bracket (socket c t) close 417 | 418 | -- | Create a new 0MQ socket within the given context. 'withSocket' provides 419 | -- automatic socket closing and may be safer to use. 420 | socket :: SocketType a => Context -> a -> IO (Socket a) 421 | socket c t = Socket <$> mkSocketRepr t c 422 | 423 | -- | Close a 0MQ socket. 'withSocket' provides automatic socket closing and may 424 | -- be safer to use. 425 | close :: Socket a -> IO () 426 | close = closeSock . _socketRepr 427 | 428 | -- | Subscribe Socket to given subscription. 429 | subscribe :: Subscriber a => Socket a -> SB.ByteString -> IO () 430 | subscribe s = setByteStringOpt s B.subscribe 431 | 432 | -- | Unsubscribe Socket from given subscription. 433 | unsubscribe :: Subscriber a => Socket a -> SB.ByteString -> IO () 434 | unsubscribe s = setByteStringOpt s B.unsubscribe 435 | 436 | -- Read Only 437 | 438 | -- | . 439 | events :: Socket a -> IO [Event] 440 | events s = toEvents <$> getIntOpt s B.events 0 441 | 442 | -- | . 443 | fileDescriptor :: Socket a -> IO Fd 444 | fileDescriptor s = Fd . fromIntegral <$> getInt32Option B.filedesc s 445 | 446 | -- | . 447 | moreToReceive :: Socket a -> IO Bool 448 | moreToReceive s = (== 1) <$> getInt32Option B.receiveMore s 449 | 450 | -- Read 451 | 452 | -- | . 453 | ioThreads :: Context -> IO Word 454 | ioThreads = ctxIntOption "ioThreads" _ioThreads 455 | 456 | -- | . 457 | maxSockets :: Context -> IO Word 458 | maxSockets = ctxIntOption "maxSockets" _maxSockets 459 | 460 | -- | Restricts the outgoing and incoming socket buffers to a single message. 461 | conflate :: Conflatable a => Socket a -> IO Bool 462 | conflate s = (== 1) <$> getInt32Option B.conflate s 463 | 464 | -- | . 465 | immediate :: Socket a -> IO Bool 466 | immediate s = (== 1) <$> getInt32Option B.immediate s 467 | 468 | -- | . 469 | identity :: Socket a -> IO SB.ByteString 470 | identity s = getByteStringOpt s B.identity 471 | 472 | -- | . 473 | affinity :: Socket a -> IO Word64 474 | affinity s = getIntOpt s B.affinity 0 475 | 476 | -- | . 477 | maxMessageSize :: Socket a -> IO Int64 478 | maxMessageSize s = getIntOpt s B.maxMessageSize 0 479 | 480 | ipv4Only :: Socket a -> IO Bool 481 | ipv4Only s = (== 1) <$> getInt32Option B.ipv4Only s 482 | {-# DEPRECATED ipv4Only "Use ipv6" #-} 483 | 484 | -- | . 485 | ipv6 :: Socket a -> IO Bool 486 | ipv6 s = (== 1) <$> getInt32Option B.ipv6 s 487 | 488 | -- | . 489 | backlog :: Socket a -> IO Int 490 | backlog = getInt32Option B.backlog 491 | 492 | delayAttachOnConnect :: Socket a -> IO Bool 493 | delayAttachOnConnect s = (== 1) <$> getInt32Option B.delayAttachOnConnect s 494 | {-# DEPRECATED delayAttachOnConnect "Use immediate" #-} 495 | 496 | -- | . 497 | linger :: Socket a -> IO Int 498 | linger = getInt32Option B.linger 499 | 500 | -- | . 501 | lastEndpoint :: Socket a -> IO String 502 | lastEndpoint s = getStrOpt s B.lastEndpoint 503 | 504 | -- | . 505 | rate :: Socket a -> IO Int 506 | rate = getInt32Option B.rate 507 | 508 | -- | . 509 | receiveBuffer :: Socket a -> IO Int 510 | receiveBuffer = getInt32Option B.receiveBuf 511 | 512 | -- | . 513 | reconnectInterval :: Socket a -> IO Int 514 | reconnectInterval = getInt32Option B.reconnectIVL 515 | 516 | -- | . 517 | reconnectIntervalMax :: Socket a -> IO Int 518 | reconnectIntervalMax = getInt32Option B.reconnectIVLMax 519 | 520 | -- | . 521 | recoveryInterval :: Socket a -> IO Int 522 | recoveryInterval = getInt32Option B.recoveryIVL 523 | 524 | -- | . 525 | sendBuffer :: Socket a -> IO Int 526 | sendBuffer = getInt32Option B.sendBuf 527 | 528 | -- | . 529 | mcastHops :: Socket a -> IO Int 530 | mcastHops = getInt32Option B.mcastHops 531 | 532 | -- | . 533 | receiveHighWM :: Socket a -> IO Int 534 | receiveHighWM = getInt32Option B.receiveHighWM 535 | 536 | -- | . 537 | receiveTimeout :: Socket a -> IO Int 538 | receiveTimeout = getInt32Option B.receiveTimeout 539 | 540 | -- | . 541 | sendTimeout :: Socket a -> IO Int 542 | sendTimeout = getInt32Option B.sendTimeout 543 | 544 | -- | . 545 | sendHighWM :: Socket a -> IO Int 546 | sendHighWM = getInt32Option B.sendHighWM 547 | 548 | -- | . 549 | tcpKeepAlive :: Socket a -> IO Switch 550 | tcpKeepAlive = fmap (toSwitch "Invalid ZMQ_TCP_KEEPALIVE") 551 | . getInt32Option B.tcpKeepAlive 552 | 553 | -- | . 554 | tcpKeepAliveCount :: Socket a -> IO Int 555 | tcpKeepAliveCount = getInt32Option B.tcpKeepAliveCount 556 | 557 | -- | . 558 | tcpKeepAliveIdle :: Socket a -> IO Int 559 | tcpKeepAliveIdle = getInt32Option B.tcpKeepAliveIdle 560 | 561 | -- | . 562 | tcpKeepAliveInterval :: Socket a -> IO Int 563 | tcpKeepAliveInterval = getInt32Option B.tcpKeepAliveInterval 564 | 565 | -- | . 566 | mechanism :: Socket a -> IO SecurityMechanism 567 | mechanism = fmap (fromMechanism "Invalid ZMQ_MECHANISM") 568 | . getInt32Option B.mechanism 569 | 570 | -- | . 571 | plainServer :: Socket a -> IO Bool 572 | plainServer = fmap (== 1) . getInt32Option B.plainServer 573 | 574 | -- | . 575 | plainUserName :: Socket a -> IO SB.ByteString 576 | plainUserName s = getByteStringOpt s B.plainUserName 577 | 578 | -- | . 579 | plainPassword :: Socket a -> IO SB.ByteString 580 | plainPassword s = getByteStringOpt s B.plainPassword 581 | 582 | -- | . 583 | zapDomain :: Socket a -> IO SB.ByteString 584 | zapDomain s = getByteStringOpt s B.zapDomain 585 | 586 | -- | . 587 | curvePublicKey :: KeyFormat f -> Socket a -> IO SB.ByteString 588 | curvePublicKey f s = getKey f s B.curvePublicKey 589 | 590 | -- | . 591 | curveServerKey :: KeyFormat f -> Socket a -> IO SB.ByteString 592 | curveServerKey f s = getKey f s B.curveServerKey 593 | 594 | -- | . 595 | curveSecretKey :: KeyFormat f -> Socket a -> IO SB.ByteString 596 | curveSecretKey f s = getKey f s B.curveSecretKey 597 | 598 | -- Write 599 | 600 | -- | . 601 | setIoThreads :: Word -> Context -> IO () 602 | setIoThreads n = setCtxIntOption "ioThreads" _ioThreads n 603 | 604 | -- | . 605 | setMaxSockets :: Word -> Context -> IO () 606 | setMaxSockets n = setCtxIntOption "maxSockets" _maxSockets n 607 | 608 | -- | Restrict the outgoing and incoming socket buffers to a single message. 609 | setConflate :: Conflatable a => Bool -> Socket a -> IO () 610 | setConflate x s = setIntOpt s B.conflate (bool2cint x) 611 | 612 | -- | . 613 | setImmediate :: Bool -> Socket a -> IO () 614 | setImmediate x s = setIntOpt s B.immediate (bool2cint x) 615 | 616 | -- | . 617 | setIdentity :: Restricted (N1, N254) SB.ByteString -> Socket a -> IO () 618 | setIdentity x s = setByteStringOpt s B.identity (rvalue x) 619 | 620 | -- | . 621 | setAffinity :: Word64 -> Socket a -> IO () 622 | setAffinity x s = setIntOpt s B.affinity x 623 | 624 | setDelayAttachOnConnect :: Bool -> Socket a -> IO () 625 | setDelayAttachOnConnect x s = setIntOpt s B.delayAttachOnConnect (bool2cint x) 626 | {-# DEPRECATED setDelayAttachOnConnect "Use setImmediate" #-} 627 | 628 | -- | . 629 | setMaxMessageSize :: Integral i => Restricted (Nneg1, Int64) i -> Socket a -> IO () 630 | setMaxMessageSize x s = setIntOpt s B.maxMessageSize ((fromIntegral . rvalue $ x) :: Int64) 631 | 632 | setIpv4Only :: Bool -> Socket a -> IO () 633 | setIpv4Only x s = setIntOpt s B.ipv4Only (bool2cint x) 634 | {-# DEPRECATED setIpv4Only "Use setIpv6" #-} 635 | 636 | -- | . 637 | setIpv6 :: Bool -> Socket a -> IO () 638 | setIpv6 x s = setIntOpt s B.ipv6 (bool2cint x) 639 | 640 | -- | . 641 | setPlainServer :: Bool -> Socket a -> IO () 642 | setPlainServer x s = setIntOpt s B.plainServer (bool2cint x) 643 | 644 | -- | . 645 | setCurveServer :: Bool -> Socket a -> IO () 646 | setCurveServer x s = setIntOpt s B.curveServer (bool2cint x) 647 | 648 | -- | . 649 | setPlainUserName :: Restricted (N1, N254) SB.ByteString -> Socket a -> IO () 650 | setPlainUserName x s = setByteStringOpt s B.plainUserName (rvalue x) 651 | 652 | -- | . 653 | setPlainPassword :: Restricted (N1, N254) SB.ByteString -> Socket a -> IO () 654 | setPlainPassword x s = setByteStringOpt s B.plainPassword (rvalue x) 655 | 656 | -- | . 657 | setLinger :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO () 658 | setLinger = setInt32OptFromRestricted B.linger 659 | 660 | -- | . 661 | setReceiveTimeout :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO () 662 | setReceiveTimeout = setInt32OptFromRestricted B.receiveTimeout 663 | 664 | -- | . 665 | setRouterMandatory :: Bool -> Socket Router -> IO () 666 | setRouterMandatory x s = setIntOpt s B.routerMandatory (bool2cint x) 667 | 668 | -- | . 669 | setSendTimeout :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO () 670 | setSendTimeout = setInt32OptFromRestricted B.sendTimeout 671 | 672 | -- | . 673 | setRate :: Integral i => Restricted (N1, Int32) i -> Socket a -> IO () 674 | setRate = setInt32OptFromRestricted B.rate 675 | 676 | -- | . 677 | setMcastHops :: Integral i => Restricted (N1, Int32) i -> Socket a -> IO () 678 | setMcastHops = setInt32OptFromRestricted B.mcastHops 679 | 680 | -- | . 681 | setBacklog :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO () 682 | setBacklog = setInt32OptFromRestricted B.backlog 683 | 684 | -- | . 685 | setCurvePublicKey :: KeyFormat f -> Restricted f SB.ByteString -> Socket a -> IO () 686 | setCurvePublicKey _ k s = setByteStringOpt s B.curvePublicKey (rvalue k) 687 | 688 | -- | . 689 | setCurveSecretKey :: KeyFormat f -> Restricted f SB.ByteString -> Socket a -> IO () 690 | setCurveSecretKey _ k s = setByteStringOpt s B.curveSecretKey (rvalue k) 691 | 692 | -- | . 693 | setCurveServerKey :: KeyFormat f -> Restricted f SB.ByteString -> Socket a -> IO () 694 | setCurveServerKey _ k s = setByteStringOpt s B.curveServerKey (rvalue k) 695 | 696 | -- | . 697 | setProbeRouter :: SendProbe a => Bool -> Socket a -> IO () 698 | setProbeRouter x s = setIntOpt s B.probeRouter (bool2cint x) 699 | 700 | -- | . 701 | setReceiveBuffer :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO () 702 | setReceiveBuffer = setInt32OptFromRestricted B.receiveBuf 703 | 704 | -- | . 705 | setReconnectInterval :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO () 706 | setReconnectInterval = setInt32OptFromRestricted B.reconnectIVL 707 | 708 | -- | . 709 | setReconnectIntervalMax :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO () 710 | setReconnectIntervalMax = setInt32OptFromRestricted B.reconnectIVLMax 711 | 712 | -- | . 713 | setReqCorrelate :: Bool -> Socket Req -> IO () 714 | setReqCorrelate x s = setIntOpt s B.reqCorrelate (bool2cint x) 715 | 716 | -- | . 717 | setReqRelaxed :: Bool -> Socket Req -> IO () 718 | setReqRelaxed x s = setIntOpt s B.reqRelaxed (bool2cint x) 719 | 720 | -- | . 721 | setSendBuffer :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO () 722 | setSendBuffer = setInt32OptFromRestricted B.sendBuf 723 | 724 | -- | . 725 | setRecoveryInterval :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO () 726 | setRecoveryInterval = setInt32OptFromRestricted B.recoveryIVL 727 | 728 | -- | . 729 | setReceiveHighWM :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO () 730 | setReceiveHighWM = setInt32OptFromRestricted B.receiveHighWM 731 | 732 | -- | . 733 | setSendHighWM :: Integral i => Restricted (N0, Int32) i -> Socket a -> IO () 734 | setSendHighWM = setInt32OptFromRestricted B.sendHighWM 735 | 736 | -- | . 737 | setTcpAcceptFilter :: Maybe SB.ByteString -> Socket a -> IO () 738 | setTcpAcceptFilter Nothing sock = onSocket "setTcpAcceptFilter" sock $ \s -> 739 | throwIfMinus1Retry_ "setStrOpt" $ 740 | c_zmq_setsockopt s (optVal tcpAcceptFilter) nullPtr 0 741 | setTcpAcceptFilter (Just dat) sock = setByteStringOpt sock tcpAcceptFilter dat 742 | 743 | -- | . 744 | setTcpKeepAlive :: Switch -> Socket a -> IO () 745 | setTcpKeepAlive x s = setIntOpt s B.tcpKeepAlive (fromSwitch x :: CInt) 746 | 747 | -- | . 748 | setTcpKeepAliveCount :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO () 749 | setTcpKeepAliveCount = setInt32OptFromRestricted B.tcpKeepAliveCount 750 | 751 | -- | . 752 | setTcpKeepAliveIdle :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO () 753 | setTcpKeepAliveIdle = setInt32OptFromRestricted B.tcpKeepAliveIdle 754 | 755 | -- | . 756 | setTcpKeepAliveInterval :: Integral i => Restricted (Nneg1, Int32) i -> Socket a -> IO () 757 | setTcpKeepAliveInterval = setInt32OptFromRestricted B.tcpKeepAliveInterval 758 | 759 | -- | . 760 | setXPubVerbose :: Bool -> Socket XPub -> IO () 761 | setXPubVerbose x s = setIntOpt s B.xpubVerbose (bool2cint x) 762 | 763 | -- | Bind the socket to the given address 764 | -- (cf. ). 765 | bind :: Socket a -> String -> IO () 766 | bind sock str = onSocket "bind" sock $ 767 | throwIfMinus1Retry_ "bind" . withCString str . c_zmq_bind 768 | 769 | -- | Unbind the socket from the given address 770 | -- (cf. ). 771 | unbind :: Socket a -> String -> IO () 772 | unbind sock str = onSocket "unbind" sock $ 773 | throwIfMinus1Retry_ "unbind" . withCString str . c_zmq_unbind 774 | 775 | -- | Connect the socket to the given address 776 | -- (cf. ). 777 | connect :: Socket a -> String -> IO () 778 | connect sock str = onSocket "connect" sock $ 779 | throwIfMinus1Retry_ "connect" . withCString str . c_zmq_connect 780 | 781 | -- | Disconnect the socket from the given endpoint 782 | -- (cf. ). 783 | disconnect :: Socket a -> String -> IO () 784 | disconnect sock str = onSocket "disconnect" sock $ 785 | throwIfMinus1Retry_ "disconnect" . withCString str . c_zmq_disconnect 786 | 787 | -- | Send the given 'SB.ByteString' over the socket 788 | -- (cf. ). 789 | -- 790 | -- /Note/: This function always calls @zmq_sendmsg@ in a non-blocking way, 791 | -- i.e. there is no need to provide the @ZMQ_DONTWAIT@ flag as this is used 792 | -- by default. Still 'send' is blocking the thread as long as the message 793 | -- can not be queued on the socket using GHC's 'threadWaitWrite'. 794 | send :: Sender a => Socket a -> [Flag] -> SB.ByteString -> IO () 795 | send sock fls val = bracketOnError (messageOf val) messageClose $ \m -> do 796 | onSocket "send" sock $ \s -> 797 | retry "send" (waitWrite sock) $ 798 | #ifdef mingw32_HOST_OS 799 | c_zmq_sendmsg s (msgPtr m) (combineFlags fls) 800 | #else 801 | c_zmq_sendmsg s (msgPtr m) (combineFlags (DontWait : fls)) 802 | #endif 803 | messageFree m 804 | 805 | -- | Send the given 'LB.ByteString' over the socket 806 | -- (cf. ). 807 | -- 808 | -- This is operationally identical to @send socket (Strict.concat 809 | -- (Lazy.toChunks lbs)) flags@ but may be more efficient. 810 | -- 811 | -- /Note/: This function always calls @zmq_sendmsg@ in a non-blocking way, 812 | -- i.e. there is no need to provide the @ZMQ_DONTWAIT@ flag as this is used 813 | -- by default. Still 'send'' is blocking the thread as long as the message 814 | -- can not be queued on the socket using GHC's 'threadWaitWrite'. 815 | send' :: Sender a => Socket a -> [Flag] -> LB.ByteString -> IO () 816 | send' sock fls val = bracketOnError (messageOfLazy val) messageClose $ \m -> do 817 | onSocket "send'" sock $ \s -> 818 | retry "send'" (waitWrite sock) $ 819 | #ifdef mingw32_HOST_OS 820 | c_zmq_sendmsg s (msgPtr m) (combineFlags fls) 821 | #else 822 | c_zmq_sendmsg s (msgPtr m) (combineFlags (DontWait : fls)) 823 | #endif 824 | messageFree m 825 | 826 | -- | Send a multi-part message. 827 | -- This function applies the 'SendMore' 'Flag' between all message parts. 828 | -- 0MQ guarantees atomic delivery of a multi-part message 829 | -- (cf. ). 830 | sendMulti :: Sender a => Socket a -> NonEmpty SB.ByteString -> IO () 831 | sendMulti sock msgs = do 832 | mapM_ (send sock [SendMore]) (S.init msgs) 833 | send sock [] (S.last msgs) 834 | 835 | -- | Receive a 'ByteString' from socket 836 | -- (cf. ). 837 | -- 838 | -- /Note/: This function always calls @zmq_recvmsg@ in a non-blocking way, 839 | -- i.e. there is no need to provide the @ZMQ_DONTWAIT@ flag as this is used 840 | -- by default. Still 'receive' is blocking the thread as long as no data 841 | -- is available using GHC's 'threadWaitRead'. 842 | receive :: Receiver a => Socket a -> IO (SB.ByteString) 843 | receive sock = bracket messageInit messageClose $ \m -> 844 | onSocket "receive" sock $ \s -> do 845 | retry "receive" (waitRead sock) $ 846 | #ifdef mingw32_HOST_OS 847 | c_zmq_recvmsg s (msgPtr m) 0 848 | #else 849 | c_zmq_recvmsg s (msgPtr m) (flagVal dontWait) 850 | #endif 851 | data_ptr <- c_zmq_msg_data (msgPtr m) 852 | size <- c_zmq_msg_size (msgPtr m) 853 | SB.packCStringLen (data_ptr, fromIntegral size) 854 | 855 | -- | Receive a multi-part message. 856 | -- This function collects all message parts send via 'sendMulti'. 857 | receiveMulti :: Receiver a => Socket a -> IO [SB.ByteString] 858 | receiveMulti sock = recvall [] 859 | where 860 | recvall acc = do 861 | msg <- receive sock 862 | moreToReceive sock >>= next (msg:acc) 863 | 864 | next acc True = recvall acc 865 | next acc False = return (reverse acc) 866 | 867 | -- | Setup socket monitoring, i.e. a 'Pair' socket which 868 | -- sends monitoring events about the given 'Socket' to the 869 | -- given address. 870 | socketMonitor :: [EventType] -> String -> Socket a -> IO () 871 | socketMonitor es addr soc = onSocket "socketMonitor" soc $ \s -> 872 | withCString addr $ \a -> 873 | throwIfMinus1_ "zmq_socket_monitor" $ 874 | c_zmq_socket_monitor s a (events2cint es) 875 | 876 | -- | Monitor socket events 877 | -- (cf. ). 878 | -- 879 | -- This function returns a function which can be invoked to retrieve 880 | -- the next socket event, potentially blocking until the next one becomes 881 | -- available. When applied to 'False', monitoring will terminate, i.e. 882 | -- internal monitoring resources will be disposed. Consequently after 883 | -- 'monitor' has been invoked, the returned function must be applied 884 | -- /once/ to 'False'. 885 | monitor :: [EventType] -> Context -> Socket a -> IO (Bool -> IO (Maybe EventMsg)) 886 | monitor es ctx sock = do 887 | let addr = "inproc://" ++ show (_socket . _socketRepr $ sock) 888 | s <- socket ctx Pair 889 | socketMonitor es addr sock 890 | connect s addr 891 | next s <$> messageInit 892 | where 893 | next soc m False = messageClose m `finally` close soc >> return Nothing 894 | next soc m True = onSocket "recv" soc $ \s -> do 895 | retry "recv" (waitRead soc) $ 896 | #ifdef mingw32_HOST_OS 897 | c_zmq_recvmsg s (msgPtr m) 0 898 | #else 899 | c_zmq_recvmsg s (msgPtr m) (flagVal dontWait) 900 | #endif 901 | evt <- peekZMQEvent (msgPtr m) 902 | str <- receive soc 903 | return . Just $ eventMessage str evt 904 | 905 | -- | Polls for events on the given 'Poll' descriptors. Returns a list of 906 | -- events per descriptor which have occured. 907 | -- (cf. ) 908 | poll :: (SocketLike s, MonadIO m) => Timeout -> [Poll s m] -> m [[Event]] 909 | poll _ [] = return [] 910 | poll to desc = do 911 | let len = length desc 912 | let ps = map toZMQPoll desc 913 | ps' <- liftIO $ withArray ps $ \ptr -> do 914 | throwIfMinus1Retry_ "poll" $ 915 | c_zmq_poll ptr (fromIntegral len) (fromIntegral to) 916 | peekArray len ptr 917 | mapM fromZMQPoll (zip desc ps') 918 | where 919 | toZMQPoll :: (SocketLike s, MonadIO m) => Poll s m -> ZMQPoll 920 | toZMQPoll (Sock s e _) = 921 | ZMQPoll (_socket . _socketRepr . toSocket $ s) 0 (combine (map fromEvent e)) 0 922 | 923 | toZMQPoll (File (Fd s) e _) = 924 | ZMQPoll nullPtr (fromIntegral s) (combine (map fromEvent e)) 0 925 | 926 | fromZMQPoll :: (SocketLike s, MonadIO m) => (Poll s m, ZMQPoll) -> m [Event] 927 | fromZMQPoll (p, zp) = do 928 | let e = toEvents . fromIntegral . pRevents $ zp 929 | let (e', f) = case p of 930 | (Sock _ x g) -> (x, g) 931 | (File _ x g) -> (x, g) 932 | forM f (unless (P.null (e `intersect` e')) . ($ e)) >> return e 933 | 934 | fromEvent :: Event -> CShort 935 | fromEvent In = fromIntegral . pollVal $ pollIn 936 | fromEvent Out = fromIntegral . pollVal $ pollOut 937 | fromEvent Err = fromIntegral . pollVal $ pollerr 938 | 939 | -- Convert bit-masked word into Event list. 940 | toEvents :: Word32 -> [Event] 941 | toEvents e = foldl' (\es f -> f e es) [] tests 942 | where 943 | tests = 944 | [ \i xs -> if i .&. (fromIntegral . pollVal $ pollIn) /= 0 then In:xs else xs 945 | , \i xs -> if i .&. (fromIntegral . pollVal $ pollOut) /= 0 then Out:xs else xs 946 | , \i xs -> if i .&. (fromIntegral . pollVal $ pollerr) /= 0 then Err:xs else xs 947 | ] 948 | 949 | retry :: String -> IO () -> IO CInt -> IO () 950 | retry msg wait act = throwIfMinus1RetryMayBlock_ msg act wait 951 | 952 | wait' :: ZMQPollEvent -> Socket a -> IO () 953 | #ifdef mingw32_HOST_OS 954 | wait' _ _ = return () 955 | #else 956 | wait' p s = do 957 | e <- getInt32Option B.events s 958 | unless (testev e) $ do 959 | fd <- getIntOpt s B.filedesc 0 960 | threadWaitRead (Fd fd) 961 | wait' p s 962 | where 963 | testev e = e .&. fromIntegral (pollVal p) /= 0 964 | #endif 965 | 966 | -- | Wait until data is available for reading from the given Socket. 967 | -- After this function returns, a call to 'receive' will essentially be 968 | -- non-blocking. 969 | waitRead :: Socket a -> IO () 970 | waitRead = wait' pollIn 971 | 972 | -- | Wait until data can be written to the given Socket. 973 | -- After this function returns, a call to 'send' will essentially be 974 | -- non-blocking. 975 | waitWrite :: Socket a -> IO () 976 | waitWrite = wait' pollOut 977 | 978 | -- | Starts built-in 0MQ proxy 979 | -- (cf. ) 980 | -- 981 | -- Proxy connects front to back socket 982 | -- 983 | -- Before calling proxy all sockets should be bound 984 | -- 985 | -- If the capture socket is not Nothing, the proxy shall send all 986 | -- messages, received on both frontend and backend, to the capture socket. 987 | proxy :: Socket a -> Socket b -> Maybe (Socket c) -> IO () 988 | proxy front back capture = 989 | onSocket "proxy-front" front $ \f -> 990 | onSocket "proxy-back" back $ \b -> 991 | throwIfMinus1Retry_ "c_zmq_proxy" $ c_zmq_proxy f b c 992 | where 993 | c = maybe nullPtr (_socket . _socketRepr) capture 994 | 995 | -- | Generate a new curve key pair. 996 | -- (cf. ) 997 | curveKeyPair :: MonadIO m => m (Restricted Div5 SB.ByteString, Restricted Div5 SB.ByteString) 998 | curveKeyPair = liftIO $ 999 | allocaBytes 41 $ \cstr1 -> 1000 | allocaBytes 41 $ \cstr2 -> do 1001 | throwIfMinus1_ "c_zmq_curve_keypair" $ c_zmq_curve_keypair cstr1 cstr2 1002 | public <- toRestricted <$> SB.packCString cstr1 1003 | private <- toRestricted <$> SB.packCString cstr2 1004 | maybe (fail errmsg) return ((,) <$> public <*> private) 1005 | where 1006 | errmsg = "curveKeyPair: invalid key-lengths produced" 1007 | 1008 | -------------------------------------------------------------------------------- /src/System/ZMQ4/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | {-# LANGUAGE GADTs #-} 3 | {-# LANGUAGE StandaloneDeriving #-} 4 | 5 | -- | /Warning/: This is an internal module and subject 6 | -- to change without notice. 7 | module System.ZMQ4.Internal 8 | ( Context (..) 9 | , Socket (..) 10 | , SocketRepr (..) 11 | , SocketType (..) 12 | , SocketLike (..) 13 | , Message (..) 14 | , Flag (..) 15 | , Timeout 16 | , Size 17 | , Switch (..) 18 | , EventType (..) 19 | , EventMsg (..) 20 | , SecurityMechanism (..) 21 | , KeyFormat (..) 22 | 23 | , messageOf 24 | , messageOfLazy 25 | , messageClose 26 | , messageFree 27 | , messageInit 28 | , messageInitSize 29 | , setIntOpt 30 | , setStrOpt 31 | , getIntOpt 32 | , getStrOpt 33 | , getInt32Option 34 | , setInt32OptFromRestricted 35 | , ctxIntOption 36 | , setCtxIntOption 37 | , getByteStringOpt 38 | , setByteStringOpt 39 | 40 | , z85Encode 41 | , z85Decode 42 | 43 | , toZMQFlag 44 | , combine 45 | , combineFlags 46 | , mkSocketRepr 47 | , closeSock 48 | , onSocket 49 | 50 | , bool2cint 51 | , toSwitch 52 | , fromSwitch 53 | , events2cint 54 | , eventMessage 55 | 56 | , toMechanism 57 | , fromMechanism 58 | 59 | , getKey 60 | ) where 61 | 62 | import Control.Applicative 63 | import Control.Monad (foldM_, when, void) 64 | import Control.Monad.IO.Class 65 | import Control.Exception 66 | import Data.IORef (IORef, mkWeakIORef, readIORef, atomicModifyIORef) 67 | 68 | import Foreign hiding (throwIfNull, void) 69 | import Foreign.C.String 70 | import Foreign.C.Types (CInt, CSize) 71 | 72 | import Data.IORef (newIORef) 73 | import Data.Restricted 74 | import Data.Typeable 75 | import Prelude 76 | 77 | import System.Posix.Types (Fd(..)) 78 | import System.ZMQ4.Internal.Base 79 | import System.ZMQ4.Internal.Error 80 | 81 | import qualified Data.ByteString as SB 82 | import qualified Data.ByteString.Lazy as LB 83 | import qualified Data.ByteString.Unsafe as UB 84 | 85 | type Timeout = Int64 86 | type Size = Word 87 | 88 | -- | Flags to apply on send operations (cf. man zmq_send) 89 | data Flag = 90 | DontWait -- ^ ZMQ_DONTWAIT (Only relevant on Windows.) 91 | | SendMore -- ^ ZMQ_SNDMORE 92 | deriving (Eq, Ord, Show) 93 | 94 | -- | Configuration switch 95 | data Switch = 96 | Default -- ^ Use default setting 97 | | On -- ^ Activate setting 98 | | Off -- ^ De-activate setting 99 | deriving (Eq, Ord, Show) 100 | 101 | -- | Event types to monitor. 102 | data EventType = 103 | ConnectedEvent 104 | | ConnectDelayedEvent 105 | | ConnectRetriedEvent 106 | | ListeningEvent 107 | | BindFailedEvent 108 | | AcceptedEvent 109 | | AcceptFailedEvent 110 | | ClosedEvent 111 | | CloseFailedEvent 112 | | DisconnectedEvent 113 | | MonitorStoppedEvent 114 | | AllEvents 115 | deriving (Eq, Ord, Show) 116 | 117 | -- | Event Message to receive when monitoring socket events. 118 | data EventMsg = 119 | Connected !SB.ByteString !Fd 120 | | ConnectDelayed !SB.ByteString 121 | | ConnectRetried !SB.ByteString !Int 122 | | Listening !SB.ByteString !Fd 123 | | BindFailed !SB.ByteString !Int 124 | | Accepted !SB.ByteString !Fd 125 | | AcceptFailed !SB.ByteString !Int 126 | | Closed !SB.ByteString !Fd 127 | | CloseFailed !SB.ByteString !Int 128 | | Disconnected !SB.ByteString !Fd 129 | | MonitorStopped !SB.ByteString !Int 130 | deriving (Eq, Show) 131 | 132 | data SecurityMechanism 133 | = Null 134 | | Plain 135 | | Curve 136 | deriving (Eq, Show) 137 | 138 | data KeyFormat a where 139 | BinaryFormat :: KeyFormat Div4 140 | TextFormat :: KeyFormat Div5 141 | 142 | deriving instance Eq (KeyFormat a) 143 | deriving instance Show (KeyFormat a) 144 | 145 | -- | A 0MQ context representation. 146 | newtype Context = Context { _ctx :: ZMQCtx } 147 | 148 | deriving instance Typeable Context 149 | 150 | -- | A 0MQ Socket. 151 | newtype Socket a = Socket 152 | { _socketRepr :: SocketRepr } 153 | 154 | data SocketRepr = SocketRepr 155 | { _socket :: ZMQSocket 156 | , _sockLive :: IORef Bool 157 | } 158 | 159 | -- | Socket types. 160 | class SocketType a where 161 | zmqSocketType :: a -> ZMQSocketType 162 | 163 | class SocketLike s where 164 | toSocket :: s t -> Socket t 165 | 166 | instance SocketLike Socket where 167 | toSocket = id 168 | 169 | -- A 0MQ Message representation. 170 | newtype Message = Message { msgPtr :: ZMQMsgPtr } 171 | 172 | -- internal helpers: 173 | 174 | onSocket :: String -> Socket a -> (ZMQSocket -> IO b) -> IO b 175 | onSocket _func (Socket (SocketRepr sock _state)) act = act sock 176 | {-# INLINE onSocket #-} 177 | 178 | mkSocketRepr :: SocketType t => t -> Context -> IO SocketRepr 179 | mkSocketRepr t c = do 180 | let ty = typeVal (zmqSocketType t) 181 | s <- throwIfNull "mkSocketRepr" (c_zmq_socket (_ctx c) ty) 182 | ref <- newIORef True 183 | addFinalizer ref $ do 184 | alive <- readIORef ref 185 | when alive $ c_zmq_close s >> return () 186 | return (SocketRepr s ref) 187 | where 188 | addFinalizer r f = mkWeakIORef r f >> return () 189 | 190 | closeSock :: SocketRepr -> IO () 191 | closeSock (SocketRepr s status) = do 192 | alive <- atomicModifyIORef status (\b -> (False, b)) 193 | when alive $ throwIfMinus1_ "close" . c_zmq_close $ s 194 | 195 | messageOf :: SB.ByteString -> IO Message 196 | messageOf b = UB.unsafeUseAsCStringLen b $ \(cstr, len) -> do 197 | msg <- messageInitSize (fromIntegral len) 198 | data_ptr <- c_zmq_msg_data (msgPtr msg) 199 | copyBytes data_ptr cstr len 200 | return msg 201 | 202 | messageOfLazy :: LB.ByteString -> IO Message 203 | messageOfLazy lbs = do 204 | msg <- messageInitSize (fromIntegral len) 205 | data_ptr <- c_zmq_msg_data (msgPtr msg) 206 | let fn offset bs = UB.unsafeUseAsCStringLen bs $ \(cstr, str_len) -> do 207 | copyBytes (data_ptr `plusPtr` offset) cstr str_len 208 | return (offset + str_len) 209 | foldM_ fn 0 (LB.toChunks lbs) 210 | return msg 211 | where 212 | len = LB.length lbs 213 | 214 | messageClose :: Message -> IO () 215 | messageClose (Message ptr) = do 216 | throwIfMinus1_ "messageClose" $ c_zmq_msg_close ptr 217 | free ptr 218 | 219 | messageFree :: Message -> IO () 220 | messageFree (Message ptr) = free ptr 221 | 222 | messageInit :: IO Message 223 | messageInit = do 224 | ptr <- new (ZMQMsg nullPtr) 225 | throwIfMinus1_ "messageInit" $ c_zmq_msg_init ptr 226 | return (Message ptr) 227 | 228 | messageInitSize :: Size -> IO Message 229 | messageInitSize s = do 230 | ptr <- new (ZMQMsg nullPtr) 231 | throwIfMinus1_ "messageInitSize" $ 232 | c_zmq_msg_init_size ptr (fromIntegral s) 233 | return (Message ptr) 234 | 235 | setIntOpt :: (Storable b, Integral b) => Socket a -> ZMQOption -> b -> IO () 236 | setIntOpt sock (ZMQOption o) i = onSocket "setIntOpt" sock $ \s -> 237 | throwIfMinus1Retry_ "setIntOpt" $ with i $ \ptr -> 238 | c_zmq_setsockopt s (fromIntegral o) 239 | (castPtr ptr) 240 | (fromIntegral . sizeOf $ i) 241 | 242 | setCStrOpt :: ZMQSocket -> ZMQOption -> CStringLen -> IO CInt 243 | setCStrOpt s (ZMQOption o) (cstr, len) = 244 | c_zmq_setsockopt s (fromIntegral o) (castPtr cstr) (fromIntegral len) 245 | 246 | setByteStringOpt :: Socket a -> ZMQOption -> SB.ByteString -> IO () 247 | setByteStringOpt sock opt str = onSocket "setByteStringOpt" sock $ \s -> 248 | throwIfMinus1Retry_ "setByteStringOpt" . UB.unsafeUseAsCStringLen str $ setCStrOpt s opt 249 | 250 | setStrOpt :: Socket a -> ZMQOption -> String -> IO () 251 | setStrOpt sock opt str = onSocket "setStrOpt" sock $ \s -> 252 | throwIfMinus1Retry_ "setStrOpt" . withCStringLen str $ setCStrOpt s opt 253 | 254 | getIntOpt :: (Storable b, Integral b) => Socket a -> ZMQOption -> b -> IO b 255 | getIntOpt sock (ZMQOption o) i = onSocket "getIntOpt" sock $ \s -> do 256 | bracket (new i) free $ \iptr -> 257 | bracket (new (fromIntegral . sizeOf $ i :: CSize)) free $ \jptr -> do 258 | throwIfMinus1Retry_ "getIntOpt" $ 259 | c_zmq_getsockopt s (fromIntegral o) (castPtr iptr) jptr 260 | peek iptr 261 | 262 | getCStrOpt :: (CStringLen -> IO s) -> Socket a -> ZMQOption -> IO s 263 | getCStrOpt peekA sock (ZMQOption o) = onSocket "getCStrOpt" sock $ \s -> 264 | bracket (mallocBytes 255) free $ \bPtr -> 265 | bracket (new (255 :: CSize)) free $ \sPtr -> do 266 | throwIfMinus1Retry_ "getCStrOpt" $ 267 | c_zmq_getsockopt s (fromIntegral o) (castPtr bPtr) sPtr 268 | peek sPtr >>= \len -> peekA (bPtr, fromIntegral len) 269 | 270 | getStrOpt :: Socket a -> ZMQOption -> IO String 271 | getStrOpt = getCStrOpt (peekCString . fst) 272 | 273 | getByteStringOpt :: Socket a -> ZMQOption -> IO SB.ByteString 274 | getByteStringOpt = getCStrOpt SB.packCStringLen 275 | 276 | getInt32Option :: ZMQOption -> Socket a -> IO Int 277 | getInt32Option o s = fromIntegral <$> getIntOpt s o (0 :: CInt) 278 | 279 | setInt32OptFromRestricted :: Integral i => ZMQOption -> Restricted r i -> Socket b -> IO () 280 | setInt32OptFromRestricted o x s = setIntOpt s o ((fromIntegral . rvalue $ x) :: CInt) 281 | 282 | ctxIntOption :: Integral i => String -> ZMQCtxOption -> Context -> IO i 283 | ctxIntOption name opt ctx = fromIntegral <$> 284 | (throwIfMinus1 name $ c_zmq_ctx_get (_ctx ctx) (ctxOptVal opt)) 285 | 286 | setCtxIntOption :: Integral i => String -> ZMQCtxOption -> i -> Context -> IO () 287 | setCtxIntOption name opt val ctx = throwIfMinus1_ name $ 288 | c_zmq_ctx_set (_ctx ctx) (ctxOptVal opt) (fromIntegral val) 289 | 290 | z85Encode :: (MonadIO m) => Restricted Div4 SB.ByteString -> m SB.ByteString 291 | z85Encode b = liftIO $ UB.unsafeUseAsCStringLen (rvalue b) $ \(c, s) -> 292 | allocaBytes ((s * 5) `div` 4 + 1) $ \w -> do 293 | void . throwIfNull "z85Encode" $ 294 | c_zmq_z85_encode w (castPtr c) (fromIntegral s) 295 | SB.packCString w 296 | 297 | z85Decode :: (MonadIO m) => Restricted Div5 SB.ByteString -> m SB.ByteString 298 | z85Decode b = liftIO $ SB.useAsCStringLen (rvalue b) $ \(c, s) -> do 299 | let size = (s * 4) `div` 5 300 | allocaBytes size $ \w -> do 301 | void . throwIfNull "z85Decode" $ 302 | c_zmq_z85_decode (castPtr w) (castPtr c) 303 | SB.packCStringLen (w, size) 304 | 305 | getKey :: KeyFormat f -> Socket a -> ZMQOption -> IO SB.ByteString 306 | getKey kf sock (ZMQOption o) = onSocket "getKey" sock $ \s -> do 307 | let len = case kf of 308 | BinaryFormat -> 32 309 | TextFormat -> 41 310 | with len $ \lenptr -> allocaBytes len $ \w -> do 311 | throwIfMinus1Retry_ "getKey" $ 312 | c_zmq_getsockopt s (fromIntegral o) (castPtr w) (castPtr lenptr) 313 | SB.packCString w 314 | 315 | toZMQFlag :: Flag -> ZMQFlag 316 | toZMQFlag DontWait = dontWait 317 | toZMQFlag SendMore = sndMore 318 | 319 | combineFlags :: [Flag] -> CInt 320 | combineFlags = fromIntegral . combine . map (flagVal . toZMQFlag) 321 | 322 | combine :: (Integral i, Bits i) => [i] -> i 323 | combine = foldr (.|.) 0 324 | 325 | bool2cint :: Bool -> CInt 326 | bool2cint True = 1 327 | bool2cint False = 0 328 | 329 | toSwitch :: (Show a, Integral a) => String -> a -> Switch 330 | toSwitch _ (-1) = Default 331 | toSwitch _ 0 = Off 332 | toSwitch _ 1 = On 333 | toSwitch m n = error $ m ++ ": " ++ show n 334 | 335 | fromSwitch :: Integral a => Switch -> a 336 | fromSwitch Default = -1 337 | fromSwitch Off = 0 338 | fromSwitch On = 1 339 | 340 | toZMQEventType :: EventType -> ZMQEventType 341 | toZMQEventType AllEvents = allEvents 342 | toZMQEventType ConnectedEvent = connected 343 | toZMQEventType ConnectDelayedEvent = connectDelayed 344 | toZMQEventType ConnectRetriedEvent = connectRetried 345 | toZMQEventType ListeningEvent = listening 346 | toZMQEventType BindFailedEvent = bindFailed 347 | toZMQEventType AcceptedEvent = accepted 348 | toZMQEventType AcceptFailedEvent = acceptFailed 349 | toZMQEventType ClosedEvent = closed 350 | toZMQEventType CloseFailedEvent = closeFailed 351 | toZMQEventType DisconnectedEvent = disconnected 352 | toZMQEventType MonitorStoppedEvent = monitorStopped 353 | 354 | toMechanism :: SecurityMechanism -> ZMQSecMechanism 355 | toMechanism Null = secNull 356 | toMechanism Plain = secPlain 357 | toMechanism Curve = secCurve 358 | 359 | fromMechanism :: String -> Int -> SecurityMechanism 360 | fromMechanism s m 361 | | m == secMechanism secNull = Null 362 | | m == secMechanism secPlain = Plain 363 | | m == secMechanism secCurve = Curve 364 | | otherwise = error $ s ++ ": " ++ show m 365 | 366 | events2cint :: [EventType] -> CInt 367 | events2cint = fromIntegral . foldr ((.|.) . eventTypeVal . toZMQEventType) 0 368 | 369 | eventMessage :: SB.ByteString -> ZMQEvent -> EventMsg 370 | eventMessage str (ZMQEvent e v) 371 | | e == connected = Connected str (Fd . fromIntegral $ v) 372 | | e == connectDelayed = ConnectDelayed str 373 | | e == connectRetried = ConnectRetried str (fromIntegral $ v) 374 | | e == listening = Listening str (Fd . fromIntegral $ v) 375 | | e == bindFailed = BindFailed str (fromIntegral $ v) 376 | | e == accepted = Accepted str (Fd . fromIntegral $ v) 377 | | e == acceptFailed = AcceptFailed str (fromIntegral $ v) 378 | | e == closed = Closed str (Fd . fromIntegral $ v) 379 | | e == closeFailed = CloseFailed str (fromIntegral $ v) 380 | | e == disconnected = Disconnected str (fromIntegral $ v) 381 | | e == monitorStopped = MonitorStopped str (fromIntegral $ v) 382 | | otherwise = error $ "unknown event type: " ++ show e 383 | -------------------------------------------------------------------------------- /src/System/ZMQ4/Internal/Base.hsc: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE ForeignFunctionInterface #-} 3 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 4 | 5 | -- | /Warning/: This is an internal module and subject 6 | -- to change without notice. 7 | module System.ZMQ4.Internal.Base where 8 | 9 | import Foreign 10 | import Foreign.C.Types 11 | import Foreign.C.String 12 | import Control.Applicative 13 | import Prelude 14 | 15 | #include 16 | 17 | #if ZMQ_VERSION_MAJOR != 4 18 | #error *** INVALID 0MQ VERSION (must be 4.x) *** 19 | #endif 20 | 21 | ----------------------------------------------------------------------------- 22 | -- Message 23 | 24 | newtype ZMQMsg = ZMQMsg 25 | { content :: Ptr () 26 | } deriving (Eq, Ord) 27 | 28 | instance Storable ZMQMsg where 29 | alignment _ = #{alignment zmq_msg_t} 30 | sizeOf _ = #{size zmq_msg_t} 31 | peek p = ZMQMsg <$> #{peek zmq_msg_t, _} p 32 | poke p (ZMQMsg c) = #{poke zmq_msg_t, _} p c 33 | 34 | ----------------------------------------------------------------------------- 35 | -- Poll 36 | 37 | data ZMQPoll = ZMQPoll 38 | { pSocket :: {-# UNPACK #-} !ZMQSocket 39 | , pFd :: {-# UNPACK #-} !CInt 40 | , pEvents :: {-# UNPACK #-} !CShort 41 | , pRevents :: {-# UNPACK #-} !CShort 42 | } 43 | 44 | instance Storable ZMQPoll where 45 | alignment _ = #{alignment zmq_pollitem_t} 46 | sizeOf _ = #{size zmq_pollitem_t} 47 | peek p = do 48 | s <- #{peek zmq_pollitem_t, socket} p 49 | f <- #{peek zmq_pollitem_t, fd} p 50 | e <- #{peek zmq_pollitem_t, events} p 51 | re <- #{peek zmq_pollitem_t, revents} p 52 | return $ ZMQPoll s f e re 53 | poke p (ZMQPoll s f e re) = do 54 | #{poke zmq_pollitem_t, socket} p s 55 | #{poke zmq_pollitem_t, fd} p f 56 | #{poke zmq_pollitem_t, events} p e 57 | #{poke zmq_pollitem_t, revents} p re 58 | 59 | type ZMQMsgPtr = Ptr ZMQMsg 60 | type ZMQCtx = Ptr () 61 | type ZMQSocket = Ptr () 62 | type ZMQPollPtr = Ptr ZMQPoll 63 | 64 | #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) 65 | 66 | ----------------------------------------------------------------------------- 67 | -- Socket Types 68 | 69 | newtype ZMQSocketType = ZMQSocketType 70 | { typeVal :: CInt 71 | } deriving (Eq, Ord) 72 | 73 | #{enum ZMQSocketType, ZMQSocketType 74 | , pair = ZMQ_PAIR 75 | , pub = ZMQ_PUB 76 | , sub = ZMQ_SUB 77 | , xpub = ZMQ_XPUB 78 | , xsub = ZMQ_XSUB 79 | , request = ZMQ_REQ 80 | , response = ZMQ_REP 81 | , dealer = ZMQ_DEALER 82 | , router = ZMQ_ROUTER 83 | , pull = ZMQ_PULL 84 | , push = ZMQ_PUSH 85 | , stream = ZMQ_STREAM 86 | } 87 | 88 | ----------------------------------------------------------------------------- 89 | -- Socket Options 90 | 91 | newtype ZMQOption = ZMQOption 92 | { optVal :: CInt 93 | } deriving (Eq, Ord) 94 | 95 | #{enum ZMQOption, ZMQOption 96 | , affinity = ZMQ_AFFINITY 97 | , backlog = ZMQ_BACKLOG 98 | , conflate = ZMQ_CONFLATE 99 | , curve = ZMQ_CURVE 100 | , curvePublicKey = ZMQ_CURVE_PUBLICKEY 101 | , curveSecretKey = ZMQ_CURVE_SECRETKEY 102 | , curveServer = ZMQ_CURVE_SERVER 103 | , curveServerKey = ZMQ_CURVE_SERVERKEY 104 | , delayAttachOnConnect = ZMQ_DELAY_ATTACH_ON_CONNECT 105 | , events = ZMQ_EVENTS 106 | , filedesc = ZMQ_FD 107 | , identity = ZMQ_IDENTITY 108 | , immediate = ZMQ_IMMEDIATE 109 | , ipv4Only = ZMQ_IPV4ONLY 110 | , ipv6 = ZMQ_IPV6 111 | , lastEndpoint = ZMQ_LAST_ENDPOINT 112 | , linger = ZMQ_LINGER 113 | , maxMessageSize = ZMQ_MAXMSGSIZE 114 | , mcastHops = ZMQ_MULTICAST_HOPS 115 | , mechanism = ZMQ_MECHANISM 116 | , null = ZMQ_NULL 117 | , plain = ZMQ_PLAIN 118 | , plainPassword = ZMQ_PLAIN_PASSWORD 119 | , plainServer = ZMQ_PLAIN_SERVER 120 | , plainUserName = ZMQ_PLAIN_USERNAME 121 | , probeRouter = ZMQ_PROBE_ROUTER 122 | , rate = ZMQ_RATE 123 | , receiveBuf = ZMQ_RCVBUF 124 | , receiveHighWM = ZMQ_RCVHWM 125 | , receiveMore = ZMQ_RCVMORE 126 | , receiveTimeout = ZMQ_RCVTIMEO 127 | , reconnectIVL = ZMQ_RECONNECT_IVL 128 | , reconnectIVLMax = ZMQ_RECONNECT_IVL_MAX 129 | , recoveryIVL = ZMQ_RECOVERY_IVL 130 | , reqCorrelate = ZMQ_REQ_CORRELATE 131 | , reqRelaxed = ZMQ_REQ_RELAXED 132 | , routerMandatory = ZMQ_ROUTER_MANDATORY 133 | , sendBuf = ZMQ_SNDBUF 134 | , sendHighWM = ZMQ_SNDHWM 135 | , sendTimeout = ZMQ_SNDTIMEO 136 | , subscribe = ZMQ_SUBSCRIBE 137 | , tcpAcceptFilter = ZMQ_TCP_ACCEPT_FILTER 138 | , tcpKeepAlive = ZMQ_TCP_KEEPALIVE 139 | , tcpKeepAliveCount = ZMQ_TCP_KEEPALIVE_CNT 140 | , tcpKeepAliveIdle = ZMQ_TCP_KEEPALIVE_IDLE 141 | , tcpKeepAliveInterval = ZMQ_TCP_KEEPALIVE_INTVL 142 | , unsubscribe = ZMQ_UNSUBSCRIBE 143 | , xpubVerbose = ZMQ_XPUB_VERBOSE 144 | , zapDomain = ZMQ_ZAP_DOMAIN 145 | } 146 | 147 | ----------------------------------------------------------------------------- 148 | -- Context Options 149 | 150 | newtype ZMQCtxOption = ZMQCtxOption 151 | { ctxOptVal :: CInt 152 | } deriving (Eq, Ord) 153 | 154 | #{enum ZMQCtxOption, ZMQCtxOption 155 | , _ioThreads = ZMQ_IO_THREADS 156 | , _maxSockets = ZMQ_MAX_SOCKETS 157 | } 158 | 159 | ----------------------------------------------------------------------------- 160 | -- Event Type 161 | 162 | newtype ZMQEventType = ZMQEventType 163 | { eventTypeVal :: Word16 164 | } deriving (Eq, Ord, Show, Storable) 165 | 166 | #{enum ZMQEventType, ZMQEventType 167 | , connected = ZMQ_EVENT_CONNECTED 168 | , connectDelayed = ZMQ_EVENT_CONNECT_DELAYED 169 | , connectRetried = ZMQ_EVENT_CONNECT_RETRIED 170 | , listening = ZMQ_EVENT_LISTENING 171 | , bindFailed = ZMQ_EVENT_BIND_FAILED 172 | , accepted = ZMQ_EVENT_ACCEPTED 173 | , acceptFailed = ZMQ_EVENT_ACCEPT_FAILED 174 | , closed = ZMQ_EVENT_CLOSED 175 | , closeFailed = ZMQ_EVENT_CLOSE_FAILED 176 | , disconnected = ZMQ_EVENT_DISCONNECTED 177 | , allEvents = ZMQ_EVENT_ALL 178 | , monitorStopped = ZMQ_EVENT_MONITOR_STOPPED 179 | } 180 | 181 | ----------------------------------------------------------------------------- 182 | -- Event 183 | 184 | data ZMQEvent = ZMQEvent 185 | { zeEvent :: {-# UNPACK #-} !ZMQEventType 186 | , zeValue :: {-# UNPACK #-} !Int32 187 | } 188 | 189 | #if ZMQ_VERSION < 40100 190 | instance Storable ZMQEvent where 191 | alignment _ = #{alignment zmq_event_t} 192 | sizeOf _ = #{size zmq_event_t} 193 | peek e = ZMQEvent 194 | <$> (ZMQEventType <$> #{peek zmq_event_t, event} e) 195 | <*> #{peek zmq_event_t, value} e 196 | poke e (ZMQEvent (ZMQEventType a) b) = do 197 | #{poke zmq_event_t, event} e a 198 | #{poke zmq_event_t, value} e b 199 | #endif 200 | 201 | peekZMQEvent :: ZMQMsgPtr -> IO ZMQEvent 202 | peekZMQEvent m = do 203 | p <- c_zmq_msg_data m 204 | #if ZMQ_VERSION < 40100 205 | peek p 206 | #else 207 | e <- peek p 208 | v <- peek (p `plusPtr` 2) 209 | return (ZMQEvent e v) 210 | #endif 211 | 212 | ----------------------------------------------------------------------------- 213 | -- Security Mechanism 214 | 215 | newtype ZMQSecMechanism = ZMQSecMechanism 216 | { secMechanism :: Int 217 | } deriving (Eq, Ord, Show) 218 | 219 | #{enum ZMQSecMechanism, ZMQSecMechanism 220 | , secNull = ZMQ_NULL 221 | , secPlain = ZMQ_PLAIN 222 | , secCurve = ZMQ_CURVE 223 | } 224 | 225 | ----------------------------------------------------------------------------- 226 | -- Message Options 227 | 228 | newtype ZMQMsgOption = ZMQMsgOption 229 | { msgOptVal :: CInt 230 | } deriving (Eq, Ord) 231 | 232 | #{enum ZMQMsgOption, ZMQMsgOption 233 | , more = ZMQ_MORE 234 | } 235 | 236 | ----------------------------------------------------------------------------- 237 | -- Flags 238 | 239 | newtype ZMQFlag = ZMQFlag 240 | { flagVal :: CInt 241 | } deriving (Eq, Ord) 242 | 243 | #{enum ZMQFlag, ZMQFlag 244 | , dontWait = ZMQ_DONTWAIT 245 | , sndMore = ZMQ_SNDMORE 246 | } 247 | 248 | ----------------------------------------------------------------------------- 249 | -- Poll Events 250 | 251 | newtype ZMQPollEvent = ZMQPollEvent 252 | { pollVal :: CShort 253 | } deriving (Eq, Ord) 254 | 255 | #{enum ZMQPollEvent, ZMQPollEvent, 256 | pollIn = ZMQ_POLLIN, 257 | pollOut = ZMQ_POLLOUT, 258 | pollerr = ZMQ_POLLERR 259 | } 260 | 261 | ----------------------------------------------------------------------------- 262 | -- function declarations 263 | 264 | -- general initialization 265 | 266 | foreign import ccall unsafe "zmq.h zmq_version" 267 | c_zmq_version :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO () 268 | 269 | foreign import ccall unsafe "zmq.h zmq_ctx_new" 270 | c_zmq_ctx_new :: IO ZMQCtx 271 | 272 | foreign import ccall unsafe "zmq.h zmq_ctx_shutdown" 273 | c_zmq_ctx_shutdown :: ZMQCtx -> IO CInt 274 | 275 | foreign import ccall unsafe "zmq.h zmq_ctx_term" 276 | c_zmq_ctx_term :: ZMQCtx -> IO CInt 277 | 278 | foreign import ccall unsafe "zmq.h zmq_ctx_get" 279 | c_zmq_ctx_get :: ZMQCtx -> CInt -> IO CInt 280 | 281 | foreign import ccall unsafe "zmq.h zmq_ctx_set" 282 | c_zmq_ctx_set :: ZMQCtx -> CInt -> CInt -> IO CInt 283 | 284 | -- zmq_msg_t related 285 | 286 | foreign import ccall unsafe "zmq.h zmq_msg_init" 287 | c_zmq_msg_init :: ZMQMsgPtr -> IO CInt 288 | 289 | foreign import ccall unsafe "zmq.h zmq_msg_init_size" 290 | c_zmq_msg_init_size :: ZMQMsgPtr -> CSize -> IO CInt 291 | 292 | foreign import ccall unsafe "zmq.h zmq_msg_close" 293 | c_zmq_msg_close :: ZMQMsgPtr -> IO CInt 294 | 295 | foreign import ccall unsafe "zmq.h zmq_msg_data" 296 | c_zmq_msg_data :: ZMQMsgPtr -> IO (Ptr a) 297 | 298 | foreign import ccall unsafe "zmq.h zmq_msg_size" 299 | c_zmq_msg_size :: ZMQMsgPtr -> IO CSize 300 | 301 | foreign import ccall unsafe "zmq.h zmq_msg_get" 302 | c_zmq_msg_get :: ZMQMsgPtr -> CInt -> IO CInt 303 | 304 | foreign import ccall unsafe "zmq.h zmq_msg_set" 305 | c_zmq_msg_set :: ZMQMsgPtr -> CInt -> CInt -> IO CInt 306 | 307 | -- socket 308 | 309 | foreign import ccall unsafe "zmq.h zmq_socket" 310 | c_zmq_socket :: ZMQCtx -> CInt -> IO ZMQSocket 311 | 312 | foreign import ccall unsafe "zmq.h zmq_close" 313 | c_zmq_close :: ZMQSocket -> IO CInt 314 | 315 | foreign import ccall unsafe "zmq.h zmq_setsockopt" 316 | c_zmq_setsockopt :: ZMQSocket 317 | -> CInt -- option 318 | -> Ptr () -- option value 319 | -> CSize -- option value size 320 | -> IO CInt 321 | 322 | foreign import ccall unsafe "zmq.h zmq_getsockopt" 323 | c_zmq_getsockopt :: ZMQSocket 324 | -> CInt -- option 325 | -> Ptr () -- option value 326 | -> Ptr CSize -- option value size ptr 327 | -> IO CInt 328 | 329 | foreign import ccall unsafe "zmq.h zmq_bind" 330 | c_zmq_bind :: ZMQSocket -> CString -> IO CInt 331 | 332 | foreign import ccall unsafe "zmq.h zmq_unbind" 333 | c_zmq_unbind :: ZMQSocket -> CString -> IO CInt 334 | 335 | foreign import ccall unsafe "zmq.h zmq_connect" 336 | c_zmq_connect :: ZMQSocket -> CString -> IO CInt 337 | 338 | foreign import ccall unsafe "zmq.h zmq_disconnect" 339 | c_zmq_disconnect :: ZMQSocket -> CString -> IO CInt 340 | 341 | #ifdef mingw32_HOST_OS 342 | foreign import ccall safe "zmq.h zmq_sendmsg" 343 | c_zmq_sendmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt 344 | 345 | foreign import ccall safe "zmq.h zmq_recvmsg" 346 | c_zmq_recvmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt 347 | #else 348 | foreign import ccall unsafe "zmq.h zmq_sendmsg" 349 | c_zmq_sendmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt 350 | 351 | foreign import ccall unsafe "zmq.h zmq_recvmsg" 352 | c_zmq_recvmsg :: ZMQSocket -> ZMQMsgPtr -> CInt -> IO CInt 353 | #endif 354 | 355 | foreign import ccall unsafe "zmq.h zmq_socket_monitor" 356 | c_zmq_socket_monitor :: ZMQSocket -> CString -> CInt -> IO CInt 357 | 358 | -- errors 359 | 360 | foreign import ccall unsafe "zmq.h zmq_errno" 361 | c_zmq_errno :: IO CInt 362 | 363 | foreign import ccall unsafe "zmq.h zmq_strerror" 364 | c_zmq_strerror :: CInt -> IO CString 365 | 366 | -- proxy 367 | 368 | foreign import ccall safe "zmq.h zmq_proxy" 369 | c_zmq_proxy :: ZMQSocket -> ZMQSocket -> ZMQSocket -> IO CInt 370 | 371 | -- poll 372 | 373 | foreign import ccall safe "zmq.h zmq_poll" 374 | c_zmq_poll :: ZMQPollPtr -> CInt -> CLong -> IO CInt 375 | 376 | -- Z85 encode/decode 377 | 378 | foreign import ccall unsafe "zmq.h zmq_z85_encode" 379 | c_zmq_z85_encode :: CString -> Ptr Word8 -> CSize -> IO CString 380 | 381 | foreign import ccall unsafe "zmq.h zmq_z85_decode" 382 | c_zmq_z85_decode :: Ptr Word8 -> CString -> IO (Ptr Word8) 383 | 384 | -- curve crypto 385 | 386 | foreign import ccall unsafe "zmq.h zmq_curve_keypair" 387 | c_zmq_curve_keypair :: CString -> CString -> IO CInt 388 | 389 | -------------------------------------------------------------------------------- /src/System/ZMQ4/Internal/Error.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | 3 | -- | We use our own functions for throwing exceptions in order to get 4 | -- the actual error message via 'zmq_strerror'. 0MQ defines additional 5 | -- error numbers besides those defined by the operating system, so 6 | -- 'zmq_strerror' should be used in preference to 'strerror' which is 7 | -- used by the standard throw* functions in 'Foreign.C.Error'. 8 | -- 9 | -- /Warning/: This is an internal module and subject 10 | -- to change without notice. 11 | module System.ZMQ4.Internal.Error where 12 | 13 | import Control.Applicative 14 | import Control.Monad 15 | import Control.Exception 16 | import Text.Printf 17 | import Data.Typeable (Typeable) 18 | 19 | import Foreign hiding (throwIf, throwIf_, void) 20 | import Foreign.C.Error 21 | import Foreign.C.String 22 | import Foreign.C.Types (CInt) 23 | import Prelude 24 | 25 | import System.ZMQ4.Internal.Base 26 | 27 | -- | ZMQError encapsulates information about errors, which occur 28 | -- when using the native 0MQ API, such as error number and message. 29 | data ZMQError = ZMQError 30 | { errno :: Int -- ^ Error number value. 31 | , source :: String -- ^ Source where this error originates from. 32 | , message :: String -- ^ Actual error message. 33 | } deriving (Eq, Ord, Typeable) 34 | 35 | instance Show ZMQError where 36 | show e = printf "ZMQError { errno = %d, source = \"%s\", message = \"%s\" }" 37 | (errno e) (source e) (message e) 38 | 39 | instance Exception ZMQError 40 | 41 | throwError :: String -> IO a 42 | throwError src = do 43 | (Errno e) <- zmqErrno 44 | msg <- zmqErrnoMessage e 45 | throwIO $ ZMQError (fromIntegral e) src msg 46 | 47 | throwIf :: (a -> Bool) -> String -> IO a -> IO a 48 | throwIf p src act = do 49 | r <- act 50 | if p r then throwError src else return r 51 | 52 | throwIf_ :: (a -> Bool) -> String -> IO a -> IO () 53 | throwIf_ p src act = void $ throwIf p src act 54 | 55 | throwIfRetry :: (a -> Bool) -> String -> IO a -> IO a 56 | throwIfRetry p src act = do 57 | r <- act 58 | if p r then zmqErrno >>= k else return r 59 | where 60 | k e | e == eINTR = throwIfRetry p src act 61 | | otherwise = throwError src 62 | 63 | throwIfRetry_ :: (a -> Bool) -> String -> IO a -> IO () 64 | throwIfRetry_ p src act = void $ throwIfRetry p src act 65 | 66 | throwIfMinus1 :: (Eq a, Num a) => String -> IO a -> IO a 67 | throwIfMinus1 = throwIf (== -1) 68 | 69 | throwIfMinus1_ :: (Eq a, Num a) => String -> IO a -> IO () 70 | throwIfMinus1_ = throwIf_ (== -1) 71 | 72 | throwIfNull :: String -> IO (Ptr a) -> IO (Ptr a) 73 | throwIfNull = throwIf (== nullPtr) 74 | 75 | throwIfMinus1Retry :: (Eq a, Num a) => String -> IO a -> IO a 76 | throwIfMinus1Retry = throwIfRetry (== -1) 77 | 78 | throwIfMinus1Retry_ :: (Eq a, Num a) => String -> IO a -> IO () 79 | throwIfMinus1Retry_ = throwIfRetry_ (== -1) 80 | 81 | throwIfRetryMayBlock :: (a -> Bool) -> String -> IO a -> IO b -> IO a 82 | throwIfRetryMayBlock p src f on_block = do 83 | r <- f 84 | if p r then zmqErrno >>= k else return r 85 | where 86 | k e | e == eINTR = throwIfRetryMayBlock p src f on_block 87 | | e == eWOULDBLOCK || e == eAGAIN = on_block >> throwIfRetryMayBlock p src f on_block 88 | | otherwise = throwError src 89 | 90 | throwIfRetryMayBlock_ :: (a -> Bool) -> String -> IO a -> IO b -> IO () 91 | throwIfRetryMayBlock_ p src f on_block = void $ throwIfRetryMayBlock p src f on_block 92 | 93 | throwIfMinus1RetryMayBlock :: (Eq a, Num a) => String -> IO a -> IO b -> IO a 94 | throwIfMinus1RetryMayBlock = throwIfRetryMayBlock (== -1) 95 | 96 | throwIfMinus1RetryMayBlock_ :: (Eq a, Num a) => String -> IO a -> IO b -> IO () 97 | throwIfMinus1RetryMayBlock_ = throwIfRetryMayBlock_ (== -1) 98 | 99 | zmqErrnoMessage :: CInt -> IO String 100 | zmqErrnoMessage e = c_zmq_strerror e >>= peekCString 101 | 102 | zmqErrno :: IO Errno 103 | zmqErrno = Errno <$> c_zmq_errno 104 | -------------------------------------------------------------------------------- /src/System/ZMQ4/Monadic.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE RankNTypes #-} 2 | {-# LANGUAGE GeneralizedNewtypeDeriving #-} 3 | {-# LANGUAGE MultiParamTypeClasses #-} 4 | {-# LANGUAGE TypeFamilies #-} 5 | {-# OPTIONS_GHC -fno-warn-warnings-deprecations #-} 6 | 7 | -- | 8 | -- Module : System.ZMQ4.Monadic 9 | -- Copyright : (c) 2013 Toralf Wittner 10 | -- License : MIT 11 | -- Maintainer : Toralf Wittner 12 | -- Stability : experimental 13 | -- Portability : non-portable 14 | -- 15 | -- This modules exposes a monadic interface of 'System.ZMQ4'. Actions run 16 | -- inside a 'ZMQ' monad and 'Socket's are guaranteed not to leak outside 17 | -- their corresponding 'runZMQ' scope. Running 'ZMQ' computations 18 | -- asynchronously is directly supported through 'async'. 19 | module System.ZMQ4.Monadic 20 | ( -- * Type Definitions 21 | ZMQ 22 | , Socket 23 | , Z.Flag (..) 24 | , Z.Switch (..) 25 | , Z.Timeout 26 | , Z.Event (..) 27 | , Z.EventType (..) 28 | , Z.EventMsg (..) 29 | , Z.Poll (..) 30 | , Z.KeyFormat (..) 31 | , Z.SecurityMechanism (..) 32 | 33 | -- ** Socket type-classes 34 | , Z.SocketType 35 | , Z.Sender 36 | , Z.Receiver 37 | , Z.Subscriber 38 | , Z.SocketLike 39 | , Z.Conflatable 40 | , Z.SendProbe 41 | 42 | -- ** Socket Types 43 | , Z.Pair (..) 44 | , Z.Pub (..) 45 | , Z.Sub (..) 46 | , Z.XPub (..) 47 | , Z.XSub (..) 48 | , Z.Req (..) 49 | , Z.Rep (..) 50 | , Z.Dealer (..) 51 | , Z.Router (..) 52 | , Z.Pull (..) 53 | , Z.Push (..) 54 | , Z.Stream (..) 55 | 56 | -- * General Operations 57 | , version 58 | , runZMQ 59 | , async 60 | , socket 61 | 62 | -- * ZMQ Options (Read) 63 | , ioThreads 64 | , maxSockets 65 | 66 | -- * ZMQ Options (Write) 67 | , setIoThreads 68 | , setMaxSockets 69 | 70 | -- * Socket operations 71 | , close 72 | , bind 73 | , unbind 74 | , connect 75 | , disconnect 76 | , send 77 | , send' 78 | , sendMulti 79 | , receive 80 | , receiveMulti 81 | , subscribe 82 | , unsubscribe 83 | , proxy 84 | , monitor 85 | , socketMonitor 86 | , Z.poll 87 | 88 | -- * Socket Options (Read) 89 | , affinity 90 | , backlog 91 | , conflate 92 | , curvePublicKey 93 | , curveSecretKey 94 | , curveServerKey 95 | , delayAttachOnConnect 96 | , events 97 | , fileDescriptor 98 | , identity 99 | , immediate 100 | , ipv4Only 101 | , ipv6 102 | , lastEndpoint 103 | , linger 104 | , maxMessageSize 105 | , mcastHops 106 | , mechanism 107 | , moreToReceive 108 | , plainServer 109 | , plainPassword 110 | , plainUserName 111 | , rate 112 | , receiveBuffer 113 | , receiveHighWM 114 | , receiveTimeout 115 | , reconnectInterval 116 | , reconnectIntervalMax 117 | , recoveryInterval 118 | , sendBuffer 119 | , sendHighWM 120 | , sendTimeout 121 | , tcpKeepAlive 122 | , tcpKeepAliveCount 123 | , tcpKeepAliveIdle 124 | , tcpKeepAliveInterval 125 | , zapDomain 126 | 127 | -- * Socket Options (Write) 128 | , setAffinity 129 | , setBacklog 130 | , setConflate 131 | , setCurveServer 132 | , setCurvePublicKey 133 | , setCurveSecretKey 134 | , setCurveServerKey 135 | , setDelayAttachOnConnect 136 | , setIdentity 137 | , setImmediate 138 | , setIpv4Only 139 | , setIpv6 140 | , setLinger 141 | , setMaxMessageSize 142 | , setMcastHops 143 | , setPlainServer 144 | , setPlainPassword 145 | , setPlainUserName 146 | , setProbeRouter 147 | , setRate 148 | , setReceiveBuffer 149 | , setReceiveHighWM 150 | , setReceiveTimeout 151 | , setReconnectInterval 152 | , setReconnectIntervalMax 153 | , setRecoveryInterval 154 | , setReqCorrelate 155 | , setReqRelaxed 156 | , setRouterMandatory 157 | , setSendBuffer 158 | , setSendHighWM 159 | , setSendTimeout 160 | , setTcpAcceptFilter 161 | , setTcpKeepAlive 162 | , setTcpKeepAliveCount 163 | , setTcpKeepAliveIdle 164 | , setTcpKeepAliveInterval 165 | , setXPubVerbose 166 | 167 | -- * Error Handling 168 | , Z.ZMQError 169 | , Z.errno 170 | , Z.source 171 | , Z.message 172 | 173 | -- * Re-exports 174 | , Control.Monad.IO.Class.liftIO 175 | , Data.Restricted.restrict 176 | , Data.Restricted.toRestricted 177 | 178 | -- * Low-level Functions 179 | , waitRead 180 | , waitWrite 181 | , I.z85Encode 182 | , I.z85Decode 183 | , Z.curveKeyPair 184 | ) where 185 | 186 | import Control.Applicative 187 | import Control.Concurrent.Async (Async) 188 | import Control.Monad 189 | import Control.Monad.Base (MonadBase(..)) 190 | import Control.Monad.Catch 191 | import Control.Monad.IO.Class 192 | import Control.Monad.Trans.Control (MonadBaseControl(..)) 193 | import Control.Monad.Trans.Reader 194 | import Data.Int 195 | import Data.IORef 196 | import Data.List.NonEmpty (NonEmpty) 197 | import Data.Restricted 198 | import Data.Word 199 | import Data.ByteString (ByteString) 200 | import System.Posix.Types (Fd) 201 | import Prelude 202 | 203 | import qualified Control.Concurrent.Async as A 204 | import qualified Control.Exception as E 205 | import qualified Control.Monad.Catch as C 206 | import qualified Data.ByteString.Lazy as Lazy 207 | import qualified System.ZMQ4 as Z 208 | import qualified System.ZMQ4.Internal as I 209 | 210 | data ZMQEnv = ZMQEnv 211 | { _refcount :: !(IORef Word) 212 | , _context :: !Z.Context 213 | , _sockets :: !(IORef [I.SocketRepr]) 214 | } 215 | 216 | -- | The ZMQ monad is modeled after 'Control.Monad.ST' and encapsulates 217 | -- a 'System.ZMQ4.Context'. It uses the uninstantiated type variable 'z' to 218 | -- distinguish different invoctions of 'runZMQ' and to prevent 219 | -- unintented use of 'Socket's outside their scope. Cf. the paper 220 | -- of John Launchbury and Simon Peyton Jones /Lazy Functional State Threads/. 221 | newtype ZMQ z a = ZMQ { _unzmq :: ReaderT ZMQEnv IO a } 222 | deriving (MonadBase IO) 223 | 224 | -- | The ZMQ socket, parameterised by 'SocketType' and belonging to 225 | -- a particular 'ZMQ' thread. 226 | newtype Socket z t = Socket { _unsocket :: Z.Socket t } 227 | 228 | instance I.SocketLike (Socket z) where 229 | toSocket = _unsocket 230 | 231 | instance Monad (ZMQ z) where 232 | return = ZMQ . return 233 | (ZMQ m) >>= f = ZMQ $ m >>= _unzmq . f 234 | 235 | instance MonadIO (ZMQ z) where 236 | liftIO m = ZMQ $! liftIO m 237 | 238 | instance MonadBaseControl IO (ZMQ z) where 239 | type StM (ZMQ z) a = a 240 | liftBaseWith = \f -> ZMQ $ liftBaseWith $ \q -> f (q . _unzmq) 241 | restoreM = ZMQ . restoreM 242 | 243 | instance MonadThrow (ZMQ z) where 244 | throwM = ZMQ . C.throwM 245 | 246 | instance MonadCatch (ZMQ z) where 247 | catch (ZMQ m) f = ZMQ $ m `C.catch` (_unzmq . f) 248 | 249 | instance MonadMask (ZMQ z) where 250 | mask a = ZMQ . ReaderT $ \env -> 251 | C.mask $ \restore -> 252 | let f :: forall r a . ZMQ r a -> ZMQ r a 253 | f (ZMQ (ReaderT b)) = ZMQ $ ReaderT (restore . b) 254 | in runReaderT (_unzmq (a $ f)) env 255 | 256 | uninterruptibleMask a = ZMQ . ReaderT $ \env -> 257 | C.uninterruptibleMask $ \restore -> 258 | let f :: forall r a . ZMQ r a -> ZMQ r a 259 | f (ZMQ (ReaderT b)) = ZMQ $ ReaderT (restore . b) 260 | in runReaderT (_unzmq (a $ f)) env 261 | 262 | instance Functor (ZMQ z) where 263 | fmap = liftM 264 | 265 | instance Applicative (ZMQ z) where 266 | pure = return 267 | (<*>) = ap 268 | 269 | -- | Return the value computed by the given 'ZMQ' monad. Rank-2 270 | -- polymorphism is used to prevent leaking of 'z'. 271 | -- An invocation of 'runZMQ' will internally create a 'System.ZMQ4.Context' 272 | -- and all actions are executed relative to this context. On finish the 273 | -- context will be disposed, but see 'async'. 274 | runZMQ :: MonadIO m => (forall z. ZMQ z a) -> m a 275 | runZMQ z = liftIO $ E.bracket make term (runReaderT (_unzmq z)) 276 | where 277 | make = ZMQEnv <$> newIORef 1 <*> Z.context <*> newIORef [] 278 | 279 | -- | Run the given 'ZMQ' computation asynchronously, i.e. this function 280 | -- runs the computation in a new thread using 'Control.Concurrent.Async.async'. 281 | -- /N.B./ reference counting is used to prolong the lifetime of the 282 | -- 'System.ZMQ.Context' encapsulated in 'ZMQ' as necessary, e.g.: 283 | -- 284 | -- @ 285 | -- runZMQ $ do 286 | -- s <- socket Pair 287 | -- async $ do 288 | -- liftIO (threadDelay 10000000) 289 | -- identity s >>= liftIO . print 290 | -- @ 291 | -- 292 | -- Here, 'runZMQ' will finish before the code section in 'async', but due to 293 | -- reference counting, the 'System.ZMQ4.Context' will only be disposed after 294 | -- 'async' finishes as well. 295 | async :: ZMQ z a -> ZMQ z (Async a) 296 | async z = ZMQ $ do 297 | e <- ask 298 | liftIO $ atomicModifyIORef (_refcount e) $ \n -> (succ n, ()) 299 | liftIO . A.async $ (runReaderT (_unzmq z) e) `E.finally` term e 300 | 301 | ioThreads :: ZMQ z Word 302 | ioThreads = onContext Z.ioThreads 303 | 304 | setIoThreads :: Word -> ZMQ z () 305 | setIoThreads = onContext . Z.setIoThreads 306 | 307 | maxSockets :: ZMQ z Word 308 | maxSockets = onContext Z.maxSockets 309 | 310 | setMaxSockets :: Word -> ZMQ z () 311 | setMaxSockets = onContext . Z.setMaxSockets 312 | 313 | socket :: Z.SocketType t => t -> ZMQ z (Socket z t) 314 | socket t = ZMQ $ do 315 | c <- asks _context 316 | s <- asks _sockets 317 | x <- liftIO $ I.mkSocketRepr t c 318 | liftIO $ atomicModifyIORef s $ \ss -> (x:ss, ()) 319 | return (Socket (I.Socket x)) 320 | 321 | version :: ZMQ z (Int, Int, Int) 322 | version = liftIO $! Z.version 323 | 324 | -- * Socket operations 325 | 326 | close :: Socket z t -> ZMQ z () 327 | close = liftIO . Z.close . _unsocket 328 | 329 | bind :: Socket z t -> String -> ZMQ z () 330 | bind s = liftIO . Z.bind (_unsocket s) 331 | 332 | unbind :: Socket z t -> String -> ZMQ z () 333 | unbind s = liftIO . Z.unbind (_unsocket s) 334 | 335 | connect :: Socket z t -> String -> ZMQ z () 336 | connect s = liftIO . Z.connect (_unsocket s) 337 | 338 | disconnect :: Socket z t -> String -> ZMQ z () 339 | disconnect s = liftIO . Z.disconnect (_unsocket s) 340 | 341 | send :: Z.Sender t => Socket z t -> [Z.Flag] -> ByteString -> ZMQ z () 342 | send s f = liftIO . Z.send (_unsocket s) f 343 | 344 | send' :: Z.Sender t => Socket z t -> [Z.Flag] -> Lazy.ByteString -> ZMQ z () 345 | send' s f = liftIO . Z.send' (_unsocket s) f 346 | 347 | sendMulti :: Z.Sender t => Socket z t -> NonEmpty ByteString -> ZMQ z () 348 | sendMulti s = liftIO . Z.sendMulti (_unsocket s) 349 | 350 | receive :: Z.Receiver t => Socket z t -> ZMQ z ByteString 351 | receive = liftIO . Z.receive . _unsocket 352 | 353 | receiveMulti :: Z.Receiver t => Socket z t -> ZMQ z [ByteString] 354 | receiveMulti = liftIO . Z.receiveMulti . _unsocket 355 | 356 | subscribe :: Z.Subscriber t => Socket z t -> ByteString -> ZMQ z () 357 | subscribe s = liftIO . Z.subscribe (_unsocket s) 358 | 359 | unsubscribe :: Z.Subscriber t => Socket z t -> ByteString -> ZMQ z () 360 | unsubscribe s = liftIO . Z.unsubscribe (_unsocket s) 361 | 362 | proxy :: Socket z a -> Socket z b -> Maybe (Socket z c) -> ZMQ z () 363 | proxy a b c = liftIO $ Z.proxy (_unsocket a) (_unsocket b) (_unsocket <$> c) 364 | 365 | monitor :: [Z.EventType] -> Socket z t -> ZMQ z (Bool -> IO (Maybe Z.EventMsg)) 366 | monitor es s = onContext $ \ctx -> Z.monitor es ctx (_unsocket s) 367 | 368 | socketMonitor :: [Z.EventType] -> String -> Socket z t -> ZMQ z () 369 | socketMonitor es addr s = liftIO $ Z.socketMonitor es addr (_unsocket s) 370 | 371 | -- * Socket Options (Read) 372 | 373 | affinity :: Socket z t -> ZMQ z Word64 374 | affinity = liftIO . Z.affinity . _unsocket 375 | 376 | backlog :: Socket z t -> ZMQ z Int 377 | backlog = liftIO . Z.backlog . _unsocket 378 | 379 | conflate :: Z.Conflatable t => Socket z t -> ZMQ z Bool 380 | conflate = liftIO . Z.conflate . _unsocket 381 | 382 | curvePublicKey :: Z.KeyFormat f -> Socket z t -> ZMQ z ByteString 383 | curvePublicKey f = liftIO . Z.curvePublicKey f . _unsocket 384 | 385 | curveSecretKey :: Z.KeyFormat f -> Socket z t -> ZMQ z ByteString 386 | curveSecretKey f = liftIO . Z.curveSecretKey f . _unsocket 387 | 388 | curveServerKey :: Z.KeyFormat f -> Socket z t -> ZMQ z ByteString 389 | curveServerKey f = liftIO . Z.curveServerKey f . _unsocket 390 | 391 | delayAttachOnConnect :: Socket z t -> ZMQ z Bool 392 | delayAttachOnConnect = liftIO . Z.delayAttachOnConnect . _unsocket 393 | {-# DEPRECATED delayAttachOnConnect "Use immediate" #-} 394 | 395 | events :: Socket z t -> ZMQ z [Z.Event] 396 | events = liftIO . Z.events . _unsocket 397 | 398 | fileDescriptor :: Socket z t -> ZMQ z Fd 399 | fileDescriptor = liftIO . Z.fileDescriptor . _unsocket 400 | 401 | identity :: Socket z t -> ZMQ z ByteString 402 | identity = liftIO . Z.identity . _unsocket 403 | 404 | immediate :: Socket z t -> ZMQ z Bool 405 | immediate = liftIO . Z.immediate . _unsocket 406 | 407 | ipv4Only :: Socket z t -> ZMQ z Bool 408 | ipv4Only = liftIO . Z.ipv4Only . _unsocket 409 | {-# DEPRECATED ipv4Only "Use ipv6" #-} 410 | 411 | ipv6 :: Socket z t -> ZMQ z Bool 412 | ipv6 = liftIO . Z.ipv6 . _unsocket 413 | 414 | lastEndpoint :: Socket z t -> ZMQ z String 415 | lastEndpoint = liftIO . Z.lastEndpoint . _unsocket 416 | 417 | linger :: Socket z t -> ZMQ z Int 418 | linger = liftIO . Z.linger . _unsocket 419 | 420 | maxMessageSize :: Socket z t -> ZMQ z Int64 421 | maxMessageSize = liftIO . Z.maxMessageSize . _unsocket 422 | 423 | mcastHops :: Socket z t -> ZMQ z Int 424 | mcastHops = liftIO . Z.mcastHops . _unsocket 425 | 426 | mechanism :: Socket z t -> ZMQ z Z.SecurityMechanism 427 | mechanism = liftIO . Z.mechanism . _unsocket 428 | 429 | moreToReceive :: Socket z t -> ZMQ z Bool 430 | moreToReceive = liftIO . Z.moreToReceive . _unsocket 431 | 432 | plainServer :: Socket z t -> ZMQ z Bool 433 | plainServer = liftIO . Z.plainServer . _unsocket 434 | 435 | plainPassword :: Socket z t -> ZMQ z ByteString 436 | plainPassword = liftIO . Z.plainPassword . _unsocket 437 | 438 | plainUserName :: Socket z t -> ZMQ z ByteString 439 | plainUserName = liftIO . Z.plainUserName . _unsocket 440 | 441 | rate :: Socket z t -> ZMQ z Int 442 | rate = liftIO . Z.rate . _unsocket 443 | 444 | receiveBuffer :: Socket z t -> ZMQ z Int 445 | receiveBuffer = liftIO . Z.receiveBuffer . _unsocket 446 | 447 | receiveHighWM :: Socket z t -> ZMQ z Int 448 | receiveHighWM = liftIO . Z.receiveHighWM . _unsocket 449 | 450 | receiveTimeout :: Socket z t -> ZMQ z Int 451 | receiveTimeout = liftIO . Z.receiveTimeout . _unsocket 452 | 453 | reconnectInterval :: Socket z t -> ZMQ z Int 454 | reconnectInterval = liftIO . Z.reconnectInterval . _unsocket 455 | 456 | reconnectIntervalMax :: Socket z t -> ZMQ z Int 457 | reconnectIntervalMax = liftIO . Z.reconnectIntervalMax . _unsocket 458 | 459 | recoveryInterval :: Socket z t -> ZMQ z Int 460 | recoveryInterval = liftIO . Z.recoveryInterval . _unsocket 461 | 462 | sendBuffer :: Socket z t -> ZMQ z Int 463 | sendBuffer = liftIO . Z.sendBuffer . _unsocket 464 | 465 | sendHighWM :: Socket z t -> ZMQ z Int 466 | sendHighWM = liftIO . Z.sendHighWM . _unsocket 467 | 468 | sendTimeout :: Socket z t -> ZMQ z Int 469 | sendTimeout = liftIO . Z.sendTimeout . _unsocket 470 | 471 | tcpKeepAlive :: Socket z t -> ZMQ z Z.Switch 472 | tcpKeepAlive = liftIO . Z.tcpKeepAlive . _unsocket 473 | 474 | tcpKeepAliveCount :: Socket z t -> ZMQ z Int 475 | tcpKeepAliveCount = liftIO . Z.tcpKeepAliveCount . _unsocket 476 | 477 | tcpKeepAliveIdle :: Socket z t -> ZMQ z Int 478 | tcpKeepAliveIdle = liftIO . Z.tcpKeepAliveIdle . _unsocket 479 | 480 | tcpKeepAliveInterval :: Socket z t -> ZMQ z Int 481 | tcpKeepAliveInterval = liftIO . Z.tcpKeepAliveInterval . _unsocket 482 | 483 | zapDomain :: Socket z t -> ZMQ z ByteString 484 | zapDomain = liftIO . Z.zapDomain . _unsocket 485 | 486 | -- * Socket Options (Write) 487 | 488 | setAffinity :: Word64 -> Socket z t -> ZMQ z () 489 | setAffinity a = liftIO . Z.setAffinity a . _unsocket 490 | 491 | setBacklog :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 492 | setBacklog b = liftIO . Z.setBacklog b . _unsocket 493 | 494 | setConflate :: Z.Conflatable t => Bool -> Socket z t -> ZMQ z () 495 | setConflate i = liftIO . Z.setConflate i . _unsocket 496 | 497 | setCurvePublicKey :: Z.KeyFormat f -> Restricted f ByteString -> Socket z t -> ZMQ z () 498 | setCurvePublicKey f k = liftIO . Z.setCurvePublicKey f k . _unsocket 499 | 500 | setCurveSecretKey :: Z.KeyFormat f -> Restricted f ByteString -> Socket z t -> ZMQ z () 501 | setCurveSecretKey f k = liftIO . Z.setCurveSecretKey f k . _unsocket 502 | 503 | setCurveServer :: Bool -> Socket z t -> ZMQ z () 504 | setCurveServer b = liftIO . Z.setCurveServer b . _unsocket 505 | 506 | setCurveServerKey :: Z.KeyFormat f -> Restricted f ByteString -> Socket z t -> ZMQ z () 507 | setCurveServerKey f k = liftIO . Z.setCurveServerKey f k . _unsocket 508 | 509 | setDelayAttachOnConnect :: Bool -> Socket z t -> ZMQ z () 510 | setDelayAttachOnConnect d = liftIO . Z.setDelayAttachOnConnect d . _unsocket 511 | {-# DEPRECATED setDelayAttachOnConnect "Use setImmediate" #-} 512 | 513 | setIdentity :: Restricted (N1, N254) ByteString -> Socket z t -> ZMQ z () 514 | setIdentity i = liftIO . Z.setIdentity i . _unsocket 515 | 516 | setImmediate :: Bool -> Socket z t -> ZMQ z () 517 | setImmediate i = liftIO . Z.setImmediate i . _unsocket 518 | 519 | setIpv4Only :: Bool -> Socket z t -> ZMQ z () 520 | setIpv4Only i = liftIO . Z.setIpv4Only i . _unsocket 521 | {-# DEPRECATED setIpv4Only "Use setIpv6" #-} 522 | 523 | setIpv6 :: Bool -> Socket z t -> ZMQ z () 524 | setIpv6 i = liftIO . Z.setIpv6 i . _unsocket 525 | 526 | setLinger :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 527 | setLinger l = liftIO . Z.setLinger l . _unsocket 528 | 529 | setMaxMessageSize :: Integral i => Restricted (Nneg1, Int64) i -> Socket z t -> ZMQ z () 530 | setMaxMessageSize s = liftIO . Z.setMaxMessageSize s . _unsocket 531 | 532 | setMcastHops :: Integral i => Restricted (N1, Int32) i -> Socket z t -> ZMQ z () 533 | setMcastHops k = liftIO . Z.setMcastHops k . _unsocket 534 | 535 | setPlainServer :: Bool -> Socket z t -> ZMQ z () 536 | setPlainServer b = liftIO . Z.setPlainServer b . _unsocket 537 | 538 | setPlainPassword :: Restricted (N1, N254) ByteString -> Socket z t -> ZMQ z () 539 | setPlainPassword s = liftIO . Z.setPlainPassword s . _unsocket 540 | 541 | setPlainUserName :: Restricted (N1, N254) ByteString -> Socket z t -> ZMQ z () 542 | setPlainUserName s = liftIO . Z.setPlainUserName s . _unsocket 543 | 544 | setProbeRouter :: Z.SendProbe t => Bool -> Socket z t -> ZMQ z () 545 | setProbeRouter b = liftIO . Z.setProbeRouter b . _unsocket 546 | 547 | setRate :: Integral i => Restricted (N1, Int32) i -> Socket z t -> ZMQ z () 548 | setRate r = liftIO . Z.setRate r . _unsocket 549 | 550 | setReceiveBuffer :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 551 | setReceiveBuffer k = liftIO . Z.setReceiveBuffer k . _unsocket 552 | 553 | setReceiveHighWM :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 554 | setReceiveHighWM k = liftIO . Z.setReceiveHighWM k . _unsocket 555 | 556 | setReceiveTimeout :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 557 | setReceiveTimeout t = liftIO . Z.setReceiveTimeout t . _unsocket 558 | 559 | setReconnectInterval :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 560 | setReconnectInterval i = liftIO . Z.setReconnectInterval i . _unsocket 561 | 562 | setReconnectIntervalMax :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 563 | setReconnectIntervalMax i = liftIO . Z.setReconnectIntervalMax i . _unsocket 564 | 565 | setRecoveryInterval :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 566 | setRecoveryInterval i = liftIO . Z.setRecoveryInterval i . _unsocket 567 | 568 | setReqCorrelate :: Bool -> Socket z Z.Req -> ZMQ z () 569 | setReqCorrelate b = liftIO . Z.setReqCorrelate b . _unsocket 570 | 571 | setReqRelaxed :: Bool -> Socket z Z.Req -> ZMQ z () 572 | setReqRelaxed b = liftIO . Z.setReqRelaxed b . _unsocket 573 | 574 | setRouterMandatory :: Bool -> Socket z Z.Router -> ZMQ z () 575 | setRouterMandatory b = liftIO . Z.setRouterMandatory b . _unsocket 576 | 577 | setSendBuffer :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 578 | setSendBuffer i = liftIO . Z.setSendBuffer i . _unsocket 579 | 580 | setSendHighWM :: Integral i => Restricted (N0, Int32) i -> Socket z t -> ZMQ z () 581 | setSendHighWM i = liftIO . Z.setSendHighWM i . _unsocket 582 | 583 | setSendTimeout :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 584 | setSendTimeout i = liftIO . Z.setSendTimeout i . _unsocket 585 | 586 | setTcpAcceptFilter :: Maybe ByteString -> Socket z t -> ZMQ z () 587 | setTcpAcceptFilter s = liftIO . Z.setTcpAcceptFilter s . _unsocket 588 | 589 | setTcpKeepAlive :: Z.Switch -> Socket z t -> ZMQ z () 590 | setTcpKeepAlive s = liftIO . Z.setTcpKeepAlive s . _unsocket 591 | 592 | setTcpKeepAliveCount :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 593 | setTcpKeepAliveCount c = liftIO . Z.setTcpKeepAliveCount c . _unsocket 594 | 595 | setTcpKeepAliveIdle :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 596 | setTcpKeepAliveIdle i = liftIO . Z.setTcpKeepAliveIdle i . _unsocket 597 | 598 | setTcpKeepAliveInterval :: Integral i => Restricted (Nneg1, Int32) i -> Socket z t -> ZMQ z () 599 | setTcpKeepAliveInterval i = liftIO . Z.setTcpKeepAliveInterval i . _unsocket 600 | 601 | setXPubVerbose :: Bool -> Socket z Z.XPub -> ZMQ z () 602 | setXPubVerbose b = liftIO . Z.setXPubVerbose b . _unsocket 603 | 604 | -- * Low Level Functions 605 | 606 | waitRead :: Socket z t -> ZMQ z () 607 | waitRead = liftIO . Z.waitRead . _unsocket 608 | 609 | waitWrite :: Socket z t -> ZMQ z () 610 | waitWrite = liftIO . Z.waitWrite . _unsocket 611 | 612 | -- * Internal 613 | 614 | onContext :: (Z.Context -> IO a) -> ZMQ z a 615 | onContext f = ZMQ $! asks _context >>= liftIO . f 616 | 617 | term :: ZMQEnv -> IO () 618 | term env = do 619 | n <- atomicModifyIORef (_refcount env) $ \n -> (pred n, n) 620 | when (n == 1) $ do 621 | readIORef (_sockets env) >>= mapM_ close' 622 | Z.term (_context env) 623 | where 624 | close' s = I.closeSock s `E.catch` (\e -> print (e :: E.SomeException)) 625 | -------------------------------------------------------------------------------- /tests/System/ZMQ4/Test/Properties.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleInstances #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | {-# LANGUAGE GADTs #-} 4 | {-# OPTIONS_GHC -fno-warn-orphans #-} 5 | 6 | module System.ZMQ4.Test.Properties where 7 | 8 | import Test.QuickCheck 9 | import Test.QuickCheck.Monadic (monadicIO, run) 10 | import Test.Tasty 11 | import Test.Tasty.HUnit 12 | import Test.Tasty.QuickCheck 13 | 14 | import Control.Applicative 15 | import Control.Concurrent.Async (wait) 16 | import Data.Int 17 | import Data.Word 18 | import Data.Restricted 19 | import Data.Maybe (fromJust) 20 | import Data.ByteString (ByteString) 21 | import System.ZMQ4.Monadic 22 | import System.Posix.Types (Fd(..)) 23 | import Prelude 24 | 25 | import qualified Data.ByteString as SB 26 | import qualified Data.ByteString.Char8 as CB 27 | import qualified Test.QuickCheck.Monadic as QM 28 | 29 | tests :: TestTree 30 | tests = testGroup "0MQ Socket Properties" 31 | [ testProperty "get socket option (Pair)" (prop_get_socket_option Pair) 32 | , testProperty "get socket option (Pub)" (prop_get_socket_option Pub) 33 | , testProperty "get socket option (Sub)" (prop_get_socket_option Sub) 34 | , testProperty "get socket option (XPub)" (prop_get_socket_option XPub) 35 | , testProperty "get socket option (XSub)" (prop_get_socket_option XSub) 36 | , testProperty "get socket option (Req)" (prop_get_socket_option Req) 37 | , testProperty "get socket option (Rep)" (prop_get_socket_option Rep) 38 | , testProperty "get socket option (Dealer)" (prop_get_socket_option Dealer) 39 | , testProperty "get socket option (Router)" (prop_get_socket_option Router) 40 | , testProperty "get socket option (Pull)" (prop_get_socket_option Pull) 41 | , testProperty "get socket option (Push)" (prop_get_socket_option Push) 42 | , testProperty "set;get socket option (Pair)" (prop_set_get_socket_option Pair) 43 | , testProperty "set;get socket option (Pub)" (prop_set_get_socket_option Pub) 44 | , testProperty "set;get socket option (Sub)" (prop_set_get_socket_option Sub) 45 | , testProperty "set;get socket option (XPub)" (prop_set_get_socket_option XPub) 46 | , testProperty "set;get socket option (XSub)" (prop_set_get_socket_option XSub) 47 | , testProperty "set;get socket option (Req)" (prop_set_get_socket_option Req) 48 | , testProperty "set;get socket option (Rep)" (prop_set_get_socket_option Rep) 49 | , testProperty "set;get socket option (Dealer)" (prop_set_get_socket_option Dealer) 50 | , testProperty "set;get socket option (Router)" (prop_set_get_socket_option Router) 51 | , testProperty "set;get socket option (Pull)" (prop_set_get_socket_option Pull) 52 | , testProperty "set;get socket option (Push)" (prop_set_get_socket_option Push) 53 | , testProperty "(un-)subscribe" (prop_subscribe Sub) 54 | , testCase "last_enpoint" (last_endpoint) 55 | , testGroup "connect disconnect" 56 | [ testProperty "" (prop_connect_disconnect x) 57 | | x <- [ (AnySocket Rep, AnySocket Req) 58 | , (AnySocket Router, AnySocket Req) 59 | , (AnySocket Pull, AnySocket Push) 60 | ] 61 | ] 62 | , testGroup "0MQ Messages" 63 | [ testProperty "msg send == msg received (Req/Rep)" (prop_send_receive Req Rep) 64 | , testProperty "msg send == msg received (Push/Pull)" (prop_send_receive Push Pull) 65 | , testProperty "msg send == msg received (Pair/Pair)" (prop_send_receive Pair Pair) 66 | -- , testProperty "publish/subscribe" (prop_pub_sub Pub Sub) 67 | -- (disabled due to LIBZMQ-270 [https://zeromq.jira.com/browse/LIBZMQ-270]) 68 | ] 69 | ] 70 | 71 | prop_get_socket_option :: SocketType t => t -> GetOpt -> Property 72 | prop_get_socket_option t opt = monadicIO $ run $ do 73 | runZMQ $ do 74 | s <- socket t 75 | case opt of 76 | Events _ -> events s >> return () 77 | Filedesc _ -> fileDescriptor s >> return () 78 | ReceiveMore _ -> moreToReceive s >> return () 79 | 80 | prop_set_get_socket_option :: SocketType t => t -> SetOpt -> Property 81 | prop_set_get_socket_option t opt = monadicIO $ do 82 | r <- run $ runZMQ $ do 83 | s <- socket t 84 | case opt of 85 | Identity val -> (== (rvalue val)) <$> (setIdentity val s >> identity s) 86 | Ipv4Only val -> (== val) <$> (setIpv4Only val s >> ipv4Only s) 87 | Affinity val -> (ieq val) <$> (setAffinity val s >> affinity s) 88 | Backlog val -> (ieq (rvalue val)) <$> (setBacklog val s >> backlog s) 89 | Linger val -> (ieq (rvalue val)) <$> (setLinger val s >> linger s) 90 | Rate val -> (ieq (rvalue val)) <$> (setRate val s >> rate s) 91 | ReceiveBuf val -> (ieq (rvalue val)) <$> (setReceiveBuffer val s >> receiveBuffer s) 92 | ReconnectIVL val -> (ieq (rvalue val)) <$> (setReconnectInterval val s >> reconnectInterval s) 93 | ReconnectIVLMax val -> (ieq (rvalue val)) <$> (setReconnectIntervalMax val s >> reconnectIntervalMax s) 94 | RecoveryIVL val -> (ieq (rvalue val)) <$> (setRecoveryInterval val s >> recoveryInterval s) 95 | SendBuf val -> (ieq (rvalue val)) <$> (setSendBuffer val s >> sendBuffer s) 96 | MaxMessageSize val -> (ieq (rvalue val)) <$> (setMaxMessageSize val s >> maxMessageSize s) 97 | McastHops val -> (ieq (rvalue val)) <$> (setMcastHops val s >> mcastHops s) 98 | ReceiveHighWM val -> (ieq (rvalue val)) <$> (setReceiveHighWM val s >> receiveHighWM s) 99 | ReceiveTimeout val -> (ieq (rvalue val)) <$> (setReceiveTimeout val s >> receiveTimeout s) 100 | SendHighWM val -> (ieq (rvalue val)) <$> (setSendHighWM val s >> sendHighWM s) 101 | SendTimeout val -> (ieq (rvalue val)) <$> (setSendTimeout val s >> sendTimeout s) 102 | QM.assert r 103 | where 104 | ieq :: (Integral i, Integral k) => i -> k -> Bool 105 | ieq i k = (fromIntegral i :: Int) == (fromIntegral k :: Int) 106 | 107 | last_endpoint :: IO () 108 | last_endpoint = do 109 | let a = "tcp://127.0.0.1:43821" 110 | a' <- runZMQ $ do 111 | s <- socket Rep 112 | bind s a 113 | lastEndpoint s 114 | a @=? a' 115 | 116 | prop_subscribe :: (Subscriber a, SocketType a) => a -> ByteString -> Property 117 | prop_subscribe t subs = monadicIO $ run $ 118 | runZMQ $ do 119 | s <- socket t 120 | subscribe s subs 121 | unsubscribe s subs 122 | 123 | prop_send_receive :: (SocketType a, SocketType b, Receiver b, Sender a) => a -> b -> ByteString -> Property 124 | prop_send_receive a b msg = monadicIO $ do 125 | msg' <- run $ runZMQ $ do 126 | sender <- socket a 127 | receiver <- socket b 128 | bind receiver "inproc://endpoint" 129 | x <- async $ receive receiver 130 | connect sender "inproc://endpoint" 131 | send sender [] msg 132 | liftIO $ wait x 133 | QM.assert (msg == msg') 134 | 135 | prop_pub_sub :: (SocketType a, Subscriber b, SocketType b, Sender a, Receiver b) => a -> b -> ByteString -> Property 136 | prop_pub_sub a b msg = monadicIO $ do 137 | msg' <- run $ runZMQ $ do 138 | pub <- socket a 139 | sub <- socket b 140 | subscribe sub "" 141 | bind sub "inproc://endpoint" 142 | connect pub "inproc://endpoint" 143 | send pub [] msg 144 | receive sub 145 | QM.assert (msg == msg') 146 | 147 | 148 | prop_connect_disconnect :: (AnySocket, AnySocket) -> Property 149 | prop_connect_disconnect (AnySocket t0, AnySocket t) = monadicIO $ run $ 150 | runZMQ $ do 151 | s0 <- socket t0 152 | bind s0 "inproc://endpoint" 153 | s <- socket t 154 | connect s "inproc://endpoint" 155 | disconnect s "inproc://endpoint" 156 | 157 | instance Arbitrary ByteString where 158 | arbitrary = CB.pack . filter (/= '\0') <$> arbitrary 159 | 160 | data GetOpt = 161 | Events Int 162 | | Filedesc Fd 163 | | ReceiveMore Bool 164 | deriving Show 165 | 166 | data SetOpt = 167 | Affinity Word64 168 | | Backlog (Restricted (N0, Int32) Int) 169 | | Identity (Restricted (N1, N254) ByteString) 170 | | Ipv4Only Bool 171 | | Linger (Restricted (Nneg1, Int32) Int) 172 | | MaxMessageSize (Restricted (Nneg1, Int64) Int64) 173 | | McastHops (Restricted (N1, Int32) Int) 174 | | Rate (Restricted (N1, Int32) Int) 175 | | ReceiveBuf (Restricted (N0, Int32) Int) 176 | | ReceiveHighWM (Restricted (N0, Int32) Int) 177 | | ReceiveTimeout (Restricted (Nneg1, Int32) Int) 178 | | ReconnectIVL (Restricted (N0, Int32) Int) 179 | | ReconnectIVLMax (Restricted (N0, Int32) Int) 180 | | RecoveryIVL (Restricted (N0, Int32) Int) 181 | | SendBuf (Restricted (N0, Int32) Int) 182 | | SendHighWM (Restricted (N0, Int32) Int) 183 | | SendTimeout (Restricted (Nneg1, Int32) Int) 184 | deriving Show 185 | 186 | instance Arbitrary GetOpt where 187 | arbitrary = oneof [ 188 | Events <$> arbitrary 189 | , Filedesc . Fd . fromIntegral <$> (arbitrary :: Gen Int32) 190 | , ReceiveMore <$> arbitrary 191 | ] 192 | 193 | instance Arbitrary SetOpt where 194 | arbitrary = oneof [ 195 | Affinity <$> (arbitrary :: Gen Word64) 196 | , Ipv4Only <$> (arbitrary :: Gen Bool) 197 | , Backlog . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) 198 | , Linger . toRneg1 <$> (arbitrary :: Gen Int32) `suchThat` (>= -1) 199 | , Rate . toR1 <$> (arbitrary :: Gen Int32) `suchThat` (> 0) 200 | , ReceiveBuf . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) 201 | , ReconnectIVL . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) 202 | , ReconnectIVLMax . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) 203 | , RecoveryIVL . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) 204 | , SendBuf . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) 205 | , McastHops . toR1 <$> (arbitrary :: Gen Int32) `suchThat` (> 0) 206 | , ReceiveHighWM . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) 207 | , ReceiveTimeout . toRneg1 <$> (arbitrary :: Gen Int32) `suchThat` (>= -1) 208 | , SendHighWM . toR0 <$> (arbitrary :: Gen Int32) `suchThat` (>= 0) 209 | , SendTimeout . toRneg1 <$> (arbitrary :: Gen Int32) `suchThat` (>= -1) 210 | , MaxMessageSize . toRneg1' <$> (arbitrary :: Gen Int64) `suchThat` (>= -1) 211 | , Identity . fromJust . toRestricted <$> arbitrary `suchThat` (\s -> SB.length s > 0 && SB.length s < 255) 212 | ] 213 | 214 | toR1 :: Int32 -> Restricted (N1, Int32) Int 215 | toR1 = fromJust . toRestricted . fromIntegral 216 | 217 | toR0 :: Int32 -> Restricted (N0, Int32) Int 218 | toR0 = fromJust . toRestricted . fromIntegral 219 | 220 | toRneg1 :: Int32 -> Restricted (Nneg1, Int32) Int 221 | toRneg1 = fromJust . toRestricted . fromIntegral 222 | 223 | toRneg1' :: Int64 -> Restricted (Nneg1, Int64) Int64 224 | toRneg1' = fromJust . toRestricted . fromIntegral 225 | 226 | data AnySocket where 227 | AnySocket :: SocketType a => a -> AnySocket 228 | 229 | -------------------------------------------------------------------------------- /tests/tests.hs: -------------------------------------------------------------------------------- 1 | import Test.Tasty 2 | 3 | import qualified System.ZMQ4.Test.Properties as Properties 4 | 5 | main :: IO () 6 | main = defaultMain Properties.tests 7 | 8 | -------------------------------------------------------------------------------- /zeromq4-haskell.cabal: -------------------------------------------------------------------------------- 1 | name: zeromq4-haskell 2 | version: 0.6.5 3 | synopsis: Bindings to ZeroMQ 4.x 4 | category: System, FFI 5 | license: MIT 6 | license-file: LICENSE 7 | author: Toralf Wittner 8 | maintainer: Toralf Wittner 9 | copyright: (c) 2010 - 2015 zeromq-haskell authors 10 | homepage: https://gitlab.com/twittner/zeromq-haskell/ 11 | stability: experimental 12 | tested-With: GHC == 7.10.3 13 | cabal-version: >= 1.8 14 | build-type: Simple 15 | extra-source-files: 16 | README.md 17 | , CHANGELOG.md 18 | , AUTHORS 19 | , examples/*.hs 20 | , examples/Makefile 21 | , examples/perf/*.hs 22 | , examples/perf/Makefile 23 | , tests/*.hs 24 | , tests/System/ZMQ4/Test/*.hs 25 | 26 | description: 27 | The 0MQ lightweight messaging kernel is a library which extends 28 | the standard socket interfaces with features traditionally provided 29 | by specialised messaging middleware products. 30 | . 31 | 0MQ sockets provide an abstraction of asynchronous message queues, 32 | multiple messaging patterns, message filtering (subscriptions), 33 | seamless access to multiple transport protocols and more. 34 | . 35 | This library provides the Haskell language binding to 0MQ >= 4.x 36 | 37 | source-repository head 38 | type: git 39 | location: https://gitlab.com/twittner/zeromq-haskell 40 | 41 | library 42 | hs-source-dirs: src 43 | ghc-options: -Wall -O2 -fwarn-tabs -funbox-strict-fields 44 | 45 | exposed-modules: 46 | Data.Restricted 47 | System.ZMQ4 48 | System.ZMQ4.Monadic 49 | System.ZMQ4.Internal 50 | System.ZMQ4.Internal.Base 51 | System.ZMQ4.Internal.Error 52 | 53 | build-depends: 54 | base >= 3 && < 5 55 | , async >= 2.0 && < 3.0 56 | , bytestring >= 0.10 57 | , containers >= 0.5 58 | , exceptions >= 0.6 && < 1.0 59 | , semigroups >= 0.8 60 | , transformers >= 0.3 61 | , monad-control >= 1.0 62 | , transformers-base >= 0.4 63 | 64 | if impl(ghc < 7.6) 65 | build-depends: ghc-prim == 0.3.* 66 | 67 | if os(windows) 68 | extra-libraries: zmq 69 | else 70 | pkgconfig-depends: libzmq >= 4.0 && < 5.0 71 | 72 | if os(freebsd) 73 | extra-libraries: pthread 74 | 75 | test-suite zeromq-haskell-tests 76 | type: exitcode-stdio-1.0 77 | hs-source-dirs: tests 78 | main-is: tests.hs 79 | ghc-options: -Wall -threaded 80 | build-depends: 81 | zeromq4-haskell 82 | , async 83 | , base >= 3 && < 5 84 | , bytestring 85 | , QuickCheck >= 2.6 86 | , tasty >= 0.8 87 | , tasty-hunit >= 0.8 88 | , tasty-quickcheck >= 0.8 89 | --------------------------------------------------------------------------------