| Copyright | (c) 2019 Athan Clark |
|---|---|
| License | BSD-3-Style |
| Maintainer | athan.clark@gmail.com |
| Portability | GHC |
| Safe Haskell | None |
| Language | Haskell2010 |
Test.Serialization.Symbiote
Description
As an example, say you have some data type TypeA, and some encoding / decoding instance with Aeson
for that data type. Now, you've also got a few functions that work with that data type - f :: TypeA -> TypeA
and g :: TypeA -> TypeA -> TypeA, and you've also taken the time to write a proper Arbitrary instance for TypeA.
Your first order of business in making TypeA a symbiote, is to first demonstrate what operations are supported by it:
instance SymbioteOperation TypeA TypeA where
data Operation TypeA
= F
| G TypeA
perform op x = case op of
F -> f x
G y -> g y xYou're also going to need to make sure your new data-family has appropriate serialization instances, as well:
instance ToJSON (Operation TypeA) where
toJSON op = case op of
F -> toJSON "f"
G x -> "g" .: x
instance FromJSON (Operation TypeA) where
parseJSON json = getF <|> getG
where
getF = do
s <- parseJSON json
if s == "f"
then pure F
else typeMismatch "Operation TypeA" json
getG = do
o <- parseJSON json
G <$> o .: "g"Next, let's make TypeA an instance of Symbiote:
instance Symbiote TypeA TypeA Value where encode = Aeson.toJSON decode = Aeson.parseMaybe Aeson.parseJSON encodeOut _ = Aeson.toJSON decodeOut _ = Aeson.parseMaybe Aeson.parseJSON encodeOp = Aeson.toJSON decodeOp = Aeson.parseMaybe Aeson.parseJSON
this instance above actually works for any type that implements ToJSON and FromJSON - there's an orphan
definition in Test.Serialization.Symbiote.Aeson.
Next, you're going to need to actually use this, by registering the type in a test suite:
myFancyTestSuite :: SymbioteT Value IO () myFancyTestSuite = register "TypeA" 100 (Proxy :: Proxy TypeA)
Lastly, you're going to need to actually run the test suite by attaching it to a network. The best way to
do that, is decide whether this peer will be the first or second peer to start the protocol, then use the
respective firstPeer and secondPeer functions - they take as arguments functions that define "how to send"
and "how to receive" messages, and likewise how to report status.
Synopsis
- class SymbioteOperation a o | a -> o where
- class SymbioteOperation a o => Symbiote a o s | a -> o where
- data SimpleSerialization a o
- = SimpleValue a
- | SimpleOutput o
- | SimpleOperation (Operation a)
- data Topic
- type SymbioteT s m = ReaderT Bool (StateT (Map Topic (ExistsSymbiote s)) m)
- register :: forall a o s m. Arbitrary a => Arbitrary (Operation a) => Symbiote a o s => Eq o => MonadIO m => Topic -> Int32 -> Proxy a -> SymbioteT s m ()
- data First s
- = AvailableTopics (Map Topic Int32)
- | BadStartSubset
- | FirstGenerating { }
- | FirstOperating { }
- data Second s
- = BadTopics (Map Topic Int32)
- | Start (Set Topic)
- | SecondOperating { }
- | SecondGenerating { }
- data Generating s
- = Generated {
- genValue :: s
- genOperation :: s
- | BadResult s
- | YourTurn
- | ImFinished
- | GeneratingNoParseOperated s
- = Generated {
- data Operating s
- data Failure them s
- = BadTopicsFailure { }
- | BadStartSubsetFailure (Set Topic)
- | OutOfSyncFirst (First s)
- | OutOfSyncSecond (Second s)
- | TopicNonexistent Topic
- | WrongTopic { }
- | CantParseOperated Topic s
- | CantParseGeneratedValue Topic s
- | CantParseGeneratedOperation Topic s
- | CantParseLocalValue Topic s
- | CantParseLocalOperation Topic s
- | BadOperating Topic (Operating s)
- | BadGenerating Topic (Generating s)
- | BadThem Topic (them s)
- | SafeFailure {
- safeFailureTopic :: Topic
- safeFailureExpected :: s
- safeFailureGot :: s
- defaultSuccess :: Topic -> IO ()
- defaultFailure :: Show (them s) => Show s => Failure them s -> IO ()
- defaultProgress :: Topic -> Float -> IO ()
- nullProgress :: Applicative m => Topic -> Float -> m ()
- simpleTest :: MonadBaseControl IO m stM => MonadIO m => Show s => SymbioteT s m () -> m ()
- simpleTest' :: MonadBaseControl IO m stM => MonadIO m => Show s => (Topic -> m ()) -> (Failure Second s -> m ()) -> (Failure First s -> m ()) -> (Topic -> Float -> m ()) -> SymbioteT s m () -> m ()
- firstPeer :: forall m s. MonadIO m => Show s => (First s -> m ()) -> m (Second s) -> (Topic -> m ()) -> (Failure Second s -> m ()) -> (Topic -> Float -> m ()) -> SymbioteT s m () -> m ()
- secondPeer :: forall s m. MonadIO m => Show s => (Second s -> m ()) -> m (First s) -> (Topic -> m ()) -> (Failure First s -> m ()) -> (Topic -> Float -> m ()) -> SymbioteT s m () -> m ()
Suite Building
class SymbioteOperation a o | a -> o where Source #
A type-level relation between a type and appropriate, testable operations on that type.
Associated Types
data Operation a :: * Source #
An enumerated type of operations on a that result in o.
Instances
class SymbioteOperation a o => Symbiote a o s | a -> o where Source #
A serialization format for a particular type, and serialized data type.
Methods
decode :: s -> Maybe a Source #
encodeOut :: Proxy a -> o -> s Source #
Needs a reference to a because the fundep is only one direction (i.e. only one output defined per input, but could be used elsewhere)
decodeOut :: Proxy a -> s -> Maybe o Source #
Needs a reference to a because the fundep is only one direction
Instances
| (Serialize a, Serialize o, Serialize (Operation a), SymbioteOperation a o) => Symbiote a o ByteString Source # | |
Defined in Test.Serialization.Symbiote.Cereal.Lazy | |
| (Serialize a, Serialize o, Serialize (Operation a), SymbioteOperation a o) => Symbiote a o ByteString Source # | |
Defined in Test.Serialization.Symbiote.Cereal | |
| (ToJSON a, FromJSON a, ToJSON o, FromJSON o, ToJSON (Operation a), FromJSON (Operation a), SymbioteOperation a o) => Symbiote a o Value Source # | |
| SymbioteOperation a o => Symbiote a o (SimpleSerialization a o) Source # | |
Defined in Test.Serialization.Symbiote Methods encode :: a -> SimpleSerialization a o Source # decode :: SimpleSerialization a o -> Maybe a Source # encodeOut :: Proxy a -> o -> SimpleSerialization a o Source # decodeOut :: Proxy a -> SimpleSerialization a o -> Maybe o Source # encodeOp :: Operation a -> SimpleSerialization a o Source # decodeOp :: SimpleSerialization a o -> Maybe (Operation a) Source # | |
data SimpleSerialization a o Source #
The most trivial serialization medium for any a and o.
There's no need to implement transmission protocol specific instances for this type, like ToJSON or Serialize, because it is intended to operate locally (on the same program), and over Eq.
Constructors
| SimpleValue a | A value |
| SimpleOutput o | An output |
| SimpleOperation (Operation a) | An operation |
Instances
Unique name of a type, for a suite of tests. Ref - Topic.
Instances
| Eq Topic Source # | |
| Ord Topic Source # | |
| Show Topic Source # | |
| IsString Topic Source # | |
Defined in Test.Serialization.Symbiote.Core Methods fromString :: String -> Topic # | |
| Arbitrary Topic Source # | |
| ToJSON Topic Source # | |
Defined in Test.Serialization.Symbiote.Core | |
| ToJSONKey Topic Source # | |
Defined in Test.Serialization.Symbiote.Core | |
| FromJSON Topic Source # | |
| FromJSONKey Topic Source # | |
Defined in Test.Serialization.Symbiote.Core | |
| Serialize Topic Source # | Serialized as a |
type SymbioteT s m = ReaderT Bool (StateT (Map Topic (ExistsSymbiote s)) m) Source #
Builder for the total set of topics supported by this peer.
Arguments
| :: Arbitrary a | |
| => Arbitrary (Operation a) | |
| => Symbiote a o s | |
| => Eq o | |
| => MonadIO m | |
| => Topic | Topic name as a |
| -> Int32 | Max size |
| -> Proxy a | Reference to the datatype |
| -> SymbioteT s m () |
Register a topic in the test suite builder.
Protocol Messages
Messages sent by the first peer - polymorphic in the serialization medium. Ref - First
Constructors
| AvailableTopics (Map Topic Int32) | "Here are the topics I support." |
| BadStartSubset | "I got your subset of topics, but they don't match to mine." |
| FirstGenerating | "It's my turn to generate, so here's a generating message." |
Fields | |
| FirstOperating | "It's my turn to operate, so here's my operating message." |
Fields | |
Instances
Messages sent by the second peer - polymorphic in the serialization medium. Ref - Second
Constructors
| BadTopics (Map Topic Int32) | "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." |
| Start (Set Topic) | "All systems nominal, you may fire (the following subset of topics) when ready." |
| SecondOperating | "It's my turn to operate, so here's my operating message." |
Fields | |
| SecondGenerating | "It's my turn to generate, so here's my generating message." |
Fields | |
Instances
data Generating s Source #
Messages sent by a peer during their generating phase - polymorphic in the serialization medium. Ref - Generating
Constructors
| Generated | "I've generated a value and operation, here you go." |
Fields
| |
| BadResult s | "You sent the wrong value!" |
| YourTurn | "It's your turn to generate, I just finished and we're both O.K." |
| ImFinished | "I just finished all generation, and my topic state's |
| GeneratingNoParseOperated s | "I could not deserialize the output value sent by you, and I have to tell you about it." |
Instances
Messages sent by a peer during their operating phase - polymorphic in the serialization medium. Ref - Operating
Constructors
| Operated s | "I've performed the operation on the value, and here's the output result." |
| OperatingNoParseValue s | "I couldn't deserialize the input value sent by you, and I have to tell you about it." |
| OperatingNoParseOperation s | "I couldn't deserialize the operation sent by you, and I have to tell you about it." |
Instances
Result Handling
Exception data type
Constructors
| BadTopicsFailure | Topic sets do not match between peers |
Fields | |
| BadStartSubsetFailure (Set Topic) | The first peer doesn't have the subset topics identified by second |
| OutOfSyncFirst (First s) | The first peer is out of sync and not sending the correct message |
| OutOfSyncSecond (Second s) | The second peer is out of sync and not sending the correct message |
| TopicNonexistent Topic | Topic does not exist |
| WrongTopic | Got the wrong topic |
Fields | |
| CantParseOperated Topic s | |
| CantParseGeneratedValue Topic s | |
| CantParseGeneratedOperation Topic s | |
| CantParseLocalValue Topic s | |
| CantParseLocalOperation Topic s | |
| BadOperating Topic (Operating s) | Incorrect operating message received |
| BadGenerating Topic (Generating s) | Incorrect generating message received |
| BadThem Topic (them s) | |
| SafeFailure | Failed because the output of the operation applied to the value does not match between the peers. |
Fields
| |
nullProgress :: Applicative m => Topic -> Float -> m () Source #
Do nothing
Test Execution
simpleTest :: MonadBaseControl IO m stM => MonadIO m => Show s => SymbioteT s m () -> m () Source #
Prints to stdout and uses a local channel for a sanity-check - doesn't serialize.
Arguments
| :: MonadBaseControl IO m stM | |
| => MonadIO m | |
| => Show s | |
| => (Topic -> m ()) | report topic success |
| -> (Failure Second s -> m ()) | report topic failure from first (sees second) |
| -> (Failure First s -> m ()) | report topic failure from second (sees first) |
| -> (Topic -> Float -> m ()) | report topic progress |
| -> SymbioteT s m () | |
| -> m () |
Arguments
| :: MonadIO m | |
| => Show s | |
| => (First s -> m ()) | Encode and send first messages |
| -> m (Second s) | Receive and decode second messages |
| -> (Topic -> m ()) | Report when Successful |
| -> (Failure Second s -> m ()) | Report when Failed |
| -> (Topic -> Float -> m ()) | Report on Progress |
| -> SymbioteT s m () | |
| -> m () |
Run the test suite as the first peer - see Test.Serialization.Symbiote.WebSocket and Test.Serialization.Symbiote.ZeroMQ for end-user implementations.
Arguments
| :: MonadIO m | |
| => Show s | |
| => (Second s -> m ()) | Encode and send second messages |
| -> m (First s) | Receive and decode first messages |
| -> (Topic -> m ()) | Report when Successful |
| -> (Failure First s -> m ()) | Report when Failed |
| -> (Topic -> Float -> m ()) | Report on Progress |
| -> SymbioteT s m () | |
| -> m () |
Run the test suite as the second peer - see Test.Serialization.Symbiote.WebSocket and Test.Serialization.Symbiote.ZeroMQ for end-user implementations.