-- | Types and functions revolving around a Hydra 'Party'. That is, a
-- participant in a Hydra Head, which signs transactions or snapshots in the
-- Hydra protocol.
module Hydra.Tx.Party where

import Hydra.Prelude

import Data.Aeson (FromJSONKeyFunction (FromJSONKeyTextParser), ToJSONKey (..))
import Data.Aeson.Types (FromJSONKey (..), toJSONKeyText)
import Hydra.Cardano.Api (
  AsType (AsVerificationKey),
  SerialiseAsRawBytes (..),
  SigningKey,
  VerificationKey,
  deserialiseFromRawBytesHex,
  getVerificationKey,
  serialiseToRawBytesHexText,
  verificationKeyHash,
 )
import Hydra.Data.Party qualified as OnChain
import Hydra.Tx.Crypto (AsType (AsHydraKey), HydraKey)

-- | Identifies a party in a Hydra head by it's 'VerificationKey'.
newtype Party = Party {Party -> VerificationKey HydraKey
vkey :: VerificationKey HydraKey}
  deriving stock (Party -> Party -> Bool
(Party -> Party -> Bool) -> (Party -> Party -> Bool) -> Eq Party
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Party -> Party -> Bool
== :: Party -> Party -> Bool
$c/= :: Party -> Party -> Bool
/= :: Party -> Party -> Bool
Eq, Int -> Party -> ShowS
[Party] -> ShowS
Party -> String
(Int -> Party -> ShowS)
-> (Party -> String) -> ([Party] -> ShowS) -> Show Party
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Party -> ShowS
showsPrec :: Int -> Party -> ShowS
$cshow :: Party -> String
show :: Party -> String
$cshowList :: [Party] -> ShowS
showList :: [Party] -> ShowS
Show, (forall x. Party -> Rep Party x)
-> (forall x. Rep Party x -> Party) -> Generic Party
forall x. Rep Party x -> Party
forall x. Party -> Rep Party x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Party -> Rep Party x
from :: forall x. Party -> Rep Party x
$cto :: forall x. Rep Party x -> Party
to :: forall x. Rep Party x -> Party
Generic)
  deriving anyclass ([Party] -> Value
[Party] -> Encoding
Party -> Bool
Party -> Value
Party -> Encoding
(Party -> Value)
-> (Party -> Encoding)
-> ([Party] -> Value)
-> ([Party] -> Encoding)
-> (Party -> Bool)
-> ToJSON Party
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: Party -> Value
toJSON :: Party -> Value
$ctoEncoding :: Party -> Encoding
toEncoding :: Party -> Encoding
$ctoJSONList :: [Party] -> Value
toJSONList :: [Party] -> Value
$ctoEncodingList :: [Party] -> Encoding
toEncodingList :: [Party] -> Encoding
$comitField :: Party -> Bool
omitField :: Party -> Bool
ToJSON, Maybe Party
Value -> Parser [Party]
Value -> Parser Party
(Value -> Parser Party)
-> (Value -> Parser [Party]) -> Maybe Party -> FromJSON Party
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser Party
parseJSON :: Value -> Parser Party
$cparseJSONList :: Value -> Parser [Party]
parseJSONList :: Value -> Parser [Party]
$comittedField :: Maybe Party
omittedField :: Maybe Party
FromJSON)
  deriving newtype (Gen Party
Gen Party -> (Party -> [Party]) -> Arbitrary Party
Party -> [Party]
forall a. Gen a -> (a -> [a]) -> Arbitrary a
$carbitrary :: Gen Party
arbitrary :: Gen Party
$cshrink :: Party -> [Party]
shrink :: Party -> [Party]
Arbitrary)

instance ToJSONKey Party where
  toJSONKey :: ToJSONKeyFunction Party
toJSONKey = (Party -> Text) -> ToJSONKeyFunction Party
forall a. (a -> Text) -> ToJSONKeyFunction a
toJSONKeyText (VerificationKey HydraKey -> Text
forall a. SerialiseAsRawBytes a => a -> Text
serialiseToRawBytesHexText (VerificationKey HydraKey -> Text)
-> (Party -> VerificationKey HydraKey) -> Party -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Party -> VerificationKey HydraKey
vkey)

instance FromJSONKey Party where
  fromJSONKey :: FromJSONKeyFunction Party
fromJSONKey = (Text -> Parser Party) -> FromJSONKeyFunction Party
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
FromJSONKeyTextParser Text -> Parser Party
forall (m :: * -> *). MonadFail m => Text -> m Party
partyFromHexText
   where
    partyFromHexText :: MonadFail m => Text -> m Party
    partyFromHexText :: forall (m :: * -> *). MonadFail m => Text -> m Party
partyFromHexText Text
t =
      case AsType (VerificationKey HydraKey)
