{-# LANGUAGE UndecidableInstances #-}

module Hydra.Network.Message where

import Hydra.Prelude

import Cardano.Binary (serialize')
import Cardano.Crypto.Util (SignableRepresentation, getSignableRepresentation)
import Hydra.Crypto (Signature)
import Hydra.Ledger (IsTx (TxIdType), UTxOType)
import Hydra.Network (NodeId)
import Hydra.Snapshot (Snapshot, SnapshotNumber)

data Connectivity
  = Connected {Connectivity -> NodeId
nodeId :: NodeId}
  | Disconnected {nodeId :: NodeId}
  deriving stock ((forall x. Connectivity -> Rep Connectivity x)
-> (forall x. Rep Connectivity x -> Connectivity)
-> Generic Connectivity
forall x. Rep Connectivity x -> Connectivity
forall x. Connectivity -> Rep Connectivity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Connectivity -> Rep Connectivity x
from :: forall x. Connectivity -> Rep Connectivity x
$cto :: forall x. Rep Connectivity x -> Connectivity
to :: forall x. Rep Connectivity x -> Connectivity
Generic, Connectivity -> Connectivity -> Bool
(Connectivity -> Connectivity -> Bool)
-> (Connectivity -> Connectivity -> Bool) -> Eq Connectivity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Connectivity -> Connectivity -> Bool
== :: Connectivity -> Connectivity -> Bool
$c/= :: Connectivity -> Connectivity -> Bool
/= :: Connectivity -> Connectivity -> Bool
Eq, Int -> Connectivity -> ShowS
[Connectivity] -> ShowS
Connectivity -> String
(Int -> Connectivity -> ShowS)
-> (Connectivity -> String)
-> ([Connectivity] -> ShowS)
-> Show Connectivity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Connectivity -> ShowS
showsPrec :: Int -> Connectivity -> ShowS
$cshow :: Connectivity -> String
show :: Connectivity -> String
$cshowList :: [Connectivity] -> ShowS
showList :: [Connectivity] -> ShowS
Show)
  deriving anyclass ([Connectivity] -> Value
[Connectivity] -> Encoding
Connectivity -> Bool
Connectivity -> Value
Connectivity -> Encoding
(Connectivity -> Value)
-> (Connectivity -> Encoding)
-> ([Connectivity] -> Value)
-> ([Connectivity] -> Encoding)
-> (Connectivity -> Bool)
-> ToJSON Connectivity
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Connectivity -> Value
toJSON :: Connectivity -> Value
$ctoEncoding :: Connectivity -> Encoding
toEncoding :: Connectivity -> Encoding
$ctoJSONList :: [Connectivity] -> Value
toJSONList :: [Connectivity] -> Value
$ctoEncodingList :: [Connectivity] -> Encoding
toEncodingList :: [Connectivity] -> Encoding
$comitField :: Connectivity -> Bool
omitField :: Connectivity -> Bool
ToJSON, Maybe Connectivity
Value -> Parser [Connectivity]
Value -> Parser Connectivity
(Value -> Parser Connectivity)
-> (Value -> Parser [Connectivity])
-> Maybe Connectivity
-> FromJSON Connectivity
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Connectivity
parseJSON :: Value -> Parser Connectivity
$cparseJSONList :: Value -> Parser [Connectivity]
parseJSONList :: Value -> Parser [Connectivity]
$comittedField :: Maybe Connectivity
omittedField :: Maybe Connectivity
FromJSON)

data Message tx
  = ReqTx {forall tx. Message tx -> tx
transaction :: tx}
  | ReqSn {forall tx. Message tx -> SnapshotNumber
snapshotNumber :: SnapshotNumber, forall tx. Message tx -> [TxIdType tx]
transactionIds :: [TxIdType tx]}
  | -- NOTE: We remove the party from the ackSn but, it would make sense to put it
    -- back as the signed snapshot is tied to the party and we should not
    -- consider which party sent this message to validate this snapshot signature.
    -- but currently we do not validate the snapshot signature itself, which is
    -- a problem.
    -- When we fix that, when we check the snapshot signature, that would be a
    -- good idea to introduce the party in AckSn again or, maybe better, only
    -- the verification key of the party.
    AckSn {forall tx. Message tx -> Signature (Snapshot tx)
signed :: Signature (Snapshot tx), snapshotNumber :: SnapshotNumber}
  deriving stock ((forall x. Message tx -> Rep (Message tx) x)
-> (forall x. Rep (Message tx) x -> Message tx)
-> Generic (Message tx)
forall x. Rep (Message tx) x -> Message tx
forall x. Message tx -> Rep (Message tx) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall tx x. Rep (Message tx) x -> Message tx
forall tx x. Message tx -> Rep (Message tx) x
$cfrom :: forall tx x. Message tx -> Rep (Message tx) x
from :: forall x. Message tx -> Rep (Message tx) x
$cto :: forall tx x. Rep (Message tx) x -> Message tx
to :: forall x. Rep (Message tx) x -> Message tx
Generic)

deriving stock instance IsTx tx => Eq (Message tx)
deriving stock instance IsTx tx => Show (Message tx)
deriving anyclass instance IsTx tx => ToJSON (Message tx)
deriving anyclass instance IsTx tx => FromJSON (Message tx)

instance IsTx tx => Arbitrary (Message tx) where
  arbitrary :: Gen (Message tx)
arbitrary = Gen (Message tx)
forall a.
(Generic a, GA UnsizedOpts (Rep a),
 UniformWeight (Weights_ (Rep a))) =>
Gen a
genericArbitrary

instance (ToCBOR tx, ToCBOR (UTxOType tx), ToCBOR (TxIdType tx)) => ToCBOR (Message tx) where
  toCBOR :: Message tx -> Encoding
toCBOR = \case
    ReqTx tx
tx -> Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"ReqTx" :: Text) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> tx -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR tx
tx
    ReqSn SnapshotNumber
sn [TxIdType tx]
txs -> Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"ReqSn" :: Text) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapshotNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapshotNumber
sn Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> [TxIdType tx] -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR [TxIdType tx]
txs
    AckSn Signature (Snapshot tx)
