{-# LANGUAGE DerivingStrategies   #-}
{-# LANGUAGE FlexibleContexts     #-}
{-# LANGUAGE GADTs                #-}
{-# LANGUAGE LambdaCase           #-}
{-# LANGUAGE NamedFieldPuns       #-}
{-# LANGUAGE StandaloneDeriving   #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
{-| Managing the credentials used for batching |-}
module Convex.Wallet.Operator(
  -- * Operator
  PaymentExtendedKey(..),
  Signing,
  Verification,
  toVerification,
  verificationKey,
  signTx,
  signTxOperator,
  Operator(..),
  operatorAddress,
  operatorPaymentCredential,
  operatorWalletID,
  operatorReturnOutput,
  generateOperator,
  returnOutputFor,

  -- * Configuration
  OperatorConfigSigning(..),
  parseOperatorConfigSigning,
  loadOperatorFiles,
  OperatorConfigVerification(..),
  parseOperatorConfigVerification,
  loadOperatorFilesVerification
) where

import           Cardano.Api         (BabbageEra, CtxTx, PaymentCredential,
                                      TxOut)
import qualified Cardano.Api         as C
import           Convex.Class        (MonadBlockchain (networkId))
import           Convex.Lenses       (emptyTxOut)
import           Convex.PlutusLedger (transPubKeyHash, transStakeKeyHash)
import           Convex.Utils        (readSigningKeyFromFile,
                                      readStakingKeyFromFile,
                                      readVerificationKeyFromFile)
import           Convex.Wallet       (addSignature, addSignatureExtended)
import           Options.Applicative (Parser, help, long, metavar, optional,
                                      strOption)
import           PlutusLedgerApi.V1  (PubKeyHash (..))

data Signing

data Verification

data PaymentExtendedKey k where
  PESigning :: C.SigningKey C.PaymentKey -> PaymentExtendedKey Signing
  PESigningEx :: C.SigningKey C.PaymentExtendedKey -> PaymentExtendedKey Signing
  PEVerification :: C.VerificationKey C.PaymentKey -> PaymentExtendedKey Verification

deriving stock instance Show (PaymentExtendedKey k)

verificationKey :: PaymentExtendedKey k -> C.VerificationKey C.PaymentKey
verificationKey :: forall k. PaymentExtendedKey k -> VerificationKey PaymentKey
verificationKey = \case
  PESigningEx SigningKey PaymentExtendedKey
k    -> forall keyroleA keyroleB.
CastVerificationKeyRole keyroleA keyroleB =>
VerificationKey keyroleA -> VerificationKey keyroleB
C.castVerificationKey forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
C.getVerificationKey SigningKey PaymentExtendedKey
k
  PESigning SigningKey PaymentKey
k      -> forall keyrole.
Key keyrole =>
SigningKey keyrole -> VerificationKey keyrole
C.getVerificationKey SigningKey PaymentKey
k
  PEVerification VerificationKey PaymentKey
k -> VerificationKey PaymentKey
k

toVerification :: PaymentExtendedKey Signing -> PaymentExtendedKey Verification
toVerification :: PaymentExtendedKey Signing -> PaymentExtendedKey Verification
toVerification = VerificationKey PaymentKey -> PaymentExtendedKey Verification
PEVerification forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k. PaymentExtendedKey k -> VerificationKey PaymentKey
verificationKey

signTx :: C.IsShelleyBasedEra era => PaymentExtendedKey Signing -> C.Tx era -> C.Tx era
signTx :: forall era.
IsShelleyBasedEra era =>
PaymentExtendedKey Signing -> Tx era -> Tx era
signTx = \case
  PESigningEx SigningKey PaymentExtendedKey
k -> forall era.
IsShelleyBasedEra era =>
SigningKey PaymentExtendedKey -> Tx era -> Tx era
addSignatureExtended SigningKey PaymentExtendedKey
k
  PESigning   SigningKey PaymentKey
k -> forall era.
IsShelleyBasedEra era =>
SigningKey PaymentKey -> Tx era -> Tx era
addSignature SigningKey PaymentKey
k

{-| Add a signature to the transaction
-}
signTxOperator :: Operator Signing -> C.Tx C.BabbageEra -> C.Tx C.BabbageEra
signTxOperator :: Operator Signing -> Tx BabbageEra -> Tx BabbageEra
signTxOperator Operator{PaymentExtendedKey Signing
oPaymentKey :: forall k. Operator k -> PaymentExtendedKey k
oPaymentKey :: PaymentExtendedKey Signing
oPaymentKey} = forall era.
IsShelleyBasedEra era =>
PaymentExtendedKey Signing -> Tx era -> Tx era
signTx PaymentExtendedKey Signing
oPaymentKey

{-| An entity that can match orders
-}
data Operator k =
  Operator
    { forall k. Operator k -> PaymentExtendedKey k
oPaymentKey :: PaymentExtendedKey k
    , forall k. Operator k -> Maybe (VerificationKey StakeKey)
oStakeKey   :: Maybe (C.VerificationKey C.StakeKey)
    }

deriving stock instance Show (PaymentExtendedKey k) => Show (Operator k)

instance Show (PaymentExtendedKey k) => Eq (Operator k) where
  Operator k
l == :: Operator k -> Operator k -> Bool
== Operator k
r = forall a. Show a => a -> FilePath
show Operator k
l forall a. Eq a => a -> a -> Bool
== forall a. Show a => a -> FilePath
show Operator k
r

{-| Address of the operator in a network
-}
operatorAddress :: C.NetworkId -> Operator k -> C.Address C.ShelleyAddr
operatorAddress :: forall k. NetworkId -> Operator k -> Address ShelleyAddr
operatorAddress NetworkId
networkId_ Operator k
op =
  NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
C.makeShelleyAddress
    NetworkId
networkId_
    (forall k. Operator k -> PaymentCredential
operatorPaymentCredential Operator k
op)
    StakeAddressReference
C.NoStakeAddress

{-| The operator's payment credential (public key)
-}
operatorPaymentCredential :: Operator k -> C.PaymentCredential
operatorPaymentCredential :: forall k. Operator k -> PaymentCredential
operatorPaymentCredential = Hash PaymentKey -> PaymentCredential
C.PaymentCredentialByKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
C.verificationKeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k. PaymentExtendedKey k -> VerificationKey PaymentKey
verificationKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k. Operator k -> PaymentExtendedKey k
oPaymentKey

{-| Key hashes in Plutus format
-}
operatorWalletID :: Operator k -> (PubKeyHash, Maybe PubKeyHash)
operatorWalletID :: forall k. Operator k -> (PubKeyHash, Maybe PubKeyHash)
operatorWalletID Operator{PaymentExtendedKey k
oPaymentKey :: PaymentExtendedKey k
oPaymentKey :: forall k. Operator k -> PaymentExtendedKey k
oPaymentKey, Maybe (VerificationKey StakeKey)
oStakeKey :: Maybe (VerificationKey StakeKey)
oStakeKey :: forall k. Operator k -> Maybe (VerificationKey StakeKey)
oStakeKey} =
  ( Hash PaymentKey -> PubKeyHash
transPubKeyHash forall a b. (a -> b) -> a -> b
$ forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
C.verificationKeyHash forall a b. (a -> b) -> a -> b
$ forall k. PaymentExtendedKey k -> VerificationKey PaymentKey
verificationKey PaymentExtendedKey k
oPaymentKey
  , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Hash StakeKey -> PubKeyHash
transStakeKeyHash forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall keyrole.
Key keyrole =>
VerificationKey keyrole -> Hash keyrole
C.verificationKeyHash) Maybe (VerificationKey StakeKey)
oStakeKey
  )

{-| An empty output locked by the operator's payment credential
-}
operatorReturnOutput :: MonadBlockchain m => Operator k -> m (TxOut CtxTx BabbageEra)
operatorReturnOutput :: forall (m :: * -> *) k.
MonadBlockchain m =>
Operator k -> m (TxOut CtxTx BabbageEra)
operatorReturnOutput = forall (m :: * -> *).
MonadBlockchain m =>
PaymentCredential -> m (TxOut CtxTx BabbageEra)
returnOutputFor forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k. Operator k -> PaymentCredential
operatorPaymentCredential

{- An empty output locked by the payment credential
-}
returnOutputFor :: MonadBlockchain m => PaymentCredential -> m (TxOut CtxTx BabbageEra)
returnOutputFor :: forall (m :: * -> *).
MonadBlockchain m =>
PaymentCredential -> m (TxOut CtxTx BabbageEra)
returnOutputFor PaymentCredential
cred = do
  Address ShelleyAddr
addr <- NetworkId
-> PaymentCredential
-> StakeAddressReference
-> Address ShelleyAddr
C.makeShelleyAddress
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadBlockchain m => m NetworkId
networkId
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure PaymentCredential
cred
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure StakeAddressReference
C.NoStakeAddress
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ AddressInEra BabbageEra -> TxOut CtxTx BabbageEra
emptyTxOut forall a b. (a -> b) -> a -> b
$ forall addrtype era.
AddressTypeInEra addrtype era
-> Address addrtype -> AddressInEra era
C.AddressInEra (forall era. ShelleyBasedEra era -> AddressTypeInEra ShelleyAddr era
C.ShelleyAddressInEra ShelleyBasedEra BabbageEra
C.ShelleyBasedEraBabbage) Address ShelleyAddr
addr


{-| Key files for operating the oracle and stablecoin
-}
data OperatorConfigSigning =
  OperatorConfigSigning
    { OperatorConfigSigning -> FilePath
ocSigningKeyFile           :: FilePath
    , OperatorConfigSigning -> Maybe FilePath
ocStakeVerificationKeyFile :: Maybe FilePath
    }
    deriving stock (OperatorConfigSigning -> OperatorConfigSigning -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperatorConfigSigning -> OperatorConfigSigning -> Bool
$c/= :: OperatorConfigSigning -> OperatorConfigSigning -> Bool
== :: OperatorConfigSigning -> OperatorConfigSigning -> Bool
$c== :: OperatorConfigSigning -> OperatorConfigSigning -> Bool
Eq, Int -> OperatorConfigSigning -> ShowS
[OperatorConfigSigning] -> ShowS
OperatorConfigSigning -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OperatorConfigSigning] -> ShowS
$cshowList :: [OperatorConfigSigning] -> ShowS
show :: OperatorConfigSigning -> FilePath
$cshow :: OperatorConfigSigning -> FilePath
showsPrec :: Int -> OperatorConfigSigning -> ShowS
$cshowsPrec :: Int -> OperatorConfigSigning -> ShowS
Show)

{-| Key files for operating the oracle and stablecoin
-}
data OperatorConfigVerification =
  OperatorConfigVerification
    { OperatorConfigVerification -> FilePath
ocvPaymentKeyFile           :: FilePath
    , OperatorConfigVerification -> Maybe FilePath
ocvStakeVerificationKeyFile :: Maybe FilePath
    }
    deriving stock (OperatorConfigVerification -> OperatorConfigVerification -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OperatorConfigVerification -> OperatorConfigVerification -> Bool
$c/= :: OperatorConfigVerification -> OperatorConfigVerification -> Bool
== :: OperatorConfigVerification -> OperatorConfigVerification -> Bool
$c== :: OperatorConfigVerification -> OperatorConfigVerification -> Bool
Eq, Int -> OperatorConfigVerification -> ShowS
[OperatorConfigVerification] -> ShowS
OperatorConfigVerification -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [OperatorConfigVerification] -> ShowS
$cshowList :: [OperatorConfigVerification] -> ShowS
show :: OperatorConfigVerification -> FilePath
$cshow :: OperatorConfigVerification -> FilePath
showsPrec :: Int -> OperatorConfigVerification -> ShowS
$cshowsPrec :: Int -> OperatorConfigVerification -> ShowS
Show)

loadOperatorFiles :: OperatorConfigSigning -> IO (Operator Signing)
loadOperatorFiles :: OperatorConfigSigning -> IO (Operator Signing)
loadOperatorFiles OperatorConfigSigning{FilePath
ocSigningKeyFile :: FilePath
ocSigningKeyFile :: OperatorConfigSigning -> FilePath
ocSigningKeyFile, Maybe FilePath
ocStakeVerificationKeyFile :: Maybe FilePath
ocStakeVerificationKeyFile :: OperatorConfigSigning -> Maybe FilePath
ocStakeVerificationKeyFile} =
  forall k.
PaymentExtendedKey k
-> Maybe (VerificationKey StakeKey) -> Operator k
Operator forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SigningKey PaymentKey -> PaymentExtendedKey Signing
PESigning (FilePath -> IO (SigningKey PaymentKey)
readSigningKeyFromFile FilePath
ocSigningKeyFile) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (VerificationKey StakeKey)
readStakingKeyFromFile Maybe FilePath
ocStakeVerificationKeyFile

loadOperatorFilesVerification :: OperatorConfigVerification -> IO (Operator Verification)
loadOperatorFilesVerification :: OperatorConfigVerification -> IO (Operator Verification)
loadOperatorFilesVerification OperatorConfigVerification{Maybe FilePath
ocvStakeVerificationKeyFile :: Maybe FilePath
ocvStakeVerificationKeyFile :: OperatorConfigVerification -> Maybe FilePath
ocvStakeVerificationKeyFile, FilePath
ocvPaymentKeyFile :: FilePath
ocvPaymentKeyFile :: OperatorConfigVerification -> FilePath
ocvPaymentKeyFile} =
  forall k.
PaymentExtendedKey k
-> Maybe (VerificationKey StakeKey) -> Operator k
Operator forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap VerificationKey PaymentKey -> PaymentExtendedKey Verification
PEVerification (FilePath -> IO (VerificationKey PaymentKey)
readVerificationKeyFromFile FilePath
ocvPaymentKeyFile) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse FilePath -> IO (VerificationKey StakeKey)
readStakingKeyFromFile Maybe FilePath
ocvStakeVerificationKeyFile

parseOperatorConfigSigning :: Parser OperatorConfigSigning
parseOperatorConfigSigning :: Parser OperatorConfigSigning
parseOperatorConfigSigning =
  FilePath -> Maybe FilePath -> OperatorConfigSigning
OperatorConfigSigning
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"signing-key-file" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The operator's signing key file.")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional  (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"stake-verification-key-file" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar FilePath
"FILE" forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"The operator's stake verification key file (optional)."))

parseOperatorConfigVerification :: Parser OperatorConfigVerification
parseOperatorConfigVerification :: Parser OperatorConfigVerification
parseOperatorConfigVerification =
  FilePath -> Maybe FilePath -> OperatorConfigVerification
OperatorConfigVerification
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"verification-key-file"  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Payment verification key of the operator")
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional  (forall s. IsString s => Mod OptionFields s -> Parser s
strOption (forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long FilePath
"stake-verification-key-file"  forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. FilePath -> Mod f a
help FilePath
"Stake verification key of the operator (optional)"))

generateOperator :: IO (Operator Signing)
generateOperator :: IO (Operator Signing)
generateOperator =
  forall k.
PaymentExtendedKey k
-> Maybe (VerificationKey StakeKey) -> Operator k
Operator
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap SigningKey PaymentKey -> PaymentExtendedKey Signing
PESigning (forall keyrole.
Key keyrole =>
AsType keyrole -> IO (SigningKey keyrole)
C.generateSigningKey AsType PaymentKey
C.AsPaymentKey)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing