{-# LANGUAGE DerivingVia #-}

module Hydra.Tx.HeadId where

import Hydra.Prelude

import Data.ByteString qualified as BS
import Hydra.Cardano.Api (
  HasTypeProxy (..),
  PolicyId,
  SerialiseAsRawBytes (..),
  UsingRawBytesHex (..),
  fromPlutusCurrencySymbol,
 )
import PlutusLedgerApi.V3 (CurrencySymbol (..), toBuiltin)
import Test.QuickCheck (vectorOf)
import Test.QuickCheck.Instances.Semigroup ()
import Test.QuickCheck.Instances.Time ()

-- | Uniquely identifies a Hydra Head.
newtype HeadId = UnsafeHeadId ByteString
  deriving stock (Int -> HeadId -> ShowS
[HeadId] -> ShowS
HeadId -> String
(Int -> HeadId -> ShowS)
-> (HeadId -> String) -> ([HeadId] -> ShowS) -> Show HeadId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeadId -> ShowS
showsPrec :: Int -> HeadId -> ShowS
$cshow :: HeadId -> String
show :: HeadId -> String
$cshowList :: [HeadId] -> ShowS
showList :: [HeadId] -> ShowS
Show, HeadId -> HeadId -> Bool
(HeadId -> HeadId -> Bool)
-> (HeadId -> HeadId -> Bool) -> Eq HeadId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeadId -> HeadId -> Bool
== :: HeadId -> HeadId -> Bool
$c/= :: HeadId -> HeadId -> Bool
/= :: HeadId -> HeadId -> Bool
Eq, Eq HeadId
Eq HeadId =>
(HeadId -> HeadId -> Ordering)
-> (HeadId -> HeadId -> Bool)
-> (HeadId -> HeadId -> Bool)
-> (HeadId -> HeadId -> Bool)
-> (HeadId -> HeadId -> Bool)
-> (HeadId -> HeadId -> HeadId)
-> (HeadId -> HeadId -> HeadId)
-> Ord HeadId
HeadId -> HeadId -> Bool
HeadId -> HeadId -> Ordering
HeadId -> HeadId -> HeadId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HeadId -> HeadId -> Ordering
compare :: HeadId -> HeadId -> Ordering
$c< :: HeadId -> HeadId -> Bool
< :: HeadId -> HeadId -> Bool
$c<= :: HeadId -> HeadId -> Bool
<= :: HeadId -> HeadId -> Bool
$c> :: HeadId -> HeadId -> Bool
> :: HeadId -> HeadId -> Bool
$c>= :: HeadId -> HeadId -> Bool
>= :: HeadId -> HeadId -> Bool
$cmax :: HeadId -> HeadId -> HeadId
max :: HeadId -> HeadId -> HeadId
$cmin :: HeadId -> HeadId -> HeadId
min :: HeadId -> HeadId -> HeadId
Ord, (forall x. HeadId -> Rep HeadId x)
-> (forall x. Rep HeadId x -> HeadId) -> Generic HeadId
forall x. Rep HeadId x -> HeadId
forall x. HeadId -> Rep HeadId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeadId -> Rep HeadId x
from :: forall x. HeadId -> Rep HeadId x
$cto :: forall x. Rep HeadId x -> HeadId
to :: forall x. Rep HeadId x -> HeadId
Generic)
  deriving ([HeadId] -> Value
[HeadId] -> Encoding
HeadId -> Bool
HeadId -> Value
HeadId -> Encoding
(HeadId -> Value)
-> (HeadId -> Encoding)
-> ([HeadId] -> Value)
-> ([HeadId] -> Encoding)
-> (HeadId -> Bool)
-> ToJSON HeadId
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: HeadId -> Value
toJSON :: HeadId -> Value
$ctoEncoding :: HeadId -> Encoding
toEncoding :: HeadId -> Encoding
$ctoJSONList :: [HeadId] -> Value
toJSONList :: [HeadId] -> Value
$ctoEncodingList :: [HeadId] -> Encoding
toEncodingList :: [HeadId] -> Encoding
$comitField :: HeadId -> Bool
omitField :: HeadId -> Bool
ToJSON, Maybe HeadId
Value -> Parser [HeadId]
Value -> Parser HeadId
(Value -> Parser HeadId)
-> (Value -> Parser [HeadId]) -> Maybe HeadId -> FromJSON HeadId
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser HeadId
parseJSON :: Value -> Parser HeadId
$cparseJSONList :: Value -> Parser [HeadId]
parseJSONList :: Value -> Parser [HeadId]
$comittedField :: Maybe HeadId
omittedField :: Maybe HeadId
FromJSON) via (UsingRawBytesHex HeadId)
  deriving newtype (Typeable HeadId
Typeable HeadId =>
(forall s. Decoder s HeadId)
-> (Proxy HeadId -> Text) -> FromCBOR HeadId
Proxy HeadId -> Text
forall s. Decoder s HeadId
forall a.
Typeable a =>
(forall s. Decoder s a) -> (Proxy a -> Text) -> FromCBOR a
$cfromCBOR :: forall s. Decoder s HeadId
fromCBOR :: forall s. Decoder s HeadId
$clabel :: Proxy HeadId -> Text
label :: Proxy HeadId -> Text
FromCBOR, Typeable HeadId
Typeable HeadId =>
(HeadId -> Encoding)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy HeadId -> Size)
-> ((forall t. ToCBOR t => Proxy t -> Size)
    -> Proxy [HeadId] -> Size)
-> ToCBOR HeadId
HeadId -> Encoding
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy [HeadId] -> Size
(forall t. ToCBOR t => Proxy t -> Size) -> Proxy HeadId -> 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 :: HeadId -> Encoding
toCBOR :: HeadId -> Encoding
$cencodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy HeadId -> Size
encodedSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy HeadId -> Size
$cencodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [HeadId] -> Size
encodedListSizeExpr :: (forall t. ToCBOR t => Proxy t -> Size) -> Proxy [HeadId] -> Size
ToCBOR)

instance SerialiseAsRawBytes HeadId where
  serialiseToRawBytes :: HeadId -> ByteString
serialiseToRawBytes (UnsafeHeadId ByteString
bytes) = ByteString
bytes
  deserialiseFromRawBytes :: AsType HeadId
-> ByteString -> Either SerialiseAsRawBytesError HeadId
deserialiseFromRawBytes AsType HeadId
_ = HeadId -> Either SerialiseAsRawBytesError HeadId
forall a b. b -> Either a b
Right (HeadId -> Either SerialiseAsRawBytesError HeadId)
-> (ByteString -> HeadId)
-> ByteString
-> Either SerialiseAsRawBytesError HeadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HeadId
UnsafeHeadId

instance HasTypeProxy HeadId where
  data AsType HeadId = AsHeadId
  proxyToAsType :: Proxy HeadId -> AsType HeadId
proxyToAsType Proxy HeadId
_ = AsType HeadId
AsHeadId

instance Arbitrary HeadId where
  arbitrary :: Gen HeadId
arbitrary = ByteString -> HeadId
UnsafeHeadId (ByteString -> HeadId)
-> ([Word8] -> ByteString) -> [Word8] -> HeadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> HeadId) -> Gen [Word8] -> Gen HeadId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
16 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | Unique seed to create a 'HeadId'
--
-- XXX: This might actually be the 'HeadId' to the protocol and users? Then the
-- policy id of the cardano-specific implementation (being the result of minting
-- policy + seed) stays internal. A drawback is, that the seed is not such a
-- good "key" to find things about this head on explorers and indexers.
newtype HeadSeed = UnsafeHeadSeed ByteString
  deriving stock (Int -> HeadSeed -> ShowS
[HeadSeed] -> ShowS
HeadSeed -> String
(Int -> HeadSeed -> ShowS)
-> (HeadSeed -> String) -> ([HeadSeed] -> ShowS) -> Show HeadSeed
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HeadSeed -> ShowS
showsPrec :: Int -> HeadSeed -> ShowS
$cshow :: HeadSeed -> String
show :: HeadSeed -> String
$cshowList :: [HeadSeed] -> ShowS
showList :: [HeadSeed] -> ShowS
Show, HeadSeed -> HeadSeed -> Bool
(HeadSeed -> HeadSeed -> Bool)
-> (HeadSeed -> HeadSeed -> Bool) -> Eq HeadSeed
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HeadSeed -> HeadSeed -> Bool
== :: HeadSeed -> HeadSeed -> Bool
$c/= :: HeadSeed -> HeadSeed -> Bool
/= :: HeadSeed -> HeadSeed -> Bool
Eq, Eq HeadSeed
Eq HeadSeed =>
(HeadSeed -> HeadSeed -> Ordering)
-> (HeadSeed -> HeadSeed -> Bool)
-> (HeadSeed -> HeadSeed -> Bool)
-> (HeadSeed -> HeadSeed -> Bool)
-> (HeadSeed -> HeadSeed -> Bool)
-> (HeadSeed -> HeadSeed -> HeadSeed)
-> (HeadSeed -> HeadSeed -> HeadSeed)
-> Ord HeadSeed
HeadSeed -> HeadSeed -> Bool
HeadSeed -> HeadSeed -> Ordering
HeadSeed -> HeadSeed -> HeadSeed
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: HeadSeed -> HeadSeed -> Ordering
compare :: HeadSeed -> HeadSeed -> Ordering
$c< :: HeadSeed -> HeadSeed -> Bool
< :: HeadSeed -> HeadSeed -> Bool
$c<= :: HeadSeed -> HeadSeed -> Bool
<= :: HeadSeed -> HeadSeed -> Bool
$c> :: HeadSeed -> HeadSeed -> Bool
> :: HeadSeed -> HeadSeed -> Bool
$c>= :: HeadSeed -> HeadSeed -> Bool
>= :: HeadSeed -> HeadSeed -> Bool
$cmax :: HeadSeed -> HeadSeed -> HeadSeed
max :: HeadSeed -> HeadSeed -> HeadSeed
$cmin :: HeadSeed -> HeadSeed -> HeadSeed
min :: HeadSeed -> HeadSeed -> HeadSeed
Ord, (forall x. HeadSeed -> Rep HeadSeed x)
-> (forall x. Rep HeadSeed x -> HeadSeed) -> Generic HeadSeed
forall x. Rep HeadSeed x -> HeadSeed
forall x. HeadSeed -> Rep HeadSeed x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. HeadSeed -> Rep HeadSeed x
from :: forall x. HeadSeed -> Rep HeadSeed x
$cto :: forall x. Rep HeadSeed x -> HeadSeed
to :: forall x. Rep HeadSeed x -> HeadSeed
Generic)
  deriving ([HeadSeed] -> Value
[HeadSeed] -> Encoding
HeadSeed -> Bool
HeadSeed -> Value
HeadSeed -> Encoding
(HeadSeed -> Value)
-> (HeadSeed -> Encoding)
-> ([HeadSeed] -> Value)
-> ([HeadSeed] -> Encoding)
-> (HeadSeed -> Bool)
-> ToJSON HeadSeed
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> (a -> Bool)
-> ToJSON a
$ctoJSON :: HeadSeed -> Value
toJSON :: HeadSeed -> Value
$ctoEncoding :: HeadSeed -> Encoding
toEncoding :: HeadSeed -> Encoding
$ctoJSONList :: [HeadSeed] -> Value
toJSONList :: [HeadSeed] -> Value
$ctoEncodingList :: [HeadSeed] -> Encoding
toEncodingList :: [HeadSeed] -> Encoding
$comitField :: HeadSeed -> Bool
omitField :: HeadSeed -> Bool
ToJSON, Maybe HeadSeed
Value -> Parser [HeadSeed]
Value -> Parser HeadSeed
(Value -> Parser HeadSeed)
-> (Value -> Parser [HeadSeed])
-> Maybe HeadSeed
-> FromJSON HeadSeed
forall a.
(Value -> Parser a)
-> (Value -> Parser [a]) -> Maybe a -> FromJSON a
$cparseJSON :: Value -> Parser HeadSeed
parseJSON :: Value -> Parser HeadSeed
$cparseJSONList :: Value -> Parser [HeadSeed]
parseJSONList :: Value -> Parser [HeadSeed]
$comittedField :: Maybe HeadSeed
omittedField :: Maybe HeadSeed
FromJSON) via (UsingRawBytesHex HeadSeed)

