module Hydra.Data.Party where

import Hydra.Prelude hiding (init)

import Data.Aeson (Value (String), object, withObject, (.:), (.=))
import Data.ByteString qualified as BS
import Data.ByteString.Base16 qualified as Base16
import PlutusTx qualified
import PlutusTx.Builtins (BuiltinByteString, fromBuiltin, toBuiltin)
import PlutusTx.IsData
import PlutusTx.Prelude qualified as PlutusTx
import Test.QuickCheck (vector)

-- | On-chain representation of a Hydra party.
--
-- NOTE: This roughly corresponds to the 'Party' in 'hydra-node', but is
-- simplified to allow usage of this type in plutus-tx. If we would use the
-- complex type directly, which is based on 'cardano-crypto-class', we would get
-- errors like "Error: Unsupported feature: Kind: GHC.Types.Nat".
--
-- The data constructor should not be used to construct this value as it would
-- always come from off-chain code via 'partyFromVerificationKeyBytes'.
newtype Party = UnsafeParty {Party -> BuiltinByteString
vkey :: BuiltinByteString}
  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, (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 newtype (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, Party -> Party -> Bool
(Party -> Party -> Bool) -> Eq Party
forall a. (a -> a -> Bool) -> Eq a
$c== :: Party -> Party -> Bool
== :: Party -> Party -> Bool
PlutusTx.Eq)

instance Arbitrary Party where
  arbitrary :: Gen Party
arbitrary = ByteString -> Party
partyFromVerificationKeyBytes (ByteString -> Party)
-> ([Word8] -> ByteString) -> [Word8] -> Party
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> Party) -> Gen [Word8] -> Gen Party
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen [Word8]
forall a. Arbitrary a => Int -> Gen [a]
vector Int
32

instance PlutusTx.ToData Party where
  toBuiltinData :: Party -> BuiltinData
toBuiltinData (UnsafeParty BuiltinByteString
bytes) = BuiltinByteString -> BuiltinData
forall a. ToData a => a -> BuiltinData
toBuiltinData BuiltinByteString
bytes

instance PlutusTx.FromData Party where
  fromBuiltinData :: BuiltinData -> Maybe Party
fromBuiltinData = (BuiltinByteString -> Party)
-> Maybe BuiltinByteString -> Maybe Party
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap BuiltinByteString -> Party
UnsafeParty (Maybe BuiltinByteString -> Maybe Party)
-> (BuiltinData -> Maybe BuiltinByteString)
-> BuiltinData
-> Maybe Party
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> Maybe BuiltinByteString
forall a. FromData a => BuiltinData -> Maybe a
fromBuiltinData

instance PlutusTx.UnsafeFromData Party where
  unsafeFromBuiltinData :: BuiltinData -> Party
unsafeFromBuiltinData = BuiltinByteString -> Party
UnsafeParty (BuiltinByteString -> Party)
-> (BuiltinData -> BuiltinByteString) -> BuiltinData -> Party
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuiltinData -> BuiltinByteString
forall a. UnsafeFromData a => BuiltinData -> a
unsafeFromBuiltinData

instance ToJSON Party where
  toJSON :: Party -> Value
toJSON (UnsafeParty BuiltinByteString
bytes) =
    [Pair] -> Value
object [Key
"vkey" Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (ByteString -> Text
forall a b. ConvertUtf8 a b => b -> a
decodeUtf8 (ByteString -> Text) -> ByteString -> Text
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
Base16.encode (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
fromBuiltin BuiltinByteString
bytes)]

instance FromJSON Party where
  parseJSON :: Value -> Parser Party
parseJSON =
    String -> (Object -> Parser Party) -> Value -> Parser Party
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Party" ((Object -> Parser Party) -> Value -> Parser Party)
-> (Object -> Parser Party) -> Value -> Parser Party
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
      Text
hexText :: Text <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"vkey"
      case ByteString -> Either String ByteString
Base16.decode (ByteString -> Either String ByteString)
-> ByteString -> Either String ByteString
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
hexText of
        Left String
e -> String -> Parser Party
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
e
        Right ByteString
bs -> Party -> Parser Party
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure UnsafeParty{vkey :: BuiltinByteString
vkey = ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin ByteString
bs}

-- | Create an on-chain 'Party' from some verification key bytes.
partyFromVerificationKeyBytes :: ByteString -> Party
partyFromVerificationKeyBytes :: ByteString -> Party
partyFromVerificationKeyBytes =
  BuiltinByteString -> Party
UnsafeParty (BuiltinByteString -> Party)
-> (ByteString -> BuiltinByteString) -> ByteString -> Party
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> BuiltinByteString
ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin

-- | Get the verification key bytes contained from an on-chain 'Party'.
partyToVerficationKeyBytes :: Party -> ByteString
partyToVerficationKeyBytes :: Party -> ByteString
partyToVerficationKeyBytes (UnsafeParty BuiltinByteString
bytes) =
  BuiltinByteString -> FromBuiltin BuiltinByteString
forall arep. HasFromBuiltin arep => arep -> FromBuiltin arep
fromBuiltin BuiltinByteString
bytes