module Hydra.Cardano.Api.KeyWitness where

import Hydra.Cardano.Api.Prelude

import Cardano.Ledger.Alonzo.TxWits qualified as Ledger
import Cardano.Ledger.Era qualified as Ledger
import Cardano.Ledger.Keys qualified as Ledger
import Data.Set qualified as Set

-- * Extras

-- | Construct a 'KeyWitness' from a transaction id and credentials.
signWith ::
  forall era.
  IsShelleyBasedEra era =>
  TxId ->
  SigningKey PaymentKey ->
  KeyWitness era
signWith :: forall era.
IsShelleyBasedEra era =>
TxId -> SigningKey PaymentKey -> KeyWitness era
signWith (TxId Hash StandardCrypto EraIndependentTxBody
h) signingKey :: SigningKey PaymentKey
signingKey@(PaymentSigningKey SignKeyDSIGN StandardCrypto
sk) =
  let (PaymentVerificationKey VKey 'Payment StandardCrypto
vk) = SigningKey PaymentKey -> VerificationKey PaymentKey
forall keyrole.
(Key keyrole, HasTypeProxy keyrole) =>
SigningKey keyrole -> VerificationKey keyrole
getVerificationKey SigningKey PaymentKey
signingKey
   in ShelleyBasedEra era
-> WitVKey 'Witness StandardCrypto -> KeyWitness era
forall era.
ShelleyBasedEra era
-> WitVKey 'Witness StandardCrypto -> KeyWitness era
ShelleyKeyWitness (forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra @era) (WitVKey 'Witness StandardCrypto -> KeyWitness era)
-> WitVKey 'Witness StandardCrypto -> KeyWitness era
forall a b. (a -> b) -> a -> b
$
        VKey 'Witness StandardCrypto
-> SignedDSIGN
     StandardCrypto (Hash StandardCrypto EraIndependentTxBody)
-> WitVKey 'Witness StandardCrypto
forall (kr :: KeyRole) c.
(Typeable kr, Crypto c) =>
VKey kr c
-> SignedDSIGN c (Hash c EraIndependentTxBody) -> WitVKey kr c
Ledger.WitVKey
          (VKey 'Payment StandardCrypto -> VKey 'Witness StandardCrypto
forall (a :: KeyRole -> * -> *) (r :: KeyRole) c.
HasKeyRole a =>
a r c -> a 'Witness c
Ledger.asWitness VKey 'Payment StandardCrypto
vk)
          (forall c a.
(Crypto c, Signable (DSIGN c) a) =>
SignKeyDSIGN (DSIGN c) -> a -> SignedDSIGN c a
Ledger.signedDSIGN @StandardCrypto SignKeyDSIGN StandardCrypto
sk Hash StandardCrypto EraIndependentTxBody
Hash Blake2b_256 EraIndependentTxBody
h)

-- * Type Conversions

-- | Convert a 'List' of cardano-api's 'KeyWitness' into a 'Set' of
-- cardano-ledger's 'WitVKey'.
--
-- NOTE: 'KeyWitness' is a bigger type than 'WitVKey' witness, this function
-- does not only the type conversion but also the selection of the right
-- underlying constructors. That means the size of the resulting set may be
-- smaller than the size of the list (but never bigger).
toLedgerKeyWitness ::
  [KeyWitness era] ->
  Set (Ledger.WitVKey 'Ledger.Witness StandardCrypto)
toLedgerKeyWitness :: forall era.
[KeyWitness era] -> Set (WitVKey 'Witness StandardCrypto)
toLedgerKeyWitness [KeyWitness era]
vkWits =
  [WitVKey 'Witness StandardCrypto]
-> Set (WitVKey 'Witness StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList [WitVKey 'Witness StandardCrypto
w | ShelleyKeyWitness ShelleyBasedEra era
_ WitVKey 'Witness StandardCrypto
w <- [KeyWitness era]
vkWits]

-- | Convert a 'List' of cardano-api's 'KeyWitness' into a 'Set' of
-- cardano-ledger's 'BootstrapWitness'.
--
-- NOTE: See note on 'toLedgerKeyWitness'.
toLedgerBootstrapWitness ::
  [KeyWitness era] ->
  Set (Ledger.BootstrapWitness StandardCrypto)
toLedgerBootstrapWitness :: forall era.
[KeyWitness era] -> Set (BootstrapWitness StandardCrypto)
toLedgerBootstrapWitness [KeyWitness era]
vkWits =
  [BootstrapWitness StandardCrypto]
-> Set (BootstrapWitness StandardCrypto)
forall a. Ord a => [a] -> Set a
Set.fromList [BootstrapWitness StandardCrypto
w | ShelleyBootstrapWitness ShelleyBasedEra era
_ BootstrapWitness StandardCrypto
w <- [KeyWitness era]
vkWits]

-- | Convert a cardano-ledger's 'TxWitness' object into a list of cardano-api's
-- 'KeyWitness'.
--
-- NOTE: this only concerns key and bootstrap witnesses. Scripts and auxiliary
-- data are obviously not part of the resulting list.
fromLedgerTxWitness ::
  forall era.
  ( IsShelleyBasedEra era
  , UsesStandardCrypto era
  , Ledger.Era (ShelleyLedgerEra era)
  ) =>
  Ledger.AlonzoTxWits (ShelleyLedgerEra era) ->
  [KeyWitness era]
fromLedgerTxWitness :: forall era.
(IsShelleyBasedEra era, UsesStandardCrypto era,
 Era (ShelleyLedgerEra era)) =>
AlonzoTxWits (ShelleyLedgerEra era) -> [KeyWitness era]
fromLedgerTxWitness AlonzoTxWits (ShelleyLedgerEra era)
wits =
  [[KeyWitness era]] -> [KeyWitness era]
forall a. Monoid a => [a] -> a
mconcat
    [ (WitVKey 'Witness StandardCrypto
 -> [KeyWitness era] -> [KeyWitness era])
-> [KeyWitness era]
-> Set (WitVKey 'Witness StandardCrypto)
-> [KeyWitness era]
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr
        ((:) (KeyWitness era -> [KeyWitness era] -> [KeyWitness era])
-> (WitVKey 'Witness StandardCrypto -> KeyWitness era)
-> WitVKey 'Witness StandardCrypto
-> [KeyWitness era]
-> [KeyWitness era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era
-> WitVKey 'Witness StandardCrypto -> KeyWitness era
forall era.
ShelleyBasedEra era
-> WitVKey 'Witness StandardCrypto -> KeyWitness era
ShelleyKeyWitness ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra)
        []
        (AlonzoTxWits (ShelleyLedgerEra era)
-> Set (WitVKey 'Witness (EraCrypto (ShelleyLedgerEra era)))
forall era.
Era era =>
AlonzoTxWits era -> Set (WitVKey 'Witness (EraCrypto era))
Ledger.txwitsVKey' AlonzoTxWits (ShelleyLedgerEra era)
wits)
    , (BootstrapWitness StandardCrypto
 -> [KeyWitness era] -> [KeyWitness era])
-> [KeyWitness era]
-> Set (BootstrapWitness StandardCrypto)
-> [KeyWitness era]
forall a b. (a -> b -> b) -> b -> Set a -> b
Set.foldr
        ((:) (KeyWitness era -> [KeyWitness era] -> [KeyWitness era])
-> (BootstrapWitness StandardCrypto -> KeyWitness era)
-> BootstrapWitness StandardCrypto
-> [KeyWitness era]
-> [KeyWitness era]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyBasedEra era
-> BootstrapWitness StandardCrypto -> KeyWitness era
forall era.
ShelleyBasedEra era
-> BootstrapWitness StandardCrypto -> KeyWitness era
ShelleyBootstrapWitness ShelleyBasedEra era
forall era. IsShelleyBasedEra era => ShelleyBasedEra era
shelleyBasedEra)
        []
        (AlonzoTxWits (ShelleyLedgerEra era)
-> Set (BootstrapWitness (EraCrypto (ShelleyLedgerEra era)))
forall era.
Era era =>
AlonzoTxWits era -> Set (BootstrapWitness (EraCrypto era))
Ledger.txwitsBoot' AlonzoTxWits (ShelleyLedgerEra era)
wits)
    ]