diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs index 896a65e1b62..dbda11726b8 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/API/Payments.hs @@ -14,6 +14,11 @@ where import Prelude +import Cardano.Wallet.Deposit.Pure + ( BIP32Path (..) + , DerivationType (..) + , Word31 + ) import Cardano.Wallet.Deposit.Pure.API.Address ( encodeAddress ) @@ -31,6 +36,11 @@ import Data.Aeson , withObject , (.:) ) +import Data.Aeson.Types + ( Parser + , parseEither + , parseFail + ) import Data.Map.Monoidal.Strict ( MonoidalMap ) @@ -42,6 +52,7 @@ import Data.Text ) import GHC.Generics ( Generic + , S ) import Numeric.Natural ( Natural @@ -61,7 +72,8 @@ import Web.FormUrlEncoded import qualified Data.Aeson as Aeson import qualified Data.Map.Monoidal.Strict as MonoidalMap -import qualified Data.Text.Lazy as T +import qualified Data.Text as T +import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL newtype NewReceiver = NewReceiver Receiver @@ -104,23 +116,66 @@ data Transaction { dataType :: Text , description :: Text , cborHex :: Text + , inputBip32Paths :: [BIP32Path] } deriving (Eq, Show) instance ToJSON Transaction where - toJSON Transaction{dataType, description, cborHex} = + toJSON Transaction{dataType, description, cborHex, inputBip32Paths} = object [ "type" .= dataType , "description" .= description , "cborHex" .= cborHex + , "bip32Paths" .= (encodeBip32 <$> inputBip32Paths) ] +encodeBip32 :: BIP32Path -> Text +encodeBip32 (Segment Root Hardened n) = + T.pack (show n) + <> "H" +encodeBip32 (Segment Root Soft n) = + T.pack (show n) +encodeBip32 (Segment p Hardened n) = + encodeBip32 p + <> "/" + <> T.pack (show n) + <> "H" +encodeBip32 (Segment p Soft n) = + encodeBip32 p <> "/" <> T.pack (show n) +encodeBip32 Root = "" + instance FromJSON Transaction where parseJSON = withObject "Transaction" $ \o -> do dataType <- o .: "type" description <- o .: "description" cborHex <- o .: "cborHex" - pure Transaction{dataType, description, cborHex} + inputBip32Paths <- o .: "bip32Paths" >>= traverse parseBip32 + pure Transaction{dataType, description, cborHex, inputBip32Paths} + +decodeBip32 :: Text -> Either String BIP32Path +decodeBip32 = parseEither parseBip32 + +parseSegment :: Text -> Parser (Word31, DerivationType) +parseSegment t = case T.stripSuffix "H" t of + Nothing -> do + s <- parseIndex t + pure (s, Soft) + Just t' -> do + s <- parseIndex t' + pure (s, Hardened) + where + parseIndex :: Text -> Parser Word31 + parseIndex text = case reads $ T.unpack text of + [(i, "")] -> pure i + _ -> parseFail "Invalid index" + +parseBip32 :: Text -> Parser BIP32Path +parseBip32 t = case T.splitOn "/" t of + [] -> pure Root + xs -> foldSegments <$> traverse parseSegment xs + +foldSegments :: [(Word31, DerivationType)] -> BIP32Path +foldSegments = foldl (\p (i, t)-> Segment p t i) Root newtype Password = Password Text @@ -150,7 +205,7 @@ instance FromJSON State instance FromHttpApiData State where parseQueryParam :: Text -> Either Text State - parseQueryParam t = case Aeson.decode $ TL.encodeUtf8 $ T.fromStrict t of + parseQueryParam t = case Aeson.decode $ TL.encodeUtf8 $ TL.fromStrict t of Nothing -> Left "Invalid JSON for a State" Just tx -> pure tx diff --git a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Transaction.hs b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Transaction.hs index 102a4c93e27..1bcd256325a 100644 --- a/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Transaction.hs +++ b/lib/ui/src/Cardano/Wallet/UI/Deposit/Handlers/Payments/Transaction.hs @@ -18,7 +18,8 @@ import Cardano.Wallet.Deposit.IO.Network.Type ( ErrPostTx ) import Cardano.Wallet.Deposit.Pure - ( CanSign + ( BIP32Path + , CanSign , ErrCreatePayment , InspectTx (..) ) @@ -35,6 +36,7 @@ import Cardano.Wallet.Deposit.REST , availableBalance , canSign , createPayment + , getBIP32PathsForOwnedInputs , inspectTx , networkTag , resolveCurrentEraTx @@ -168,7 +170,8 @@ signPayment serializedTx (Password pwd) = do case mSignedTx of Nothing -> ExceptT $ pure $ Left PrivateKeyIsMissing Just signedTx -> do - pure $ serializeTransaction signedTx + paths <- lift $ getBIP32PathsForOwnedInputs signedTx + pure $ serializeTransaction paths signedTx receiversPayment :: Transaction -> ExceptT PaymentError WalletResourceM Receivers @@ -189,11 +192,16 @@ unsignedPayment receivers = do pure (address, ValueC (CoinC $ fromIntegral amount) mempty) case er of Left e -> ExceptT $ pure $ Left $ CreatePaymentError e - Right rtx -> pure $ serializeTransaction $ resolvedTx rtx + Right rtx -> do + paths <- lift $ getBIP32PathsForOwnedInputs $ resolvedTx rtx + pure $ serializeTransaction paths $ resolvedTx rtx -serializeTransaction :: Tx -> Transaction -serializeTransaction = - conwayEraTransactionExport +serializeTransaction + :: [BIP32Path] + -> Tx + -> Transaction +serializeTransaction paths = + conwayEraTransactionExport paths . T.decodeUtf8 . B16.encode . BL.toStrict @@ -259,12 +267,13 @@ signalHandler layer alert render state signal = do $ case r of x -> x -conwayEraTransactionExport :: Text -> Transaction -conwayEraTransactionExport cborHex = +conwayEraTransactionExport :: [BIP32Path] -> Text -> Transaction +conwayEraTransactionExport inputBip32Paths cborHex = Transaction { dataType = "Unwitnessed Tx ConwayEra" , description = "Ledger Cddl Format" , cborHex + , inputBip32Paths } data AddressValidationResponse diff --git a/lib/ui/test/unit/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/PageSpec.hs b/lib/ui/test/unit/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/PageSpec.hs index 7067cadb6cd..4ef93d4657d 100644 --- a/lib/ui/test/unit/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/PageSpec.hs +++ b/lib/ui/test/unit/Cardano/Wallet/UI/Deposit/Html/Pages/Payments/PageSpec.hs @@ -28,7 +28,9 @@ import Cardano.Wallet.Deposit.IO.Resource ( withResource ) import Cardano.Wallet.Deposit.Pure - ( Credentials + ( BIP32Path (..) + , Credentials + , DerivationType (..) ) import Cardano.Wallet.Deposit.Pure.State.Creation ( createMnemonicFromWords @@ -54,7 +56,9 @@ import Cardano.Wallet.Deposit.Write , mkTxOut ) import Cardano.Wallet.UI.Deposit.API.Payments - ( unsigned + ( decodeBip32 + , encodeBip32 + , unsigned ) import Cardano.Wallet.UI.Deposit.Handlers.Payments.Transaction ( deserializeTransaction @@ -82,6 +86,7 @@ import Test.Hspec ( Spec , describe , it + , shouldBe , shouldNotBe ) @@ -93,7 +98,8 @@ fakeBootEnv = do pure $ WalletBootEnv nullTracer Read.mockGenesisDataMainnet net mnemonics :: Text -mnemonics = "vital minimum victory start lunch find city peanut shiver soft hedgehog artwork mushroom loud found" +mnemonics = + "vital minimum victory start lunch find city peanut shiver soft hedgehog artwork mushroom loud found" seed :: SomeMnemonic Right seed = createMnemonicFromWords mnemonics @@ -134,6 +140,26 @@ fundTheWallet network = do Right () <- liftIO $ postTx network tx pure () +customer0 :: BIP32Path +customer0 = + ( Segment + ( Segment + ( Segment + ( Segment + (Segment Root Hardened 1857) + Hardened + 1815 + ) + Hardened + 0 + ) + Soft + 0 + ) + Soft + 0 + ) + spec :: Spec spec = do describe "payment" $ do @@ -148,3 +174,10 @@ spec = do change `shouldNotBe` [] ourInputs `shouldNotBe` [] fee `shouldNotBe` 0 + describe "inputh paths" $ do + it "has a json encoding" + $ do + encodeBip32 customer0 `shouldBe` "1857H/1815H/0H/0/0" + it "can be decoded after encoding" $ do + decodeBip32 "1857H/1815H/0H/0/0" + `shouldBe` Right customer0