module Hydra.Network.AuthenticateSpec where

import Cardano.Crypto.Util (SignableRepresentation)
import Control.Concurrent.Class.MonadSTM (MonadSTM (readTVarIO), modifyTVar', newTVarIO)
import Control.Monad.IOSim (runSimOrThrow)
import Data.ByteString (pack)
import Hydra.Ledger.Simple (SimpleTx)
import Hydra.Logging (Envelope (message), nullTracer, traceInTVar)
import Hydra.Network (Network (..), NetworkCallback (..))
import Hydra.Network.Authenticate (AuthLog, Authenticated (..), Signed (Signed), mkAuthLog, withAuthentication)
import Hydra.Network.HeartbeatSpec (noop)
import Hydra.Network.Message (Message (ReqTx))
import Hydra.NetworkSpec (prop_canRoundtripCBOREncoding)
import Hydra.Prelude
import Hydra.Tx.Crypto (sign)
import Test.Aeson.GenericSpecs (roundtripAndGoldenSpecs)
import Test.Hydra.Prelude
import Test.Hydra.Tx.Fixture (alice, aliceSk, bob, bobSk, carol, carolSk)
import Test.QuickCheck (listOf)
import Test.QuickCheck.Gen (generate)

spec :: Spec
spec :: Spec
spec = Spec -> Spec
forall a. SpecWith a -> SpecWith a
parallel (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
  let captureOutgoing :: TVar m [a] -> p -> (Network m a -> b) -> b
captureOutgoing TVar m [a]
msgqueue p
_cb Network m a -> b
action =
        Network m a -> b
action (Network m a -> b) -> Network m a -> b
forall a b. (a -> b) -> a -> b
$ Network{$sel:broadcast:Network :: a -> m ()
broadcast = \a
msg -> STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar m [a] -> ([a] -> [a]) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar' TVar m [a]
msgqueue (a
msg :)}

      captureIncoming :: TVar m [a] -> NetworkCallback a m
captureIncoming TVar m [a]
receivedMessages =
        NetworkCallback
          { $sel:deliver:NetworkCallback :: a -> m ()
deliver = \a
msg ->
              STM m () -> m ()
forall a. HasCallStack => STM m a -> m a
forall (m :: * -> *) a.
(MonadSTM m, HasCallStack) =>
STM m a -> m a
atomically (STM m () -> m ()) -> STM m () -> m ()
forall a b. (a -> b) -> a -> b
$ TVar m [a] -> ([a] -> [a]) -> STM m ()
forall a. TVar m a -> (a -> a) -> STM m ()
forall (m :: * -> *) a.
MonadSTM m =>
TVar m a -> (a -> a) -> STM m ()
modifyTVar' TVar m [a]
receivedMessages (a
msg :)
          }

  Message SimpleTx
msg <- IO (Message SimpleTx) -> SpecM () (Message SimpleTx)
forall r a. IO r -> SpecM a r
runIO (IO (Message SimpleTx) -> SpecM () (Message SimpleTx))
-> IO (Message SimpleTx) -> SpecM () (Message SimpleTx)
forall a b. (a -> b) -> a -> b
$ forall a. Gen a -> IO a
generate @(Message SimpleTx) Gen (Message SimpleTx)
forall a. Arbitrary a => Gen a
arbitrary
  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"pass the authenticated messages around" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let receivedMsgs :: [Authenticated (Message SimpleTx)]
receivedMsgs = (forall s. IOSim s [Authenticated (Message SimpleTx)])
-> [Authenticated (Message SimpleTx)]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Authenticated (Message SimpleTx)])
 -> [Authenticated (Message SimpleTx)])
-> (forall s. IOSim s [Authenticated (Message SimpleTx)])
-> [Authenticated (Message SimpleTx)]
forall a b. (a -> b) -> a -> b
$ do
          TVar s [Authenticated (Message SimpleTx)]
