{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GADTs                      #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns             #-}
{-# LANGUAGE RankNTypes                 #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TypeApplications           #-}

{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Network.Protocol.LocalStateQuery.Test
  ( tests
  , codec
  , AnyMessageAndAgencyWithResult (..)
  ) where

import Codec.CBOR.Decoding qualified as CBOR
import Codec.CBOR.Encoding qualified as CBOR
import Data.ByteString.Lazy (ByteString)
import Data.Map (Map)
import Data.Map qualified as Map

import Control.Monad.Class.MonadAsync (MonadAsync)
import Control.Monad.Class.MonadST (MonadST)
import Control.Monad.Class.MonadThrow (MonadCatch)
import Control.Monad.IOSim
import Control.Monad.ST (runST)
import Control.Tracer (nullTracer)

import Codec.Serialise (DeserialiseFailure)
import Codec.Serialise qualified as Serialise (decode, encode)
import Codec.Serialise.Class qualified as SerialiseClass

import Network.TypedProtocol.Codec hiding (prop_codec)
import Network.TypedProtocol.Proofs

import Ouroboros.Network.Channel
import Ouroboros.Network.Driver.Simple (runConnectedPeers)
import Ouroboros.Network.Util.ShowProxy

import Ouroboros.Network.Mock.Chain (Point)
import Ouroboros.Network.Mock.ConcreteBlock (Block)

import Ouroboros.Network.Protocol.LocalStateQuery.Client
import Ouroboros.Network.Protocol.LocalStateQuery.Codec
import Ouroboros.Network.Protocol.LocalStateQuery.Direct
import Ouroboros.Network.Protocol.LocalStateQuery.Examples
import Ouroboros.Network.Protocol.LocalStateQuery.Server
import Ouroboros.Network.Protocol.LocalStateQuery.Type

import Test.ChainGenerators ()
import Test.Ouroboros.Network.Testing.Utils (prop_codec_cborM,
           prop_codec_valid_cbor_encoding, splits2, splits3)

import Test.QuickCheck as QC hiding (Result)
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import Text.Show.Functions ()


--
-- Test cases
--

tests :: TestTree
tests :: TestTree
tests =
  [Char] -> [TestTree] -> TestTree
testGroup [Char]
"Ouroboros.Network.Protocol"
    [ [Char] -> [TestTree] -> TestTree
testGroup [Char]
"LocalStateQuery"
        [ [Char] -> (SetupData -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"direct"              SetupData -> Property
prop_direct
        , [Char] -> (SetupData -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"connect"             SetupData -> Property
prop_connect
        , [Char]
-> (AnyMessageAndAgencyWithResult
      Block (Point Block) Query MockLedgerState
    -> Bool)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"codec"               AnyMessageAndAgencyWithResult
  Block (Point Block) Query MockLedgerState
-> Bool
prop_codec
        , [Char]
-> (AnyMessageAndAgencyWithResult
      Block (Point Block) Query MockLedgerState
    -> Bool)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"codec 2-splits"      AnyMessageAndAgencyWithResult
  Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_splits2
        , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"codec 3-splits"    (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ Int
-> (AnyMessageAndAgencyWithResult
      Block (Point Block) Query MockLedgerState
    -> Bool)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
30
                                             AnyMessageAndAgencyWithResult
  Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_splits3
        , [Char]
-> (AnyMessageAndAgencyWithResult
      Block (Point Block) Query MockLedgerState
    -> Bool)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"codec cbor"          AnyMessageAndAgencyWithResult
  Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_cbor
        , [Char]
-> (AnyMessageAndAgencyWithResult
      Block (Point Block) Query MockLedgerState
    -> Property)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"codec valid cbor"    AnyMessageAndAgencyWithResult
  Block (Point Block) Query MockLedgerState
-> Property
prop_codec_valid_cbor
        , [Char] -> (SetupData -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"channel ST"          SetupData -> Property
prop_channel_ST
        , [Char] -> (SetupData -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"channel IO"          SetupData -> Property
prop_channel_IO
        , [Char] -> (SetupData -> Property) -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"pipe IO"             SetupData -> Property
prop_pipe_IO
        ]
    ]


--
-- Common types & clients and servers used in the tests in this module.
--

data QueryWithResult query result where
    QueryWithResult :: query result
                    -> result
                    -> QueryWithResult query result
  deriving Int -> QueryWithResult query result -> ShowS
[QueryWithResult query result] -> ShowS
QueryWithResult query result -> [Char]
(Int -> QueryWithResult query result -> ShowS)
-> (QueryWithResult query result -> [Char])
-> ([QueryWithResult query result] -> ShowS)
-> Show (QueryWithResult query result)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall (query :: * -> *) result.
(Show result, Show (query result)) =>
Int -> QueryWithResult query result -> ShowS
forall (query :: * -> *) result.
(Show result, Show (query result)) =>
[QueryWithResult query result] -> ShowS
forall (query :: * -> *) result.
(Show result, Show (query result)) =>
QueryWithResult query result -> [Char]
$cshowsPrec :: forall (query :: * -> *) result.
(Show result, Show (query result)) =>
Int -> QueryWithResult query result -> ShowS
showsPrec :: Int -> QueryWithResult query result -> ShowS
$cshow :: forall (query :: * -> *) result.
(Show result, Show (query result)) =>
QueryWithResult query result -> [Char]
show :: QueryWithResult query result -> [Char]
$cshowList :: forall (query :: * -> *) result.
(Show result, Show (query result)) =>
[QueryWithResult query result] -> ShowS
showList :: [QueryWithResult query result] -> ShowS
Show

instance ( Arbitrary (query result)
         , Arbitrary result
         )
      => Arbitrary (QueryWithResult query result) where
    arbitrary :: Gen (QueryWithResult query result)
arbitrary = query result -> result -> QueryWithResult query result
forall (query :: * -> *) result.
query result -> result -> QueryWithResult query result
QueryWithResult (query result -> result -> QueryWithResult query result)
-> Gen (query result)
-> Gen (result -> QueryWithResult query result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (query result)
forall a. Arbitrary a => Gen a
arbitrary Gen (result -> QueryWithResult query result)
-> Gen result -> Gen (QueryWithResult query result)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen result
forall a. Arbitrary a => Gen a
arbitrary

data Query result where
  -- | An arbitrary query that happens to be trivial to implement in this test
  GetTheLedgerState :: Query MockLedgerState

deriving instance Show (Query result)
instance ShowProxy Query where

newtype MockLedgerState = MockLedgerState (Target (Point Block))
  deriving (Gen MockLedgerState
Gen MockLedgerState
-> (MockLedgerState -> [MockLedgerState])
-> Arbitrary MockLedgerState
MockLedgerState -> [MockLedgerState]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen MockLedgerState
arbitrary :: Gen MockLedgerState
$cshrink :: MockLedgerState -> [MockLedgerState]
shrink :: MockLedgerState -> [MockLedgerState]
Arbitrary, MockLedgerState -> MockLedgerState -> Bool
(MockLedgerState -> MockLedgerState -> Bool)
-> (MockLedgerState -> MockLedgerState -> Bool)
-> Eq MockLedgerState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MockLedgerState -> MockLedgerState -> Bool
== :: MockLedgerState -> MockLedgerState -> Bool
$c/= :: MockLedgerState -> MockLedgerState -> Bool
/= :: MockLedgerState -> MockLedgerState -> Bool
Eq, Int -> MockLedgerState -> ShowS
[MockLedgerState] -> ShowS
MockLedgerState -> [Char]
(Int -> MockLedgerState -> ShowS)
-> (MockLedgerState -> [Char])
-> ([MockLedgerState] -> ShowS)
-> Show MockLedgerState
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MockLedgerState -> ShowS
showsPrec :: Int -> MockLedgerState -> ShowS
$cshow :: MockLedgerState -> [Char]
show :: MockLedgerState -> [Char]
$cshowList :: [MockLedgerState] -> ShowS
showList :: [MockLedgerState] -> ShowS
Show, [MockLedgerState] -> Encoding
MockLedgerState -> Encoding
(MockLedgerState -> Encoding)
-> (forall s. Decoder s MockLedgerState)
-> ([MockLedgerState] -> Encoding)
-> (forall s. Decoder s [MockLedgerState])
-> Serialise MockLedgerState
forall s. Decoder s [MockLedgerState]
forall s. Decoder s MockLedgerState
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
$cencode :: MockLedgerState -> Encoding
encode :: MockLedgerState -> Encoding
$cdecode :: forall s. Decoder s MockLedgerState
decode :: forall s. Decoder s MockLedgerState
$cencodeList :: [MockLedgerState] -> Encoding
encodeList :: [MockLedgerState] -> Encoding
$cdecodeList :: forall s. Decoder s [MockLedgerState]
decodeList :: forall s. Decoder s [MockLedgerState]
SerialiseClass.Serialise)

-- | Information to test an example server and client.
data Setup = Setup
  { Setup -> [(Target (Point Block), Query MockLedgerState)]
clientInput   :: [(Target (Point Block), Query MockLedgerState)]
    -- ^ Input for 'localStateQueryClient'
  , Setup
-> Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire :: Target (Point Block) -> Either AcquireFailure MockLedgerState
    -- ^ First input parameter for 'localStateQueryServer'
  , Setup -> forall result. MockLedgerState -> Query result -> result
serverAnswer  :: forall result. MockLedgerState -> Query result -> result
    -- ^ Second input parameter for 'localStateQueryServer'
  , Setup
-> [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected      :: [(Target (Point Block), Either AcquireFailure MockLedgerState)]
    -- ^ Expected result for the 'localStateQueryClient'.
  }

-- | This map determines the input to the server and client defined in
-- "Ouroboros.Network.Protocol.LocalStateQuery.Examples"
--
-- For each entry, in order, the client will attempt to acquire the key, the
-- server will respond either with the given @'Just' 'AcquireFailure'@ or else
-- in the affirmative, in which case the client will issue the given query.
--
-- This is the randomly generated input for the 'Setup'.
type SetupData = Map (Target (Point Block)) (Maybe AcquireFailure, Query MockLedgerState)

mkSetup :: SetupData -> Setup
mkSetup :: SetupData -> Setup
mkSetup SetupData
input = Setup {
      clientInput :: [(Target (Point Block), Query MockLedgerState)]
clientInput   = [(Target (Point Block)
pt, Query MockLedgerState
q) | (Target (Point Block)
pt, (Maybe AcquireFailure
_, Query MockLedgerState
q)) <- SetupData
-> [(Target (Point Block),
     (Maybe AcquireFailure, Query MockLedgerState))]
forall k a. Map k a -> [(k, a)]
Map.toList SetupData
input]
    , serverAcquire :: Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire = \Target (Point Block)
tgt -> case Target (Point Block)
-> SetupData -> Maybe (Maybe AcquireFailure, Query MockLedgerState)
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Target (Point Block)
tgt SetupData
input of
        Just (Just AcquireFailure
failure, Query MockLedgerState
_q) -> AcquireFailure -> Either AcquireFailure MockLedgerState
forall a b. a -> Either a b
Left AcquireFailure
failure
        Just (Maybe AcquireFailure
Nothing,      Query MockLedgerState
_q) -> MockLedgerState -> Either AcquireFailure MockLedgerState
forall a b. b -> Either a b
Right (Target (Point Block) -> MockLedgerState
MockLedgerState Target (Point Block)
tgt)
        Maybe (Maybe AcquireFailure, Query MockLedgerState)
Nothing                 -> [Char] -> Either AcquireFailure MockLedgerState
forall a. HasCallStack => [Char] -> a
error ([Char] -> Either AcquireFailure MockLedgerState)
-> [Char] -> Either AcquireFailure MockLedgerState
forall a b. (a -> b) -> a -> b
$
          [Char]
"a point not in the input was tried to be acquired: " [Char] -> ShowS
forall a. Semigroup a => a -> a -> a
<> Target (Point Block) -> [Char]
forall a. Show a => a -> [Char]
show Target (Point Block)
tgt
    , serverAnswer :: forall result. MockLedgerState -> Query result -> result
serverAnswer  = MockLedgerState -> Query result -> result
forall result. MockLedgerState -> Query result -> result
answer
    , expected :: [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected      =
        [ (Target (Point Block)
tgt, Either AcquireFailure MockLedgerState
res)
        | (Target (Point Block)
tgt, (Maybe AcquireFailure
mbFailure, Query MockLedgerState
q)) <- SetupData
-> [(Target (Point Block),
     (Maybe AcquireFailure, Query MockLedgerState))]
forall k a. Map k a -> [(k, a)]
Map.toList SetupData
input
        , let res :: Either AcquireFailure MockLedgerState
res = case Maybe AcquireFailure
mbFailure of
                Maybe AcquireFailure
Nothing      -> MockLedgerState -> Either AcquireFailure MockLedgerState
forall a b. b -> Either a b
Right (MockLedgerState -> Either AcquireFailure MockLedgerState)
-> MockLedgerState -> Either AcquireFailure MockLedgerState
forall a b. (a -> b) -> a -> b
$ MockLedgerState -> Query MockLedgerState -> MockLedgerState
forall result. MockLedgerState -> Query result -> result
answer (Target (Point Block) -> MockLedgerState
MockLedgerState Target (Point Block)
tgt) Query MockLedgerState
q
                Just AcquireFailure
failure -> AcquireFailure -> Either AcquireFailure MockLedgerState
forall a b. a -> Either a b
Left AcquireFailure
failure
        ]
    }
  where
    answer :: MockLedgerState -> Query result -> result
    answer :: forall result. MockLedgerState -> Query result -> result
answer MockLedgerState
st Query result
q = case Query result
q of
      Query result
GetTheLedgerState -> result
MockLedgerState
st


--
-- Properties going directly, not via Peer.
--

-- | Run a simple local state query client and server, directly on the wrappers,
-- without going via the 'Peer'.
--
prop_direct :: SetupData
            -> Property
prop_direct :: SetupData -> Property
prop_direct SetupData
input =
    (forall s.
 IOSim
   s
   ([(Target (Point Block), Either AcquireFailure MockLedgerState)],
    ()))
-> ([(Target (Point Block),
      Either AcquireFailure MockLedgerState)],
    ())
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
      (LocalStateQueryClient
  Any
  (Point Block)
  Query
  (IOSim s)
  [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> LocalStateQueryServer Any (Point Block) Query (IOSim s) ()
-> IOSim
     s
     ([(Target (Point Block), Either AcquireFailure MockLedgerState)],
      ())
forall block point (query :: * -> *) (m :: * -> *) a b.
Monad m =>
LocalStateQueryClient block point query m a
-> LocalStateQueryServer block point query m b -> m (a, b)
direct
        ([(Target (Point Block), Query MockLedgerState)]
-> LocalStateQueryClient
     Any
     (Point Block)
     Query
     (IOSim s)
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
forall block point (query :: * -> *) result (m :: * -> *).
Applicative m =>
[(Target point, query result)]
-> LocalStateQueryClient
     block point query m [(Target point, Either AcquireFailure result)]
localStateQueryClient [(Target (Point Block), Query MockLedgerState)]
clientInput)
        ((Target (Point Block) -> Either AcquireFailure MockLedgerState)
-> (forall result. MockLedgerState -> Query result -> result)
-> LocalStateQueryServer Any (Point Block) Query (IOSim s) ()
forall block point (query :: * -> *) (m :: * -> *) state.
Applicative m =>
(Target point -> Either AcquireFailure state)
-> (forall result. state -> query result -> result)
-> LocalStateQueryServer block point query m ()
localStateQueryServer Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire MockLedgerState -> Query result -> result
forall result. MockLedgerState -> Query result -> result
serverAnswer))
  ([(Target (Point Block), Either AcquireFailure MockLedgerState)],
 ())
-> ([(Target (Point Block),
      Either AcquireFailure MockLedgerState)],
    ())
-> Property
forall a. (Eq a, Show a) => a -> a -> Property
===
    ([(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected, ())
  where
    Setup { [(Target (Point Block), Query MockLedgerState)]
clientInput :: Setup -> [(Target (Point Block), Query MockLedgerState)]
clientInput :: [(Target (Point Block), Query MockLedgerState)]
clientInput, Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire :: Setup
-> Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire :: Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire, forall result. MockLedgerState -> Query result -> result
serverAnswer :: Setup -> forall result. MockLedgerState -> Query result -> result
serverAnswer :: forall result. MockLedgerState -> Query result -> result
serverAnswer, [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected :: Setup
-> [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected :: [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected } = SetupData -> Setup
mkSetup SetupData
input


--
-- Properties going via Peer, but without using a channel
--

-- | Run a simple local state query client and server, going via the 'Peer'
-- representation, but without going via a channel.
--
prop_connect :: SetupData
             -> Property
prop_connect :: SetupData -> Property
prop_connect SetupData
input =
    case (forall s.
 IOSim
   s
   ([(Target (Point Block), Either AcquireFailure MockLedgerState)],
    (), TerminalStates (LocalStateQuery Any (Point Block) Query)))
-> ([(Target (Point Block),
      Either AcquireFailure MockLedgerState)],
    (), TerminalStates (LocalStateQuery Any (Point Block) Query))
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
           (Peer
  (LocalStateQuery Any (Point Block) Query)
  'AsClient
  'StIdle
  (IOSim s)
  [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Peer
     (LocalStateQuery Any (Point Block) Query)
     (FlipAgency 'AsClient)
     'StIdle
     (IOSim s)
     ()
-> IOSim
     s
     ([(Target (Point Block), Either AcquireFailure MockLedgerState)],
      (), TerminalStates (LocalStateQuery Any (Point Block) Query))
forall ps (pr :: PeerRole) (st :: ps) (m :: * -> *) a b.
(Monad m, Protocol ps) =>
Peer ps pr st m a
-> Peer ps (FlipAgency pr) st m b -> m (a, b, TerminalStates ps)
connect
             (LocalStateQueryClient
  Any
  (Point Block)
  Query
  (IOSim s)
  [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Peer
     (LocalStateQuery Any (Point Block) Query)
     'AsClient
     'StIdle
     (IOSim s)
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryClient block point query m a
-> Peer (LocalStateQuery block point query) 'AsClient 'StIdle m a
localStateQueryClientPeer (LocalStateQueryClient
   Any
   (Point Block)
   Query
   (IOSim s)
   [(Target (Point Block), Either AcquireFailure MockLedgerState)]
 -> Peer
      (LocalStateQuery Any (Point Block) Query)
      'AsClient
      'StIdle
      (IOSim s)
      [(Target (Point Block), Either AcquireFailure MockLedgerState)])
-> LocalStateQueryClient
     Any
     (Point Block)
     Query
     (IOSim s)
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Peer
     (LocalStateQuery Any (Point Block) Query)
     'AsClient
     'StIdle
     (IOSim s)
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
forall a b. (a -> b) -> a -> b
$
              [(Target (Point Block), Query MockLedgerState)]
-> LocalStateQueryClient
     Any
     (Point Block)
     Query
     (IOSim s)
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
forall block point (query :: * -> *) result (m :: * -> *).
Applicative m =>
[(Target point, query result)]
-> LocalStateQueryClient
     block point query m [(Target point, Either AcquireFailure result)]
localStateQueryClient [(Target (Point Block), Query MockLedgerState)]
clientInput)
             (LocalStateQueryServer Any (Point Block) Query (IOSim s) ()
-> Peer
     (LocalStateQuery Any (Point Block) Query)
     'AsServer
     'StIdle
     (IOSim s)
     ()
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryServer block point query m a
-> Peer (LocalStateQuery block point query) 'AsServer 'StIdle m a
localStateQueryServerPeer (LocalStateQueryServer Any (Point Block) Query (IOSim s) ()
 -> Peer
      (LocalStateQuery Any (Point Block) Query)
      'AsServer
      'StIdle
      (IOSim s)
      ())
-> LocalStateQueryServer Any (Point Block) Query (IOSim s) ()
-> Peer
     (LocalStateQuery Any (Point Block) Query)
     'AsServer
     'StIdle
     (IOSim s)
     ()
forall a b. (a -> b) -> a -> b
$
              (Target (Point Block) -> Either AcquireFailure MockLedgerState)
-> (forall result. MockLedgerState -> Query result -> result)
-> LocalStateQueryServer Any (Point Block) Query (IOSim s) ()
forall block point (query :: * -> *) (m :: * -> *) state.
Applicative m =>
(Target point -> Either AcquireFailure state)
-> (forall result. state -> query result -> result)
-> LocalStateQueryServer block point query m ()
localStateQueryServer Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire MockLedgerState -> Query result -> result
forall result. MockLedgerState -> Query result -> result
serverAnswer)) of

      ([(Target (Point Block), Either AcquireFailure MockLedgerState)]
result, (), TerminalStates NobodyHasAgency st
R:NobodyHasAgencyLocalStateQueryst
  (*) (*) Any (Point Block) Query st
TokDone NobodyHasAgency st
R:NobodyHasAgencyLocalStateQueryst
  (*) (*) Any (Point Block) Query 'StDone
TokDone) -> [(Target (Point Block), Either AcquireFailure MockLedgerState)]
result [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected
  where
    Setup { [(Target (Point Block), Query MockLedgerState)]
clientInput :: Setup -> [(Target (Point Block), Query MockLedgerState)]
clientInput :: [(Target (Point Block), Query MockLedgerState)]
clientInput, Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire :: Setup
-> Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire :: Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire, forall result. MockLedgerState -> Query result -> result
serverAnswer :: Setup -> forall result. MockLedgerState -> Query result -> result
serverAnswer :: forall result. MockLedgerState -> Query result -> result
serverAnswer, [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected :: Setup
-> [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected :: [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected } = SetupData -> Setup
mkSetup SetupData
input


--
-- Properties using a channel
--

-- | Run a local state query client and server using connected channels.
--
prop_channel :: ( MonadAsync m
                , MonadCatch m
                , MonadST m
                )
             => m (Channel m ByteString, Channel m ByteString)
             -> SetupData
             -> m Property
prop_channel :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> SetupData -> m Property
prop_channel m (Channel m ByteString, Channel m ByteString)
createChannels SetupData
input =

    (([(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected, ()) ([(Target (Point Block), Either AcquireFailure MockLedgerState)],
 ())
-> ([(Target (Point Block),
      Either AcquireFailure MockLedgerState)],
    ())
-> Property
forall a. (Eq a, Show a) => a -> a -> Property
===) (([(Target (Point Block), Either AcquireFailure MockLedgerState)],
  ())
 -> Property)
-> m ([(Target (Point Block),
        Either AcquireFailure MockLedgerState)],
      ())
-> m Property
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>

    m (Channel m ByteString, Channel m ByteString)
-> Tracer
     m (Role, TraceSendRecv (LocalStateQuery Block (Point Block) Query))
-> Codec
     (LocalStateQuery Block (Point Block) Query)
     DeserialiseFailure
     m
     ByteString
-> Peer
     (LocalStateQuery Block (Point Block) Query)
     'AsClient
     'StIdle
     m
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Peer
     (LocalStateQuery Block (Point Block) Query)
     (FlipAgency 'AsClient)
     'StIdle
     m
     ()
-> m ([(Target (Point Block),
        Either AcquireFailure MockLedgerState)],
      ())
forall (m :: * -> *) failure ps bytes (pr :: PeerRole) (st :: ps) a
       b.
(MonadAsync m, MonadCatch m, Show failure,
 forall (st' :: ps). Show (ClientHasAgency st'),
 forall (st' :: ps). Show (ServerHasAgency st'), ShowProxy ps) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps)
-> Codec ps failure m bytes
-> Peer ps pr st m a
-> Peer ps (FlipAgency pr) st m b
-> m (a, b)
runConnectedPeers
      m (Channel m ByteString, Channel m ByteString)
createChannels
      Tracer
  m (Role, TraceSendRecv (LocalStateQuery Block (Point Block) Query))
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
      Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  m
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  m
  ByteString
codec
      (LocalStateQueryClient
  Block
  (Point Block)
  Query
  m
  [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Peer
     (LocalStateQuery Block (Point Block) Query)
     'AsClient
     'StIdle
     m
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryClient block point query m a
-> Peer (LocalStateQuery block point query) 'AsClient 'StIdle m a
localStateQueryClientPeer (LocalStateQueryClient
   Block
   (Point Block)
   Query
   m
   [(Target (Point Block), Either AcquireFailure MockLedgerState)]
 -> Peer
      (LocalStateQuery Block (Point Block) Query)
      'AsClient
      'StIdle
      m
      [(Target (Point Block), Either AcquireFailure MockLedgerState)])
-> LocalStateQueryClient
     Block
     (Point Block)
     Query
     m
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Peer
     (LocalStateQuery Block (Point Block) Query)
     'AsClient
     'StIdle
     m
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
forall a b. (a -> b) -> a -> b
$
       [(Target (Point Block), Query MockLedgerState)]
-> LocalStateQueryClient
     Block
     (Point Block)
     Query
     m
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
forall block point (query :: * -> *) result (m :: * -> *).
Applicative m =>
[(Target point, query result)]
-> LocalStateQueryClient
     block point query m [(Target point, Either AcquireFailure result)]
localStateQueryClient [(Target (Point Block), Query MockLedgerState)]
clientInput)
      (LocalStateQueryServer Block (Point Block) Query m ()
-> Peer
     (LocalStateQuery Block (Point Block) Query) 'AsServer 'StIdle m ()
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryServer block point query m a
-> Peer (LocalStateQuery block point query) 'AsServer 'StIdle m a
localStateQueryServerPeer (LocalStateQueryServer Block (Point Block) Query m ()
 -> Peer
      (LocalStateQuery Block (Point Block) Query) 'AsServer 'StIdle m ())
-> LocalStateQueryServer Block (Point Block) Query m ()
-> Peer
     (LocalStateQuery Block (Point Block) Query) 'AsServer 'StIdle m ()
forall a b. (a -> b) -> a -> b
$
       (Target (Point Block) -> Either AcquireFailure MockLedgerState)
-> (forall result. MockLedgerState -> Query result -> result)
-> LocalStateQueryServer Block (Point Block) Query m ()
forall block point (query :: * -> *) (m :: * -> *) state.
Applicative m =>
(Target point -> Either AcquireFailure state)
-> (forall result. state -> query result -> result)
-> LocalStateQueryServer block point query m ()
localStateQueryServer Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire MockLedgerState -> Query result -> result
forall result. MockLedgerState -> Query result -> result
serverAnswer)
  where
    Setup { [(Target (Point Block), Query MockLedgerState)]
clientInput :: Setup -> [(Target (Point Block), Query MockLedgerState)]
clientInput :: [(Target (Point Block), Query MockLedgerState)]
clientInput, Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire :: Setup
-> Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire :: Target (Point Block) -> Either AcquireFailure MockLedgerState
serverAcquire, forall result. MockLedgerState -> Query result -> result
serverAnswer :: Setup -> forall result. MockLedgerState -> Query result -> result
serverAnswer :: forall result. MockLedgerState -> Query result -> result
serverAnswer, [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected :: Setup
-> [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected :: [(Target (Point Block), Either AcquireFailure MockLedgerState)]
expected } = SetupData -> Setup
mkSetup SetupData
input

-- | Run 'prop_channel' in the simulation monad.
--
prop_channel_ST :: SetupData
                -> Property
prop_channel_ST :: SetupData -> Property
prop_channel_ST SetupData
input =
    (forall s. IOSim s Property) -> Property
forall a. (forall s. IOSim s a) -> a
runSimOrThrow
      (IOSim
  s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
-> SetupData -> IOSim s Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> SetupData -> m Property
prop_channel IOSim
  s (Channel (IOSim s) ByteString, Channel (IOSim s) ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels SetupData
input)

-- | Run 'prop_channel' in the IO monad.
--
prop_channel_IO :: SetupData
                -> Property
prop_channel_IO :: SetupData -> Property
prop_channel_IO SetupData
input =
    IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO (Channel IO ByteString, Channel IO ByteString)
-> SetupData -> IO Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> SetupData -> m Property
prop_channel IO (Channel IO ByteString, Channel IO ByteString)
forall (m :: * -> *) a. MonadSTM m => m (Channel m a, Channel m a)
createConnectedChannels SetupData
input)

-- | Run 'prop_channel' in the IO monad using local pipes.
--
prop_pipe_IO :: SetupData
             -> Property
prop_pipe_IO :: SetupData -> Property
prop_pipe_IO SetupData
input =
    IO Property -> Property
forall prop. Testable prop => IO prop -> Property
ioProperty (IO (Channel IO ByteString, Channel IO ByteString)
-> SetupData -> IO Property
forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadST m) =>
m (Channel m ByteString, Channel m ByteString)
-> SetupData -> m Property
prop_channel IO (Channel IO ByteString, Channel IO ByteString)
createPipeConnectedChannels SetupData
input)


--
-- Codec properties
--

instance Arbitrary point => Arbitrary (Target point) where
  arbitrary :: Gen (Target point)
arbitrary = [Gen (Target point)] -> Gen (Target point)
forall a. [Gen a] -> Gen a
oneof
    [ Target point -> Gen (Target point)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Target point
forall point. Target point
ImmutableTip
    , point -> Target point
forall point. point -> Target point
SpecificPoint (point -> Target point) -> Gen point -> Gen (Target point)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen point
forall a. Arbitrary a => Gen a
arbitrary
    , Target point -> Gen (Target point)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Target point
forall point. Target point
VolatileTip
    ]

instance SerialiseClass.Serialise point => SerialiseClass.Serialise (Target point)

instance Arbitrary AcquireFailure where
  arbitrary :: Gen AcquireFailure
arbitrary = [AcquireFailure] -> Gen AcquireFailure
forall a. [a] -> Gen a
elements
    [ AcquireFailure
AcquireFailurePointTooOld
    , AcquireFailure
AcquireFailurePointNotOnChain
    ]

instance Arbitrary (Query MockLedgerState) where
  arbitrary :: Gen (Query MockLedgerState)
arbitrary = Query MockLedgerState -> Gen (Query MockLedgerState)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Query MockLedgerState
GetTheLedgerState

-- | A newtype wrapper which captures type of response generated for all
-- queries.
--
-- Note that this is not as general as the protocol allows, since the protocol
-- admits different result for different queries.
--
newtype AnyMessageAndAgencyWithResult block point query result = AnyMessageAndAgencyWithResult {
    forall block point (query :: * -> *) result.
AnyMessageAndAgencyWithResult block point query result
-> AnyMessageAndAgency (LocalStateQuery block point query)
getAnyMessageAndAgencyWithResult :: AnyMessageAndAgency (LocalStateQuery block point query)
  }
  deriving Int
-> AnyMessageAndAgencyWithResult block point query result -> ShowS
[AnyMessageAndAgencyWithResult block point query result] -> ShowS
AnyMessageAndAgencyWithResult block point query result -> [Char]
(Int
 -> AnyMessageAndAgencyWithResult block point query result -> ShowS)
-> (AnyMessageAndAgencyWithResult block point query result
    -> [Char])
-> ([AnyMessageAndAgencyWithResult block point query result]
    -> ShowS)
-> Show (AnyMessageAndAgencyWithResult block point query result)
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
Int
-> AnyMessageAndAgencyWithResult block point query result -> ShowS
forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
[AnyMessageAndAgencyWithResult block point query result] -> ShowS
forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
AnyMessageAndAgencyWithResult block point query result -> [Char]
$cshowsPrec :: forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
Int
-> AnyMessageAndAgencyWithResult block point query result -> ShowS
showsPrec :: Int
-> AnyMessageAndAgencyWithResult block point query result -> ShowS
$cshow :: forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
AnyMessageAndAgencyWithResult block point query result -> [Char]
show :: AnyMessageAndAgencyWithResult block point query result -> [Char]
$cshowList :: forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
[AnyMessageAndAgencyWithResult block point query result] -> ShowS
showList :: [AnyMessageAndAgencyWithResult block point query result] -> ShowS
Show

instance ( Arbitrary point
         , Arbitrary (query result)
         , Arbitrary result
         )
      => Arbitrary (AnyMessageAndAgencyWithResult block point query result) where
  arbitrary :: Gen (AnyMessageAndAgencyWithResult block point query result)
arbitrary = AnyMessageAndAgency (LocalStateQuery block point query)
-> AnyMessageAndAgencyWithResult block point query result
forall block point (query :: * -> *) result.
AnyMessageAndAgency (LocalStateQuery block point query)
-> AnyMessageAndAgencyWithResult block point query result
AnyMessageAndAgencyWithResult (AnyMessageAndAgency (LocalStateQuery block point query)
 -> AnyMessageAndAgencyWithResult block point query result)
-> Gen (AnyMessageAndAgency (LocalStateQuery block point query))
-> Gen (AnyMessageAndAgencyWithResult block point query result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (AnyMessageAndAgency (LocalStateQuery block point query))]
-> Gen (AnyMessageAndAgency (LocalStateQuery block point query))
forall a. [Gen a] -> Gen a
oneof
    [ PeerHasAgency 'AsClient 'StIdle
-> Message (LocalStateQuery block point query) 'StIdle 'StAcquiring
-> AnyMessageAndAgency (LocalStateQuery block point query)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ClientHasAgency 'StIdle -> PeerHasAgency 'AsClient 'StIdle
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall {k} {k1} {block :: k} {point :: k1} {query :: * -> *}.
ClientHasAgency 'StIdle
TokIdle) (Message (LocalStateQuery block point query) 'StIdle 'StAcquiring
 -> AnyMessageAndAgency (LocalStateQuery block point query))
-> Gen
     (Message (LocalStateQuery block point query) 'StIdle 'StAcquiring)
-> Gen (AnyMessageAndAgency (LocalStateQuery block point query))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Target point
-> Message (LocalStateQuery block point query) 'StIdle 'StAcquiring
forall {k} point1 (block :: k) (query :: * -> *).
Target point1
-> Message
     (LocalStateQuery block point1 query) 'StIdle 'StAcquiring
MsgAcquire (Target point
 -> Message
      (LocalStateQuery block point query) 'StIdle 'StAcquiring)
-> Gen (Target point)
-> Gen
     (Message (LocalStateQuery block point query) 'StIdle 'StAcquiring)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Target point)
forall a. Arbitrary a => Gen a
arbitrary)

    , PeerHasAgency 'AsServer 'StAcquiring
-> Message
     (LocalStateQuery block point query) 'StAcquiring 'StAcquired
-> AnyMessageAndAgency (LocalStateQuery block point query)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ServerHasAgency 'StAcquiring
-> PeerHasAgency 'AsServer 'StAcquiring
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StAcquiring
forall {k} {k1} {block :: k} {point :: k1} {query :: * -> *}.
ServerHasAgency 'StAcquiring
TokAcquiring) (Message
   (LocalStateQuery block point query) 'StAcquiring 'StAcquired
 -> AnyMessageAndAgency (LocalStateQuery block point query))
-> Gen
     (Message
        (LocalStateQuery block point query) 'StAcquiring 'StAcquired)
-> Gen (AnyMessageAndAgency (LocalStateQuery block point query))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Message
  (LocalStateQuery block point query) 'StAcquiring 'StAcquired
-> Gen
     (Message
        (LocalStateQuery block point query) 'StAcquiring 'StAcquired)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message
  (LocalStateQuery block point query) 'StAcquiring 'StAcquired
forall {k} {k1} (block :: k) (point :: k1) (query :: * -> *).
Message
  (LocalStateQuery block point query) 'StAcquiring 'StAcquired
MsgAcquired

    , PeerHasAgency 'AsServer 'StAcquiring
-> Message (LocalStateQuery block point query) 'StAcquiring 'StIdle
-> AnyMessageAndAgency (LocalStateQuery block point query)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ServerHasAgency 'StAcquiring
-> PeerHasAgency 'AsServer 'StAcquiring
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency ServerHasAgency 'StAcquiring
forall {k} {k1} {block :: k} {point :: k1} {query :: * -> *}.
ServerHasAgency 'StAcquiring
TokAcquiring) (Message (LocalStateQuery block point query) 'StAcquiring 'StIdle
 -> AnyMessageAndAgency (LocalStateQuery block point query))
-> Gen
     (Message (LocalStateQuery block point query) 'StAcquiring 'StIdle)
-> Gen (AnyMessageAndAgency (LocalStateQuery block point query))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (AcquireFailure
-> Message (LocalStateQuery block point query) 'StAcquiring 'StIdle
forall {k} {k1} (block :: k) (point :: k1) (query :: * -> *).
AcquireFailure
-> Message (LocalStateQuery block point query) 'StAcquiring 'StIdle
MsgFailure (AcquireFailure
 -> Message
      (LocalStateQuery block point query) 'StAcquiring 'StIdle)
-> Gen AcquireFailure
-> Gen
     (Message (LocalStateQuery block point query) 'StAcquiring 'StIdle)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen AcquireFailure
forall a. Arbitrary a => Gen a
arbitrary)

    , PeerHasAgency 'AsClient 'StAcquired
-> Message
     (LocalStateQuery block point query)
     'StAcquired
     ('StQuerying result)
-> AnyMessageAndAgency (LocalStateQuery block point query)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ClientHasAgency 'StAcquired -> PeerHasAgency 'AsClient 'StAcquired
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StAcquired
forall {k} {k1} {block :: k} {point :: k1} {query :: * -> *}.
ClientHasAgency 'StAcquired
TokAcquired) (Message
   (LocalStateQuery block point query)
   'StAcquired
   ('StQuerying result)
 -> AnyMessageAndAgency (LocalStateQuery block point query))
-> Gen
     (Message
        (LocalStateQuery block point query)
        'StAcquired
        ('StQuerying result))
-> Gen (AnyMessageAndAgency (LocalStateQuery block point query))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (query result
-> Message
     (LocalStateQuery block point query)
     'StAcquired
     ('StQuerying result)
forall {k} {k1} (query :: * -> *) result (block :: k)
       (point :: k1).
query result
-> Message
     (LocalStateQuery block point query)
     'StAcquired
     ('StQuerying result)
MsgQuery (query result
 -> Message
      (LocalStateQuery block point query)
      'StAcquired
      ('StQuerying result))
-> Gen (query result)
-> Gen
     (Message
        (LocalStateQuery block point query)
        'StAcquired
        ('StQuerying result))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen (query result)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (query result)))

    , (\(QueryWithResult query result
query result
result) ->
        PeerHasAgency 'AsServer ('StQuerying result)
-> Message
     (LocalStateQuery block point query)
     ('StQuerying result)
     'StAcquired
-> AnyMessageAndAgency (LocalStateQuery block point query)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ServerHasAgency ('StQuerying result)
-> PeerHasAgency 'AsServer ('StQuerying result)
forall {ps} (st :: ps).
ServerHasAgency st -> PeerHasAgency 'AsServer st
ServerAgency (query result -> ServerHasAgency ('StQuerying result)
forall {k} {k1} (query :: * -> *) result (block :: k)
       (point :: k1).
query result -> ServerHasAgency ('StQuerying result)
TokQuerying query result
query))
                            (query result
-> result
-> Message
     (LocalStateQuery block point query)
     ('StQuerying result)
     'StAcquired
forall {k} {k1} (query :: * -> *) result (block :: k)
       (point :: k1).
query result
-> result
-> Message
     (LocalStateQuery block point query)
     ('StQuerying result)
     'StAcquired
MsgResult query result
query result
result))
      (QueryWithResult query result
 -> AnyMessageAndAgency (LocalStateQuery block point query))
-> Gen (QueryWithResult query result)
-> Gen (AnyMessageAndAgency (LocalStateQuery block point query))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen (QueryWithResult query result)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (QueryWithResult query result))

    , PeerHasAgency 'AsClient 'StAcquired
-> Message (LocalStateQuery block point query) 'StAcquired 'StIdle
-> AnyMessageAndAgency (LocalStateQuery block point query)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ClientHasAgency 'StAcquired -> PeerHasAgency 'AsClient 'StAcquired
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StAcquired
forall {k} {k1} {block :: k} {point :: k1} {query :: * -> *}.
ClientHasAgency 'StAcquired
TokAcquired) (Message (LocalStateQuery block point query) 'StAcquired 'StIdle
 -> AnyMessageAndAgency (LocalStateQuery block point query))
-> Gen
     (Message (LocalStateQuery block point query) 'StAcquired 'StIdle)
-> Gen (AnyMessageAndAgency (LocalStateQuery block point query))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Message (LocalStateQuery block point query) 'StAcquired 'StIdle
-> Gen
     (Message (LocalStateQuery block point query) 'StAcquired 'StIdle)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message (LocalStateQuery block point query) 'StAcquired 'StIdle
forall {k} {k1} (block :: k) (point :: k1) (query :: * -> *).
Message (LocalStateQuery block point query) 'StAcquired 'StIdle
MsgRelease

    , PeerHasAgency 'AsClient 'StAcquired
-> Message
     (LocalStateQuery block point query) 'StAcquired 'StAcquiring
-> AnyMessageAndAgency (LocalStateQuery block point query)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ClientHasAgency 'StAcquired -> PeerHasAgency 'AsClient 'StAcquired
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StAcquired
forall {k} {k1} {block :: k} {point :: k1} {query :: * -> *}.
ClientHasAgency 'StAcquired
TokAcquired) (Message
   (LocalStateQuery block point query) 'StAcquired 'StAcquiring
 -> AnyMessageAndAgency (LocalStateQuery block point query))
-> Gen
     (Message
        (LocalStateQuery block point query) 'StAcquired 'StAcquiring)
-> Gen (AnyMessageAndAgency (LocalStateQuery block point query))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        (Target point
-> Message
     (LocalStateQuery block point query) 'StAcquired 'StAcquiring
forall {k} point1 (block :: k) (query :: * -> *).
Target point1
-> Message
     (LocalStateQuery block point1 query) 'StAcquired 'StAcquiring
MsgReAcquire (Target point
 -> Message
      (LocalStateQuery block point query) 'StAcquired 'StAcquiring)
-> Gen (Target point)
-> Gen
     (Message
        (LocalStateQuery block point query) 'StAcquired 'StAcquiring)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Target point)
forall a. Arbitrary a => Gen a
arbitrary)

    , PeerHasAgency 'AsClient 'StIdle
-> Message (LocalStateQuery block point query) 'StIdle 'StDone
-> AnyMessageAndAgency (LocalStateQuery block point query)
forall (pr :: PeerRole) ps (st :: ps) (st' :: ps).
PeerHasAgency pr st -> Message ps st st' -> AnyMessageAndAgency ps
AnyMessageAndAgency (ClientHasAgency 'StIdle -> PeerHasAgency 'AsClient 'StIdle
forall {ps} (st :: ps).
ClientHasAgency st -> PeerHasAgency 'AsClient st
ClientAgency ClientHasAgency 'StIdle
forall {k} {k1} {block :: k} {point :: k1} {query :: * -> *}.
ClientHasAgency 'StIdle
TokIdle) (Message (LocalStateQuery block point query) 'StIdle 'StDone
 -> AnyMessageAndAgency (LocalStateQuery block point query))
-> Gen
     (Message (LocalStateQuery block point query) 'StIdle 'StDone)
-> Gen (AnyMessageAndAgency (LocalStateQuery block point query))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
        Message (LocalStateQuery block point query) 'StIdle 'StDone
-> Gen
     (Message (LocalStateQuery block point query) 'StIdle 'StDone)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message (LocalStateQuery block point query) 'StIdle 'StDone
forall {k} {k1} (block :: k) (point :: k1) (query :: * -> *).
Message (LocalStateQuery block point query) 'StIdle 'StDone
MsgDone
    ]

instance ShowQuery Query where
  showResult :: forall result. Query result -> result -> [Char]
showResult Query result
GetTheLedgerState = result -> [Char]
forall a. Show a => a -> [Char]
show

instance  Eq (AnyMessage (LocalStateQuery Block (Point Block) Query)) where

  == :: AnyMessage (LocalStateQuery Block (Point Block) Query)
-> AnyMessage (LocalStateQuery Block (Point Block) Query) -> Bool
(==) (AnyMessage (MsgAcquire Target point1
tgt))
       (AnyMessage (MsgAcquire Target point1
tgt')) = Target point1
tgt Target point1 -> Target point1 -> Bool
forall a. Eq a => a -> a -> Bool
== Target point1
Target point1
tgt'

  (==) (AnyMessage Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto
  (*) (*) Block (Point Block) Query st st'
MsgAcquired)
       (AnyMessage Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto
  (*) (*) Block (Point Block) Query st st'
MsgAcquired) = Bool
True

  (==) (AnyMessage (MsgFailure AcquireFailure
failure))
       (AnyMessage (MsgFailure AcquireFailure
failure')) = AcquireFailure
failure AcquireFailure -> AcquireFailure -> Bool
forall a. Eq a => a -> a -> Bool
== AcquireFailure
failure'

  (==) (AnyMessage (MsgQuery Query result
query))
       (AnyMessage (MsgQuery Query result
query')) =
         case (Query result
query, Query result
query') of
           (Query result
GetTheLedgerState, Query result
GetTheLedgerState) -> Bool
True

  (==) (AnyMessage (MsgResult Query result
query  result
result))
       (AnyMessage (MsgResult Query result
query' result
result')) =
         case (Query result
query, Query result
query') of
           (Query result
GetTheLedgerState, Query result
GetTheLedgerState) -> result
result result -> result -> Bool
forall a. Eq a => a -> a -> Bool
== result
result
result'

  (==) (AnyMessage Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto
  (*) (*) Block (Point Block) Query st st'
MsgRelease)
       (AnyMessage Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto
  (*) (*) Block (Point Block) Query st st'
MsgRelease) = Bool
True

  (==) (AnyMessage (MsgReAcquire Target point1
tgt))
       (AnyMessage (MsgReAcquire Target point1
tgt')) = Target point1
tgt Target point1 -> Target point1 -> Bool
forall a. Eq a => a -> a -> Bool
== Target point1
Target point1
tgt'

  (==) (AnyMessage Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto
  (*) (*) Block (Point Block) Query st st'
MsgDone)
       (AnyMessage Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto
  (*) (*) Block (Point Block) Query st st'
MsgDone) = Bool
True

  AnyMessage (LocalStateQuery Block (Point Block) Query)
_ == AnyMessage (LocalStateQuery Block (Point Block) Query)
_ = Bool
False


codec :: MonadST m
      => Codec (LocalStateQuery Block (Point Block) Query)
                DeserialiseFailure
                m ByteString
codec :: forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  m
  ByteString
codec =
    NodeToClientVersion
-> (Point Block -> Encoding)
-> (forall s. Decoder s (Point Block))
-> (forall result. Query result -> Encoding)
-> (forall s. Decoder s (Some Query))
-> (forall result. Query result -> result -> Encoding)
-> (forall result. Query result -> forall s. Decoder s result)
-> Codec
     (LocalStateQuery Block (Point Block) Query)
     DeserialiseFailure
     m
     ByteString
forall {k} (block :: k) point (query :: * -> *) (m :: * -> *).
(MonadST m, ShowQuery query) =>
NodeToClientVersion
-> (point -> Encoding)
-> (forall s. Decoder s point)
-> (forall result. query result -> Encoding)
-> (forall s. Decoder s (Some query))
-> (forall result. query result -> result -> Encoding)
-> (forall result. query result -> forall s. Decoder s result)
-> Codec
     (LocalStateQuery block point query) DeserialiseFailure m ByteString
codecLocalStateQuery
      NodeToClientVersion
forall a. Bounded a => a
maxBound
      Point Block -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode Decoder s (Point Block)
forall s. Decoder s (Point Block)
forall a s. Serialise a => Decoder s a
Serialise.decode
      Query result -> Encoding
forall result. Query result -> Encoding
encodeQuery      Decoder s (Some Query)
forall s. Decoder s (Some Query)
decodeQuery
      Query result -> result -> Encoding
forall result. Query result -> result -> Encoding
encodeResult     Query result -> Decoder s result
Query result -> forall s. Decoder s result
forall result. Query result -> forall s. Decoder s result
decodeResult
  where
    encodeQuery :: Query result -> CBOR.Encoding
    encodeQuery :: forall result. Query result -> Encoding
encodeQuery Query result
GetTheLedgerState = () -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode ()

    decodeQuery :: forall s . CBOR.Decoder s (Some Query)
    decodeQuery :: forall s. Decoder s (Some Query)
decodeQuery = do
      () <- Decoder s ()
forall s. Decoder s ()
forall a s. Serialise a => Decoder s a
Serialise.decode
      return $ Some GetTheLedgerState

    encodeResult :: Query result -> result -> CBOR.Encoding
    encodeResult :: forall result. Query result -> result -> Encoding
encodeResult Query result
GetTheLedgerState = result -> Encoding
forall a. Serialise a => a -> Encoding
Serialise.encode

    decodeResult :: Query result -> forall s. CBOR.Decoder s result
    decodeResult :: forall result. Query result -> forall s. Decoder s result
decodeResult Query result
GetTheLedgerState = Decoder s result
forall s. Decoder s result
forall a s. Serialise a => Decoder s a
Serialise.decode

-- | Check the codec round trip property.
--
prop_codec
  :: AnyMessageAndAgencyWithResult Block (Point Block) Query MockLedgerState
  -> Bool
prop_codec :: AnyMessageAndAgencyWithResult
  Block (Point Block) Query MockLedgerState
-> Bool
prop_codec (AnyMessageAndAgencyWithResult AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
msg) =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  (ST s)
  ByteString
-> AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codecM Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  m
  ByteString
codec AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
msg)

-- | Check for data chunk boundary problems in the codec using 2 chunks.
--
prop_codec_splits2
  :: AnyMessageAndAgencyWithResult Block (Point Block) Query MockLedgerState
  -> Bool
prop_codec_splits2 :: AnyMessageAndAgencyWithResult
  Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_splits2 (AnyMessageAndAgencyWithResult AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
msg) =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST ((ByteString -> [[ByteString]])
-> Codec
     (LocalStateQuery Block (Point Block) Query)
     DeserialiseFailure
     (ST s)
     ByteString
-> AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits2 Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  m
  ByteString
codec AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
msg)

-- | Check for data chunk boundary problems in the codec using 3 chunks.
--
prop_codec_splits3
  :: AnyMessageAndAgencyWithResult Block (Point Block) Query MockLedgerState
  -> Bool
prop_codec_splits3 :: AnyMessageAndAgencyWithResult
  Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_splits3 (AnyMessageAndAgencyWithResult AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
msg) =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST ((ByteString -> [[ByteString]])
-> Codec
     (LocalStateQuery Block (Point Block) Query)
     DeserialiseFailure
     (ST s)
     ByteString
-> AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
-> ST s Bool
forall ps failure (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps)) =>
(bytes -> [[bytes]])
-> Codec ps failure m bytes -> AnyMessageAndAgency ps -> m Bool
prop_codec_splitsM ByteString -> [[ByteString]]
splits3 Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  m
  ByteString
codec AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
msg)

prop_codec_cbor
  :: AnyMessageAndAgencyWithResult Block (Point Block) Query MockLedgerState
  -> Bool
prop_codec_cbor :: AnyMessageAndAgencyWithResult
  Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_cbor (AnyMessageAndAgencyWithResult AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
msg) =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  (ST s)
  ByteString
-> AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
-> ST s Bool
forall ps (m :: * -> *).
(Monad m, Eq (AnyMessage ps)) =>
Codec ps DeserialiseFailure m ByteString
-> AnyMessageAndAgency ps -> m Bool
prop_codec_cborM Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  m
  ByteString
codec AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
msg)

-- | Check that the encoder produces a valid CBOR.
--
prop_codec_valid_cbor
  :: AnyMessageAndAgencyWithResult Block (Point Block) Query MockLedgerState
  -> Property
prop_codec_valid_cbor :: AnyMessageAndAgencyWithResult
  Block (Point Block) Query MockLedgerState
-> Property
prop_codec_valid_cbor (AnyMessageAndAgencyWithResult AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
msg) = Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  IO
  ByteString
-> AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
-> Property
forall ps.
Codec ps DeserialiseFailure IO ByteString
-> AnyMessageAndAgency ps -> Property
prop_codec_valid_cbor_encoding Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  IO
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  m
  ByteString
codec AnyMessageAndAgency (LocalStateQuery Block (Point Block) Query)
msg