{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# OPTIONS_GHC -Wno-partial-fields #-}

module Cardano.Wasm.Api.Wallet
  ( WalletObject (..)
  , generatePaymentWalletImpl
  , generateStakeWalletImpl
  , restorePaymentWalletFromSigningKeyBech32Impl
  , restoreStakeWalletFromSigningKeyBech32Impl
  , generateTestnetPaymentWalletImpl
  , generateTestnetStakeWalletImpl
  , restoreTestnetPaymentWalletFromSigningKeyBech32Impl
  , restoreTestnetStakeWalletFromSigningKeyBech32Impl
  , getAddressBech32Impl
  , getBech32ForPaymentVerificationKeyImpl
  , getBech32ForPaymentSigningKeyImpl
  , getBech32ForStakeVerificationKeyImpl
  , getBech32ForStakeSigningKeyImpl
  , getBase16ForPaymentVerificationKeyHashImpl
  , getBase16ForStakeVerificationKeyHashImpl
  )
where

import Cardano.Api
  ( AsType (AsPaymentKey, AsStakeKey)
  , FromJSON
  , Key (..)
  , NetworkId (..)
  , NetworkMagic (..)
  , PaymentCredential (..)
  , PaymentKey
  , StakeAddressReference (..)
  , StakeKey
  , ToJSON
  , deserialiseFromBech32
  , deserialiseFromRawBytesHex
  , deterministicSigningKey
  , fromNetworkMagic
  , makeShelleyAddress
  , serialiseAddress
  , serialiseToBech32
  , serialiseToRawBytesHex
  , toNetworkMagic
  )
import Cardano.Api.Address (StakeCredential (..))

import Cardano.Crypto.Seed (mkSeedFromBytes)
import Cardano.Wasm.ExceptionHandling (rightOrError, toMonadFail)
import Cardano.Wasm.Internal.Api.Random (getRandomBytes)

import Data.Aeson ((.=))
import Data.Aeson qualified as Aeson
import Data.Aeson.Types qualified as Aeson
import Data.Text (Text)
import Data.Text qualified as Text
import Data.Text.Encoding qualified as Text
import GHC.Generics (Generic)

data WalletObject
  = PaymentWallet
      { WalletObject -> NetworkId
paymentWalletNetworkId :: NetworkId
      , WalletObject -> SigningKey PaymentKey
paymentWalletPaymentSigningKey :: SigningKey PaymentKey
      }
  | StakeWallet
      { WalletObject -> NetworkId
stakeWalletNetworkId :: NetworkId
      , WalletObject -> SigningKey PaymentKey
stakeWalletPaymentSigningKey :: SigningKey PaymentKey
      , WalletObject -> SigningKey StakeKey
stakeWalletStakeSigningKey :: SigningKey StakeKey
      }

deriving instance Show WalletObject

deriving instance Generic WalletObject

instance ToJSON WalletObject where
  toJSON :: WalletObject -> Aeson.Value
  toJSON :: WalletObject -> Value
toJSON (PaymentWallet NetworkId
nid SigningKey PaymentKey
key) =
    let NetworkMagic Word32
nm = NetworkId -> NetworkMagic
toNetworkMagic NetworkId
nid
     in [Pair] -> Value
Aeson.object
          [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"PaymentWallet" :: Text)
          , Key
"networkMagic" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nm :: Int)
          , Key
"signingKey" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
Text.decodeUtf8 (SigningKey PaymentKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex SigningKey PaymentKey
key)
          ]
  toJSON (StakeWallet NetworkId
nid SigningKey PaymentKey
pKey SigningKey StakeKey
sKey) =
    let NetworkMagic Word32
nm = NetworkId -> NetworkMagic
toNetworkMagic NetworkId
nid
     in [Pair] -> Value
Aeson.object
          [ Key
"type" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Text
"StakeWallet" :: Text)
          , Key
"networkMagic" Key -> Int -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
nm :: Int)
          , Key
"paymentSigningKey" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
Text.decodeUtf8 (SigningKey PaymentKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex SigningKey PaymentKey
pKey)
          , Key
"stakeSigningKey" Key -> Text -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall e kv v. (KeyValue e kv, ToJSON v) => Key -> v -> kv
.= ByteString -> Text
Text.decodeUtf8 (SigningKey StakeKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex SigningKey StakeKey
sKey)
          ]

instance FromJSON WalletObject where
  parseJSON :: Aeson.Value -> Aeson.Parser WalletObject
  parseJSON :: Value -> Parser WalletObject
parseJSON = String
-> (Object -> Parser WalletObject) -> Value -> Parser WalletObject
forall a. String -> (Object -> Parser a) -> Value -> Parser a
Aeson.withObject String
"WalletObject" ((Object -> Parser WalletObject) -> Value -> Parser WalletObject)
-> (Object -> Parser WalletObject) -> Value -> Parser WalletObject
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    (typ :: Text) <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"type"
    case typ of
      Text
"PaymentWallet" -> do
        keyHex <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"signingKey"
        (nm :: Int) <- o Aeson..: "networkMagic"
        PaymentWallet (fromNetworkMagic (NetworkMagic (fromIntegral nm)))
          <$> toMonadFail (rightOrError $ deserialiseFromRawBytesHex (Text.encodeUtf8 keyHex))
      Text
"StakeWallet" -> do
        pKeyHex <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
Aeson..: Key
"paymentSigningKey"
        sKeyHex <- o Aeson..: "stakeSigningKey"
        (nm :: Int) <- o Aeson..: "networkMagic"
        StakeWallet (fromNetworkMagic (NetworkMagic (fromIntegral nm)))
          <$> toMonadFail (rightOrError $ deserialiseFromRawBytesHex (Text.encodeUtf8 pKeyHex))
          <*> toMonadFail (rightOrError $ deserialiseFromRawBytesHex (Text.encodeUtf8 sKeyHex))
      Text
other -> String -> Parser WalletObject
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser WalletObject) -> String -> Parser WalletObject
forall a b. (a -> b) -> a -> b
$ String
"Unsupported wallet type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> String
forall a. Show a => a -> String
show Text
other

-- * Wallet mainnet generation

-- | Generate a simple payment wallet for mainnet.
generatePaymentWalletImpl :: IO WalletObject
generatePaymentWalletImpl :: IO WalletObject
generatePaymentWalletImpl = do
  let seedSize :: Word
seedSize = AsType PaymentKey -> Word
forall keyrole. Key keyrole => AsType keyrole -> Word
deterministicSigningKeySeedSize AsType PaymentKey
AsPaymentKey
  randomBytes <- Word -> IO ByteString
getRandomBytes Word
seedSize
  let seed = ByteString -> Seed
mkSeedFromBytes ByteString
randomBytes
      key = AsType PaymentKey -> Seed -> SigningKey PaymentKey
forall keyrole.
Key keyrole =>
AsType keyrole -> Seed -> SigningKey keyrole
deterministicSigningKey AsType PaymentKey
AsPaymentKey Seed
seed
  return (PaymentWallet Mainnet key)

-- | Generate a stake wallet for mainnet.
generateStakeWalletImpl :: IO WalletObject
generateStakeWalletImpl :: IO WalletObject
generateStakeWalletImpl = do
  let seedSize :: Word
seedSize = AsType PaymentKey -> Word
forall keyrole. Key keyrole => AsType keyrole -> Word
deterministicSigningKeySeedSize AsType PaymentKey
AsPaymentKey
  randomBytes1 <- Word -> IO ByteString
getRandomBytes Word
seedSize
  let seed1 = ByteString -> Seed
mkSeedFromBytes ByteString
randomBytes1
      pKey = AsType PaymentKey -> Seed -> SigningKey PaymentKey
forall keyrole.
Key keyrole =>
AsType keyrole -> Seed -> SigningKey keyrole
deterministicSigningKey AsType PaymentKey
AsPaymentKey Seed
seed1
  randomBytes2 <- getRandomBytes seedSize
  let seed2 = ByteString -> Seed
mkSeedFromBytes ByteString
randomBytes2
      sKey = AsType StakeKey -> Seed -> SigningKey StakeKey
forall keyrole.
Key keyrole =>
AsType keyrole -> Seed -> SigningKey keyrole
deterministicSigningKey AsType StakeKey
AsStakeKey Seed
seed2
  return (StakeWallet Mainnet pKey sKey)

-- * Wallet restoration for mainnet.

-- | Restore a mainnet payment wallet from a Bech32 encoded signing key.
restorePaymentWalletFromSigningKeyBech32Impl :: String -> IO WalletObject
restorePaymentWalletFromSigningKeyBech32Impl :: String -> IO WalletObject
restorePaymentWalletFromSigningKeyBech32Impl String
signingKeyBech32 = do
  key <- Either Bech32DecodeError (SigningKey PaymentKey)
-> IO (SigningKey PaymentKey)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Show e) =>
Either e a -> m a
rightOrError (Either Bech32DecodeError (SigningKey PaymentKey)
 -> IO (SigningKey PaymentKey))
-> Either Bech32DecodeError (SigningKey PaymentKey)
-> IO (SigningKey PaymentKey)
forall a b. (a -> b) -> a -> b
$ Text -> Either Bech32DecodeError (SigningKey PaymentKey)
forall a. SerialiseAsBech32 a => Text -> Either Bech32DecodeError a
deserialiseFromBech32 (String -> Text
Text.pack String
signingKeyBech32)
  pure $ PaymentWallet Mainnet key

-- | Restore a mainnet stake wallet from Bech32 encoded signing keys.
restoreStakeWalletFromSigningKeyBech32Impl :: String -> String -> IO WalletObject
restoreStakeWalletFromSigningKeyBech32Impl :: String -> String -> IO WalletObject
restoreStakeWalletFromSigningKeyBech32Impl String
paymentKeyBech32 String
stakeKeyBech32 = do
  pKey <- Either Bech32DecodeError (SigningKey PaymentKey)
-> IO (SigningKey PaymentKey)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Show e) =>
Either e a -> m a
rightOrError (Either Bech32DecodeError (SigningKey PaymentKey)
 -> IO (SigningKey PaymentKey))
-> Either Bech32DecodeError (SigningKey PaymentKey)
-> IO (SigningKey PaymentKey)
forall a b. (a -> b) -> a -> b
$ Text -> Either Bech32DecodeError (SigningKey PaymentKey)
forall a. SerialiseAsBech32 a => Text -> Either Bech32DecodeError a
deserialiseFromBech32 (String -> Text
Text.pack String
paymentKeyBech32)
  sKey <- rightOrError $ deserialiseFromBech32 (Text.pack stakeKeyBech32)
  pure $ StakeWallet Mainnet pKey sKey

-- * Wallet testnet generation

-- | Generate a simple payment wallet for testnet, given the testnet's network magic.
generateTestnetPaymentWalletImpl :: Int -> IO WalletObject
generateTestnetPaymentWalletImpl :: Int -> IO WalletObject
generateTestnetPaymentWalletImpl Int
networkMagic = do
  let seedSize :: Word
seedSize = AsType PaymentKey -> Word
forall keyrole. Key keyrole => AsType keyrole -> Word
deterministicSigningKeySeedSize AsType PaymentKey
AsPaymentKey
  randomBytes <- Word -> IO ByteString
getRandomBytes Word
seedSize
  let seed = ByteString -> Seed
mkSeedFromBytes ByteString
randomBytes
      key = AsType PaymentKey -> Seed -> SigningKey PaymentKey
forall keyrole.
Key keyrole =>
AsType keyrole -> Seed -> SigningKey keyrole
deterministicSigningKey AsType PaymentKey
AsPaymentKey Seed
seed
  return $ PaymentWallet (Testnet $ NetworkMagic $ fromIntegral networkMagic) key

-- | Generate a stake wallet for testnet, given the testnet's network magic.
generateTestnetStakeWalletImpl :: Int -> IO WalletObject
generateTestnetStakeWalletImpl :: Int -> IO WalletObject
generateTestnetStakeWalletImpl Int
networkMagic = do
  let seedSize :: Word
seedSize = AsType PaymentKey -> Word
forall keyrole. Key keyrole => AsType keyrole -> Word
deterministicSigningKeySeedSize AsType PaymentKey
AsPaymentKey
  randomBytes1 <- Word -> IO ByteString
getRandomBytes Word
seedSize
  let seed1 = ByteString -> Seed
mkSeedFromBytes ByteString
randomBytes1
      pKey = AsType PaymentKey -> Seed -> SigningKey PaymentKey
forall keyrole.
Key keyrole =>
AsType keyrole -> Seed -> SigningKey keyrole
deterministicSigningKey AsType PaymentKey
AsPaymentKey Seed
seed1
  randomBytes2 <- getRandomBytes seedSize
  let seed2 = ByteString -> Seed
mkSeedFromBytes ByteString
randomBytes2
      sKey = AsType StakeKey -> Seed -> SigningKey StakeKey
forall keyrole.
Key keyrole =>
AsType keyrole -> Seed -> SigningKey keyrole
deterministicSigningKey AsType StakeKey
AsStakeKey Seed
seed2
  return $ StakeWallet (Testnet $ NetworkMagic $ fromIntegral networkMagic) pKey sKey

-- * Wallet restoration for testnet.

-- | Restore a testnet payment wallet from a Bech32 encoded signing key.
restoreTestnetPaymentWalletFromSigningKeyBech32Impl :: Int -> String -> IO WalletObject
restoreTestnetPaymentWalletFromSigningKeyBech32Impl :: Int -> String -> IO WalletObject
restoreTestnetPaymentWalletFromSigningKeyBech32Impl Int
networkMagic String
signingKeyHex = do
  key <- Either Bech32DecodeError (SigningKey PaymentKey)
-> IO (SigningKey PaymentKey)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Show e) =>
Either e a -> m a
rightOrError (Either Bech32DecodeError (SigningKey PaymentKey)
 -> IO (SigningKey PaymentKey))
-> Either Bech32DecodeError (SigningKey PaymentKey)
-> IO (SigningKey PaymentKey)
forall a b. (a -> b) -> a -> b
$ Text -> Either Bech32DecodeError (SigningKey PaymentKey)
forall a. SerialiseAsBech32 a => Text -> Either Bech32DecodeError a
deserialiseFromBech32 (String -> Text
Text.pack String
signingKeyHex)
  pure $ PaymentWallet (Testnet (NetworkMagic (fromIntegral networkMagic))) key

-- | Restore a testnet stake wallet from Bech32 encoded signing keys.
restoreTestnetStakeWalletFromSigningKeyBech32Impl :: Int -> String -> String -> IO WalletObject
restoreTestnetStakeWalletFromSigningKeyBech32Impl :: Int -> String -> String -> IO WalletObject
restoreTestnetStakeWalletFromSigningKeyBech32Impl Int
networkMagic String
paymentKeyBech32 String
stakeKeyBech32 = do
  pKey <- Either Bech32DecodeError (SigningKey PaymentKey)
-> IO (SigningKey PaymentKey)
forall (m :: * -> *) e a.
(HasCallStack, MonadThrow m, Show e) =>
Either e a -> m a
rightOrError (Either Bech32DecodeError (SigningKey PaymentKey)
 -> IO (SigningKey PaymentKey))
-> Either Bech32DecodeError (SigningKey PaymentKey)
-> IO (SigningKey PaymentKey)
forall a b. (a -> b) -> a -> b
$ Text -> Either Bech32DecodeError (SigningKey PaymentKey)
forall a. SerialiseAsBech32 a => Text -> Either Bech32DecodeError a
deserialiseFromBech32 (String -> Text
Text.pack String
paymentKeyBech32)
  sKey <- rightOrError $ deserialiseFromBech32 (Text.pack stakeKeyBech32)
  pure $ StakeWallet (Testnet (NetworkMagic (fromIntegral networkMagic))) pKey sKey

-- * Wallet information retrieval

-- ** Bech32 of addresses and keys

-- | Get the Bech32 representation of the address. (Can be shared for receiving funds.)
getAddressBech32Impl :: WalletObject -> String
getAddressBech32Impl :: WalletObject -> String
getAddressBech32Impl (PaymentWallet NetworkId
nid SigningKey PaymentKey
key) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
    Address ShelleyAddr -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress (Address ShelleyAddr -> Text) -> Address ShelleyAddr -> Text
forall a b. (a -> b) -> a -> b
$
      NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress
        NetworkId
nid
        (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
key)))
        StakeAddressReference
NoStakeAddress
getAddressBech32Impl (StakeWallet NetworkId
nid SigningKey PaymentKey
pKey SigningKey StakeKey
sKey) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
    Address ShelleyAddr -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress (Address ShelleyAddr -> Text) -> Address ShelleyAddr -> Text
forall a b. (a -> b) -> a -> b
$
      NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
makeShelleyAddress
        NetworkId
nid
        (Hash PaymentKey -> PaymentCredential
PaymentCredentialByKey (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
pKey)))
        (StakeCredential -> StakeAddressReference
StakeAddressByValue (Hash StakeKey -> StakeCredential
StakeCredentialByKey (VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (SigningKey StakeKey -> VerificationKey StakeKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey StakeKey
sKey))))

-- | Get the Bech32 representation of the verification key of the wallet. (Can be shared for verification.)
getBech32ForPaymentVerificationKeyImpl :: WalletObject -> String
getBech32ForPaymentVerificationKeyImpl :: WalletObject -> String
getBech32ForPaymentVerificationKeyImpl (PaymentWallet NetworkId
_ SigningKey PaymentKey
key) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
key)
getBech32ForPaymentVerificationKeyImpl (StakeWallet NetworkId
_ SigningKey PaymentKey
pKey SigningKey StakeKey
_) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ VerificationKey PaymentKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
pKey)

-- | Get the Bech32 representation of the stake verification key of the wallet. (Can be shared for verification.)
getBech32ForStakeVerificationKeyImpl :: WalletObject -> String
getBech32ForStakeVerificationKeyImpl :: WalletObject -> String
getBech32ForStakeVerificationKeyImpl (PaymentWallet NetworkId
_ SigningKey PaymentKey
_) =
  ShowS
forall a. HasCallStack => String -> a
error String
"Payment wallets do not have stake keys"
getBech32ForStakeVerificationKeyImpl (StakeWallet NetworkId
_ SigningKey PaymentKey
_ SigningKey StakeKey
sKey) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ VerificationKey StakeKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 (SigningKey StakeKey -> VerificationKey StakeKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey StakeKey
sKey)

-- | Get the Bech32 representation of the signing key of the wallet, if any. (Must be kept secret.)
getBech32ForPaymentSigningKeyImpl :: WalletObject -> String
getBech32ForPaymentSigningKeyImpl :: WalletObject -> String
getBech32ForPaymentSigningKeyImpl (PaymentWallet NetworkId
_ SigningKey PaymentKey
pkey) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ SigningKey PaymentKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey PaymentKey
pkey
getBech32ForPaymentSigningKeyImpl (StakeWallet NetworkId
_ SigningKey PaymentKey
pKey SigningKey StakeKey
_) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ SigningKey PaymentKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey PaymentKey
pKey

-- | Get the Bech32 representation of the stake signing key of the wallet, if any. (Must be kept secret.)
getBech32ForStakeSigningKeyImpl :: WalletObject -> String
getBech32ForStakeSigningKeyImpl :: WalletObject -> String
getBech32ForStakeSigningKeyImpl (PaymentWallet NetworkId
_ SigningKey PaymentKey
_) =
  ShowS
forall a. HasCallStack => String -> a
error String
"Payment wallets do not have stake keys"
getBech32ForStakeSigningKeyImpl (StakeWallet NetworkId
_ SigningKey PaymentKey
_ SigningKey StakeKey
sKey) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ SigningKey StakeKey -> Text
forall a. SerialiseAsBech32 a => a -> Text
serialiseToBech32 SigningKey StakeKey
sKey

-- ** Base16 of key hashes

-- | Get the base16 representation of the hash of the verification key of the wallet.
getBase16ForPaymentVerificationKeyHashImpl :: WalletObject -> String
getBase16ForPaymentVerificationKeyHashImpl :: WalletObject -> String
getBase16ForPaymentVerificationKeyHashImpl (PaymentWallet NetworkId
_ SigningKey PaymentKey
pkey) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
    ByteString -> Text
Text.decodeUtf8 (Hash PaymentKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
pkey)))
getBase16ForPaymentVerificationKeyHashImpl (StakeWallet NetworkId
_ SigningKey PaymentKey
pKey SigningKey StakeKey
_) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
    ByteString -> Text
Text.decodeUtf8 (Hash PaymentKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
pKey)))

-- | Get the base16 representation of the hash of the stake verification key of the wallet.
getBase16ForStakeVerificationKeyHashImpl :: WalletObject -> String
getBase16ForStakeVerificationKeyHashImpl :: WalletObject -> String
getBase16ForStakeVerificationKeyHashImpl (PaymentWallet NetworkId
_ SigningKey PaymentKey
_) =
  ShowS
forall a. HasCallStack => String -> a
error String
"Payment wallets do not have stake keys"
getBase16ForStakeVerificationKeyHashImpl (StakeWallet NetworkId
_ SigningKey PaymentKey
_ SigningKey StakeKey
sKey) =
  Text -> String
Text.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$
    ByteString -> Text
Text.decodeUtf8 (Hash StakeKey -> ByteString
forall a. SerialiseAsRawBytes a => a -> ByteString
serialiseToRawBytesHex (VerificationKey StakeKey -> Hash StakeKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash (SigningKey StakeKey -> VerificationKey StakeKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey StakeKey
sKey)))