receivedMessages <- [Authenticated (Message SimpleTx)]
-> IOSim s (TVar (IOSim s) [Authenticated (Message SimpleTx)])
forall a. a -> IOSim s (TVar (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []

          forall inbound outbound (m :: * -> *) a.
(SignableRepresentation inbound, ToJSON inbound,
 SignableRepresentation outbound) =>
Tracer m AuthLog
-> SigningKey HydraKey
-> [Party]
-> NetworkComponent m (Signed inbound) (Signed outbound) a
-> NetworkComponent m (Authenticated inbound) outbound a
withAuthentication
            @(Message SimpleTx)
            @(Message SimpleTx)
            Tracer (IOSim s) AuthLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
            SigningKey HydraKey
aliceSk
            [Party
bob]
            ( \NetworkCallback{Signed (Message SimpleTx) -> IOSim s ()
$sel:deliver:NetworkCallback :: forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver :: Signed (Message SimpleTx) -> IOSim s ()
deliver} Network (IOSim s) (Signed (Message SimpleTx)) -> IOSim s ()
_ -> do
                Signed (Message SimpleTx) -> IOSim s ()
deliver (Message SimpleTx
-> Signature (Message SimpleTx)
-> Party
-> Signed (Message SimpleTx)
forall msg. msg -> Signature msg -> Party -> Signed msg
Signed Message SimpleTx
msg (SigningKey HydraKey
-> Message SimpleTx -> Signature (Message SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
bobSk Message SimpleTx
msg) Party
bob)
            )
            (TVar (IOSim s) [Authenticated (Message SimpleTx)]
-> NetworkCallback (Authenticated (Message SimpleTx)) (IOSim s)
forall {m :: * -> *} {a}.
MonadSTM m =>
TVar m [a] -> NetworkCallback a m
captureIncoming TVar (IOSim s) [Authenticated (Message SimpleTx)]
TVar s [Authenticated (Message SimpleTx)]
receivedMessages)
            ((Network (IOSim s) (Message SimpleTx) -> IOSim s ())
 -> IOSim s ())
-> (Network (IOSim s) (Message SimpleTx) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network (IOSim s) (Message SimpleTx)
_ ->
              DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

          TVar (IOSim s) [Authenticated (Message SimpleTx)]
-> IOSim s [Authenticated (Message SimpleTx)]
forall a. TVar (IOSim s) a -> IOSim s a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar (IOSim s) [Authenticated (Message SimpleTx)]
TVar s [Authenticated (Message SimpleTx)]
receivedMessages

    [Authenticated (Message SimpleTx)]
receivedMsgs [Authenticated (Message SimpleTx)]
-> [Authenticated (Message SimpleTx)] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [Message SimpleTx -> Party -> Authenticated (Message SimpleTx)
forall msg. msg -> Party -> Authenticated msg
Authenticated Message SimpleTx
msg Party
bob]

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"drop message coming from unknown party" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    Message SimpleTx
unexpectedMessage <- SimpleTx -> Message SimpleTx
forall tx. tx -> Message tx
ReqTx (SimpleTx -> Message SimpleTx)
-> IO SimpleTx -> IO (Message SimpleTx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SimpleTx -> IO SimpleTx
forall a. Gen a -> IO a
generate Gen SimpleTx
forall a. Arbitrary a => Gen a
arbitrary
    let receivedMsgs :: [Authenticated (Message SimpleTx)]
receivedMsgs = (forall s. IOSim s [Authenticated (Message SimpleTx)])
-> [Authenticated (Message SimpleTx)]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Authenticated (Message SimpleTx)])
 -> [Authenticated (Message SimpleTx)])
-> (forall s. IOSim s [Authenticated (Message SimpleTx)])
-> [Authenticated (Message SimpleTx)]
forall a b. (a -> b) -> a -> b
$ do
          TVar s [Authenticated (Message SimpleTx)]
receivedMessages <- [Authenticated (Message SimpleTx)]
-> IOSim s (TVar (IOSim s) [Authenticated (Message SimpleTx)])
forall a. a -> IOSim s (TVar (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []

          forall inbound outbound (m :: * -> *) a.
(SignableRepresentation inbound, ToJSON inbound,
 SignableRepresentation outbound) =>
Tracer m AuthLog
-> SigningKey HydraKey
-> [Party]
-> NetworkComponent m (Signed inbound) (Signed outbound) a
-> NetworkComponent m (Authenticated inbound) outbound a
withAuthentication
            @(Message SimpleTx)
            @(Message SimpleTx)
            Tracer (IOSim s) AuthLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
            SigningKey HydraKey
aliceSk
            [Party
bob]
            ( \NetworkCallback{Signed (Message SimpleTx) -> IOSim s ()
$sel:deliver:NetworkCallback :: forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver :: Signed (Message SimpleTx) -> IOSim s ()
deliver} Network (IOSim s) (Signed (Message SimpleTx)) -> IOSim s ()
_ -> do
                Signed (Message SimpleTx) -> IOSim s ()
deliver (Message SimpleTx
-> Signature (Message SimpleTx)
-> Party
-> Signed (Message SimpleTx)
forall msg. msg -> Signature msg -> Party -> Signed msg
Signed Message SimpleTx
msg (SigningKey HydraKey
-> Message SimpleTx -> Signature (Message SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
bobSk Message SimpleTx
msg) Party
bob)
                Signed (Message SimpleTx) -> IOSim s ()
deliver (Message SimpleTx
-> Signature (Message SimpleTx)
-> Party
-> Signed (Message SimpleTx)
forall msg. msg -> Signature msg -> Party -> Signed msg
Signed Message SimpleTx
unexpectedMessage (SigningKey HydraKey
-> Message SimpleTx -> Signature (Message SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
aliceSk Message SimpleTx
unexpectedMessage) Party
alice)
            )
            (TVar (IOSim s) [Authenticated (Message SimpleTx)]
-> NetworkCallback (Authenticated (Message SimpleTx)) (IOSim s)
forall {m :: * -> *} {a}.
MonadSTM m =>
TVar m [a] -> NetworkCallback a m
captureIncoming TVar (IOSim s) [Authenticated (Message SimpleTx)]
TVar s [Authenticated (Message SimpleTx)]
receivedMessages)
            ((Network (IOSim s) (Message SimpleTx) -> IOSim s ())
 -> IOSim s ())
-> (Network (IOSim s) (Message SimpleTx) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network (IOSim s) (Message SimpleTx)
_ ->
              DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

          TVar (IOSim s) [Authenticated (Message SimpleTx)]
-> IOSim s [Authenticated (Message SimpleTx)]
forall a. TVar (IOSim s) a -> IOSim s a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar (IOSim s) [Authenticated (Message SimpleTx)]
TVar s [Authenticated (Message SimpleTx)]
receivedMessages

    [Authenticated (Message SimpleTx)]
receivedMsgs [Authenticated (Message SimpleTx)]
-> [Authenticated (Message SimpleTx)] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [Message SimpleTx -> Party -> Authenticated (Message SimpleTx)
forall msg. msg -> Party -> Authenticated msg
Authenticated Message SimpleTx
msg Party
bob]

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"drop message coming from party with wrong signature" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let receivedMsgs :: [Authenticated (Message SimpleTx)]
receivedMsgs = (forall s. IOSim s [Authenticated (Message SimpleTx)])
-> [Authenticated (Message SimpleTx)]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Authenticated (Message SimpleTx)])
 -> [Authenticated (Message SimpleTx)])
-> (forall s. IOSim s [Authenticated (Message SimpleTx)])
-> [Authenticated (Message SimpleTx)]
forall a b. (a -> b) -> a -> b
$ do
          TVar s [Authenticated (Message SimpleTx)]
receivedMessages <- [Authenticated (Message SimpleTx)]
-> IOSim s (TVar (IOSim s) [Authenticated (Message SimpleTx)])
forall a. a -> IOSim s (TVar (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []

          forall inbound outbound (m :: * -> *) a.
(SignableRepresentation inbound, ToJSON inbound,
 SignableRepresentation outbound) =>
Tracer m AuthLog
-> SigningKey HydraKey
-> [Party]
-> NetworkComponent m (Signed inbound) (Signed outbound) a
-> NetworkComponent m (Authenticated inbound) outbound a
withAuthentication
            @(Message SimpleTx)
            @(Message SimpleTx)
            Tracer (IOSim s) AuthLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
            SigningKey HydraKey
aliceSk
            [Party
bob, Party
carol]
            ( \NetworkCallback{Signed (Message SimpleTx) -> IOSim s ()
$sel:deliver:NetworkCallback :: forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver :: Signed (Message SimpleTx) -> IOSim s ()
deliver} Network (IOSim s) (Signed (Message SimpleTx)) -> IOSim s ()
_ -> do
                Signed (Message SimpleTx) -> IOSim s ()
deliver (Message SimpleTx
-> Signature (Message SimpleTx)
-> Party
-> Signed (Message SimpleTx)
forall msg. msg -> Signature msg -> Party -> Signed msg
Signed Message SimpleTx
msg (SigningKey HydraKey
-> Message SimpleTx -> Signature (Message SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
carolSk Message SimpleTx
msg) Party
bob)
            )
            (TVar (IOSim s) [Authenticated (Message SimpleTx)]
-> NetworkCallback (Authenticated (Message SimpleTx)) (IOSim s)
forall {m :: * -> *} {a}.
MonadSTM m =>
TVar m [a] -> NetworkCallback a m
captureIncoming TVar (IOSim s) [Authenticated (Message SimpleTx)]
TVar s [Authenticated (Message SimpleTx)]
receivedMessages)
            ((Network (IOSim s) (Message SimpleTx) -> IOSim s ())
 -> IOSim s ())
-> (Network (IOSim s) (Message SimpleTx) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network (IOSim s) (Message SimpleTx)
_ ->
              DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

          TVar (IOSim s) [Authenticated (Message SimpleTx)]
-> IOSim s [Authenticated (Message SimpleTx)]
forall a. TVar (IOSim s) a -> IOSim s a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar (IOSim s) [Authenticated (Message SimpleTx)]
TVar s [Authenticated (Message SimpleTx)]
receivedMessages

    [Authenticated (Message SimpleTx)]
receivedMsgs [Authenticated (Message SimpleTx)]
-> [Authenticated (Message SimpleTx)] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` []

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"authenticate the message to broadcast" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let someMessage :: Message SimpleTx
someMessage = Message SimpleTx
msg
        sentMsgs :: [Signed (Message SimpleTx)]
sentMsgs = (forall s. IOSim s [Signed (Message SimpleTx)])
-> [Signed (Message SimpleTx)]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Signed (Message SimpleTx)])
 -> [Signed (Message SimpleTx)])
-> (forall s. IOSim s [Signed (Message SimpleTx)])
-> [Signed (Message SimpleTx)]
forall a b. (a -> b) -> a -> b
$ do
          TVar s [Signed (Message SimpleTx)]
sentMessages <- [Signed (Message SimpleTx)]
-> IOSim s (TVar (IOSim s) [Signed (Message SimpleTx)])
forall a. a -> IOSim s (TVar (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []

          forall inbound outbound (m :: * -> *) a.
(SignableRepresentation inbound, ToJSON inbound,
 SignableRepresentation outbound) =>
Tracer m AuthLog
-> SigningKey HydraKey
-> [Party]
-> NetworkComponent m (Signed inbound) (Signed outbound) a
-> NetworkComponent m (Authenticated inbound) outbound a
withAuthentication
            @(Message SimpleTx)
            @(Message SimpleTx)
            Tracer (IOSim s) AuthLog
forall (m :: * -> *) a. Applicative m => Tracer m a
nullTracer
            SigningKey HydraKey
bobSk
            []
            (TVar (IOSim s) [Signed (Message SimpleTx)]
-> NetworkComponent
     (IOSim s)
     (Signed (Message SimpleTx))
     (Signed (Message SimpleTx))
     ()
forall {m :: * -> *} {a} {p} {b}.
MonadSTM m =>
TVar m [a] -> p -> (Network m a -> b) -> b
captureOutgoing TVar (IOSim s) [Signed (Message SimpleTx)]
TVar s [Signed (Message SimpleTx)]
sentMessages)
            NetworkCallback (Authenticated (Message SimpleTx)) (IOSim s)
forall (m :: * -> *) b. Monad m => NetworkCallback b m
noop
            ((Network (IOSim s) (Message SimpleTx) -> IOSim s ())
 -> IOSim s ())
-> (Network (IOSim s) (Message SimpleTx) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network{Message SimpleTx -> IOSim s ()
$sel:broadcast:Network :: forall (m :: * -> *) msg. Network m msg -> msg -> m ()
broadcast :: Message SimpleTx -> IOSim s ()
broadcast} -> do
              DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
0.6
              Message SimpleTx -> IOSim s ()
broadcast Message SimpleTx
someMessage
              DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

          TVar (IOSim s) [Signed (Message SimpleTx)]
-> IOSim s [Signed (Message SimpleTx)]
forall a. TVar (IOSim s) a -> IOSim s a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar (IOSim s) [Signed (Message SimpleTx)]
TVar s [Signed (Message SimpleTx)]
sentMessages

    [Signed (Message SimpleTx)]
sentMsgs [Signed (Message SimpleTx)]
-> [Signed (Message SimpleTx)] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => a -> a -> Expectation
`shouldBe` [Message SimpleTx
-> Signature (Message SimpleTx)
-> Party
-> Signed (Message SimpleTx)
forall msg. msg -> Signature msg -> Party -> Signed msg
Signed Message SimpleTx
msg (SigningKey HydraKey
-> Message SimpleTx -> Signature (Message SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
bobSk Message SimpleTx
msg) Party
bob]

  String -> Expectation -> SpecWith (Arg Expectation)
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"logs dropped messages" (Expectation -> SpecWith (Arg Expectation))
-> Expectation -> SpecWith (Arg Expectation)
forall a b. (a -> b) -> a -> b
$ do
    let signature :: Signature (Message SimpleTx)
signature = SigningKey HydraKey
-> Message SimpleTx -> Signature (Message SimpleTx)
forall a.
SignableRepresentation a =>
SigningKey HydraKey -> a -> Signature a
sign SigningKey HydraKey
carolSk Message SimpleTx
msg
    let signedMsg :: Signed (Message SimpleTx)
signedMsg = Message SimpleTx
-> Signature (Message SimpleTx)
-> Party
-> Signed (Message SimpleTx)
forall msg. msg -> Signature msg -> Party -> Signed msg
Signed Message SimpleTx
msg Signature (Message SimpleTx)
signature Party
bob
    let traced :: [Envelope AuthLog]
traced = (forall s. IOSim s [Envelope AuthLog]) -> [Envelope AuthLog]
forall a. (forall s. IOSim s a) -> a
runSimOrThrow ((forall s. IOSim s [Envelope AuthLog]) -> [Envelope AuthLog])
-> (forall s. IOSim s [Envelope AuthLog]) -> [Envelope AuthLog]
forall a b. (a -> b) -> a -> b
$ do
          TVar s [Envelope AuthLog]
traces <- [Envelope AuthLog] -> IOSim s (TVar (IOSim s) [Envelope AuthLog])
forall a. a -> IOSim s (TVar (IOSim s) a)
forall (m :: * -> *) a. MonadSTM m => a -> m (TVar m a)
newTVarIO []

          let tracer :: Tracer (IOSim s) AuthLog
tracer = TVar (IOSim s) [Envelope AuthLog]
-> Text -> Tracer (IOSim s) AuthLog
forall (m :: * -> *) msg.
(MonadFork m, MonadTime m, MonadSTM m) =>
TVar m [Envelope msg] -> Text -> Tracer m msg
traceInTVar TVar (IOSim s) [Envelope AuthLog]
TVar s [Envelope AuthLog]
traces Text
"AuthenticateSpec"
          forall inbound outbound (m :: * -> *) a.
(SignableRepresentation inbound, ToJSON inbound,
 SignableRepresentation outbound) =>
Tracer m AuthLog
-> SigningKey HydraKey
-> [Party]
-> NetworkComponent m (Signed inbound) (Signed outbound) a
-> NetworkComponent m (Authenticated inbound) outbound a
withAuthentication
            @(Message SimpleTx)
            @(Message SimpleTx)
            Tracer (IOSim s) AuthLog
tracer
            SigningKey HydraKey
aliceSk
            [Party
bob, Party
carol]
            (\NetworkCallback{Signed (Message SimpleTx) -> IOSim s ()
$sel:deliver:NetworkCallback :: forall msg (m :: * -> *). NetworkCallback msg m -> msg -> m ()
deliver :: Signed (Message SimpleTx) -> IOSim s ()
deliver} Network (IOSim s) (Signed (Message SimpleTx)) -> IOSim s ()
_ -> Signed (Message SimpleTx) -> IOSim s ()
deliver Signed (Message SimpleTx)
signedMsg)
            NetworkCallback (Authenticated (Message SimpleTx)) (IOSim s)
forall (m :: * -> *) b. Monad m => NetworkCallback b m
noop
            ((Network (IOSim s) (Message SimpleTx) -> IOSim s ())
 -> IOSim s ())
-> (Network (IOSim s) (Message SimpleTx) -> IOSim s ())
-> IOSim s ()
forall a b. (a -> b) -> a -> b
$ \Network (IOSim s) (Message SimpleTx)
_ ->
              DiffTime -> IOSim s ()
forall (m :: * -> *). MonadDelay m => DiffTime -> m ()
threadDelay DiffTime
1

          TVar (IOSim s) [Envelope AuthLog] -> IOSim s [Envelope AuthLog]
forall a. TVar (IOSim s) a -> IOSim s a
forall (m :: * -> *) a. MonadSTM m => TVar m a -> m a
readTVarIO TVar (IOSim s) [Envelope AuthLog]
TVar s [Envelope AuthLog]
traces

    (Envelope AuthLog -> AuthLog
forall a. Envelope a -> a
message (Envelope AuthLog -> AuthLog) -> [Envelope AuthLog] -> [AuthLog]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Envelope AuthLog]
traced) [AuthLog] -> [AuthLog] -> Expectation
forall a. (HasCallStack, Show a, Eq a) => [a] -> [a] -> Expectation
`shouldContain` [Message SimpleTx
-> Signature (Message SimpleTx) -> Party -> AuthLog
forall msg signature.
(ToJSON msg, Show signature) =>
msg -> signature -> Party -> AuthLog
mkAuthLog Message SimpleTx
msg Signature (Message SimpleTx)
signature Party
bob]

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Serialization" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> (Signed Msg -> Property) -> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"can roundtrip CBOR encoding/decoding of Signed Hydra Message" ((Signed Msg -> Property) -> Spec)
-> (Signed Msg -> Property) -> Spec
forall a b. (a -> b) -> a -> b
$
      forall a. (ToCBOR a, FromCBOR a, Eq a, Show a) => a -> Property
prop_canRoundtripCBOREncoding @(Signed Msg)

    Proxy AuthLog -> Spec
forall a.
(Arbitrary a, ToJSON a, FromJSON a, Typeable a) =>
Proxy a -> Spec
roundtripAndGoldenSpecs (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @AuthLog)

newtype Msg = Msg ByteString
  deriving newtype (Msg -> Msg -> Bool
(Msg -> Msg -> Bool) -> (Msg -> Msg -> Bool) -> Eq Msg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Msg -> Msg -> Bool
== :: Msg -> Msg -> Bool
$c/= :: Msg -> Msg -> Bool
/= :: Msg -> Msg -> Bool
Eq, Int -> Msg -> ShowS
[Msg] -> ShowS
Msg -> String
(Int -> Msg -> ShowS)
-> (Msg -> String) -> ([Msg] -> ShowS) -> Show Msg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Msg -> ShowS
showsPrec :: Int -> Msg -> ShowS
$cshow :: Msg -> String
show :: Msg -> String
$cshowList :: [Msg] -> ShowS
showList :: [Msg] -> ShowS
Show, Typeable Msg
Typeable Msg =>
(Msg -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy Msg -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Msg] -> Size)
-> ToCBOR Msg
Msg -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Msg] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy Msg -> Size
forall a.
Typeable a =>
(a -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy a -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size) -> Proxy [a] -> Size)
-> ToCBOR a
$ctoCBOR :: Msg -> Encoding
toCBOR :: Msg -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Msg -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy Msg -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Msg] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [Msg] -> Size
ToCBOR, Typeable Msg
Typeable Msg =>
(forall s. Decoder s Msg) -> (Proxy Msg -> Text) -> FromCBOR Msg
Proxy Msg -> Text
forall s. Decoder s Msg
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s Msg
fromCBOR :: forall s. Decoder s Msg
$clabel :: Proxy Msg -> Text
label :: Proxy Msg -> Text
FromCBOR, Msg -> ByteString
(Msg -> ByteString) -> SignableRepresentation Msg
forall a. (a -> ByteString) -> SignableRepresentation a
$cgetSignableRepresentation :: Msg -> ByteString
getSignableRepresentation :: Msg -> ByteString
SignableRepresentation)

instance Arbitrary Msg where
  arbitrary :: Gen Msg
arbitrary = ByteString -> Msg
Msg (ByteString -> Msg) -> ([Word8] -> ByteString) -> [Word8] -> Msg
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
pack ([Word8] -> Msg) -> Gen [Word8] -> Gen Msg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word8 -> Gen [Word8]
forall a. Gen a -> Gen [a]
listOf Gen Word8
forall a. Arbitrary a => Gen a
arbitrary