sig SnapshotNumber
sn -> Text -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Text
"AckSn" :: Text) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Signature (Snapshot tx) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR Signature (Snapshot tx)
sig Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> SnapshotNumber -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR SnapshotNumber
sn

instance (FromCBOR tx, FromCBOR (UTxOType tx), FromCBOR (TxIdType tx)) => FromCBOR (Message tx) where
  fromCBOR :: forall s. Decoder s (Message tx)
fromCBOR =
    Decoder s Text
forall s. Decoder s Text
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s Text
-> (Text -> Decoder s (Message tx)) -> Decoder s (Message tx)
forall a b. Decoder s a -> (a -> Decoder s b) -> Decoder s b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      (Text
"ReqTx" :: Text) -> tx -> Message tx
forall tx. tx -> Message tx
ReqTx (tx -> Message tx) -> Decoder s tx -> Decoder s (Message tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s tx
forall s. Decoder s tx
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Text
"ReqSn" -> SnapshotNumber -> [TxIdType tx] -> Message tx
forall tx. SnapshotNumber -> [TxIdType tx] -> Message tx
ReqSn (SnapshotNumber -> [TxIdType tx] -> Message tx)
-> Decoder s SnapshotNumber
-> Decoder s ([TxIdType tx] -> Message tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s SnapshotNumber
forall s. Decoder s SnapshotNumber
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s ([TxIdType tx] -> Message tx)
-> Decoder s [TxIdType tx] -> Decoder s (Message tx)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s [TxIdType tx]
forall s. Decoder s [TxIdType tx]
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Text
"AckSn" -> Signature (Snapshot tx) -> SnapshotNumber -> Message tx
forall tx. Signature (Snapshot tx) -> SnapshotNumber -> Message tx
AckSn (Signature (Snapshot tx) -> SnapshotNumber -> Message tx)
-> Decoder s (Signature (Snapshot tx))
-> Decoder s (SnapshotNumber -> Message tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (Signature (Snapshot tx))
forall s. Decoder s (Signature (Snapshot tx))
forall a s. FromCBOR a => Decoder s a
fromCBOR Decoder s (SnapshotNumber -> Message tx)
-> Decoder s SnapshotNumber -> Decoder s (Message tx)
forall a b. Decoder s (a -> b) -> Decoder s a -> Decoder s b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Decoder s SnapshotNumber
forall s. Decoder s SnapshotNumber
forall a s. FromCBOR a => Decoder s a
fromCBOR
      Text
msg -> String -> Decoder s (Message tx)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Decoder s (Message tx))
-> String -> Decoder s (Message tx)
forall a b. (a -> b) -> a -> b
$ Text -> String
forall b a. (Show a, IsString b) => a -> b
show Text
msg String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" is not a proper CBOR-encoded Message"

instance IsTx tx => SignableRepresentation (Message tx) where
  getSignableRepresentation :: Message tx -> ByteString
getSignableRepresentation = Message tx -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize'