-----------------------------------------------------------------------------
--
-- Module      :  $Headers
-- Copyright   :  (c) 2021 Brian W Bush
-- License     :  MIT
--
-- Maintainer  :  Brian W Bush <code@functionally.io>
-- Stability   :  Experimental
-- Portability :  Portable
--
-- | Key management.
--
-----------------------------------------------------------------------------


{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}


module Mantra.Wallet (
-- * Keys
  SomePaymentVerificationKey
, readVerificationKey
, SomePaymentSigningKey
, readSigningKey
, makeVerificationKeyHash
-- * Addresses
, readAddress
, showAddress
, showAddressInEra
-- * Stake addresses
, stakeReference
, stakeReferenceInEra
) where


import Cardano.Api (AddressAny(..), AddressInEra(..), AddressTypeInEra(ShelleyAddressInEra), AsType(..), Hash, IsCardanoEra, IsShelleyBasedEra(..), PaymentExtendedKey, PaymentExtendedKey, PaymentKey, SigningKey, StakeAddressReference(NoStakeAddress), VerificationKey, castVerificationKey, deserialiseAddress, readFileTextEnvelope, serialiseAddress, verificationKeyHash)
import Control.Monad.IO.Class (MonadIO)
import Mantra.Types (MantraM, foistMantraEitherIO, foistMantraMaybe)

import qualified Cardano.Api.Shelley  as Shelley (Address(ShelleyAddress), fromShelleyStakeReference)
import qualified Data.Text            as T (pack, unpack)


-- | Parse an address.
readAddress :: Monad m
            => String               -- ^ The string representation.
            -> MantraM m AddressAny -- ^ Action to parse the address.
readAddress :: String -> MantraM m AddressAny
readAddress =
  String -> Maybe AddressAny -> MantraM m AddressAny
forall (m :: * -> *) a. Monad m => String -> Maybe a -> MantraM m a
foistMantraMaybe String
"Could not deserialize address."
    (Maybe AddressAny -> MantraM m AddressAny)
-> (String -> Maybe AddressAny) -> String -> MantraM m AddressAny
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AsType AddressAny -> Text -> Maybe AddressAny
forall addr.
SerialiseAddress addr =>
AsType addr -> Text -> Maybe addr
deserialiseAddress AsType AddressAny
AsAddressAny
    (Text -> Maybe AddressAny)
-> (String -> Text) -> String -> Maybe AddressAny
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack


-- | Show an address.
showAddress :: AddressAny -- ^ The address.
            -> String     -- ^ The string representation.
showAddress :: AddressAny -> String
showAddress = Text -> String
T.unpack (Text -> String) -> (AddressAny -> Text) -> AddressAny -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressAny -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress


-- | Show a era-based address.
showAddressInEra :: IsCardanoEra era
                 => AddressInEra era -- ^ The address.
                 -> String           -- ^ The string representation.
showAddressInEra :: AddressInEra era -> String
showAddressInEra = Text -> String
T.unpack (Text -> String)
-> (AddressInEra era -> Text) -> AddressInEra era -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AddressInEra era -> Text
forall addr. SerialiseAddress addr => addr -> Text
serialiseAddress


-- | A payment verification key.
type SomePaymentVerificationKey = Either (VerificationKey PaymentKey) (VerificationKey PaymentExtendedKey)


-- | Read a payment verification key.
readVerificationKey :: MonadIO m
                    => FilePath                             -- ^ Path to the key.
                    -> MantraM m SomePaymentVerificationKey -- ^ Action to read the key.
readVerificationKey :: String -> MantraM m SomePaymentVerificationKey
readVerificationKey String
file =
  IO
  (Either (FileError TextEnvelopeError) SomePaymentVerificationKey)
-> MantraM m SomePaymentVerificationKey
forall (m :: * -> *) e a.
(MonadIO m, Show e) =>
IO (Either e a) -> MantraM m a
foistMantraEitherIO
    (IO
   (Either (FileError TextEnvelopeError) SomePaymentVerificationKey)
 -> MantraM m SomePaymentVerificationKey)
-> IO
     (Either (FileError TextEnvelopeError) SomePaymentVerificationKey)
-> MantraM m SomePaymentVerificationKey
forall a b. (a -> b) -> a -> b
$ do -- FIXME: Make this lazy, so the file is only read once.
      Either (FileError TextEnvelopeError) SomePaymentVerificationKey
extendedKey <- (VerificationKey PaymentExtendedKey -> SomePaymentVerificationKey)
-> Either
     (FileError TextEnvelopeError) (VerificationKey PaymentExtendedKey)
-> Either (FileError TextEnvelopeError) SomePaymentVerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VerificationKey PaymentExtendedKey -> SomePaymentVerificationKey
forall a b. b -> Either a b
Right (Either
   (FileError TextEnvelopeError) (VerificationKey PaymentExtendedKey)
 -> Either (FileError TextEnvelopeError) SomePaymentVerificationKey)
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey PaymentExtendedKey))
-> IO
     (Either (FileError TextEnvelopeError) SomePaymentVerificationKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (VerificationKey PaymentExtendedKey)
-> String
-> IO
     (Either
        (FileError TextEnvelopeError) (VerificationKey PaymentExtendedKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType PaymentExtendedKey
-> AsType (VerificationKey PaymentExtendedKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType PaymentExtendedKey
AsPaymentExtendedKey) String
file
      Either (FileError TextEnvelopeError) SomePaymentVerificationKey
plainKey    <- (VerificationKey PaymentKey -> SomePaymentVerificationKey)
-> Either
     (FileError TextEnvelopeError) (VerificationKey PaymentKey)
-> Either (FileError TextEnvelopeError) SomePaymentVerificationKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VerificationKey PaymentKey -> SomePaymentVerificationKey
forall a b. a -> Either a b
Left  (Either (FileError TextEnvelopeError) (VerificationKey PaymentKey)
 -> Either (FileError TextEnvelopeError) SomePaymentVerificationKey)
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey PaymentKey))
-> IO
     (Either (FileError TextEnvelopeError) SomePaymentVerificationKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (VerificationKey PaymentKey)
-> String
-> IO
     (Either (FileError TextEnvelopeError) (VerificationKey PaymentKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType PaymentKey -> AsType (VerificationKey PaymentKey)
forall a. AsType a -> AsType (VerificationKey a)
AsVerificationKey AsType PaymentKey
AsPaymentKey        ) String
file
      Either (FileError TextEnvelopeError) SomePaymentVerificationKey
-> IO
     (Either (FileError TextEnvelopeError) SomePaymentVerificationKey)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError TextEnvelopeError) SomePaymentVerificationKey
 -> IO
      (Either (FileError TextEnvelopeError) SomePaymentVerificationKey))
-> Either (FileError TextEnvelopeError) SomePaymentVerificationKey
-> IO
     (Either (FileError TextEnvelopeError) SomePaymentVerificationKey)
forall a b. (a -> b) -> a -> b
$ Either (FileError TextEnvelopeError) SomePaymentVerificationKey
extendedKey Either (FileError TextEnvelopeError) SomePaymentVerificationKey
-> Either (FileError TextEnvelopeError) SomePaymentVerificationKey
-> Either (FileError TextEnvelopeError) SomePaymentVerificationKey
forall a. Semigroup a => a -> a -> a
<> Either (FileError TextEnvelopeError) SomePaymentVerificationKey
plainKey


-- | Compute a verification hash.
makeVerificationKeyHash :: SomePaymentVerificationKey -- ^ The key.
                        -> Hash PaymentKey            -- ^ The hash.
makeVerificationKeyHash :: SomePaymentVerificationKey -> Hash PaymentKey
makeVerificationKeyHash =
  VerificationKey PaymentKey -> Hash PaymentKey
forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
verificationKeyHash
    (VerificationKey PaymentKey -> Hash PaymentKey)
-> (SomePaymentVerificationKey -> VerificationKey PaymentKey)
-> SomePaymentVerificationKey
-> Hash PaymentKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VerificationKey PaymentKey -> VerificationKey PaymentKey)
-> (VerificationKey PaymentExtendedKey
    -> VerificationKey PaymentKey)
-> SomePaymentVerificationKey
-> VerificationKey PaymentKey
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either VerificationKey PaymentKey -> VerificationKey PaymentKey
forall a. a -> a
id VerificationKey PaymentExtendedKey -> VerificationKey PaymentKey
forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
castVerificationKey


-- | A payment signing key.
type SomePaymentSigningKey = Either (SigningKey PaymentKey) (SigningKey PaymentExtendedKey)


-- | Read a signing key.
readSigningKey :: MonadIO m
               => FilePath                        -- ^ Path to the key.
               -> MantraM m SomePaymentSigningKey -- ^ Action to read the key.
readSigningKey :: String -> MantraM m SomePaymentSigningKey
readSigningKey String
file =
  IO (Either (FileError TextEnvelopeError) SomePaymentSigningKey)
-> MantraM m SomePaymentSigningKey
forall (m :: * -> *) e a.
(MonadIO m, Show e) =>
IO (Either e a) -> MantraM m a
foistMantraEitherIO
    (IO (Either (FileError TextEnvelopeError) SomePaymentSigningKey)
 -> MantraM m SomePaymentSigningKey)
-> IO (Either (FileError TextEnvelopeError) SomePaymentSigningKey)
-> MantraM m SomePaymentSigningKey
forall a b. (a -> b) -> a -> b
$ do -- FIXME: Make this lazy, so the file is only read once.
      Either (FileError TextEnvelopeError) SomePaymentSigningKey
extendedKey <- (SigningKey PaymentExtendedKey -> SomePaymentSigningKey)
-> Either
     (FileError TextEnvelopeError) (SigningKey PaymentExtendedKey)
-> Either (FileError TextEnvelopeError) SomePaymentSigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SigningKey PaymentExtendedKey -> SomePaymentSigningKey
forall a b. b -> Either a b
Right (Either
   (FileError TextEnvelopeError) (SigningKey PaymentExtendedKey)
 -> Either (FileError TextEnvelopeError) SomePaymentSigningKey)
-> IO
     (Either
        (FileError TextEnvelopeError) (SigningKey PaymentExtendedKey))
-> IO (Either (FileError TextEnvelopeError) SomePaymentSigningKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (SigningKey PaymentExtendedKey)
-> String
-> IO
     (Either
        (FileError TextEnvelopeError) (SigningKey PaymentExtendedKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType PaymentExtendedKey -> AsType (SigningKey PaymentExtendedKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentExtendedKey
AsPaymentExtendedKey) String
file
      Either (FileError TextEnvelopeError) SomePaymentSigningKey
plainKey    <- (SigningKey PaymentKey -> SomePaymentSigningKey)
-> Either (FileError TextEnvelopeError) (SigningKey PaymentKey)
-> Either (FileError TextEnvelopeError) SomePaymentSigningKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SigningKey PaymentKey -> SomePaymentSigningKey
forall a b. a -> Either a b
Left  (Either (FileError TextEnvelopeError) (SigningKey PaymentKey)
 -> Either (FileError TextEnvelopeError) SomePaymentSigningKey)
-> IO
     (Either (FileError TextEnvelopeError) (SigningKey PaymentKey))
-> IO (Either (FileError TextEnvelopeError) SomePaymentSigningKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AsType (SigningKey PaymentKey)
-> String
-> IO
     (Either (FileError TextEnvelopeError) (SigningKey PaymentKey))
forall a.
HasTextEnvelope a =>
AsType a -> String -> IO (Either (FileError TextEnvelopeError) a)
readFileTextEnvelope (AsType PaymentKey -> AsType (SigningKey PaymentKey)
forall a. AsType a -> AsType (SigningKey a)
AsSigningKey AsType PaymentKey
AsPaymentKey        ) String
file
      Either (FileError TextEnvelopeError) SomePaymentSigningKey
-> IO (Either (FileError TextEnvelopeError) SomePaymentSigningKey)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either (FileError TextEnvelopeError) SomePaymentSigningKey
 -> IO (Either (FileError TextEnvelopeError) SomePaymentSigningKey))
-> Either (FileError TextEnvelopeError) SomePaymentSigningKey
-> IO (Either (FileError TextEnvelopeError) SomePaymentSigningKey)
forall a b. (a -> b) -> a -> b
$ Either (FileError TextEnvelopeError) SomePaymentSigningKey
extendedKey Either (FileError TextEnvelopeError) SomePaymentSigningKey
-> Either (FileError TextEnvelopeError) SomePaymentSigningKey
-> Either (FileError TextEnvelopeError) SomePaymentSigningKey
forall a. Semigroup a => a -> a -> a
<> Either (FileError TextEnvelopeError) SomePaymentSigningKey
plainKey


-- | Extract a stake address from a payment address.
stakeReference :: AddressAny            -- ^ The payment address.
               -> StakeAddressReference -- ^ The stake address.
stakeReference :: AddressAny -> StakeAddressReference
stakeReference (AddressShelley (Shelley.ShelleyAddress Network
_ PaymentCredential StandardCrypto
_ StakeReference StandardCrypto
s)) = StakeReference StandardCrypto -> StakeAddressReference
Shelley.fromShelleyStakeReference StakeReference StandardCrypto
s
stakeReference AddressAny
_                                               = StakeAddressReference
NoStakeAddress


-- | Extract a stake address from a payment address.
stakeReferenceInEra :: IsShelleyBasedEra era
                    => AddressInEra era     -- ^ The payment address.
                   -> StakeAddressReference -- ^ The stake address.
stakeReferenceInEra :: AddressInEra era -> StakeAddressReference
stakeReferenceInEra (AddressInEra (ShelleyAddressInEra ShelleyBasedEra era
_) (Shelley.ShelleyAddress Network
_ PaymentCredential StandardCrypto
_  StakeReference StandardCrypto
s)) = StakeReference StandardCrypto -> StakeAddressReference
Shelley.fromShelleyStakeReference StakeReference StandardCrypto
s
stakeReferenceInEra AddressInEra era
_                                                                      = StakeAddressReference
NoStakeAddress