-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

{-# LANGUAGE NoPolyKinds #-}

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

  , Packed (..)

  , TSignature (..)
  , lSignEd22519

  , Hash (..)
  , DHashAlgorithm
  , KnownHashAlgorithm (..)
  , toHashHs
  , Sha256
  , Sha512
  , Blake2b
  ) where

import qualified Data.Kind as Kind
import Fmt (Buildable(..))
import qualified Type.Reflection as Refl
import Util.Markdown

import Lorentz.Annotation
import Lorentz.Base
import Lorentz.Constraints.Scopes
import Lorentz.Doc
import Lorentz.Value
import qualified Michelson.Typed as T
import Tezos.Crypto
import qualified Tezos.Crypto.Ed25519 as Ed22519
import qualified Tezos.Crypto.Hash 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 { 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
showList :: [Packed a] -> ShowS
$cshowList :: forall a. [Packed a] -> ShowS
show :: Packed a -> String
$cshow :: forall a. Packed a -> String
showsPrec :: Int -> Packed a -> ShowS
$cshowsPrec :: forall a. Int -> 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
/= :: 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
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
min :: Packed a -> Packed a -> Packed a
$cmin :: forall a. Packed a -> Packed a -> Packed a
max :: Packed a -> Packed a -> Packed a
$cmax :: forall a. Packed a -> Packed a -> Packed a
>= :: 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
$c< :: forall a. Packed a -> Packed a -> Bool
compare :: Packed a -> Packed a -> Ordering
$ccompare :: forall a. Packed a -> Packed a -> Ordering
$cp1Ord :: forall a. Eq (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
$cto :: forall a x. Rep (Packed a) x -> Packed a
$cfrom :: forall a x. Packed a -> Rep (Packed a) x
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))
fromVal :: Value (ToT (Packed a)) -> Packed a
$cfromVal :: forall a. Value (ToT (Packed a)) -> Packed a
toVal :: Packed a -> Value (ToT (Packed a))
$ctoVal :: forall a. Packed a -> Value (ToT (Packed a))
$cp1IsoValue :: forall a. WellTypedToT (Packed a)
IsoValue, AnnOptions
FollowEntrypointFlag -> Notes (ToT (Packed a))
(FollowEntrypointFlag -> Notes (ToT (Packed a)))
-> AnnOptions -> HasAnnotation (Packed a)
forall a. AnnOptions
forall a. FollowEntrypointFlag -> Notes (ToT (Packed a))
forall a.
(FollowEntrypointFlag -> Notes (ToT a))
-> AnnOptions -> HasAnnotation a
annOptions :: AnnOptions
$cannOptions :: forall a. AnnOptions
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (Packed a))
$cgetAnnotation :: forall a. FollowEntrypointFlag -> Notes (ToT (Packed a))
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
toBytes :: Packed a -> ByteString
$ctoBytes :: forall a. Typeable a => Packed a -> ByteString
$cp2BytesLike :: forall a. Typeable a => ToT (Packed a) ~ ToT ByteString
$cp1BytesLike :: forall a. Typeable a => KnownValue (Packed a)
BytesLike)

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

instance TypeHasDoc a => TypeHasDoc (Packed a) where
  typeDocMdDescription :: Builder
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 -> Builder
typeDocMdReference = Proxy (Packed a) -> WithinParens -> Builder
forall (t :: * -> *) r a.
(r ~ t a, Typeable t, Each '[TypeHasDoc] '[r, a],
 IsHomomorphic t) =>
Proxy r -> WithinParens -> Builder
poly1TypeDocMdReference
  typeDocDependencies :: Proxy (Packed a) -> [SomeDocDefinitionItem]
typeDocDependencies p :: Proxy (Packed a)
p =
    Proxy (Packed a) -> [SomeDocDefinitionItem]
forall a.
(Generic a, GTypeHasDoc (Rep a)) =>
Proxy a -> [SomeDocDefinitionItem]
genericTypeDocDependencies Proxy (Packed a)
p [SomeDocDefinitionItem]
-> [SomeDocDefinitionItem] -> [SomeDocDefinitionItem]
forall a. Semigroup a => a -> a -> a
<>
    [ TypeHasDoc a => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @a
    , TypeHasDoc MText => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @MText, TypeHasDoc Integer => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @Integer  -- for examples below
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (Packed a)
typeDocHaskellRep = forall b.
(Typeable (Packed (MText, Integer)),
 GenericIsoValue (Packed (MText, Integer)),
 GTypeHasDoc (Rep (Packed (MText, Integer))),
 HaveCommonTypeCtor b (Packed (MText, Integer))) =>
TypeDocHaskellRep b
forall a b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a),
 HaveCommonTypeCtor b a) =>
TypeDocHaskellRep b
concreteTypeDocHaskellRep @(Packed (MText, Integer))
  typeDocMichelsonRep :: TypeDocMichelsonRep (Packed a)
typeDocMichelsonRep = forall b.
(Typeable (Packed (MText, Integer)),
 SingI (ToT (Packed (MText, Integer))),
 HaveCommonTypeCtor b (Packed (MText, Integer))) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT 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 { 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
showList :: [TSignature a] -> ShowS
$cshowList :: forall a. [TSignature a] -> ShowS
show :: TSignature a -> String
$cshow :: forall a. TSignature a -> String
showsPrec :: Int -> TSignature a -> ShowS
$cshowsPrec :: forall a. Int -> 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
$cto :: forall a x. Rep (TSignature a) x -> TSignature a
$cfrom :: forall a x. TSignature a -> Rep (TSignature a) x
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))
fromVal :: Value (ToT (TSignature a)) -> TSignature a
$cfromVal :: forall a. Value (ToT (TSignature a)) -> TSignature a
toVal :: TSignature a -> Value (ToT (TSignature a))
$ctoVal :: forall a. TSignature a -> Value (ToT (TSignature a))
$cp1IsoValue :: forall a. WellTypedToT (TSignature a)
IsoValue, AnnOptions
FollowEntrypointFlag -> Notes (ToT (TSignature a))
(FollowEntrypointFlag -> Notes (ToT (TSignature a)))
-> AnnOptions -> HasAnnotation (TSignature a)
forall a. AnnOptions
forall a. FollowEntrypointFlag -> Notes (ToT (TSignature a))
forall a.
(FollowEntrypointFlag -> Notes (ToT a))
-> AnnOptions -> HasAnnotation a
annOptions :: AnnOptions
$cannOptions :: forall a. AnnOptions
getAnnotation :: FollowEntrypointFlag -> Notes (ToT (TSignature a))
$cgetAnnotation :: forall a. FollowEntrypointFlag -> Notes (ToT (TSignature a))
HasAnnotation)

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

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

-- | Sign data using Ed25519 curve.
-- TODO [#456]: handle other methods, either all at once (if viable) or each one separately
lSignEd22519 :: BytesLike a => Ed22519.SecretKey -> a -> TSignature a
lSignEd22519 :: SecretKey -> a -> TSignature a
lSignEd22519 sk :: 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)
-> (Signature -> Signature) -> Signature -> TSignature a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Signature
SignatureEd25519 (Signature -> TSignature a) -> Signature -> TSignature a
forall a b. (a -> b) -> a -> b
$ SecretKey -> ByteString -> Signature
Ed22519.sign SecretKey
sk ByteString
bs

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

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

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

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

instance (KnownHashAlgorithm alg, TypeHasDoc a) => TypeHasDoc (Hash alg a) where
  typeDocMdDescription :: Builder
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 -> Builder
typeDocMdReference tp :: Proxy (Hash alg a)
tp wp :: WithinParens
wp =
    WithinParens -> Builder -> Builder
