feat: introcution of AsPubKeyHash super class of CanSignTx and de…

…fining it's instance for `GYStakePoolId` Related to #294
geniusyield · Apr 28, 2024 · a47774f · a47774f
1 parent bd26908
commit a47774f
Show file tree

Hide file tree

Showing 6 changed files with 27 additions and 10 deletions.
diff --git a/src/GeniusYield/TxBuilder/Run.hs b/src/GeniusYield/TxBuilder/Run.hs
@@ -56,7 +56,6 @@ import qualified PlutusTx.Builtins.Internal                as Plutus
 
 import qualified Cardano.Simple.PlutusLedgerApi.V1.Scripts as Fork
 import           Data.Sequence                             (ViewR (..), viewr)
-import qualified Data.Text.Encoding                        as Text
 import           GeniusYield.Imports
 import           GeniusYield.Transaction                   (BuildTxException (BuildTxBalancingError),
                                                             GYCoinSelectionStrategy (GYRandomImproveMultiAsset))
@@ -223,7 +222,7 @@ instance GYTxQueryMonad GYTxMonadRun where
             Just r -> Just $
               GYStakeAddressInfo {
                   gyStakeAddressInfoAvailableRewards = fromInteger r,
-                  gyStakeAddressInfoDelegatedPool = Map.toList (stake'pools ms) & find (\(_pid, scs) -> sc `elem` pool'stakes scs) >>= (fst >>> unPoolId >>> pubKeyHashFromPlutus >>> rightToMaybe) >>= (pubKeyHashToApi >>> Api.serialiseToRawBytesHexText >>> Text.encodeUtf8 >>> Api.deserialiseFromRawBytesHex (Api.AsHash Api.AsStakePoolKey) >>> rightToMaybe) <&> stakePoolIdFromApi
+                  gyStakeAddressInfoDelegatedPool = Map.toList (stake'pools ms) & find (\(_pid, scs) -> sc `elem` pool'stakes scs) >>= (fst >>> unPoolId >>> pubKeyHashFromPlutus >>> rightToMaybe) <&> fromPubKeyHash
               }
 
     slotConfig = do

diff --git a/src/GeniusYield/Types/Credential.hs b/src/GeniusYield/Types/Credential.hs
@@ -31,7 +31,7 @@ import           GeniusYield.Types.PaymentKeyHash (GYPaymentKeyHash,
                                                    paymentKeyHashFromApi,
                                                    paymentKeyHashToApi,
                                                    paymentKeyHashToPlutus)
-import           GeniusYield.Types.PubKeyHash     (CanSignTx (fromPubKeyHash, toPubKeyHash))
+import           GeniusYield.Types.PubKeyHash     (AsPubKeyHash (fromPubKeyHash, toPubKeyHash))
 import           GeniusYield.Types.Script         (GYStakeValidatorHash,
                                                    GYValidatorHash,
                                                    stakeValidatorHashFromApi,

diff --git a/src/GeniusYield/Types/PaymentKeyHash.hs b/src/GeniusYield/Types/PaymentKeyHash.hs
@@ -24,7 +24,7 @@ import qualified Data.Text                    as Text
 import qualified Data.Text.Encoding           as Text
 import           GeniusYield.Imports
 import           GeniusYield.Types.Ledger
-import           GeniusYield.Types.PubKeyHash (CanSignTx (..))
+import           GeniusYield.Types.PubKeyHash (AsPubKeyHash (..), CanSignTx)
 import qualified PlutusLedgerApi.V1.Crypto    as Plutus
 import qualified PlutusTx.Builtins            as Plutus
 import qualified PlutusTx.Builtins.Internal   as Plutus
@@ -43,10 +43,12 @@ newtype GYPaymentKeyHash = GYPaymentKeyHash (Api.Hash Api.PaymentKey)
     deriving stock Show
     deriving newtype (Eq, Ord, IsString)
 
-instance CanSignTx GYPaymentKeyHash where
+instance AsPubKeyHash GYPaymentKeyHash where
   toPubKeyHash = unsafeCoerce  -- We could have exported `GYPubKeyHash` from an internal module but `GYPubKeyHash` needs an overhaul anyways.
   fromPubKeyHash = unsafeCoerce
 
+instance CanSignTx GYPaymentKeyHash
+
 -- |
 --
 -- >>> paymentKeyHashFromPlutus "e1cbb80db89e292269aeb93ec15eb963dda5176b66949fe1c2a6a38d"

diff --git a/src/GeniusYield/Types/PubKeyHash.hs b/src/GeniusYield/Types/PubKeyHash.hs
@@ -8,7 +8,8 @@ Stability   : develop
 -}
 module GeniusYield.Types.PubKeyHash (
     GYPubKeyHash (..),
-    CanSignTx (..),
+    AsPubKeyHash (..),
+    CanSignTx,
     pubKeyHashFromPlutus,
     pubKeyHashToPlutus,
     pubKeyHashToApi,
@@ -43,14 +44,18 @@ newtype GYPubKeyHash = GYPubKeyHash (Api.Hash Api.PaymentKey)
     deriving stock Show
     deriving newtype (Eq, Ord, IsString)
 
-class CanSignTx a where
+class AsPubKeyHash a where
   toPubKeyHash :: a -> GYPubKeyHash
   fromPubKeyHash :: GYPubKeyHash -> a
 
-instance CanSignTx GYPubKeyHash where
+class AsPubKeyHash a => CanSignTx a
+
+instance AsPubKeyHash GYPubKeyHash where
   toPubKeyHash = id
   fromPubKeyHash = id
 
+instance CanSignTx GYPubKeyHash
+
 -- |
 --
 -- >>> pubKeyHashFromPlutus "e1cbb80db89e292269aeb93ec15eb963dda5176b66949fe1c2a6a38d"

diff --git a/src/GeniusYield/Types/StakeKeyHash.hs b/src/GeniusYield/Types/StakeKeyHash.hs
@@ -21,7 +21,7 @@ import qualified Data.Csv                     as Csv
 import qualified Data.Swagger                 as Swagger
 import qualified Data.Swagger.Internal.Schema as Swagger
 import qualified Data.Text.Encoding           as Text
-import           GeniusYield.Types.PubKeyHash (CanSignTx (..))
+import           GeniusYield.Types.PubKeyHash (AsPubKeyHash (..), CanSignTx)
 import qualified Text.Printf                  as Printf
 import           Unsafe.Coerce                (unsafeCoerce)
 
@@ -37,10 +37,12 @@ newtype GYStakeKeyHash = GYStakeKeyHash (Api.Hash Api.StakeKey)
     deriving stock Show
     deriving newtype (Eq, Ord, IsString)
 
-instance CanSignTx GYStakeKeyHash where
+instance AsPubKeyHash GYStakeKeyHash where
   toPubKeyHash = unsafeCoerce
   fromPubKeyHash = unsafeCoerce
 
+instance CanSignTx GYStakeKeyHash
+
 -- |
 --
 -- >>> let Just skh = Aeson.decode @GYStakeKeyHash "\"7a77d120b9e86addc7388dbbb1bd2350490b7d140ab234038632334d\""

diff --git a/src/GeniusYield/Types/StakePoolId.hs b/src/GeniusYield/Types/StakePoolId.hs
@@ -28,6 +28,9 @@ import qualified Data.Swagger.Internal.Schema as Swagger
 import qualified Data.Text                    as Text
 import qualified Data.Text.Encoding           as Text
 import           GeniusYield.Imports
+import           GeniusYield.Types.PubKeyHash (AsPubKeyHash (..),
+                                               pubKeyHashFromApi,
+                                               pubKeyHashToApi)
 import qualified Text.Printf                  as Printf
 import qualified Web.HttpApiData              as Web
 
@@ -70,6 +73,12 @@ stakePoolIdToApi = coerce
 stakePoolIdFromApi :: Api.Hash Api.StakePoolKey -> GYStakePoolId
 stakePoolIdFromApi = coerce
 
+-- >>> fromPubKeyHash @GYStakePoolId (toPubKeyHash spId)
+-- unsafeStakePoolIdFromText "pool1cjz6kg9a8ug9uk0nc59q60a67c2628ms58rd98gq587jwa2x5qt"
+instance AsPubKeyHash GYStakePoolId where
+  toPubKeyHash = stakePoolIdToApi >>> Api.serialiseToRawBytesHex >>> Api.deserialiseFromRawBytesHex (Api.AsHash Api.AsPaymentKey) >>> either (error "AsPubKeyHash.toPubKeyHash: Absurd (GYStakePoolId)") id >>> pubKeyHashFromApi
+  fromPubKeyHash = pubKeyHashToApi >>> Api.serialiseToRawBytesHex >>> Api.deserialiseFromRawBytesHex (Api.AsHash Api.AsStakePoolKey) >>> either (error "AsPubKeyHash.fromPubKeyHash: Absurd (GYStakePoolId)") id >>> stakePoolIdFromApi
+
 -- |
 --
 -- >>> let Just spid = Aeson.decode @GYStakePoolId "\"c485ab20bd3f105e59f3c50a0d3fbaf615a51f70a1c6d29d00a1fd27\""