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

{-# OPTIONS_GHC -Wno-orphans #-}
module Ouroboros.Network.Protocol.LocalStateQuery.Test
  ( tests
  , codec
  , AnyMessageWithResult (..)
  , Query (..)
  , MockLedgerState (..)
  ) 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, MonadMask)
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.Stateful.Codec qualified as Stateful
import Network.TypedProtocol.Stateful.Proofs qualified as Stateful

import Ouroboros.Network.Channel
import Ouroboros.Network.Driver.Stateful qualified as Stateful
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

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]
-> (AnyMessageWithResult Block (Point Block) Query MockLedgerState
    -> Bool)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"codec"               AnyMessageWithResult Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_LocalStateQuery
        , [Char]
-> (AnyMessageWithResult Block (Point Block) Query MockLedgerState
    -> Bool)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"codec 2-splits"      AnyMessageWithResult 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
-> (AnyMessageWithResult Block (Point Block) Query MockLedgerState
    -> Bool)
-> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
30
                                             AnyMessageWithResult Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_splits3
        , [Char]
-> (AnyMessageWithResult Block (Point Block) Query MockLedgerState
    -> Bool)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"codec cbor"          AnyMessageWithResult Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_cbor
        , [Char]
-> (AnyMessageWithResult Block (Point Block) Query MockLedgerState
    -> Property)
-> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"codec valid cbor"    AnyMessageWithResult 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
           (State 'StIdle
-> Peer
     (LocalStateQuery Any (Point Block) Query)
     'AsClient
     'StIdle
     State
     (IOSim s)
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Peer
     (LocalStateQuery Any (Point Block) Query)
     (FlipAgency 'AsClient)
     'StIdle
     State
     (IOSim s)
     ()
-> IOSim
     s
     ([(Target (Point Block), Either AcquireFailure MockLedgerState)],
      (), TerminalStates (LocalStateQuery Any (Point Block) Query))
forall ps (pr :: PeerRole) (st :: ps) (f :: ps -> *) (m :: * -> *)
       a b.
(MonadSTM m, SingI pr) =>
f st
-> Peer ps pr st f m a
-> Peer ps (FlipAgency pr) st f m b
-> m (a, b, TerminalStates ps)
Stateful.connect State 'StIdle
forall {block} {point} {query :: * -> *}. State 'StIdle
StateIdle
             (LocalStateQueryClient
  Any
  (Point Block)
  Query
  (IOSim s)
  [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Peer
     (LocalStateQuery Any (Point Block) Query)
     'AsClient
     'StIdle
     State
     (IOSim s)
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryClient block point query m a
-> Client (LocalStateQuery block point query) 'StIdle State m a
localStateQueryClientPeer (LocalStateQueryClient
   Any
   (Point Block)
   Query
   (IOSim s)
   [(Target (Point Block), Either AcquireFailure MockLedgerState)]
 -> Peer
      (LocalStateQuery Any (Point Block) Query)
      'AsClient
      'StIdle
      State
      (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
     State
     (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) ()
-> Server
     (LocalStateQuery Any (Point Block) Query)
     'StIdle
     State
     (IOSim s)
     ()
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryServer block point query m a
-> Server (LocalStateQuery block point query) 'StIdle State m a
localStateQueryServerPeer (LocalStateQueryServer Any (Point Block) Query (IOSim s) ()
 -> Server
      (LocalStateQuery Any (Point Block) Query)
      'StIdle
      State
      (IOSim s)
      ())
-> LocalStateQueryServer Any (Point Block) Query (IOSim s) ()
-> Server
     (LocalStateQuery Any (Point Block) Query)
     'StIdle
     State
     (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, (), Stateful.TerminalStates SingLocalStateQuery st
StateToken st
SingDone SingLocalStateQuery 'StDone
StateToken st
SingDone) ->
        [(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
                , MonadMask  m
                , MonadST m
                )
             => m (Channel m ByteString, Channel m ByteString)
             -> SetupData
             -> m Property
prop_channel :: forall (m :: * -> *).
(MonadAsync m, MonadCatch m, MonadMask 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 = do
    r <-
      m (Channel m ByteString, Channel m ByteString)
-> Tracer
     m
     (Role,
      TraceSendRecv (LocalStateQuery Block (Point Block) Query) State)
-> Codec
     (LocalStateQuery Block (Point Block) Query)
     DeserialiseFailure
     State
     m
     ByteString
-> State 'StIdle
-> Peer
     (LocalStateQuery Block (Point Block) Query)
     'AsClient
     'StIdle
     State
     m
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Peer
     (LocalStateQuery Block (Point Block) Query)
     (FlipAgency 'AsClient)
     'StIdle
     State
     m
     ()
-> m ([(Target (Point Block),
        Either AcquireFailure MockLedgerState)],
      ())
forall ps (pr :: PeerRole) (st :: ps) failure bytes (f :: ps -> *)
       (m :: * -> *) a b.
(MonadAsync m, MonadMask m, Show failure,
 forall (st' :: ps) tok. (tok ~ StateToken st') => Show tok,
 ShowProxy ps) =>
m (Channel m bytes, Channel m bytes)
-> Tracer m (Role, TraceSendRecv ps f)
-> Codec ps failure f m bytes
-> f st
-> Peer ps pr st f m a
-> Peer ps (FlipAgency pr) st f m b
-> m (a, b)
Stateful.runConnectedPeers
        m (Channel m ByteString, Channel m ByteString)
createChannels
        Tracer
  m
  (Role,
   TraceSendRecv (LocalStateQuery Block (Point Block) Query) State)
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
        Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  m
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  m
  ByteString
codec
        State 'StIdle
forall {block} {point} {query :: * -> *}. State 'StIdle
StateIdle
        (LocalStateQueryClient
  Block
  (Point Block)
  Query
  m
  [(Target (Point Block), Either AcquireFailure MockLedgerState)]
-> Peer
     (LocalStateQuery Block (Point Block) Query)
     'AsClient
     'StIdle
     State
     m
     [(Target (Point Block), Either AcquireFailure MockLedgerState)]
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryClient block point query m a
-> Client (LocalStateQuery block point query) 'StIdle State m a
localStateQueryClientPeer (LocalStateQueryClient
   Block
   (Point Block)
   Query
   m
   [(Target (Point Block), Either AcquireFailure MockLedgerState)]
 -> Peer
      (LocalStateQuery Block (Point Block) Query)
      'AsClient
      'StIdle
      State
      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
     State
     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 ()
-> Server
     (LocalStateQuery Block (Point Block) Query) 'StIdle State m ()
forall block point (query :: * -> *) (m :: * -> *) a.
Monad m =>
LocalStateQueryServer block point query m a
-> Server (LocalStateQuery block point query) 'StIdle State m a
localStateQueryServerPeer (LocalStateQueryServer Block (Point Block) Query m ()
 -> Server
      (LocalStateQuery Block (Point Block) Query) 'StIdle State m ())
-> LocalStateQueryServer Block (Point Block) Query m ()
-> Server
     (LocalStateQuery Block (Point Block) Query) 'StIdle State 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)
    return $ case r of
      ([(Target (Point Block), Either AcquireFailure MockLedgerState)]
result, ()) -> [(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

-- | 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, MonadMask 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, MonadMask 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, MonadMask 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 AnyMessageWithResult block point query result = AnyMessageWithResult {
    forall block point (query :: * -> *) result.
AnyMessageWithResult block point query result
-> AnyMessage (LocalStateQuery block point query) State
getAnyMessageWithResult :: Stateful.AnyMessage (LocalStateQuery block point query) State
  }
  deriving Int -> AnyMessageWithResult block point query result -> ShowS
[AnyMessageWithResult block point query result] -> ShowS
AnyMessageWithResult block point query result -> [Char]
(Int -> AnyMessageWithResult block point query result -> ShowS)
-> (AnyMessageWithResult block point query result -> [Char])
-> ([AnyMessageWithResult block point query result] -> ShowS)
-> Show (AnyMessageWithResult 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 -> AnyMessageWithResult block point query result -> ShowS
forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
[AnyMessageWithResult block point query result] -> ShowS
forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
AnyMessageWithResult block point query result -> [Char]
$cshowsPrec :: forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
Int -> AnyMessageWithResult block point query result -> ShowS
showsPrec :: Int -> AnyMessageWithResult block point query result -> ShowS
$cshow :: forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
AnyMessageWithResult block point query result -> [Char]
show :: AnyMessageWithResult block point query result -> [Char]
$cshowList :: forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
[AnyMessageWithResult block point query result] -> ShowS
showList :: [AnyMessageWithResult block point query result] -> ShowS
Show

instance ( Arbitrary point
         , Arbitrary (query result)
         , Arbitrary result
         )
      => Arbitrary (AnyMessageWithResult block point query result) where
      arbitrary :: Gen (AnyMessageWithResult block point query result)
arbitrary = [Gen (AnyMessageWithResult block point query result)]
-> Gen (AnyMessageWithResult block point query result)
forall a. [Gen a] -> Gen a
oneof
        [ AnyMessage (LocalStateQuery block point query) State
-> AnyMessageWithResult block point query result
forall block point (query :: * -> *) result.
AnyMessage (LocalStateQuery block point query) State
-> AnyMessageWithResult block point query result
AnyMessageWithResult (AnyMessage (LocalStateQuery block point query) State
 -> AnyMessageWithResult block point query result)
-> (AnyMessageV7 block point query result
    -> AnyMessage (LocalStateQuery block point query) State)
-> AnyMessageV7 block point query result
-> AnyMessageWithResult block point query result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AnyMessageV7 block point query result
-> AnyMessage (LocalStateQuery block point query) State
forall block point (query :: * -> *) result.
AnyMessageV7 block point query result
-> AnyMessage (LocalStateQuery block point query) State
getAnyMessageV7 (AnyMessageV7 block point query result
 -> AnyMessageWithResult block point query result)
-> Gen (AnyMessageV7 block point query result)
-> Gen (AnyMessageWithResult block point query result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Gen (AnyMessageV7 block point query result)
forall a. Arbitrary a => Gen a
arbitrary :: Gen (AnyMessageV7 block point query result))

        , AnyMessage (LocalStateQuery block point query) State
-> AnyMessageWithResult block point query result
forall block point (query :: * -> *) result.
AnyMessage (LocalStateQuery block point query) State
-> AnyMessageWithResult block point query result
AnyMessageWithResult (AnyMessage (LocalStateQuery block point query) State
 -> AnyMessageWithResult block point query result)
-> (Target point
    -> AnyMessage (LocalStateQuery block point query) State)
-> Target point
-> AnyMessageWithResult block point query result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State 'StIdle
-> Message (LocalStateQuery block point query) 'StIdle 'StAcquiring
-> AnyMessage (LocalStateQuery block point query) State
forall ps (f :: ps -> *) (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
f st -> Message ps st st' -> AnyMessage ps f
Stateful.AnyMessage State 'StIdle
forall {block} {point} {query :: * -> *}. State 'StIdle
StateIdle (Message (LocalStateQuery block point query) 'StIdle 'StAcquiring
 -> AnyMessage (LocalStateQuery block point query) State)
-> (Target point
    -> Message
         (LocalStateQuery block point query) 'StIdle 'StAcquiring)
-> Target point
-> AnyMessage (LocalStateQuery block point query) State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target point
-> Message (LocalStateQuery block point query) 'StIdle 'StAcquiring
forall point block (query :: * -> *).
Target point
-> Message (LocalStateQuery block point query) 'StIdle 'StAcquiring
MsgAcquire (Target point -> AnyMessageWithResult block point query result)
-> Gen (Target point)
-> Gen (AnyMessageWithResult block point query result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Target point)
forall a. Arbitrary a => Gen a
arbitrary

        , AnyMessage (LocalStateQuery block point query) State
-> AnyMessageWithResult block point query result
forall block point (query :: * -> *) result.
AnyMessage (LocalStateQuery block point query) State
-> AnyMessageWithResult block point query result
AnyMessageWithResult (AnyMessage (LocalStateQuery block point query) State
 -> AnyMessageWithResult block point query result)
-> (Target point
    -> AnyMessage (LocalStateQuery block point query) State)
-> Target point
-> AnyMessageWithResult block point query result
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State 'StAcquired
-> Message
     (LocalStateQuery block point query) 'StAcquired 'StAcquiring
-> AnyMessage (LocalStateQuery block point query) State
forall ps (f :: ps -> *) (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
f st -> Message ps st st' -> AnyMessage ps f
Stateful.AnyMessage State 'StAcquired
forall {block} {point} {query :: * -> *}. State 'StAcquired
StateAcquired (Message
   (LocalStateQuery block point query) 'StAcquired 'StAcquiring
 -> AnyMessage (LocalStateQuery block point query) State)
-> (Target point
    -> Message
         (LocalStateQuery block point query) 'StAcquired 'StAcquiring)
-> Target point
-> AnyMessage (LocalStateQuery block point query) State
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Target point
-> Message
     (LocalStateQuery block point query) 'StAcquired 'StAcquiring
forall point block (query :: * -> *).
Target point
-> Message
     (LocalStateQuery block point query) 'StAcquired 'StAcquiring
MsgReAcquire (Target point -> AnyMessageWithResult block point query result)
-> Gen (Target point)
-> Gen (AnyMessageWithResult block point query result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Target point)
forall a. Arbitrary a => Gen a
arbitrary
        ]

-- Newtype wrapper which generates only valid data for 'NodeToClientV7' protocol.
--
newtype AnyMessageV7 block point query result = AnyMessageV7 {
    forall block point (query :: * -> *) result.
AnyMessageV7 block point query result
-> AnyMessage (LocalStateQuery block point query) State
getAnyMessageV7
      :: Stateful.AnyMessage (LocalStateQuery block point query) State
  }
  deriving Int -> AnyMessageV7 block point query result -> ShowS
[AnyMessageV7 block point query result] -> ShowS
AnyMessageV7 block point query result -> [Char]
(Int -> AnyMessageV7 block point query result -> ShowS)
-> (AnyMessageV7 block point query result -> [Char])
-> ([AnyMessageV7 block point query result] -> ShowS)
-> Show (AnyMessageV7 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 -> AnyMessageV7 block point query result -> ShowS
forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
[AnyMessageV7 block point query result] -> ShowS
forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
AnyMessageV7 block point query result -> [Char]
$cshowsPrec :: forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
Int -> AnyMessageV7 block point query result -> ShowS
showsPrec :: Int -> AnyMessageV7 block point query result -> ShowS
$cshow :: forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
AnyMessageV7 block point query result -> [Char]
show :: AnyMessageV7 block point query result -> [Char]
$cshowList :: forall block point (query :: * -> *) result.
(ShowQuery query, Show point) =>
[AnyMessageV7 block point query result] -> ShowS
showList :: [AnyMessageV7 block point query result] -> ShowS
Show

instance ( Arbitrary point
         , Arbitrary (query result)
         , Arbitrary result
         )
      => Arbitrary (AnyMessageV7 block point query result) where
  arbitrary :: Gen (AnyMessageV7 block point query result)
arbitrary = AnyMessage (LocalStateQuery block point query) State
-> AnyMessageV7 block point query result
forall block point (query :: * -> *) result.
AnyMessage (LocalStateQuery block point query) State
-> AnyMessageV7 block point query result
AnyMessageV7 (AnyMessage (LocalStateQuery block point query) State
 -> AnyMessageV7 block point query result)
-> Gen (AnyMessage (LocalStateQuery block point query) State)
-> Gen (AnyMessageV7 block point query result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen (AnyMessage (LocalStateQuery block point query) State)]
-> Gen (AnyMessage (LocalStateQuery block point query) State)
forall a. [Gen a] -> Gen a
oneof
    [ State 'StIdle
-> Message (LocalStateQuery block point query) 'StIdle 'StAcquiring
-> AnyMessage (LocalStateQuery block point query) State
forall ps (f :: ps -> *) (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
f st -> Message ps st st' -> AnyMessage ps f
Stateful.AnyMessage State 'StIdle
forall {block} {point} {query :: * -> *}. State 'StIdle
StateIdle
        (Message (LocalStateQuery block point query) 'StIdle 'StAcquiring
 -> AnyMessage (LocalStateQuery block point query) State)
-> Gen
     (Message (LocalStateQuery block point query) 'StIdle 'StAcquiring)
-> Gen (AnyMessage (LocalStateQuery block point query) State)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Target point
-> Message (LocalStateQuery block point query) 'StIdle 'StAcquiring
forall point block (query :: * -> *).
Target point
-> Message (LocalStateQuery block point 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)

    , AnyMessage (LocalStateQuery block point query) State
-> Gen (AnyMessage (LocalStateQuery block point query) State)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State 'StAcquiring
-> Message
     (LocalStateQuery block point query) 'StAcquiring 'StAcquired
-> AnyMessage (LocalStateQuery block point query) State
forall ps (f :: ps -> *) (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
f st -> Message ps st st' -> AnyMessage ps f
Stateful.AnyMessage State 'StAcquiring
forall {block} {point} {query :: * -> *}. State 'StAcquiring
StateAcquiring Message
  (LocalStateQuery block point query) 'StAcquiring 'StAcquired
forall block point (query :: * -> *).
Message
  (LocalStateQuery block point query) 'StAcquiring 'StAcquired
MsgAcquired)

    , State 'StAcquiring
-> Message (LocalStateQuery block point query) 'StAcquiring 'StIdle
-> AnyMessage (LocalStateQuery block point query) State
forall ps (f :: ps -> *) (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
f st -> Message ps st st' -> AnyMessage ps f
Stateful.AnyMessage State 'StAcquiring
forall {block} {point} {query :: * -> *}. State 'StAcquiring
StateAcquiring
        (Message (LocalStateQuery block point query) 'StAcquiring 'StIdle
 -> AnyMessage (LocalStateQuery block point query) State)
-> Gen
     (Message (LocalStateQuery block point query) 'StAcquiring 'StIdle)
-> Gen (AnyMessage (LocalStateQuery block point query) State)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AcquireFailure
-> Message (LocalStateQuery block point query) 'StAcquiring 'StIdle
forall block point (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)

    , (\query result
query ->
        State 'StAcquired
-> Message
     (LocalStateQuery block point query)
     'StAcquired
     ('StQuerying result)
-> AnyMessage (LocalStateQuery block point query) State
forall ps (f :: ps -> *) (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
f st -> Message ps st st' -> AnyMessage ps f
Stateful.AnyMessage State 'StAcquired
forall {block} {point} {query :: * -> *}. State 'StAcquired
StateAcquired
                            (query result
-> Message
     (LocalStateQuery block point query)
     'StAcquired
     ('StQuerying result)
forall (query :: * -> *) result block point.
query result
-> Message
     (LocalStateQuery block point query)
     'StAcquired
     ('StQuerying result)
MsgQuery query result
query))
        (query result
 -> AnyMessage (LocalStateQuery block point query) State)
-> Gen (query result)
-> Gen (AnyMessage (LocalStateQuery block point query) State)
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) ->
        State ('StQuerying result)
-> Message
     (LocalStateQuery block point query)
     ('StQuerying result)
     'StAcquired
-> AnyMessage (LocalStateQuery block point query) State
forall ps (f :: ps -> *) (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
f st -> Message ps st st' -> AnyMessage ps f
Stateful.AnyMessage (query result -> State ('StQuerying result)
forall (query :: * -> *) result block point.
query result -> State ('StQuerying result)
StateQuerying query result
query)
                            (result
-> Message
     (LocalStateQuery block point query)
     ('StQuerying result)
     'StAcquired
forall result block point (query :: * -> *).
result
-> Message
     (LocalStateQuery block point query)
     ('StQuerying result)
     'StAcquired
MsgResult result
result))
        (QueryWithResult query result
 -> AnyMessage (LocalStateQuery block point query) State)
-> Gen (QueryWithResult query result)
-> Gen (AnyMessage (LocalStateQuery block point query) State)
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))

    , AnyMessage (LocalStateQuery block point query) State
-> Gen (AnyMessage (LocalStateQuery block point query) State)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State 'StAcquired
-> Message (LocalStateQuery block point query) 'StAcquired 'StIdle
-> AnyMessage (LocalStateQuery block point query) State
forall ps (f :: ps -> *) (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
f st -> Message ps st st' -> AnyMessage ps f
Stateful.AnyMessage State 'StAcquired
forall {block} {point} {query :: * -> *}. State 'StAcquired
StateAcquired Message (LocalStateQuery block point query) 'StAcquired 'StIdle
forall block point (query :: * -> *).
Message (LocalStateQuery block point query) 'StAcquired 'StIdle
MsgRelease)

    , State 'StAcquired
-> Message
     (LocalStateQuery block point query) 'StAcquired 'StAcquiring
-> AnyMessage (LocalStateQuery block point query) State
forall ps (f :: ps -> *) (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
f st -> Message ps st st' -> AnyMessage ps f
Stateful.AnyMessage State 'StAcquired
forall {block} {point} {query :: * -> *}. State 'StAcquired
StateAcquired
      (Message
   (LocalStateQuery block point query) 'StAcquired 'StAcquiring
 -> AnyMessage (LocalStateQuery block point query) State)
-> Gen
     (Message
        (LocalStateQuery block point query) 'StAcquired 'StAcquiring)
-> Gen (AnyMessage (LocalStateQuery block point query) State)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Target point
-> Message
     (LocalStateQuery block point query) 'StAcquired 'StAcquiring
forall point block (query :: * -> *).
Target point
-> Message
     (LocalStateQuery block point 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)

    , AnyMessage (LocalStateQuery block point query) State
-> Gen (AnyMessage (LocalStateQuery block point query) State)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (State 'StIdle
-> Message (LocalStateQuery block point query) 'StIdle 'StDone
-> AnyMessage (LocalStateQuery block point query) State
forall ps (f :: ps -> *) (st :: ps) (st' :: ps).
(StateTokenI st, ActiveState st) =>
f st -> Message ps st st' -> AnyMessage ps f
Stateful.AnyMessage State 'StIdle
forall {block} {point} {query :: * -> *}. State 'StIdle
StateIdle Message (LocalStateQuery block point query) 'StIdle 'StDone
forall block point (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 (Stateful.AnyMessage (LocalStateQuery Block (Point Block) Query) State) where

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

  (==) (Stateful.AnyMessage State st
_ Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto Block (Point Block) Query st st'
MsgAcquired)
       (Stateful.AnyMessage State st
_ Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto Block (Point Block) Query st st'
MsgAcquired) = Bool
True

  (==) (Stateful.AnyMessage State st
_ (MsgFailure AcquireFailure
failure))
       (Stateful.AnyMessage State st
_ (MsgFailure AcquireFailure
failure')) = AcquireFailure
failure AcquireFailure -> AcquireFailure -> Bool
forall a. Eq a => a -> a -> Bool
== AcquireFailure
failure'

  (==) (Stateful.AnyMessage State st
_ (MsgQuery Query result
query))
       (Stateful.AnyMessage State st
_ (MsgQuery Query result
query')) =
         case (Query result
query, Query result
query') of
           (Query result
GetTheLedgerState, Query result
GetTheLedgerState) -> Bool
True

  (==) (Stateful.AnyMessage (StateQuerying Query result
query)  (MsgResult result
result))
       (Stateful.AnyMessage (StateQuerying Query result
query') (MsgResult 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'

  (==) (Stateful.AnyMessage State st
_ Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto Block (Point Block) Query st st'
MsgRelease)
       (Stateful.AnyMessage State st
_ Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto Block (Point Block) Query st st'
MsgRelease) = Bool
True

  (==) (Stateful.AnyMessage State st
_ (MsgReAcquire Target (Point Block)
tgt))
       (Stateful.AnyMessage State st
_ (MsgReAcquire Target (Point Block)
tgt')) = Target (Point Block)
tgt Target (Point Block) -> Target (Point Block) -> Bool
forall a. Eq a => a -> a -> Bool
== Target (Point Block)
tgt'

  (==) (Stateful.AnyMessage State st
_ Message (LocalStateQuery Block (Point Block) Query) st st'
R:MessageLocalStateQueryfromto Block (Point Block) Query st st'
MsgDone)
       (Stateful.AnyMessage State st
_ 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) State
_ == AnyMessage (LocalStateQuery Block (Point Block) Query) State
_ = Bool
False


codec :: MonadST m
      => Stateful.Codec (LocalStateQuery Block (Point Block) Query)
                        DeserialiseFailure
                        State
                        m ByteString
codec :: forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  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
     State
     m
     ByteString
forall block 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
     State
     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_LocalStateQuery
  :: AnyMessageWithResult Block (Point Block) Query MockLedgerState
  -> Bool
prop_codec_LocalStateQuery :: AnyMessageWithResult Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_LocalStateQuery (AnyMessageWithResult AnyMessage (LocalStateQuery Block (Point Block) Query) State
msg) =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  (ST s)
  ByteString
-> AnyMessage (LocalStateQuery Block (Point Block) Query) State
-> ST s Bool
forall ps failure (f :: ps -> *) (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps f)) =>
Codec ps failure f m bytes -> AnyMessage ps f -> m Bool
Stateful.prop_codecM Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  m
  ByteString
codec AnyMessage (LocalStateQuery Block (Point Block) Query) State
msg)

-- | Check for data chunk boundary problems in the codec using 2 chunks.
--
prop_codec_splits2
  :: AnyMessageWithResult Block (Point Block) Query MockLedgerState
  -> Bool
prop_codec_splits2 :: AnyMessageWithResult Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_splits2 (AnyMessageWithResult AnyMessage (LocalStateQuery Block (Point Block) Query) State
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
     State
     (ST s)
     ByteString
-> AnyMessage (LocalStateQuery Block (Point Block) Query) State
-> ST s Bool
forall ps failure (f :: ps -> *) (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps f)) =>
(bytes -> [[bytes]])
-> Codec ps failure f m bytes -> AnyMessage ps f -> m Bool
Stateful.prop_codec_splitsM ByteString -> [[ByteString]]
splits2 Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  m
  ByteString
codec AnyMessage (LocalStateQuery Block (Point Block) Query) State
msg)

-- | Check for data chunk boundary problems in the codec using 3 chunks.
--
prop_codec_splits3
  :: AnyMessageWithResult Block (Point Block) Query MockLedgerState
  -> Bool
prop_codec_splits3 :: AnyMessageWithResult Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_splits3 (AnyMessageWithResult AnyMessage (LocalStateQuery Block (Point Block) Query) State
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
     State
     (ST s)
     ByteString
-> AnyMessage (LocalStateQuery Block (Point Block) Query) State
-> ST s Bool
forall ps failure (f :: ps -> *) (m :: * -> *) bytes.
(Monad m, Eq (AnyMessage ps f)) =>
(bytes -> [[bytes]])
-> Codec ps failure f m bytes -> AnyMessage ps f -> m Bool
Stateful.prop_codec_splitsM ByteString -> [[ByteString]]
splits3 Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  m
  ByteString
codec AnyMessage (LocalStateQuery Block (Point Block) Query) State
msg)

-- TODO: this test is not needed; `prop_codec_valid_cbor` and
-- `prop_codec_LocalStateQuery` subsume it.
prop_codec_cbor
  :: AnyMessageWithResult Block (Point Block) Query MockLedgerState
  -> Bool
prop_codec_cbor :: AnyMessageWithResult Block (Point Block) Query MockLedgerState
-> Bool
prop_codec_cbor (AnyMessageWithResult AnyMessage (LocalStateQuery Block (Point Block) Query) State
msg) =
  (forall s. ST s Bool) -> Bool
forall a. (forall s. ST s a) -> a
runST (Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  (ST s)
  ByteString
-> AnyMessage (LocalStateQuery Block (Point Block) Query) State
-> ST s Bool
forall ps (f :: ps -> *) (m :: * -> *).
Monad m =>
Codec ps DeserialiseFailure f m ByteString
-> AnyMessage ps f -> m Bool
prop_codec_st_cborM Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  (ST s)
  ByteString
forall (m :: * -> *).
MonadST m =>
Codec
  (LocalStateQuery Block (Point Block) Query)
  DeserialiseFailure
  State
  m
  ByteString
codec AnyMessage (LocalStateQuery Block (Point Block) Query) State
msg)

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