T.applyWithinParens WithinParens
wp (Builder -> Builder) -> Builder -> Builder
forall a b. (a -> b) -> a -> b
$ [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat
      [ Builder -> DocItemRef 'DocItemInDefinitions 'True -> Builder
forall anchor. ToAnchor anchor => Builder -> anchor -> Builder
mdLocalRef (Builder -> Builder
mdTicked "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))
      , " "
      , Proxy alg -> Builder
forall (alg :: HashAlgorithmKind).
KnownHashAlgorithm alg =>
Proxy alg -> Builder
hashAlgorithmMdRef (Proxy alg
forall k (t :: k). Proxy t
Proxy @alg)
      , " "
      , Proxy a -> WithinParens -> Builder
forall a. TypeHasDoc a => Proxy a -> WithinParens -> Builder
typeDocMdReference (Proxy a
forall k (t :: k). Proxy t
Proxy @a) (Bool -> WithinParens
T.WithinParens Bool
True)
      ]

  typeDocDependencies :: Proxy (Hash alg a) -> [SomeDocDefinitionItem]
typeDocDependencies p :: Proxy (Hash alg a)
p =
    Proxy (Hash alg a) -> [SomeDocDefinitionItem]
forall a.
(Generic a, GTypeHasDoc (Rep 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 (Proxy alg
forall k (t :: k). Proxy t
Proxy @alg)), TypeHasDoc a => SomeDocDefinitionItem
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 (Proxy Blake2b
forall k (t :: k). Proxy t
Proxy @Blake2b)), TypeHasDoc ByteString => SomeDocDefinitionItem
forall t. TypeHasDoc t => SomeDocDefinitionItem
dTypeDep @ByteString
        --- ^ for examples below
    ]
  typeDocHaskellRep :: TypeDocHaskellRep (Hash alg a)
typeDocHaskellRep = forall b.
(Typeable (Hash Blake2b ByteString),
 GenericIsoValue (Hash Blake2b ByteString),
 GTypeHasDoc (Rep (Hash Blake2b ByteString)),
 HaveCommonTypeCtor b (Hash Blake2b ByteString)) =>
TypeDocHaskellRep b
forall a b.
(Typeable a, GenericIsoValue a, GTypeHasDoc (Rep a),
 HaveCommonTypeCtor b a) =>
TypeDocHaskellRep b
concreteTypeDocHaskellRep @(Hash Blake2b ByteString)
  typeDocMichelsonRep :: TypeDocMichelsonRep (Hash alg a)
typeDocMichelsonRep = forall b.
(Typeable (Hash Blake2b ByteString),
 SingI (ToT (Hash Blake2b ByteString)),
 HaveCommonTypeCtor b (Hash Blake2b ByteString)) =>
TypeDocMichelsonRep b
forall k a (b :: k).
(Typeable a, SingI (ToT 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 _ =
    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
$ Typeable alg => TypeRep alg
forall k (a :: k). 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 :: bs -> Hash alg bs
toHashHs = ByteString -> Hash alg bs
forall (alg :: HashAlgorithmKind) a. ByteString -> Hash alg a
HashUnsafe (ByteString -> Hash alg bs)
-> (bs -> ByteString) -> bs -> Hash alg bs
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KnownHashAlgorithm alg => ByteString -> ByteString
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
  a :: DHashAlgorithm
a == :: DHashAlgorithm -> DHashAlgorithm -> Bool
== b :: 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 a :: Proxy alg
a compare :: DHashAlgorithm -> DHashAlgorithm -> Ordering
`compare` DHashAlgorithm b :: 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 = 5310
  docItemSectionName :: Maybe Text
docItemSectionName = Text -> Maybe Text
forall a. a -> Maybe a
Just "Referenced hash algorithms"

  docItemRef :: DHashAlgorithm
-> DocItemRef
     (DocItemPlacement DHashAlgorithm)
     (DocItemReferenced DHashAlgorithm)
docItemRef (DHashAlgorithm alg :: Proxy alg
alg) =
    DocItemId
-> DocItemRef
     (DocItemPlacement DHashAlgorithm)
     (DocItemReferenced DHashAlgorithm)
DocItemId -> DocItemRef 'DocItemInDefinitions 'True
DocItemRef (DocItemId
 -> DocItemRef
      (DocItemPlacement DHashAlgorithm)
      (DocItemReferenced DHashAlgorithm))
-> DocItemId
-> DocItemRef
     (DocItemPlacement DHashAlgorithm)
     (DocItemReferenced DHashAlgorithm)
forall a b. (a -> b) -> a -> b
$ Text -> DocItemId
DocItemId ("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 -> Builder
docItemToMarkdown _ (DHashAlgorithm alg :: Proxy alg
alg) =
    "* " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
forall p. Buildable p => p -> Builder
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 :: Proxy alg -> Builder
hashAlgorithmMdRef alg :: Proxy alg
alg =
  Builder -> DocItemRef 'DocItemInDefinitions 'True -> Builder
forall anchor. ToAnchor anchor => Builder -> anchor -> Builder
mdLocalRef
    (Builder -> Builder
mdTicked (Builder -> Builder) -> (Text -> Builder) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder
forall p. Buildable p => p -> Builder
build (Text -> Builder) -> Text -> Builder
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 :: (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 (ToTs (bs : s)) (ToTs (Hash Sha256 bs : s))
forall (s :: [T]). Instr ('TBytes : s) ('TBytes : s)
T.SHA256

data Sha512 :: HashAlgorithmKind

instance KnownHashAlgorithm Sha512 where
  computeHash :: ByteString -> ByteString
computeHash = ByteString -> ByteString
Crypto.sha512
  toHash :: (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 (ToTs (bs : s)) (ToTs (Hash Sha512 bs : s))
forall (s :: [T]). Instr ('TBytes : s) ('TBytes : s)
T.SHA512

data Blake2b :: HashAlgorithmKind

instance KnownHashAlgorithm Blake2b where
  computeHash :: ByteString -> ByteString
computeHash = ByteString -> ByteString
Crypto.blake2b
  toHash :: (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 (ToTs (bs : s)) (ToTs (Hash Blake2b bs : s))
forall (s :: [T]). Instr ('TBytes : s) ('TBytes : s)
T.BLAKE2B