Add new Alonzo-era code required to create a mint transaction

lib/shelley/src/Cardano/Wallet/Shelley/Compatibility.hs

@@ -35,6 +35,8 @@ module Cardano.Wallet.Shelley.Compatibility
     , AllegraEra
     , CardanoBlock
     , NetworkId
+    , ErrScriptConversion(..)
+    , ErrScriptWitnessConversion(..)
 
     , NodeVersionData
     , StandardCrypto
@@ -59,6 +61,9 @@ module Cardano.Wallet.Shelley.Compatibility
     , toAllegraTxOut
     , toMaryTxOut
     , toCardanoLovelace
+    , toCardanoScript
+    , toCardanoScriptWitness
+    , toCardanoPolicyId
     , sealShelleyTx
     , toStakeKeyRegCert
     , toStakeKeyDeregCert
@@ -120,6 +125,8 @@ module Cardano.Wallet.Shelley.Compatibility
     , invertUnitInterval
     , interval0
     , interval1
+    , prettyPrintScriptConversionError
+    , prettyPrintScriptWitnessConversionError
     ) where
 
 import Prelude
@@ -219,6 +226,8 @@ import Data.Word
     ( Word16, Word32, Word64, Word8 )
 import Fmt
     ( Buildable (..) )
+import GHC.Generics
+    ( Generic )
 import GHC.Stack
     ( HasCallStack )
 import GHC.TypeLits
@@ -261,6 +270,7 @@ import Ouroboros.Network.Point
 import Type.Reflection
     ( Typeable, typeRep )
 
+import qualified Cardano.Address.Script as Cardano.Address
 import qualified Cardano.Address.Style.Shelley as CA
 import qualified Cardano.Api as Cardano
 import qualified Cardano.Api.Byron as Cardano
@@ -301,6 +311,7 @@ import qualified Data.ByteString.Lazy as BL
 import qualified Data.ByteString.Short as SBS
 import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
+import qualified Data.Text as T
 import qualified Data.Text.Encoding as T
 import qualified Ouroboros.Consensus.Shelley.Ledger as O
 import qualified Ouroboros.Network.Block as O
@@ -313,6 +324,47 @@ import qualified Shelley.Spec.Ledger.UTxO as SL
 type NodeVersionData =
     (NodeToClientVersionData, CodecCBORTerm Text NodeToClientVersionData)
 
+-- | Errors that can occur when converting our script type to the
+-- underlying cardano-api script type.
+data ErrScriptConversion
+    = ErrScriptConversionHashExpectedSize !Int
+    | ErrScriptConversionExpectedPaymentKey
+    deriving (Generic, Eq, Show)
+
+prettyPrintScriptConversionError :: ErrScriptConversion -> T.Text
+prettyPrintScriptConversionError = \case
+    ErrScriptConversionHashExpectedSize sz ->
+        "Expected a hash of size '" <> T.pack (show sz) <> "'."
+    ErrScriptConversionExpectedPaymentKey  ->
+        "Scripts can't require the signature of a delegation key."
+
+-- | Errors that can occur when converting our script type to the
+-- underlying cardano-api script type.
+data ErrScriptWitnessConversion era
+    = ErrUnderlyingScriptConversionError ErrScriptConversion
+    | ErrScriptLanguageNotSupportedInEra
+        (Cardano.CardanoEra era)
+        (Cardano.SimpleScriptVersion Cardano.SimpleScriptV2)
+    deriving (Generic, Eq, Show)
+
+prettyPrintScriptWitnessConversionError
+    :: ErrScriptWitnessConversion era -> T.Text
+prettyPrintScriptWitnessConversionError = \case
+    ErrUnderlyingScriptConversionError err ->
+        prettyPrintScriptConversionError err
+    ErrScriptLanguageNotSupportedInEra
+      era Cardano.SimpleScriptV2 ->
+        "The script language 'SimpleScriptV2' is not supported in the "
+        <> prettyPrintCardanoEra era <> " era."
+
+prettyPrintCardanoEra :: CardanoEra era -> T.Text
+prettyPrintCardanoEra = \case
+    ByronEra -> "Byron"
+    ShelleyEra -> "Shelley"
+    AllegraEra -> "Allegra"
+    MaryEra -> "Mary"
+    AlonzoEra -> "Alonzo"
+
 --------------------------------------------------------------------------------
 --
 -- Chain Parameters
@@ -1202,18 +1254,82 @@ toCardanoValue tb = Cardano.valueFromList $
     toCardanoAssetId (TokenBundle.AssetId pid name) =
         Cardano.AssetId (toCardanoPolicyId pid) (toCardanoAssetName name)
 
-    toCardanoPolicyId (W.UnsafeTokenPolicyId (W.Hash pid)) = just "PolicyId" $
-        Cardano.deserialiseFromRawBytes Cardano.AsPolicyId pid
     toCardanoAssetName (W.UnsafeTokenName name) = just "TokenName" $
         Cardano.deserialiseFromRawBytes Cardano.AsAssetName name
 
-    just :: String -> Maybe a -> a
-    just t = fromMaybe $ error $
-        "toMaryTxOut: Internal error: unable to deserialise " ++ t
-
     coinToQuantity = fromIntegral . W.unCoin
     toQuantity = fromIntegral . W.unTokenQuantity
 
+toCardanoScriptWitness
+    :: CardanoEra era
+    -> Cardano.Address.Script Cardano.Address.KeyHash
+    -> Either (ErrScriptWitnessConversion era) (Cardano.ScriptWitness witctx era)
+toCardanoScriptWitness era script =
+    let
+        ver = Cardano.SimpleScriptV2
+        lang = Cardano.SimpleScriptLanguage ver
+    in
+        case Cardano.scriptLanguageSupportedInEra era lang of
+            Nothing ->
+                Left $ ErrScriptLanguageNotSupportedInEra era ver
+            Just langEra ->
+                case toCardanoScript script of
+                    Left scriptConversionErr ->
+                        Left
+                        $ ErrUnderlyingScriptConversionError scriptConversionErr
+                    Right cardanoScript ->
+                        Right
+                        $ Cardano.SimpleScriptWitness langEra ver cardanoScript
+
+toCardanoScript
+    :: Cardano.Address.Script Cardano.Address.KeyHash
+    -> Either ErrScriptConversion (Cardano.SimpleScript Cardano.SimpleScriptV2)
+toCardanoScript = \case
+    Cardano.Address.RequireSignatureOf keyHash ->
+        Cardano.RequireSignature
+        <$> toCardanoKeyHash keyHash
+    Cardano.Address.RequireAllOf ss ->
+        Cardano.RequireAllOf
+        <$> traverse toCardanoScript ss
+    Cardano.Address.RequireAnyOf ss ->
+        Cardano.RequireAnyOf
+        <$> traverse toCardanoScript ss
+    Cardano.Address.RequireSomeOf n ss ->
+        Cardano.RequireMOf (fromIntegral n)
+        <$> traverse toCardanoScript ss
+    Cardano.Address.ActiveFromSlot slot ->
+        Right
+        $ Cardano.RequireTimeAfter Cardano.TimeLocksInSimpleScriptV2
+        $ fromIntegral slot
+    Cardano.Address.ActiveUntilSlot slot ->
+        Right
+        $ Cardano.RequireTimeBefore Cardano.TimeLocksInSimpleScriptV2
+        $ fromIntegral slot
+
+toCardanoKeyHash
+    :: Cardano.Address.KeyHash
+    -> Either ErrScriptConversion (Cardano.Hash Cardano.PaymentKey)
+toCardanoKeyHash = \case
+    Cardano.Address.KeyHash Cardano.Address.Delegation _ ->
+        Left ErrScriptConversionExpectedPaymentKey
+    Cardano.Address.KeyHash Cardano.Address.Payment bs ->
+        case Crypto.hashFromBytes bs of
+            Nothing -> Left
+                $ ErrScriptConversionHashExpectedSize
+                $ fromIntegral
+                $ Crypto.sizeHash (Proxy :: Proxy Crypto.Blake2b_224)
+            Just h  -> Right
+                $ Cardano.PaymentKeyHash
+                $ SL.KeyHash h
+
+toCardanoPolicyId :: W.TokenPolicyId -> Cardano.PolicyId
+toCardanoPolicyId (W.UnsafeTokenPolicyId (W.Hash pid)) = just "PolicyId" $
+    Cardano.deserialiseFromRawBytes Cardano.AsPolicyId pid
+
+just :: String -> Maybe a -> a
+just t = fromMaybe $ error $
+    "toMaryTxOut: Internal error: unable to deserialise " ++ t
+
 -- | Convert from reward account address (which is a hash of a public key)
 -- to a shelley ledger stake credential.
 toStakeCredential :: W.RewardAccount -> SL.StakeCredential crypto