-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

{-# OPTIONS_GHC -Wno-deprecations #-} -- due to temporary OPEN_CHEST deprecation

{-# LANGUAGE NoPolyKinds #-}

-- | Type-safe operations with @bytes@-like data.
module Lorentz.Bytes
  ( BytesLike (..)

  -- * Packed
  , Packed (..)

  -- * Signatures
  , TSignature (..)
  , lSign

  -- * Hashes
  , Hash (..)
  , DHashAlgorithm
  , KnownHashAlgorithm (..)
  , toHashHs
  , Sha256
  , Sha512
  , Blake2b
  , Sha3
  , Keccak

  -- * Typed Chest
  , ChestT (..)
  , OpenChestT (..)
  , openChestT
  ) where

import Crypto.Random (MonadRandom)
import Fmt (Buildable(..))
import Morley.Util.Markdown
import Type.Reflection qualified as Refl

import Lorentz.Annotation
import Lorentz.Base
import Lorentz.Constraints.Scopes
import Lorentz.Doc
import Lorentz.Value
import Morley.AsRPC (HasRPCRepr(..))
import Morley.Michelson.Typed qualified as T
import Morley.Tezos.Crypto hiding (Hash)
import Morley.Tezos.Crypto.Hash qualified as Crypto

-- | Everything which is represented as bytes inside.
class (KnownValue bs, ToT bs ~ ToT ByteString) => BytesLike bs where
  toBytes :: bs -> ByteString

instance BytesLike ByteString where
  toBytes :: ByteString -> ByteString
toBytes = ByteString -> ByteString
forall a. a -> a
id

----------------------------------------------------------------------------
-- Packing
----------------------------------------------------------------------------

-- | Represents a 'ByteString' resulting from packing a value of type @a@.
--
-- This is /not/ guaranteed to keep some packed value, and @unpack@ can fail.
-- We do so because often we need to accept values of such type from user,
-- and also because there is no simple way to check validity of packed data
-- without performing full unpack.
-- So this wrapper is rather a hint for users.
newtype Packed a = Packed { forall a. Packed a -> ByteString
unPacked :: ByteString }
  deriving stock (Int -> Packed a -> ShowS
[Packed a] -> ShowS
Packed a -> String
(Int -> Packed a -> ShowS)
-> (Packed a -> String) -> ([Packed a] -> ShowS) -> Show (Packed a)
forall a. Int -> Packed a -> ShowS
forall a. [Packed a] -> ShowS
forall a. Packed a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> Packed a -> ShowS
showsPrec :: Int -> Packed a -> ShowS
$cshow :: forall a. Packed a -> String
show :: Packed a -> String
$cshowList :: forall a. [Packed a] -> ShowS
showList :: [Packed a] -> ShowS
Show, Packed a -> Packed a -> Bool
(Packed a -> Packed a -> Bool)
-> (Packed a -> Packed a -> Bool) -> Eq (Packed a)
forall a. Packed a -> Packed a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Packed a -> Packed a -> Bool
== :: Packed a -> Packed a -> Bool
$c/= :: forall a. Packed a -> Packed a -> Bool
/= :: Packed a -> Packed a -> Bool
Eq, Eq (Packed a)
Eq (Packed a)
-> (Packed a -> Packed a -> Ordering)
-> (Packed a -> Packed a -> Bool)
-> (Packed a -> Packed a -> Bool)
-> (Packed a -> Packed a -> Bool)
-> (Packed a -> Packed a -> Bool)
-> (Packed a -> Packed a -> Packed a)
-> (Packed a -> Packed a -> Packed a)
-> Ord (Packed a)
Packed a -> Packed a -> Bool
Packed a -> Packed a -> Ordering
Packed a -> Packed a -> Packed a
forall a. Eq (Packed a)
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
forall a. Packed a -> Packed a -> Bool
forall a. Packed a -> Packed a -> Ordering
forall a. Packed a -> Packed a -> Packed a
$ccompare :: forall a. Packed a -> Packed a -> Ordering
compare :: Packed a -> Packed a -> Ordering
$c< :: forall a. Packed a -> Packed a -> Bool
< :: Packed a -> Packed a -> Bool
$c<= :: forall a. Packed a -> Packed a -> Bool
<= :: Packed a -> Packed a -> Bool
$c> :: forall a. Packed a -> Packed a -> Bool
> :: Packed a -> Packed a -> Bool
$c>= :: forall a. Packed a -> Packed a -> Bool
>= :: Packed a -> Packed a -> Bool
$cmax :: forall a. Packed a -> Packed a -> Packed a
max :: Packed a -> Packed a -> Packed a
$cmin :: forall a. Packed a -> Packed a -> Packed a
min :: Packed a -> Packed a -> Packed a
Ord, (forall x. Packed a -> Rep (Packed a) x)
-> (forall x. Rep (Packed a) x -> Packed a) -> Generic (Packed a)
forall x. Rep (Packed a) x -> Packed a
forall x. Packed a -> Rep (Packed a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Packed a) x -> Packed a
forall a x. Packed a -> Rep (Packed a) x
$cfrom :: forall a x. Packed a -> Rep (Packed a) x
from :: forall x. Packed a -> Rep (Packed a) x
$cto :: forall a x. Rep (Packed a) x -> Packed a
to :: forall x. Rep (Packed a) x -> Packed a
Generic)
  deriving newtype (WellTypedToT (Packed a)
WellTypedToT (Packed a)
-> (Packed a -> Value (ToT (Packed a)))
-> (Value (ToT (Packed a)) -> Packed a)
-> IsoValue (Packed a)
Value (ToT (Packed a)) -> Packed a
Packed a -> Value (ToT (Packed a))
forall {a}. WellTypedToT (Packed a)
forall a.
WellTypedToT a
-> (a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
forall a. Value (ToT (Packed a)) -> Packed a
forall a. Packed a -> Value (ToT (Packed a))
$ctoVal :: forall a. Packed a -> Value (ToT (Packed a))
toVal :: Packed a -> Value (ToT (Packed a))
$cfromVal :: forall a. Value (ToT (Packed a)) -> Packed a
fromVal :: Value (ToT (Packed a)) -> Packed a
IsoValue, Maybe AnnOptions
FollowEntrypointFlag -> Notes (ToT (Packed a))
(FollowEntrypointFlag -> Notes (ToT (Packed a)))
-> Maybe AnnOptions -> HasAnnotation (Packed a)
forall a. Maybe AnnOptions
forall a. FollowEntrypointFlag -> Notes (ToT (Packed a))
forall a.
(FollowEntrypointFlag -> Notes (ToT a))
-> Maybe AnnOptions -> HasAnnotation a
$cgetAnnotation :: forall a. FollowEntrypointFlag -> Notes (ToT (Packed a))
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (Packed a))
$cannOptions :: forall a. Maybe AnnOptions
annOptions :: Maybe AnnOptions
HasAnnotation, ToT (Packed a) ~ ToT ByteString
KnownValue (Packed a)
KnownValue (Packed a)
-> (ToT (Packed a) ~ ToT ByteString)
-> (Packed a -> ByteString)
-> BytesLike (Packed a)
Packed a -> ByteString
forall {a}. Typeable a => ToT (Packed a) ~ ToT ByteString
forall {a}. Typeable a => KnownValue (Packed a)
forall a. Typeable a => Packed a -> ByteString
forall bs.
KnownValue bs
-> (ToT bs ~ ToT ByteString) -> (bs -> ByteString) -> BytesLike bs
$ctoBytes :: forall a. Typeable a => Packed a -> ByteString
toBytes :: Packed a -> ByteString
BytesLike)

instance Buildable (Packed a) where
  build :: Packed a -> Doc
build = Value 'TBytes -> Doc
forall a. Buildable a => a -> Doc
build (Value 'TBytes -> Doc)
-> (Packed a -> Value 'TBytes) -> Packed a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Packed a -> Value (ToT (Packed a))
Packed a -> Value 'TBytes
forall a. IsoValue a => a -> Value (ToT a)
toVal

instance HasRPCRepr (Packed a) where
  type AsRPC (Packed a) = Packed a

instance TypeHasDoc a => TypeHasDoc (Packed a) where
  typeDocMdDescription :: Doc
typeDocMdDescription = [md|
    Packed value of the given type.
    This exactly matches the result of Michelson `PACK` instruction application
    to the given value.
    |]
  typeDocMdReference :: Proxy (Packed a) -> WithinParens -> Doc
typeDocMdReference = Proxy (Packed a) -> WithinParens -> Doc
forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Doc
poly1TypeDocMdReference
  typeDocDependencies :: Proxy (Packed a) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (Packed a)
p =
    Proxy (Packed a) -> [SomeDocDefinitionItem]
forall a.
(Generic a, GTypeHasDoc (GRep a)) =>
Proxy a -> [SomeDocDefinitionItem]
genericTypeDocDependencies Proxy (Packed a)
p [SomeDocDefinitionItem]
-> [SomeDocDefinitionItem] -> [SomeDocDefinitionItem]
forall a. Semigroup a => a -> a -> a
<>
    [ forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @a
    , forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @MText, forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Integer  -- for examples below
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (Packed a)
typeDocHaskellRep = forall a b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (GRep a),
 HaveCommonTypeCtor b a) =>
TypeDocHaskellRep b
concreteTypeDocHaskellRep @(Packed (MText, Integer))
  typeDocMichelsonRep :: TypeDocMichelsonRep (Packed a)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Packed (MText, Integer))

----------------------------------------------------------------------------
-- Signatures
----------------------------------------------------------------------------

-- | Represents a signature, where signed data has given type.
--
-- Since we usually sign a packed data, a common pattern for this type is
-- @TSignature ('Packed' signedData)@.
-- If you don't want to use 'Packed', use plain @TSignature ByteString@ instead.
newtype TSignature a = TSignature { forall a. TSignature a -> Signature
unTSignature :: Signature }
  deriving stock (Int -> TSignature a -> ShowS
[TSignature a] -> ShowS
TSignature a -> String
(Int -> TSignature a -> ShowS)
-> (TSignature a -> String)
-> ([TSignature a] -> ShowS)
-> Show (TSignature a)
forall a. Int -> TSignature a -> ShowS
forall a. [TSignature a] -> ShowS
forall a. TSignature a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Int -> TSignature a -> ShowS
showsPrec :: Int -> TSignature a -> ShowS
$cshow :: forall a. TSignature a -> String
show :: TSignature a -> String
$cshowList :: forall a. [TSignature a] -> ShowS
showList :: [TSignature a] -> ShowS
Show, (forall x. TSignature a -> Rep (TSignature a) x)
-> (forall x. Rep (TSignature a) x -> TSignature a)
-> Generic (TSignature a)
forall x. Rep (TSignature a) x -> TSignature a
forall x. TSignature a -> Rep (TSignature a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (TSignature a) x -> TSignature a
forall a x. TSignature a -> Rep (TSignature a) x
$cfrom :: forall a x. TSignature a -> Rep (TSignature a) x
from :: forall x. TSignature a -> Rep (TSignature a) x
$cto :: forall a x. Rep (TSignature a) x -> TSignature a
to :: forall x. Rep (TSignature a) x -> TSignature a
Generic)
  deriving newtype (WellTypedToT (TSignature a)
WellTypedToT (TSignature a)
-> (TSignature a -> Value (ToT (TSignature a)))
-> (Value (ToT (TSignature a)) -> TSignature a)
-> IsoValue (TSignature a)
Value (ToT (TSignature a)) -> TSignature a
TSignature a -> Value (ToT (TSignature a))
forall {a}. WellTypedToT (TSignature a)
forall a.
WellTypedToT a
-> (a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
forall a. Value (ToT (TSignature a)) -> TSignature a
forall a. TSignature a -> Value (ToT (TSignature a))
$ctoVal :: forall a. TSignature a -> Value (ToT (TSignature a))
toVal :: TSignature a -> Value (ToT (TSignature a))
$cfromVal :: forall a. Value (ToT (TSignature a)) -> TSignature a
fromVal :: Value (ToT (TSignature a)) -> TSignature a
IsoValue, Maybe AnnOptions
FollowEntrypointFlag -> Notes (ToT (TSignature a))
(FollowEntrypointFlag -> Notes (ToT (TSignature a)))
-> Maybe AnnOptions -> HasAnnotation (TSignature a)
forall a. Maybe AnnOptions
forall a. FollowEntrypointFlag -> Notes (ToT (TSignature a))
forall a.
(FollowEntrypointFlag -> Notes (ToT a))
-> Maybe AnnOptions -> HasAnnotation a
$cgetAnnotation :: forall a. FollowEntrypointFlag -> Notes (ToT (TSignature a))
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (TSignature a))
$cannOptions :: forall a. Maybe AnnOptions
annOptions :: Maybe AnnOptions
HasAnnotation)

instance Buildable (TSignature a) where
  build :: TSignature a -> Doc
build = Value 'TSignature -> Doc
forall a. Buildable a => a -> Doc
build (Value 'TSignature -> Doc)
-> (TSignature a -> Value 'TSignature) -> TSignature a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TSignature a -> Value (ToT (TSignature a))
TSignature a -> Value 'TSignature
forall a. IsoValue a => a -> Value (ToT a)
toVal

instance HasRPCRepr (TSignature a) where
  type AsRPC (TSignature a) = TSignature a

instance TypeHasDoc a => TypeHasDoc (TSignature a) where
  typeDocMdDescription :: Doc
typeDocMdDescription = Doc
"Signature for data of the given type."
  typeDocMdReference :: Proxy (TSignature a) -> WithinParens -> Doc
typeDocMdReference = Proxy (TSignature a) -> WithinParens -> Doc
forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Doc
poly1TypeDocMdReference
  typeDocDependencies :: Proxy (TSignature a) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (TSignature a)
p =
    Proxy (TSignature a) -> [SomeDocDefinitionItem]
forall a.
(Generic a, GTypeHasDoc (GRep a)) =>
Proxy a -> [SomeDocDefinitionItem]
genericTypeDocDependencies Proxy (TSignature a)
p [SomeDocDefinitionItem]
-> [SomeDocDefinitionItem] -> [SomeDocDefinitionItem]
forall a. Semigroup a => a -> a -> a
<>
    [ forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @a
    , forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @MText, forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Integer  -- for examples below
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (TSignature a)
typeDocHaskellRep = forall a b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (GRep a),
 HaveCommonTypeCtor b a) =>
TypeDocHaskellRep b
concreteTypeDocHaskellRep @(TSignature (MText, Integer))
  typeDocMichelsonRep :: TypeDocMichelsonRep (TSignature a)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(TSignature (MText, Integer))

-- | Sign data using 'SecretKey'
lSign :: (MonadRandom m, BytesLike a) => SecretKey -> a -> m (TSignature a)
lSign :: forall (m :: * -> *) a.
(MonadRandom m, BytesLike a) =>
SecretKey -> a -> m (TSignature a)
lSign SecretKey
sk (a -> ByteString
forall bs. BytesLike bs => bs -> ByteString
toBytes -> ByteString
bs) = Signature -> TSignature a
forall a. Signature -> TSignature a
TSignature (Signature -> TSignature a) -> m Signature -> m (TSignature a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SecretKey -> ByteString -> m Signature
forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
sign SecretKey
sk ByteString
bs

----------------------------------------------------------------------------
-- Hashes
----------------------------------------------------------------------------

-- | Open kind for hash algorithms, to make it more difficult to apply type
-- arguments incorrectly.
type HashAlgorithmKind = HashAlgoTag -> Type
data HashAlgoTag

-- | Hash of type @t@ evaluated from data of type @a@.
newtype Hash (alg :: HashAlgorithmKind) a = UnsafeHash { forall (alg :: HashAlgorithmKind) a. Hash alg a -> ByteString
unHash :: ByteString }
  deriving stock (Int -> Hash alg a -> ShowS
[Hash alg a] -> ShowS
Hash alg a -> String
(Int -> Hash alg a -> ShowS)
-> (Hash alg a -> String)
-> ([Hash alg a] -> ShowS)
-> Show (Hash alg a)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (alg :: HashAlgorithmKind) a. Int -> Hash alg a -> ShowS
forall (alg :: HashAlgorithmKind) a. [Hash alg a] -> ShowS
forall (alg :: HashAlgorithmKind) a. Hash alg a -> String
$cshowsPrec :: forall (alg :: HashAlgorithmKind) a. Int -> Hash alg a -> ShowS
showsPrec :: Int -> Hash alg a -> ShowS
$cshow :: forall (alg :: HashAlgorithmKind) a. Hash alg a -> String
show :: Hash alg a -> String
$cshowList :: forall (alg :: HashAlgorithmKind) a. [Hash alg a] -> ShowS
showList :: [Hash alg a] -> ShowS
Show, Hash alg a -> Hash alg a -> Bool
(Hash alg a -> Hash alg a -> Bool)
-> (Hash alg a -> Hash alg a -> Bool) -> Eq (Hash alg a)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Bool
$c== :: forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Bool
== :: Hash alg a -> Hash alg a -> Bool
$c/= :: forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Bool
/= :: Hash alg a -> Hash alg a -> Bool
Eq, Eq (Hash alg a)
Eq (Hash alg a)
-> (Hash alg a -> Hash alg a -> Ordering)
-> (Hash alg a -> Hash alg a -> Bool)
-> (Hash alg a -> Hash alg a -> Bool)
-> (Hash alg a -> Hash alg a -> Bool)
-> (Hash alg a -> Hash alg a -> Bool)
-> (Hash alg a -> Hash alg a -> Hash alg a)
-> (Hash alg a -> Hash alg a -> Hash alg a)
-> Ord (Hash alg a)
Hash alg a -> Hash alg a -> Bool
Hash alg a -> Hash alg a -> Ordering
Hash alg a -> Hash alg a -> Hash alg a
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
forall (alg :: HashAlgorithmKind) a. Eq (Hash alg a)
forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Bool
forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Ordering
forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Hash alg a
$ccompare :: forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Ordering
compare :: Hash alg a -> Hash alg a -> Ordering
$c< :: forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Bool
< :: Hash alg a -> Hash alg a -> Bool
$c<= :: forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Bool
<= :: Hash alg a -> Hash alg a -> Bool
$c> :: forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Bool
> :: Hash alg a -> Hash alg a -> Bool
$c>= :: forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Bool
>= :: Hash alg a -> Hash alg a -> Bool
$cmax :: forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Hash alg a
max :: Hash alg a -> Hash alg a -> Hash alg a
$cmin :: forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Hash alg a -> Hash alg a
min :: Hash alg a -> Hash alg a -> Hash alg a
Ord, (forall x. Hash alg a -> Rep (Hash alg a) x)
-> (forall x. Rep (Hash alg a) x -> Hash alg a)
-> Generic (Hash alg a)
forall x. Rep (Hash alg a) x -> Hash alg a
forall x. Hash alg a -> Rep (Hash alg a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (alg :: HashAlgorithmKind) a x.
Rep (Hash alg a) x -> Hash alg a
forall (alg :: HashAlgorithmKind) a x.
Hash alg a -> Rep (Hash alg a) x
$cfrom :: forall (alg :: HashAlgorithmKind) a x.
Hash alg a -> Rep (Hash alg a) x
from :: forall x. Hash alg a -> Rep (Hash alg a) x
$cto :: forall (alg :: HashAlgorithmKind) a x.
Rep (Hash alg a) x -> Hash alg a
to :: forall x. Rep (Hash alg a) x -> Hash alg a
Generic)
  deriving newtype (WellTypedToT (Hash alg a)
WellTypedToT (Hash alg a)
-> (Hash alg a -> Value (ToT (Hash alg a)))
-> (Value (ToT (Hash alg a)) -> Hash alg a)
-> IsoValue (Hash alg a)
Value (ToT (Hash alg a)) -> Hash alg a
Hash alg a -> Value (ToT (Hash alg a))
forall a.
WellTypedToT a
-> (a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
forall {alg :: HashAlgorithmKind} {a}. WellTypedToT (Hash alg a)
forall (alg :: HashAlgorithmKind) a.
Value (ToT (Hash alg a)) -> Hash alg a
forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Value (ToT (Hash alg a))
$ctoVal :: forall (alg :: HashAlgorithmKind) a.
Hash alg a -> Value (ToT (Hash alg a))
toVal :: Hash alg a -> Value (ToT (Hash alg a))
$cfromVal :: forall (alg :: HashAlgorithmKind) a.
Value (ToT (Hash alg a)) -> Hash alg a
fromVal :: Value (ToT (Hash alg a)) -> Hash alg a
IsoValue, Maybe AnnOptions
FollowEntrypointFlag -> Notes (ToT (Hash alg a))
(FollowEntrypointFlag -> Notes (ToT (Hash alg a)))
-> Maybe AnnOptions -> HasAnnotation (Hash alg a)
forall a.
(FollowEntrypointFlag -> Notes (ToT a))
-> Maybe AnnOptions -> HasAnnotation a
forall (alg :: HashAlgorithmKind) a. Maybe AnnOptions
forall (alg :: HashAlgorithmKind) a.
FollowEntrypointFlag -> Notes (ToT (Hash alg a))
$cgetAnnotation :: forall (alg :: HashAlgorithmKind) a.
FollowEntrypointFlag -> Notes (ToT (Hash alg a))
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (Hash alg a))
$cannOptions :: forall (alg :: HashAlgorithmKind) a. Maybe AnnOptions
annOptions :: Maybe AnnOptions
HasAnnotation, ToT (Hash alg a) ~ ToT ByteString
KnownValue (Hash alg a)
KnownValue (Hash alg a)
-> (ToT (Hash alg a) ~ ToT ByteString)
-> (Hash alg a -> ByteString)
-> BytesLike (Hash alg a)
Hash alg a -> ByteString
forall bs.
KnownValue bs
-> (ToT bs ~ ToT ByteString) -> (bs -> ByteString) -> BytesLike bs
forall {alg :: HashAlgorithmKind} {a}.
(Typeable alg, Typeable a) =>
ToT (Hash alg a) ~ ToT ByteString
forall {alg :: HashAlgorithmKind} {a}.
(Typeable alg, Typeable a) =>
KnownValue (Hash alg a)
forall (alg :: HashAlgorithmKind) a.
(Typeable alg, Typeable a) =>
Hash alg a -> ByteString
$ctoBytes :: forall (alg :: HashAlgorithmKind) a.
(Typeable alg, Typeable a) =>
Hash alg a -> ByteString
toBytes :: Hash alg a -> ByteString
BytesLike)

instance Buildable (Hash alg a) where
  build :: Hash alg a -> Doc
build = Value 'TBytes -> Doc
forall a. Buildable a => a -> Doc
build (Value 'TBytes -> Doc)
-> (Hash alg a -> Value 'TBytes) -> Hash alg a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash alg a -> Value (ToT (Hash alg a))
Hash alg a -> Value 'TBytes
forall a. IsoValue a => a -> Value (ToT a)
toVal

instance HasRPCRepr (Hash alg a) where
  type AsRPC (Hash alg a) = Hash alg a

instance (KnownHashAlgorithm alg, TypeHasDoc a) => TypeHasDoc (Hash alg a) where
  typeDocMdDescription :: Doc
typeDocMdDescription = [md|
    Hash of a value.

    First type argument denotes algorithm used to compute the hash, and the second
    argument describes the data being hashed.
    |]

  typeDocMdReference :: Proxy (Hash alg a) -> WithinParens -> Doc
typeDocMdReference Proxy (Hash alg a)
tp WithinParens
wp =
    WithinParens -> Doc -> Doc
T.applyWithinParens WithinParens
wp (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ [Doc] -> Doc
forall a. Monoid a => [a] -> a
mconcat
      [ Doc -> DocItemRef 'DocItemInDefinitions 'True -> Doc
forall anchor. ToAnchor anchor => Doc -> anchor -> Doc
mdLocalRef (Doc -> Doc
mdTicked Doc
"Hash") (DType
-> DocItemRef (DocItemPlacement DType) (DocItemReferenced DType)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef (Proxy (Hash alg a) -> DType
forall a. TypeHasDoc a => Proxy a -> DType
DType Proxy (Hash alg a)
tp))
      , Doc
" "
      , Proxy alg -> Doc
forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> Doc
hashAlgorithmMdRef (forall {k} (t :: k). Proxy t
forall (t :: HashAlgorithmKind). Proxy t
Proxy @alg)
      , Doc
" "
      , Proxy a -> WithinParens -> Doc
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Doc
typeDocMdReference (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a) (Bool -> WithinParens
T.WithinParens Bool
True)
      ]

  typeDocDependencies :: Proxy (Hash alg a) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (Hash alg a)
p =
    Proxy (Hash alg a) -> [SomeDocDefinitionItem]
forall a.
(Generic a, GTypeHasDoc (GRep a)) =>
Proxy a -> [SomeDocDefinitionItem]
genericTypeDocDependencies Proxy (Hash alg a)
p [SomeDocDefinitionItem]
-> [SomeDocDefinitionItem] -> [SomeDocDefinitionItem]
forall a. Semigroup a => a -> a -> a
<>
    [ DHashAlgorithm -> SomeDocDefinitionItem
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
d -> SomeDocDefinitionItem
SomeDocDefinitionItem (Proxy alg -> DHashAlgorithm
forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> DHashAlgorithm
DHashAlgorithm (forall {k} (t :: k). Proxy t
forall (t :: HashAlgorithmKind). Proxy t
Proxy @alg)), forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @a
    , DHashAlgorithm -> SomeDocDefinitionItem
forall d.
(DocItem d, DocItemPlacement d ~ 'DocItemInDefinitions) =>
d -> SomeDocDefinitionItem
SomeDocDefinitionItem (Proxy Blake2b -> DHashAlgorithm
forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> DHashAlgorithm
DHashAlgorithm (forall {k} (t :: k). Proxy t
forall (t :: HashAlgorithmKind). Proxy t
Proxy @Blake2b)), forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @ByteString
        --- ^ for examples below
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (Hash alg a)
typeDocHaskellRep = forall a b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (GRep a),
 HaveCommonTypeCtor b a) =>
TypeDocHaskellRep b
concreteTypeDocHaskellRep @(Hash Blake2b ByteString)
  typeDocMichelsonRep :: TypeDocMichelsonRep (Hash alg a)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(Hash Blake2b ByteString)

-- | Hash algorithm used in Tezos.
class Typeable alg => KnownHashAlgorithm (alg :: HashAlgorithmKind) where
  hashAlgorithmName :: Proxy alg -> Text
  hashAlgorithmName Proxy alg
_ =
    String -> Text
forall a. ToText a => a -> Text
toText (String -> Text) -> (TypeRep alg -> String) -> TypeRep alg -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TyCon -> String
Refl.tyConName (TyCon -> String)
-> (TypeRep alg -> TyCon) -> TypeRep alg -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TypeRep alg -> TyCon
forall {k} (a :: k). TypeRep a -> TyCon
Refl.typeRepTyCon (TypeRep alg -> Text) -> TypeRep alg -> Text
forall a b. (a -> b) -> a -> b
$ forall {k} (a :: k). Typeable a => TypeRep a
forall (a :: HashAlgorithmKind). Typeable a => TypeRep a
Refl.typeRep @alg

  computeHash :: ByteString -> ByteString
  toHash :: BytesLike bs => bs : s :-> Hash alg bs : s

-- | Evaluate hash in Haskell world.
toHashHs
  :: forall alg bs. (BytesLike bs, KnownHashAlgorithm alg)
  => bs -> Hash alg bs
toHashHs :: forall (alg :: HashAlgorithmKind) bs.
(BytesLike bs, KnownHashAlgorithm alg) =>
bs -> Hash alg bs
toHashHs = ByteString -> Hash alg bs
forall (alg :: HashAlgorithmKind) a. ByteString -> Hash alg a
UnsafeHash (ByteString -> Hash alg bs)
-> (bs -> ByteString) -> bs -> Hash alg bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
ByteString -> ByteString
computeHash @alg (ByteString -> ByteString)
-> (bs -> ByteString) -> bs -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. bs -> ByteString
forall bs. BytesLike bs => bs -> ByteString
toBytes

-- | Documentation item for hash algorithms.
data DHashAlgorithm where
  DHashAlgorithm :: KnownHashAlgorithm alg => Proxy alg -> DHashAlgorithm

instance Eq DHashAlgorithm where
  DHashAlgorithm
a == :: DHashAlgorithm -> DHashAlgorithm -> Bool
== DHashAlgorithm
b = (DHashAlgorithm
a DHashAlgorithm -> DHashAlgorithm -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` DHashAlgorithm
b) Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
EQ
instance Ord DHashAlgorithm where
  DHashAlgorithm Proxy alg
a compare :: DHashAlgorithm -> DHashAlgorithm -> Ordering
`compare` DHashAlgorithm Proxy alg
b =
    Proxy alg -> Text
forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> Text
hashAlgorithmName Proxy alg
a Text -> Text -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Proxy alg -> Text
forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> Text
hashAlgorithmName Proxy alg
b

instance DocItem DHashAlgorithm where
  type DocItemPlacement DHashAlgorithm = 'DocItemInDefinitions
  type DocItemReferenced DHashAlgorithm = 'True
  docItemPos :: Natural
docItemPos = Natural
5310
  docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"Referenced hash algorithms"

  docItemRef :: DHashAlgorithm
-> DocItemRef
     (DocItemPlacement DHashAlgorithm)
     (DocItemReferenced DHashAlgorithm)
docItemRef (DHashAlgorithm Proxy alg
alg) =
    DocItemId -> DocItemRef 'DocItemInDefinitions 'True
DocItemRef (DocItemId -> DocItemRef 'DocItemInDefinitions 'True)
-> DocItemId -> DocItemRef 'DocItemInDefinitions 'True
forall a b. (a -> b) -> a -> b
$ Text -> DocItemId
DocItemId (Text
"hash-alg-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Proxy alg -> Text
forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> Text
hashAlgorithmName Proxy alg
alg)

  docItemToMarkdown :: HeaderLevel -> DHashAlgorithm -> Doc
docItemToMarkdown HeaderLevel
_ (DHashAlgorithm Proxy alg
alg) =
    Doc
"* " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Text -> Doc
forall a. Buildable a => a -> Doc
build (Proxy alg -> Text
forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> Text
hashAlgorithmName Proxy alg
alg)

-- Creates a reference to given hash algorithm description.
hashAlgorithmMdRef :: KnownHashAlgorithm alg => Proxy alg -> Markdown
hashAlgorithmMdRef :: forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> Doc
hashAlgorithmMdRef Proxy alg
alg =
  Doc -> DocItemRef 'DocItemInDefinitions 'True -> Doc
forall anchor. ToAnchor anchor => Doc -> anchor -> Doc
mdLocalRef
    (Doc -> Doc
mdTicked (Doc -> Doc) -> (Text -> Doc) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> Text -> Doc
forall a b. (a -> b) -> a -> b
$ Proxy alg -> Text
forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> Text
hashAlgorithmName Proxy alg
alg)
    (DHashAlgorithm
-> DocItemRef
     (DocItemPlacement DHashAlgorithm)
     (DocItemReferenced DHashAlgorithm)
forall d.
DocItem d =>
d -> DocItemRef (DocItemPlacement d) (DocItemReferenced d)
docItemRef (Proxy alg -> DHashAlgorithm
forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> DHashAlgorithm
DHashAlgorithm Proxy alg
alg))

data Sha256 :: HashAlgorithmKind

instance KnownHashAlgorithm Sha256 where
  computeHash :: ByteString -> ByteString
computeHash = ByteString -> ByteString
Crypto.sha256
  toHash :: forall bs (s :: [*]).
BytesLike bs =>
(bs : s) :-> (Hash Sha256 bs : s)
toHash = Instr (ToTs (bs : s)) (ToTs (Hash Sha256 bs : s))
-> (bs : s) :-> (Hash Sha256 bs : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr ('TBytes : ToTs s) ('TBytes : ToTs s)
Instr (ToTs (bs : s)) (ToTs (Hash Sha256 bs : s))
forall {inp :: [T]} {out :: [T]} (s :: [T]).
(inp ~ ('TBytes : s), out ~ ('TBytes : s)) =>
Instr inp out
T.SHA256

data Sha512 :: HashAlgorithmKind

instance KnownHashAlgorithm Sha512 where
  computeHash :: ByteString -> ByteString
computeHash = ByteString -> ByteString
Crypto.sha512
  toHash :: forall bs (s :: [*]).
BytesLike bs =>
(bs : s) :-> (Hash Sha512 bs : s)
toHash = Instr (ToTs (bs : s)) (ToTs (Hash Sha512 bs : s))
-> (bs : s) :-> (Hash Sha512 bs : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr ('TBytes : ToTs s) ('TBytes : ToTs s)
Instr (ToTs (bs : s)) (ToTs (Hash Sha512 bs : s))
forall {inp :: [T]} {out :: [T]} (s :: [T]).
(inp ~ ('TBytes : s), out ~ ('TBytes : s)) =>
Instr inp out
T.SHA512

data Blake2b :: HashAlgorithmKind

instance KnownHashAlgorithm Blake2b where
  computeHash :: ByteString -> ByteString
computeHash = ByteString -> ByteString
Crypto.blake2b
  toHash :: forall bs (s :: [*]).
BytesLike bs =>
(bs : s) :-> (Hash Blake2b bs : s)
toHash = Instr (ToTs (bs : s)) (ToTs (Hash Blake2b bs : s))
-> (bs : s) :-> (Hash Blake2b bs : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr ('TBytes : ToTs s) ('TBytes : ToTs s)
Instr (ToTs (bs : s)) (ToTs (Hash Blake2b bs : s))
forall {inp :: [T]} {out :: [T]} (s :: [T]).
(inp ~ ('TBytes : s), out ~ ('TBytes : s)) =>
Instr inp out
T.BLAKE2B

data Sha3 :: HashAlgorithmKind

instance KnownHashAlgorithm Sha3 where
  computeHash :: ByteString -> ByteString
computeHash = ByteString -> ByteString
Crypto.sha3
  toHash :: forall bs (s :: [*]).
BytesLike bs =>
(bs : s) :-> (Hash Sha3 bs : s)
toHash = Instr (ToTs (bs : s)) (ToTs (Hash Sha3 bs : s))
-> (bs : s) :-> (Hash Sha3 bs : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr ('TBytes : ToTs s) ('TBytes : ToTs s)
Instr (ToTs (bs : s)) (ToTs (Hash Sha3 bs : s))
forall {inp :: [T]} {out :: [T]} (s :: [T]).
(inp ~ ('TBytes : s), out ~ ('TBytes : s)) =>
Instr inp out
T.SHA3

data Keccak :: HashAlgorithmKind

instance KnownHashAlgorithm Keccak where
  computeHash :: ByteString -> ByteString
computeHash = ByteString -> ByteString
Crypto.keccak
  toHash :: forall bs (s :: [*]).
BytesLike bs =>
(bs : s) :-> (Hash Keccak bs : s)
toHash = Instr (ToTs (bs : s)) (ToTs (Hash Keccak bs : s))
-> (bs : s) :-> (Hash Keccak bs : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr ('TBytes : ToTs s) ('TBytes : ToTs s)
Instr (ToTs (bs : s)) (ToTs (Hash Keccak bs : s))
forall {inp :: [T]} {out :: [T]} (s :: [T]).
(inp ~ ('TBytes : s), out ~ ('TBytes : s)) =>
Instr inp out
T.KECCAK

----------------------------------------------------------------------------
-- Typed Chest
----------------------------------------------------------------------------

newtype ChestT a = ChestT { forall a. ChestT a -> Chest
unChestT :: Chest }
  deriving newtype (WellTypedToT (ChestT a)
WellTypedToT (ChestT a)
-> (ChestT a -> Value (ToT (ChestT a)))
-> (Value (ToT (ChestT a)) -> ChestT a)
-> IsoValue (ChestT a)
Value (ToT (ChestT a)) -> ChestT a
ChestT a -> Value (ToT (ChestT a))
forall {a}. WellTypedToT (ChestT a)
forall a.
WellTypedToT a
-> (a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
forall a. Value (ToT (ChestT a)) -> ChestT a
forall a. ChestT a -> Value (ToT (ChestT a))
$ctoVal :: forall a. ChestT a -> Value (ToT (ChestT a))
toVal :: ChestT a -> Value (ToT (ChestT a))
$cfromVal :: forall a. Value (ToT (ChestT a)) -> ChestT a
fromVal :: Value (ToT (ChestT a)) -> ChestT a
IsoValue, Maybe AnnOptions
FollowEntrypointFlag -> Notes (ToT (ChestT a))
(FollowEntrypointFlag -> Notes (ToT (ChestT a)))
-> Maybe AnnOptions -> HasAnnotation (ChestT a)
forall a. Maybe AnnOptions
forall a. FollowEntrypointFlag -> Notes (ToT (ChestT a))
forall a.
(FollowEntrypointFlag -> Notes (ToT a))
-> Maybe AnnOptions -> HasAnnotation a
$cgetAnnotation :: forall a. FollowEntrypointFlag -> Notes (ToT (ChestT a))
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (ChestT a))
$cannOptions :: forall a. Maybe AnnOptions
annOptions :: Maybe AnnOptions
HasAnnotation)
  deriving stock (forall x. ChestT a -> Rep (ChestT a) x)
-> (forall x. Rep (ChestT a) x -> ChestT a) -> Generic (ChestT a)
forall x. Rep (ChestT a) x -> ChestT a
forall x. ChestT a -> Rep (ChestT a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ChestT a) x -> ChestT a
forall a x. ChestT a -> Rep (ChestT a) x
$cfrom :: forall a x. ChestT a -> Rep (ChestT a) x
from :: forall x. ChestT a -> Rep (ChestT a) x
$cto :: forall a x. Rep (ChestT a) x -> ChestT a
to :: forall x. Rep (ChestT a) x -> ChestT a
Generic

instance HasRPCRepr (ChestT a) where
  type AsRPC (ChestT a) = ChestT a

instance TypeHasDoc a => TypeHasDoc (ChestT a) where
  typeDocMdDescription :: Doc
typeDocMdDescription = [md|
    Timelock puzzle chest containing a typed value.

    In Lorentz, use `openChestT` instead of `openChest` to open it.
    |]
  typeDocMdReference :: Proxy (ChestT a) -> WithinParens -> Doc
typeDocMdReference = Proxy (ChestT a) -> WithinParens -> Doc
forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Doc
poly1TypeDocMdReference
  typeDocDependencies :: Proxy (ChestT a) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (ChestT a)
p =
    Proxy (ChestT a) -> [SomeDocDefinitionItem]
forall a.
(Generic a, GTypeHasDoc (GRep a)) =>
Proxy a -> [SomeDocDefinitionItem]
genericTypeDocDependencies Proxy (ChestT a)
p [SomeDocDefinitionItem]
-> [SomeDocDefinitionItem] -> [SomeDocDefinitionItem]
forall a. Semigroup a => a -> a -> a
<>
    [ forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @a
    , forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @MText, forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Integer  -- for examples below
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (ChestT a)
typeDocHaskellRep = forall a b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (GRep a),
 HaveCommonTypeCtor b a) =>
TypeDocHaskellRep b
concreteTypeDocHaskellRep @(ChestT (Packed (MText, Integer)))
  typeDocMichelsonRep :: TypeDocMichelsonRep (ChestT a)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(ChestT (Packed (MText, Integer)))

data OpenChestT a = ChestContentT a | ChestOpenFailedT Bool
  deriving stock ((forall x. OpenChestT a -> Rep (OpenChestT a) x)
-> (forall x. Rep (OpenChestT a) x -> OpenChestT a)
-> Generic (OpenChestT a)
forall x. Rep (OpenChestT a) x -> OpenChestT a
forall x. OpenChestT a -> Rep (OpenChestT a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (OpenChestT a) x -> OpenChestT a
forall a x. OpenChestT a -> Rep (OpenChestT a) x
$cfrom :: forall a x. OpenChestT a -> Rep (OpenChestT a) x
from :: forall x. OpenChestT a -> Rep (OpenChestT a) x
$cto :: forall a x. Rep (OpenChestT a) x -> OpenChestT a
to :: forall x. Rep (OpenChestT a) x -> OpenChestT a
Generic, Int -> OpenChestT a -> ShowS
[OpenChestT a] -> ShowS
OpenChestT a -> String
(Int -> OpenChestT a -> ShowS)
-> (OpenChestT a -> String)
-> ([OpenChestT a] -> ShowS)
-> Show (OpenChestT a)
forall a. Show a => Int -> OpenChestT a -> ShowS
forall a. Show a => [OpenChestT a] -> ShowS
forall a. Show a => OpenChestT a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> OpenChestT a -> ShowS
showsPrec :: Int -> OpenChestT a -> ShowS
$cshow :: forall a. Show a => OpenChestT a -> String
show :: OpenChestT a -> String
$cshowList :: forall a. Show a => [OpenChestT a] -> ShowS
showList :: [OpenChestT a] -> ShowS
Show, OpenChestT a -> OpenChestT a -> Bool
(OpenChestT a -> OpenChestT a -> Bool)
-> (OpenChestT a -> OpenChestT a -> Bool) -> Eq (OpenChestT a)
forall a. Eq a => OpenChestT a -> OpenChestT a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => OpenChestT a -> OpenChestT a -> Bool
== :: OpenChestT a -> OpenChestT a -> Bool
$c/= :: forall a. Eq a => OpenChestT a -> OpenChestT a -> Bool
/= :: OpenChestT a -> OpenChestT a -> Bool
Eq)
  deriving anyclass (WellTypedToT (OpenChestT a)
WellTypedToT (OpenChestT a)
-> (OpenChestT a -> Value (ToT (OpenChestT a)))
-> (Value (ToT (OpenChestT a)) -> OpenChestT a)
-> IsoValue (OpenChestT a)
Value (ToT (OpenChestT a)) -> OpenChestT a
OpenChestT a -> Value (ToT (OpenChestT a))
forall a.
WellTypedToT a
-> (a -> Value (ToT a)) -> (Value (ToT a) -> a) -> IsoValue a
forall {a}. IsoValue a => WellTypedToT (OpenChestT a)
forall a. IsoValue a => Value (ToT (OpenChestT a)) -> OpenChestT a
forall a. IsoValue a => OpenChestT a -> Value (ToT (OpenChestT a))
$ctoVal :: forall a. IsoValue a => OpenChestT a -> Value (ToT (OpenChestT a))
toVal :: OpenChestT a -> Value (ToT (OpenChestT a))
$cfromVal :: forall a. IsoValue a => Value (ToT (OpenChestT a)) -> OpenChestT a
fromVal :: Value (ToT (OpenChestT a)) -> OpenChestT a
T.IsoValue, Maybe AnnOptions
FollowEntrypointFlag -> Notes (ToT (OpenChestT a))
(FollowEntrypointFlag -> Notes (ToT (OpenChestT a)))
-> Maybe AnnOptions -> HasAnnotation (OpenChestT a)
forall a. HasAnnotation a => Maybe AnnOptions
forall a.
HasAnnotation a =>
FollowEntrypointFlag -> Notes (ToT (OpenChestT a))
forall a.
(FollowEntrypointFlag -> Notes (ToT a))
-> Maybe AnnOptions -> HasAnnotation a
$cgetAnnotation :: forall a.
HasAnnotation a =>
FollowEntrypointFlag -> Notes (ToT (OpenChestT a))
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (OpenChestT a))
$cannOptions :: forall a. HasAnnotation a => Maybe AnnOptions
annOptions :: Maybe AnnOptions
HasAnnotation)

instance HasRPCRepr a => HasRPCRepr (OpenChestT a) where
  type AsRPC (OpenChestT a) = OpenChestT (AsRPC a)

instance (TypeHasDoc a) => TypeHasDoc (OpenChestT a) where
  typeDocMdDescription :: Doc
typeDocMdDescription = Doc
"Typed result of opening a typed timelocked chest."
  typeDocMdReference :: Proxy (OpenChestT a) -> WithinParens -> Doc
typeDocMdReference = Proxy (OpenChestT a) -> WithinParens -> Doc
forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Doc
poly1TypeDocMdReference
  typeDocDependencies :: Proxy (OpenChestT a) -> [SomeDocDefinitionItem]
typeDocDependencies Proxy (OpenChestT a)
_ =
    [ forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @a
    , forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @MText, forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Integer  -- for examples below
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (OpenChestT a)
typeDocHaskellRep Proxy (OpenChestT a)
_ FieldDescriptionsV
_ = Maybe (Maybe DocTypeRepLHS, ADTRep SomeTypeWithDoc)
forall a. Maybe a
Nothing
  typeDocMichelsonRep :: TypeDocMichelsonRep (OpenChestT a)
typeDocMichelsonRep = forall a b.
(Typeable a, KnownIsoT a, HaveCommonTypeCtor b a) =>
TypeDocMichelsonRep b
concreteTypeDocMichelsonRep @(OpenChestT (Packed (MText, Integer)))

openChestT :: BytesLike a => ChestKey : ChestT a : Natural : s :-> OpenChestT a : s
openChestT :: forall a (s :: [*]).
BytesLike a =>
(ChestKey : ChestT a : Natural : s) :-> (OpenChestT a : s)
openChestT = Instr
  (ToTs (ChestKey : ChestT a : Natural : s))
  (ToTs (OpenChestT a : s))
-> (ChestKey : ChestT a : Natural : s) :-> (OpenChestT a : s)
forall (inp :: [*]) (out :: [*]).
Instr (ToTs inp) (ToTs out) -> inp :-> out
I Instr
  ('TChestKey : 'TChest : 'TNat : ToTs s)
  ('TOr 'TBytes 'TBool : ToTs s)
Instr
  (ToTs (ChestKey : ChestT a : Natural : s))
  (ToTs (OpenChestT a : s))
forall {inp :: [T]} {out :: [T]} (s :: [T]).
(inp ~ ('TChestKey : 'TChest : 'TNat : s),
 out ~ ('TOr 'TBytes 'TBool : s)) =>
Instr inp out
T.OPEN_CHEST

{-# DEPRECATED openChestT
  "Due to a vulnerability discovered in time-lock protocol, \
  \OPEN_CHEST is temporarily deprecated since Lima" #-}