From b3695deb8f4dd06b464cdcb4bd45abf84110fa0e Mon Sep 17 00:00:00 2001 From: euonymos Date: Wed, 15 Jan 2025 18:06:10 -0600 Subject: [PATCH 1/2] chore: update nix setup --- flake.lock | 44 ++++++++++++++++++++++---------------------- 1 file changed, 22 insertions(+), 22 deletions(-) diff --git a/flake.lock b/flake.lock index f7f5bb4b..3daa762f 100644 --- a/flake.lock +++ b/flake.lock @@ -3,11 +3,11 @@ "CHaP": { "flake": false, "locked": { - "lastModified": 1725372492, - "narHash": "sha256-eQwfZIEHH5qHZQHXujgjj35dVAqSZa6EbTRWeppn1ME=", + "lastModified": 1736937016, + "narHash": "sha256-dmLSu2SvSaTDjSE03cU6DwY62J3nWJbVhIn/kKtMwJg=", "owner": "input-output-hk", "repo": "cardano-haskell-packages", - "rev": "05c9f8fb28fde6e46d8768ce396a4482883d6bab", + "rev": "045875beec586ff57a7333c0563fd5c2b1a308fa", "type": "github" }, "original": { @@ -155,11 +155,11 @@ "hackage": { "flake": false, "locked": { - "lastModified": 1725409900, - "narHash": "sha256-XfSA7YyjHUfuNsCw4cE6p0kQcmrJgQq3nW36Cw/PAv0=", + "lastModified": 1736900878, + "narHash": "sha256-gNHrCM1JydFpNhBLwniPVjZG8Z5TUVyI/A01NmdqZeE=", "owner": "input-output-hk", "repo": "hackage.nix", - "rev": "d86e544dec33ce5fb0ad3981be91074d397b700d", + "rev": "d042ec3dc44f5d15d908251c9e724ee8c017a065", "type": "github" }, "original": { @@ -208,11 +208,11 @@ "stackage": "stackage" }, "locked": { - "lastModified": 1725411053, - "narHash": "sha256-cW999pULNLOZHlV9sqBFIrWTkSxuVAVR6xJR7GndHdQ=", + "lastModified": 1736902273, + "narHash": "sha256-7x+uEZ8wgm3gocNgST5RQ5a1xEp4Is+VwGICqEgo/BM=", "owner": "input-output-hk", "repo": "haskell.nix", - "rev": "63783ecc949e99b2396ca821275cee26385adaba", + "rev": "94a061666cbd39c32468efed72dca29cf716c90a", "type": "github" }, "original": { @@ -377,16 +377,16 @@ "hls-2.9": { "flake": false, "locked": { - "lastModified": 1718469202, - "narHash": "sha256-THXSz+iwB1yQQsr/PY151+2GvtoJnTIB2pIQ4OzfjD4=", + "lastModified": 1720003792, + "narHash": "sha256-qnDx8Pk0UxtoPr7BimEsAZh9g2WuTuMB/kGqnmdryKs=", "owner": "haskell", "repo": "haskell-language-server", - "rev": "40891bccb235ebacce020b598b083eab9dda80f1", + "rev": "0c1817cb2babef0765e4e72dd297c013e8e3d12b", "type": "github" }, "original": { "owner": "haskell", - "ref": "2.9.0.0", + "ref": "2.9.0.1", "repo": "haskell-language-server", "type": "github" } @@ -614,11 +614,11 @@ }, "nixpkgs-2405": { "locked": { - "lastModified": 1720122915, - "narHash": "sha256-Nby8WWxj0elBu1xuRaUcRjPi/rU3xVbkAt2kj4QwX2U=", + "lastModified": 1729242558, + "narHash": "sha256-VgcLDu4igNT0eYua6OAl9pWCI0cYXhDbR+pWP44tte0=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "835cf2d3f37989c5db6585a28de967a667a75fb1", + "rev": "4a3f2d3195b60d07530574988df92e049372c10e", "type": "github" }, "original": { @@ -646,11 +646,11 @@ }, "nixpkgs-unstable": { "locked": { - "lastModified": 1720181791, - "narHash": "sha256-i4vJL12/AdyuQuviMMd1Hk2tsGt02hDNhA0Zj1m16N8=", + "lastModified": 1729980323, + "narHash": "sha256-eWPRZAlhf446bKSmzw6x7RWEE4IuZgAp8NW3eXZwRAY=", "owner": "NixOS", "repo": "nixpkgs", - "rev": "4284c2b73c8bce4b46a6adf23e16d9e2ec8da4bb", + "rev": "86e78d3d2084ff87688da662cf78c2af085d8e73", "type": "github" }, "original": { @@ -691,11 +691,11 @@ "stackage": { "flake": false, "locked": { - "lastModified": 1725408838, - "narHash": "sha256-tHw95xcMElCqI6xOLmdTAEvQ0/4IS7WBZc+RF7HT/uk=", + "lastModified": 1736899856, + "narHash": "sha256-1pmiaXI59iAfHOtTYU4hw7LdP7VVmyO9ZK5RG5F4Izc=", "owner": "input-output-hk", "repo": "stackage.nix", - "rev": "2ab3b5a823933ef199a289fbf39bbf0da0023100", + "rev": "c6a5d45df57c7669eb63e27ab4e8be212323d273", "type": "github" }, "original": { From 4e2dbe2d37d4b0ecb502df9eac56f9b419b54840 Mon Sep 17 00:00:00 2001 From: euonymos Date: Wed, 15 Jan 2025 18:56:52 -0600 Subject: [PATCH 2/2] feat: support extended keys in runGYTxMonadIO --- flake.nix | 1 + src/GeniusYield/Test/Clb.hs | 4 ++-- src/GeniusYield/Test/Privnet/Ctx.hs | 10 +++++++- src/GeniusYield/TxBuilder/Class.hs | 8 +++++-- src/GeniusYield/TxBuilder/IO.hs | 12 +++++----- src/GeniusYield/Types/Key.hs | 36 ++++++++++++++++++++++++++++- 6 files changed, 59 insertions(+), 12 deletions(-) diff --git a/flake.nix b/flake.nix index faddf1ce..cebab4c9 100644 --- a/flake.nix +++ b/flake.nix @@ -37,6 +37,7 @@ cabal = {} ; hlint = {}; haskell-language-server = {}; + fourmolu = {}; }; # Non-Haskell shell tools go here shell.buildInputs = with pkgs; [ diff --git a/src/GeniusYield/Test/Clb.hs b/src/GeniusYield/Test/Clb.hs index 3c531b35..db917ab0 100644 --- a/src/GeniusYield/Test/Clb.hs +++ b/src/GeniusYield/Test/Clb.hs @@ -409,8 +409,8 @@ instance GYTxUserQueryMonad GYTxMonadClb where Just (ref, _) -> return ref instance GYTxMonad GYTxMonadClb where - signTxBody = signTxBodyImpl . asks $ userPaymentSKey . clbEnvWallet - signTxBodyWithStake = signTxBodyWithStakeImpl $ asks ((,) . userPaymentSKey . clbEnvWallet) <*> asks (userStakeSKey . clbEnvWallet) + signTxBody = signTxBodyImpl . asks $ AGYPaymentSigningKey . userPaymentSKey . clbEnvWallet + signTxBodyWithStake = signTxBodyWithStakeImpl $ asks ((,) . AGYPaymentSigningKey . userPaymentSKey . clbEnvWallet) <*> asks (fmap AGYStakeSigningKey . userStakeSKey . clbEnvWallet) submitTx tx = do let txBody = getTxBody tx dumpBody txBody diff --git a/src/GeniusYield/Test/Privnet/Ctx.hs b/src/GeniusYield/Test/Privnet/Ctx.hs index d7efa5e2..957af145 100644 --- a/src/GeniusYield/Test/Privnet/Ctx.hs +++ b/src/GeniusYield/Test/Privnet/Ctx.hs @@ -165,7 +165,15 @@ ctxRunGame :: Ctx -> GYTxGameMonadIO a -> IO a ctxRunGame ctx = runGYTxGameMonadIO (ctxNetworkId ctx) (ctxProviders ctx) ctxRun :: Ctx -> User -> GYTxMonadIO a -> IO a -ctxRun ctx User' {..} = runGYTxMonadIO (ctxNetworkId ctx) (ctxProviders ctx) userPaymentSKey' userStakeSKey' [userAddr] userAddr Nothing +ctxRun ctx User' {..} = + runGYTxMonadIO + (ctxNetworkId ctx) + (ctxProviders ctx) + (AGYPaymentSigningKey userPaymentSKey') + (AGYStakeSigningKey <$> userStakeSKey') + [userAddr] + userAddr + Nothing ctxRunQuery :: Ctx -> GYTxQueryMonadIO a -> IO a ctxRunQuery ctx = runGYTxQueryMonadIO (ctxNetworkId ctx) (ctxProviders ctx) diff --git a/src/GeniusYield/TxBuilder/Class.hs b/src/GeniusYield/TxBuilder/Class.hs index 27df5f17..da6fd539 100644 --- a/src/GeniusYield/TxBuilder/Class.hs +++ b/src/GeniusYield/TxBuilder/Class.hs @@ -249,10 +249,14 @@ class GYTxBuilderMonad m => GYTxMonad m where -- by the identified transaction. awaitTxConfirmed' :: GYAwaitTxParameters -> GYTxId -> m () -signTxBodyImpl :: GYTxMonad m => m GYPaymentSigningKey -> GYTxBody -> m GYTx +signTxBodyImpl :: GYTxMonad m => m GYSomePaymentSigningKey -> GYTxBody -> m GYTx signTxBodyImpl kM txBody = signGYTxBody txBody . (: []) <$> kM -signTxBodyWithStakeImpl :: GYTxMonad m => m (GYPaymentSigningKey, Maybe GYStakeSigningKey) -> GYTxBody -> m GYTx +signTxBodyWithStakeImpl :: + GYTxMonad m => + m (GYSomePaymentSigningKey, Maybe GYSomeStakeSigningKey) -> + GYTxBody -> + m GYTx signTxBodyWithStakeImpl kM txBody = (\(pKey, sKey) -> signGYTxBody txBody $ GYSomeSigningKey pKey : maybeToList (GYSomeSigningKey <$> sKey)) <$> kM -- | Class of monads that can simulate a "game" between different users interacting with transactions. diff --git a/src/GeniusYield/TxBuilder/IO.hs b/src/GeniusYield/TxBuilder/IO.hs index 1f1e27da..2a3c646c 100644 --- a/src/GeniusYield/TxBuilder/IO.hs +++ b/src/GeniusYield/TxBuilder/IO.hs @@ -59,8 +59,8 @@ newtype GYTxMonadIO a = GYTxMonadIO (GYTxIOEnv -> GYTxBuilderMonadIO a) data GYTxIOEnv = GYTxIOEnv { envNid :: !GYNetworkId , envProviders :: !GYProviders - , envPaymentSKey :: !GYPaymentSigningKey - , envStakeSKey :: !(Maybe GYStakeSigningKey) + , envPaymentSKey :: !GYSomePaymentSigningKey + , envStakeSKey :: !(Maybe GYSomeStakeSigningKey) } -- INTERNAL USAGE ONLY @@ -95,9 +95,9 @@ runGYTxMonadIO :: -- | Provider. GYProviders -> -- | Payment signing key of the wallet - GYPaymentSigningKey -> + GYSomePaymentSigningKey -> -- | Stake signing key of the wallet (optional) - Maybe GYStakeSigningKey -> + Maybe GYSomeStakeSigningKey -> -- | Addresses belonging to wallet. [GYAddress] -> -- | Change address. @@ -176,8 +176,8 @@ instance GYTxGameMonad GYTxGameMonadIO where runGYTxMonadIO nid providers - userPaymentSKey - userStakeSKey + (AGYPaymentSigningKey userPaymentSKey) + (AGYStakeSigningKey <$> userStakeSKey) (NE.toList userAddresses) userChangeAddress (userCollateralDumb u) diff --git a/src/GeniusYield/Types/Key.hs b/src/GeniusYield/Types/Key.hs index c53c1b8e..1b02d4b8 100644 --- a/src/GeniusYield/Types/Key.hs +++ b/src/GeniusYield/Types/Key.hs @@ -107,6 +107,9 @@ module GeniusYield.Types.Key ( GYSomePaymentSigningKey (..), readSomePaymentSigningKey, somePaymentSigningKeyToSomeSigningKey, + GYSomeStakeSigningKey (..), + readSomeStakeSigningKey, + someStakeSigningKeyToSomeSigningKey, ) where import Cardano.Api qualified as Api @@ -756,9 +759,24 @@ data GYSomeSigningKey = forall a. (ToShelleyWitnessSigningKey a, Show a) => GYSo instance ToShelleyWitnessSigningKey GYSomeSigningKey where toShelleyWitnessSigningKey (GYSomeSigningKey skey) = toShelleyWitnessSigningKey skey -data GYSomePaymentSigningKey = AGYPaymentSigningKey !GYPaymentSigningKey | AGYExtendedPaymentSigningKey !GYExtendedPaymentSigningKey +data GYSomePaymentSigningKey + = AGYPaymentSigningKey !GYPaymentSigningKey + | AGYExtendedPaymentSigningKey !GYExtendedPaymentSigningKey deriving stock (Eq, Show, Ord) +instance ToShelleyWitnessSigningKey GYSomePaymentSigningKey where + toShelleyWitnessSigningKey (AGYPaymentSigningKey key) = toShelleyWitnessSigningKey key + toShelleyWitnessSigningKey (AGYExtendedPaymentSigningKey key) = toShelleyWitnessSigningKey key + +data GYSomeStakeSigningKey + = AGYStakeSigningKey !GYStakeSigningKey + | AGYExtendedStakeSigningKey !GYExtendedStakeSigningKey + deriving stock (Eq, Show, Ord) + +instance ToShelleyWitnessSigningKey GYSomeStakeSigningKey where + toShelleyWitnessSigningKey (AGYStakeSigningKey key) = toShelleyWitnessSigningKey key + toShelleyWitnessSigningKey (AGYExtendedStakeSigningKey key) = toShelleyWitnessSigningKey key + readSomePaymentSigningKey :: FilePath -> IO GYSomePaymentSigningKey readSomePaymentSigningKey file = do e <- @@ -771,6 +789,22 @@ readSomePaymentSigningKey file = do Left err -> throwIO $ userError $ show err Right skey -> return skey +readSomeStakeSigningKey :: FilePath -> IO GYSomeStakeSigningKey +readSomeStakeSigningKey file = do + e <- + Api.readFileTextEnvelopeAnyOf + [ Api.FromSomeType (Api.AsSigningKey Api.AsStakeKey) $ AGYStakeSigningKey . stakeSigningKeyFromApi + , Api.FromSomeType (Api.AsSigningKey Api.AsStakeExtendedKey) $ AGYExtendedStakeSigningKey . extendedStakeSigningKeyFromApi + ] + (Api.File file) + case e of + Left err -> throwIO $ userError $ show err + Right skey -> return skey + somePaymentSigningKeyToSomeSigningKey :: GYSomePaymentSigningKey -> GYSomeSigningKey somePaymentSigningKeyToSomeSigningKey (AGYPaymentSigningKey key) = GYSomeSigningKey key somePaymentSigningKeyToSomeSigningKey (AGYExtendedPaymentSigningKey key) = GYSomeSigningKey key + +someStakeSigningKeyToSomeSigningKey :: GYSomeStakeSigningKey -> GYSomeSigningKey +someStakeSigningKeyToSomeSigningKey (AGYStakeSigningKey key) = GYSomeSigningKey key +someStakeSigningKeyToSomeSigningKey (AGYExtendedStakeSigningKey key) = GYSomeSigningKey key