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

-- | Cryptographic primitives used in Tezos.
--
-- WARNING: some functions may be vulnerable to timing attacks.
-- Also, this code was not reviewed by cryptography/security experts.
-- Do not use it with secret keys that have some value.
-- We provide 'SecretKey' type and (limited) signing functionality only
-- for testing.
-- If you need to sign something in production, use something else
-- (e. g. @octez-client@).
--
-- Tezos supports multiple cryptographic curves that are denoted by the
-- number after tz in the public key hash:
-- • tz1 — ed25519
-- • tz2 — secp256k1
-- • tz3 — P256
-- • tz4 — BLS12381
-- We have Morley.Tezos.Crypto.Curve module for each of these curves.
-- They expose very similar functionality and their main purpose is to hide
-- implementation details for each curve as well as some other specifics (e. g.
-- prefixes that are used for human-readable representation).
--
-- Additionally, Tezos uses b2b hashes to represent addresses of contracts
-- (using @KT1@ prefix) and transaction rollups (using @txr1@ prefix) -- these
-- hashes are also implemented here.
--
-- We do not support @txr1@ addresses as those are disabled on the mainnet.
--
-- This module serves two purposes:
-- 1. It is an umbrella module that re-exports some stuff from other modules.
-- 2. Michelson types such as @key@ and @signature@ may store primitive of any
-- curve, so we need "union" types in Haskell as well.
--
-- During conversion to human-readable representation usually some magical
-- prefix is used. They have been found in source code in some repos (e. g.
-- <https://gitlab.com/tezos/tezos/blob/c52ee69231c5ae4d9cec1f3c8aba0c3573922e2a/src/lib_crypto/base58.ml>)
-- and checked manually. Existing tests confirm they are correct.

{-# LANGUAGE DeriveLift #-}

module Morley.Tezos.Crypto
  ( -- * Cryptographic primitive types
    PublicKey (..)
  , SecretKey (..) -- Currently we need to differentiate secret keys in morley-client
  , Signature (..)
  , HashTag (..)
  , KeyHashTag
  , Hash (..)
  , HashKind (..)
  , KeyHash
  , ContractHash
  , SmartRollupHash
  , BLS12381.Bls12381Fr
  , BLS12381.Bls12381G1
  , BLS12381.Bls12381G2

  -- * Public/secret key functions
  , detSecretKey
  , detSecretKey'
  , KeyType(..)
  , keyTypeTag
  , publicKeyType
  , toPublic
  , publicKeyToBytes

  -- * Signature
  , signatureToBytes
  , mkSignature
  , parseSignatureRaw
  , signatureLengthBytes
  , checkSignature
  , sign

  -- * Formatting
  , CryptoParseError (..)
  , formatPublicKey
  , mformatPublicKey
  , parsePublicKey
  , parsePublicKeyRaw
  , formatSignature
  , mformatSignature
  , parseSignature
  , formatHash
  , mformatHash
  , parseHash
  , parseKeyHashRaw
  , hashLengthBytes
  , formatSecretKey
  , parseSecretKey
  , decodeKeyHash

  -- * Hashing
  , hashKey
  , blake2b
  , blake2b160
  , keccak
  , sha256
  , sha3
  , sha512

  -- * Timelock puzzle
  , Chest
  , ChestKey
  , OpeningResult(..)
  , TLTime(..)
  , openChest
  , mkTLTime
  , toTLTime

  -- * Utilities
  , encodeBase58Check
  , decodeBase58Check
  , B58CheckWithPrefixError (..)
  , decodeBase58CheckWithPrefix
  , parseSomeHashBase58
  , keyDecoders
  , keyHashDecoders
  , AllHashTags(..)
  ) where

import Control.Monad.Except (throwError)
import Crypto.Number.Serialize (os2ip)
import Crypto.Random (MonadRandom)
import Data.Aeson (FromJSON(..), FromJSONKey, ToJSON(..), ToJSONKey)
import Data.Aeson qualified as Aeson
import Data.Aeson.Encoding qualified as Aeson
import Data.Aeson.Types qualified as AesonTypes
import Data.Binary.Get qualified as Get
import Data.ByteArray qualified as BA
import Data.ByteString qualified as BS
import Data.ByteString.Lazy qualified as LBS
import Data.Some (Some(..), mapSome)
import Data.Text qualified as T
import Fmt (Buildable, build, hexF, pretty)
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)

import Morley.Michelson.Text
import Morley.Tezos.Crypto.BLS qualified as BLS
import Morley.Tezos.Crypto.BLS12381 qualified as BLS12381
import Morley.Tezos.Crypto.Ed25519 qualified as Ed25519
import Morley.Tezos.Crypto.Hash
import Morley.Tezos.Crypto.P256 qualified as P256
import Morley.Tezos.Crypto.Secp256k1 qualified as Secp256k1
import Morley.Tezos.Crypto.Timelock
  (Chest, ChestKey, OpeningResult(..), TLTime(..), mkTLTime, openChest, toTLTime)
import Morley.Tezos.Crypto.Util
import Morley.Util.Binary
import Morley.Util.CLI
import Morley.Util.TH (deriveGADTNFData)

----------------------------------------------------------------------------
-- Types, instances, conversions
----------------------------------------------------------------------------

-- | A kind of a hash.
data HashKind
  = HashKindPublicKey -- ^ Public key hash for @tz1@, @tz2@, @tz3@ addresses.
  | HashKindContract -- ^ Contract hash for @KT1@ smart contract addresses.
  | HashKindSmartRollup -- ^ Smart rollup hash for @sr1@ addresses.

-- | Type of public/secret key as enum.
data KeyType
  = KeyTypeEd25519
  | KeyTypeSecp256k1
  | KeyTypeP256
  | KeyTypeBLS
  deriving stock (Int -> KeyType -> ShowS
[KeyType] -> ShowS
KeyType -> String
(Int -> KeyType -> ShowS)
-> (KeyType -> String) -> ([KeyType] -> ShowS) -> Show KeyType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> KeyType -> ShowS
showsPrec :: Int -> KeyType -> ShowS
$cshow :: KeyType -> String
show :: KeyType -> String
$cshowList :: [KeyType] -> ShowS
showList :: [KeyType] -> ShowS
Show, KeyType -> KeyType -> Bool
(KeyType -> KeyType -> Bool)
-> (KeyType -> KeyType -> Bool) -> Eq KeyType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: KeyType -> KeyType -> Bool
== :: KeyType -> KeyType -> Bool
$c/= :: KeyType -> KeyType -> Bool
/= :: KeyType -> KeyType -> Bool
Eq, Int -> KeyType
KeyType -> Int
KeyType -> [KeyType]
KeyType -> KeyType
KeyType -> KeyType -> [KeyType]
KeyType -> KeyType -> KeyType -> [KeyType]
(KeyType -> KeyType)
-> (KeyType -> KeyType)
-> (Int -> KeyType)
-> (KeyType -> Int)
-> (KeyType -> [KeyType])
-> (KeyType -> KeyType -> [KeyType])
-> (KeyType -> KeyType -> [KeyType])
-> (KeyType -> KeyType -> KeyType -> [KeyType])
-> Enum KeyType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: KeyType -> KeyType
succ :: KeyType -> KeyType
$cpred :: KeyType -> KeyType
pred :: KeyType -> KeyType
$ctoEnum :: Int -> KeyType
toEnum :: Int -> KeyType
$cfromEnum :: KeyType -> Int
fromEnum :: KeyType -> Int
$cenumFrom :: KeyType -> [KeyType]
enumFrom :: KeyType -> [KeyType]
$cenumFromThen :: KeyType -> KeyType -> [KeyType]
enumFromThen :: KeyType -> KeyType -> [KeyType]
$cenumFromTo :: KeyType -> KeyType -> [KeyType]
enumFromTo :: KeyType -> KeyType -> [KeyType]
$cenumFromThenTo :: KeyType -> KeyType -> KeyType -> [KeyType]
enumFromThenTo :: KeyType -> KeyType -> KeyType -> [KeyType]
Enum, KeyType
KeyType -> KeyType -> Bounded KeyType
forall a. a -> a -> Bounded a
$cminBound :: KeyType
minBound :: KeyType
$cmaxBound :: KeyType
maxBound :: KeyType
Bounded, Eq KeyType
Eq KeyType
-> (KeyType -> KeyType -> Ordering)
-> (KeyType -> KeyType -> Bool)
-> (KeyType -> KeyType -> Bool)
-> (KeyType -> KeyType -> Bool)
-> (KeyType -> KeyType -> Bool)
-> (KeyType -> KeyType -> KeyType)
-> (KeyType -> KeyType -> KeyType)
-> Ord KeyType
KeyType -> KeyType -> Bool
KeyType -> KeyType -> Ordering
KeyType -> KeyType -> KeyType
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 :: KeyType -> KeyType -> Ordering
compare :: KeyType -> KeyType -> Ordering
$c< :: KeyType -> KeyType -> Bool
< :: KeyType -> KeyType -> Bool
$c<= :: KeyType -> KeyType -> Bool
<= :: KeyType -> KeyType -> Bool
$c> :: KeyType -> KeyType -> Bool
> :: KeyType -> KeyType -> Bool
$c>= :: KeyType -> KeyType -> Bool
>= :: KeyType -> KeyType -> Bool
$cmax :: KeyType -> KeyType -> KeyType
max :: KeyType -> KeyType -> KeyType
$cmin :: KeyType -> KeyType -> KeyType
min :: KeyType -> KeyType -> KeyType
Ord, (forall (m :: * -> *). Quote m => KeyType -> m Exp)
-> (forall (m :: * -> *). Quote m => KeyType -> Code m KeyType)
-> Lift KeyType
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => KeyType -> m Exp
forall (m :: * -> *). Quote m => KeyType -> Code m KeyType
$clift :: forall (m :: * -> *). Quote m => KeyType -> m Exp
lift :: forall (m :: * -> *). Quote m => KeyType -> m Exp
$cliftTyped :: forall (m :: * -> *). Quote m => KeyType -> Code m KeyType
liftTyped :: forall (m :: * -> *). Quote m => KeyType -> Code m KeyType
Lift, (forall x. KeyType -> Rep KeyType x)
-> (forall x. Rep KeyType x -> KeyType) -> Generic KeyType
forall x. Rep KeyType x -> KeyType
forall x. KeyType -> Rep KeyType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. KeyType -> Rep KeyType x
from :: forall x. KeyType -> Rep KeyType x
$cto :: forall x. Rep KeyType x -> KeyType
to :: forall x. Rep KeyType x -> KeyType
Generic)
  deriving anyclass KeyType -> ()
(KeyType -> ()) -> NFData KeyType
forall a. (a -> ()) -> NFData a
$crnf :: KeyType -> ()
rnf :: KeyType -> ()
NFData

instance Buildable KeyType where
  build :: KeyType -> Doc
build = \case
    KeyType
KeyTypeEd25519   -> Doc
"key Ed25519"
    KeyType
KeyTypeSecp256k1 -> Doc
"key Secp256k1"
    KeyType
KeyTypeP256      -> Doc
"key P256"
    KeyType
KeyTypeBLS       -> Doc
"key BLS"

-- | What specific type of hash is used for the 'Hash'.
data HashTag (kind :: HashKind) where
  HashKey :: KeyType -> HashTag 'HashKindPublicKey
  HashContract :: HashTag 'HashKindContract
  HashSR :: HashTag 'HashKindSmartRollup

deriving stock instance Show (HashTag kind)
deriving stock instance Eq (HashTag kind)
deriving stock instance Ord (HashTag kind)
deriving stock instance Lift (HashTag kind)

-- NB: these definitions are here and not below because TH scoping rules are annoying

deriveGADTNFData ''HashTag

-- | Public cryptographic key used by Tezos.
-- There are three cryptographic curves each represented by its own constructor.
data PublicKey
  = PublicKeyEd25519 Ed25519.PublicKey
  -- ^ Public key that uses the ed25519 cryptographic curve.
  | PublicKeySecp256k1 Secp256k1.PublicKey
  -- ^ Public key that uses the secp256k1 cryptographic curve.
  | PublicKeyP256 P256.PublicKey
  -- ^ Public key that uses the NIST P-256 cryptographic curve.
  | PublicKeyBLS BLS.PublicKey
  -- ^ Public key that uses the BLS12-381 cryptographic curve.
  deriving stock (Int -> PublicKey -> ShowS
[PublicKey] -> ShowS
PublicKey -> String
(Int -> PublicKey -> ShowS)
-> (PublicKey -> String)
-> ([PublicKey] -> ShowS)
-> Show PublicKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PublicKey -> ShowS
showsPrec :: Int -> PublicKey -> ShowS
$cshow :: PublicKey -> String
show :: PublicKey -> String
$cshowList :: [PublicKey] -> ShowS
showList :: [PublicKey] -> ShowS
Show, PublicKey -> PublicKey -> Bool
(PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool) -> Eq PublicKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PublicKey -> PublicKey -> Bool
== :: PublicKey -> PublicKey -> Bool
$c/= :: PublicKey -> PublicKey -> Bool
/= :: PublicKey -> PublicKey -> Bool
Eq, Eq PublicKey
Eq PublicKey
-> (PublicKey -> PublicKey -> Ordering)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> Bool)
-> (PublicKey -> PublicKey -> PublicKey)
-> (PublicKey -> PublicKey -> PublicKey)
-> Ord PublicKey
PublicKey -> PublicKey -> Bool
PublicKey -> PublicKey -> Ordering
PublicKey -> PublicKey -> PublicKey
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 :: PublicKey -> PublicKey -> Ordering
compare :: PublicKey -> PublicKey -> Ordering
$c< :: PublicKey -> PublicKey -> Bool
< :: PublicKey -> PublicKey -> Bool
$c<= :: PublicKey -> PublicKey -> Bool
<= :: PublicKey -> PublicKey -> Bool
$c> :: PublicKey -> PublicKey -> Bool
> :: PublicKey -> PublicKey -> Bool
$c>= :: PublicKey -> PublicKey -> Bool
>= :: PublicKey -> PublicKey -> Bool
$cmax :: PublicKey -> PublicKey -> PublicKey
max :: PublicKey -> PublicKey -> PublicKey
$cmin :: PublicKey -> PublicKey -> PublicKey
min :: PublicKey -> PublicKey -> PublicKey
Ord, (forall x. PublicKey -> Rep PublicKey x)
-> (forall x. Rep PublicKey x -> PublicKey) -> Generic PublicKey
forall x. Rep PublicKey x -> PublicKey
forall x. PublicKey -> Rep PublicKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PublicKey -> Rep PublicKey x
from :: forall x. PublicKey -> Rep PublicKey x
$cto :: forall x. Rep PublicKey x -> PublicKey
to :: forall x. Rep PublicKey x -> PublicKey
Generic)

instance NFData PublicKey

-- | Secret cryptographic key used by Tezos.
-- Constructors correspond to 'PublicKey' constructors.
data SecretKey
  = SecretKeyEd25519 Ed25519.SecretKey
  -- ^ Secret key that uses the ed25519 cryptographic curve.
  | SecretKeySecp256k1 Secp256k1.SecretKey
  -- ^ Secret key that uses the secp256k1 cryptographic curve.
  | SecretKeyP256 P256.SecretKey
  -- ^ Secret key that uses the NIST P-256 cryptographic curve.
  | SecretKeyBLS  BLS.SecretKey
  -- ^ Secret key that uses BLS12-381 curve.
  deriving stock (Int -> SecretKey -> ShowS
[SecretKey] -> ShowS
SecretKey -> String
(Int -> SecretKey -> ShowS)
-> (SecretKey -> String)
-> ([SecretKey] -> ShowS)
-> Show SecretKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SecretKey -> ShowS
showsPrec :: Int -> SecretKey -> ShowS
$cshow :: SecretKey -> String
show :: SecretKey -> String
$cshowList :: [SecretKey] -> ShowS
showList :: [SecretKey] -> ShowS
Show, SecretKey -> SecretKey -> Bool
(SecretKey -> SecretKey -> Bool)
-> (SecretKey -> SecretKey -> Bool) -> Eq SecretKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SecretKey -> SecretKey -> Bool
== :: SecretKey -> SecretKey -> Bool
$c/= :: SecretKey -> SecretKey -> Bool
/= :: SecretKey -> SecretKey -> Bool
Eq, (forall x. SecretKey -> Rep SecretKey x)
-> (forall x. Rep SecretKey x -> SecretKey) -> Generic SecretKey
forall x. Rep SecretKey x -> SecretKey
forall x. SecretKey -> Rep SecretKey x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. SecretKey -> Rep SecretKey x
from :: forall x. SecretKey -> Rep SecretKey x
$cto :: forall x. Rep SecretKey x -> SecretKey
to :: forall x. Rep SecretKey x -> SecretKey
Generic)

instance NFData SecretKey

instance HasCLReader SecretKey where
  getReader :: ReadM SecretKey
getReader = (String -> Either String SecretKey) -> ReadM SecretKey
forall a. (String -> Either String a) -> ReadM a
eitherReader ((CryptoParseError -> String)
-> Either CryptoParseError SecretKey -> Either String SecretKey
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CryptoParseError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty (Either CryptoParseError SecretKey -> Either String SecretKey)
-> (String -> Either CryptoParseError SecretKey)
-> String
-> Either String SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError SecretKey
parseSecretKey (Text -> Either CryptoParseError SecretKey)
-> (String -> Text) -> String -> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText)
  getMetavar :: String
getMetavar = String
"SECRET_KEY"

-- | Deterministically generate a secret key from seed. Key type is specified
-- explicitly.
detSecretKey' :: KeyType -> ByteString -> SecretKey
detSecretKey' :: KeyType -> ByteString -> SecretKey
detSecretKey' = \case
  KeyType
KeyTypeEd25519   -> SecretKey -> SecretKey
SecretKeyEd25519   (SecretKey -> SecretKey)
-> (ByteString -> SecretKey) -> ByteString -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SecretKey
Ed25519.detSecretKey
  KeyType
KeyTypeSecp256k1 -> SecretKey -> SecretKey
SecretKeySecp256k1 (SecretKey -> SecretKey)
-> (ByteString -> SecretKey) -> ByteString -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SecretKey
Secp256k1.detSecretKey
  KeyType
KeyTypeP256      -> SecretKey -> SecretKey
SecretKeyP256      (SecretKey -> SecretKey)
-> (ByteString -> SecretKey) -> ByteString -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SecretKey
P256.detSecretKey
  KeyType
KeyTypeBLS       -> SecretKey -> SecretKey
SecretKeyBLS       (SecretKey -> SecretKey)
-> (ByteString -> SecretKey) -> ByteString -> SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> SecretKey
BLS.detSecretKey

-- | Deterministically generate a secret key from seed. Type of the key depends
-- on seed value.
detSecretKey :: ByteString -> SecretKey
detSecretKey :: ByteString -> SecretKey
detSecretKey ByteString
seed = KeyType -> ByteString -> SecretKey
detSecretKey'
  (Int -> KeyType
forall a. Enum a => Int -> a
toEnum (Int -> KeyType) -> Int -> KeyType
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegralOverflowing (ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
seed) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` (KeyType -> Int
forall a. Enum a => a -> Int
fromEnum (KeyType
forall a. Bounded a => a
maxBound :: KeyType) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1))
  ByteString
seed

-- | Create a public key from a secret key.
toPublic :: SecretKey -> PublicKey
toPublic :: SecretKey -> PublicKey
toPublic = \case
  SecretKeyEd25519 SecretKey
sk -> PublicKey -> PublicKey
PublicKeyEd25519 (PublicKey -> PublicKey)
-> (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PublicKey
Ed25519.toPublic (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ SecretKey
sk
  SecretKeySecp256k1 SecretKey
sk -> PublicKey -> PublicKey
PublicKeySecp256k1 (PublicKey -> PublicKey)
-> (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PublicKey
Secp256k1.toPublic (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ SecretKey
sk
  SecretKeyP256 SecretKey
sk -> PublicKey -> PublicKey
PublicKeyP256 (PublicKey -> PublicKey)
-> (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PublicKey
P256.toPublic (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ SecretKey
sk
  SecretKeyBLS SecretKey
sk -> PublicKey -> PublicKey
PublicKeyBLS (PublicKey -> PublicKey)
-> (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PublicKey
BLS.toPublic (SecretKey -> PublicKey) -> SecretKey -> PublicKey
forall a b. (a -> b) -> a -> b
$ SecretKey
sk

-- | Cryptographic signatures used by Tezos.
-- Constructors correspond to 'PublicKey' constructors.
--
-- Tezos distinguishes signatures for different curves.
-- For instance, ed25519 signatures and secp256k1 signatures
-- are printed differently (have different prefix).
-- However, signatures are packed without information about the
-- curve. For this purpose there is a generic signature which
-- only stores bytes and doesn't carry information about the curve.
-- Apparently unpacking from bytes always produces such signature.
-- Unpacking from string produces a signature with curve information.
data Signature
  = SignatureEd25519 Ed25519.Signature
  -- ^ Signature that uses the ed25519 cryptographic curve.
  | SignatureSecp256k1 Secp256k1.Signature
  -- ^ Siganture that uses the secp256k1 cryptographic curve.
  | SignatureP256 P256.Signature
  -- ^ Signature that uses the NIST P-256 cryptographic curve.
  | SignatureBLS BLS.Signature
  -- ^ Signature that uses the BLS12-381 cryptographic curve.
  | SignatureGeneric ByteString
  -- ^ Generic signature for which curve is unknown.
  deriving stock (Int -> Signature -> ShowS
[Signature] -> ShowS
Signature -> String
(Int -> Signature -> ShowS)
-> (Signature -> String)
-> ([Signature] -> ShowS)
-> Show Signature
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Signature -> ShowS
showsPrec :: Int -> Signature -> ShowS
$cshow :: Signature -> String
show :: Signature -> String
$cshowList :: [Signature] -> ShowS
showList :: [Signature] -> ShowS
Show, (forall x. Signature -> Rep Signature x)
-> (forall x. Rep Signature x -> Signature) -> Generic Signature
forall x. Rep Signature x -> Signature
forall x. Signature -> Rep Signature x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Signature -> Rep Signature x
from :: forall x. Signature -> Rep Signature x
$cto :: forall x. Rep Signature x -> Signature
to :: forall x. Rep Signature x -> Signature
Generic)

instance NFData Signature

-- This instance slightly differs from the default one. If one
-- signature is generic and the other one is not, they still may be
-- equal if they have the same byte representation.
-- With default instance packing a signature and unpacking it would produce
-- a different (with respect to 'Eq') signature which is inconvenient.
instance Eq Signature where
  Signature
sig1 == :: Signature -> Signature -> Bool
== Signature
sig2 = case (Signature
sig1, Signature
sig2) of
    (SignatureGeneric ByteString
bytes1, Signature
_) -> ByteString
bytes1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== Signature -> ByteString
forall ba. ByteArray ba => Signature -> ba
signatureToBytes Signature
sig2
    (Signature
_, SignatureGeneric ByteString
bytes2) -> Signature -> ByteString
forall ba. ByteArray ba => Signature -> ba
signatureToBytes Signature
sig1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
bytes2

    (SignatureEd25519 Signature
s1, SignatureEd25519 Signature
s2) -> Signature
s1 Signature -> Signature -> Bool
forall a. Eq a => a -> a -> Bool
== Signature
s2
    (SignatureEd25519 {}, Signature
_) -> Bool
False

    (SignatureSecp256k1 Signature
s1, SignatureSecp256k1 Signature
s2) -> Signature
s1 Signature -> Signature -> Bool
forall a. Eq a => a -> a -> Bool
== Signature
s2
    (SignatureSecp256k1 {}, Signature
_) -> Bool
False

    (SignatureP256 Signature
s1, SignatureP256 Signature
s2) -> Signature
s1 Signature -> Signature -> Bool
forall a. Eq a => a -> a -> Bool
== Signature
s2
    (SignatureP256 {}, Signature
_) -> Bool
False

    (SignatureBLS Signature
s1, SignatureBLS Signature
s2) -> Signature
s1 Signature -> Signature -> Bool
forall a. Eq a => a -> a -> Bool
== Signature
s2
    (SignatureBLS {}, Signature
_) -> Bool
False

instance Ord Signature where
  compare :: Signature -> Signature -> Ordering
compare = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (ByteString -> ByteString -> Ordering)
-> (Signature -> ByteString) -> Signature -> Signature -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall ba. ByteArray ba => Signature -> ba
signatureToBytes @ByteString

----------------------------------------------------------------------------
-- Signature
----------------------------------------------------------------------------

-- | Convert a 'Signature' to raw bytes.
signatureToBytes :: BA.ByteArray ba => Signature -> ba
signatureToBytes :: forall ba. ByteArray ba => Signature -> ba
signatureToBytes = \case
  SignatureEd25519 Signature
sig -> Signature -> ba
forall ba. ByteArray ba => Signature -> ba
Ed25519.signatureToBytes Signature
sig
  SignatureSecp256k1 Signature
sig -> Signature -> ba
forall ba. ByteArray ba => Signature -> ba
Secp256k1.signatureToBytes Signature
sig
  SignatureP256 Signature
sig -> Signature -> ba
forall ba. ByteArray ba => Signature -> ba
P256.signatureToBytes Signature
sig
  SignatureBLS Signature
sig -> Signature -> ba
forall ba. ByteArray ba => Signature -> ba
BLS.signatureToBytes Signature
sig
  SignatureGeneric ByteString
bytes -> ByteString -> ba
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ByteString
bytes

-- | Make a 'Signature' from raw bytes.
-- Can return only 'SignatureGeneric' or 'SignatureBLS'
mkSignature :: BA.ByteArray ba => ba -> Maybe Signature
mkSignature :: forall ba. ByteArray ba => ba -> Maybe Signature
mkSignature ba
ba
  | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall n. (HasCallStack, Integral n) => n
signatureLengthBytes = Signature -> Maybe Signature
forall a. a -> Maybe a
Just (Signature -> Maybe Signature) -> Signature -> Maybe Signature
forall a b. (a -> b) -> a -> b
$ ByteString -> Signature
SignatureGeneric (ByteString -> Signature) -> ByteString -> Signature
forall a b. (a -> b) -> a -> b
$ ba -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
BA.convert ba
ba
  | Int
l Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall n. (Integral n, CheckIntSubType Int n) => n
BLS.signatureLengthBytes = Signature -> Signature
SignatureBLS (Signature -> Signature) -> Maybe Signature -> Maybe Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either CryptoParseError Signature -> Maybe Signature
forall l r. Either l r -> Maybe r
rightToMaybe (ba -> Either CryptoParseError Signature
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError Signature
BLS.mkSignature ba
ba)
  | Bool
otherwise = Maybe Signature
forall a. Maybe a
Nothing
  where
   l :: Int
l = ba -> Int
forall ba. ByteArrayAccess ba => ba -> Int
BA.length ba
ba

parseSignatureRaw :: ByteString -> Either ParseSignatureRawError Signature
parseSignatureRaw :: ByteString -> Either ParseSignatureRawError Signature
parseSignatureRaw ByteString
ba = ParseSignatureRawError
-> Maybe Signature -> Either ParseSignatureRawError Signature
forall l r. l -> Maybe r -> Either l r
maybeToRight (ByteString -> ParseSignatureRawError
ParseSignatureRawWrongSize ByteString
ba) (Maybe Signature -> Either ParseSignatureRawError Signature)
-> Maybe Signature -> Either ParseSignatureRawError Signature
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe Signature
forall ba. ByteArray ba => ba -> Maybe Signature
mkSignature ByteString
ba

data ParseSignatureRawError
  = ParseSignatureRawWrongSize ByteString
  deriving stock (ParseSignatureRawError -> ParseSignatureRawError -> Bool
(ParseSignatureRawError -> ParseSignatureRawError -> Bool)
-> (ParseSignatureRawError -> ParseSignatureRawError -> Bool)
-> Eq ParseSignatureRawError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseSignatureRawError -> ParseSignatureRawError -> Bool
== :: ParseSignatureRawError -> ParseSignatureRawError -> Bool
$c/= :: ParseSignatureRawError -> ParseSignatureRawError -> Bool
/= :: ParseSignatureRawError -> ParseSignatureRawError -> Bool
Eq, Int -> ParseSignatureRawError -> ShowS
[ParseSignatureRawError] -> ShowS
ParseSignatureRawError -> String
(Int -> ParseSignatureRawError -> ShowS)
-> (ParseSignatureRawError -> String)
-> ([ParseSignatureRawError] -> ShowS)
-> Show ParseSignatureRawError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParseSignatureRawError -> ShowS
showsPrec :: Int -> ParseSignatureRawError -> ShowS
$cshow :: ParseSignatureRawError -> String
show :: ParseSignatureRawError -> String
$cshowList :: [ParseSignatureRawError] -> ShowS
showList :: [ParseSignatureRawError] -> ShowS
Show, (forall x. ParseSignatureRawError -> Rep ParseSignatureRawError x)
-> (forall x.
    Rep ParseSignatureRawError x -> ParseSignatureRawError)
-> Generic ParseSignatureRawError
forall x. Rep ParseSignatureRawError x -> ParseSignatureRawError
forall x. ParseSignatureRawError -> Rep ParseSignatureRawError x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ParseSignatureRawError -> Rep ParseSignatureRawError x
from :: forall x. ParseSignatureRawError -> Rep ParseSignatureRawError x
$cto :: forall x. Rep ParseSignatureRawError x -> ParseSignatureRawError
to :: forall x. Rep ParseSignatureRawError x -> ParseSignatureRawError
Generic)

instance Buildable ParseSignatureRawError where
  build :: ParseSignatureRawError -> Doc
build =
    \case
      ParseSignatureRawWrongSize ByteString
ba -> Doc
"Given raw signature " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<>
        ByteString -> Doc
forall a. FormatAsHex a => a -> Doc
hexF ByteString
ba Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
" has invalid length " Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Int -> Doc
forall b a. (PrettyShow a, Show a, IsString b) => a -> b
show (ByteString -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length ByteString
ba)

-- Apparently Tezos relies on the fact that in all schemes signature
-- size is 64 bytes, so it also has generic signature and always reads
-- 64 bytes during unpack.
-- So we can have one 'signatureLengthBytes' and do not have to
-- distinguish between curves.
-- However, we still have such a check here just in case as a precaution.
signatureLengthBytes :: HasCallStack => Integral n => n
signatureLengthBytes :: forall n. (HasCallStack, Integral n) => n
signatureLengthBytes
  | (Element [Int] -> Bool) -> [Int] -> Bool
forall c b.
(Container c, BooleanMonoid b) =>
(Element c -> b) -> c -> b
all Int -> Bool
Element [Int] -> Bool
is64
    [ Int
forall n. (Integral n, CheckIntSubType Int n) => n
Ed25519.signatureLengthBytes
    , Int
forall n. (Integral n, CheckIntSubType Int n) => n
P256.signatureLengthBytes
    , Int
forall n. (Integral n, CheckIntSubType Int n) => n
Secp256k1.signatureLengthBytes
    ]
  = n
64
  | Bool
otherwise =
    Text -> n
forall a. HasCallStack => Text -> a
error Text
"Apparently our understanding of signatures in Tezos is broken"
  where
    is64 :: Int -> Bool
    is64 :: Int -> Bool
is64 = (Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
64)

genericSignatureTag :: ByteString
genericSignatureTag :: ByteString
genericSignatureTag = ByteString
"\004\130\043"

-- | Check that a sequence of bytes has been signed with a given key.
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature :: PublicKey -> Signature -> ByteString -> Bool
checkSignature PublicKey
pk0 Signature
sig0 ByteString
bytes =
  case (PublicKey
pk0, Signature
sig0) of
    (PublicKeyEd25519 PublicKey
pk, SignatureEd25519 Signature
sig) ->
      PublicKey -> Signature -> ByteString -> Bool
Ed25519.checkSignature PublicKey
pk Signature
sig ByteString
bytes
    (PublicKeySecp256k1 PublicKey
pk, SignatureSecp256k1 Signature
sig) ->
      PublicKey -> Signature -> ByteString -> Bool
Secp256k1.checkSignature PublicKey
pk Signature
sig ByteString
bytes
    (PublicKeyP256 PublicKey
pk, SignatureP256 Signature
sig) ->
      PublicKey -> Signature -> ByteString -> Bool
P256.checkSignature PublicKey
pk Signature
sig ByteString
bytes
    (PublicKeyBLS PublicKey
pk, SignatureBLS Signature
sig) ->
      PublicKey -> Signature -> ByteString -> Bool
BLS.checkSignature PublicKey
pk Signature
sig ByteString
bytes
    (PublicKeyEd25519 PublicKey
pk, SignatureGeneric ByteString
sBytes) ->
      case ByteString -> Either CryptoParseError Signature
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError Signature
Ed25519.mkSignature ByteString
sBytes of
        Right Signature
sig -> PublicKey -> Signature -> ByteString -> Bool
Ed25519.checkSignature PublicKey
pk Signature
sig ByteString
bytes
        Left CryptoParseError
_ -> Bool
False
    (PublicKeySecp256k1 PublicKey
pk, SignatureGeneric ByteString
sBytes) ->
      case ByteString -> Either CryptoParseError Signature
forall ba. ByteArray ba => ba -> Either CryptoParseError Signature
Secp256k1.mkSignature ByteString
sBytes of
        Right Signature
sig -> PublicKey -> Signature -> ByteString -> Bool
Secp256k1.checkSignature PublicKey
pk Signature
sig ByteString
bytes
        Left CryptoParseError
_ -> Bool
False
    (PublicKeyP256 PublicKey
pk, SignatureGeneric ByteString
sBytes) ->
      case ByteString -> Either CryptoParseError Signature
forall ba. ByteArray ba => ba -> Either CryptoParseError Signature
P256.mkSignature ByteString
sBytes of
        Right Signature
sig -> PublicKey -> Signature -> ByteString -> Bool
P256.checkSignature PublicKey
pk Signature
sig ByteString
bytes
        Left CryptoParseError
_ -> Bool
False
    (PublicKey, Signature)
_ -> Bool
False

sign :: MonadRandom m => SecretKey -> ByteString -> m Signature
sign :: forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
sign SecretKey
sk ByteString
bs =
  case SecretKey
sk of
    SecretKeyEd25519 SecretKey
sk'   -> Signature -> m Signature
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> m Signature) -> Signature -> m Signature
forall a b. (a -> b) -> a -> b
$ Signature -> Signature
SignatureEd25519 (Signature -> Signature) -> Signature -> Signature
forall a b. (a -> b) -> a -> b
$ SecretKey -> ByteString -> Signature
Ed25519.sign SecretKey
sk' ByteString
bs
    SecretKeySecp256k1 SecretKey
sk' -> Signature -> Signature
SignatureSecp256k1 (Signature -> Signature) -> m Signature -> m Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SecretKey -> ByteString -> m Signature
forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
Secp256k1.sign SecretKey
sk' ByteString
bs
    SecretKeyP256 SecretKey
sk'      -> Signature -> Signature
SignatureP256 (Signature -> Signature) -> m Signature -> m Signature
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SecretKey -> ByteString -> m Signature
forall (m :: * -> *).
MonadRandom m =>
SecretKey -> ByteString -> m Signature
P256.sign SecretKey
sk' ByteString
bs
    SecretKeyBLS SecretKey
sk'       -> Signature -> m Signature
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> m Signature) -> Signature -> m Signature
forall a b. (a -> b) -> a -> b
$ Signature -> Signature
SignatureBLS (Signature -> Signature) -> Signature -> Signature
forall a b. (a -> b) -> a -> b
$ SecretKey -> ByteString -> Signature
BLS.sign SecretKey
sk' ByteString
bs

----------------------------------------------------------------------------
-- Formatting
----------------------------------------------------------------------------

formatPublicKey :: PublicKey -> Text
formatPublicKey :: PublicKey -> Text
formatPublicKey = \case
  PublicKeyEd25519 PublicKey
pk -> PublicKey -> Text
Ed25519.formatPublicKey PublicKey
pk
  PublicKeySecp256k1 PublicKey
pk -> PublicKey -> Text
Secp256k1.formatPublicKey PublicKey
pk
  PublicKeyP256 PublicKey
pk -> PublicKey -> Text
P256.formatPublicKey PublicKey
pk
  PublicKeyBLS PublicKey
pk -> PublicKey -> Text
BLS.formatPublicKey PublicKey
pk

mformatPublicKey :: PublicKey -> MText
mformatPublicKey :: PublicKey -> MText
mformatPublicKey = Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (PublicKey -> Either Text MText) -> PublicKey -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> (PublicKey -> Text) -> PublicKey -> Either Text MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Text
formatPublicKey

instance Buildable PublicKey where
  build :: PublicKey -> Doc
build = Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (PublicKey -> Text) -> PublicKey -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Text
formatPublicKey

parsePublicKey :: Text -> Either CryptoParseError PublicKey
parsePublicKey :: Text -> Either CryptoParseError PublicKey
parsePublicKey Text
txt =
  NonEmpty (Either CryptoParseError PublicKey)
-> Either CryptoParseError PublicKey
forall e a. NonEmpty (Either e a) -> Either e a
firstRight (NonEmpty (Either CryptoParseError PublicKey)
 -> Either CryptoParseError PublicKey)
-> NonEmpty (Either CryptoParseError PublicKey)
-> Either CryptoParseError PublicKey
forall a b. (a -> b) -> a -> b
$ ((Text -> Either CryptoParseError PublicKey)
 -> Either CryptoParseError PublicKey)
-> NonEmpty (Text -> Either CryptoParseError PublicKey)
-> NonEmpty (Either CryptoParseError PublicKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Text -> Either CryptoParseError PublicKey)
-> Text -> Either CryptoParseError PublicKey
forall a b. (a -> b) -> a -> b
$ Text
txt)
    ( (PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey
-> Either CryptoParseError PublicKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> PublicKey
PublicKeyEd25519 (Either CryptoParseError PublicKey
 -> Either CryptoParseError PublicKey)
-> (Text -> Either CryptoParseError PublicKey)
-> Text
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError PublicKey
Ed25519.parsePublicKey (Text -> Either CryptoParseError PublicKey)
-> [Text -> Either CryptoParseError PublicKey]
-> NonEmpty (Text -> Either CryptoParseError PublicKey)
forall a. a -> [a] -> NonEmpty a
:|
    [ (PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey
-> Either CryptoParseError PublicKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> PublicKey
PublicKeySecp256k1 (Either CryptoParseError PublicKey
 -> Either CryptoParseError PublicKey)
-> (Text -> Either CryptoParseError PublicKey)
-> Text
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError PublicKey
Secp256k1.parsePublicKey
    , (PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey
-> Either CryptoParseError PublicKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> PublicKey
PublicKeyP256 (Either CryptoParseError PublicKey
 -> Either CryptoParseError PublicKey)
-> (Text -> Either CryptoParseError PublicKey)
-> Text
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError PublicKey
P256.parsePublicKey
    , (PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey
-> Either CryptoParseError PublicKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> PublicKey
PublicKeyBLS (Either CryptoParseError PublicKey
 -> Either CryptoParseError PublicKey)
-> (Text -> Either CryptoParseError PublicKey)
-> Text
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError PublicKey
BLS.parsePublicKey
    ])

parsePublicKeyRaw :: ByteString -> Either Text PublicKey
parsePublicKeyRaw :: ByteString -> Either Text PublicKey
parsePublicKeyRaw ByteString
ba = ((ByteString, ByteOffset, String) -> Text)
-> ((ByteString, ByteOffset, PublicKey) -> PublicKey)
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, PublicKey)
-> Either Text PublicKey
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> ((ByteString, ByteOffset, String) -> String)
-> (ByteString, ByteOffset, String)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String (ByteString, ByteOffset, String) String
-> (ByteString, ByteOffset, String) -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String (ByteString, ByteOffset, String) String
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (ByteString, ByteOffset, String)
  (ByteString, ByteOffset, String)
  String
  String
_3) (Getting PublicKey (ByteString, ByteOffset, PublicKey) PublicKey
-> (ByteString, ByteOffset, PublicKey) -> PublicKey
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting PublicKey (ByteString, ByteOffset, PublicKey) PublicKey
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (ByteString, ByteOffset, PublicKey)
  (ByteString, ByteOffset, PublicKey)
  PublicKey
  PublicKey
_3) (Either
   (ByteString, ByteOffset, String)
   (ByteString, ByteOffset, PublicKey)
 -> Either Text PublicKey)
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, PublicKey)
-> Either Text PublicKey
forall a b. (a -> b) -> a -> b
$
  Get PublicKey
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, PublicKey)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Get.runGetOrFail (String -> [TaggedDecoder PublicKey] -> Get PublicKey
forall a. String -> [TaggedDecoder a] -> Get a
decodeWithTag String
"key" [TaggedDecoder PublicKey]
keyDecoders) (ByteString -> ByteString
LBS.fromStrict ByteString
ba)

formatSignature :: Signature -> Text
formatSignature :: Signature -> Text
formatSignature = \case
  SignatureEd25519 Signature
sig -> Signature -> Text
Ed25519.formatSignature Signature
sig
  SignatureSecp256k1 Signature
sig -> Signature -> Text
Secp256k1.formatSignature Signature
sig
  SignatureP256 Signature
sig -> Signature -> Text
P256.formatSignature Signature
sig
  SignatureBLS Signature
sig -> Signature -> Text
BLS.formatSignature Signature
sig
  SignatureGeneric ByteString
sig -> ByteString -> ByteString -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl ByteString
genericSignatureTag ByteString
sig

mformatSignature :: Signature -> MText
mformatSignature :: Signature -> MText
mformatSignature = Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (Signature -> Either Text MText) -> Signature -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> (Signature -> Text) -> Signature -> Either Text MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
formatSignature

instance Buildable Signature where
  build :: Signature -> Doc
build = Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (Signature -> Text) -> Signature -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
formatSignature

parseSignature :: Text -> Either CryptoParseError Signature
parseSignature :: Text -> Either CryptoParseError Signature
parseSignature Text
txt =
  NonEmpty (Either CryptoParseError Signature)
-> Either CryptoParseError Signature
forall e a. NonEmpty (Either e a) -> Either e a
firstRight (NonEmpty (Either CryptoParseError Signature)
 -> Either CryptoParseError Signature)
-> NonEmpty (Either CryptoParseError Signature)
-> Either CryptoParseError Signature
forall a b. (a -> b) -> a -> b
$ ((Text -> Either CryptoParseError Signature)
 -> Either CryptoParseError Signature)
-> NonEmpty (Text -> Either CryptoParseError Signature)
-> NonEmpty (Either CryptoParseError Signature)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map ((Text -> Either CryptoParseError Signature)
-> Text -> Either CryptoParseError Signature
forall a b. (a -> b) -> a -> b
$ Text
txt)
    ( (Signature -> Signature)
-> Either CryptoParseError Signature
-> Either CryptoParseError Signature
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Signature -> Signature
SignatureEd25519 (Either CryptoParseError Signature
 -> Either CryptoParseError Signature)
-> (Text -> Either CryptoParseError Signature)
-> Text
-> Either CryptoParseError Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError Signature
Ed25519.parseSignature (Text -> Either CryptoParseError Signature)
-> [Text -> Either CryptoParseError Signature]
-> NonEmpty (Text -> Either CryptoParseError Signature)
forall a. a -> [a] -> NonEmpty a
:|
    [ (Signature -> Signature)
-> Either CryptoParseError Signature
-> Either CryptoParseError Signature
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Signature -> Signature
SignatureSecp256k1 (Either CryptoParseError Signature
 -> Either CryptoParseError Signature)
-> (Text -> Either CryptoParseError Signature)
-> Text
-> Either CryptoParseError Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError Signature
Secp256k1.parseSignature
    , (Signature -> Signature)
-> Either CryptoParseError Signature
-> Either CryptoParseError Signature
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Signature -> Signature
SignatureP256 (Either CryptoParseError Signature
 -> Either CryptoParseError Signature)
-> (Text -> Either CryptoParseError Signature)
-> Text
-> Either CryptoParseError Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError Signature
P256.parseSignature
    , (Signature -> Signature)
-> Either CryptoParseError Signature
-> Either CryptoParseError Signature
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Signature -> Signature
SignatureBLS (Either CryptoParseError Signature
 -> Either CryptoParseError Signature)
-> (Text -> Either CryptoParseError Signature)
-> Text
-> Either CryptoParseError Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError Signature
BLS.parseSignature
    , ByteString
-> (ByteString -> Either CryptoParseError Signature)
-> Text
-> Either CryptoParseError Signature
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl ByteString
genericSignatureTag (Signature -> Either CryptoParseError Signature
forall a. a -> Either CryptoParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Signature -> Either CryptoParseError Signature)
-> (ByteString -> Signature)
-> ByteString
-> Either CryptoParseError Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Signature
SignatureGeneric)
    ])

formatSecretKey :: SecretKey -> Text
formatSecretKey :: SecretKey -> Text
formatSecretKey SecretKey
key = Text
"unencrypted:" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> case SecretKey
key of
  SecretKeyEd25519 SecretKey
sig -> SecretKey -> Text
Ed25519.formatSecretKey SecretKey
sig
  SecretKeySecp256k1 SecretKey
sig -> SecretKey -> Text
Secp256k1.formatSecretKey SecretKey
sig
  SecretKeyP256 SecretKey
sig -> SecretKey -> Text
P256.formatSecretKey SecretKey
sig
  SecretKeyBLS SecretKey
sig -> SecretKey -> Text
BLS.formatSecretKey SecretKey
sig

instance Buildable SecretKey where
  build :: SecretKey -> Doc
build = Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (SecretKey -> Text) -> SecretKey -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> Text
formatSecretKey

-- | Parse __unencrypted__ secret key. It accepts formats containing
-- either with or without the @unecrypted@ prefix.
parseSecretKey :: Text -> Either CryptoParseError SecretKey
parseSecretKey :: Text -> Either CryptoParseError SecretKey
parseSecretKey Text
txt =
  NonEmpty (Either CryptoParseError SecretKey)
-> Either CryptoParseError SecretKey
forall e a. NonEmpty (Either e a) -> Either e a
firstRight (NonEmpty (Either CryptoParseError SecretKey)
 -> Either CryptoParseError SecretKey)
-> NonEmpty (Either CryptoParseError SecretKey)
-> Either CryptoParseError SecretKey
forall a b. (a -> b) -> a -> b
$ ((Text -> Either CryptoParseError SecretKey)
 -> Either CryptoParseError SecretKey)
-> NonEmpty (Text -> Either CryptoParseError SecretKey)
-> NonEmpty (Either CryptoParseError SecretKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map (\Text -> Either CryptoParseError SecretKey
f -> Text -> Either CryptoParseError SecretKey
f (Text -> Either CryptoParseError SecretKey)
-> Text -> Either CryptoParseError SecretKey
forall a b. (a -> b) -> a -> b
$ Text -> Text
removePrefix Text
txt)
    ( (SecretKey -> SecretKey)
-> Either CryptoParseError SecretKey
-> Either CryptoParseError SecretKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> SecretKey
SecretKeyEd25519 (Either CryptoParseError SecretKey
 -> Either CryptoParseError SecretKey)
-> (Text -> Either CryptoParseError SecretKey)
-> Text
-> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError SecretKey
Ed25519.parseSecretKey (Text -> Either CryptoParseError SecretKey)
-> [Text -> Either CryptoParseError SecretKey]
-> NonEmpty (Text -> Either CryptoParseError SecretKey)
forall a. a -> [a] -> NonEmpty a
:|
    [ (SecretKey -> SecretKey)
-> Either CryptoParseError SecretKey
-> Either CryptoParseError SecretKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> SecretKey
SecretKeySecp256k1 (Either CryptoParseError SecretKey
 -> Either CryptoParseError SecretKey)
-> (Text -> Either CryptoParseError SecretKey)
-> Text
-> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError SecretKey
Secp256k1.parseSecretKey
    , (SecretKey -> SecretKey)
-> Either CryptoParseError SecretKey
-> Either CryptoParseError SecretKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> SecretKey
SecretKeyP256 (Either CryptoParseError SecretKey
 -> Either CryptoParseError SecretKey)
-> (Text -> Either CryptoParseError SecretKey)
-> Text
-> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError SecretKey
P256.parseSecretKey
    , (SecretKey -> SecretKey)
-> Either CryptoParseError SecretKey
-> Either CryptoParseError SecretKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SecretKey -> SecretKey
SecretKeyBLS (Either CryptoParseError SecretKey
 -> Either CryptoParseError SecretKey)
-> (Text -> Either CryptoParseError SecretKey)
-> Text
-> Either CryptoParseError SecretKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError SecretKey
BLS.parseSecretKey
    ])
  where
    removePrefix :: Text -> Text
    removePrefix :: Text -> Text
removePrefix Text
input =
      let unencrypted :: Text
unencrypted = Text
"unencrypted:"
          (Text
prefix, Text
payload) = Int -> Text -> (Text, Text)
T.splitAt (Text -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length Text
unencrypted) Text
input
      in case Text
prefix Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
unencrypted of
        Bool
True -> Text
payload
        Bool
False -> Text
input

----------------------------------------------------------------------------
-- JSON encoding/decoding
----------------------------------------------------------------------------

-- If you ever need these instances for any particular 'PublicKey' or
-- 'Signature', you can define them in respective modules the same
-- way.

instance ToJSON PublicKey where
  toJSON :: PublicKey -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (PublicKey -> Text) -> PublicKey -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Text
formatPublicKey
  toEncoding :: PublicKey -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
Aeson.text (Text -> Encoding) -> (PublicKey -> Text) -> PublicKey -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PublicKey -> Text
formatPublicKey

instance FromJSON PublicKey where
  parseJSON :: Value -> Parser PublicKey
parseJSON =
    String -> (Text -> Parser PublicKey) -> Value -> Parser PublicKey
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"PublicKey" ((Text -> Parser PublicKey) -> Value -> Parser PublicKey)
-> (Text -> Parser PublicKey) -> Value -> Parser PublicKey
forall a b. (a -> b) -> a -> b
$
    (CryptoParseError -> Parser PublicKey)
-> (PublicKey -> Parser PublicKey)
-> Either CryptoParseError PublicKey
-> Parser PublicKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser PublicKey
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser PublicKey)
-> (CryptoParseError -> String)
-> CryptoParseError
-> Parser PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoParseError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty) PublicKey -> Parser PublicKey
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CryptoParseError PublicKey -> Parser PublicKey)
-> (Text -> Either CryptoParseError PublicKey)
-> Text
-> Parser PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError PublicKey
parsePublicKey

instance ToJSON Signature where
  toJSON :: Signature -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (Signature -> Text) -> Signature -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
formatSignature
  toEncoding :: Signature -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
Aeson.text (Text -> Encoding) -> (Signature -> Text) -> Signature -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Signature -> Text
formatSignature

instance FromJSON Signature where
  parseJSON :: Value -> Parser Signature
parseJSON =
    String -> (Text -> Parser Signature) -> Value -> Parser Signature
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Signature" ((Text -> Parser Signature) -> Value -> Parser Signature)
-> (Text -> Parser Signature) -> Value -> Parser Signature
forall a b. (a -> b) -> a -> b
$
    (CryptoParseError -> Parser Signature)
-> (Signature -> Parser Signature)
-> Either CryptoParseError Signature
-> Parser Signature
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser Signature
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Signature)
-> (CryptoParseError -> String)
-> CryptoParseError
-> Parser Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoParseError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty) Signature -> Parser Signature
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CryptoParseError Signature -> Parser Signature)
-> (Text -> Either CryptoParseError Signature)
-> Text
-> Parser Signature
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError Signature
parseSignature

instance ToJSON (Hash kind) where
  toJSON :: Hash kind -> Value
toJSON = Text -> Value
Aeson.String (Text -> Value) -> (Hash kind -> Text) -> Hash kind -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash kind -> Text
forall (kind :: HashKind). Hash kind -> Text
formatHash
  toEncoding :: Hash kind -> Encoding
toEncoding = Text -> Encoding
forall a. Text -> Encoding' a
Aeson.text (Text -> Encoding) -> (Hash kind -> Text) -> Hash kind -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash kind -> Text
forall (kind :: HashKind). Hash kind -> Text
formatHash

instance ToJSONKey (Hash kind) where
  toJSONKey :: ToJSONKeyFunction (Hash kind)
toJSONKey = (Hash kind -> Text) -> ToJSONKeyFunction (Hash kind)
forall a. (a -> Text) -> ToJSONKeyFunction a
AesonTypes.toJSONKeyText Hash kind -> Text
forall (kind :: HashKind). Hash kind -> Text
formatHash

instance AllHashTags kind => FromJSON (Hash kind) where
  parseJSON :: Value -> Parser (Hash kind)
parseJSON =
    String
-> (Text -> Parser (Hash kind)) -> Value -> Parser (Hash kind)
forall a. String -> (Text -> Parser a) -> Value -> Parser a
Aeson.withText String
"Hash" ((Text -> Parser (Hash kind)) -> Value -> Parser (Hash kind))
-> (Text -> Parser (Hash kind)) -> Value -> Parser (Hash kind)
forall a b. (a -> b) -> a -> b
$
    (CryptoParseError -> Parser (Hash kind))
-> (Hash kind -> Parser (Hash kind))
-> Either CryptoParseError (Hash kind)
-> Parser (Hash kind)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser (Hash kind)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Hash kind))
-> (CryptoParseError -> String)
-> CryptoParseError
-> Parser (Hash kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoParseError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty) Hash kind -> Parser (Hash kind)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CryptoParseError (Hash kind) -> Parser (Hash kind))
-> (Text -> Either CryptoParseError (Hash kind))
-> Text
-> Parser (Hash kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError (Hash kind)
forall (kind :: HashKind).
AllHashTags kind =>
Text -> Either CryptoParseError (Hash kind)
parseHash

instance AllHashTags kind => FromJSONKey (Hash kind) where
  fromJSONKey :: FromJSONKeyFunction (Hash kind)
fromJSONKey =
    (Text -> Parser (Hash kind)) -> FromJSONKeyFunction (Hash kind)
forall a. (Text -> Parser a) -> FromJSONKeyFunction a
AesonTypes.FromJSONKeyTextParser ((Text -> Parser (Hash kind)) -> FromJSONKeyFunction (Hash kind))
-> (Text -> Parser (Hash kind)) -> FromJSONKeyFunction (Hash kind)
forall a b. (a -> b) -> a -> b
$
    (CryptoParseError -> Parser (Hash kind))
-> (Hash kind -> Parser (Hash kind))
-> Either CryptoParseError (Hash kind)
-> Parser (Hash kind)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser (Hash kind)
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser (Hash kind))
-> (CryptoParseError -> String)
-> CryptoParseError
-> Parser (Hash kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CryptoParseError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty) Hash kind -> Parser (Hash kind)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either CryptoParseError (Hash kind) -> Parser (Hash kind))
-> (Text -> Either CryptoParseError (Hash kind))
-> Text
-> Parser (Hash kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError (Hash kind)
forall (kind :: HashKind).
AllHashTags kind =>
Text -> Either CryptoParseError (Hash kind)
parseHash

----------------------------------------------------------------------------
-- Hash
----------------------------------------------------------------------------

-- | A compatibility synonym for a public key hash tag.
type KeyHashTag = HashTag 'HashKindPublicKey

-- | List all 'HashTag's for a given 'HashKind'.
class AllHashTags kind where
  allHashTags :: NonEmpty (HashTag kind)

instance AllHashTags 'HashKindPublicKey where
  allHashTags :: NonEmpty (HashTag 'HashKindPublicKey)
allHashTags = KeyType -> HashTag 'HashKindPublicKey
HashKey (KeyType -> HashTag 'HashKindPublicKey)
-> NonEmpty KeyType -> NonEmpty (HashTag 'HashKindPublicKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> KeyType
forall a. Bounded a => a
minBound KeyType -> [KeyType] -> NonEmpty KeyType
forall a. a -> [a] -> NonEmpty a
:| [KeyType -> KeyType
forall a. Enum a => a -> a
succ KeyType
forall a. Bounded a => a
minBound .. KeyType
forall a. Bounded a => a
maxBound]

instance AllHashTags 'HashKindContract where
  allHashTags :: NonEmpty (HashTag 'HashKindContract)
allHashTags = HashTag 'HashKindContract -> NonEmpty (HashTag 'HashKindContract)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashTag 'HashKindContract
HashContract

instance AllHashTags 'HashKindSmartRollup where
  allHashTags :: NonEmpty (HashTag 'HashKindSmartRollup)
allHashTags = HashTag 'HashKindSmartRollup
-> NonEmpty (HashTag 'HashKindSmartRollup)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure HashTag 'HashKindSmartRollup
HashSR

-- | Blake2b_160 hash of something.
data Hash (kind :: HashKind) = Hash
  { forall (kind :: HashKind). Hash kind -> HashTag kind
hTag :: HashTag kind
  -- ^ Which kind of hash.
  , forall (kind :: HashKind). Hash kind -> ByteString
hBytes :: ByteString
  -- ^ Hash itself.
  } deriving stock (Int -> Hash kind -> ShowS
[Hash kind] -> ShowS
Hash kind -> String
(Int -> Hash kind -> ShowS)
-> (Hash kind -> String)
-> ([Hash kind] -> ShowS)
-> Show (Hash kind)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall (kind :: HashKind). Int -> Hash kind -> ShowS
forall (kind :: HashKind). [Hash kind] -> ShowS
forall (kind :: HashKind). Hash kind -> String
$cshowsPrec :: forall (kind :: HashKind). Int -> Hash kind -> ShowS
showsPrec :: Int -> Hash kind -> ShowS
$cshow :: forall (kind :: HashKind). Hash kind -> String
show :: Hash kind -> String
$cshowList :: forall (kind :: HashKind). [Hash kind] -> ShowS
showList :: [Hash kind] -> ShowS
Show, Hash kind -> Hash kind -> Bool
(Hash kind -> Hash kind -> Bool)
-> (Hash kind -> Hash kind -> Bool) -> Eq (Hash kind)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall (kind :: HashKind). Hash kind -> Hash kind -> Bool
$c== :: forall (kind :: HashKind). Hash kind -> Hash kind -> Bool
== :: Hash kind -> Hash kind -> Bool
$c/= :: forall (kind :: HashKind). Hash kind -> Hash kind -> Bool
/= :: Hash kind -> Hash kind -> Bool
Eq, Eq (Hash kind)
Eq (Hash kind)
-> (Hash kind -> Hash kind -> Ordering)
-> (Hash kind -> Hash kind -> Bool)
-> (Hash kind -> Hash kind -> Bool)
-> (Hash kind -> Hash kind -> Bool)
-> (Hash kind -> Hash kind -> Bool)
-> (Hash kind -> Hash kind -> Hash kind)
-> (Hash kind -> Hash kind -> Hash kind)
-> Ord (Hash kind)
Hash kind -> Hash kind -> Bool
Hash kind -> Hash kind -> Ordering
Hash kind -> Hash kind -> Hash kind
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 (kind :: HashKind). Eq (Hash kind)
forall (kind :: HashKind). Hash kind -> Hash kind -> Bool
forall (kind :: HashKind). Hash kind -> Hash kind -> Ordering
forall (kind :: HashKind). Hash kind -> Hash kind -> Hash kind
$ccompare :: forall (kind :: HashKind). Hash kind -> Hash kind -> Ordering
compare :: Hash kind -> Hash kind -> Ordering
$c< :: forall (kind :: HashKind). Hash kind -> Hash kind -> Bool
< :: Hash kind -> Hash kind -> Bool
$c<= :: forall (kind :: HashKind). Hash kind -> Hash kind -> Bool
<= :: Hash kind -> Hash kind -> Bool
$c> :: forall (kind :: HashKind). Hash kind -> Hash kind -> Bool
> :: Hash kind -> Hash kind -> Bool
$c>= :: forall (kind :: HashKind). Hash kind -> Hash kind -> Bool
>= :: Hash kind -> Hash kind -> Bool
$cmax :: forall (kind :: HashKind). Hash kind -> Hash kind -> Hash kind
max :: Hash kind -> Hash kind -> Hash kind
$cmin :: forall (kind :: HashKind). Hash kind -> Hash kind -> Hash kind
min :: Hash kind -> Hash kind -> Hash kind
Ord, (forall x. Hash kind -> Rep (Hash kind) x)
-> (forall x. Rep (Hash kind) x -> Hash kind)
-> Generic (Hash kind)
forall x. Rep (Hash kind) x -> Hash kind
forall x. Hash kind -> Rep (Hash kind) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (kind :: HashKind) x. Rep (Hash kind) x -> Hash kind
forall (kind :: HashKind) x. Hash kind -> Rep (Hash kind) x
$cfrom :: forall (kind :: HashKind) x. Hash kind -> Rep (Hash kind) x
from :: forall x. Hash kind -> Rep (Hash kind) x
$cto :: forall (kind :: HashKind) x. Rep (Hash kind) x -> Hash kind
to :: forall x. Rep (Hash kind) x -> Hash kind
Generic, (forall (m :: * -> *). Quote m => Hash kind -> m Exp)
-> (forall (m :: * -> *).
    Quote m =>
    Hash kind -> Code m (Hash kind))
-> Lift (Hash kind)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (kind :: HashKind) (m :: * -> *).
Quote m =>
Hash kind -> m Exp
forall (kind :: HashKind) (m :: * -> *).
Quote m =>
Hash kind -> Code m (Hash kind)
forall (m :: * -> *). Quote m => Hash kind -> m Exp
forall (m :: * -> *). Quote m => Hash kind -> Code m (Hash kind)
$clift :: forall (kind :: HashKind) (m :: * -> *).
Quote m =>
Hash kind -> m Exp
lift :: forall (m :: * -> *). Quote m => Hash kind -> m Exp
$cliftTyped :: forall (kind :: HashKind) (m :: * -> *).
Quote m =>
Hash kind -> Code m (Hash kind)
liftTyped :: forall (m :: * -> *). Quote m => Hash kind -> Code m (Hash kind)
Lift)

instance NFData (Hash kind)

-- | Convenience synonym for an on-chain public key hash.
type KeyHash = Hash 'HashKindPublicKey

-- | Convenience synonym for a contract hash.
type ContractHash = Hash 'HashKindContract

-- | Convenience synonym for a smart rollup hash.
type SmartRollupHash = Hash 'HashKindSmartRollup

-- | Length of a hash in bytes (only the hash itself, no tags, checksums
-- or anything).
hashLengthBytes :: Integral n => n
hashLengthBytes :: forall n. Integral n => n
hashLengthBytes = n
20

-- | Compute the b58check of a public key hash.
hashKey :: PublicKey -> KeyHash
hashKey :: PublicKey -> KeyHash
hashKey PublicKey
pk = HashTag 'HashKindPublicKey -> ByteString -> KeyHash
forall (kind :: HashKind). HashTag kind -> ByteString -> Hash kind
Hash (KeyType -> HashTag 'HashKindPublicKey
HashKey (PublicKey -> KeyType
publicKeyType PublicKey
pk)) (ByteString -> KeyHash) -> ByteString -> KeyHash
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
blake2b160 (ByteString -> ByteString) -> ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ PublicKey -> ByteString
publicKeyToBytes PublicKey
pk

publicKeyToBytes :: PublicKey -> ByteString
publicKeyToBytes :: PublicKey -> ByteString
publicKeyToBytes = \case
  PublicKeyEd25519 PublicKey
pk -> PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
Ed25519.publicKeyToBytes PublicKey
pk
  PublicKeySecp256k1 PublicKey
pk -> PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
Secp256k1.publicKeyToBytes PublicKey
pk
  PublicKeyP256 PublicKey
pk -> PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
P256.publicKeyToBytes PublicKey
pk
  PublicKeyBLS PublicKey
pk -> PublicKey -> ByteString
forall ba. ByteArray ba => PublicKey -> ba
BLS.publicKeyToBytes PublicKey
pk

mkPublicKey :: BA.ByteArray ba => KeyType -> ba -> Either CryptoParseError PublicKey
mkPublicKey :: forall ba.
ByteArray ba =>
KeyType -> ba -> Either CryptoParseError PublicKey
mkPublicKey = \case
  KeyType
KeyTypeEd25519   -> (PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey
-> Either CryptoParseError PublicKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> PublicKey
PublicKeyEd25519 (Either CryptoParseError PublicKey
 -> Either CryptoParseError PublicKey)
-> (ba -> Either CryptoParseError PublicKey)
-> ba
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ba -> Either CryptoParseError PublicKey
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError PublicKey
Ed25519.mkPublicKey
  KeyType
KeyTypeSecp256k1 -> (PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey
-> Either CryptoParseError PublicKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> PublicKey
PublicKeySecp256k1 (Either CryptoParseError PublicKey
 -> Either CryptoParseError PublicKey)
-> (ba -> Either CryptoParseError PublicKey)
-> ba
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ba -> Either CryptoParseError PublicKey
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError PublicKey
Secp256k1.mkPublicKey
  KeyType
KeyTypeP256      -> (PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey
-> Either CryptoParseError PublicKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> PublicKey
PublicKeyP256 (Either CryptoParseError PublicKey
 -> Either CryptoParseError PublicKey)
-> (ba -> Either CryptoParseError PublicKey)
-> ba
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ba -> Either CryptoParseError PublicKey
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError PublicKey
P256.mkPublicKey
  KeyType
KeyTypeBLS       -> (PublicKey -> PublicKey)
-> Either CryptoParseError PublicKey
-> Either CryptoParseError PublicKey
forall a b.
(a -> b) -> Either CryptoParseError a -> Either CryptoParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PublicKey -> PublicKey
PublicKeyBLS (Either CryptoParseError PublicKey
 -> Either CryptoParseError PublicKey)
-> (ba -> Either CryptoParseError PublicKey)
-> ba
-> Either CryptoParseError PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ba -> Either CryptoParseError PublicKey
forall ba.
ByteArrayAccess ba =>
ba -> Either CryptoParseError PublicKey
BLS.mkPublicKey

formatHash :: (Hash kind) -> Text
formatHash :: forall (kind :: HashKind). Hash kind -> Text
formatHash (Hash HashTag kind
tag ByteString
bytes) = ByteString -> ByteString -> Text
forall x. ByteArrayAccess x => ByteString -> x -> Text
formatImpl (HashTag kind -> ByteString
forall (kind :: HashKind). HashTag kind -> ByteString
hashTagBytes HashTag kind
tag) ByteString
bytes

mformatHash :: (Hash kind) -> MText
mformatHash :: forall (kind :: HashKind). Hash kind -> MText
mformatHash = Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (Hash kind -> Either Text MText) -> Hash kind -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> (Hash kind -> Text) -> Hash kind -> Either Text MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash kind -> Text
forall (kind :: HashKind). Hash kind -> Text
formatHash

instance Buildable (Hash kind) where
  build :: Hash kind -> Doc
build = Text -> Doc
forall a. Buildable a => a -> Doc
build (Text -> Doc) -> (Hash kind -> Text) -> Hash kind -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hash kind -> Text
forall (kind :: HashKind). Hash kind -> Text
formatHash

parseHash
  :: AllHashTags kind
  => Text
  -> Either CryptoParseError (Hash kind)
parseHash :: forall (kind :: HashKind).
AllHashTags kind =>
Text -> Either CryptoParseError (Hash kind)
parseHash Text
txt =
  let
    mkKeyHash :: HashTag kind -> ByteString -> Either CryptoParseError (Hash kind)
mkKeyHash HashTag kind
tag ByteString
bs =
      HashTag kind -> ByteString -> Hash kind
forall (kind :: HashKind). HashTag kind -> ByteString -> Hash kind
Hash HashTag kind
tag ByteString
bs Hash kind
-> Either CryptoParseError ()
-> Either CryptoParseError (Hash kind)
forall a b.
a -> Either CryptoParseError b -> Either CryptoParseError a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$
        Bool -> Either CryptoParseError () -> Either CryptoParseError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (ByteString -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall n. Integral n => n
hashLengthBytes)
        (CryptoParseError -> Either CryptoParseError ()
forall a b. a -> Either a b
Left (CryptoParseError -> Either CryptoParseError ())
-> CryptoParseError -> Either CryptoParseError ()
forall a b. (a -> b) -> a -> b
$ LText -> Int -> CryptoParseError
CryptoParseUnexpectedLength LText
"KeyHash" (ByteString -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length ByteString
bs))

    parse :: HashTag kind -> Either CryptoParseError (Hash kind)
    parse :: forall (kind :: HashKind).
HashTag kind -> Either CryptoParseError (Hash kind)
parse HashTag kind
tag = HashTag kind -> ByteString -> Either CryptoParseError (Hash kind)
forall {kind :: HashKind}.
HashTag kind -> ByteString -> Either CryptoParseError (Hash kind)
mkKeyHash HashTag kind
tag (ByteString -> Either CryptoParseError (Hash kind))
-> Either CryptoParseError ByteString
-> Either CryptoParseError (Hash kind)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString
-> (ByteString -> Either CryptoParseError ByteString)
-> Text
-> Either CryptoParseError ByteString
forall res.
ByteString
-> (ByteString -> Either CryptoParseError res)
-> Text
-> Either CryptoParseError res
parseImpl (HashTag kind -> ByteString
forall (kind :: HashKind). HashTag kind -> ByteString
hashTagBytes HashTag kind
tag) ByteString -> Either CryptoParseError ByteString
forall a. a -> Either CryptoParseError a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
txt

  in NonEmpty (Either CryptoParseError (Hash kind))
-> Either CryptoParseError (Hash kind)
forall e a. NonEmpty (Either e a) -> Either e a
firstRight (NonEmpty (Either CryptoParseError (Hash kind))
 -> Either CryptoParseError (Hash kind))
-> NonEmpty (Either CryptoParseError (Hash kind))
-> Either CryptoParseError (Hash kind)
forall a b. (a -> b) -> a -> b
$ (HashTag kind -> Either CryptoParseError (Hash kind))
-> NonEmpty (HashTag kind)
-> NonEmpty (Either CryptoParseError (Hash kind))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
map HashTag kind -> Either CryptoParseError (Hash kind)
forall (kind :: HashKind).
HashTag kind -> Either CryptoParseError (Hash kind)
parse NonEmpty (HashTag kind)
forall (kind :: HashKind).
AllHashTags kind =>
NonEmpty (HashTag kind)
allHashTags

-- | Parse a 'Hash' of any known kind from its its human-readable textual representation.
parseSomeHashBase58 :: Text -> Either CryptoParseError (Some Hash)
parseSomeHashBase58 :: Text -> Either CryptoParseError (Some Hash)
parseSomeHashBase58 = Either CryptoParseError (Some Hash)
-> (ByteString -> Either CryptoParseError (Some Hash))
-> Maybe ByteString
-> Either CryptoParseError (Some Hash)
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (CryptoParseError -> Either CryptoParseError (Some Hash)
forall a b. a -> Either a b
Left CryptoParseError
CryptoParseWrongBase58Check) ByteString -> Either CryptoParseError (Some Hash)
parseSomeHash (Maybe ByteString -> Either CryptoParseError (Some Hash))
-> (Text -> Maybe ByteString)
-> Text
-> Either CryptoParseError (Some Hash)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  Text -> Maybe ByteString
decodeBase58Check

parseSomeHash :: ByteString -> Either CryptoParseError (Some Hash)
parseSomeHash :: ByteString -> Either CryptoParseError (Some Hash)
parseSomeHash ByteString
a = do
  (Some HashTag
sometag, ByteString
bs) <- ByteString -> Either CryptoParseError (Some HashTag, ByteString)
parseSomeHashTag ByteString
a
  Bool -> Either CryptoParseError () -> Either CryptoParseError ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
forall n. Integral n => n
hashLengthBytes) (Either CryptoParseError () -> Either CryptoParseError ())
-> Either CryptoParseError () -> Either CryptoParseError ()
forall a b. (a -> b) -> a -> b
$
    CryptoParseError -> Either CryptoParseError ()
forall a b. a -> Either a b
Left (LText -> Int -> CryptoParseError
CryptoParseUnexpectedLength LText
"KeyHash" (ByteString -> Int
forall i a.
(Integral i, Container a,
 DefaultToInt (IsIntSubType Length i) i) =>
a -> i
length ByteString
bs))
  return $ (forall (t :: HashKind). HashTag t -> Hash t)
-> Some HashTag -> Some Hash
forall {k} (f :: k -> *) (g :: k -> *).
(forall (t :: k). f t -> g t) -> Some f -> Some g
mapSome ((HashTag t -> ByteString -> Hash t)
-> ByteString -> HashTag t -> Hash t
forall a b c. (a -> b -> c) -> b -> a -> c
flip HashTag t -> ByteString -> Hash t
forall (kind :: HashKind). HashTag kind -> ByteString -> Hash kind
Hash ByteString
bs) Some HashTag
sometag

parseKeyHashHelper
  :: Int
  -> LText
  -> ExceptT CryptoParseError Get.Get a
  -> ByteString
  -> Either CryptoParseError a
parseKeyHashHelper :: forall a.
Int
-> LText
-> ExceptT CryptoParseError Get a
-> ByteString
-> Either CryptoParseError a
parseKeyHashHelper Int
expectedLength LText
name ExceptT CryptoParseError Get a
decoder ByteString
ba
  | ByteString -> Int
BS.length ByteString
ba Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
expectedLength
  = CryptoParseError -> Either CryptoParseError a
forall a b. a -> Either a b
Left (CryptoParseError -> Either CryptoParseError a)
-> CryptoParseError -> Either CryptoParseError a
forall a b. (a -> b) -> a -> b
$ LText -> Int -> CryptoParseError
CryptoParseUnexpectedLength LText
name (ByteString -> Int
BS.length ByteString
ba)
  | Bool
otherwise
  = ((ByteString, ByteOffset, String) -> Either CryptoParseError a)
-> ((ByteString, ByteOffset, Either CryptoParseError a)
    -> Either CryptoParseError a)
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, Either CryptoParseError a)
-> Either CryptoParseError a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (CryptoParseError -> Either CryptoParseError a
forall a b. a -> Either a b
Left (CryptoParseError -> Either CryptoParseError a)
-> ((ByteString, ByteOffset, String) -> CryptoParseError)
-> (ByteString, ByteOffset, String)
-> Either CryptoParseError a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CryptoParseError
CryptoParseBinaryError (Text -> CryptoParseError)
-> ((ByteString, ByteOffset, String) -> Text)
-> (ByteString, ByteOffset, String)
-> CryptoParseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText (String -> Text)
-> ((ByteString, ByteOffset, String) -> String)
-> (ByteString, ByteOffset, String)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting String (ByteString, ByteOffset, String) String
-> (ByteString, ByteOffset, String) -> String
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting String (ByteString, ByteOffset, String) String
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (ByteString, ByteOffset, String)
  (ByteString, ByteOffset, String)
  String
  String
_3) (Getting
  (Either CryptoParseError a)
  (ByteString, ByteOffset, Either CryptoParseError a)
  (Either CryptoParseError a)
-> (ByteString, ByteOffset, Either CryptoParseError a)
-> Either CryptoParseError a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting
  (Either CryptoParseError a)
  (ByteString, ByteOffset, Either CryptoParseError a)
  (Either CryptoParseError a)
forall s t a b. Field3 s t a b => Lens s t a b
Lens
  (ByteString, ByteOffset, Either CryptoParseError a)
  (ByteString, ByteOffset, Either CryptoParseError a)
  (Either CryptoParseError a)
  (Either CryptoParseError a)
_3)
  (Either
   (ByteString, ByteOffset, String)
   (ByteString, ByteOffset, Either CryptoParseError a)
 -> Either CryptoParseError a)
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, Either CryptoParseError a)
-> Either CryptoParseError a
forall a b. (a -> b) -> a -> b
$ (Get (Either CryptoParseError a)
 -> ByteString
 -> Either
      (ByteString, ByteOffset, String)
      (ByteString, ByteOffset, Either CryptoParseError a))
-> ByteString
-> Get (Either CryptoParseError a)
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, Either CryptoParseError a)
forall a b c. (a -> b -> c) -> b -> a -> c
flip Get (Either CryptoParseError a)
-> ByteString
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, Either CryptoParseError a)
forall a.
Get a
-> ByteString
-> Either
     (ByteString, ByteOffset, String) (ByteString, ByteOffset, a)
Get.runGetOrFail (ByteString -> ByteString
LBS.fromStrict ByteString
ba) (Get (Either CryptoParseError a)
 -> Either
      (ByteString, ByteOffset, String)
      (ByteString, ByteOffset, Either CryptoParseError a))
-> Get (Either CryptoParseError a)
-> Either
     (ByteString, ByteOffset, String)
     (ByteString, ByteOffset, Either CryptoParseError a)
forall a b. (a -> b) -> a -> b
$ ExceptT CryptoParseError Get a -> Get (Either CryptoParseError a)
forall e (m :: * -> *) a. ExceptT e m a -> m (Either e a)
runExceptT ExceptT CryptoParseError Get a
decoder

parseKeyHashRaw :: ByteString -> Either CryptoParseError KeyHash
parseKeyHashRaw :: ByteString -> Either CryptoParseError KeyHash
parseKeyHashRaw = Int
-> LText
-> ExceptT CryptoParseError Get KeyHash
-> ByteString
-> Either CryptoParseError KeyHash
forall a.
Int
-> LText
-> ExceptT CryptoParseError Get a
-> ByteString
-> Either CryptoParseError a
parseKeyHashHelper (Int
forall n. Integral n => n
hashLengthBytes Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) LText
"key_hash" ExceptT CryptoParseError Get KeyHash
decodeKeyHash

-- | Magic constants used by Tezos to encode hashes with proper prefixes.
hashTagBytes :: HashTag kind -> ByteString
hashTagBytes :: forall (kind :: HashKind). HashTag kind -> ByteString
hashTagBytes =
  \case
    HashKey KeyType
KeyTypeEd25519 -> ByteString
"\006\161\159" -- tz1
    -- https://gitlab.com/tezos/tezos/-/blob/0ca82c9dc361a6f223e81221c86bdb95d1a8d91c/src/lib_crypto/base58.ml#L379
    HashKey KeyType
KeyTypeSecp256k1 -> ByteString
"\006\161\161" -- tz2
    -- https://gitlab.com/tezos/tezos/-/blob/0ca82c9dc361a6f223e81221c86bdb95d1a8d91c/src/lib_crypto/base58.ml#L381
    HashKey KeyType
KeyTypeP256 -> ByteString
"\006\161\164" -- tz3
    -- https://gitlab.com/tezos/tezos/-/blob/0ca82c9dc361a6f223e81221c86bdb95d1a8d91c/src/lib_crypto/base58.ml#L383
    HashKey KeyType
KeyTypeBLS -> ByteString
"\006\161\166" -- tz4
    -- https://gitlab.com/tezos/tezos/-/blob/4b0dd9e9715ce82ac6429571d8843ab681522daf/src/lib_crypto/base58.ml#L371
    HashTag kind
HashContract -> ByteString
"\2\90\121" -- KT1
    -- https://gitlab.com/tezos/tezos/-/blob/0ca82c9dc361a6f223e81221c86bdb95d1a8d91c/src/proto_alpha/lib_protocol/contract_hash.ml#L27
    HashTag kind
HashSR -> ByteString
"\006\124\117" -- sr1
    -- https://gitlab.com/tezos/tezos/-/blob/f7f6047237974ef85d94c87368f2a82615bcc8ca/src/proto_016_PtMumbai/lib_protocol/sc_rollup_repr.ml#L33

parseSomeHashTag :: ByteString -> Either CryptoParseError (Some HashTag, ByteString)
parseSomeHashTag :: ByteString -> Either CryptoParseError (Some HashTag, ByteString)
parseSomeHashTag ByteString
bs = CryptoParseError
-> Maybe (Some HashTag, ByteString)
-> Either CryptoParseError (Some HashTag, ByteString)
forall l r. l -> Maybe r -> Either l r
maybeToRight CryptoParseError
failHash (Maybe (Some HashTag, ByteString)
 -> Either CryptoParseError (Some HashTag, ByteString))
-> Maybe (Some HashTag, ByteString)
-> Either CryptoParseError (Some HashTag, ByteString)
forall a b. (a -> b) -> a -> b
$ [Maybe (Some HashTag, ByteString)]
-> Maybe (Some HashTag, ByteString)
forall t (f :: * -> *) a.
(Container t, Alternative f, Element t ~ f a) =>
t -> f a
asum
  [ HashTag 'HashKindPublicKey -> Maybe (Some HashTag, ByteString)
forall (kind :: HashKind).
HashTag kind -> Maybe (Some HashTag, ByteString)
tryHash (KeyType -> HashTag 'HashKindPublicKey
HashKey KeyType
KeyTypeEd25519)
  , HashTag 'HashKindPublicKey -> Maybe (Some HashTag, ByteString)
forall (kind :: HashKind).
HashTag kind -> Maybe (Some HashTag, ByteString)
tryHash (KeyType -> HashTag 'HashKindPublicKey
HashKey KeyType
KeyTypeSecp256k1)
  , HashTag 'HashKindPublicKey -> Maybe (Some HashTag, ByteString)
forall (kind :: HashKind).
HashTag kind -> Maybe (Some HashTag, ByteString)
tryHash (KeyType -> HashTag 'HashKindPublicKey
HashKey KeyType
KeyTypeP256)
  , HashTag 'HashKindPublicKey -> Maybe (Some HashTag, ByteString)
forall (kind :: HashKind).
HashTag kind -> Maybe (Some HashTag, ByteString)
tryHash (KeyType -> HashTag 'HashKindPublicKey
HashKey KeyType
KeyTypeBLS)
  , HashTag 'HashKindContract -> Maybe (Some HashTag, ByteString)
forall (kind :: HashKind).
HashTag kind -> Maybe (Some HashTag, ByteString)
tryHash HashTag 'HashKindContract
HashContract
  , HashTag 'HashKindSmartRollup -> Maybe (Some HashTag, ByteString)
forall (kind :: HashKind).
HashTag kind -> Maybe (Some HashTag, ByteString)
tryHash HashTag 'HashKindSmartRollup
HashSR
  ]
  where
    tryHash :: HashTag kind -> Maybe (Some HashTag, ByteString)
    tryHash :: forall (kind :: HashKind).
HashTag kind -> Maybe (Some HashTag, ByteString)
tryHash HashTag kind
hashKind = (HashTag kind -> Some HashTag
forall {k} (tag :: k -> *) (a :: k). tag a -> Some tag
Some HashTag kind
hashKind,) (ByteString -> (Some HashTag, ByteString))
-> Maybe ByteString -> Maybe (Some HashTag, ByteString)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> ByteString -> Maybe ByteString
BS.stripPrefix (HashTag kind -> ByteString
forall (kind :: HashKind). HashTag kind -> ByteString
hashTagBytes HashTag kind
hashKind) ByteString
bs

    hashTXR :: ByteString
hashTXR = ByteString
"\001\128\120\031" -- txr1
    -- https://gitlab.com/tezos/tezos/-/blob/0ca82c9dc361a6f223e81221c86bdb95d1a8d91c/src/proto_014_PtKathma/lib_protocol/tx_rollup_prefixes.ml#L35

    failHash :: CryptoParseError
    failHash :: CryptoParseError
failHash
      | ByteString
hashTXR ByteString -> ByteString -> Bool
`BS.isPrefixOf` ByteString
bs = LText -> ByteString -> CryptoParseError
CryptoParseUnsupportedTag LText
"txr1" ByteString
bs
      | Bool
otherwise = ByteString -> CryptoParseError
CryptoParseWrongTag ByteString
bs

instance AllHashTags kind => HasCLReader (Hash kind) where
  getReader :: ReadM (Hash kind)
getReader = (String -> Either String (Hash kind)) -> ReadM (Hash kind)
forall a. (String -> Either String a) -> ReadM a
eitherReader ((CryptoParseError -> String)
-> Either CryptoParseError (Hash kind) -> Either String (Hash kind)
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first CryptoParseError -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty (Either CryptoParseError (Hash kind) -> Either String (Hash kind))
-> (String -> Either CryptoParseError (Hash kind))
-> String
-> Either String (Hash kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either CryptoParseError (Hash kind)
forall (kind :: HashKind).
AllHashTags kind =>
Text -> Either CryptoParseError (Hash kind)
parseHash (Text -> Either CryptoParseError (Hash kind))
-> (String -> Text)
-> String
-> Either CryptoParseError (Hash kind)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. ToText a => a -> Text
toText)
  getMetavar :: String
getMetavar = String
"KEY_HASH"

keyTypeTag :: KeyType -> Word8
keyTypeTag :: KeyType -> Word8
keyTypeTag = \case
  KeyType
KeyTypeEd25519   -> Word8
0x00
  KeyType
KeyTypeSecp256k1 -> Word8
0x01
  KeyType
KeyTypeP256      -> Word8
0x02
  KeyType
KeyTypeBLS       -> Word8
0x03

publicKeyType :: PublicKey -> KeyType
publicKeyType :: PublicKey -> KeyType
publicKeyType = \case
  PublicKeyEd25519{}   -> KeyType
KeyTypeEd25519
  PublicKeySecp256k1{} -> KeyType
KeyTypeSecp256k1
  PublicKeyP256{}      -> KeyType
KeyTypeP256
  PublicKeyBLS{}       -> KeyType
KeyTypeBLS

keyDecoders :: [TaggedDecoder PublicKey]
keyDecoders :: [TaggedDecoder PublicKey]
keyDecoders = [KeyType
forall a. Bounded a => a
minBound..] [KeyType]
-> (KeyType -> TaggedDecoder PublicKey)
-> [TaggedDecoder PublicKey]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> KeyType -> TaggedDecoder PublicKey
mkKeyParser
  where
    mkKeyParser :: KeyType -> TaggedDecoder PublicKey
mkKeyParser KeyType
x = KeyType -> Word8
keyTypeTag KeyType
x Word8 -> Get PublicKey -> TaggedDecoder PublicKey
forall a. Word8 -> Get a -> TaggedDecoder a
#: String
-> (ByteString -> Either CryptoParseError PublicKey)
-> Get PublicKey
forall err a.
Buildable err =>
String -> (ByteString -> Either err a) -> Get a
decodeBytesLike (KeyType -> String
forall a b. (Buildable a, FromDoc b) => a -> b
pretty KeyType
x) (KeyType -> ByteString -> Either CryptoParseError PublicKey
forall ba.
ByteArray ba =>
KeyType -> ba -> Either CryptoParseError PublicKey
mkPublicKey KeyType
x)

keyHashDecoders :: (Monad (t Get.Get), MonadTrans t) => [TaggedDecoderM t KeyHash]
keyHashDecoders :: forall (t :: (* -> *) -> * -> *).
(Monad (t Get), MonadTrans t) =>
[TaggedDecoderM t KeyHash]
keyHashDecoders = [KeyType
forall a. Bounded a => a
minBound..] [KeyType]
-> (KeyType -> TaggedDecoderM t KeyHash)
-> [TaggedDecoderM t KeyHash]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> KeyType -> TaggedDecoderM t KeyHash
mkKeyHashParser
  where
    mkKeyHashParser :: KeyType -> TaggedDecoderM t KeyHash
mkKeyHashParser KeyType
kt = KeyType -> Word8
keyTypeTag KeyType
kt Word8 -> t Get KeyHash -> TaggedDecoderM t KeyHash
forall {k} (t :: (* -> *) -> k -> *) (a :: k).
Word8 -> t Get a -> TaggedDecoderM t a
##: HashTag 'HashKindPublicKey -> ByteString -> KeyHash
forall (kind :: HashKind). HashTag kind -> ByteString -> Hash kind
Hash (KeyType -> HashTag 'HashKindPublicKey
HashKey KeyType
kt) (ByteString -> KeyHash) -> t Get ByteString -> t Get KeyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t Get ByteString
getPayload
    getPayload :: t Get ByteString
getPayload = Get ByteString -> t Get ByteString
forall (m :: * -> *) a. Monad m => m a -> t m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (Get ByteString -> t Get ByteString)
-> Get ByteString -> t Get ByteString
forall a b. (a -> b) -> a -> b
$ Int -> Get ByteString
getByteStringCopy Int
forall n. Integral n => n
hashLengthBytes

decodeKeyHash :: ExceptT CryptoParseError Get.Get KeyHash
decodeKeyHash :: ExceptT CryptoParseError Get KeyHash
decodeKeyHash =
  String
-> (Word8 -> ExceptT CryptoParseError Get KeyHash)
-> [TaggedDecoderM (ExceptT CryptoParseError) KeyHash]
-> ExceptT CryptoParseError Get KeyHash
forall (t :: (* -> *) -> * -> *) a.
(MonadTrans t, Monad (t Get)) =>
String -> (Word8 -> t Get a) -> [TaggedDecoderM t a] -> t Get a
decodeWithTagM String
"key_hash" (CryptoParseError -> ExceptT CryptoParseError Get KeyHash
forall a. CryptoParseError -> ExceptT CryptoParseError Get a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (CryptoParseError -> ExceptT CryptoParseError Get KeyHash)
-> (Word8 -> CryptoParseError)
-> Word8
-> ExceptT CryptoParseError Get KeyHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> CryptoParseError
CryptoParseWrongTag (ByteString -> CryptoParseError)
-> (Word8 -> ByteString) -> Word8 -> CryptoParseError
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> ByteString
BS.singleton) [TaggedDecoderM (ExceptT CryptoParseError) KeyHash]
forall (t :: (* -> *) -> * -> *).
(Monad (t Get), MonadTrans t) =>
[TaggedDecoderM t KeyHash]
keyHashDecoders