instance SerialiseAsRawBytes HeadSeed where
  serialiseToRawBytes :: HeadSeed -> ByteString
serialiseToRawBytes (UnsafeHeadSeed ByteString
bytes) = ByteString
bytes
  deserialiseFromRawBytes :: AsType HeadSeed
-> ByteString -> Either SerialiseAsRawBytesError HeadSeed
deserialiseFromRawBytes AsType HeadSeed
_ = HeadSeed -> Either SerialiseAsRawBytesError HeadSeed
forall a b. b -> Either a b
Right (HeadSeed -> Either SerialiseAsRawBytesError HeadSeed)
-> (ByteString -> HeadSeed)
-> ByteString
-> Either SerialiseAsRawBytesError HeadSeed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> HeadSeed
UnsafeHeadSeed

instance HasTypeProxy HeadSeed where
  data AsType HeadSeed = AsHeadSeed
  proxyToAsType :: Proxy HeadSeed -> AsType HeadSeed
proxyToAsType Proxy HeadSeed
_ = AsType HeadSeed
AsHeadSeed

instance Arbitrary HeadSeed where
  arbitrary :: Gen HeadSeed
arbitrary = ByteString -> HeadSeed
UnsafeHeadSeed (ByteString -> HeadSeed)
-> ([Word8] -> ByteString) -> [Word8] -> HeadSeed
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> HeadSeed) -> Gen [Word8] -> Gen HeadSeed
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
16 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

headIdToCurrencySymbol :: HeadId -> CurrencySymbol
headIdToCurrencySymbol :: HeadId -> CurrencySymbol
headIdToCurrencySymbol (UnsafeHeadId ByteString
headId) = BuiltinByteString -> CurrencySymbol
CurrencySymbol (ByteString -> ToBuiltin ByteString
forall a. HasToBuiltin a => a -> ToBuiltin a
toBuiltin ByteString
headId)

fromCurrencySymbol :: MonadFail m => CurrencySymbol -> m HeadId
fromCurrencySymbol :: forall (m :: * -> *). MonadFail m => CurrencySymbol -> m HeadId
fromCurrencySymbol = (PolicyId -> HeadId) -> m PolicyId -> m HeadId
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PolicyId -> HeadId
mkHeadId (m PolicyId -> m HeadId)
-> (CurrencySymbol -> m PolicyId) -> CurrencySymbol -> m HeadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CurrencySymbol -> m PolicyId
forall (m :: * -> *). MonadFail m => CurrencySymbol -> m PolicyId
fromPlutusCurrencySymbol

mkHeadId :: PolicyId -> HeadId
mkHeadId :: PolicyId -> HeadId
mkHeadId = ByteString -> HeadId
UnsafeHeadId (ByteString -> HeadId)
-> (PolicyId -> ByteString) -> PolicyId -> HeadId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PolicyId -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytes