packages feed

symbiote 0.0.4 → 0.0.5

raw patch · 8 files changed

+82/−314 lines, 8 filesdep −zeromq4-haskelldep −zeromq4-simple

Dependencies removed: zeromq4-haskell, zeromq4-simple

Files

README.md view
@@ -1,5 +1,7 @@ # Symbiote +Iteration of the [Symbiotic-Data Test Suite](https://docs.symbiotic-data.io/en/latest/testsuite.html).+ This project aims to be a network agnostic and data format agnostic serialization verifier - it's main purpose is to verify that _data_, _operations_ on that data, and _serialization_ of that data is all consistent for multiple platforms. This project defines a trivial protocol that can be re-implemented
src/Test/Serialization/Symbiote.hs view
@@ -185,6 +185,7 @@   -- | Messages sent by a peer during their generating phase - polymorphic in the serialization medium.+-- <https://docs.symbiotic-data.io/en/latest/testsuitetypes.html#generating Ref - Generating> data Generating s   = -- | \"I\'ve generated a value and operation, here you go.\"     Generated@@ -264,6 +265,7 @@       _ -> fail "Generating LazyByteString"  -- | Messages sent by a peer during their operating phase - polymorphic in the serialization medium.+-- <https://docs.symbiotic-data.io/en/latest/testsuitetypes.html#operating Ref - Operating> data Operating s   = -- | \"I\'ve performed the operation on the value, and here's the output result.\"     Operated s@@ -318,6 +320,7 @@       _ -> fail "Operating LazyByteString"  -- | Messages sent by the first peer - polymorphic in the serialization medium.+-- <https://docs.symbiotic-data.io/en/latest/testsuitetypes.html#first Ref - First> data First s   = -- | \"Here are the topics I support.\"     AvailableTopics (Map Topic Int32)@@ -419,6 +422,7 @@   -- | Messages sent by the second peer - polymorphic in the serialization medium.+-- <https://docs.symbiotic-data.io/en/latest/testsuitetypes.html#second Ref - Second> data Second s   = -- | \"Although my topics should be at least a subset of your topics available,     -- the following of mine do not have the same max size as yours.\"
src/Test/Serialization/Symbiote/Abides.hs view
@@ -165,15 +165,15 @@ deriving instance Show a => Show (Operation (AbidesEq a)) instance Arbitrary a => Arbitrary (Operation (AbidesEq a)) where   arbitrary = oneof-    [ EqSymmetry <$> arbitrary-    , pure EqReflexive+    [ pure EqReflexive+    , EqSymmetry <$> arbitrary     , EqTransitive <$> arbitrary <*> arbitrary     , EqNegation <$> arbitrary     ] instance ToJSON a => ToJSON (Operation (AbidesEq a)) where   toJSON op = case op of-    EqSymmetry y -> object ["symmetry" .= y]     EqReflexive -> String "reflexive"+    EqSymmetry y -> object ["symmetry" .= y]     EqTransitive y z -> object ["transitive" .= object ["y" .= y, "z" .= z]]     EqNegation y -> object ["negation" .= y] instance FromJSON a => FromJSON (Operation (AbidesEq a)) where@@ -190,25 +190,27 @@   parseJSON x = typeMismatch "Operation (AbidesEq a)" x instance Serialize a => Serialize (Operation (AbidesEq a)) where   put op = case op of-    EqSymmetry y -> putWord8 0 *> put y-    EqReflexive -> putWord8 1+    EqReflexive -> putWord8 0+    EqSymmetry y -> putWord8 1 *> put y     EqTransitive y z -> putWord8 2 *> put y *> put z     EqNegation y -> putWord8 3 *> put y   get = do     x <- getWord8     case x of-      0 -> EqSymmetry <$> get-      1 -> pure EqReflexive+      0 -> pure EqReflexive+      1 -> EqSymmetry <$> get       2 -> EqTransitive <$> get <*> get       3 -> EqNegation <$> get       _ -> fail "Operation (AbidesEq a)"  instance (Ord a) => SymbioteOperation (AbidesOrd a) Bool where   data Operation (AbidesOrd a)-    = OrdReflexive+    = OrdEq (Operation (AbidesEq a))+    | OrdReflexive     | OrdAntiSymmetry (AbidesOrd a)     | OrdTransitive (AbidesOrd a) (AbidesOrd a)-  perform op x = case op of+  perform op x@(AbidesOrd x') = case op of+    OrdEq op' -> perform op' (AbidesEq x')     OrdReflexive -> Ord.reflexive x     OrdAntiSymmetry y -> Ord.antisymmetry x y     OrdTransitive y z -> Ord.transitive x y z@@ -216,18 +218,21 @@ deriving instance Show a => Show (Operation (AbidesOrd a)) instance Arbitrary a => Arbitrary (Operation (AbidesOrd a)) where   arbitrary = oneof-    [ OrdAntiSymmetry <$> arbitrary+    [ OrdEq <$> arbitrary     , pure OrdReflexive+    , OrdAntiSymmetry <$> arbitrary     , OrdTransitive <$> arbitrary <*> arbitrary     ] instance ToJSON a => ToJSON (Operation (AbidesOrd a)) where   toJSON op = case op of+    OrdEq op' -> object ["eq" .= op']     OrdReflexive -> String "reflexive"     OrdAntiSymmetry y -> object ["antisymmetry" .= y]     OrdTransitive y z -> object ["transitive" .= object ["y" .= y, "z" .= z]] instance FromJSON a => FromJSON (Operation (AbidesOrd a)) where-  parseJSON (Object o) = transitive <|> antisymmetry+  parseJSON (Object o) = ordEq <|> transitive <|> antisymmetry     where+      ordEq = OrdEq <$> o .: "eq"       transitive = do         o' <- o .: "transitive"         OrdTransitive <$> o' .: "y" <*> o' .: "z"@@ -238,23 +243,27 @@   parseJSON x = typeMismatch "Operation (AbidesOrd a)" x instance Serialize a => Serialize (Operation (AbidesOrd a)) where   put op = case op of-    OrdReflexive -> putWord8 0-    OrdAntiSymmetry y -> putWord8 1 *> put y-    OrdTransitive y z -> putWord8 2 *> put y *> put z+    OrdEq op' -> putWord8 0 *> put op'+    OrdReflexive -> putWord8 1+    OrdAntiSymmetry y -> putWord8 2 *> put y+    OrdTransitive y z -> putWord8 3 *> put y *> put z   get = do     x <- getWord8     case x of-      0 -> pure OrdReflexive-      1 -> OrdAntiSymmetry <$> get-      2 -> OrdTransitive <$> get <*> get+      0 -> OrdEq <$> get+      1 -> pure OrdReflexive+      2 -> OrdAntiSymmetry <$> get+      3 -> OrdTransitive <$> get <*> get       _ -> fail "Operation (AbidesOrd a)"  instance (Enum a, Ord a) => SymbioteOperation (AbidesEnum a) Bool where   data Operation (AbidesEnum a)-    = EnumCompareHom (AbidesEnum a)+    = EnumOrd (Operation (AbidesOrd a))+    | EnumCompareHom (AbidesEnum a)     | EnumPredSucc     | EnumSuccPred-  perform op x = case op of+  perform op x@(AbidesEnum x') = case op of+    EnumOrd op' -> perform op' (AbidesOrd x')     EnumCompareHom y -> Enum.compareHom x y     EnumPredSucc -> Enum.predsucc x     EnumSuccPred -> Enum.succpred x@@ -262,17 +271,22 @@ deriving instance Show a => Show (Operation (AbidesEnum a)) instance Arbitrary a => Arbitrary (Operation (AbidesEnum a)) where   arbitrary = oneof-    [ EnumCompareHom <$> arbitrary+    [ EnumOrd <$> arbitrary+    , EnumCompareHom <$> arbitrary     , pure EnumPredSucc     , pure EnumSuccPred     ] instance ToJSON a => ToJSON (Operation (AbidesEnum a)) where   toJSON op = case op of+    EnumOrd op' -> object ["ord" .= op']     EnumCompareHom y -> object ["compareHom" .= y]     EnumPredSucc -> String "predsucc"     EnumSuccPred -> String "succpred" instance FromJSON a => FromJSON (Operation (AbidesEnum a)) where-  parseJSON (Object o) = EnumCompareHom <$> o .: "compareHom"+  parseJSON (Object o) = enumOrd <|> compareHom+    where+      enumOrd = EnumOrd <$> o .: "ord"+      compareHom = EnumCompareHom <$> o .: "compareHom"   parseJSON x@(String s)     | s == "predsucc" = pure EnumPredSucc     | s == "succpred" = pure EnumSuccPred@@ -280,15 +294,17 @@   parseJSON x = typeMismatch "Operation (AbidesEnum a)" x instance Serialize a => Serialize (Operation (AbidesEnum a)) where   put op = case op of-    EnumCompareHom y -> putWord8 0 *> put y-    EnumPredSucc -> putWord8 1-    EnumSuccPred -> putWord8 2+    EnumOrd op' -> putWord8 0 *> put op'+    EnumCompareHom y -> putWord8 1 *> put y+    EnumPredSucc -> putWord8 2+    EnumSuccPred -> putWord8 3   get = do     x <- getWord8     case x of-      0 -> EnumCompareHom <$> get-      1 -> pure EnumPredSucc-      2 -> pure EnumSuccPred+      0 -> EnumOrd <$> get+      1 -> EnumCompareHom <$> get+      2 -> pure EnumPredSucc+      3 -> pure EnumSuccPred       _ -> fail "Operation (AbidesEnum a)"  instance (Num a, Eq a) => SymbioteOperation (AbidesSemiring a) Bool where
src/Test/Serialization/Symbiote/Core.hs view
@@ -70,7 +70,7 @@   decodeOp  :: s -> Maybe (Operation a)  --- | Unique name of a type, for a suite of tests+-- | Unique name of a type, for a suite of tests. <https://docs.symbiotic-data.io/en/latest/testsuitetypes.html#topic Ref - Topic>. newtype Topic = Topic Text   deriving (Eq, Ord, Show, IsString, Arbitrary, ToJSON, FromJSON, ToJSONKey, FromJSONKey) -- | Serialized as a @String32@ in the <https://symbiotic-data.github.io/#/data/?id=string32 symbiotic-data standard>.
src/Test/Serialization/Symbiote/WebSocket.hs view
@@ -141,7 +141,7 @@        let encodeAndSend x = liftIO $ atomically $ writeTChan outgoing x           receiveAndDecode = liftIO $ atomically $ readTChan incoming-          onSuccess t = liftIO $ putStrLn $ "WebSocket Topic finished: " ++ show t+          onSuccess t = liftIO $ putStrLn $ "WebSocket Lazy ByteString Topic finished: " ++ show t           onFailure = liftIO . defaultFailure           onProgress t n = case debug of             NoDebug -> nullProgress t n@@ -211,7 +211,7 @@                 receiveAndDecode :: m (them LBS.ByteString)                 receiveAndDecode = liftIO $ atomically $ readTChanRW inputs -                onSuccess t = liftIO $ putStrLn $ "WebSocket Topic finished: " ++ show t+                onSuccess t = liftIO $ putStrLn $ "WebSocket Lazy ByteString Topic finished: " ++ show t                 onFailure = liftIO . defaultFailure                 onProgress t n = case debug of                   NoDebug -> nullProgress t n@@ -287,7 +287,7 @@        let encodeAndSend x = liftIO $ atomically $ writeTChan outgoing x           receiveAndDecode = liftIO $ atomically $ readTChan incoming-          onSuccess t = liftIO $ putStrLn $ "WebSocket Topic finished: " ++ show t+          onSuccess t = liftIO $ putStrLn $ "WebSocket ByteString Topic finished: " ++ show t           onFailure = liftIO . defaultFailure           onProgress t n = case debug of             NoDebug -> nullProgress t n@@ -364,7 +364,7 @@                 receiveAndDecode :: m (them BS.ByteString)                 receiveAndDecode = liftIO $ atomically $ readTChanRW inputs -                onSuccess t = liftIO $ putStrLn $ "WebSocket Topic finished: " ++ show t+                onSuccess t = liftIO $ putStrLn $ "WebSocket ByteString Topic finished: " ++ show t                 onFailure = liftIO . defaultFailure                 onProgress t n = case debug of                   NoDebug -> nullProgress t n@@ -448,7 +448,7 @@        let encodeAndSend x = liftIO $ atomically $ writeTChan outgoing x           receiveAndDecode = liftIO $ atomically $ readTChan incoming-          onSuccess t = liftIO $ putStrLn $ "WebSocket Topic finished: " ++ show t+          onSuccess t = liftIO $ putStrLn $ "WebSocket Json Topic finished: " ++ show t           onFailure = liftIO . defaultFailure           onProgress t n = case debug of             NoDebug -> nullProgress t n@@ -513,7 +513,7 @@                 receiveAndDecode :: m (them Json.Value)                 receiveAndDecode = liftIO $ atomically $ readTChanRW inputs -                onSuccess t = liftIO $ putStrLn $ "WebSocket Topic finished: " ++ show t+                onSuccess t = liftIO $ putStrLn $ "WebSocket Json Topic finished: " ++ show t                 onFailure = liftIO . defaultFailure                 onProgress t n = case debug of                   NoDebug -> nullProgress t n
− src/Test/Serialization/Symbiote/ZeroMQ.hs
@@ -1,252 +0,0 @@-{-# LANGUAGE-    DataKinds-  , RankNTypes-  , FlexibleContexts-  , ScopedTypeVariables-  #-}--{-|--Module: Test.Serialization.Symbiote.ZeroMQ-Copyright: (c) 2019 Athan Clark-License: BSD-3-Style-Maintainer: athan.clark@gmail.com-Portability: GHC--Use these functions to communicate over a Peer-to-Peer ZeroMQ socket.---}--module Test.Serialization.Symbiote.ZeroMQ where---import Test.Serialization.Symbiote-  (firstPeer, secondPeer, SymbioteT, defaultFailure, defaultProgress, nullProgress, Topic, Failure)-import Test.Serialization.Symbiote.Debug (Debug (..), Network (..))--import qualified Data.ByteString as BS-import qualified Data.Serialize as Cereal-import Data.List.NonEmpty (NonEmpty (..))-import Data.Singleton.Class (Extractable)-import Data.Restricted (Restricted)-import Control.Monad (forever, void)-import Control.Monad.IO.Class (MonadIO (liftIO))-import Control.Monad.Trans.Control.Aligned (MonadBaseControl, liftBaseWith)-import Control.Concurrent (threadDelay)-import Control.Concurrent.Async (cancel)-import Control.Concurrent.Chan.Scope (Scope (Read, Write))-import Control.Concurrent.Chan.Extra (writeOnly)-import Control.Concurrent.STM (TChan, newTChanIO, writeTChan, readTChan, atomically)-import Control.Concurrent.STM.TChan.Typed (TChanRW, newTChanRW, writeTChanRW, readTChanRW)-import Control.Concurrent.Threaded.Hash (threaded)-import System.ZMQ4 (Router (..), Dealer (..), Pair (..))-import System.ZMQ4.Monadic (runZMQ, async, KeyFormat, setCurveServer, setCurvePublicKey, setCurveSecretKey, setCurveServerKey)-import System.ZMQ4.Simple (ZMQIdent, socket, bind, send, receive, connect, setUUIDIdentity, Socket (..))-import System.Timeout (timeout)-import Unsafe.Coerce (unsafeCoerce)----secondPeerZeroMQ :: MonadIO m-                 => MonadBaseControl IO m stM-                 => Extractable stM-                 => ZeroMQParams f-                 -> Debug-                 -> SymbioteT BS.ByteString m () -- ^ Tests registered-                 -> m ()-secondPeerZeroMQ params debug = peerZeroMQ params debug secondPeer--firstPeerZeroMQ :: MonadIO m-                => MonadBaseControl IO m stM-                => Extractable stM-                => ZeroMQParams f-                -> Debug-                -> SymbioteT BS.ByteString m () -- ^ Tests registered-                -> m ()-firstPeerZeroMQ params debug = peerZeroMQ params debug firstPeer---- | Parameterized by optional keypairs associated with CurveMQ-data ZeroMQServerOrClient f-  = ZeroMQServer (Maybe (ServerKeys f))-  | ZeroMQClient (Maybe (ClientKeys f))--data Key f = Key-  { format :: KeyFormat f -- ^ Text via Z85 or raw binary-  , key    :: Restricted f BS.ByteString-  }--data KeyPair f = KeyPair-  { public :: Key f-  , secret :: Key f-  }--newtype ServerKeys f = ServerKeys-  { serverKeyPair :: KeyPair f-  }--data ClientKeys f = ClientKeys-  { clientKeyPair :: KeyPair f-  , clientServer  :: Key f -- ^ The public key of the server-  }--data ZeroMQParams f = ZeroMQParams-  { zmqHost           :: String-  , zmqServerOrClient :: ZeroMQServerOrClient f-  , zmqNetwork        :: Network-  }----- | ZeroMQ can only work on 'BS.ByteString's-peerZeroMQ :: forall m stM them me f-            . MonadIO m-           => MonadBaseControl IO m stM-           => Extractable stM-           => Show (them BS.ByteString)-           => Cereal.Serialize (me BS.ByteString)-           => Cereal.Serialize (them BS.ByteString)-           => ZeroMQParams f-           -> Debug-           -> ( (me BS.ByteString -> m ())-             -> m (them BS.ByteString)-             -> (Topic -> m ())-             -> (Failure them BS.ByteString -> m ())-             -> (Topic -> Float -> m ())-             -> SymbioteT BS.ByteString m ()-             -> m ()-              ) -- ^ Encode and send, receive and decode, on success, on failure, on progress, and test set-           -> SymbioteT BS.ByteString m () -- ^ Tests registered-           -> m ()-peerZeroMQ (ZeroMQParams host clientOrServer network) debug peer tests =-  case (network,clientOrServer) of-    (Public, ZeroMQServer mKeys) -> do-      (incoming :: TChanRW 'Write (ZMQIdent, them BS.ByteString)) <- writeOnly <$> liftIO (atomically newTChanRW)-      -- the process that gets invoked for each new thread. Writes to a @me BS.ByteString@ and reads from a @them BS.ByteString@.-      let process :: TChanRW 'Read (them BS.ByteString) -> TChanRW 'Write (me BS.ByteString) -> m ()-          process inputs outputs = void $ liftBaseWith $ \runInBase -> timeout 10000000 $ runInBase $ do-            let encodeAndSend :: me BS.ByteString -> m ()-                encodeAndSend x = liftIO $ atomically $ writeTChanRW outputs x--                receiveAndDecode :: m (them BS.ByteString)-                receiveAndDecode = liftIO $ atomically $ readTChanRW inputs--                onSuccess t = liftIO $ putStrLn $ "ZeroMQ Topic finished: " ++ show t-                onFailure = liftIO . defaultFailure-                onProgress t n = case debug of-                  NoDebug -> nullProgress t n-                  _ -> liftIO (defaultProgress t n)-            peer encodeAndSend receiveAndDecode onSuccess onFailure onProgress tests-            liftIO (threadDelay 1000000)--      -- manage invoked threads-      ( _-        , outgoing :: TChanRW 'Read (ZMQIdent, me BS.ByteString)-        ) <- threaded incoming process--      -- forever bind to ZeroMQ-      runZMQ $ do-        s@(Socket s') <- socket Router Dealer-        case mKeys of-          Nothing -> pure ()-          Just (ServerKeys (KeyPair _ (Key secFormat secKey))) -> do-            setCurveServer True s'-            setCurveSecretKey secFormat secKey s'-        bind s host--        -- sending loop (separate thread)-        void $ async $ forever $ do-          (ident, x) <- liftIO (atomically (readTChanRW outgoing))-          send ident s ((Cereal.encode x) :| [])--        -- receiving loop (current thread)-        forever $ do-          mX <- receive s-          case mX of-            Nothing -> liftIO $ putStrLn "got nothin"-            Just (ident,x :| _) -> case Cereal.decode x of-              Left e -> error $ "couldn't decode: " ++ e-              Right x' -> do-                liftIO (atomically (writeTChanRW incoming (ident,x')))-      -- liftIO (cancel zThread) - never dies automatically?--    _ -> do-      (outgoing :: TChan (me BS.ByteString)) <- liftIO newTChanIO-      (incoming :: TChan (them BS.ByteString)) <- liftIO newTChanIO-      let encodeAndSend :: me BS.ByteString -> m ()-          encodeAndSend x = liftIO (atomically (writeTChan outgoing x))--          receiveAndDecode :: m (them BS.ByteString)-          receiveAndDecode = liftIO (atomically (readTChan incoming))--          onSuccess t = liftIO $ putStrLn $ "ZeroMQ Topic finished: " ++ show t-          onFailure = liftIO . defaultFailure-          onProgress t n = case debug of-            NoDebug -> nullProgress t n-            _ -> liftIO (defaultProgress t n)--          -- sending loop (separate thread)-          sendingThread s =-            void $ async $ forever $ do-              x <- liftIO (atomically (readTChan outgoing))-              send () s ((Cereal.encode x) :| [])--          -- receiving loop (current thread)-          receivingLoop s = forever $ do-            mX <- receive s-            case mX of-              Nothing -> liftIO (putStrLn "got nothin")-              Just ((),x :| _) -> case Cereal.decode x of-                Left e -> error ("couldn't decode: " ++ e)-                Right x' -> do-                  liftIO (atomically (writeTChan incoming x'))--      -- thread that connects and communicates with ZeroMQ-      zThread <- case network of-        -- is a ZeroMQClient-        Public -> runZMQ $ async $ do-          s@(Socket s') <- socket Dealer Router-          case clientOrServer of-            ZeroMQClient mKeys -> case mKeys of-              Nothing -> pure ()-              Just (ClientKeys (KeyPair (Key pubFormat pubKey) (Key secFormat secKey)) (Key servFormat server)) -> do-                setCurvePublicKey pubFormat pubKey s'-                setCurveSecretKey secFormat secKey s'-                setCurveServerKey servFormat server s'-            _ -> error "impossible case"-          setUUIDIdentity s-          connect s host--          sendingThread s--          receivingLoop s-        Private -> case clientOrServer of-          ZeroMQServer mKeys -> runZMQ $ async $ do-            s@(Socket s') <- socket Pair Pair-            case mKeys of-              Nothing -> pure ()-              Just (ServerKeys (KeyPair _ (Key secFormat secKey))) -> do-                setCurveServer True s'-                setCurveSecretKey secFormat secKey s'-            bind s host--            sendingThread s--            receivingLoop s-          ZeroMQClient mKeys -> runZMQ $ async $ do-            s@(Socket s') <- socket Pair Pair-            case mKeys of-              Nothing -> pure ()-              Just (ClientKeys (KeyPair (Key pubFormat pubKey) (Key secFormat secKey)) (Key servFormat server)) -> do-                setCurvePublicKey pubFormat pubKey s'-                setCurveSecretKey secFormat secKey s'-                setCurveServerKey servFormat server s'-            connect s host--            sendingThread s--            receivingLoop s--      -- main loop (current thread, continues when finished)-      peer encodeAndSend receiveAndDecode onSuccess onFailure onProgress tests--      -- kill ZeroMQ thread-      liftIO (cancel zThread)
symbiote.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: b0ed7398ea9c3fdf50a9dfc395712f17935161fec68786977d951a94aacb8142+-- hash: d69be209ae03aba7795deaada6681f80f452459cc980193421fba3bc3230df4b  name:           symbiote-version:        0.0.4+version:        0.0.5 synopsis:       Data serialization, communication, and operation verification implementation description:    Please see the README on GitHub at <https://github.com/athanclark/symbiote#readme> category:       Data, Testing@@ -30,15 +30,14 @@ library   exposed-modules:       Test.Serialization.Symbiote+      Test.Serialization.Symbiote.Core+      Test.Serialization.Symbiote.Debug       Test.Serialization.Symbiote.Abides-      Test.Serialization.Symbiote.Aeson       Test.Serialization.Symbiote.Cereal       Test.Serialization.Symbiote.Cereal.Lazy-      Test.Serialization.Symbiote.Core-      Test.Serialization.Symbiote.Debug+      Test.Serialization.Symbiote.Aeson       Test.Serialization.Symbiote.WebSocket       Test.Serialization.Symbiote.WebSocket.Ident-      Test.Serialization.Symbiote.ZeroMQ   other-modules:       Paths_symbiote   hs-source-dirs:@@ -66,8 +65,6 @@     , wai-transformers >=0.1.0     , websockets-simple >=0.2.0     , websockets-simple-extra-    , zeromq4-haskell-    , zeromq4-simple >=0.0.0.2   default-language: Haskell2010  test-suite symbiote-test@@ -116,6 +113,4 @@     , websockets     , websockets-simple     , websockets-simple-extra-    , zeromq4-haskell-    , zeromq4-simple >=0.0.0.2   default-language: Haskell2010
test/Spec/Protocol.hs view
@@ -4,6 +4,7 @@   , FlexibleInstances   , FlexibleContexts   , OverloadedStrings+  , ScopedTypeVariables   #-}  module Spec.Protocol where@@ -17,13 +18,13 @@ import Data.Proxy import Test.Serialization.Symbiote   (SymbioteOperation (..), Generating, Operating, First, Second, Topic, SymbioteT, register)-import Test.Serialization.Symbiote.Debug (Debug (..))+import Test.Serialization.Symbiote.Debug (Debug (..), Network) import Test.Serialization.Symbiote.WebSocket   ( firstPeerWebSocketJson, firstPeerWebSocketByteString   , secondPeerWebSocketJson, secondPeerWebSocketByteString   , WebSocketParams (..), WebSocketServerOrClient (..))-import Test.Serialization.Symbiote.ZeroMQ-  ( firstPeerZeroMQ, secondPeerZeroMQ, ZeroMQParams (..), ZeroMQServerOrClient (..))+-- import Test.Serialization.Symbiote.ZeroMQ+--   ( firstPeerZeroMQ, secondPeerZeroMQ, ZeroMQParams (..), ZeroMQServerOrClient (..)) import Test.Serialization.Symbiote.Aeson () import Test.Serialization.Symbiote.Cereal () import Test.QuickCheck (Arbitrary (..))@@ -89,26 +90,28 @@                 }               NoDebug byteStringTests         ]-  , askOption $ \serverOrClient -> askOption $ \network -> case serverOrClient of+  , askOption $ \serverOrClient -> askOption $ \(network :: Network) -> case serverOrClient of       Server -> testGroup "ZeroMQ Server"         [ testCase "ByteString" $-            secondPeerZeroMQ-              ZeroMQParams-                { zmqHost = "tcp://*:3002"-                , zmqServerOrClient = ZeroMQServer-                , zmqNetwork = network-                }-              NoDebug byteStringTests+            putStrLn "\ncurrently inoperable"+            -- secondPeerZeroMQ+            --   ZeroMQParams+            --     { zmqHost = "tcp://*:3002"+            --     , zmqServerOrClient = ZeroMQServer Nothing -- no keys because it's local+            --     , zmqNetwork = network+            --     }+            --   NoDebug byteStringTests         ]       Client -> testGroup "ZeroMQ Client"         [ testCase "ByteString" $-            firstPeerZeroMQ-              ZeroMQParams-                { zmqHost = "tcp://127.0.0.1:3002"-                , zmqServerOrClient = ZeroMQClient-                , zmqNetwork = network-                }-              NoDebug byteStringTests+            putStrLn "\ncurrently inoperable"+            -- firstPeerZeroMQ+            --   ZeroMQParams+            --     { zmqHost = "tcp://127.0.0.1:3002"+            --     , zmqServerOrClient = ZeroMQClient Nothing -- no keys because it's local+            --     , zmqNetwork = network+            --     }+            --   NoDebug byteStringTests         ]   ]   where