-> ByteString -> Either RawBytesHexError (VerificationKey HydraKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either RawBytesHexError a
deserialiseFromRawBytesHex (AsType HydraKey -> AsType (VerificationKey HydraKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType HydraKey
AsHydraKey) (Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
t) of
        Left RawBytesHexError
err -> String -> m Party
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Party) -> String -> m Party
forall a b. (a -> b) -> a -> b
$ String
"failed to decode Party: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> RawBytesHexError -> String
forall b a. (Show a, IsString b) => a -> b
show RawBytesHexError
err
        Right VerificationKey HydraKey
vkey -> Party -> m Party
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Party -> m Party) -> Party -> m Party
forall a b. (a -> b) -> a -> b
$ Party{VerificationKey HydraKey
$sel:vkey:Party :: VerificationKey HydraKey
vkey :: VerificationKey HydraKey
vkey}

-- REVIEW: Do we really want to define Ord or also use unordered-containers
-- based on Hashable?
instance Ord Party where
  Party{$sel:vkey:Party :: Party -> VerificationKey HydraKey
vkey = VerificationKey HydraKey
a} <= :: Party -> Party -> Bool
<= Party{$sel:vkey:Party :: Party -> VerificationKey HydraKey
vkey = VerificationKey HydraKey
b} =
    VerificationKey HydraKey -> Hash HydraKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey HydraKey
a Hash HydraKey -> Hash HydraKey -> Bool
forall a. Ord a => a -> a -> Bool
<= VerificationKey HydraKey -> Hash HydraKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash VerificationKey HydraKey
b

instance FromCBOR Party where
  fromCBOR :: forall s. Decoder s Party
fromCBOR = VerificationKey HydraKey -> Party
Party (VerificationKey HydraKey -> Party)
-> Decoder s (VerificationKey HydraKey) -> Decoder s Party
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (VerificationKey HydraKey)
forall s. Decoder s (VerificationKey HydraKey)
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance ToCBOR Party where
  toCBOR :: Party -> Encoding
toCBOR Party{VerificationKey HydraKey
$sel:vkey:Party :: Party -> VerificationKey HydraKey
vkey :: VerificationKey HydraKey
vkey} = VerificationKey HydraKey -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR VerificationKey HydraKey
vkey

-- | Get the 'Party' given some Hydra 'SigningKey'.
deriveParty :: SigningKey HydraKey -> Party
deriveParty :: SigningKey HydraKey -> Party
deriveParty = VerificationKey HydraKey -> Party
Party (VerificationKey HydraKey -> Party)
-> (SigningKey HydraKey -> VerificationKey HydraKey)
-> SigningKey HydraKey
-> Party
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SigningKey HydraKey -> VerificationKey HydraKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey

-- | Convert "high-level" 'Party' to the "low-level" representation as used
-- on-chain. See 'Hydra.Data.Party.Party' for an explanation why this is a
-- distinct type.
partyToChain :: Party -> OnChain.Party
partyToChain :: Party -> Party
partyToChain Party{VerificationKey HydraKey
$sel:vkey:Party :: Party -> VerificationKey HydraKey
vkey :: VerificationKey HydraKey
vkey} =
  ByteString -> Party
OnChain.partyFromVerificationKeyBytes (ByteString -> Party) -> ByteString -> Party
forall a b. (a -> b) -> a -> b
$ VerificationKey HydraKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes VerificationKey HydraKey
vkey

-- | Retrieve the "high-level" 'Party from the "low-level" on-chain
-- representation. This can fail because of the lower type-safety used on-chain
-- and a non-guaranteed verification key length. See 'Hydra.Data.Party.Party'
-- for an explanation why this is a distinct type.
partyFromChain :: MonadFail m => OnChain.Party -> m Party
partyFromChain :: forall (m :: * -> *). MonadFail m => Party -> m Party
partyFromChain =
  (SerialiseAsRawBytesError -> m Party)
-> (VerificationKey HydraKey -> m Party)
-> Either SerialiseAsRawBytesError (VerificationKey HydraKey)
-> m Party
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (\SerialiseAsRawBytesError
e -> String -> m Party
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m Party) -> String -> m Party
forall a b. (a -> b) -> a -> b
$ String
"partyFromChain failed: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> SerialiseAsRawBytesError -> String
forall b a. (Show a, IsString b) => a -> b
show SerialiseAsRawBytesError
e) (Party -> m Party
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Party -> m Party)
-> (VerificationKey HydraKey -> Party)
-> VerificationKey HydraKey
-> m Party
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VerificationKey HydraKey -> Party
Party)
    (Either SerialiseAsRawBytesError (VerificationKey HydraKey)
 -> m Party)
-> (Party
    -> Either SerialiseAsRawBytesError (VerificationKey HydraKey))
-> Party
-> m Party
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType (VerificationKey HydraKey)
-> ByteString
-> Either SerialiseAsRawBytesError (VerificationKey HydraKey)
forall a.
SerialiseAsRawBytes a =>
AsType a -> ByteString -> Either SerialiseAsRawBytesError a
deserialiseFromRawBytes (AsType HydraKey -> AsType (VerificationKey HydraKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType HydraKey
AsHydraKey)
    (ByteString
 -> Either SerialiseAsRawBytesError (VerificationKey HydraKey))
-> (Party -> ByteString)
-> Party
-> Either SerialiseAsRawBytesError (VerificationKey HydraKey)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Party -> ByteString
OnChain.partyToVerficationKeyBytes

-- | Type class to retrieve the 'Party' from some type.
class HasParty a where
  getParty :: a -> Party