solana-haskell-sdk (empty) → 1.2.0.0
raw patch · 86 files changed
+12792/−0 lines, 86 filesdep +aesondep +basedep +base16-bytestring
Dependencies added: aeson, base, base16-bytestring, base58-bytestring, base64, binary, bytestring, containers, crypton, ed25519, either, extra, jsonrpc-tinyclient, memory, mtl, solana-haskell-sdk, tasty, tasty-hunit, tasty-quickcheck, text, vector, web3, web3-provider, websockets
Files
- CHANGELOG.md +95/−0
- LICENSE +202/−0
- README.md +257/−0
- app/Main.hs +46/−0
- solana-haskell-sdk.cabal +215/−0
- src/Network/Solana/Constants.hs +19/−0
- src/Network/Solana/Core/Account.hs +149/−0
- src/Network/Solana/Core/Block.hs +61/−0
- src/Network/Solana/Core/Borsh.hs +97/−0
- src/Network/Solana/Core/Compact.hs +126/−0
- src/Network/Solana/Core/Crypto.hs +285/−0
- src/Network/Solana/Core/Instruction.hs +176/−0
- src/Network/Solana/Core/Message.hs +384/−0
- src/Network/Solana/Core/Pda.hs +67/−0
- src/Network/Solana/Core/Transaction.hs +24/−0
- src/Network/Solana/Core/VersionedMessage.hs +244/−0
- src/Network/Solana/Metaplex/TokenMetadata.hs +377/−0
- src/Network/Solana/NativePrograms/AddressLookupTable.hs +248/−0
- src/Network/Solana/NativePrograms/BpfLoaderUpgradeable.hs +263/−0
- src/Network/Solana/NativePrograms/ComputeBudget.hs +77/−0
- src/Network/Solana/NativePrograms/Secp256k1.hs +130/−0
- src/Network/Solana/NativePrograms/Stake.hs +415/−0
- src/Network/Solana/NativePrograms/SystemProgram.hs +456/−0
- src/Network/Solana/NativePrograms/Vote.hs +199/−0
- src/Network/Solana/RPC/HTTP/Account.hs +210/−0
- src/Network/Solana/RPC/HTTP/Block.hs +265/−0
- src/Network/Solana/RPC/HTTP/Chain.hs +221/−0
- src/Network/Solana/RPC/HTTP/Ledger.hs +208/−0
- src/Network/Solana/RPC/HTTP/Token.hs +162/−0
- src/Network/Solana/RPC/HTTP/Tokenomics.hs +232/−0
- src/Network/Solana/RPC/HTTP/Transaction.hs +143/−0
- src/Network/Solana/RPC/HTTP/Types.hs +129/−0
- src/Network/Solana/RPC/WebSocket.hs +332/−0
- src/Network/Solana/SolanaWeb3.hs +271/−0
- src/Network/Solana/SplPrograms/AssociatedTokenAccount.hs +75/−0
- src/Network/Solana/SplPrograms/Memo.hs +44/−0
- src/Network/Solana/SplPrograms/Token.hs +499/−0
- src/Network/Solana/Sysvar.hs +65/−0
- test-integration/Main.hs +62/−0
- test-integration/Test/Integration/Alt.hs +63/−0
- test-integration/Test/Integration/Nonce.hs +56/−0
- test-integration/Test/Integration/PriorityFee.hs +52/−0
- test-integration/Test/Integration/Setup.hs +184/−0
- test-integration/Test/Integration/Token.hs +53/−0
- test-integration/Test/Integration/Transfer.hs +72/−0
- test-integration/Test/Integration/WebSocket.hs +66/−0
- test/Main.hs +57/−0
- test/Test/Core/Account.hs +22/−0
- test/Test/Core/Block.hs +31/−0
- test/Test/Core/Borsh.hs +146/−0
- test/Test/Core/Compact.hs +44/−0
- test/Test/Core/Crypto.hs +49/−0
- test/Test/Core/Instruction.hs +28/−0
- test/Test/Core/Message.hs +237/−0
- test/Test/Core/Pda.hs +36/−0
- test/Test/Core/VersionedMessage.hs +149/−0
- test/Test/Fixtures.hs +66/−0
- test/Test/Metaplex/TokenMetadata.hs +301/−0
- test/Test/NativePrograms/AddressLookupTable.hs +201/−0
- test/Test/NativePrograms/BpfLoaderUpgradeable.hs +150/−0
- test/Test/NativePrograms/ComputeBudget.hs +60/−0
- test/Test/NativePrograms/Secp256k1.hs +75/−0
- test/Test/NativePrograms/Stake.hs +236/−0
- test/Test/NativePrograms/SystemProgram.hs +188/−0
- test/Test/NativePrograms/Vote.hs +120/−0
- test/Test/RPC/Chain.hs +20/−0
- test/Test/RPC/Parsers.hs +194/−0
- test/Test/RPC/WebSocket.hs +192/−0
- test/Test/SplPrograms/AssociatedTokenAccount.hs +53/−0
- test/Test/SplPrograms/Memo.hs +31/−0
- test/Test/SplPrograms/Token.hs +320/−0
- test/fixtures/alt_instruction_data.json +22/−0
- test/fixtures/compute_budget_instruction_data.json +18/−0
- test/fixtures/loader_instruction_data.json +34/−0
- test/fixtures/memo_instruction_data.json +6/−0
- test/fixtures/messages.json +10/−0
- test/fixtures/metadata_instruction_data.json +61/−0
- test/fixtures/pda.json +42/−0
- test/fixtures/rpc_responses.json +1163/−0
- test/fixtures/secp256k1.json +22/−0
- test/fixtures/stake_instruction_data.json +54/−0
- test/fixtures/state_fixtures.json +46/−0
- test/fixtures/system_instruction_data.json +54/−0
- test/fixtures/token_instruction_data.json +102/−0
- test/fixtures/transactions.json +46/−0
- test/fixtures/vote_instruction_data.json +30/−0
+ CHANGELOG.md view
@@ -0,0 +1,95 @@+# Revision history for solana-haskell-sdk++## 1.2.0.0 -- 2026-08-03++* Added on-chain account-state decoders (SPL token accounts and mints, address lookup tables, stake and nonce accounts, Metaplex metadata) with typed SolanaWeb3 fetch helpers; decoded lookup tables feed compileV0Message directly.+* Added developer-experience helpers: explicit fee-payer transactions with automatic signature ordering (sponsored fees supported), a durable-nonce transaction flow, and priority-fee estimation.+* Added an opt-in local-validator integration test suite (`integration-tests`, behind the `integration` cabal flag) covering SOL and sponsored transfers, the SPL token lifecycle, durable nonces, address lookup tables with v0 transactions, priority fees, and WebSocket confirmation; the suite skips itself when no validator is running.+* Added golden tests for the JSON-RPC response parsers, replaying 37 responses recorded from a live validator by `tools/rpc-record`, so every `FromJSON` instance is asserted against JSON a node actually sends.+* Added Solana PubSub (WebSocket) support in `Network.Solana.RPC.WebSocket`: signature and account subscribe/unsubscribe requests, notification parsing, and `awaitSignature` — a push-based confirmation that replaces polling. The module is transport-agnostic (`WsTransport`), so the library gains no new dependency and works with both `ws://` and `wss://` endpoints.++## 1.1.0.0 -- 2026-08-01++* Added Metaplex Token Metadata client (CreateMetadataAccountV3, UpdateMetadataAccountV2, CreateMasterEditionV3) with metadata/master-edition PDA derivation, built on a new minimal Borsh serialization layer.+* Added Address Lookup Table program client and versioned (v0) transaction support: compile messages against lookup tables and sign VersionedTransactions (encode-only; account-state parsing out of scope). The `CompileException` constructor (`MissingIndex`) is now exported for error inspection.+* Hackage-ready packaging: PVP upper bounds on all dependencies; homepage and bug-reports metadata.++## 1.0.0.0 -- 2026-08-01++First stable release: byte-verified clients for System, Compute Budget, Stake, Vote, BPF Loader (upgradeable), Secp256k1, SPL Memo, SPL Token, and Associated Token Account programs; PDA derivation; canonical Rust-identical message compilation.++* Changed: `sendTransaction`'s default configuration no longer skips preflight+ simulation and no longer caps retries — submissions now follow the node's+ defaults (preflight runs; the node rebroadcasts until blockhash expiry).+ Transactions failing simulation return an RPC error instead of a signature.+* Changed: account-fetching RPC methods now request `base64` encoding+ explicitly for reliable binary account data.+* Hardened all RPC-facing JSON parsers to be total: malformed or unexpected+ node responses (failed transactions, v0 transactions, pruned/unknown slots)+ no longer crash the client.+* Fixed: `mkPrivateKeyFromString` rejected valid 64-byte private keys; now+ parses them correctly.+* Fixed: `BlockHash` and `CompactArray` `Binary` decoding were asymmetric+ with their `put` (falling back to an incompatible/length-prefixed+ decoder); both now round-trip correctly.+* Fixed documentation typos referring to the `RPCResponse` type (the+ exported name never changed) and renamed RPC fields for consistency+ (`Ammount*` -> `Amount*`); changed transaction/account error fields to+ structured `Maybe Value` instead of partial `Maybe String`.+* Renamed `ClusterNodes.sharedVersion` to `shredVersion` (typo fix; matches+ the RPC field).+* Added `confirmTransaction` to `SolanaWeb3`: polls for `confirmed`/+ `finalized` status instead of a fixed `wait`.+* Haddock coverage completed for the Core, RPC/HTTP, and SolanaWeb3 modules+ touched by the quality pass (module headers and per-export documentation);+ `cabal haddock` exits 0 with a handful of internal native/SPL-program+ helpers still undocumented.+* Added upgradeable BPF loader client (buffer/write/deploy/upgrade/authority/+ close/extend) with program-data address derivation.+* Added secp256k1 precompile client: signature-verification instruction+ construction from a precomputed signature (signing is out of scope).+* Added Stake program client (initialize, authorize, delegate, split, withdraw,+ deactivate, lockup, merge, checked variants) — golden-tested against the Rust SDK.+* Added Vote program client (account management: initialize, authorize, withdraw,+ identity/commission updates); consensus voting instructions are out of scope.+* Added SPL Token program client (instructions 0-20: mint/account initialization,+ transfers, approvals, minting, burning, freezing, multisig support) —+ golden-tested against the `spl-token` Rust crate.+* Added Associated Token Account program client with address derivation.+* Added Program Derived Address (PDA) support: `createProgramAddress` /+ `findProgramAddress` with ed25519 on-curve rejection (new `crypton` and `memory` dependencies).+* Added Compute Budget program client: request heap frame, set compute unit+ limit, set compute unit price (priority fees), set loaded accounts data size+ limit — golden-tested against the Rust SDK.+* Added SPL Memo (v2) program client.+* Added binary decoding for `SystemInstruction` and `ComputeBudgetInstruction`+ (symmetric `Binary` instances, round-trip tested).+* Fixed: account keys within each privilege section are now ordered+ canonically (sorted by pubkey, fee payer first) to match the Rust SDK, so+ multi-program messages serialize byte-identically. For multi-signer+ transactions, signing keys must be passed in the canonical account order+ (fee payer first).+* Test suite: golden vectors generated from the Rust `solana-sdk` (byte-for-byte+ serialization checks at instruction, message, and signed-transaction level),+ plus QuickCheck properties for compact-u16, crypto round-trips, and message+ header/key-ordering invariants.+* Fixed: pubkeys inside System Program instruction data were serialized with a+ length prefix (invalid wire format).+* Fixed: `CreateAccountWithSeed` seed was missing its u64 length prefix.+* Fixed: `SolanaSignature` binary decoding read 32 bytes instead of 64.+* Fixed: the program id was appended as an extra account to every instruction;+ it is now added only to the message account keys.+* Fixed: account privilege deduplication in message building used the wrong+ buckets to decide writability, producing duplicate keys or wrongly-writable+ accounts when the same account appeared in several instructions with mixed+ privileges.+* Fixed: compact-u16 decoding now rejects aliased (non-canonical) encodings.+* Fixed: `CompiledInstruction` JSON parsing fails cleanly on invalid base58.+* Added the 9 remaining System Program instructions: nonce account management+ (advance, withdraw, initialize, authorize, upgrade) and+ allocate/assign/transfer with seed.+* Added CI (GitHub Actions).++## 0.1.0.0 -- 2024 (unreleased alpha)++* Initial alpha: JSON-RPC API client, key management, System Program transfers.
+ LICENSE view
@@ -0,0 +1,202 @@++ Apache License+ Version 2.0, January 2004+ http://www.apache.org/licenses/++ TERMS AND CONDITIONS FOR USE, REPRODUCTION, AND DISTRIBUTION++ 1. Definitions.++ "License" shall mean the terms and conditions for use, reproduction,+ and distribution as defined by Sections 1 through 9 of this document.++ "Licensor" shall mean the copyright owner or entity authorized by+ the copyright owner that is granting the License.++ "Legal Entity" shall mean the union of the acting entity and all+ other entities that control, are controlled by, or are under common+ control with that entity. For the purposes of this definition,+ "control" means (i) the power, direct or indirect, to cause the+ direction or management of such entity, whether by contract or+ otherwise, or (ii) ownership of fifty percent (50%) or more of the+ outstanding shares, or (iii) beneficial ownership of such entity.++ "You" (or "Your") shall mean an individual or Legal Entity+ exercising permissions granted by this License.++ "Source" form shall mean the preferred form for making modifications,+ including but not limited to software source code, documentation+ source, and configuration files.++ "Object" form shall mean any form resulting from mechanical+ transformation or translation of a Source form, including but+ not limited to compiled object code, generated documentation,+ and conversions to other media types.++ "Work" shall mean the work of authorship, whether in Source or+ Object form, made available under the License, as indicated by a+ copyright notice that is included in or attached to the work+ (an example is provided in the Appendix below).++ "Derivative Works" shall mean any work, whether in Source or Object+ form, that is based on (or derived from) the Work and for which the+ editorial revisions, annotations, elaborations, or other modifications+ represent, as a whole, an original work of authorship. For the purposes+ of this License, Derivative Works shall not include works that remain+ separable from, or merely link (or bind by name) to the interfaces of,+ the Work and Derivative Works thereof.++ "Contribution" shall mean any work of authorship, including+ the original version of the Work and any modifications or additions+ to that Work or Derivative Works thereof, that is intentionally+ submitted to Licensor for inclusion in the Work by the copyright owner+ or by an individual or Legal Entity authorized to submit on behalf of+ the copyright owner. For the purposes of this definition, "submitted"+ means any form of electronic, verbal, or written communication sent+ to the Licensor or its representatives, including but not limited to+ communication on electronic mailing lists, source code control systems,+ and issue tracking systems that are managed by, or on behalf of, the+ Licensor for the purpose of discussing and improving the Work, but+ excluding communication that is conspicuously marked or otherwise+ designated in writing by the copyright owner as "Not a Contribution."++ "Contributor" shall mean Licensor and any individual or Legal Entity+ on behalf of whom a Contribution has been received by Licensor and+ subsequently incorporated within the Work.++ 2. Grant of Copyright License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ copyright license to reproduce, prepare Derivative Works of,+ publicly display, publicly perform, sublicense, and distribute the+ Work and such Derivative Works in Source or Object form.++ 3. Grant of Patent License. Subject to the terms and conditions of+ this License, each Contributor hereby grants to You a perpetual,+ worldwide, non-exclusive, no-charge, royalty-free, irrevocable+ (except as stated in this section) patent license to make, have made,+ use, offer to sell, sell, import, and otherwise transfer the Work,+ where such license applies only to those patent claims licensable+ by such Contributor that are necessarily infringed by their+ Contribution(s) alone or by combination of their Contribution(s)+ with the Work to which such Contribution(s) was submitted. If You+ institute patent litigation against any entity (including a+ cross-claim or counterclaim in a lawsuit) alleging that the Work+ or a Contribution incorporated within the Work constitutes direct+ or contributory patent infringement, then any patent licenses+ granted to You under this License for that Work shall terminate+ as of the date such litigation is filed.++ 4. Redistribution. You may reproduce and distribute copies of the+ Work or Derivative Works thereof in any medium, with or without+ modifications, and in Source or Object form, provided that You+ meet the following conditions:++ (a) You must give any other recipients of the Work or+ Derivative Works a copy of this License; and++ (b) You must cause any modified files to carry prominent notices+ stating that You changed the files; and++ (c) You must retain, in the Source form of any Derivative Works+ that You distribute, all copyright, patent, trademark, and+ attribution notices from the Source form of the Work,+ excluding those notices that do not pertain to any part of+ the Derivative Works; and++ (d) If the Work includes a "NOTICE" text file as part of its+ distribution, then any Derivative Works that You distribute must+ include a readable copy of the attribution notices contained+ within such NOTICE file, excluding those notices that do not+ pertain to any part of the Derivative Works, in at least one+ of the following places: within a NOTICE text file distributed+ as part of the Derivative Works; within the Source form or+ documentation, if provided along with the Derivative Works; or,+ within a display generated by the Derivative Works, if and+ wherever such third-party notices normally appear. The contents+ of the NOTICE file are for informational purposes only and+ do not modify the License. You may add Your own attribution+ notices within Derivative Works that You distribute, alongside+ or as an addendum to the NOTICE text from the Work, provided+ that such additional attribution notices cannot be construed+ as modifying the License.++ You may add Your own copyright statement to Your modifications and+ may provide additional or different license terms and conditions+ for use, reproduction, or distribution of Your modifications, or+ for any such Derivative Works as a whole, provided Your use,+ reproduction, and distribution of the Work otherwise complies with+ the conditions stated in this License.++ 5. Submission of Contributions. Unless You explicitly state otherwise,+ any Contribution intentionally submitted for inclusion in the Work+ by You to the Licensor shall be under the terms and conditions of+ this License, without any additional terms or conditions.+ Notwithstanding the above, nothing herein shall supersede or modify+ the terms of any separate license agreement you may have executed+ with Licensor regarding such Contributions.++ 6. Trademarks. This License does not grant permission to use the trade+ names, trademarks, service marks, or product names of the Licensor,+ except as required for reasonable and customary use in describing the+ origin of the Work and reproducing the content of the NOTICE file.++ 7. Disclaimer of Warranty. Unless required by applicable law or+ agreed to in writing, Licensor provides the Work (and each+ Contributor provides its Contributions) on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or+ implied, including, without limitation, any warranties or conditions+ of TITLE, NON-INFRINGEMENT, MERCHANTABILITY, or FITNESS FOR A+ PARTICULAR PURPOSE. You are solely responsible for determining the+ appropriateness of using or redistributing the Work and assume any+ risks associated with Your exercise of permissions under this License.++ 8. Limitation of Liability. In no event and under no legal theory,+ whether in tort (including negligence), contract, or otherwise,+ unless required by applicable law (such as deliberate and grossly+ negligent acts) or agreed to in writing, shall any Contributor be+ liable to You for damages, including any direct, indirect, special,+ incidental, or consequential damages of any character arising as a+ result of this License or out of the use or inability to use the+ Work (including but not limited to damages for loss of goodwill,+ work stoppage, computer failure or malfunction, or any and all+ other commercial damages or losses), even if such Contributor+ has been advised of the possibility of such damages.++ 9. Accepting Warranty or Additional Liability. While redistributing+ the Work or Derivative Works thereof, You may choose to offer,+ and charge a fee for, acceptance of support, warranty, indemnity,+ or other liability obligations and/or rights consistent with this+ License. However, in accepting such obligations, You may act only+ on Your own behalf and on Your sole responsibility, not on behalf+ of any other Contributor, and only if You agree to indemnify,+ defend, and hold each Contributor harmless for any liability+ incurred by, or claims asserted against, such Contributor by reason+ of your accepting any such warranty or additional liability.++ END OF TERMS AND CONDITIONS++ APPENDIX: How to apply the Apache License to your work.++ To apply the Apache License to your work, attach the following+ boilerplate notice, with the fields enclosed by brackets "[]"+ replaced with your own identifying information. (Don't include+ the brackets!) The text should be enclosed in the appropriate+ comment syntax for the file format. We also recommend that a+ file or class name and description of purpose be included on the+ same "printed page" as the copyright notice for easier+ identification within third-party archives.++ Copyright [yyyy] [name of copyright owner]++ Licensed under the Apache License, Version 2.0 (the "License");+ you may not use this file except in compliance with the License.+ You may obtain a copy of the License at++ http://www.apache.org/licenses/LICENSE-2.0++ Unless required by applicable law or agreed to in writing, software+ distributed under the License is distributed on an "AS IS" BASIS,+ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.+ See the License for the specific language governing permissions and+ limitations under the License.
+ README.md view
@@ -0,0 +1,257 @@++<p align="center">+ <a href="https://solana.com/docs">+ <img src="https://raw.githubusercontent.com/mariusgeorgescu/solana-haskell-sdk/main/solana-haskell-logo.jpeg" alt="Solana Haskell SDK Logo" width="425" />+ </a>+ <h1 align="center">Solana SDK library for Haskellers</h1>+ <p align="center">+ <a href="https://hackage.haskell.org/package/solana-haskell-sdk">+ <img src="https://img.shields.io/hackage/v/solana-haskell-sdk.svg?style=flat-square&logo=haskell&logoColor=white&label=Hackage" />+ </a>+ <a href="https://github.com/mariusgeorgescu/solana-haskell-sdk/actions/workflows/ci.yml">+ <img src="https://github.com/mariusgeorgescu/solana-haskell-sdk/actions/workflows/ci.yml/badge.svg?branch=main" />+ </a>+ <a href="https://github.com/mariusgeorgescu/solana-haskell-sdk/blob/main/CONTRIBUTING.md">+ <img src="https://img.shields.io/badge/PRs-welcome-brightgreen.svg?style=flat-square" />+ </a>+ </p>+</p>++## Table of contents++- 📋 [Documentation](#documentation)+- 🧪 [Integration tests](#integration-tests)+- 🔌 [WebSocket subscriptions](#websocket-subscriptions)+- 🚀 [Features](#features)+- 🧑💻 [Usage Examples](#usage-examples)+- 📝 [Contributing](#contributing)+- ✨ [Credits](#credits)+- ⚖️ [License](#license)++## Documentation++API documentation is generated with Haddock (`cabal haddock`). Serialization correctness methodology: every instruction, message, and transaction encoder is asserted byte-identical to vectors generated from the official Rust crates (solana-sdk, spl-token, mpl-token-metadata) — see [tools/README.md](https://github.com/mariusgeorgescu/solana-haskell-sdk/blob/main/tools/README.md).++## Integration tests++An opt-in test suite runs the SDK against a local validator. It sits behind the `integration` cabal flag, so a plain `cabal test all` neither builds it nor pulls its extra dependencies:++ solana-test-validator --reset+ cabal test integration-tests --flags=integration++Without a validator listening on `127.0.0.1:8899` the suite skips itself and exits 0, so it stays green in CI even when enabled. Set `SOLANA_INTEGRATION=1` to make an unreachable validator a failure instead, or `SOLANA_RPC_URL` to target a different endpoint.++## WebSocket subscriptions++`Network.Solana.RPC.WebSocket` speaks Solana's PubSub protocol: signature and account subscriptions, and `awaitSignature`, which waits for a transaction to be *pushed* to you instead of polling for it.++The module is transport-agnostic, so the SDK carries no WebSocket dependency and the same code serves plain `ws://` and TLS `wss://` endpoints — you supply the connection. With the [`websockets`](https://hackage.haskell.org/package/websockets) package:++```haskell+import Network.Solana.RPC.WebSocket+import Network.WebSockets qualified as WS++WS.runClient "127.0.0.1" 8900 "/" $ \conn -> do+ let transport = WsTransport (WS.sendTextData conn) (WS.receiveData conn)+ result <- awaitSignature transport (RequestId 1) (Just "confirmed") 30 signature+ print result -- Right <slot>, or Left with the on-chain or protocol error+```++For `wss://` endpoints use [`wuss`](https://hackage.haskell.org/package/wuss)'s `runSecureClient` in place of `runClient`; nothing else changes.++## Features++- [x] Full JSON-RPC API client (accounts, blocks, chain, ledger, tokens, tokenomics, transactions)+- [x] Wallet, account and keys management (ed25519 keypairs, base58 addresses)+- [x] Program Derived Addresses (`findProgramAddress` / `createProgramAddress`)+- [x] Transaction building, signing and submission+ - [x] Priority fees via Compute Budget (`setComputeUnitLimit`, `setComputeUnitPrice`)+ - [x] Versioned (v0) transactions and Address Lookup Tables+ - [x] Clients for native programs+ - [x] Address Lookup Table+ - [x] BPF Loader (upgradeable)+ - [x] Compute Budget+ - [x] Secp256k1 (instruction construction; signing out of scope)+ - [x] Stake (delegation lifecycle; seed-authority variants out of scope)+ - [x] System Program (all 13 instructions)+ - [x] Vote (account management)+ - [x] Clients for Solana Program Library (SPL)+ - [x] Memo+ - [x] SPL Token (instructions 0-20, incl. `transferChecked`)+ - [x] Associated Token Account (derive + create, idempotent variant)+ - [x] Metaplex Token Metadata (create/update metadata, master edition)+- [x] On-chain account state decoders (SPL token accounts and mints, lookup tables, stake and nonce accounts, Metaplex metadata)+- [x] PubSub (WebSocket) signature and account subscriptions, with push-based confirmation+- [x] Serialization verified byte-for-byte against the official Rust crates (solana-sdk, spl-token, mpl-token-metadata) (golden-vector tests)++### Release status++The current stable release is **v1.2.0.0**. Serialization is verified byte-for-byte against the official Rust SDK by golden-vector tests (see test/fixtures/ and [tools/README.md](https://github.com/mariusgeorgescu/solana-haskell-sdk/blob/main/tools/README.md)).++## Usage Examples++### Simple transfer++This example demonstrates how to use the Haskell Solana SDK to interact with a Solana validator and perform basic blockchain operations such as keypair generation, account funding via airdrop, balance checking, and transferring SOL tokens.++In the provided sample:++1. We start by generating a new keypair to act as the transaction sender and fee payer.++2. We connect to a local Solana validator using an HTTP provider.++3. The newly generated keypair receives an airdrop of 10 SOL to ensure it has sufficient funds.++4. We define a recipient's public address from a base58 encoded string.++5. We **construct**, **sign** and **submit** the transaction by defining the signers and the transaction's list of instructions with their parameters.++Before and after performing the transfer of 1 SOL to the recipient, we check and print the account balances to verify the transaction's success.++This straightforward example highlights the convenience and expressiveness of Haskell when building decentralized applications on Solana.++> The examples use `GHC2021` (this package's `default-language`). If you compile them under `Haskell2010`, additionally enable `NumericUnderscores` and `ImportQualifiedPost`.++```haskell+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)+import Network.Solana.Core.Crypto+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.RPC.HTTP.Transaction+import Network.Solana.SolanaWeb3+import Network.Web3.Provider++main :: IO ()+main = do+ -- Generate keypairs for fee payer (sender)+ (myPublicKey, myPrivateKey) <- createSolanaKeyPair++ -- Create Connection, local validator in this example+ result <- runWeb3' (HttpProvider "http://127.0.0.1:8899") $ do+ -- Fund fee payer+ void $ requestAirdrop myPublicKey 10_000_000_000+ wait 15 -- Wait 15 seconds be sure the tx was confirmed++ -- Define recipient's address from a base58-encoded string+ let recipient = "A988FuUtUVk8jMUuVc1ccaoTA3VS9CB4dkEf9XUAUqV4"++ -- Check balance+ printBalances [myPublicKey, recipient]++ -- Create a new transaction.+ txId <-+ newTransaction+ [myPrivateKey] -- Signing keys (with all required signers)+ -- List of instructions+ [ SystemProgram.transfer+ myPublicKey -- sender address+ recipient -- recipient address+ 1_000_000_000 -- amount to transfer 1 SOL+ ]+ liftIO $ putStrLn ("Transaction sent: " <> show txId)++ void $ confirmTransaction txId+ -- Check balance+ printBalances [myPublicKey, recipient]++ either (\e -> putStrLn ("RPC error: " <> show e)) pure result+```++### SPL token transfer (Associated Token Accounts)++Tokens live in *associated token accounts* (ATAs) — program-derived addresses computed from the wallet and the mint. This example derives both ATAs with `getAssociatedTokenAddress`, creates the recipient's ATA if missing (idempotent, safe to include unconditionally), and moves tokens with the decimals-checked `transferChecked`.++```haskell+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (void)+import Data.Maybe (fromJust)+import Network.Solana.Core.Crypto+import Network.Solana.SolanaWeb3+import Network.Solana.SplPrograms.AssociatedTokenAccount qualified as Ata+import Network.Solana.SplPrograms.Token qualified as Token+import Network.Web3.Provider++main :: IO ()+main = do+ (myPublicKey, myPrivateKey) <- createSolanaKeyPair++ void $ runWeb3' (HttpProvider "http://127.0.0.1:8899") $ do+ let mint = "4zMMC9srt5Ri5X14GAgXhaHii3GnPAEERYPJgZJDncDU" -- the token's mint address+ recipient = "A988FuUtUVk8jMUuVc1ccaoTA3VS9CB4dkEf9XUAUqV4" -- recipient wallet++ -- ATAs are PDAs of (wallet, token program, mint): derived, not generated.+ sourceAta = fromJust (Ata.getAssociatedTokenAddress myPublicKey mint)+ destinationAta = fromJust (Ata.getAssociatedTokenAddress recipient mint)++ void $+ newTransaction+ [myPrivateKey]+ [ -- Create the recipient's token account if it does not exist yet (no-op otherwise).+ Ata.createAssociatedTokenAccountIdempotent+ myPublicKey -- funder (pays rent)+ recipient -- wallet that will own the ATA+ mint,+ -- Transfer 1 token (here: 6 decimals); mint and decimals are verified on-chain.+ Token.transferChecked+ sourceAta -- source token account+ mint -- token mint+ destinationAta -- destination token account+ myPublicKey -- owner of the source account+ [] -- extra multisig signers (none)+ 1_000_000 -- amount in base units+ 6 -- decimals of the mint+ ]+```++### Priority fees and memo++Compute Budget instructions raise a transaction's scheduling priority by paying a fee per compute unit; a memo attaches a signed, human-readable note recorded on-chain. Both are ordinary `Instruction`s added to the same instruction list.++```haskell+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (void)+import Network.Solana.Core.Crypto+import Network.Solana.NativePrograms.ComputeBudget qualified as ComputeBudget+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.SolanaWeb3+import Network.Solana.SplPrograms.Memo qualified as Memo+import Network.Web3.Provider++main :: IO ()+main = do+ (myPublicKey, myPrivateKey) <- createSolanaKeyPair++ void $ runWeb3' (HttpProvider "http://127.0.0.1:8899") $ do+ let recipient = "A988FuUtUVk8jMUuVc1ccaoTA3VS9CB4dkEf9XUAUqV4"++ void $+ newTransaction+ [myPrivateKey]+ [ ComputeBudget.setComputeUnitLimit 200_000, -- cap the compute units this tx may use+ ComputeBudget.setComputeUnitPrice 10_000, -- priority fee: micro-lamports per compute unit+ SystemProgram.transfer myPublicKey recipient 1_000_000_000, -- 1 SOL+ Memo.buildMemo "thanks for the coffee" [myPublicKey] -- signed on-chain note+ ]+```++## Contributing++We welcome all contributors! See [contributing guide](https://github.com/mariusgeorgescu/solana-haskell-sdk/blob/main/CONTRIBUTING.md) for how to get started.++## Credits++Created and maintained by Marius Georgescu.++## License++[Apache-2.0](https://github.com/mariusgeorgescu/solana-haskell-sdk/blob/main/LICENSE)
+ app/Main.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)+import Network.Solana.Core.Crypto+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.RPC.HTTP.Transaction+import Network.Solana.SolanaWeb3+import Network.Web3.Provider++main :: IO ()+main = do+ -- Generate keypairs for fee payer (sender)+ (myPublicKey, myPrivateKey) <- createSolanaKeyPair++ -- Create Connection, local validator in this example+ result <- runWeb3' (HttpProvider "http://127.0.0.1:8899") $ do+ -- Fund fee payer+ void $ requestAirdrop myPublicKey 10_000_000_000+ wait 15 -- Wait 15 seconds be sure the tx was confirmed++ -- Define recipient's address from a base58-encoded string+ let recipient = "A988FuUtUVk8jMUuVc1ccaoTA3VS9CB4dkEf9XUAUqV4"++ -- Check balance+ printBalances [myPublicKey, recipient]++ -- Create a new transaction.+ txId <-+ newTransaction+ [myPrivateKey] -- Signing keys (with all required signers)+ -- List of instructions+ [ SystemProgram.transfer+ myPublicKey -- sender address+ recipient -- recipient address+ 1_000_000_000 -- amount to transfer 1 SOL+ ]+ liftIO $ putStrLn ("Transaction sent: " <> show txId)++ void $ confirmTransaction txId+ -- Check balance+ printBalances [myPublicKey, recipient]++ either (\e -> putStrLn ("RPC error: " <> show e)) pure result
+ solana-haskell-sdk.cabal view
@@ -0,0 +1,215 @@+cabal-version: 3.0+name: solana-haskell-sdk+version: 1.2.0.0+synopsis: Solana SDK: transaction building, signing, program clients, and JSON-RPC.+homepage: https://github.com/mariusgeorgescu/solana-haskell-sdk+bug-reports: https://github.com/mariusgeorgescu/solana-haskell-sdk/issues++-- A longer description of the package.+description:+ This library includes features like key generation and management,+ transaction and instruction construction, and a JSON-RPC API client.++ This library is aimed at developers building Solana dApps, tools, or infrastructure in Haskell.++ All serialization is verified byte-for-byte against the official Rust SDK by golden-vector tests.++license: Apache-2.0+license-file: LICENSE+author: Marius Georgescu+maintainer: georgescumarius@live.com+copyright: 2024 Marius Georgescu+category: Blockchain, Web3, Solana+build-type: Simple+tested-with: GHC ==9.6.7++-- Extra doc files to be distributed with the package, such as a CHANGELOG or a README.+extra-doc-files:+ CHANGELOG.md+ README.md++-- Extra source files to be distributed with the package, such as examples, or a tutorial module.+extra-source-files:+ test/fixtures/*.json++flag integration+ description:+ Build the local-validator integration test suite. Off by default so that+ building this package's tests needs no WebSocket dependency and no running+ validator; see the Integration tests section of the README.++ default: False+ manual: True++common warnings+ ghc-options: -Wall++library+ -- Import common warning flags.+ import: warnings++ -- Modules exported by the library.+ exposed-modules:+ Network.Solana.Constants+ Network.Solana.Core.Account+ Network.Solana.Core.Block+ Network.Solana.Core.Borsh+ Network.Solana.Core.Compact+ Network.Solana.Core.Crypto+ Network.Solana.Core.Instruction+ Network.Solana.Core.Message+ Network.Solana.Core.Pda+ Network.Solana.Core.Transaction+ Network.Solana.Core.VersionedMessage+ Network.Solana.Metaplex.TokenMetadata+ Network.Solana.NativePrograms.AddressLookupTable+ Network.Solana.NativePrograms.BpfLoaderUpgradeable+ Network.Solana.NativePrograms.ComputeBudget+ Network.Solana.NativePrograms.Secp256k1+ Network.Solana.NativePrograms.Stake+ Network.Solana.NativePrograms.SystemProgram+ Network.Solana.NativePrograms.Vote+ Network.Solana.SplPrograms.AssociatedTokenAccount+ Network.Solana.SplPrograms.Memo+ Network.Solana.SplPrograms.Token+ Network.Solana.RPC.HTTP.Account+ Network.Solana.RPC.HTTP.Block+ Network.Solana.RPC.HTTP.Chain+ Network.Solana.RPC.HTTP.Ledger+ Network.Solana.RPC.HTTP.Token+ Network.Solana.RPC.HTTP.Tokenomics+ Network.Solana.RPC.HTTP.Transaction+ Network.Solana.RPC.HTTP.Types+ Network.Solana.RPC.WebSocket+ Network.Solana.SolanaWeb3+ Network.Solana.Sysvar++ -- Modules included in this library but not exported.+ -- other-modules:++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:++ -- Other library packages from which modules are imported.+ build-depends:+ , aeson ^>=2.2+ , base ^>=4.18.0.0+ , base58-bytestring ^>=0.1+ , base64 ^>=1.0+ , binary ^>=0.8+ , bytestring ^>=0.11+ , containers ^>=0.6+ , crypton ^>=1.0+ , ed25519 ^>=0.0.5+ , either ^>=5.0+ , extra ^>=1.8+ , jsonrpc-tinyclient ^>=1.1+ , memory ^>=0.18+ , mtl ^>=2.3+ , text ^>=2.0+ , vector ^>=0.13+ , web3 ^>=1.1++ -- Directories containing source files.+ hs-source-dirs: src++ -- Base language which the package is written in.+ default-language: GHC2021++executable solana-haskell-sdk+ -- Import common warning flags.+ import: warnings++ -- .hs or .lhs file containing the Main module.+ main-is: Main.hs++ -- Modules included in this executable, other than Main.+ -- other-modules: Demos++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:++ -- Other library packages from which modules are imported.+ build-depends:+ , base ^>=4.18.0.0+ , solana-haskell-sdk+ , web3-provider ^>=1.1++ -- Directories containing source files.+ hs-source-dirs: app++ -- Base language which the package is written in.+ default-language: GHC2021++test-suite solana-haskell-sdk-test+ import: warnings+ default-language: GHC2021+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ other-modules:+ Test.Core.Account+ Test.Core.Block+ Test.Core.Borsh+ Test.Core.Compact+ Test.Core.Crypto+ Test.Core.Instruction+ Test.Core.Message+ Test.Core.Pda+ Test.Core.VersionedMessage+ Test.Fixtures+ Test.Metaplex.TokenMetadata+ Test.NativePrograms.AddressLookupTable+ Test.NativePrograms.BpfLoaderUpgradeable+ Test.NativePrograms.ComputeBudget+ Test.NativePrograms.Secp256k1+ Test.NativePrograms.Stake+ Test.NativePrograms.SystemProgram+ Test.NativePrograms.Vote+ Test.RPC.Chain+ Test.RPC.Parsers+ Test.RPC.WebSocket+ Test.SplPrograms.AssociatedTokenAccount+ Test.SplPrograms.Memo+ Test.SplPrograms.Token+ build-depends:+ , aeson ^>=2.2+ , base ^>=4.18.0.0+ , base16-bytestring ^>=1.0+ , binary ^>=0.8+ , bytestring ^>=0.11+ , containers ^>=0.6+ , solana-haskell-sdk+ , tasty ^>=1.5+ , tasty-hunit ^>=0.10+ , tasty-quickcheck ^>=0.11+ , text ^>=2.0++test-suite integration-tests+ import: warnings+ default-language: GHC2021+ type: exitcode-stdio-1.0+ hs-source-dirs: test-integration+ main-is: Main.hs+ other-modules:+ Test.Integration.Alt+ Test.Integration.Nonce+ Test.Integration.PriorityFee+ Test.Integration.Setup+ Test.Integration.Token+ Test.Integration.Transfer+ Test.Integration.WebSocket+ build-depends:+ , base ^>=4.18.0.0+ , solana-haskell-sdk+ , tasty ^>=1.5+ , tasty-hunit ^>=0.10+ , web3-provider ^>=1.1+ , websockets ^>=0.13++ if !flag(integration)+ buildable: False++source-repository head+ type: git+ location: https://github.com/mariusgeorgescu/solana-haskell-sdk
+ src/Network/Solana/Constants.hs view
@@ -0,0 +1,19 @@+-- |+-- Module : Network.Solana.Constants+-- Description : Useful constants for working with the Solana blockchain.+--+-- This module provides well-known constants related to Solana's economic model,+-- such as the number of lamports (the smallest unit) in one SOL token.+module Network.Solana.Constants where++-- | Number of lamports in one SOL.+--+-- One SOL (the native token of the Solana blockchain) is equal to 1,000,000,000 lamports.+-- Lamports are the smallest indivisible unit of SOL, similar to satoshis in Bitcoin, wei in Ethereum, or lovelaces in Cardano.+lamportsPerSol :: Integer+lamportsPerSol = 1_000_000_000++-- | Maximum length in bytes of a single seed used when deriving addresses+-- (program-derived-address seeds and @createAccountWithSeed@ seeds).+maxSeedLen :: Integer+maxSeedLen = 32
+ src/Network/Solana/Core/Account.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.Core.Account+-- Description : Accounts, account state, and the 'Lamport' unit.+module Network.Solana.Core.Account where++import Data.Aeson.Types+import Data.ByteString qualified as S+import Data.Text qualified as T+import Data.Vector qualified as V+import Data.Word (Word64)+import GHC.Base (Alternative (..))+import GHC.Generics (Generic)+import Network.Solana.Constants+import Network.Solana.Core.Crypto+import Text.Printf (printf)++-- | Lamport is the smallest unit of SOL (1 SOL = 1 billion lamports).+-- 'Show' renders the amount converted to SOL (e.g. @0.000000001 SOL ◎@), not the raw count.+newtype Lamport = Lamport+ { -- | The raw lamport amount.+ unLamport :: Word64+ }+ deriving (Eq, Ord, Generic, Enum)+ deriving newtype (Num, Real, Integral)++instance ToJSON Lamport where+ toJSON :: Lamport -> Value+ toJSON (Lamport amnt) = toJSON amnt++instance FromJSON Lamport where+ parseJSON :: Value -> Parser Lamport+ parseJSON value = do+ v <- parseJSON @Word64 value+ return $ Lamport v++instance Show Lamport where+ show :: Lamport -> String+ show (Lamport n) =+ let (sol :: Double) = fromIntegral n / fromIntegral lamportsPerSol+ in printf "%.9f SOL ◎" sol++------------------------------------------------------------------------------------------------++-- ** Account++------------------------------------------------------------------------------------------------++-- | An account paired with its address, as returned by RPC methods such as+-- @getProgramAccounts@.+data Account = Account+ { -- | The account's address.+ pubkey :: SolanaPublicKey,+ -- | The account's state.+ account :: AccountInfo+ }+ deriving (Show, Eq, Generic, ToJSON, FromJSON)++------------------------------------------------------------------------------------------------++-- ** Account Info++------------------------------------------------------------------------------------------------++-- | The base state shared by every Solana account. Accounts hold at most+-- 10 MiB of data.+data AccountInfo = AccountInfo+ { -- | Amount of lamports in the account+ lamports :: Lamport,+ -- | The account's data: executable code for program accounts,+ -- program-defined state otherwise. Named @dataField@ because @data@ is+ -- reserved in Haskell; serialized as @data@ in JSON.+ dataField :: AccountData,+ -- | The program that owns this account. Only the owner program may+ -- modify the account's data or debit its lamports.+ owner :: SolanaPublicKey,+ -- | A boolean flag that indicates whether this account contains a loaded program.+ executable :: Bool+ }+ deriving (Show, Eq, Generic, ToJSON)++instance FromJSON AccountInfo where+ parseJSON :: Value -> Parser AccountInfo+ parseJSON = do+ withObject "AccountInfo" $+ \v ->+ AccountInfo+ <$> v .: "lamports"+ <*> v .: "data"+ <*> v .: "owner"+ <*> v .: "executable"++------------------------------------------------------------------------------------------------++-- ** Account Data++------------------------------------------------------------------------------------------------++-- | A byte array that stores arbitrary data for an account.+data AccountData+ = AccountDataBinary+ { accData :: S.ByteString+ }+ | AccountDataJSON {accDataObj :: String}+ deriving (Eq, Generic)++instance Show AccountData where+ show :: AccountData -> String+ show (AccountDataBinary bs) = toBase58String bs+ show (AccountDataJSON o) = show o++instance ToJSON AccountData where+ toJSON :: AccountData -> Value+ toJSON ac = toJSON (show ac)++instance FromJSON AccountData where+ parseJSON :: Value -> Parser AccountData+ parseJSON v =+ let base64StringParser =+ withText+ "AccountDataText"+ (return . AccountDataBinary . fromBase64String . T.unpack)++ base58StringParser =+ withText+ "AccountDataText"+ ( maybe (fail "AccountData: invalid base58") (pure . AccountDataBinary)+ . fromBase58String+ . T.unpack+ )++ encodedParser =+ withArray+ "AccountDataArray"+ ( \arr ->+ if V.length arr /= 2+ then fail "AccountData: expected [data, encoding] pair"+ else case arr V.! 1 of+ "base58" -> base58StringParser $ arr V.! 0+ "base64" -> base64StringParser $ arr V.! 0+ "json" -> withText "AccountDataJSON" (return . AccountDataJSON . T.unpack) $ arr V.! 0+ "jsonParsed" -> withText "AccountDataJSON" (return . AccountDataJSON . T.unpack) $ arr V.! 0+ other -> fail ("AccountData: unsupported encoding: " <> show other)+ )+ v+ in base64StringParser v <|> encodedParser
+ src/Network/Solana/Core/Block.hs view
@@ -0,0 +1,61 @@+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.Core.Block+-- Description : Block hashes and block heights.+module Network.Solana.Core.Block where++import Network.Solana.Core.Crypto (fromBase58String, toBase58String)+import Data.Aeson.Types+import Data.Binary+import Data.Binary.Get (getByteString)+import Data.Binary.Put (putByteString)+import Data.ByteString qualified as S+import Data.Maybe (fromJust)+import Data.Text qualified as Text+import GHC.Generics (Generic)++------------------------------------------------------------------------------------------------++-- * BlockHash++------------------------------------------------------------------------------------------------++-- | A 32-byte hash identifying a ledger entry (block), rendered in Base58 by+-- 'Show' and the JSON instances. Transactions embed a recent block hash as+-- a proof of recency.+newtype BlockHash = BlockHash S.ByteString+ deriving (Eq, Generic)+ deriving newtype (Semigroup)+ deriving newtype (Monoid)++instance Show BlockHash where+ show :: BlockHash -> String+ show (BlockHash bs) = toBase58String bs++instance Binary BlockHash where+ put :: BlockHash -> Put+ put (BlockHash bs) = putByteString bs -- not default Binary instance (wo length)+ get :: Get BlockHash+ get = BlockHash <$> getByteString 32++instance ToJSON BlockHash where+ toJSON :: BlockHash -> Value+ toJSON bh = toJSON (show bh)++instance FromJSON BlockHash where+ parseJSON :: Value -> Parser BlockHash+ parseJSON = withText "BlockHash" $ \t -> do+ bs <- maybe (fail "BlockHash: invalid base58") pure (fromBase58String (Text.unpack t))+ if S.length bs == 32+ then pure (BlockHash bs)+ else fail "BlockHash: expected 32 bytes"++-- | Build a 'BlockHash' from Base58 text. Calls 'error' if the text is not+-- valid Base58; the decoded length is not checked.+unsafeBlockHash :: String -> BlockHash+unsafeBlockHash = BlockHash . fromJust . fromBase58String++-- | The number of blocks beneath a block (its height in the chain).+type BlockHeight = Word64
+ src/Network/Solana/Core/Borsh.hs view
@@ -0,0 +1,97 @@+-- |+-- Module : Network.Solana.Core.Borsh+-- Description : Borsh serialization helpers for common types.+--+-- This module provides helpers for Borsh serialization, which differs from Bincode+-- in specific length encodings and enum tag widths. Both enforce strict 0/1 validation+-- for Option tags and Bool encoding:+--+-- * __String lengths__: Borsh uses 32-bit LE (u32), Bincode uses 64-bit LE (u64).+-- * __Vec counts__: Borsh uses 32-bit LE (u32), Bincode uses 64-bit LE (u64).+-- * __Enum tags__: Borsh uses 8-bit (u8), Bincode uses 32-bit LE (u32).+module Network.Solana.Core.Borsh+ ( putBorshString,+ getBorshString,+ putBorshOption,+ getBorshOption,+ putBorshVec,+ getBorshVec,+ putBorshBool,+ getBorshBool,+ )+where++import Control.Monad (replicateM)+import Data.Binary.Get (Get, getByteString, getWord32le, getWord8)+import Data.Binary.Put (Put, putByteString, putWord32le, putWord8)+import Data.ByteString qualified as BS+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE++-- | Serialize a 'String' in Borsh format: u32 LE byte-length + UTF-8 bytes.+-- The length prefix is a 32-bit little-endian word (u32).+putBorshString :: String -> Put+putBorshString s = do+ let bs = TE.encodeUtf8 (T.pack s)+ putWord32le (fromIntegral (BS.length bs))+ putByteString bs++-- | Deserialize a 'String' in Borsh format: u32 LE byte-length + UTF-8 bytes.+-- Fails if the length exceeds @maxBound :: Int@ or if the bytes are not valid UTF-8.+getBorshString :: Get String+getBorshString = do+ len <- getWord32le+ if len > fromIntegral (maxBound :: Int)+ then fail "getBorshString: length exceeds Int range"+ else do+ bs <- getByteString (fromIntegral len)+ case TE.decodeUtf8' bs of+ Left _ -> fail "getBorshString: invalid UTF-8"+ Right t -> pure (T.unpack t)++-- | Serialize a 'Maybe' value in Borsh format: u8 tag (0 = Nothing, 1 = Just) + optional value.+putBorshOption :: (a -> Put) -> Maybe a -> Put+putBorshOption _ Nothing = putWord8 0+putBorshOption putVal (Just a) = do+ putWord8 1+ putVal a++-- | Deserialize a 'Maybe' value in Borsh format: u8 tag (0 = Nothing, 1 = Just) + optional value.+-- Fails if the tag is not 0 or 1.+getBorshOption :: Get a -> Get (Maybe a)+getBorshOption getVal = do+ tag <- getWord8+ case tag of+ 0 -> pure Nothing+ 1 -> Just <$> getVal+ _ -> fail $ "getBorshOption: invalid tag " <> show tag <> " (expected 0 or 1)"++-- | Serialize a list in Borsh format: u32 LE count + elements.+putBorshVec :: (a -> Put) -> [a] -> Put+putBorshVec putVal xs = do+ putWord32le (fromIntegral (length xs))+ mapM_ putVal xs++-- | Deserialize a list in Borsh format: u32 LE count + elements.+-- Fails if the count exceeds @maxBound :: Int@.+getBorshVec :: Get a -> Get [a]+getBorshVec getVal = do+ count <- getWord32le+ if count > fromIntegral (maxBound :: Int)+ then fail "getBorshVec: count exceeds Int range"+ else replicateM (fromIntegral count) getVal++-- | Serialize a 'Bool' in Borsh format: u8 (0 = False, 1 = True).+putBorshBool :: Bool -> Put+putBorshBool False = putWord8 0+putBorshBool True = putWord8 1++-- | Deserialize a 'Bool' in Borsh format: u8 (0 = False, 1 = True).+-- Fails if the byte is not 0 or 1.+getBorshBool :: Get Bool+getBorshBool = do+ b <- getWord8+ case b of+ 0 -> pure False+ 1 -> pure True+ _ -> fail $ "getBorshBool: invalid byte " <> show b <> " (expected 0 or 1)"
+ src/Network/Solana/Core/Compact.hs view
@@ -0,0 +1,126 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.Core.Compact+-- Description : compact-u16 (ShortU16) encoding and compact arrays.+--+-- Solana serializes lengths as /compact-u16/: a 'Word16' packed into 1–3+-- bytes, little-endian, 7 data bits per byte, with the high bit of each+-- byte flagging a continuation byte. The third byte may only carry 2 data+-- bits, and aliased (non-canonical) encodings are rejected when decoding.+-- A 'CompactArray' is a sequence serialized as its compact-u16 length+-- followed by the serialized items.+module Network.Solana.Core.Compact+ ( getCompactU16,+ putCompactU16,+ encodeCompactU16,+ decodeCompactU16,+ CompactArray (),+ mkCompact,+ unCompact,+ getCompactArrayLength,+ )+where++import Control.Monad (replicateM)+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.Bits+import Data.ByteString.Lazy qualified as BL+import GHC.Generics++------------------------------------------------------------------------------------------------++-- * CompactArray++------------------------------------------------------------------------------------------------++-- | A list paired with its length, serialized ('Binary' 'put') as a+-- compact-u16 length prefix followed by each item. Build with 'mkCompact'.+data CompactArray a = CompactArray+ { -- | The recorded number of items.+ getCompactArrayLength :: Word16,+ -- | The items of the array.+ unCompact :: [a]+ }+ deriving (Eq, Ord, Show, Generic)++-- instance (ToJSON a) => ToJSON (CompactArray a) where+-- toJSON :: CompactArray a -> Value+-- toJSON (CompactArray _ xs) = toJSON xs++-- instance (FromJSON a) => FromJSON (CompactArray a) where+-- parseJSON :: (FromJSON a) => Value -> Parser (CompactArray a)+-- parseJSON v = mkCompact <$> parseJSON v++instance (Binary a) => Binary (CompactArray a) where+ put :: (Binary a) => CompactArray a -> Put+ put (CompactArray i xs) = do+ putCompactU16 i+ mapM_ put xs -- not default putList+ get :: (Binary a) => Get (CompactArray a)+ get = do+ n <- getCompactU16+ xs <- replicateM (fromIntegral n) get+ pure (CompactArray n xs)++-- | Wrap a list into a 'CompactArray', recording its length. The length is+-- truncated to 'Word16'.+mkCompact :: [a] -> CompactArray a+mkCompact xs = CompactArray (fromIntegral $ length xs) xs++------------------------------------------------------------------------------------------------++-- * CompactU16++------------------------------------------------------------------------------------------------++-- | Decode a compact-u16 value. Fails on encodings longer than 3 bytes, on+-- aliased (non-canonical) encodings, on an invalid third byte, and on+-- values exceeding 'Word16'.+getCompactU16 :: Get Word16+getCompactU16 = go 0 0+ where+ go :: Word32 -> Int -> Get Word16+ go acc byteIndex+ | byteIndex >= 3 = fail "Too many bytes in compact-u16"+ | otherwise = do+ byte <- getWord8+ let value = fromIntegral (byte .&. 0x7F) --+ acc' = acc .|. (value `shiftL` (7 * byteIndex))+ continue = (byte .&. 0x80) /= 0+ if continue+ then go acc' (byteIndex + 1)+ else+ if byteIndex > 0 && byte == 0+ then fail "Aliased (non-canonical) compact-u16 encoding"+ else+ if byteIndex == 2 && (byte .&. 0xFC) /= 0+ then fail "Invalid 3rd byte in compact-u16 (only 2 bits allowed)"+ else case fromIntegral acc' of+ w | w <= 0xFFFF -> return w+ _ -> fail "Decoded value exceeds u16 range"++-- | Encode a 'Word16' as compact-u16 (1–3 bytes).+putCompactU16 :: Word16 -> Put+putCompactU16 val = go (fromIntegral val :: Word32)+ where+ go :: Word32 -> Put+ go v+ | v < 0x80 = putWord8 (fromIntegral v)+ | otherwise = do+ putWord8 (fromIntegral (v .&. 0x7F) .|. 0x80)+ go (v `shiftR` 7)++-- | Run 'putCompactU16' to a lazy byte string.+encodeCompactU16 :: Word16 -> BL.ByteString+encodeCompactU16 = runPut . putCompactU16++-- | Run 'getCompactU16' over a lazy byte string, returning the decoder's+-- error message on failure.+decodeCompactU16 :: BL.ByteString -> Either String Word16+decodeCompactU16 bs =+ case runGetOrFail getCompactU16 bs of+ Left (_, _, err) -> Left err+ Right (_, _, val) -> Right val
+ src/Network/Solana/Core/Crypto.hs view
@@ -0,0 +1,285 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.Core.Crypto+-- Description : Ed25519 keys, signatures, and Base58\/Base64 helpers for Solana.+--+-- Wrappers around "Crypto.Sign.Ed25519" providing the core cryptographic+-- types: 'SolanaPublicKey', 'SolanaPrivateKey' and 'SolanaSignature'.+-- All three 'show' as the Base58 strings used across the Solana ecosystem.+module Network.Solana.Core.Crypto+ ( createSolanaKeyPair,+ createSolanaKeypairFromSeed,+ toSolanaPublicKey,+ sign,+ verify,+ dsign,+ dverify,+ SolanaPublicKey,+ SolanaPrivateKey,+ SolanaSignature,+ unsafeSolanaPublicKey,+ unsafeSolanaPublicKeyRaw,+ unsafeSolanaPrivateKey,+ unsafeSolanaPrivateKeyRaw,+ unsafeSigFromString,+ getSolanaPublicKeyRaw,+ getSolanaPrivateKeyRaw,+ getSolanaSignatureRaw,+ toBase58String,+ toBase64String,+ fromBase64String,+ fromBase58String,+ readSigningKeyFromFile,+ mkPublicKeyFromString,+ mkPrivateKeyFromString,+ )+where++import Crypto.Sign.Ed25519 qualified as Ed25519+import Data.Aeson+import Data.Aeson.Types+import Data.Bifunctor (Bifunctor (bimap))+import Data.Binary+import Data.Binary.Get (getByteString)+import Data.Binary.Put (putByteString)+import Data.ByteString qualified as BS+import Data.ByteString.Base58+import Data.ByteString.Base64 (decodeBase64Lenient, encodeBase64')+import Data.ByteString.Char8 qualified as BS8+import Data.Either.Extra (maybeToEither)+import Data.String (IsString, fromString)+import Data.Text qualified as Text+import GHC.Generics (Generic)+import Text.Read (readMaybe)++-- | Encode a byte string as Base58 text (Bitcoin alphabet), the encoding+-- Solana uses for addresses, signatures and hashes.+toBase58String :: BS.ByteString -> String+toBase58String = tail . init . show . encodeBase58 bitcoinAlphabet++-- | Encode a byte string as Base64 text.+toBase64String :: BS.ByteString -> String+toBase64String = tail . init . show . encodeBase64'++-- | Decode Base58 text (Bitcoin alphabet); 'Nothing' if the input contains+-- characters outside the alphabet.+fromBase58String :: String -> Maybe BS.ByteString+fromBase58String = decodeBase58 bitcoinAlphabet . fromString++-- | Decode Base64 text /leniently/: invalid characters are skipped rather+-- than reported, so this never fails but may silently accept malformed+-- input.+fromBase64String :: String -> BS.ByteString+fromBase64String = decodeBase64Lenient . fromString++--- >>> fromBase64String $ toBase64String "Sun"+--- >>> fromBase58String $ toBase58String "Sun"+-- "Sun"+-- Just "Sun"++------------------------------------------------------------------------------------------------++-- * SolanaSignature++------------------------------------------------------------------------------------------------++-- | A 64-byte detached Ed25519 signature. 'Show' and the JSON instances use+-- the Base58 rendering.+newtype SolanaSignature = SolanaSignature Ed25519.Signature+ deriving (Eq, Ord, Generic)++instance Show SolanaSignature where+ show :: SolanaSignature -> String+ show (SolanaSignature (Ed25519.Signature bs)) = toBase58String bs++instance Binary SolanaSignature where+ put :: SolanaSignature -> Put+ put (SolanaSignature (Ed25519.Signature bs)) = putByteString bs+ get :: Get SolanaSignature+ get = SolanaSignature . Ed25519.Signature <$> getByteString 64++instance ToJSON SolanaSignature where+ toJSON :: SolanaSignature -> Value+ toJSON pk = toJSON (show pk)++instance FromJSON SolanaSignature where+ parseJSON :: Value -> Parser SolanaSignature+ parseJSON = withText "SolanaSignature" $ either fail pure . mkSigFromString . Text.unpack++------------------------------------------------------------------------------------------------++-- *** SolanaPublicKey++------------------------------------------------------------------------------------------------++-- | A 32-byte Ed25519 public key: the address of an account, program or+-- signer. 'Show' and the JSON instances use the Base58 rendering; the+-- 'IsString' instance is partial (see 'unsafeSolanaPublicKey').+newtype SolanaPublicKey+ = SolanaPublicKey Ed25519.PublicKey+ deriving (Eq, Ord, Generic)++instance Show SolanaPublicKey where+ show :: SolanaPublicKey -> String+ show (SolanaPublicKey (Ed25519.PublicKey bs)) = toBase58String bs++instance IsString SolanaPublicKey where+ fromString = unsafeSolanaPublicKey++instance Binary SolanaPublicKey where+ put :: SolanaPublicKey -> Put+ put (SolanaPublicKey (Ed25519.PublicKey bs)) = putByteString bs+ get :: Get SolanaPublicKey+ get = SolanaPublicKey . Ed25519.PublicKey <$> getByteString 32++instance ToJSON SolanaPublicKey where+ toJSON :: SolanaPublicKey -> Value+ toJSON pk = toJSON (show pk)++instance FromJSON SolanaPublicKey where+ parseJSON :: Value -> Parser SolanaPublicKey+ parseJSON = withText "SolanaPublicKey" $ either fail pure . mkPublicKeyFromString . Text.unpack++instance FromJSONKey SolanaPublicKey where+ fromJSONKey :: FromJSONKeyFunction SolanaPublicKey+ fromJSONKey = FromJSONKeyTextParser (either fail pure . mkPublicKeyFromString . Text.unpack)++instance ToJSONKey SolanaPublicKey where+ toJSONKey :: ToJSONKeyFunction SolanaPublicKey+ toJSONKey = toJSONKeyText (Text.pack . show)++------------------------------------------------------------------------------------------------++-- *** SolanaPrivateKey++------------------------------------------------------------------------------------------------++-- | A 64-byte Ed25519 secret key (seed plus public key, NaCl layout).+-- 'Show' renders it in Base58 — avoid logging values of this type.+newtype SolanaPrivateKey+ = SolanaPrivateKey Ed25519.SecretKey+ deriving (Eq, Ord, Generic)++instance Show SolanaPrivateKey where+ show :: SolanaPrivateKey -> String+ show (SolanaPrivateKey (Ed25519.SecretKey bs)) = toBase58String bs++------------------------------------------------------------------------------------------------++-- *** Functions++------------------------------------------------------------------------------------------------++mkSigFromString :: String -> Either String SolanaSignature+mkSigFromString str = do+ bs <- maybeToEither "Not base58" $ fromBase58String str+ if BS.length bs == 64+ then Right $ (SolanaSignature . Ed25519.Signature) bs+ else Left "Invalid string length for sig"++-- | Build a 'SolanaSignature' from Base58 text. Calls 'error' unless the+-- input decodes to exactly 64 bytes.+unsafeSigFromString :: String -> SolanaSignature+unsafeSigFromString = either error id . mkSigFromString++mkKeyFromString :: forall f. Int -> (BS.ByteString -> f) -> String -> Either String f+mkKeyFromString n cstr str = do+ bs <- maybeToEither "Not base58" $ fromBase58String str+ if BS.length bs == n+ then Right $ cstr bs+ else Left "Invalid string length for key"++-- | Parse Base58 text into a 'SolanaPublicKey'. 'Left' if the input is not+-- Base58 or does not decode to exactly 32 bytes.+mkPublicKeyFromString :: String -> Either String SolanaPublicKey+mkPublicKeyFromString = mkKeyFromString 32 (SolanaPublicKey . Ed25519.PublicKey)++-- | Parse Base58 text into a 'SolanaPrivateKey'. 'Left' if the input is not+-- Base58 or has the wrong length.+mkPrivateKeyFromString :: String -> Either String SolanaPrivateKey+mkPrivateKeyFromString = mkKeyFromString 64 (SolanaPrivateKey . Ed25519.SecretKey)++unsafeKeyFromString :: forall f. Int -> (BS.ByteString -> f) -> String -> f+unsafeKeyFromString n cstr str = either error id $ mkKeyFromString n cstr str++unsafeKeyFromWords :: forall f. (BS.ByteString -> f) -> [Word8] -> f+unsafeKeyFromWords cstr ws = cstr (BS.pack ws)++-- | Partial version of 'mkPublicKeyFromString': calls 'error' on invalid+-- input. Prefer the total variant outside of literals and tests.+unsafeSolanaPublicKey :: String -> SolanaPublicKey+unsafeSolanaPublicKey = unsafeKeyFromString 32 (SolanaPublicKey . Ed25519.PublicKey)++-- | Build a 'SolanaPublicKey' directly from raw bytes. No length check is+-- performed — the caller must supply exactly 32 bytes.+unsafeSolanaPublicKeyRaw :: [Word8] -> SolanaPublicKey+unsafeSolanaPublicKeyRaw = unsafeKeyFromWords (SolanaPublicKey . Ed25519.PublicKey)++-- | Partial version of 'mkPrivateKeyFromString': calls 'error' on invalid+-- input.+unsafeSolanaPrivateKey :: String -> SolanaPrivateKey+unsafeSolanaPrivateKey = unsafeKeyFromString 64 (SolanaPrivateKey . Ed25519.SecretKey)++-- | Build a 'SolanaPrivateKey' directly from raw bytes (e.g. the 64 numbers+-- in a @solana-keygen@ keypair file). No length check is performed.+unsafeSolanaPrivateKeyRaw :: [Word8] -> SolanaPrivateKey+unsafeSolanaPrivateKeyRaw = unsafeKeyFromWords (SolanaPrivateKey . Ed25519.SecretKey)++-- | The raw 32 bytes of a public key.+getSolanaPublicKeyRaw :: SolanaPublicKey -> BS.ByteString+getSolanaPublicKeyRaw (SolanaPublicKey (Ed25519.PublicKey bs)) = bs++-- | The raw bytes of a secret key. Handle with care.+getSolanaPrivateKeyRaw :: SolanaPrivateKey -> BS.ByteString+getSolanaPrivateKeyRaw (SolanaPrivateKey (Ed25519.SecretKey bs)) = bs++-- | The raw 64 bytes of a signature.+getSolanaSignatureRaw :: SolanaSignature -> BS.ByteString+getSolanaSignatureRaw (SolanaSignature (Ed25519.Signature bs)) = bs++-- | Generate a fresh random Ed25519 keypair.+createSolanaKeyPair :: IO (SolanaPublicKey, SolanaPrivateKey)+createSolanaKeyPair = bimap SolanaPublicKey SolanaPrivateKey <$> Ed25519.createKeypair++-- | Derive a keypair deterministically from a seed. 'Nothing' unless the+-- seed is exactly 32 bytes.+createSolanaKeypairFromSeed :: BS.ByteString -> Maybe (SolanaPublicKey, SolanaPrivateKey)+createSolanaKeypairFromSeed bs = bimap SolanaPublicKey SolanaPrivateKey <$> Ed25519.createKeypairFromSeed_ bs++-- | The public key corresponding to a private key.+toSolanaPublicKey :: SolanaPrivateKey -> SolanaPublicKey+toSolanaPublicKey (SolanaPrivateKey pv) = SolanaPublicKey $ Ed25519.toPublicKey pv++-- | Sign a message, returning the /joined/ signed message (signature+-- prepended to the message). For transaction signatures use 'dsign'.+sign :: SolanaPrivateKey -> BS.ByteString -> BS.ByteString+sign (SolanaPrivateKey sk) = Ed25519.sign sk++-- | Verify a joined signed message produced by 'sign'.+verify :: SolanaPublicKey -> BS.ByteString -> Bool+verify (SolanaPublicKey pk) = Ed25519.verify pk++-- | Produce a detached 'SolanaSignature' over a byte string. This is the+-- primitive used to sign transaction messages.+dsign :: SolanaPrivateKey -> BS.ByteString -> SolanaSignature+dsign (SolanaPrivateKey sk) bs = SolanaSignature $ Ed25519.dsign sk bs++-- | Verify a detached 'SolanaSignature' over a byte string.+dverify :: SolanaPublicKey -> BS.ByteString -> SolanaSignature -> Bool+dverify (SolanaPublicKey pk) bs (SolanaSignature sig) = Ed25519.dverify pk bs sig++----+----+----+----++-- | Read a private key from a @solana-keygen@-style keypair file containing+-- a list of byte values (e.g. @[1,2,...]@). Throws an 'IOError' if the file+-- cannot be read, or if its contents cannot be parsed as a @[Word8]@ list.+readSigningKeyFromFile :: FilePath -> IO SolanaPrivateKey+readSigningKeyFromFile path = do+ contents <- BS8.readFile path+ case readMaybe (BS8.unpack contents) of+ Just word8List -> return $ unsafeSolanaPrivateKeyRaw (word8List :: [Word8])+ Nothing -> fail ("readSigningKeyFromFile: could not parse " <> path <> " as a list of bytes (e.g. \"[1,2,...]\")")
+ src/Network/Solana/Core/Instruction.hs view
@@ -0,0 +1,176 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module Network.Solana.Core.Instruction+ ( Instruction,+ mkInstruction,+ iProgramId,+ iAccounts,+ iData,+ AccountMeta (..),+ InstructionData (..),+ compileInstruction,+ CompiledInstruction,+ CompileException (..),+ )+where++import Control.Exception+import Data.Aeson.Types+import Data.Binary+import Data.Binary qualified as Binary+import Data.ByteString qualified as S+import Data.Either.Combinators+import Data.List (elemIndex)+import GHC.Generics (Generic)+import Network.Solana.Core.Compact+import Network.Solana.Core.Crypto (SolanaPublicKey, fromBase58String, toBase58String, toBase64String)++------------------------------------------------------------------------------------------------++-- * Instruction++------------------------------------------------------------------------------------------------++-- | A single program invocation: which program to call, the accounts it+-- may read or write, and the input bytes to pass it.+data Instruction = Instruction+ { -- | Address of the program that executes this instruction.+ iProgramId :: SolanaPublicKey,+ -- | List of metadata describing accounts that should be passed to the program.+ iAccounts :: [AccountMeta],+ -- | Bytes selecting which instruction of the program to invoke, plus+ -- any arguments it needs.+ iData :: InstructionData+ }+ deriving (Show, Eq, Generic)++-- | Build an 'Instruction' from a program id, account metas, and+-- 'Binary'-encodable instruction data.+mkInstruction :: (Binary.Binary a) => SolanaPublicKey -> [AccountMeta] -> a -> Instruction+mkInstruction programid accmetas instrData =+ Instruction+ { iProgramId = programid,+ iAccounts = accmetas,+ iData = InstructionData $ S.toStrict (Binary.encode instrData)+ }++------------------------------------------------------------------------------------------------++-- ** Account Meta++------------------------------------------------------------------------------------------------++-- | Each account required by an instruction must be provided as an AccountMeta that contains:+data AccountMeta = AccountMeta+ { -- | Account's address+ accountPubKey :: SolanaPublicKey,+ {- Whether the account must sign the transaction.+ True if an 'Instruction' requires a 'Transaction' signature matching 'SolanaPublicKey'.+ -}+ isSigner :: Bool,+ {- Whether the instruction will modify the account's data.+ True if the account data or metadata may be mutated during program execution.+ -}+ isWritable :: Bool+ }+ deriving (Show, Eq, Generic)++------------------------------------------------------------------------------------------------++-- ** Instruction Data++------------------------------------------------------------------------------------------------++-- | Raw instruction input bytes. 'Show' renders them in Base64.+newtype InstructionData = InstructionData {instrData :: S.ByteString}+ deriving (Eq, Generic)++instance Show InstructionData where+ show :: InstructionData -> String+ show (InstructionData bs) = toBase64String bs++------------------------------------------------------------------------------------------------++-- *** Compiled Instruction++------------------------------------------------------------------------------------------------++-- | The structure of a compiled instruction.+data CompiledInstruction = CompiledInstruction+ { {-+ Index that points to the program's address in the account addresses array.+ This specifies the program that will process the instruction.+ -}+ ciProgramIdIndex :: Word8,+ -- | Compact array of indexes that point to the account addresses required for this instruction.+ ciAccounts :: CompactArray Word8,+ {- Compact byte array specifying the instruction on the program to invoke+ and any function arguments required by the instruction.+ -}+ ciData :: CompactArray Word8+ }+ deriving (Show, Eq, Generic)++instance ToJSON CompiledInstruction where+ toJSON :: CompiledInstruction -> Value+ toJSON (CompiledInstruction programIdIndex accounts iData) =+ object+ [ "programIdIndex" .= programIdIndex,+ "accounts" .= unCompact accounts,+ "data" .= (toBase58String . S.pack . unCompact $ iData)+ ]++instance FromJSON CompiledInstruction where+ parseJSON :: Value -> Parser CompiledInstruction+ parseJSON = withObject "CompiledInstruction" $ \v -> do+ programIdIndex <- v .: "programIdIndex"+ accounts <- v .: "accounts"+ dataStr <- v .: "data"+ bytes <- case fromBase58String dataStr of+ Nothing -> fail "CompiledInstruction: data is not valid base58"+ Just bs -> pure bs+ pure+ CompiledInstruction+ { ciProgramIdIndex = programIdIndex,+ ciAccounts = mkCompact accounts,+ ciData = mkCompact (S.unpack bytes)+ }++instance Binary CompiledInstruction where+ put :: CompiledInstruction -> Put+ put CompiledInstruction {..} = do+ put ciProgramIdIndex+ put ciAccounts+ put ciData+ get :: Get CompiledInstruction+ get = CompiledInstruction <$> get <*> get <*> get++-- | Replace each pubkey referenced by an instruction with its index into+-- the given account-key table. 'Left' when a key is not present in the+-- table.+compileInstruction :: [SolanaPublicKey] -> Instruction -> Either CompileException CompiledInstruction+compileInstruction keys instruction = do+ programIdIndex <- keyToIndex (iProgramId instruction) keys+ accIndices <- mapM ((`keyToIndex` keys) . accountPubKey) (iAccounts instruction)+ return $+ CompiledInstruction+ { ciProgramIdIndex = fromIntegral programIdIndex,+ ciAccounts = mkCompact (fromIntegral <$> accIndices),+ ciData = mkCompact . S.unpack $ instrData (iData instruction)+ }++keyToIndex :: SolanaPublicKey -> [SolanaPublicKey] -> Either CompileException Int+keyToIndex k keys = maybeToRight (MissingIndex $ show k) $ k `elemIndex` keys++------------------------------------------------------------------------------------------------++-- *** CompileException++------------------------------------------------------------------------------------------------+-- | Compilation failure: an instruction references an account key that is+-- missing from the message's account table.+newtype CompileException = MissingIndex String+ deriving (Show)++instance Exception CompileException
+ src/Network/Solana/Core/Message.hs view
@@ -0,0 +1,384 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module : Network.Solana.Core.Message+-- Description : Building, canonically ordering, compiling and signing transaction messages.+module Network.Solana.Core.Message+ ( newTransactionIntent,+ newTransactionIntentWithPayer,+ newDurableNonceTransactionIntent,+ newDurableNonceTransactionIntentWithPayer,+ SignedTransactionIntent,+ Message (..),+ MessageHeader (..),+ CompiledMessage,+ newMessage,+ newMessageToBase64String,+ mkNewMessage,+ )+where++import Data.Aeson+import Data.Aeson.Types (Parser)+import Data.Binary+import Data.ByteString qualified as S+import Data.Foldable+import Data.List (sortOn)+import GHC.Generics (Generic)+import Network.Solana.Core.Block (BlockHash)+import Network.Solana.Core.Compact+import Network.Solana.Core.Crypto (SolanaPrivateKey, SolanaPublicKey, dsign, getSolanaPublicKeyRaw, toBase64String, toSolanaPublicKey)+import Network.Solana.Core.Instruction+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+++------------------------------------------------------------------------------------------------++-- * SignedTransactionIntent++------------------------------------------------------------------------------------------------++-- | A transaction awaiting a recent block hash: applying one yields the+-- Base64-encoded signed transaction, or a 'CompileException'.+type SignedTransactionIntent = (BlockHash -> Either CompileException String)+++-- | Builds and signs a transaction from a list of signing keys and+-- instructions. The fee payer is the first writable signer encountered+-- across the instructions' account metas, and account keys are canonically+-- ordered (fee payer first, then each privilege section sorted by pubkey+-- bytes; see @canonicalizeAccountOrder@). The private keys passed here must+-- be ordered to match the resulting account order (fee payer first),+-- otherwise the produced signatures will not correspond to the right+-- account keys. If you would rather name the fee payer explicitly and not+-- worry about signer order, consider 'newTransactionIntentWithPayer',+-- which orders signatures automatically.+newTransactionIntent :: [SolanaPrivateKey] -> [Instruction] -> SignedTransactionIntent+newTransactionIntent signers instructions blockhash = do+ msg <- newMessage blockhash instructions -- make the binary message+ let signatures = S.toStrict . Data.Binary.encode $ mkCompact $ flip dsign msg <$> signers -- sign the binary message+ return $ toBase64String $ S.append signatures msg -- return signed transaction++-- | Builds and signs a transaction with an explicitly named fee payer.+-- Unlike 'newTransactionIntent', the fee payer is always account 0+-- (sponsored fees are supported: the payer need not appear in any+-- instruction at all), and the given private keys may be listed in any+-- order — they are matched against the compiled message's required+-- signers and the resulting signatures are placed in message order+-- automatically. 'Left' if a required signer has no corresponding private+-- key, or if a given private key does not correspond to any required+-- signer. Duplicate private keys for the same required signer are+-- tolerated: the first match signs, mirroring the Rust SDK's @try_sign@.+newTransactionIntentWithPayer :: SolanaPublicKey -> [SolanaPrivateKey] -> [Instruction] -> BlockHash -> Either CompileException String+newTransactionIntentWithPayer payer signingKeys instructions blockhash = do+ let msg = mkNewMessageWithPayer payer blockhash instructions+ msgBytes <- compileMessageToBinary msg+ let requiredSigners = take (fromIntegral (numRequiredSignatures (mHeader msg))) (mAccountKeys msg)+ keyedByPubkey = [(toSolanaPublicKey k, k) | k <- signingKeys]+ orderedKeys <- mapM (findSigningKey keyedByPubkey) requiredSigners+ mapM_ (checkKeyIsRequired requiredSigners . fst) keyedByPubkey+ let signatures = S.toStrict . Data.Binary.encode $ mkCompact $ flip dsign msgBytes <$> orderedKeys+ return $ toBase64String $ S.append signatures msgBytes+ where+ findSigningKey keyedByPubkey pk =+ case lookup pk keyedByPubkey of+ Just k -> Right k+ Nothing -> Left (MissingIndex ("missing signer for " <> show pk))+ checkKeyIsRequired requiredSigners pk =+ if pk `elem` requiredSigners+ then Right ()+ else Left (MissingIndex ("unused signing key " <> show pk))++-- | Builds and signs a durable-nonce transaction: prepends+-- @SystemProgram.advanceNonceAccount nonceAccount nonceAuthority@ ahead of+-- the given instructions and delegates to 'newTransactionIntent'. The+-- durable nonce — read from the nonce account's on-chain 'Network.Solana.NativePrograms.SystemProgram.NonceState' via+-- @nsDurableNonce@ — is passed in place of a recent block hash, since a+-- durable-nonce transaction never expires and does not depend on a recent+-- ledger entry. The nonce authority must be among the given signers, or the+-- resulting transaction will be rejected on submission.+--+-- ORDER-SENSITIVE: as with 'newTransactionIntent', the given private keys+-- must be ordered to match the resulting canonical account order (fee payer+-- first), or the produced signatures will not correspond to the right+-- account keys. If you would rather name the fee payer explicitly and not+-- worry about signer order, use 'newDurableNonceTransactionIntentWithPayer'+-- instead.+newDurableNonceTransactionIntent :: [SolanaPrivateKey] -> SolanaPublicKey -> SolanaPublicKey -> [Instruction] -> BlockHash -> Either CompileException String+newDurableNonceTransactionIntent signers nonceAccount nonceAuthority instructions =+ newTransactionIntent signers (SystemProgram.advanceNonceAccount nonceAccount nonceAuthority : instructions)++-- | Builds and signs a durable-nonce transaction with an explicitly named+-- fee payer: prepends @SystemProgram.advanceNonceAccount nonceAccount+-- nonceAuthority@ ahead of the given instructions and delegates to+-- 'newTransactionIntentWithPayer', composing sponsored fees with durable+-- nonces. As with 'newTransactionIntentWithPayer', the fee payer is forced+-- into account 0 (even if it appears in no instruction), and the given+-- private keys may be listed in any order — signatures are auto-ordered to+-- match the compiled message. The nonce authority must be among the given+-- signers, or the resulting transaction will be rejected on submission.+newDurableNonceTransactionIntentWithPayer :: SolanaPublicKey -> [SolanaPrivateKey] -> SolanaPublicKey -> SolanaPublicKey -> [Instruction] -> BlockHash -> Either CompileException String+newDurableNonceTransactionIntentWithPayer payer signers nonceAccount nonceAuthority instructions =+ newTransactionIntentWithPayer payer signers (SystemProgram.advanceNonceAccount nonceAccount nonceAuthority : instructions)++------------------------------------------------------------------------------------------------++-- ** Message++------------------------------------------------------------------------------------------------++-- | The structure of a transaction message.+data Message = Message+ { -- | Specifies the number of signer and read-only account.+ mHeader :: MessageHeader,+ -- | All the account keys used by this transaction (used by all the instructions on the transaction).+ mAccountKeys :: [SolanaPublicKey],+ -- | The id of a recent ledger entry. Acts as a timestamp for the transaction.+ mRecentBlockhash :: BlockHash,+ {- An array of instructions to be executed.+ Programs that will be executed in sequence and committed in one atomic transaction if all succeed.+ -}+ mInstructions :: [Instruction]+ }+ deriving (Show, Eq, Generic)++-- | Compile instructions into serialized legacy-message bytes using the+-- given recent block hash. Account keys are collected and canonically+-- ordered as described at 'newTransactionIntent'.+newMessage :: BlockHash -> [Instruction] -> Either CompileException S.ByteString+newMessage bh is = compileMessageToBinary (mkNewMessage bh is)++-- | Like 'newMessage', but returns the message bytes Base64-encoded.+newMessageToBase64String :: BlockHash -> [Instruction] -> Either CompileException String+newMessageToBase64String = fmap (fmap toBase64String) . newMessage++compileMessageToBinary :: Message -> Either CompileException S.ByteString+compileMessageToBinary = fmap (S.toStrict . Data.Binary.encode) . compileMessage++-- | Assemble the uncompiled 'Message': fold the instructions' account+-- metas into a deduplicated, privilege-merged key list, then put it in+-- canonical order.+mkNewMessage :: BlockHash -> [Instruction] -> Message+mkNewMessage bh =+ canonicalizeAccountOrder . updateMessageWithInstructions (Message mempty mempty bh mempty)++-- | Like 'mkNewMessage', but with an explicitly named fee payer. The payer+-- is seeded as a writable signer before the instructions' account metas are+-- folded in, so it ends up in the message (and pinned first by+-- 'canonicalizeAccountOrder') even if no instruction references it —+-- enabling sponsored-fee transactions.+mkNewMessageWithPayer :: SolanaPublicKey -> BlockHash -> [Instruction] -> Message+mkNewMessageWithPayer payer bh =+ canonicalizeAccountOrder . updateMessageWithInstructions seeded+ where+ payerMeta = AccountMeta {accountPubKey = payer, isSigner = True, isWritable = True}+ (seededHeader, seededKeys) = updateHeaderAndKeys (mempty, mempty) payerMeta+ seeded = Message seededHeader seededKeys bh mempty++-- | Sort the account keys within each privilege section by raw pubkey bytes,+-- keeping the fee payer (first writable signer) pinned in first position.+-- Matches the Rust SDK's CompiledKeys (BTreeMap) ordering, which is required+-- for byte-identical messages once several program ids share a section.+canonicalizeAccountOrder :: Message -> Message+canonicalizeAccountOrder (Message header keys bh instrs) =+ let (rws, ros, rwus, rous) = splitAccountsByPurpose header keys+ sortKeys = sortOn getSolanaPublicKeyRaw+ rws' = case rws of+ [] -> []+ (feePayer : rest) -> feePayer : sortKeys rest+ keys' = rws' <> sortKeys ros <> sortKeys rwus <> sortKeys rous+ in Message header keys' bh instrs++updateMessageWithInstructions :: Message -> [Instruction] -> Message+updateMessageWithInstructions = foldl' updateMessageWithInstruction++updateMessageWithInstruction :: Message -> Instruction -> Message+updateMessageWithInstruction (Message header accountKeys bh instrs) newInstr =+ let programMeta =+ AccountMeta+ { accountPubKey = iProgramId newInstr,+ isSigner = False,+ isWritable = False+ }+ (newHeader, newAccountKeys) =+ foldl' updateHeaderAndKeys (header, accountKeys) (iAccounts newInstr <> [programMeta])+ newInstrucionsList = instrs <> [newInstr]+ in Message newHeader newAccountKeys bh newInstrucionsList++updateHeaderAndKeys :: (MessageHeader, [SolanaPublicKey]) -> AccountMeta -> (MessageHeader, [SolanaPublicKey])+updateHeaderAndKeys (currentHeader, currentKeys) (AccountMeta newKey isSigner isWritable) =+ let (rws, ros, rwus, rous) = splitAccountsByPurpose currentHeader currentKeys+ alreadySignable = newKey `elem` rws <> ros+ alreadyWritable = newKey `elem` rws <> rwus+ (rws', ros', rwus', rous') =+ case (isSigner || alreadySignable, isWritable || alreadyWritable) of+ (True, True) ->+ ( addIfNotExists newKey rws,+ removeAll newKey ros,+ removeAll newKey rwus,+ removeAll newKey rous+ )+ (True, False) ->+ ( rws,+ addIfNotExists newKey ros,+ rwus,+ removeAll newKey rous+ )+ (False, True) ->+ ( rws,+ ros,+ addIfNotExists newKey rwus,+ removeAll newKey rous+ )+ (False, False) ->+ ( rws,+ ros,+ rwus,+ addIfNotExists newKey rous+ )+ updatedMessage = mkMessageHeaderFromSplittedAccounts (rws', ros', rwus', rous')+ updatedKeys = (rws' <> ros' <> rwus' <> rous')+ in (updatedMessage, updatedKeys)+ where+ addIfNotExists :: (Eq a) => a -> [a] -> [a]+ addIfNotExists x xs =+ if x `elem` xs+ then xs+ else xs ++ [x]++ removeAll :: (Eq a) => a -> [a] -> [a]+ removeAll x = filter (/= x)++splitAccountsByPurpose ::+ MessageHeader ->+ [SolanaPublicKey] ->+ ([SolanaPublicKey], [SolanaPublicKey], [SolanaPublicKey], [SolanaPublicKey])+splitAccountsByPurpose+ (MessageHeader x y z)+ keys =+ let numRequiredSignatures = fromIntegral x+ numReadonlySigned = fromIntegral y+ numReadonlyUnsigned = fromIntegral z++ -- Split into signed and unsigned keys:+ (signed, unsigned) = splitAt numRequiredSignatures keys+ -- For signed keys: first part are read and write, last part are read-only.+ (readAndWriteSigned, readOnlySigned) = splitAt (numRequiredSignatures - numReadonlySigned) signed+ -- For unsigned keys:+ unsignedCount = length unsigned+ (readAndWriteUnsigned, readOnlyUnsigned) = splitAt (unsignedCount - numReadonlyUnsigned) unsigned+ in (readAndWriteSigned, readOnlySigned, readAndWriteUnsigned, readOnlyUnsigned)++mkMessageHeaderFromSplittedAccounts ::+ ([SolanaPublicKey], [SolanaPublicKey], [SolanaPublicKey], [SolanaPublicKey]) ->+ MessageHeader+mkMessageHeaderFromSplittedAccounts (readAndWriteSigned, readOnlySigned, _readAndWriteUnsigned, readOnlyUnsigned) =+ let numRequiredSignatures = fromIntegral $ length readAndWriteSigned + length readOnlySigned+ numReadonlySigned = fromIntegral $ length readOnlySigned+ numReadonlyUnsigned = fromIntegral $ length readOnlyUnsigned+ in MessageHeader numRequiredSignatures numReadonlySigned numReadonlyUnsigned++------------------------------------------------------------------------------------------------++-- *** MessageHeader++------------------------------------------------------------------------------------------------+-- | Three bytes at the front of every message declaring account privileges.+data MessageHeader = MessageHeader+ { -- | Number of signatures required for the message to be valid; the+ -- first @numRequiredSignatures@ account keys of the message must sign,+ -- in order.+ numRequiredSignatures :: Word8,+ -- | Of the signed keys, the last @numReadonlySignedAccounts@ are+ -- read-only.+ numReadonlySignedAccounts :: Word8,+ -- | Of the unsigned keys, the last @numReadonlyUnsignedAccounts@ are+ -- read-only.+ numReadonlyUnsignedAccounts :: Word8+ }+ deriving (Show, Eq, Generic)+ deriving anyclass (ToJSON, FromJSON)++instance Binary MessageHeader where+ put :: MessageHeader -> Put+ put MessageHeader {..} = do+ put numRequiredSignatures+ put numReadonlySignedAccounts+ put numReadonlyUnsignedAccounts++ get :: Get MessageHeader+ get = MessageHeader <$> get <*> get <*> get++instance Semigroup MessageHeader where+ (<>) :: MessageHeader -> MessageHeader -> MessageHeader+ (<>) (MessageHeader rqs ros rou) (MessageHeader rqs' ros' rou') = MessageHeader (rqs + rqs') (ros + ros') (rou + rou')++instance Monoid MessageHeader where+ mempty :: MessageHeader+ mempty = MessageHeader 0 0 0++------------------------------------------------------------------------------------------------++-- ** Compiled Message++------------------------------------------------------------------------------------------------++-- | The structure of a Compiled Message.+data CompiledMessage = CompiledMessage+ { -- | Specifies the number of signer and read-only account.+ cmHeader :: MessageHeader,+ -- | Compact array of account keys used by this transaction (used by all the instructions on the transaction).+ cmAccountKeys :: CompactArray SolanaPublicKey,+ -- | The id of a recent ledger entry. Acts as a timestamp for the transaction.+ cmRecentBlockhash :: BlockHash,+ {- Compact array of compiled instructions to be executed.+ -}+ cmInstructions :: CompactArray CompiledInstruction+ }+ deriving (Show, Eq, Generic)++instance ToJSON CompiledMessage where+ toJSON :: CompiledMessage -> Value+ toJSON (CompiledMessage header accountKeys recentBlockhash instructions) =+ object+ [ "header" .= header,+ "accountKeys" .= unCompact accountKeys,+ "recentBlockhash" .= recentBlockhash,+ "instructions" .= unCompact instructions+ ]++instance FromJSON CompiledMessage where+ parseJSON :: Value -> Parser CompiledMessage+ parseJSON = withObject "CompiledMessage" $ \v ->+ CompiledMessage+ <$> v .: "header"+ <*> (mkCompact <$> (v .: "accountKeys"))+ <*> v .: "recentBlockhash"+ <*> (mkCompact <$> (v .: "instructions"))++instance Binary CompiledMessage where+ put :: CompiledMessage -> Put+ put CompiledMessage {..} = do+ put cmHeader+ put cmAccountKeys+ put cmRecentBlockhash+ put cmInstructions++------------------------------------------------------------------------------------------------++-- *** Compile Message++------------------------------------------------------------------------------------------------+compileMessage :: Message -> Either CompileException CompiledMessage+compileMessage Message {..} = do+ compiledInstrctions <- mapM (compileInstruction mAccountKeys) mInstructions+ return $+ CompiledMessage+ { cmHeader = mHeader,+ cmAccountKeys = mkCompact mAccountKeys,+ cmRecentBlockhash = mRecentBlockhash,+ cmInstructions = mkCompact compiledInstrctions+ }
+ src/Network/Solana/Core/Pda.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Program Derived Addresses (PDAs): addresses derived from seeds and a+-- program id that are guaranteed to lie off the ed25519 curve, so no+-- private key can exist for them. Used by programs to sign via CPI and by+-- clients to locate program-owned accounts (e.g. associated token accounts).+module Network.Solana.Core.Pda+ ( PdaError (..),+ createProgramAddress,+ findProgramAddress,+ )+where++import Crypto.ECC.Edwards25519 qualified as Edwards+import Crypto.Error (CryptoFailable (..))+import Crypto.Hash (Digest, SHA256, hash)+import Data.ByteArray qualified as BA+import Data.ByteString qualified as BS+import Data.Word (Word8)+import Network.Solana.Core.Crypto (SolanaPublicKey, getSolanaPublicKeyRaw, unsafeSolanaPublicKeyRaw)++data PdaError+ = -- | A seed exceeds 32 bytes+ SeedTooLong+ | -- | More than 16 seeds were provided+ TooManySeeds+ | -- | The derived hash landed on the ed25519 curve; use another bump/seed+ InvalidSeeds+ deriving (Eq, Show)++pdaMarker :: BS.ByteString+pdaMarker = "ProgramDerivedAddress"++-- | Derive a program address from seeds and a program id. Fails with+-- 'InvalidSeeds' if the sha256 result is a valid ed25519 curve point.+createProgramAddress :: [BS.ByteString] -> SolanaPublicKey -> Either PdaError SolanaPublicKey+createProgramAddress seeds programId+ | length seeds > 16 = Left TooManySeeds+ | any ((> 32) . BS.length) seeds = Left SeedTooLong+ | otherwise =+ let digest :: Digest SHA256+ digest = hash (BS.concat seeds <> getSolanaPublicKeyRaw programId <> pdaMarker)+ bytes = BS.pack (BA.unpack digest)+ in if isOnCurve bytes+ then Left InvalidSeeds+ else Right (unsafeSolanaPublicKeyRaw (BS.unpack bytes))++-- | Find the first bump seed (255 downto 0) whose derived address is off+-- the curve, mirroring the Rust SDK's @Pubkey::find_program_address@.+findProgramAddress :: [BS.ByteString] -> SolanaPublicKey -> Maybe (SolanaPublicKey, Word8)+findProgramAddress seeds programId = go 255+ where+ go :: Word8 -> Maybe (SolanaPublicKey, Word8)+ go bump =+ case createProgramAddress (seeds <> [BS.singleton bump]) programId of+ Right addr -> Just (addr, bump)+ Left InvalidSeeds+ | bump == 0 -> Nothing+ | otherwise -> go (bump - 1)+ Left _ -> Nothing++-- | A 32-byte string is "on curve" iff it decodes as a valid ed25519 point.+isOnCurve :: BS.ByteString -> Bool+isOnCurve bs =+ case Edwards.pointDecode (BA.convert bs :: BA.Bytes) of+ CryptoPassed _ -> True+ CryptoFailed _ -> False
+ src/Network/Solana/Core/Transaction.hs view
@@ -0,0 +1,24 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}++-- |+-- Module : Network.Solana.Core.Transaction+-- Description : A Solana transaction: a compiled message plus its signatures.+module Network.Solana.Core.Transaction where++import Data.Aeson.Types+import GHC.Generics+import Network.Solana.Core.Crypto (SolanaSignature)+import Network.Solana.Core.Message++-- | A signed transaction as exchanged with RPC nodes: the compiled+-- message together with one signature per required signer.+data Transaction = Transaction+ { -- | The compiled transaction message that was signed.+ message :: CompiledMessage,+ -- | Ed25519 signatures over the serialized message, one per required+ -- signer, in the order of the message's signer account keys.+ signatures :: [SolanaSignature]+ }+ deriving (Generic, Show, Eq)+ deriving anyclass (ToJSON, FromJSON)
+ src/Network/Solana/Core/VersionedMessage.hs view
@@ -0,0 +1,244 @@+{-# LANGUAGE RecordWildCards #-}++-- |+-- Module : Network.Solana.Core.VersionedMessage+-- Description : v0 message compilation (address lookup tables) and versioned-transaction signing.+module Network.Solana.Core.VersionedMessage+ ( AddressLookupTableAccount (..),+ MessageAddressTableLookup (..),+ compileV0Message,+ newV0TransactionIntent,+ )+where++import Data.Binary+import Data.Binary.Put+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.List (elemIndex, partition)+import Data.Maybe (fromJust)+import GHC.Generics (Generic)+import Network.Solana.Core.Block (BlockHash)+import Network.Solana.Core.Compact+import Network.Solana.Core.Crypto (SolanaPrivateKey, SolanaPublicKey, dsign, toBase64String)+import Network.Solana.Core.Instruction+import Network.Solana.Core.Message++------------------------------------------------------------------------------------------------++-- * AddressLookupTableAccount++------------------------------------------------------------------------------------------------++-- | An address lookup table as loaded on-chain: its own address, and the+-- ordered list of addresses it stores. Passed to 'compileV0Message' as a+-- candidate source of accounts, so message account keys can be replaced by+-- a lookup index instead of being listed in full.+data AddressLookupTableAccount = AddressLookupTableAccount+ { -- | The lookup table account's own address.+ altKey :: SolanaPublicKey,+ -- | The addresses stored in the table, in on-chain order (a key's+ -- lookup index is its position in this list).+ altAddresses :: [SolanaPublicKey]+ }+ deriving (Show, Eq, Generic)++------------------------------------------------------------------------------------------------++-- * MessageAddressTableLookup++------------------------------------------------------------------------------------------------++-- | A v0 message's reference to one address lookup table: the table's own+-- address, and the indexes within it to load as writable and read-only+-- accounts respectively.+data MessageAddressTableLookup = MessageAddressTableLookup+ { -- | The lookup table account's own address.+ mtlAccountKey :: SolanaPublicKey,+ -- | Indexes of writable accounts to load from the table.+ mtlWritableIndexes :: [Word8],+ -- | Indexes of read-only accounts to load from the table.+ mtlReadonlyIndexes :: [Word8]+ }+ deriving (Show, Eq, Generic)++instance Binary MessageAddressTableLookup where+ put :: MessageAddressTableLookup -> Put+ put MessageAddressTableLookup {..} = do+ put mtlAccountKey+ put (mkCompact mtlWritableIndexes)+ put (mkCompact mtlReadonlyIndexes)+ get :: Get MessageAddressTableLookup+ get =+ MessageAddressTableLookup+ <$> get+ <*> (unCompact <$> get)+ <*> (unCompact <$> get)++------------------------------------------------------------------------------------------------++-- * Compile v0 message++------------------------------------------------------------------------------------------------++-- | Compile a v0 message (mirrors the Rust SDK's @v0::Message::try_compile@):+-- build the legacy message (privilege union + canonical key ordering, via+-- 'mkNewMessage'), then move eligible writable-unsigned and+-- readonly-unsigned keys into the given lookup tables, in table order, with+-- the first table containing a key winning. Program ids and signers never+-- move to a lookup. Tables that end up with no keys loaded are omitted from+-- the serialized message.+--+-- Fails with a 'CompileException' if a table has more than 256 addresses+-- and a key drained into it sits at position 256 or beyond — that position+-- cannot be represented in the byte-sized lookup index the wire format+-- requires, so it is rejected rather than silently truncated (wrapped) into+-- the wrong index, mirroring Rust's @AddressLookupTableIndexOverflow@.+--+-- __A trap this module can't protect you from:__ an address only just added+-- to a lookup table by an @ExtendLookupTable@ instruction that landed in+-- slot @S@ only becomes eligible for lookup in a slot strictly greater than+-- @S@ -- on-chain, the table's @last_extended_slot@ is set to @S@, and its+-- active-address count stays at the length recorded in+-- @last_extended_slot_start_index@ (the table's length before the first+-- extension that landed in @S@ -- relevant if you batch several extends+-- into the same slot) until the current slot passes @S@. The invariant that+-- matters: whatever bank resolves the lookup (a preflight simulation, or+-- the bank that actually processes the transaction) must be at a slot+-- strictly greater than @S@, or the submission is rejected with+-- \"Transaction address table lookup uses an invalid index\" -- not a bug+-- in this function, but a real on-chain rule to wait out. Read @S@ back+-- with 'Network.Solana.NativePrograms.AddressLookupTable.decodeLookupTable'+-- (its 'Network.Solana.NativePrograms.AddressLookupTable.ltLastExtendedSlot'+-- field) if you need to check it explicitly; the convenience wrapper+-- 'Network.Solana.SolanaWeb3.getLookupTable' drops that field and returns+-- only 'AddressLookupTableAccount', so it can't be used for this check.+compileV0Message :: BlockHash -> [Instruction] -> [AddressLookupTableAccount] -> Either CompileException BS.ByteString+compileV0Message bh instructions tables = do+ let legacy = mkNewMessage bh instructions+ header = mHeader legacy+ keys = mAccountKeys legacy+ (rws, ros, rwus, rous) = splitAccountsByPurpose header keys+ programIds = iProgramId <$> instructions+ (rwusRemaining, rousRemaining, tableLoads) = drainTables programIds rwus rous tables+ statics = rws <> ros <> rwusRemaining <> rousRemaining+ newHeader = header {numReadonlyUnsignedAccounts = fromIntegral (length rousRemaining)}+ resolutionKeys =+ statics+ <> concatMap tlWritableKeys tableLoads+ <> concatMap tlReadonlyKeys tableLoads+ byteIndexes <- mapM toByteIndexes tableLoads+ let lookups =+ [ MessageAddressTableLookup (altKey (tlTable tl)) writableIdx readonlyIdx+ | (tl, (writableIdx, readonlyIdx)) <- zip tableLoads byteIndexes,+ not (null writableIdx && null readonlyIdx)+ ]+ compiledInstructions <- mapM (compileInstruction resolutionKeys) (mInstructions legacy)+ return . BL.toStrict . runPut $ do+ putWord8 0x80+ put newHeader+ put (mkCompact statics)+ put (mRecentBlockhash legacy)+ put (mkCompact compiledInstructions)+ put (mkCompact lookups)++-- | Sign a v0-compiled message with each signer's private key, and return+-- the Base64-encoded signed versioned transaction (compact signature array+-- followed by the message bytes). Mirrors 'Network.Solana.Core.Message.newTransactionIntent'.+-- The private keys passed here must be ordered to match the resulting account+-- order (fee payer first), otherwise the produced signatures will not correspond+-- to the right account keys.+--+-- If any given table was extended very recently, see the note on+-- 'compileV0Message' about the resulting transaction's activation window:+-- whatever bank resolves the lookup must be at a slot strictly past the+-- table's last extension, regardless of the preflight commitment level used+-- to submit it (and regardless of preflight at all, if it is skipped).+newV0TransactionIntent :: [SolanaPrivateKey] -> [Instruction] -> [AddressLookupTableAccount] -> BlockHash -> Either CompileException String+newV0TransactionIntent signers instructions tables bh = do+ msg <- compileV0Message bh instructions tables+ let signatures = BL.toStrict . encode $ mkCompact $ flip dsign msg <$> signers+ return $ toBase64String $ BS.append signatures msg++------------------------------------------------------------------------------------------------++-- * Internal helpers++------------------------------------------------------------------------------------------------++-- | The keys drained from the static writable-/readonly-unsigned sections+-- into one lookup table, alongside the resulting lookup positions. Positions+-- are kept as plain 'Int' (not yet 'Word8') since a table may have more than+-- 256 addresses; 'toByteIndexes' validates and narrows them.+data TableLoad = TableLoad+ { tlTable :: AddressLookupTableAccount,+ tlWritableKeys :: [SolanaPublicKey],+ tlReadonlyKeys :: [SolanaPublicKey],+ tlWritableIdx :: [Int],+ tlReadonlyIdx :: [Int]+ }++-- | Drain eligible keys (present in a table's addresses, and not a program+-- id) from the writable-unsigned and readonly-unsigned pools into each+-- table in turn, preserving pool order within each table and leaving+-- already-drained keys unavailable to later tables. Returns the remaining+-- (undrained) pools and the per-table loads, in table order.+drainTables ::+ [SolanaPublicKey] ->+ [SolanaPublicKey] ->+ [SolanaPublicKey] ->+ [AddressLookupTableAccount] ->+ ([SolanaPublicKey], [SolanaPublicKey], [TableLoad])+drainTables _ rwus rous [] = (rwus, rous, [])+drainTables programIds rwus rous (table : rest) =+ let addrs = altAddresses table+ eligible k = k `notElem` programIds && k `elem` addrs+ (wDrain, rwus') = partition eligible rwus+ (rDrain, rous') = partition eligible rous+ indexIn k = fromJust (elemIndex k addrs)+ tableLoad =+ TableLoad+ { tlTable = table,+ tlWritableKeys = wDrain,+ tlReadonlyKeys = rDrain,+ tlWritableIdx = indexIn <$> wDrain,+ tlReadonlyIdx = indexIn <$> rDrain+ }+ (rwusFinal, rousFinal, restLoads) = drainTables programIds rwus' rous' rest+ in (rwusFinal, rousFinal, tableLoad : restLoads)++-- | Narrow one table's drained positions to the 'Word8' indexes the+-- serialized lookup format requires, failing if any position doesn't fit in+-- a byte.+toByteIndexes :: TableLoad -> Either CompileException ([Word8], [Word8])+toByteIndexes tl+ | all fitsInByte (tlWritableIdx tl <> tlReadonlyIdx tl) =+ Right (fromIntegral <$> tlWritableIdx tl, fromIntegral <$> tlReadonlyIdx tl)+ | otherwise =+ Left+ ( MissingIndex+ ( "address table lookup index overflow: table "+ <> show (altKey (tlTable tl))+ <> " has more than 256 addresses"+ )+ )+ where+ fitsInByte i = i <= fromIntegral (maxBound :: Word8)++-- | Split a message's account keys into its four privilege sections+-- (writable-signed, readonly-signed, writable-unsigned, readonly-unsigned)+-- using the header's counts. Recomputed locally: 'Message'\'s equivalent+-- helper is not exported.+splitAccountsByPurpose ::+ MessageHeader ->+ [SolanaPublicKey] ->+ ([SolanaPublicKey], [SolanaPublicKey], [SolanaPublicKey], [SolanaPublicKey])+splitAccountsByPurpose (MessageHeader numRequiredSignatures' numReadonlySigned' numReadonlyUnsigned') keys =+ let numRequiredSignatures = fromIntegral numRequiredSignatures'+ numReadonlySigned = fromIntegral numReadonlySigned'+ numReadonlyUnsigned = fromIntegral numReadonlyUnsigned'+ (signed, unsigned) = splitAt numRequiredSignatures keys+ (readAndWriteSigned, readOnlySigned) = splitAt (numRequiredSignatures - numReadonlySigned) signed+ unsignedCount = length unsigned+ (readAndWriteUnsigned, readOnlyUnsigned) = splitAt (unsignedCount - numReadonlyUnsigned) unsigned+ in (readAndWriteSigned, readOnlySigned, readAndWriteUnsigned, readOnlyUnsigned)
+ src/Network/Solana/Metaplex/TokenMetadata.hs view
@@ -0,0 +1,377 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Client for the Metaplex Token Metadata program: attaches on-chain+-- metadata (name, symbol, URI, creators, royalties) to SPL Token mints and+-- registers "master edition" NFTs. Instruction data is Borsh-encoded (see+-- "Network.Solana.Core.Borsh"), unlike the native and SPL programs covered+-- elsewhere in this SDK, which use bincode or hand-rolled formats.+--+-- Only three instructions are modeled: 'createMetadataAccountV3',+-- 'updateMetadataAccountV2' and 'createMasterEditionV3'. The rest of the+-- program (50+ instructions, programmable NFTs, delegates, Token-2022+-- support) is out of scope.+module Network.Solana.Metaplex.TokenMetadata+ ( tokenMetadataProgramId,+ deriveMetadataAddress,+ deriveMasterEditionAddress,+ UseMethod (..),+ Creator (..),+ Collection (..),+ Uses (..),+ CollectionDetails (..),+ DataV2 (..),+ TokenMetadataInstruction (..),+ createMetadataAccountV3,+ updateMetadataAccountV2,+ createMasterEditionV3,+ Metadata (..),+ decodeMetadata,+ )+where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.List (isPrefixOf)+import Data.Maybe (fromMaybe)+import GHC.Generics (Generic)+import Network.Solana.Core.Borsh+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction+import Network.Solana.Core.Pda (findProgramAddress)+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.SplPrograms.Token qualified as Token+import Network.Solana.Sysvar qualified as Sysvar++-- | Metaplex Token Metadata program address.+tokenMetadataProgramId :: SolanaPublicKey+tokenMetadataProgramId = "metaqbxxUerdq28cj1RbAWkYQm3ybzjb6a8bt518x1s"++-- | Derive the metadata PDA for a mint: the PDA of+-- @["metadata", program id, mint]@ under the Token Metadata program.+deriveMetadataAddress :: SolanaPublicKey -> Maybe SolanaPublicKey+deriveMetadataAddress mint =+ fst+ <$> findProgramAddress+ [ "metadata",+ getSolanaPublicKeyRaw tokenMetadataProgramId,+ getSolanaPublicKeyRaw mint+ ]+ tokenMetadataProgramId++-- | Derive the master edition PDA for a mint: the PDA of+-- @["metadata", program id, mint, "edition"]@ under the Token Metadata program.+deriveMasterEditionAddress :: SolanaPublicKey -> Maybe SolanaPublicKey+deriveMasterEditionAddress mint =+ fst+ <$> findProgramAddress+ [ "metadata",+ getSolanaPublicKeyRaw tokenMetadataProgramId,+ getSolanaPublicKeyRaw mint,+ "edition"+ ]+ tokenMetadataProgramId++-- | Which "uses" behavior an NFT carries (Borsh u8 enum index 0\/1\/2).+data UseMethod = Burn | Multiple | Single+ deriving (Eq, Show, Enum, Bounded, Generic)++putUseMethod :: UseMethod -> Put+putUseMethod = putWord8 . fromIntegral . fromEnum++getUseMethod :: Get UseMethod+getUseMethod = do+ b <- getWord8+ if b <= 2+ then pure (toEnum (fromIntegral b))+ else fail ("UseMethod: invalid value " <> show b)++-- | A single NFT creator entry: address, whether they have verified their+-- inclusion, and their royalty share (0-100).+data Creator = Creator+ { crAddress :: SolanaPublicKey,+ crVerified :: Bool,+ crShare :: Word8+ }+ deriving (Eq, Show, Generic)++instance Binary Creator where+ put :: Creator -> Put+ put (Creator addr verified share) = do+ putByteString (getSolanaPublicKeyRaw addr)+ putBorshBool verified+ putWord8 share+ get :: Get Creator+ get = Creator <$> get <*> getBorshBool <*> getWord8++-- | The collection an NFT belongs to.+data Collection = Collection+ { colVerified :: Bool,+ colKey :: SolanaPublicKey+ }+ deriving (Eq, Show, Generic)++instance Binary Collection where+ put :: Collection -> Put+ put (Collection verified key) = do+ putBorshBool verified+ putByteString (getSolanaPublicKeyRaw key)+ get :: Get Collection+ get = Collection <$> getBorshBool <*> get++-- | Limited-use configuration for an NFT (e.g. burn-on-use tickets).+data Uses = Uses+ { usesUseMethod :: UseMethod,+ usesRemaining :: Word64,+ usesTotal :: Word64+ }+ deriving (Eq, Show, Generic)++instance Binary Uses where+ put :: Uses -> Put+ put (Uses method usesRemaining' total) = do+ putUseMethod method+ putWord64le usesRemaining'+ putWord64le total+ get :: Get Uses+ get = Uses <$> getUseMethod <*> getWord64le <*> getWord64le++-- | Marks a Metadata account as a collection ("sized" collection, V1). Only+-- the V1 variant is modeled; decoding any other variant tag fails.+newtype CollectionDetails = CollectionDetailsV1 {cdSize :: Word64}+ deriving (Eq, Show, Generic)++instance Binary CollectionDetails where+ put :: CollectionDetails -> Put+ put (CollectionDetailsV1 size) = do+ putWord8 0+ putWord64le size+ get :: Get CollectionDetails+ get = do+ variant <- getWord8+ case variant of+ 0 -> CollectionDetailsV1 <$> getWord64le+ _ -> fail ("CollectionDetails: unsupported variant " <> show variant)++-- | The mutable on-chain fields of a Metadata account.+data DataV2 = DataV2+ { dName :: String,+ dSymbol :: String,+ dUri :: String,+ dSellerFeeBasisPoints :: Word16,+ dCreators :: Maybe [Creator],+ dCollection :: Maybe Collection,+ dUses :: Maybe Uses+ }+ deriving (Eq, Show, Generic)++instance Binary DataV2 where+ put :: DataV2 -> Put+ put (DataV2 name symbol uri fee creators collection uses) = do+ putBorshString name+ putBorshString symbol+ putBorshString uri+ putWord16le fee+ putBorshOption (putBorshVec put) creators+ putBorshOption put collection+ putBorshOption put uses+ get :: Get DataV2+ get =+ DataV2+ <$> getBorshString+ <*> getBorshString+ <*> getBorshString+ <*> getWord16le+ <*> getBorshOption (getBorshVec get)+ <*> getBorshOption get+ <*> getBorshOption get++-- | On-chain state of a Metadata account (the @Metadata@ struct from+-- @mpl-token-metadata@). The head fields are always present; the tail+-- (edition nonce, token standard, collection, uses) was added across+-- several program upgrades, so older accounts simply end early.+data Metadata = Metadata+ { mdKey :: Word8,+ mdUpdateAuthority :: SolanaPublicKey,+ mdMint :: SolanaPublicKey,+ mdName :: String,+ mdSymbol :: String,+ mdUri :: String,+ mdSellerFeeBasisPoints :: Word16,+ mdCreators :: Maybe [Creator],+ mdPrimarySaleHappened :: Bool,+ mdIsMutable :: Bool,+ mdEditionNonce :: Maybe Word8,+ mdTokenStandard :: Maybe Word8,+ mdCollection :: Maybe Collection,+ mdUses :: Maybe Uses+ }+ deriving (Eq, Show)++-- | Strips trailing NUL padding from a Borsh string field. @name@, @symbol@+-- and @uri@ are stored in fixed-size, NUL-padded buffers on-chain.+trimNuls :: String -> String+trimNuls = reverse . dropWhile (== '\0') . reverse++-- | Decodes a Metadata account's data: a Borsh-encoded @key@, two pubkeys,+-- the three NUL-padded name\/symbol\/uri strings, royalty fee, creators,+-- and the @primarySaleHappened@\/@isMutable@ flags, followed by a tolerant+-- tail of @editionNonce@, @tokenStandard@, @collection@ and @uses@: each is+-- read only if bytes remain, and any bytes left over after @uses@ (account+-- padding) are ignored. Fails if the key byte is not 4 (MetadataV1).+decodeMetadata :: BS.ByteString -> Either String Metadata+decodeMetadata bs = case runGetOrFail getMetadata (BL.fromStrict bs) of+ Left (_, _, err) -> Left (prefixError err)+ Right (_, _, m) -> Right m+ where+ prefixError err =+ if "Metadata:" `isPrefixOf` err then err else "Metadata: " <> err+ getMetadata = do+ k <- getWord8+ if k /= 4+ then fail ("Metadata: unexpected account key " <> show k <> " (expected 4)")+ else Metadata k+ <$> get+ <*> get+ <*> (trimNuls <$> getBorshString)+ <*> (trimNuls <$> getBorshString)+ <*> (trimNuls <$> getBorshString)+ <*> getWord16le+ <*> getBorshOption (getBorshVec get)+ <*> getBorshBool+ <*> getBorshBool+ <*> getTolerantOption getWord8+ <*> getTolerantOption getWord8+ <*> getTolerantOption get+ <*> getTolerantOption get+ getTolerantOption getVal = do+ e <- isEmpty+ if e then pure Nothing else getBorshOption getVal++-- | Token Metadata instructions covered by this client (Borsh u8+-- discriminants, arbitrated by the @mpl-token-metadata@ crate's fixtures).+data TokenMetadataInstruction+ = -- | Create a Metadata account (v3) for a mint. Discriminant 33.+ CreateMetadataAccountV3+ { cmaData :: DataV2,+ cmaIsMutable :: Bool,+ cmaCollectionDetails :: Maybe CollectionDetails+ }+ | -- | Update an existing Metadata account (v2). Discriminant 15.+ UpdateMetadataAccountV2+ { umaData :: Maybe DataV2,+ umaUpdateAuthority :: Maybe SolanaPublicKey,+ umaPrimarySaleHappened :: Maybe Bool,+ umaIsMutable :: Maybe Bool+ }+ | -- | Register a Metadata account as a Master Edition (v3). Discriminant 17.+ CreateMasterEditionV3+ { cmeMaxSupply :: Maybe Word64+ }+ deriving (Eq, Show, Generic)++instance Binary TokenMetadataInstruction where+ put :: TokenMetadataInstruction -> Put+ put (CreateMetadataAccountV3 dataV2 isMutable collectionDetails) = do+ putWord8 33+ put dataV2+ putBorshBool isMutable+ putBorshOption put collectionDetails+ put (UpdateMetadataAccountV2 dataV2 updateAuthority primarySaleHappened isMutable) = do+ putWord8 15+ putBorshOption put dataV2+ putBorshOption (putByteString . getSolanaPublicKeyRaw) updateAuthority+ putBorshOption putBorshBool primarySaleHappened+ putBorshOption putBorshBool isMutable+ put (CreateMasterEditionV3 maxSupply) = do+ putWord8 17+ putBorshOption putWord64le maxSupply++ get :: Get TokenMetadataInstruction+ get = do+ disc <- getWord8+ case disc of+ 33 -> CreateMetadataAccountV3 <$> get <*> getBorshBool <*> getBorshOption get+ 15 ->+ UpdateMetadataAccountV2+ <$> getBorshOption get+ <*> getBorshOption get+ <*> getBorshOption getBorshBool+ <*> getBorshOption getBorshBool+ 17 -> CreateMasterEditionV3 <$> getBorshOption getWord64le+ _ -> fail ("TokenMetadataInstruction: unknown discriminant " <> show disc)++-- | Create a new Metadata account (v3) for a mint.+-- Fails with 'error' if PDA derivation fails (established precedent, see+-- "Network.Solana.SplPrograms.AssociatedTokenAccount").+-- # Account references (no rent account — matches the reference crate,+-- which omits the optional rent account entirely when unset)+-- 0. `[WRITE]` Metadata account (derived)+-- 1. `[]` Mint account+-- 2. `[SIGNER]` Mint authority+-- 3. `[WRITE, SIGNER]` Payer+-- 4. `[]` Update authority (signer iff @updateAuthorityIsSigner@)+-- 5. `[]` System program+createMetadataAccountV3 :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Bool -> DataV2 -> Bool -> Maybe CollectionDetails -> Instruction+createMetadataAccountV3 mint mintAuthority payer updateAuthority updateAuthorityIsSigner dataV2 isMutable collectionDetails =+ mkInstruction+ tokenMetadataProgramId+ [ AccountMeta {accountPubKey = metadata, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = mintAuthority, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = payer, isSigner = True, isWritable = True},+ AccountMeta {accountPubKey = updateAuthority, isSigner = updateAuthorityIsSigner, isWritable = False},+ AccountMeta {accountPubKey = SystemProgram.systemProgramId, isSigner = False, isWritable = False}+ ]+ (CreateMetadataAccountV3 dataV2 isMutable collectionDetails)+ where+ metadata = fromMaybe (error "createMetadataAccountV3: metadata PDA derivation failed") (deriveMetadataAddress mint)++-- | Update an existing Metadata account (v2).+-- # Account references+-- 0. `[WRITE]` Metadata account (derived)+-- 1. `[SIGNER]` Update authority+updateMetadataAccountV2 :: SolanaPublicKey -> SolanaPublicKey -> Maybe DataV2 -> Maybe SolanaPublicKey -> Maybe Bool -> Maybe Bool -> Instruction+updateMetadataAccountV2 mint updateAuthority dataV2 newUpdateAuthority primarySaleHappened isMutable =+ mkInstruction+ tokenMetadataProgramId+ [ AccountMeta {accountPubKey = metadata, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = updateAuthority, isSigner = True, isWritable = False}+ ]+ (UpdateMetadataAccountV2 dataV2 newUpdateAuthority primarySaleHappened isMutable)+ where+ metadata = fromMaybe (error "updateMetadataAccountV2: metadata PDA derivation failed") (deriveMetadataAddress mint)++-- | Register a Metadata account as a Master Edition (v3), fixing the+-- maximum number of print editions (or making it unlimited when 'Nothing').+-- Fails with 'error' if PDA derivation fails (see 'createMetadataAccountV3').+-- # Account references+-- 0. `[WRITE]` Master Edition account (derived)+-- 1. `[WRITE]` Mint account+-- 2. `[SIGNER]` Update authority+-- 3. `[SIGNER]` Mint authority+-- 4. `[WRITE, SIGNER]` Payer+-- 5. `[]` Metadata account (derived)+-- 6. `[]` Token program+-- 7. `[]` System program+-- 8. `[]` Rent sysvar+createMasterEditionV3 :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Maybe Word64 -> Instruction+createMasterEditionV3 mint updateAuthority mintAuthority payer maxSupply =+ mkInstruction+ tokenMetadataProgramId+ [ AccountMeta {accountPubKey = edition, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = updateAuthority, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = mintAuthority, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = payer, isSigner = True, isWritable = True},+ AccountMeta {accountPubKey = metadata, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Token.tokenProgramId, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = SystemProgram.systemProgramId, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.rent, isSigner = False, isWritable = False}+ ]+ (CreateMasterEditionV3 maxSupply)+ where+ edition = fromMaybe (error "createMasterEditionV3: master edition PDA derivation failed") (deriveMasterEditionAddress mint)+ metadata = fromMaybe (error "createMasterEditionV3: metadata PDA derivation failed") (deriveMetadataAddress mint)
+ src/Network/Solana/NativePrograms/AddressLookupTable.hs view
@@ -0,0 +1,248 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Client for the Address Lookup Table program. Instruction data is+-- bincode-encoded (u32 little-endian discriminant), like the System+-- Program; the @ExtendLookupTable@ variant's address vector is bincode's+-- @Vec\<Pubkey\>@ encoding (u64 little-endian count followed by the raw+-- 32-byte keys).+module Network.Solana.NativePrograms.AddressLookupTable where++import Control.Monad (replicateM)+import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.Maybe (fromMaybe)+import GHC.Generics (Generic)+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction+import Network.Solana.Core.Pda (findProgramAddress)+import Network.Solana.Core.VersionedMessage qualified as VM+import Network.Solana.NativePrograms.SystemProgram qualified as SP++-- | Address Lookup Table program address.+addressLookupTableProgramId :: SolanaPublicKey+addressLookupTableProgramId = "AddressLookupTab1e1111111111111111111111111"++-- | Address Lookup Table program instructions.+data AddressLookupTableInstruction+ = CreateLookupTable {recentSlot :: Word64, bumpSeed :: Word8}+ | FreezeLookupTable+ | ExtendLookupTable {newAddresses :: [SolanaPublicKey]}+ | DeactivateLookupTable+ | CloseLookupTable+ deriving (Eq, Show, Generic)++-- bincode encodes a Rust Vec<Pubkey> as a u64 little-endian count followed+-- by the raw 32-byte keys.+putBincodeVec :: [SolanaPublicKey] -> Put+putBincodeVec pks = do+ putWord64le (fromIntegral (length pks))+ mapM_ (putByteString . getSolanaPublicKeyRaw) pks++-- | bincode decodes a Rust Vec<Pubkey> as a u64 little-endian count+-- followed by that many raw 32-byte keys.+getBincodeVec :: Get [SolanaPublicKey]+getBincodeVec = do+ count <- getWord64le+ if count > fromIntegral (maxBound :: Int)+ then fail "getBincodeVec: count exceeds Int range"+ else replicateM (fromIntegral count) get++instance Binary AddressLookupTableInstruction where+ put :: AddressLookupTableInstruction -> Put+ put (CreateLookupTable slot bump) = do+ putWord32le 0+ putWord64le slot+ putWord8 bump+ put FreezeLookupTable = putWord32le 1+ put (ExtendLookupTable addrs) = do+ putWord32le 2+ putBincodeVec addrs+ put DeactivateLookupTable = putWord32le 3+ put CloseLookupTable = putWord32le 4++ get :: Get AddressLookupTableInstruction+ get = do+ disc <- getWord32le+ case disc of+ 0 -> CreateLookupTable <$> getWord64le <*> getWord8+ 1 -> pure FreezeLookupTable+ 2 -> ExtendLookupTable <$> getBincodeVec+ 3 -> pure DeactivateLookupTable+ 4 -> pure CloseLookupTable+ _ -> fail ("AddressLookupTableInstruction: unknown discriminant " <> show disc)++-- | An address lookup table account's on-chain state: the fixed-size+-- @LookupTableMeta@ fields followed by the raw stored addresses.+data LookupTableState = LookupTableState+ { ltDeactivationSlot :: Word64,+ ltLastExtendedSlot :: Word64,+ ltLastExtendedSlotStartIndex :: Word8,+ ltAuthority :: Maybe SolanaPublicKey,+ ltAddresses :: [SolanaPublicKey]+ }+ deriving (Eq, Show)++-- | Decodes an address lookup table account's data. The first 56 bytes are+-- the fixed @LookupTableMeta@ region (u32 discriminant, two u64 slots, a u8+-- start index, a bincode @Option\<Pubkey\>@ authority, and trailing padding+-- up to the 56-byte boundary); the remainder is the raw table of 32-byte+-- addresses.+decodeLookupTable :: BS.ByteString -> Either String LookupTableState+decodeLookupTable bs+ | BS.length bs < 56 =+ Left ("LookupTableState: expected at least 56 bytes, got " <> show (BS.length bs))+ | otherwise = do+ (deactivationSlot, lastExtendedSlot, startIndex, authority) <- parseMeta (BS.take 56 bs)+ addresses <- parseAddresses (BS.drop 56 bs)+ Right (LookupTableState deactivationSlot lastExtendedSlot startIndex authority addresses)+ where+ parseMeta chunk = case runGetOrFail getMeta (BL.fromStrict chunk) of+ Left (_, _, err) -> Left err+ Right (_, _, v) -> Right v+ getMeta = do+ disc <- getWord32le+ case disc of+ 0 -> fail "LookupTableState: uninitialized lookup table"+ 1 ->+ (,,,)+ <$> getWord64le+ <*> getWord64le+ <*> getWord8+ <*> getOptionalAuthority+ _ -> fail ("LookupTableState: unknown discriminant " <> show disc)+ getOptionalAuthority = do+ tag <- getWord8+ case tag of+ 0 -> pure Nothing+ 1 -> Just <$> get+ _ -> fail ("LookupTableState: invalid authority option tag " <> show tag)+ parseAddresses addrBytes+ | remainder /= 0 =+ Left ("LookupTableState: addresses length " <> show (BS.length addrBytes) <> " is not a multiple of 32")+ | otherwise = case runGetOrFail (replicateM count get) (BL.fromStrict addrBytes) of+ Left (_, _, err) -> Left err+ Right (_, _, addrs) -> Right addrs+ where+ (count, remainder) = BS.length addrBytes `divMod` 32++-- | Builds the 'VM.AddressLookupTableAccount' 'Network.Solana.Core.VersionedMessage.compileV0Message' expects from+-- the table's own address and its decoded on-chain state.+lookupTableToAccount :: SolanaPublicKey -> LookupTableState -> VM.AddressLookupTableAccount+lookupTableToAccount key state = VM.AddressLookupTableAccount key (ltAddresses state)++-- | Derives the address of a lookup table for a given authority and recent+-- slot: the PDA of @[authority, recentSlot as 8 little-endian bytes]@ under+-- the Address Lookup Table program.+deriveLookupTableAddress :: SolanaPublicKey -> Word64 -> Maybe (SolanaPublicKey, Word8)+deriveLookupTableAddress authority slot =+ findProgramAddress+ [ getSolanaPublicKeyRaw authority,+ BL.toStrict (runPut (putWord64le slot))+ ]+ addressLookupTableProgramId++-- | Creates instruction to "Create a lookup table" and returns it together+-- with the table's derived address.+-- Receives the authority (not required to sign), the payer (which must+-- sign) and the recent slot used to derive the table's address.+-- Calls 'error' if the lookup-table address cannot be derived (practically+-- unreachable: requires every bump candidate to land on-curve).+-- # Account references+-- 0. `[WRITE]` Uninitialized lookup table account+-- 1. `[]` Authority+-- 2. `[WRITE, SIGNER]` Payer account+-- 3. `[]` System program+createLookupTable :: SolanaPublicKey -> SolanaPublicKey -> Word64 -> (Instruction, SolanaPublicKey)+createLookupTable authority payer slot =+ let (table, bump) =+ fromMaybe+ (error "deriveLookupTableAddress: derivation failed")+ (deriveLookupTableAddress authority slot)+ ix =+ mkInstruction+ addressLookupTableProgramId+ [ AccountMeta {accountPubKey = table, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = authority, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = payer, isSigner = True, isWritable = True},+ AccountMeta {accountPubKey = SP.systemProgramId, isSigner = False, isWritable = False}+ ]+ (CreateLookupTable slot bump)+ in (ix, table)++-- | Creates instruction to "Freeze a lookup table, making it immutable"+-- Receives the lookup table account and its authority (which must sign).+-- # Account references+-- 0. `[WRITE]` Lookup table account+-- 1. `[SIGNER]` Authority+freezeLookupTable :: SolanaPublicKey -> SolanaPublicKey -> Instruction+freezeLookupTable table authority =+ mkInstruction+ addressLookupTableProgramId+ [ AccountMeta {accountPubKey = table, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = authority, isSigner = True, isWritable = False}+ ]+ FreezeLookupTable++-- | Creates instruction to "Extend a lookup table with new addresses"+-- Receives the lookup table account, its authority (which must sign), an+-- optional payer to fund the extension (the system program is always+-- included alongside it) and the addresses to append.+-- # Account references+-- 0. `[WRITE]` Lookup table account+-- 1. `[SIGNER]` Authority+-- 2. `[WRITE, SIGNER]` (optional) Payer account+-- 3. `[]` (optional) System program+extendLookupTable :: SolanaPublicKey -> SolanaPublicKey -> Maybe SolanaPublicKey -> [SolanaPublicKey] -> Instruction+extendLookupTable table authority mPayer addrs =+ mkInstruction+ addressLookupTableProgramId+ ( [ AccountMeta {accountPubKey = table, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = authority, isSigner = True, isWritable = False}+ ]+ ++ maybe+ []+ ( \payer ->+ [ AccountMeta {accountPubKey = payer, isSigner = True, isWritable = True},+ AccountMeta {accountPubKey = SP.systemProgramId, isSigner = False, isWritable = False}+ ]+ )+ mPayer+ )+ (ExtendLookupTable addrs)++-- | Creates instruction to "Deactivate a lookup table, making it unusable+-- and eligible for closure once it is no longer referenced by any+-- transaction"+-- Receives the lookup table account and its authority (which must sign).+-- # Account references+-- 0. `[WRITE]` Lookup table account+-- 1. `[SIGNER]` Authority+deactivateLookupTable :: SolanaPublicKey -> SolanaPublicKey -> Instruction+deactivateLookupTable table authority =+ mkInstruction+ addressLookupTableProgramId+ [ AccountMeta {accountPubKey = table, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = authority, isSigner = True, isWritable = False}+ ]+ DeactivateLookupTable++-- | Creates instruction to "Close a deactivated lookup table, reclaiming+-- its lamports"+-- Receives the lookup table account, its authority (which must sign) and+-- the recipient of the reclaimed lamports.+-- # Account references+-- 0. `[WRITE]` Lookup table account+-- 1. `[SIGNER]` Authority+-- 2. `[WRITE]` Recipient account+closeLookupTable :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+closeLookupTable table authority recipient =+ mkInstruction+ addressLookupTableProgramId+ [ AccountMeta {accountPubKey = table, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = authority, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = recipient, isSigner = False, isWritable = True}+ ]+ CloseLookupTable
+ src/Network/Solana/NativePrograms/BpfLoaderUpgradeable.hs view
@@ -0,0 +1,263 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Client for the Upgradeable BPF Loader program (loader-v3). Instruction+-- data is bincode-encoded (u32 little-endian discriminant), like the System+-- Program; the @Write@ variant's byte vector is bincode's @Vec\<u8\>@ encoding+-- (u64 little-endian length followed by the raw bytes).+--+-- Rust's composite helpers (@create_buffer@, @deploy_with_max_program_len@)+-- are deliberately not mirrored: compose them from the System Program client+-- (createAccount) plus 'initializeBuffer' / 'deployWithMaxDataLen'.+module Network.Solana.NativePrograms.BpfLoaderUpgradeable where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString qualified as BS+import GHC.Generics (Generic)+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction+import Network.Solana.Core.Pda (findProgramAddress)+import Network.Solana.NativePrograms.SystemProgram qualified as SP+import Network.Solana.Sysvar qualified as Sysvar++-- | Upgradeable BPF loader program address.+--+-- Named after the Rust SDK's @bpf_loader_upgradeable@ module rather than the+-- @...ProgramId@ convention used elsewhere in this SDK; kept intentionally+-- for symmetry with upstream.+bpfLoaderUpgradeableId :: SolanaPublicKey+bpfLoaderUpgradeableId = "BPFLoaderUpgradeab1e11111111111111111111111"++-- | Upgradeable BPF loader program instructions.+data UpgradeableLoaderInstruction+ = InitializeBuffer+ | Write {wOffset :: Word32, wBytes :: BS.ByteString}+ | DeployWithMaxDataLen {dMaxDataLen :: Word64}+ | Upgrade+ | SetAuthority+ | Close+ | ExtendProgram {eAdditionalBytes :: Word32}+ | SetAuthorityChecked+ deriving (Eq, Show, Generic)++-- bincode encodes a Rust Vec<u8> as a u64 little-endian byte length+-- followed by the raw bytes.+putBincodeBytes :: BS.ByteString -> Put+putBincodeBytes bs = do+ putWord64le (fromIntegral (BS.length bs))+ putByteString bs++-- | bincode decodes a Rust Vec<u8> as a u64 little-endian byte length+-- followed by that many raw bytes.+getBincodeBytes :: Get BS.ByteString+getBincodeBytes = do+ len <- getWord64le+ if len > fromIntegral (maxBound :: Int)+ then fail "getBincodeBytes: length exceeds Int range"+ else getByteString (fromIntegral len)++instance Binary UpgradeableLoaderInstruction where+ put :: UpgradeableLoaderInstruction -> Put+ put InitializeBuffer = putWord32le 0+ put (Write offset bytes) = do+ putWord32le 1+ putWord32le offset+ putBincodeBytes bytes+ put (DeployWithMaxDataLen maxDataLen) = do+ putWord32le 2+ putWord64le maxDataLen+ put Upgrade = putWord32le 3+ put SetAuthority = putWord32le 4+ put Close = putWord32le 5+ put (ExtendProgram additionalBytes) = do+ putWord32le 6+ putWord32le additionalBytes+ put SetAuthorityChecked = putWord32le 7++ get :: Get UpgradeableLoaderInstruction+ get = do+ disc <- getWord32le+ case disc of+ 0 -> pure InitializeBuffer+ 1 -> Write <$> getWord32le <*> getBincodeBytes+ 2 -> DeployWithMaxDataLen <$> getWord64le+ 3 -> pure Upgrade+ 4 -> pure SetAuthority+ 5 -> pure Close+ 6 -> ExtendProgram <$> getWord32le+ 7 -> pure SetAuthorityChecked+ _ -> fail ("UpgradeableLoaderInstruction: unknown discriminant " <> show disc)++-- | Derives the ProgramData account address for a given program: the PDA of+-- @[program]@ under the upgradeable BPF loader.+programDataAddress :: SolanaPublicKey -> Maybe SolanaPublicKey+programDataAddress prog = fst <$> findProgramAddress [getSolanaPublicKeyRaw prog] bpfLoaderUpgradeableId++-- | Creates instruction to "Initialize a Buffer account"+-- Receives the uninitialized buffer account and its authority.+-- # Account references+-- 0. `[WRITE]` Source account to initialize+-- 1. `[]` Buffer authority+initializeBuffer :: SolanaPublicKey -> SolanaPublicKey -> Instruction+initializeBuffer buffer authority =+ mkInstruction+ bpfLoaderUpgradeableId+ [ AccountMeta {accountPubKey = buffer, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = authority, isSigner = False, isWritable = False}+ ]+ InitializeBuffer++-- | Creates instruction to "Write program data into a Buffer account"+-- Receives the buffer account, its authority (which must sign), the byte+-- offset and the bytes to write.+-- # Account references+-- 0. `[WRITE]` Buffer account to write to+-- 1. `[SIGNER]` Buffer authority+write :: SolanaPublicKey -> SolanaPublicKey -> Word32 -> BS.ByteString -> Instruction+write buffer authority offset bytes =+ mkInstruction+ bpfLoaderUpgradeableId+ [ AccountMeta {accountPubKey = buffer, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = authority, isSigner = True, isWritable = False}+ ]+ (Write offset bytes)++-- | Creates instruction to "Deploy an executable program"+-- Receives the payer, the uninitialized ProgramData account, the+-- uninitialized Program account, the Buffer account holding the deployed+-- program data, the authority (which must sign) and the maximum length in+-- bytes the program can be upgraded to.+-- # Account references+-- 0. `[WRITE, SIGNER]` Payer account+-- 1. `[WRITE]` ProgramData account+-- 2. `[WRITE]` Program account+-- 3. `[WRITE]` Buffer account+-- 4. `[]` Rent sysvar+-- 5. `[]` Clock sysvar+-- 6. `[]` System program+-- 7. `[SIGNER]` Authority+deployWithMaxDataLen :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Word64 -> Instruction+deployWithMaxDataLen payer programdata program buffer authority maxDataLen =+ mkInstruction+ bpfLoaderUpgradeableId+ [ AccountMeta {accountPubKey = payer, isSigner = True, isWritable = True},+ AccountMeta {accountPubKey = programdata, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = program, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = buffer, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.rent, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = SP.systemProgramId, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = authority, isSigner = True, isWritable = False}+ ]+ (DeployWithMaxDataLen maxDataLen)++-- | Creates instruction to "Upgrade a program"+-- Receives the ProgramData account, the Program account, the Buffer account+-- holding the new program data, the spill account (which receives excess+-- lamports) and the authority (which must sign).+-- # Account references+-- 0. `[WRITE]` ProgramData account+-- 1. `[WRITE]` Program account+-- 2. `[WRITE]` Buffer account+-- 3. `[WRITE]` Spill account+-- 4. `[]` Rent sysvar+-- 5. `[]` Clock sysvar+-- 6. `[SIGNER]` Authority+upgrade :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+upgrade programdata program buffer spill authority =+ mkInstruction+ bpfLoaderUpgradeableId+ [ AccountMeta {accountPubKey = programdata, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = program, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = buffer, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = spill, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.rent, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = authority, isSigner = True, isWritable = False}+ ]+ Upgrade++-- | Creates instruction to "Set a new authority"+-- Receives the account whose authority is being changed, the current+-- authority (which must sign) and the new authority.+-- # Account references+-- 0. `[WRITE]` Buffer or ProgramData account+-- 1. `[SIGNER]` Current authority+-- 2. `[]` New authority+setAuthority :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+setAuthority owned currentAuthority newAuthority =+ mkInstruction+ bpfLoaderUpgradeableId+ [ AccountMeta {accountPubKey = owned, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = currentAuthority, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = newAuthority, isSigner = False, isWritable = False}+ ]+ SetAuthority++-- | Creates instruction to "Set a new authority", checking that the new+-- authority signs (a safer version of 'setAuthority').+-- Receives the account whose authority is being changed, the current+-- authority (which must sign) and the new authority (which must sign).+-- # Account references+-- 0. `[WRITE]` Buffer or ProgramData account+-- 1. `[SIGNER]` Current authority+-- 2. `[SIGNER]` New authority+setAuthorityChecked :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+setAuthorityChecked owned currentAuthority newAuthority =+ mkInstruction+ bpfLoaderUpgradeableId+ [ AccountMeta {accountPubKey = owned, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = currentAuthority, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = newAuthority, isSigner = True, isWritable = False}+ ]+ SetAuthorityChecked++-- | Creates instruction to "Close an account"+-- Receives the account to close, the recipient of its lamports, the+-- authority (which must sign) and, when closing a ProgramData account, the+-- associated Program account.+-- # Account references+-- 0. `[WRITE]` Account to close+-- 1. `[WRITE]` Recipient account+-- 2. `[SIGNER]` Authority+-- 3. `[WRITE]` (optional) Associated Program account, if closing a ProgramData account+closeAccount :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Maybe SolanaPublicKey -> Instruction+closeAccount account recipient authority mProgram =+ mkInstruction+ bpfLoaderUpgradeableId+ ( [ AccountMeta {accountPubKey = account, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = recipient, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = authority, isSigner = True, isWritable = False}+ ]+ ++ maybe [] (\p -> [AccountMeta {accountPubKey = p, isSigner = False, isWritable = True}]) mProgram+ )+ Close++-- | Creates instruction to "Extend a program's ProgramData account by the+-- given number of bytes"+-- Receives the ProgramData account, the Program account, an optional payer+-- to fund the extension (the system program is always included alongside+-- it), and the number of additional bytes.+-- # Account references+-- 0. `[WRITE]` ProgramData account+-- 1. `[WRITE]` Program account+-- 2. `[]` (optional) System program+-- 3. `[WRITE, SIGNER]` (optional) Payer account+extendProgram :: SolanaPublicKey -> SolanaPublicKey -> Maybe SolanaPublicKey -> Word32 -> Instruction+extendProgram programdata program mPayer additionalBytes =+ mkInstruction+ bpfLoaderUpgradeableId+ ( [ AccountMeta {accountPubKey = programdata, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = program, isSigner = False, isWritable = True}+ ]+ ++ maybe+ []+ ( \payer ->+ [ AccountMeta {accountPubKey = SP.systemProgramId, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = payer, isSigner = True, isWritable = True}+ ]+ )+ mPayer+ )+ (ExtendProgram additionalBytes)
+ src/Network/Solana/NativePrograms/ComputeBudget.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Solana.NativePrograms.ComputeBudget where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import GHC.Generics (Generic)+import Network.Solana.Core.Crypto (SolanaPublicKey)+import Network.Solana.Core.Instruction++-- | Compute Budget program address. This program contains instructions to+-- set transaction-wide compute limits, heap size and a compute unit price+-- ("priority fee") for transaction prioritization.+computeBudgetProgramId :: SolanaPublicKey+computeBudgetProgramId = "ComputeBudget111111111111111111111111111111"++-- | Compute Budget instructions, serialized in the Rust SDK's borsh layout:+-- a single-byte discriminant followed by the little-endian field.+-- The deprecated variant 0 is intentionally not modeled.+data ComputeBudgetInstruction+ = -- | Request a specific transaction-wide program heap region size in bytes+ -- (must be a multiple of 1024)+ RequestHeapFrame Word32+ | -- | Set a specific compute unit limit that the transaction is allowed to consume+ SetComputeUnitLimit Word32+ | -- | Set a compute unit price in micro-lamports to pay a higher transaction+ -- fee for higher transaction prioritization+ SetComputeUnitPrice Word64+ | -- | Set a specific transaction-wide account data size limit, in bytes, allowed to load+ SetLoadedAccountsDataSizeLimit Word32+ deriving (Eq, Show, Generic)++instance Binary ComputeBudgetInstruction where+ put :: ComputeBudgetInstruction -> Put+ put (RequestHeapFrame bytes) = do+ putWord8 1+ putWord32le bytes+ put (SetComputeUnitLimit units) = do+ putWord8 2+ putWord32le units+ put (SetComputeUnitPrice microLamports) = do+ putWord8 3+ putWord64le microLamports+ put (SetLoadedAccountsDataSizeLimit bytes) = do+ putWord8 4+ putWord32le bytes++ get :: Get ComputeBudgetInstruction+ get = do+ disc <- getWord8+ case disc of+ 1 -> RequestHeapFrame <$> getWord32le+ 2 -> SetComputeUnitLimit <$> getWord32le+ 3 -> SetComputeUnitPrice <$> getWord64le+ 4 -> SetLoadedAccountsDataSizeLimit <$> getWord32le+ _ -> fail ("ComputeBudgetInstruction: unknown discriminant " <> show disc)++-- | Creates instruction to "Request a transaction-wide program heap region size in bytes".+-- Compute Budget instructions take no accounts.+requestHeapFrame :: Word32 -> Instruction+requestHeapFrame bytes = mkInstruction computeBudgetProgramId [] (RequestHeapFrame bytes)++-- | Creates instruction to "Set the transaction's compute unit limit".+-- Compute Budget instructions take no accounts.+setComputeUnitLimit :: Word32 -> Instruction+setComputeUnitLimit units = mkInstruction computeBudgetProgramId [] (SetComputeUnitLimit units)++-- | Creates instruction to "Set the compute unit price in micro-lamports" (priority fee).+-- Compute Budget instructions take no accounts.+setComputeUnitPrice :: Word64 -> Instruction+setComputeUnitPrice microLamports = mkInstruction computeBudgetProgramId [] (SetComputeUnitPrice microLamports)++-- | Creates instruction to "Set the transaction-wide loaded account data size limit in bytes".+-- Compute Budget instructions take no accounts.+setLoadedAccountsDataSizeLimit :: Word32 -> Instruction+setLoadedAccountsDataSizeLimit bytes = mkInstruction computeBudgetProgramId [] (SetLoadedAccountsDataSizeLimit bytes)
+ src/Network/Solana/NativePrograms/Secp256k1.hs view
@@ -0,0 +1,130 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Client for the Secp256k1 native precompile program. The precompile+-- verifies secp256k1 (ECDSA/@ecrecover@) signatures included directly in an+-- instruction's data against a message and Ethereum address, also included+-- in that data; it does not compute a signature itself. Signing (producing+-- the signature and recovery id from a private key) is out of scope for this+-- SDK — callers must supply an already-computed signature.+module Network.Solana.NativePrograms.Secp256k1 where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Network.Solana.Core.Crypto (SolanaPublicKey)+import Network.Solana.Core.Instruction++-- | Secp256k1 native precompile program address.+secp256k1ProgramId :: SolanaPublicKey+secp256k1ProgramId = "KeccakSecp256k11111111111111111111111111111"++-- | Offsets (within the transaction's instructions) of the signature,+-- Ethereum address, and message data used to verify a single secp256k1+-- signature. The u8 instruction indexes are absolute indexes into the+-- transaction's instruction list; index @0@ means the transaction's FIRST+-- instruction. Serialized as an 11-byte little-endian packed struct,+-- matching the Rust SDK layout.+data SecpSignatureOffsets = SecpSignatureOffsets+ { -- | Offset to the [signature, recovery_id] bytes (64 + 1 bytes).+ ssoSignatureOffset :: Word16,+ -- | Instruction index to find the signature.+ ssoSignatureInstructionIndex :: Word8,+ -- | Offset to the Ethereum address (20 bytes).+ ssoEthAddressOffset :: Word16,+ -- | Instruction index to find the Ethereum address.+ ssoEthAddressInstructionIndex :: Word8,+ -- | Offset to the start of the message data.+ ssoMessageDataOffset :: Word16,+ -- | Size of the message data, in bytes.+ ssoMessageDataSize :: Word16,+ -- | Instruction index to find the message data.+ ssoMessageInstructionIndex :: Word8+ }+ deriving (Eq, Show)++instance Binary SecpSignatureOffsets where+ put :: SecpSignatureOffsets -> Put+ put (SecpSignatureOffsets sigOffset sigIdx ethOffset ethIdx msgOffset msgSize msgIdx) = do+ putWord16le sigOffset+ putWord8 sigIdx+ putWord16le ethOffset+ putWord8 ethIdx+ putWord16le msgOffset+ putWord16le msgSize+ putWord8 msgIdx++ get :: Get SecpSignatureOffsets+ get =+ SecpSignatureOffsets+ <$> getWord16le+ <*> getWord8+ <*> getWord16le+ <*> getWord8+ <*> getWord16le+ <*> getWord16le+ <*> getWord8++-- | Secp256k1 instruction data: a pre-built byte string. The 'Binary'+-- instance mirrors 'Network.Solana.SplPrograms.Memo.MemoData': 'put' emits+-- the bytes verbatim (no discriminant, no length prefix) and 'get' consumes+-- all remaining input, so that 'mkInstruction' reproduces exactly the bytes+-- built by 'newSecp256k1Instruction'.+newtype Secp256k1InstructionData = Secp256k1InstructionData BS.ByteString+ deriving (Eq, Show)++instance Binary Secp256k1InstructionData where+ put :: Secp256k1InstructionData -> Put+ put (Secp256k1InstructionData bs) = putByteString bs+ get :: Get Secp256k1InstructionData+ get = Secp256k1InstructionData . BL.toStrict <$> getRemainingLazyByteString++-- | Creates a Secp256k1 signature-verification instruction that checks a+-- single, precomputed ECDSA signature: this SDK's counterpart of the Rust+-- SDK's @new_secp256k1_instruction_with_signature@. Receives the 20-byte+-- Ethereum address the signature is expected to recover to, the 64-byte+-- compact ECDSA signature, the recovery id, and the RAW message bytes: the+-- precompile applies Keccak-256 to the message itself during verification,+-- so the supplied signature must have been produced over+-- @keccak256(message)@. The signature, address, and message are all+-- embedded in this single instruction's data (instruction index @0@), so+-- the precompile takes no accounts.+--+-- The recovery id selects which public key the signature recovers to; only+-- values 0-3 verify on-chain, but that range is not validated here,+-- matching the Rust builder.+--+-- Throws via 'error' if @ethAddress@ is not exactly 20 bytes or @signature@+-- is not exactly 64 bytes, mirroring the assertions in the Rust builder.+--+-- The built instruction hardcodes all instruction indexes to 0, so it must+-- be placed as the FIRST instruction of the transaction for verification to+-- read its own embedded data (matching the Rust SDK's+-- @new_secp256k1_instruction@).+newSecp256k1Instruction :: BS.ByteString -> BS.ByteString -> Word8 -> BS.ByteString -> Instruction+newSecp256k1Instruction ethAddress signature recoveryId message+ | BS.length ethAddress /= 20 =+ error ("newSecp256k1Instruction: ethAddress must be 20 bytes, got " <> show (BS.length ethAddress))+ | BS.length signature /= 64 =+ error ("newSecp256k1Instruction: signature must be 64 bytes, got " <> show (BS.length signature))+ | otherwise =+ mkInstruction secp256k1ProgramId [] (Secp256k1InstructionData (BL.toStrict (runPut body)))+ where+ offsets =+ SecpSignatureOffsets+ { ssoSignatureOffset = 32,+ ssoSignatureInstructionIndex = 0,+ ssoEthAddressOffset = 12,+ ssoEthAddressInstructionIndex = 0,+ ssoMessageDataOffset = 97,+ ssoMessageDataSize = fromIntegral (BS.length message),+ ssoMessageInstructionIndex = 0+ }+ body = do+ putWord8 1 -- count: a single signature to verify+ put offsets+ putByteString ethAddress+ putByteString signature+ putWord8 recoveryId+ putByteString message
+ src/Network/Solana/NativePrograms/Stake.hs view
@@ -0,0 +1,415 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Client for the Stake program. Instruction data is bincode-encoded+-- (u32 little-endian discriminant), like the System Program.+-- Covered discriminants: 0-7, 9, 10, 13; the seed-authority variants (8, 11),+-- SetLockupChecked (12), DeactivateDelinquent (14) and the deprecated+-- Redelegate (15) are not modeled.+module Network.Solana.NativePrograms.Stake where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.Int (Int64)+import GHC.Generics (Generic)+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction+import Network.Solana.Sysvar qualified as Sysvar++-- | Stake program address.+stakeProgramId :: SolanaPublicKey+stakeProgramId = "Stake11111111111111111111111111111111111111"++-- | Stake config account address (legacy; still passed to DelegateStake).+stakeConfigId :: SolanaPublicKey+stakeConfigId = "StakeConfig11111111111111111111111111111111"++-- | The authorities of a stake account.+data Authorized = Authorized+ { aStaker :: SolanaPublicKey,+ aWithdrawer :: SolanaPublicKey+ }+ deriving (Eq, Show, Generic)++instance Binary Authorized where+ put :: Authorized -> Put+ put (Authorized staker withdrawer) = do+ putByteString (getSolanaPublicKeyRaw staker)+ putByteString (getSolanaPublicKeyRaw withdrawer)+ get :: Get Authorized+ get = Authorized <$> get <*> get++-- | Lockup constraints on a stake account.+data Lockup = Lockup+ { lUnixTimestamp :: Int64,+ lEpoch :: Word64,+ lCustodian :: SolanaPublicKey+ }+ deriving (Eq, Show, Generic)++instance Binary Lockup where+ put :: Lockup -> Put+ put (Lockup ts epoch cust) = do+ putInt64le ts+ putWord64le epoch+ putByteString (getSolanaPublicKeyRaw cust)+ get :: Get Lockup+ get = Lockup <$> getInt64le <*> getWord64le <*> get++-- | A stake's delegation to a vote account.+data StakeDelegation = StakeDelegation+ { sdVoter :: SolanaPublicKey,+ sdStake :: Word64,+ sdActivationEpoch :: Word64,+ sdDeactivationEpoch :: Word64,+ sdWarmupCooldownRate :: Double+ }+ deriving (Eq, Show)++-- | A stake account's metadata: rent-exempt reserve, authorities, and lockup.+data StakeMeta = StakeMeta+ { smRentExemptReserve :: Word64,+ smAuthorized :: Authorized,+ smLockup :: Lockup+ }+ deriving (Eq, Show)++-- | A stake account's on-chain state (bincode-encoded @StakeStateV2@).+data StakeState+ = StakeUninitialized+ | StakeInitialized StakeMeta+ | -- | Meta, delegation, credits observed, stake flags (wire order).+ StakeActive StakeMeta StakeDelegation Word64 Word8+ | StakeRewardsPool+ deriving (Eq, Show)++-- | Decodes a stake account's data: a u32 discriminant (0 uninitialized,+-- 1 initialized, 2 active/delegated, 3 rewards pool). Trailing bytes+-- (account padding) are allowed.+decodeStakeAccount :: BS.ByteString -> Either String StakeState+decodeStakeAccount bs = case runGetOrFail getStakeState (BL.fromStrict bs) of+ Left (_, _, err) -> Left err+ Right (_, _, s) -> Right s+ where+ getStakeState = do+ disc <- getWord32le+ case disc of+ 0 -> pure StakeUninitialized+ 1 -> StakeInitialized <$> getMeta+ 2 -> StakeActive <$> getMeta <*> getDelegation <*> getWord64le <*> getWord8+ 3 -> pure StakeRewardsPool+ _ -> fail ("StakeState: unknown discriminant " <> show disc)+ getMeta = StakeMeta <$> getWord64le <*> get <*> get+ getDelegation =+ StakeDelegation+ <$> get+ <*> getWord64le+ <*> getWord64le+ <*> getWord64le+ <*> getDoublele++-- | Which stake authority an operation concerns (bincode u32: 0 staker, 1 withdrawer).+data StakeAuthorize = AuthorizeStaker | AuthorizeWithdrawer+ deriving (Eq, Show, Enum, Bounded, Generic)++putStakeAuthorize :: StakeAuthorize -> Put+putStakeAuthorize sa = putWord32le (fromIntegral (fromEnum sa))++getStakeAuthorize :: Get StakeAuthorize+getStakeAuthorize = do+ v <- getWord32le+ if v <= 1+ then pure (toEnum (fromIntegral v))+ else fail ("StakeAuthorize: invalid value " <> show v)++-- | Partial lockup update; bincode Option fields (u8 tag + value).+data LockupArgs = LockupArgs+ { laUnixTimestamp :: Maybe Int64,+ laEpoch :: Maybe Word64,+ laCustodian :: Maybe SolanaPublicKey+ }+ deriving (Eq, Show, Generic)++-- | bincode Option<T>: u8 tag 0 (None) | 1 followed by T.+putBincodeOption :: (a -> Put) -> Maybe a -> Put+putBincodeOption _ Nothing = putWord8 0+putBincodeOption p (Just x) = putWord8 1 >> p x++getBincodeOption :: Get a -> Get (Maybe a)+getBincodeOption g = do+ tag <- getWord8+ case tag of+ 0 -> pure Nothing+ 1 -> Just <$> g+ _ -> fail ("bincode Option: invalid tag " <> show tag)++instance Binary LockupArgs where+ put :: LockupArgs -> Put+ put (LockupArgs ts epoch cust) = do+ putBincodeOption putInt64le ts+ putBincodeOption putWord64le epoch+ putBincodeOption (putByteString . getSolanaPublicKeyRaw) cust+ get :: Get LockupArgs+ get =+ LockupArgs+ <$> getBincodeOption getInt64le+ <*> getBincodeOption getWord64le+ <*> getBincodeOption get++-- | Stake program instructions (covered subset).+data StakeInstruction+ = Initialize Authorized Lockup+ | Authorize SolanaPublicKey StakeAuthorize+ | DelegateStake+ | Split Word64+ | Withdraw Word64+ | Deactivate+ | SetLockup LockupArgs+ | Merge+ | InitializeChecked+ | AuthorizeChecked StakeAuthorize+ | GetMinimumDelegation+ deriving (Eq, Show, Generic)++instance Binary StakeInstruction where+ put :: StakeInstruction -> Put+ put (Initialize authorized lockup) = do+ putWord32le 0+ put authorized+ put lockup+ put (Authorize newAuthority stakeAuthorize) = do+ putWord32le 1+ putByteString (getSolanaPublicKeyRaw newAuthority)+ putStakeAuthorize stakeAuthorize+ put DelegateStake = putWord32le 2+ put (Split amount) = do+ putWord32le 3+ putWord64le amount+ put (Withdraw amount) = do+ putWord32le 4+ putWord64le amount+ put Deactivate = putWord32le 5+ put (SetLockup args) = do+ putWord32le 6+ put args+ put Merge = putWord32le 7+ put InitializeChecked = putWord32le 9+ put (AuthorizeChecked stakeAuthorize) = do+ putWord32le 10+ putStakeAuthorize stakeAuthorize+ put GetMinimumDelegation = putWord32le 13++ get :: Get StakeInstruction+ get = do+ disc <- getWord32le+ case disc of+ 0 -> Initialize <$> get <*> get+ 1 -> Authorize <$> get <*> getStakeAuthorize+ 2 -> pure DelegateStake+ 3 -> Split <$> getWord64le+ 4 -> Withdraw <$> getWord64le+ 5 -> pure Deactivate+ 6 -> SetLockup <$> get+ 7 -> pure Merge+ 9 -> pure InitializeChecked+ 10 -> AuthorizeChecked <$> getStakeAuthorize+ 13 -> pure GetMinimumDelegation+ _ -> fail ("StakeInstruction: unknown discriminant " <> show disc)++-- | Creates instruction to "Initialize a stake with lockup and authorization information"+-- Receives the new stake account, the authorized staker/withdrawer and the lockup.+-- # Account references+-- 0. `[WRITE]` Uninitialized stake account+-- 1. `[]` Rent sysvar+initialize :: SolanaPublicKey -> Authorized -> Lockup -> Instruction+initialize stakeAccount authorized lockup =+ mkInstruction+ stakeProgramId+ [ AccountMeta {accountPubKey = stakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.rent, isSigner = False, isWritable = False}+ ]+ (Initialize authorized lockup)++-- | Creates instruction to "Authorize a key to manage stake or withdrawal"+-- Receives the stake account, the current stake or withdraw authority, the new authority,+-- which authority is being changed and, if updating the withdrawer before lockup expiration,+-- the lockup custodian.+-- # Account references+-- 0. `[WRITE]` Stake account to be updated+-- 1. `[]` Clock sysvar+-- 2. `[SIGNER]` The stake or withdraw authority+-- 3. `[SIGNER]` (optional) Lockup authority, if updating StakeAuthorize::Withdrawer before lockup expiration+authorize :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> StakeAuthorize -> Maybe SolanaPublicKey -> Instruction+authorize stakeAccount currentAuthority newAuthority stakeAuthorize custodian =+ mkInstruction+ stakeProgramId+ ( [ AccountMeta {accountPubKey = stakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = currentAuthority, isSigner = True, isWritable = False}+ ]+ ++ maybe [] (\c -> [AccountMeta {accountPubKey = c, isSigner = True, isWritable = False}]) custodian+ )+ (Authorize newAuthority stakeAuthorize)++-- | Creates instruction to "Delegate a stake to a particular vote account"+-- Receives the stake account, the authorized staker and the vote account.+-- # Account references+-- 0. `[WRITE]` Initialized stake account to be delegated+-- 1. `[]` Vote account to which this stake will be delegated+-- 2. `[]` Clock sysvar+-- 3. `[]` Stake history sysvar+-- 4. `[]` Address of config account that carries stake config+-- 5. `[SIGNER]` Stake authority+delegateStake :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+delegateStake stakeAccount stakeAuthority voteAccount =+ mkInstruction+ stakeProgramId+ [ AccountMeta {accountPubKey = stakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = voteAccount, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.stakeHistory, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = stakeConfigId, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = stakeAuthority, isSigner = True, isWritable = False}+ ]+ DelegateStake++-- | Creates instruction to "Split u64 tokens and stake off a stake account into another stake account"+-- Receives the stake account to split from, the uninitialized stake account that will take the+-- split-off amount, the stake authority and the number of lamports to split.+-- The destination account must already be allocated with 200 bytes and assigned to the stake+-- program (compose with the System Program client's createAccount/allocate+assign); the Rust+-- SDK's composite @split@ helper emits those instructions automatically, this builder does not.+-- # Account references+-- 0. `[WRITE]` Stake account to be split; must be in the Initialized or Stake state+-- 1. `[WRITE]` Uninitialized stake account that will take the split-off amount+-- 2. `[SIGNER]` Stake authority+split :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Word64 -> Instruction+split stakeAccount splitStakeAccount stakeAuthority amount =+ mkInstruction+ stakeProgramId+ [ AccountMeta {accountPubKey = stakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = splitStakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = stakeAuthority, isSigner = True, isWritable = False}+ ]+ (Split amount)++-- | Creates instruction to "Withdraw unstaked lamports from the stake account"+-- Receives the stake account, the recipient account, the withdraw authority, the number of+-- lamports to withdraw and, if withdrawing before lockup expiration, the lockup custodian.+-- # Account references+-- 0. `[WRITE]` Stake account from which to withdraw+-- 1. `[WRITE]` Recipient account+-- 2. `[]` Clock sysvar+-- 3. `[]` Stake history sysvar+-- 4. `[SIGNER]` Withdraw authority+-- 5. `[SIGNER]` (optional) Lockup authority, if before lockup expiration+withdraw :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Word64 -> Maybe SolanaPublicKey -> Instruction+withdraw stakeAccount recipient withdrawAuthority amount custodian =+ mkInstruction+ stakeProgramId+ ( [ AccountMeta {accountPubKey = stakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = recipient, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.stakeHistory, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = withdrawAuthority, isSigner = True, isWritable = False}+ ]+ ++ maybe [] (\c -> [AccountMeta {accountPubKey = c, isSigner = True, isWritable = False}]) custodian+ )+ (Withdraw amount)++-- | Creates instruction to "Deactivate the stake in the account"+-- Receives the stake account and the stake authority.+-- # Account references+-- 0. `[WRITE]` Delegated stake account+-- 1. `[]` Clock sysvar+-- 2. `[SIGNER]` Stake authority+deactivate :: SolanaPublicKey -> SolanaPublicKey -> Instruction+deactivate stakeAccount stakeAuthority =+ mkInstruction+ stakeProgramId+ [ AccountMeta {accountPubKey = stakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = stakeAuthority, isSigner = True, isWritable = False}+ ]+ Deactivate++-- | Creates instruction to "Set stake lockup"+-- Receives the stake account, the lockup fields to update, and the lockup custodian+-- (or, if no lockup is currently in force, the withdraw authority).+-- # Account references+-- 0. `[WRITE]` Stake account+-- 1. `[SIGNER]` Lockup authority or withdraw authority+setLockup :: SolanaPublicKey -> LockupArgs -> SolanaPublicKey -> Instruction+setLockup stakeAccount lockupArgs custodian =+ mkInstruction+ stakeProgramId+ [ AccountMeta {accountPubKey = stakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = custodian, isSigner = True, isWritable = False}+ ]+ (SetLockup lockupArgs)++-- | Creates instruction to "Merge two stake accounts"+-- Receives the destination stake account, the source stake account (which is merged into the+-- destination and deactivated) and the stake authority.+-- # Account references+-- 0. `[WRITE]` Destination stake account for the merge+-- 1. `[WRITE]` Source stake account for the merge+-- 2. `[]` Clock sysvar+-- 3. `[]` Stake history sysvar+-- 4. `[SIGNER]` Stake authority+merge :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+merge destinationStakeAccount sourceStakeAccount stakeAuthority =+ mkInstruction+ stakeProgramId+ [ AccountMeta {accountPubKey = destinationStakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = sourceStakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.stakeHistory, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = stakeAuthority, isSigner = True, isWritable = False}+ ]+ Merge++-- | Creates instruction to "Initialize a stake with authorization information", checking that the+-- withdrawer signs (a safer version of 'initialize').+-- Receives the new stake account and the authorized staker/withdrawer; the withdrawer must sign.+-- # Account references+-- 0. `[WRITE]` Uninitialized stake account+-- 1. `[]` Rent sysvar+-- 2. `[]` The stake authority+-- 3. `[SIGNER]` The withdraw authority+initializeChecked :: SolanaPublicKey -> Authorized -> Instruction+initializeChecked stakeAccount authorized =+ mkInstruction+ stakeProgramId+ [ AccountMeta {accountPubKey = stakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.rent, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = aStaker authorized, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = aWithdrawer authorized, isSigner = True, isWritable = False}+ ]+ InitializeChecked++-- | Creates instruction to "Authorize a key to manage stake or withdrawal", checking that the new+-- authority signs (a safer version of 'authorize').+-- Receives the stake account, the current stake or withdraw authority, the new authority (which+-- must sign), which authority is being changed and, if updating the withdrawer before lockup+-- expiration, the lockup custodian.+-- # Account references+-- 0. `[WRITE]` Stake account to be updated+-- 1. `[]` Clock sysvar+-- 2. `[SIGNER]` The stake or withdraw authority+-- 3. `[SIGNER]` The new stake or withdraw authority+-- 4. `[SIGNER]` (optional) Lockup authority, if updating StakeAuthorize::Withdrawer before lockup expiration+authorizeChecked :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> StakeAuthorize -> Maybe SolanaPublicKey -> Instruction+authorizeChecked stakeAccount currentAuthority newAuthority stakeAuthorize custodian =+ mkInstruction+ stakeProgramId+ ( [ AccountMeta {accountPubKey = stakeAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = currentAuthority, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = newAuthority, isSigner = True, isWritable = False}+ ]+ ++ maybe [] (\c -> [AccountMeta {accountPubKey = c, isSigner = True, isWritable = False}]) custodian+ )+ (AuthorizeChecked stakeAuthorize)
+ src/Network/Solana/NativePrograms/SystemProgram.hs view
@@ -0,0 +1,456 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Solana.NativePrograms.SystemProgram where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import GHC.Generics+import Network.Solana.Core.Account (Lamport)+import Network.Solana.Core.Block (BlockHash)+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction+import Network.Solana.Sysvar qualified as Sysvar++-- | System program address. This program contain instructions to:+-- create new accounts, allocate account data, assign accounts to owning programs,+-- transfer lamports from System Program owned accounts and pay transaction fees.+systemProgramId :: SolanaPublicKey+systemProgramId = "11111111111111111111111111111111"++data SystemInstruction+ = -- | Create a new account+ CreateAccount+ { -- | Number of lamports to transfer to the new account+ lamports :: Word64,+ -- | Number of bytes of memory to allocate+ space :: Word64,+ -- | Address of program that will own the new account+ owner :: SolanaPublicKey+ }+ | -- | Assign account to a program+ Assign+ { -- | Owner program account+ owner :: SolanaPublicKey+ }+ | -- | Transfer lamports+ Transfer+ { -- | Transfer amount+ lamports :: Word64+ }+ | CreateAccountWithSeed+ { -- | Base public key+ base :: SolanaPublicKey,+ -- | String of ASCII chars, no longer than 'Network.Solana.Constants.maxSeedLen'+ seed :: String,+ -- | Number of lamports to transfer to the new account+ lamports :: Word64,+ -- | Number of bytes of memory to allocate+ space :: Word64,+ -- | Address of program that will own the new account+ owner :: SolanaPublicKey+ }+ | -- | Consume a stored nonce, replacing it with a successor+ AdvanceNonceAccount+ | -- | Withdraw funds from a nonce account+ WithdrawNonceAccount+ { -- | Withdraw amount+ lamports :: Word64+ }+ | -- | Drive state of Uninitialized nonce account to Initialized, setting the nonce value+ InitializeNonceAccount+ { -- | Entity authorized to execute nonce instructions on the account+ authority :: SolanaPublicKey+ }+ | -- | Change the entity authorized to execute nonce instructions on the account+ AuthorizeNonceAccount+ { -- | New nonce authority+ authority :: SolanaPublicKey+ }+ | -- | Allocate space in a (possibly new) account without funding+ Allocate+ { -- | Number of bytes of memory to allocate+ space :: Word64+ }+ | -- | Allocate space for and assign an account at an address derived from a base public key and a seed+ AllocateWithSeed+ { -- | Base public key+ base :: SolanaPublicKey,+ -- | String of ASCII chars, no longer than 'Network.Solana.Constants.maxSeedLen'+ seed :: String,+ -- | Number of bytes of memory to allocate+ space :: Word64,+ -- | Address of program that will own the account+ owner :: SolanaPublicKey+ }+ | -- | Assign account to a program based on a seed+ AssignWithSeed+ { -- | Base public key+ base :: SolanaPublicKey,+ -- | String of ASCII chars, no longer than 'Network.Solana.Constants.maxSeedLen'+ seed :: String,+ -- | Owner program account+ owner :: SolanaPublicKey+ }+ | -- | Transfer lamports from a derived address+ TransferWithSeed+ { -- | Transfer amount+ lamports :: Word64,+ -- | Seed to use to derive the funding account address+ fromSeed :: String,+ -- | Owner to use to derive the funding account address+ fromOwner :: SolanaPublicKey+ }+ | -- | One-time idempotent upgrade of legacy nonce versions to bump them out of chain blockhash domain+ UpgradeNonceAccount+ deriving (Eq, Show, Generic)++instance Binary SystemInstruction where+ put :: SystemInstruction -> Put+ put (CreateAccount lamports space owner) = do+ putWord32le (0 :: Word32)+ putWord64le lamports+ putWord64le space+ putByteString (getSolanaPublicKeyRaw owner)+ put (Assign owner) = do+ putWord32le (1 :: Word32)+ putByteString (getSolanaPublicKeyRaw owner)+ put (Transfer lamports) = do+ putWord32le (2 :: Word32)+ putWord64le lamports+ put (CreateAccountWithSeed base seed lamports space owner) = do+ putWord32le (3 :: Word32)+ putByteString (getSolanaPublicKeyRaw base)+ putBincodeString seed+ putWord64le lamports+ putWord64le space+ putByteString (getSolanaPublicKeyRaw owner)+ put AdvanceNonceAccount =+ putWord32le (4 :: Word32)+ put (WithdrawNonceAccount lamports) = do+ putWord32le (5 :: Word32)+ putWord64le lamports+ put (InitializeNonceAccount authority) = do+ putWord32le (6 :: Word32)+ putByteString (getSolanaPublicKeyRaw authority)+ put (AuthorizeNonceAccount authority) = do+ putWord32le (7 :: Word32)+ putByteString (getSolanaPublicKeyRaw authority)+ put (Allocate space) = do+ putWord32le (8 :: Word32)+ putWord64le space+ put (AllocateWithSeed base seed space owner) = do+ putWord32le (9 :: Word32)+ putByteString (getSolanaPublicKeyRaw base)+ putBincodeString seed+ putWord64le space+ putByteString (getSolanaPublicKeyRaw owner)+ put (AssignWithSeed base seed owner) = do+ putWord32le (10 :: Word32)+ putByteString (getSolanaPublicKeyRaw base)+ putBincodeString seed+ putByteString (getSolanaPublicKeyRaw owner)+ put (TransferWithSeed lamports fromSeed fromOwner) = do+ putWord32le (11 :: Word32)+ putWord64le lamports+ putBincodeString fromSeed+ putByteString (getSolanaPublicKeyRaw fromOwner)+ put UpgradeNonceAccount =+ putWord32le (12 :: Word32)++ get :: Get SystemInstruction+ get = do+ disc <- getWord32le+ case disc of+ 0 -> CreateAccount <$> getWord64le <*> getWord64le <*> get+ 1 -> Assign <$> get+ 2 -> Transfer <$> getWord64le+ 3 -> CreateAccountWithSeed <$> get <*> getBincodeString <*> getWord64le <*> getWord64le <*> get+ 4 -> pure AdvanceNonceAccount+ 5 -> WithdrawNonceAccount <$> getWord64le+ 6 -> InitializeNonceAccount <$> get+ 7 -> AuthorizeNonceAccount <$> get+ 8 -> Allocate <$> getWord64le+ 9 -> AllocateWithSeed <$> get <*> getBincodeString <*> getWord64le <*> get+ 10 -> AssignWithSeed <$> get <*> getBincodeString <*> get+ 11 -> TransferWithSeed <$> getWord64le <*> getBincodeString <*> get+ 12 -> pure UpgradeNonceAccount+ _ -> fail ("SystemInstruction: unknown discriminant " <> show disc)++-- bincode encodes a Rust String as a u64 little-endian byte length+-- followed by the UTF-8 bytes+putBincodeString :: String -> Put+putBincodeString s = do+ let bs = TE.encodeUtf8 (T.pack s)+ putWord64le (fromIntegral (BS.length bs))+ putByteString bs++-- | bincode decodes a Rust String as a u64 little-endian byte length+-- followed by that many UTF-8 bytes.+getBincodeString :: Get String+getBincodeString = do+ len <- getWord64le+ if len > fromIntegral (maxBound :: Int)+ then fail "getBincodeString: length exceeds Int range"+ else do+ bs <- getByteString (fromIntegral len)+ case TE.decodeUtf8' bs of+ Left _ -> fail "getBincodeString: invalid UTF-8"+ Right t -> pure (T.unpack t)++-- | A nonce account's on-chain state (bincode-encoded @Versions<State>@:+-- a u32 version tag around a u32 state tag).+data NonceState+ = NonceUninitialized+ | NonceInitialized+ { nsAuthority :: SolanaPublicKey,+ nsDurableNonce :: BlockHash,+ nsLamportsPerSignature :: Word64+ }+ deriving (Eq, Show)++-- | Decodes a nonce account's data: a u32 version (0 or 1), then a u32 state+-- discriminant (0 uninitialized, 1 initialized with authority, durable+-- nonce, and fee-rate fields). Trailing bytes (account padding) are allowed.+decodeNonceAccount :: BS.ByteString -> Either String NonceState+decodeNonceAccount bs = case runGetOrFail getNonceState (BL.fromStrict bs) of+ Left (_, _, err) -> Left err+ Right (_, _, ns) -> Right ns+ where+ getNonceState = do+ version <- getWord32le+ if version /= 0 && version /= 1+ then fail ("NonceState: unsupported version " <> show version)+ else do+ st <- getWord32le+ case st of+ 0 -> pure NonceUninitialized+ 1 -> NonceInitialized <$> get <*> get <*> getWord64le+ _ -> fail ("NonceState: unknown state " <> show st)++-- | Creates instruction to "Create a new account"+-- Receives the funding account, the new account, amount to transfer, the number of bytes of memory to allocate and the owner program account.+-- # Account references+-- 0. `[WRITE, SIGNER]` Funding account+-- 1. `[WRITE, SIGNER]` New account+createAccount :: SolanaPublicKey -> SolanaPublicKey -> Lamport -> Int -> SolanaPublicKey -> Instruction+createAccount fundingAccount newAccount lamports space ownerProgramAccount =+ mkInstruction+ systemProgramId+ [ AccountMeta+ { accountPubKey = fundingAccount,+ isSigner = True,+ isWritable = True+ },+ AccountMeta+ { accountPubKey = newAccount,+ isSigner = True,+ isWritable = True+ }+ ]+ (CreateAccount (fromIntegral lamports) (fromIntegral space) ownerProgramAccount)++-- | Creates instruction to "Assign account to a program"+-- Receives addresses for the assigned account and owner program account+-- # Account references+-- 0. `[WRITE, SIGNER]` Assigned account public key+assignAccount :: SolanaPublicKey -> SolanaPublicKey -> Instruction+assignAccount assignedAccount ownerProgramAccount =+ mkInstruction+ systemProgramId+ [ AccountMeta+ { accountPubKey = assignedAccount,+ isSigner = True,+ isWritable = True+ }+ ]+ (Assign ownerProgramAccount)++-- | Creates instruction to "Transfer lamports"+-- Receives the funding account, the recipient account and the amount to transfer.+-- # Account references+-- 0. `[WRITE, SIGNER]` Funding account+-- 1. `[WRITE]` Recipient account+transfer :: SolanaPublicKey -> SolanaPublicKey -> Lamport -> Instruction+transfer fundingAccount recipientAccount amount =+ mkInstruction+ systemProgramId+ [ AccountMeta+ { accountPubKey = fundingAccount,+ isSigner = True,+ isWritable = True+ },+ AccountMeta+ { accountPubKey = recipientAccount,+ isSigner = False,+ isWritable = True+ }+ ]+ (Transfer (fromIntegral amount))++-- | Creates instruction to "Create a new account at an address derived from a base pubkey and a seed"+-- Receives the funding account, the new account, base pubkey, seed, amount to transfer, the number of bytes of memory to allocate and the owner program account.+-- # Account references+-- 0. `[WRITE, SIGNER]` Funding account+-- 1. `[WRITE]` Created account+-- 2. `[SIGNER]` (optional) Base account; the account matching the base Pubkey below must be+-- provided as a signer, but may be the same as the funding account and provided as account 0+createAccountWithSeed :: SolanaPublicKey -> String -> SolanaPublicKey -> SolanaPublicKey -> Lamport -> Int -> SolanaPublicKey -> Instruction+createAccountWithSeed baseAccount seed fundingAccount newAccount lamports space ownerProgramAccount =+ mkInstruction+ systemProgramId+ [ AccountMeta+ { accountPubKey = fundingAccount,+ isSigner = True,+ isWritable = True+ },+ AccountMeta+ { accountPubKey = newAccount,+ isSigner = False,+ isWritable = True+ },+ AccountMeta+ { accountPubKey = baseAccount,+ isSigner = True,+ isWritable = False+ }+ ]+ (CreateAccountWithSeed baseAccount seed (fromIntegral lamports) (fromIntegral space) ownerProgramAccount)++-- | Creates instruction to "Consume a stored nonce, replacing it with a successor"+-- Receives the nonce account and the nonce authority.+-- # Account references+-- 0. `[WRITE]` Nonce account+-- 1. `[]` RecentBlockhashes sysvar+-- 2. `[SIGNER]` Nonce authority+advanceNonceAccount :: SolanaPublicKey -> SolanaPublicKey -> Instruction+advanceNonceAccount nonceAccount nonceAuthority =+ mkInstruction+ systemProgramId+ [ AccountMeta {accountPubKey = nonceAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.recentBlockhashes, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = nonceAuthority, isSigner = True, isWritable = False}+ ]+ AdvanceNonceAccount++-- | Creates instruction to "Withdraw funds from a nonce account"+-- Receives the nonce account, the nonce authority, the recipient account and the amount.+-- # Account references+-- 0. `[WRITE]` Nonce account+-- 1. `[WRITE]` Recipient account+-- 2. `[]` RecentBlockhashes sysvar+-- 3. `[]` Rent sysvar+-- 4. `[SIGNER]` Nonce authority+withdrawNonceAccount :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Lamport -> Instruction+withdrawNonceAccount nonceAccount nonceAuthority recipientAccount amount =+ mkInstruction+ systemProgramId+ [ AccountMeta {accountPubKey = nonceAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = recipientAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.recentBlockhashes, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.rent, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = nonceAuthority, isSigner = True, isWritable = False}+ ]+ (WithdrawNonceAccount (fromIntegral amount))++-- | Creates instruction to "Drive state of Uninitialized nonce account to Initialized"+-- Receives the nonce account and the entity authorized to execute nonce instructions on it.+-- # Account references+-- 0. `[WRITE]` Nonce account+-- 1. `[]` RecentBlockhashes sysvar+-- 2. `[]` Rent sysvar+initializeNonceAccount :: SolanaPublicKey -> SolanaPublicKey -> Instruction+initializeNonceAccount nonceAccount nonceAuthority =+ mkInstruction+ systemProgramId+ [ AccountMeta {accountPubKey = nonceAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.recentBlockhashes, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.rent, isSigner = False, isWritable = False}+ ]+ (InitializeNonceAccount nonceAuthority)++-- | Creates instruction to "Change the entity authorized to execute nonce instructions on the account"+-- Receives the nonce account, the current nonce authority and the new nonce authority.+-- # Account references+-- 0. `[WRITE]` Nonce account+-- 1. `[SIGNER]` Nonce authority+authorizeNonceAccount :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+authorizeNonceAccount nonceAccount nonceAuthority newAuthority =+ mkInstruction+ systemProgramId+ [ AccountMeta {accountPubKey = nonceAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = nonceAuthority, isSigner = True, isWritable = False}+ ]+ (AuthorizeNonceAccount newAuthority)++-- | Creates instruction to "Upgrade legacy nonce versions"+-- Receives the nonce account.+-- # Account references+-- 0. `[WRITE]` Nonce account+upgradeNonceAccount :: SolanaPublicKey -> Instruction+upgradeNonceAccount nonceAccount =+ mkInstruction+ systemProgramId+ [ AccountMeta {accountPubKey = nonceAccount, isSigner = False, isWritable = True}+ ]+ UpgradeNonceAccount++-- | Creates instruction to "Allocate space in a (possibly new) account without funding"+-- Receives the account and the number of bytes of memory to allocate.+-- # Account references+-- 0. `[WRITE, SIGNER]` New account+allocate :: SolanaPublicKey -> Int -> Instruction+allocate newAccount space =+ mkInstruction+ systemProgramId+ [ AccountMeta {accountPubKey = newAccount, isSigner = True, isWritable = True}+ ]+ (Allocate (fromIntegral space))++-- | Creates instruction to "Allocate space for and assign an account at an address derived from a base public key and a seed"+-- Receives the allocated account, base account, seed, the number of bytes and the owner program account.+-- # Account references+-- 0. `[WRITE]` Allocated account+-- 1. `[SIGNER]` Base account+allocateWithSeed :: SolanaPublicKey -> SolanaPublicKey -> String -> Int -> SolanaPublicKey -> Instruction+allocateWithSeed allocatedAccount baseAccount seed space ownerProgramAccount =+ mkInstruction+ systemProgramId+ [ AccountMeta {accountPubKey = allocatedAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = baseAccount, isSigner = True, isWritable = False}+ ]+ (AllocateWithSeed baseAccount seed (fromIntegral space) ownerProgramAccount)++-- | Creates instruction to "Assign account to a program based on a seed"+-- Receives the assigned account, base account, seed and the owner program account.+-- # Account references+-- 0. `[WRITE]` Assigned account+-- 1. `[SIGNER]` Base account+assignWithSeed :: SolanaPublicKey -> SolanaPublicKey -> String -> SolanaPublicKey -> Instruction+assignWithSeed assignedAccount baseAccount seed ownerProgramAccount =+ mkInstruction+ systemProgramId+ [ AccountMeta {accountPubKey = assignedAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = baseAccount, isSigner = True, isWritable = False}+ ]+ (AssignWithSeed baseAccount seed ownerProgramAccount)++-- | Creates instruction to "Transfer lamports from a derived address"+-- Receives the funding account, base account, seed, the owner of the funding account, the recipient and the amount.+-- # Account references+-- 0. `[WRITE]` Funding account+-- 1. `[SIGNER]` Base for funding account+-- 2. `[WRITE]` Recipient account+transferWithSeed :: SolanaPublicKey -> SolanaPublicKey -> String -> SolanaPublicKey -> SolanaPublicKey -> Lamport -> Instruction+transferWithSeed fundingAccount baseAccount fromSeed fromOwner recipientAccount amount =+ mkInstruction+ systemProgramId+ [ AccountMeta {accountPubKey = fundingAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = baseAccount, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = recipientAccount, isSigner = False, isWritable = True}+ ]+ (TransferWithSeed (fromIntegral amount) fromSeed fromOwner)
+ src/Network/Solana/NativePrograms/Vote.hs view
@@ -0,0 +1,199 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Client for the Vote program. Instruction data is bincode-encoded+-- (u32 little-endian discriminant), like the System and Stake programs.+-- Covered discriminants: 0, 1, 3, 4, 5, 7 (account-management surface); the+-- consensus @Vote@ instruction (2) and the remaining vote-state variants+-- (6, 8-15) are not modeled.+module Network.Solana.NativePrograms.Vote where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import GHC.Generics (Generic)+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction+import Network.Solana.Sysvar qualified as Sysvar++-- | Vote program address.+voteProgramId :: SolanaPublicKey+voteProgramId = "Vote111111111111111111111111111111111111111"++-- | Arguments to initialize a vote account.+data VoteInit = VoteInit+ { viNodePubkey :: SolanaPublicKey,+ viAuthorizedVoter :: SolanaPublicKey,+ viAuthorizedWithdrawer :: SolanaPublicKey,+ viCommission :: Word8+ }+ deriving (Eq, Show, Generic)++instance Binary VoteInit where+ put :: VoteInit -> Put+ put (VoteInit node voter withdrawer commission) = do+ putByteString (getSolanaPublicKeyRaw node)+ putByteString (getSolanaPublicKeyRaw voter)+ putByteString (getSolanaPublicKeyRaw withdrawer)+ putWord8 commission+ get :: Get VoteInit+ get = VoteInit <$> get <*> get <*> get <*> getWord8++-- | Which vote authority an operation concerns (bincode u32: 0 voter, 1 withdrawer).+data VoteAuthorize = AuthorizeVoter | AuthorizeWithdrawer+ deriving (Eq, Show, Enum, Bounded, Generic)++putVoteAuthorize :: VoteAuthorize -> Put+putVoteAuthorize va = putWord32le (fromIntegral (fromEnum va))++getVoteAuthorize :: Get VoteAuthorize+getVoteAuthorize = do+ v <- getWord32le+ if v <= 1+ then pure (toEnum (fromIntegral v))+ else fail ("VoteAuthorize: invalid value " <> show v)++-- | Vote program instructions (covered subset).+data VoteInstruction+ = InitializeAccount VoteInit+ | Authorize SolanaPublicKey VoteAuthorize+ | Withdraw Word64+ | UpdateValidatorIdentity+ | UpdateCommission Word8+ | AuthorizeChecked VoteAuthorize+ deriving (Eq, Show, Generic)++instance Binary VoteInstruction where+ put :: VoteInstruction -> Put+ put (InitializeAccount voteInit) = do+ putWord32le 0+ put voteInit+ put (Authorize newAuthority voteAuthorize) = do+ putWord32le 1+ putByteString (getSolanaPublicKeyRaw newAuthority)+ putVoteAuthorize voteAuthorize+ put (Withdraw amount) = do+ putWord32le 3+ putWord64le amount+ put UpdateValidatorIdentity = putWord32le 4+ put (UpdateCommission commission) = do+ putWord32le 5+ putWord8 commission+ put (AuthorizeChecked voteAuthorize) = do+ putWord32le 7+ putVoteAuthorize voteAuthorize++ get :: Get VoteInstruction+ get = do+ disc <- getWord32le+ case disc of+ 0 -> InitializeAccount <$> get+ 1 -> Authorize <$> get <*> getVoteAuthorize+ 3 -> Withdraw <$> getWord64le+ 4 -> pure UpdateValidatorIdentity+ 5 -> UpdateCommission <$> getWord8+ 7 -> AuthorizeChecked <$> getVoteAuthorize+ _ -> fail ("VoteInstruction: unknown discriminant " <> show disc)++-- | Creates instruction to "Initialize a vote account"+-- Receives the new vote account and the initialization arguments (node+-- identity, authorized voter/withdrawer and commission).+-- # Account references+-- 0. `[WRITE]` Uninitialized vote account+-- 1. `[]` Rent sysvar+-- 2. `[]` Clock sysvar+-- 3. `[SIGNER]` New validator identity (node)+initializeVoteAccount :: SolanaPublicKey -> VoteInit -> Instruction+initializeVoteAccount voteAccount voteInit =+ mkInstruction+ voteProgramId+ [ AccountMeta {accountPubKey = voteAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.rent, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = viNodePubkey voteInit, isSigner = True, isWritable = False}+ ]+ (InitializeAccount voteInit)++-- | Creates instruction to "Authorize a key to send votes or issue a withdrawal"+-- Receives the vote account, the current authority, the new authority and+-- which authority is being changed.+-- # Account references+-- 0. `[WRITE]` Vote account to be updated+-- 1. `[]` Clock sysvar+-- 2. `[SIGNER]` The vote or withdraw authority+authorizeVote :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> VoteAuthorize -> Instruction+authorizeVote voteAccount currentAuthority newAuthority voteAuthorize =+ mkInstruction+ voteProgramId+ [ AccountMeta {accountPubKey = voteAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = currentAuthority, isSigner = True, isWritable = False}+ ]+ (Authorize newAuthority voteAuthorize)++-- | Creates instruction to "Withdraw lamports from a vote account"+-- Receives the vote account, the recipient account, the withdraw authority+-- and the number of lamports to withdraw.+-- # Account references+-- 0. `[WRITE]` Vote account to withdraw from+-- 1. `[WRITE]` Recipient account+-- 2. `[SIGNER]` Withdraw authority+withdrawVote :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Word64 -> Instruction+withdrawVote voteAccount recipient withdrawAuthority amount =+ mkInstruction+ voteProgramId+ [ AccountMeta {accountPubKey = voteAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = recipient, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = withdrawAuthority, isSigner = True, isWritable = False}+ ]+ (Withdraw amount)++-- | Creates instruction to "Update the vote account's validator identity (node pubkey)"+-- Receives the vote account, the new validator identity (which must sign) and+-- the withdraw authority.+-- # Account references+-- 0. `[WRITE]` Vote account to be updated+-- 1. `[SIGNER]` New validator identity (node)+-- 2. `[SIGNER]` Withdraw authority+updateValidatorIdentity :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+updateValidatorIdentity voteAccount newNode withdrawAuthority =+ mkInstruction+ voteProgramId+ [ AccountMeta {accountPubKey = voteAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = newNode, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = withdrawAuthority, isSigner = True, isWritable = False}+ ]+ UpdateValidatorIdentity++-- | Creates instruction to "Update the vote account's commission"+-- Receives the vote account, the withdraw authority and the new commission.+-- # Account references+-- 0. `[WRITE]` Vote account to be updated+-- 1. `[SIGNER]` Withdraw authority+updateCommission :: SolanaPublicKey -> SolanaPublicKey -> Word8 -> Instruction+updateCommission voteAccount withdrawAuthority commission =+ mkInstruction+ voteProgramId+ [ AccountMeta {accountPubKey = voteAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = withdrawAuthority, isSigner = True, isWritable = False}+ ]+ (UpdateCommission commission)++-- | Creates instruction to "Authorize a key to send votes or issue a withdrawal", checking+-- that the new authority signs (a safer version of 'authorizeVote').+-- Receives the vote account, the current authority, the new authority (which+-- must sign) and which authority is being changed.+-- # Account references+-- 0. `[WRITE]` Vote account to be updated+-- 1. `[]` Clock sysvar+-- 2. `[SIGNER]` The vote or withdraw authority+-- 3. `[SIGNER]` The new vote or withdraw authority+authorizeVoteChecked :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> VoteAuthorize -> Instruction+authorizeVoteChecked voteAccount currentAuthority newAuthority voteAuthorize =+ mkInstruction+ voteProgramId+ [ AccountMeta {accountPubKey = voteAccount, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.clock, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = currentAuthority, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = newAuthority, isSigner = True, isWritable = False}+ ]+ (AuthorizeChecked voteAuthorize)
+ src/Network/Solana/RPC/HTTP/Account.hs view
@@ -0,0 +1,210 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.RPC.HTTP.Account+-- Description : Solana RPC methods for retrieving account-related data.+--+-- This module provides bindings to various Solana JSON-RPC methods+-- for fetching account information, balances, transaction signatures,+-- and related metadata.+module Network.Solana.RPC.HTTP.Account where++import Data.Aeson+import Data.Aeson.Types+import Data.Int (Int64)+import GHC.Generics (Generic)+import Network.JsonRpc.TinyClient (JsonRpc (..))+import Network.Solana.Core.Account (Account, AccountInfo, Lamport)+import Network.Solana.Core.Crypto (SolanaPublicKey, SolanaSignature)+import Network.Solana.RPC.HTTP.Types++------------------------------------------------------------------------------------------------++-- ** getAccountInfo++------------------------------------------------------------------------------------------------++-- | Fetches all available data for the given account address, using the given configuration.+-- Returns 'RPCResponse' ('Maybe' 'AccountInfo'), where 'Nothing' indicates the account does not exist.+getAccountInfo' :: (JsonRpc m) => SolanaPublicKey -> ConfigurationObject -> m (RPCResponse (Maybe AccountInfo))+getAccountInfo' = do+ remote "getAccountInfo"+{-# INLINE getAccountInfo' #-}++-- | Fetches all available data for the given account address, requesting+-- base64 encoding (the node's default base58 encoding rejects account data+-- over 128 bytes). Returns 'Nothing' if the account does not exist.+getAccountInfo :: (JsonRpc m) => SolanaPublicKey -> m (Maybe AccountInfo)+getAccountInfo pubKey = value <$> getAccountInfo' pubKey cfgJustEncodingBase64+{-# INLINE getAccountInfo #-}++------------------------------------------------------------------------------------------------++-- ** getBalance++------------------------------------------------------------------------------------------------++-- | Returns the balance, in lamports, of the specified account.+-- Returns 'RPCResponse' 'Lamport'.+getBalance' :: (JsonRpc m) => SolanaPublicKey -> m (RPCResponse Lamport)+getBalance' = do+ remote "getBalance"+{-# INLINE getBalance' #-}++-- | Returns the balance, in lamports, of the specified account.+getBalance :: (JsonRpc m) => SolanaPublicKey -> m Lamport+getBalance pubKey = value <$> getBalance' pubKey+{-# INLINE getBalance #-}++------------------------------------------------------------------------------------------------++-- * getMultipleAccounts++------------------------------------------------------------------------------------------------++-- | Returns account information for a list of addresses, using the given configuration.+-- For any missing account, the result contains 'Nothing' in its place.+getMultipleAccounts' :: (JsonRpc m) => [SolanaPublicKey] -> ConfigurationObject -> m (RPCResponse [Maybe AccountInfo])+getMultipleAccounts' = do+ remote "getMultipleAccounts"+{-# INLINE getMultipleAccounts' #-}++-- | Returns account information for a list of addresses, requesting base64+-- encoding (the node's default base58 encoding rejects account data over+-- 128 bytes). For any missing account, the result contains 'Nothing' in its place.+getMultipleAccounts :: (JsonRpc m) => [SolanaPublicKey] -> m [Maybe AccountInfo]+getMultipleAccounts pubKeys = value <$> getMultipleAccounts' pubKeys cfgJustEncodingBase64+{-# INLINE getMultipleAccounts #-}++------------------------------------------------------------------------------------------------++-- * getProgramAccounts++------------------------------------------------------------------------------------------------++-- | Returns all accounts owned by the specified program address, using the given configuration.+getProgramAccounts' :: (JsonRpc m) => SolanaPublicKey -> ConfigurationObject -> m [Account]+getProgramAccounts' = do+ remote "getProgramAccounts"+{-# INLINE getProgramAccounts' #-}++-- | Returns all accounts owned by the specified program address, requesting+-- base64 encoding (the node's default base58 encoding rejects account data+-- over 128 bytes).+getProgramAccounts :: (JsonRpc m) => SolanaPublicKey -> m [Account]+getProgramAccounts pk = getProgramAccounts' pk cfgJustEncodingBase64+{-# INLINE getProgramAccounts #-}++------------------------------------------------------------------------------------------------++-- * getLargestAccounts++------------------------------------------------------------------------------------------------++-- | Contains the address and value of an account.+data AddressAndLamports+ = AddressAndLamports+ { -- | Account address+ address :: SolanaPublicKey,+ -- | Number of lamports in the account+ lamports :: Lamport+ }+ deriving (Generic, Show, FromJSON)++-- | Returns up to the 20 accounts with the highest balances in lamports.+-- Results may be cached for up to two hours.+getLargestAccounts' :: (JsonRpc m) => m (RPCResponse [AddressAndLamports])+getLargestAccounts' = do+ remote "getLargestAccounts"+{-# INLINE getLargestAccounts' #-}++-- | Returns up to the 20 accounts with the highest balances in lamports.+-- Results may be cached for up to two hours.+getLargestAccounts :: (JsonRpc m) => m [(SolanaPublicKey, Lamport)]+getLargestAccounts = fmap (liftA2 (,) address lamports) . value <$> getLargestAccounts'+{-# INLINE getLargestAccounts #-}++------------------------------------------------------------------------------------------------++-- * getSignaturesForAddress++------------------------------------------------------------------------------------------------++-- | Returns confirmed transaction signatures involving the given address, in reverse chronological order.+getSignaturesForAddress :: (JsonRpc m) => SolanaPublicKey -> m [TransactionSignatureInformation]+getSignaturesForAddress = do+ remote "getSignaturesForAddress"+{-# INLINE getSignaturesForAddress #-}++-- | Metadata for a confirmed transaction signature involving a given address.+data TransactionSignatureInformation = TransactionSignatureInformation+ { -- | Transaction signature+ signature :: SolanaSignature,+ -- | The slot that contains the block with the transaction+ slotTxSig :: Slot,+ -- | Error details if the transaction failed ('Data.Aeson.Value' as+ -- returned by the RPC), 'Nothing' if it succeeded.+ err :: Maybe Value,+ -- | Memo associated with the transaction, 'Nothing' if no memo is present+ memo :: Maybe String,+ -- | Estimated production time, as Unix timestamp (seconds since the Unix epoch) of when transaction was processed. 'Nothing' if not available.+ blockTime :: Maybe Int64,+ -- | The transaction's cluster confirmation status;+ confirmationStatus :: Maybe String+ }+ deriving (Show)++instance FromJSON TransactionSignatureInformation where+ parseJSON :: Value -> Parser TransactionSignatureInformation+ parseJSON = withObject "TransactionSignatureInformation" $ \v ->+ TransactionSignatureInformation+ <$> v .: "signature"+ <*> v .: "slot"+ <*> v .: "err"+ <*> v .: "memo"+ <*> v .: "blockTime"+ <*> v .: "confirmationStatus"++------------------------------------------------------------------------------------------------++-- * getSignatureStatuses++------------------------------------------------------------------------------------------------++-- | Returns the confirmation status and slot info for the specified transaction signatures.+-- Each signature should be the transaction’s first signature (used as a unique identifier).+getSignatureStatuses' :: (JsonRpc m) => [SolanaSignature] -> ConfigurationObject -> m (RPCResponse [Maybe TransactionSignatureStatus])+getSignatureStatuses' = do+ remote "getSignatureStatuses"+{-# INLINE getSignatureStatuses' #-}++-- | Returns the confirmation status and slot info for the specified transaction signatures.+-- Each signature should be the transaction’s first signature (used as a unique identifier).+getSignatureStatuses :: (JsonRpc m) => [SolanaSignature] -> m [Maybe TransactionSignatureStatus]+getSignatureStatuses sigs = value <$> getSignatureStatuses' sigs (defaultConfigObject {searchTransactionHistory = Just True})+{-# INLINE getSignatureStatuses #-}++-- | Status metadata for a given transaction signature.+data TransactionSignatureStatus = TransactionSignatureStatus+ { -- | The slot the transaction was processed+ slotTxStatus :: Slot,+ -- | Number of blocks since signature confirmation, 'Nothing' if rooted, as well as finalized by a supermajority of the cluster.+ confirmationsTxStatus :: Maybe Int,+ -- | Error details if the transaction failed ('Data.Aeson.Value' as+ -- returned by the RPC), 'Nothing' if it succeeded.+ errTxStatus :: Maybe Value,+ -- | The transaction's cluster confirmation status.+ confirmationStatusTxStatus :: Maybe String+ }+ deriving (Generic, Show)++instance FromJSON TransactionSignatureStatus where+ parseJSON :: Value -> Parser TransactionSignatureStatus+ parseJSON = withObject "TransactionSignatureStatus" $ \v ->+ TransactionSignatureStatus+ <$> v .: "slot"+ <*> v .: "confirmations"+ <*> v .: "err"+ <*> v .: "confirmationStatus"
+ src/Network/Solana/RPC/HTTP/Block.hs view
@@ -0,0 +1,265 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.RPC.HTTP.Block+-- Description : Solana RPC methods for accessing block-related information.+--+-- This module provides access to block-related JSON-RPC methods in the Solana network.+-- These include fetching full block data, commitment levels, recent block production statistics,+-- block ranges, timestamps, and validity of blockhashes. Useful for exploring historical blocks,+-- validator performance, and transaction confirmation metadata.+module Network.Solana.RPC.HTTP.Block where++import Data.Aeson+import Data.Aeson.Types+import Data.Int+import Data.Map+import Data.Word (Word64)+import GHC.Generics (Generic)+import Network.JsonRpc.TinyClient (JsonRpc (..))+import Network.Solana.Core.Block+import Network.Solana.Core.Crypto (SolanaPublicKey)+import Network.Solana.Core.Transaction (Transaction)+import Network.Solana.RPC.HTTP.Types++------------------------------------------------------------------------------------------------++-- ** getBlock++------------------------------------------------------------------------------------------------++-- | Returns identity and transaction information about a confirmed block in+-- the ledger, using the given configuration.+-- Returns 'Nothing' if the slot has been skipped or pruned from the ledger.+getBlock' :: (JsonRpc m) => Slot -> ConfigurationObject -> m (Maybe BlockInfo)+getBlock' = do+ remote "getBlock"+{-# INLINE getBlock' #-}++-- | Returns identity and transaction information about a confirmed block in+-- the ledger. Sets @maxSupportedTransactionVersion@ so that blocks+-- containing versioned (v0) transactions can be decoded (without it, such+-- blocks make the node respond with error -32015); as a result, v0+-- transactions are returned without their address-lookup-table data, so+-- instruction account indices may reference addresses not present in the+-- parsed account keys.+-- Returns 'Nothing' if the slot has been skipped or pruned from the ledger.+getBlock :: (JsonRpc m) => Slot -> m (Maybe BlockInfo)+getBlock slot = getBlock' slot (defaultConfigObject {encoding = Just "json", maxSupportedTransactionVersion = Just 0})+{-# INLINE getBlock #-}++-- | Contains identity and transaction information for a block.+data BlockInfo = BlockInfo+ { -- | The blockhash of this block.+ blockhashBI :: BlockHash,+ -- | The blockhash of this block's parent. If the parent is not available due to ledger cleanup, this will return "11111111111111111111111111111111".+ previousBlockhashBI :: BlockHash,+ -- | The slot index of this block's parent.+ parentSlotBI :: Slot,+ -- | List of transactions included in the block, each with optional metadata.+ transactionsBI :: [TransactionWithMeta],+ -- | Estimated production time, as a Unix timestamp (in seconds). 'Nothing' if not available.+ blockTimeBI :: Maybe Int64,+ -- | The number of blocks beneath this block.+ blockHeightBI :: Maybe BlockHeight+ }+ deriving (Show)++instance FromJSON BlockInfo where+ parseJSON :: Value -> Parser BlockInfo+ parseJSON = withObject "BlockInfo" $ \v ->+ BlockInfo+ <$> v .: "blockhash"+ <*> v .: "previousBlockhash"+ <*> v .: "parentSlot"+ <*> v .: "transactions"+ <*> v .: "blockTime"+ <*> v .: "blockHeight"++-- | A transaction and its optional metadata as included in a block.+data TransactionWithMeta = TransactionWithMeta+ { -- | Optional metadata for the transaction.+ meta :: Maybe Object,+ -- | The transaction details.+ transaction :: Transaction+ }+ deriving (Generic, Show, FromJSON)++------------------------------------------------------------------------------------------------++-- ** getBlockCommitment++------------------------------------------------------------------------------------------------++-- | Get the block commitment based on the given block number 'Slot'.+-- Returns a 'BlockCommitment' for the specified block.+getBlockCommitment :: (JsonRpc m) => Slot -> m BlockCommitment+getBlockCommitment = do+ remote "getBlockCommitment"+{-# INLINE getBlockCommitment #-}++-- | Commitment information for a block.+data BlockCommitment = BlockCommitment+ { -- | Array logging the amount of cluster stake in lamports that has voted on the block at each depth from 0 to MAX_LOCKOUT_HISTORY+ commitmentList :: Maybe [Word64],+ -- | Total active stake, in lamports, for the current epoch.+ totalStake :: Integer+ }+ deriving (Show)++instance FromJSON BlockCommitment where+ parseJSON = withObject "BlockCommitment" $ \v ->+ BlockCommitment+ <$> v .: "commitment"+ <*> v .: "totalStake"++------------------------------------------------------------------------------------------------++-- ** getBlockHeight++------------------------------------------------------------------------------------------------++-- | Returns the current block height of the node.+getBlockHeight :: (JsonRpc m) => m BlockHeight+getBlockHeight = do+ remote "getBlockHeight"+{-# INLINE getBlockHeight #-}++------------------------------------------------------------------------------------------------++-- ** getBlockProduction++------------------------------------------------------------------------------------------------++-- | Returns recent block production information from the current or previous epoch.+-- Returns 'RPCResponse' 'BlockProduction' with the production statistics.+getBlockProduction' :: (JsonRpc m) => m (RPCResponse BlockProduction)+getBlockProduction' = do+ remote "getBlockProduction"+{-# INLINE getBlockProduction' #-}++-- | Returns recent block production information from the current or previous epoch.+getBlockProduction :: (JsonRpc m) => m BlockProduction+getBlockProduction = value <$> getBlockProduction'+{-# INLINE getBlockProduction #-}++-- | Per-validator production counts: a two-element array of the number of leader slots and the number of blocks produced.+type ValidatorData = [Word64]++-- | Mapping from validator identity to its production counts ('ValidatorData').+type ByIdentity = Map SolanaPublicKey ValidatorData++-- | Range of slots considered for block production.+data BlockProductionRange = BlockProductionRange+ { -- | First slot in the range.+ firstSlot :: Slot,+ -- | Last slot in the range.+ lastSlot :: Slot+ }+ deriving (Show, Generic, FromJSON)++-- | Block production statistics mapped by validator identity.+data BlockProduction+ = BlockProduction+ -- | Mapping from validator identity to number of blocks produced.+ ByIdentity+ -- | Range of slots considered.+ BlockProductionRange+ deriving (Generic, Show)++instance FromJSON BlockProduction where+ parseJSON :: Value -> Parser BlockProduction+ parseJSON = withObject "BlockProduction" $ \v ->+ BlockProduction+ <$> v .: "byIdentity"+ <*> v .: "range"++------------------------------------------------------------------------------------------------++-- * getBlocks++------------------------------------------------------------------------------------------------++-- | Returns a list of confirmed blocks between two slots (inclusive).+-- The maximum range allowed is 500,000 slots.+getBlocks :: (JsonRpc m) => Slot -> Maybe Slot -> m [Slot]+getBlocks = do+ remote "getBlocks"+{-# INLINE getBlocks #-}++------------------------------------------------------------------------------------------------++-- * getBlocksWithLimit++------------------------------------------------------------------------------------------------++-- | Returns a list of confirmed blocks starting from the given slot, up to the specified limit.+getBlocksWithLimit :: (JsonRpc m) => Slot -> Int -> m [Slot]+getBlocksWithLimit = do+ remote "getBlocksWithLimit"+{-# INLINE getBlocksWithLimit #-}++------------------------------------------------------------------------------------------------++-- * getBlockTime++------------------------------------------------------------------------------------------------++-- | Returns the estimated production time of a block (as Unix timestamp).+-- This is based on stake-weighted votes and validator-reported timestamps.+-- Returns 'Nothing' if the timestamp is not available for the given slot.+getBlockTime :: (JsonRpc m) => Slot -> m (Maybe Int)+getBlockTime = do+ remote "getBlockTime"+{-# INLINE getBlockTime #-}++------------------------------------------------------------------------------------------------++-- * getLatestBlockhash++------------------------------------------------------------------------------------------------++-- | Get the hash and height of the latest block.+-- Returns 'RPCResponse' 'LatestBlockHash' containing the block information.+getLatestBlockhash' :: (JsonRpc m) => m (RPCResponse LatestBlockHash)+getLatestBlockhash' = do+ remote "getLatestBlockhash"+{-# INLINE getLatestBlockhash' #-}++-- | Get the hash and height of the latest block.+getLatestBlockhash :: (JsonRpc m) => m LatestBlockHash+getLatestBlockhash = value <$> getLatestBlockhash'+{-# INLINE getLatestBlockhash #-}++-- | Get only the blockhash of the latest block.+getTheLatestBlockhash :: (JsonRpc m) => m BlockHash+getTheLatestBlockhash = blockhash <$> getLatestBlockhash+{-# INLINE getTheLatestBlockhash #-}++-- | Contains the hash and the height of the latest block.+data LatestBlockHash = LatestBlockHash+ { -- | Block hash as a base-58 encoded string.+ blockhash :: BlockHash,+ -- | Last block height at which the blockhash is still considered valid.+ lastValidBlockHeight :: BlockHeight+ }+ deriving (Generic, Show, FromJSON)++------------------------------------------------------------------------------------------------++-- * isBlockhashValid++------------------------------------------------------------------------------------------------++-- | Returns whether a blockhash is still valid.+isBlockhashValid' :: (JsonRpc m) => BlockHash -> m (RPCResponse Bool)+isBlockhashValid' = do+ remote "isBlockhashValid"+{-# INLINE isBlockhashValid' #-}++-- | Returns whether a blockhash is still valid.+isBlockhashValid :: (JsonRpc m) => BlockHash -> m Bool+isBlockhashValid = fmap value . isBlockhashValid'+{-# INLINE isBlockhashValid #-}
+ src/Network/Solana/RPC/HTTP/Chain.hs view
@@ -0,0 +1,221 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.RPC.HTTP.Chain+-- Description : Cluster and node-level RPC methods for Solana.+--+-- This module provides access to Solana JSON-RPC endpoints related to cluster-wide+-- and node-specific information.+--+-- These endpoints are especially useful for monitoring, diagnostics,+-- and understanding the state of the cluster from a validator or RPC node's perspective.+module Network.Solana.RPC.HTTP.Chain where++import Data.Aeson+import Data.Aeson.Types+import Data.List (sort)+import Data.Word+import GHC.Generics (Generic)+import Network.JsonRpc.TinyClient (JsonRpc (..))+import Network.Solana.Core.Crypto (SolanaPublicKey)+import Network.Solana.RPC.HTTP.Types++------------------------------------------------------------------------------------------------++-- * getClusterNodes++------------------------------------------------------------------------------------------------++-- | Returns information about all the nodes currently participating in the cluster.+getClusterNodes :: (JsonRpc m) => m [ClusterNodes]+getClusterNodes = do+ remote "getClusterNodes"+{-# INLINE getClusterNodes #-}++-- | Contains information about all the nodes participating in the cluster.+data ClusterNodes = ClusterNodes+ { -- | The node's public key.+ pubkey :: SolanaPublicKey,+ -- | Gossip network address for the node.+ gossip :: Maybe String,+ -- | TPU (Transaction Processing Unit) network address.+ tpu :: Maybe String,+ -- | JSON-RPC address, if the RPC service is enabled.+ rpc :: Maybe String,+ -- | Software version of the node, if available.+ version :: Maybe String,+ -- | Unique identifier of the node's feature set.+ featureSet :: Maybe Word32,+ -- | Shred version used by the node.+ shredVersion :: Maybe Word16+ }+ deriving (Show, Generic, FromJSON)++------------------------------------------------------------------------------------------------++-- * getHealth++------------------------------------------------------------------------------------------------++-- | Checks if the node is healthy.+--+-- A healthy node is within a certain number of slots (defined by @HEALTH_CHECK_SLOT_DISTANCE@, a validator-side constant)+-- of the latest confirmed cluster slot. Returns @"ok"@ if healthy; otherwise, an error is returned.+getHealth :: (JsonRpc m) => m String+getHealth = do+ remote "getHealth"+{-# INLINE getHealth #-}++------------------------------------------------------------------------------------------------++-- * getHighestSnapshotSlot++------------------------------------------------------------------------------------------------++-- | Returns the highest full and incremental snapshot slots that the node has generated.+--+-- This includes the highest full snapshot slot and, if available, the corresponding highest incremental snapshot slot.+getHighestSnapshotSlot :: (JsonRpc m) => m HighestSnapshotSlot+getHighestSnapshotSlot = do+ remote "getHighestSnapshotSlot"+{-# INLINE getHighestSnapshotSlot #-}++-- | Contains the highest slot information that the node has snapshots for.+data HighestSnapshotSlot = HighestSnapshotSlot+ { -- | The highest full snapshot slot.+ full :: Word64,+ -- | The highest incremental snapshot slot, if available.+ incremental :: Maybe Word64+ }+ deriving (Show, Generic, FromJSON)++------------------------------------------------------------------------------------------------++-- * getIdentity++------------------------------------------------------------------------------------------------++-- | Returns the full 'NodeIdentity' object for the current node.+getIdentity' :: (JsonRpc m) => m NodeIdentity+getIdentity' = do+ remote "getIdentity"+{-# INLINE getIdentity' #-}++-- | Returns the identity public key of the current node.+getIdentity :: (JsonRpc m) => m SolanaPublicKey+getIdentity = identity <$> getIdentity'+{-# INLINE getIdentity #-}++-- | Identity information for the current node.+newtype NodeIdentity = NodeIdentity+ { -- | The node's identity public key.+ identity :: SolanaPublicKey+ }+ deriving (Show, Generic)+ deriving anyclass (FromJSON)++------------------------------------------------------------------------------------------------++-- * getRecentPerformanceSamples++------------------------------------------------------------------------------------------------++-- | Returns a list of recent 'PerformanceSample' entries, in reverse slot order.+--+-- Performance samples are collected every 60 seconds and include metrics such as the number+-- of transactions, slots, and non-vote transactions within each sample window.+-- Optionally takes the number of samples to return (must be ≤ 720).+getRecentPerformanceSamples :: (JsonRpc m) => Maybe Int -> m [PerformanceSample]+getRecentPerformanceSamples = do+ remote "getRecentPerformanceSamples"+{-# INLINE getRecentPerformanceSamples #-}++-- | Performance metrics sampled periodically from the node.+data PerformanceSample = PerformanceSample+ { -- | Slot in which the sample was taken.+ slot :: Slot,+ -- | Number of transactions during the sample period.+ numTransactions :: Word64,+ -- | Number of slots completed during the sample.+ numSlots :: Word64,+ -- | Duration of the sampling window, in seconds.+ samplePeriodSecs :: Word16,+ -- | Number of non-vote transactions during the sample.+ numNonVoteTransactions :: Word64+ }+ deriving (Generic, Show, FromJSON)++------------------------------------------------------------------------------------------------++-- * getRecentPrioritizationFees++------------------------------------------------------------------------------------------------++-- | Returns recent prioritization fees observed in recent blocks.+--+-- Optionally takes a list of up to 128 account addresses. If provided, the response estimates+-- the prioritization fee for landing a transaction that locks all listed accounts as writable.+getRecentPrioritizationFees :: (JsonRpc m) => Maybe [SolanaPublicKey] -> m [PrioritizationFee]+getRecentPrioritizationFees = do+ remote "getRecentPrioritizationFees"+{-# INLINE getRecentPrioritizationFees #-}++-- | A prioritization fee sample from a recent block.+data PrioritizationFee = PrioritizationFee+ { -- | Slot in which the fee was observed.+ pfSlot :: Slot,+ -- | Per-compute-unit fee (in micro-lamports).+ prioritizationFee :: Word64+ }+ deriving (Generic, Show)++instance FromJSON PrioritizationFee where+ parseJSON :: Value -> Parser PrioritizationFee+ parseJSON = withObject "PrioritizationFee" $ \v ->+ PrioritizationFee+ <$> v .: "slot"+ <*> v .: "prioritizationFee"++-- | Nearest-rank percentile over the sorted, nonzero fee samples (e.g. from+-- 'getRecentPrioritizationFees'). Zero samples (slots with no priority fee)+-- are dropped before ranking, so the result reflects only slots that+-- actually paid a priority fee. @p@ is clamped into @[0, 1]@. An empty+-- sample list, or one containing only zeros, returns @0@.+percentilePriorityFee :: Double -> [Word64] -> Word64+percentilePriorityFee p samples =+ case sort (filter (/= 0) samples) of+ [] -> 0+ nonzero ->+ let n = length nonzero+ clampedP = max 0 (min 1 p)+ idx = max 0 (ceiling (clampedP * fromIntegral n) - 1)+ in nonzero !! idx++------------------------------------------------------------------------------------------------++-- * getVersion++------------------------------------------------------------------------------------------------++-- | Returns the Solana software version and feature set currently running on the node.+getVersion :: (JsonRpc m) => m SolanaVersion+getVersion = do+ remote "getVersion"++-- | Contains information about the software version and feature set identifier of the node.+data SolanaVersion = SolanaVersion+ { -- | Software version of 'solana-core'.+ solana_core :: String,+ -- | Unique identifier of the software's feature set.+ feature_set :: Word32+ }+ deriving (Generic, Show, Eq)++instance FromJSON SolanaVersion where+ parseJSON :: Value -> Parser SolanaVersion+ parseJSON = withObject "SolanaVersion" $ \v ->+ SolanaVersion+ <$> v .: "solana-core"+ <*> v .: "feature-set"
+ src/Network/Solana/RPC/HTTP/Ledger.hs view
@@ -0,0 +1,208 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.RPC.HTTP.Ledger+-- Description : Ledger-level Solana RPC methods for querying epoch and slot data.+--+-- This module provides bindings to Solana JSON-RPC methods related to the ledger,+-- including epoch and slot information, block leader schedules, genesis data,+-- and transaction counts. It is useful for building explorers, monitoring tools,+-- or protocols that depend on precise ledger state and validator schedule tracking.+module Network.Solana.RPC.HTTP.Ledger where++import Data.Aeson+import Data.Map+import Data.Word+import GHC.Generics+import Network.JsonRpc.TinyClient (JsonRpc (..))+import Network.Solana.Core.Block+import Network.Solana.Core.Crypto (SolanaPublicKey)+import Network.Solana.RPC.HTTP.Types++------------------------------------------------------------------------------------------------++-- * getEpochInfo++------------------------------------------------------------------------------------------------++-- | Returns information about the current epoch.+--+-- This includes the current slot, block height, epoch index, and transaction count since genesis.+getEpochInfo :: (JsonRpc m) => m EpochInfo+getEpochInfo = do+ remote "getEpochInfo"+{-# INLINE getEpochInfo #-}++-- | Solana epoch index.+type Epoch = Word64++-- | Contains information about the current epoch.+data EpochInfo = EpochInfo+ { -- | The current absolute slot.+ absoluteSlot :: Slot,+ -- | The current block height.+ blockHeight :: Word64,+ -- | The current epoch index.+ epoch :: Epoch,+ -- | Slot index relative to the start of the epoch.+ slotIndex :: Word64,+ -- | Total number of slots in the epoch.+ slotsInEpoch :: Word64,+ -- | Total number of successful transactions since genesis.+ transactionCount :: Maybe Word64+ }+ deriving (Show, Generic, FromJSON)++------------------------------------------------------------------------------------------------++-- * getEpochSchedule++------------------------------------------------------------------------------------------------++-- | Returns the epoch scheduling parameters configured in the cluster's genesis configuration.+getEpochSchedule :: (JsonRpc m) => m EpochSchedule+getEpochSchedule = do+ remote "getEpochSchedule"+{-# INLINE getEpochSchedule #-}++-- | Contains epoch schedule information as defined in the cluster's genesis config.+data EpochSchedule = EpochSchedule+ { -- | Maximum number of slots per epoch.+ slotsPerEpoch :: Word64,+ -- | Number of slots before epoch start to compute leader schedule.+ leaderScheduleSlotOffset :: Word64,+ -- | Whether epochs start small and grow (warmup).+ warmup :: Bool,+ -- | First normal-length epoch.(log2(slotsPerEpoch) - log2(MINIMUM_SLOTS_PER_EPOCH))+ firstNormalEpoch :: Word64,+ -- | First slot of the first normal-length epoch. ( MINIMUM_SLOTS_PER_EPOCH * (2.pow(firstNormalEpoch) - 1))+ firstNormalSlot :: Word64+ }+ deriving (Show, Generic, FromJSON)++------------------------------------------------------------------------------------------------++-- * getFirstAvailableBlock++------------------------------------------------------------------------------------------------++-- | Returns the slot of the lowest confirmed block that has not been purged from the ledger.+getFirstAvailableBlock :: (JsonRpc m) => m Slot+getFirstAvailableBlock = do+ remote "getFirstAvailableBlock"+{-# INLINE getFirstAvailableBlock #-}++------------------------------------------------------------------------------------------------++-- * getGenesisHash++------------------------------------------------------------------------------------------------++-- | Returns the block hash of the genesis block.+getGenesisHash :: (JsonRpc m) => m BlockHash+getGenesisHash = do+ remote "getGenesisHash"+{-# INLINE getGenesisHash #-}++------------------------------------------------------------------------------------------------++-- * getLeaderSchedule++------------------------------------------------------------------------------------------------++-- | Returns the leader schedule mapping validator identities to their leader slots.+--+-- Fetches the leader schedule for the epoch that contains the specified slot.+-- If no slot is specified, the schedule for the current epoch is returned.+getLeaderSchedule :: (JsonRpc m) => Maybe Slot -> m (Maybe LeaderSchedule)+getLeaderSchedule = do+ remote "getLeaderSchedule"+{-# INLINE getLeaderSchedule #-}++-- | Map from validator identity pubkeys to arrays of slot indices+-- indicating when each validator is expected to produce a block.+type LeaderSchedule = Map SolanaPublicKey [Word64]++------------------------------------------------------------------------------------------------++-- * getMaxRetransmitSlot++------------------------------------------------------------------------------------------------++-- | Returns the highest slot observed by the node from the retransmit stage.+getMaxRetransmitSlot :: (JsonRpc m) => m Slot+getMaxRetransmitSlot = do+ remote "getMaxRetransmitSlot"+{-# INLINE getMaxRetransmitSlot #-}++------------------------------------------------------------------------------------------------++-- * getMaxShredInsertSlot++------------------------------------------------------------------------------------------------++-- | Returns the highest slot observed by the node after shred insertion.+getMaxShredInsertSlot :: (JsonRpc m) => m Slot+getMaxShredInsertSlot = do+ remote "getMaxShredInsertSlot"+{-# INLINE getMaxShredInsertSlot #-}++------------------------------------------------------------------------------------------------++-- * getSlot++------------------------------------------------------------------------------------------------++-- | Returns the current slot, based on the default or specified commitment level.+getSlot :: (JsonRpc m) => m Slot+getSlot = do+ remote "getSlot"++------------------------------------------------------------------------------------------------++-- * getSlotLeader++------------------------------------------------------------------------------------------------++-- | Returns the identity public key of the current slot leader.+getSlotLeader :: (JsonRpc m) => m SolanaPublicKey+getSlotLeader = do+ remote "getSlotLeader"++------------------------------------------------------------------------------------------------++-- * getSlotLeaders++------------------------------------------------------------------------------------------------++-- | Returns the list of slot leaders for a given slot range.+--+-- Takes a starting 'Slot' and a limit (between 1 and 5,000), and returns the validator identities+-- that will produce blocks for the given slots.+getSlotLeaders :: (JsonRpc m) => Slot -> Int -> m [SolanaPublicKey]+getSlotLeaders = do+ remote "getSlotLeaders"++------------------------------------------------------------------------------------------------++-- * getTransactionCount++------------------------------------------------------------------------------------------------++-- | Returns the total number of transactions recorded in the ledger.+getTransactionCount :: (JsonRpc m) => m Word64+getTransactionCount = do+ remote "getTransactionCount"++------------------------------------------------------------------------------------------------++-- * minimumLedgerSlot++------------------------------------------------------------------------------------------------++-- | Returns the lowest slot that the node has information about in its ledger.+minimumLedgerSlot :: (JsonRpc m) => m Slot+minimumLedgerSlot = do+ remote "minimumLedgerSlot"
+ src/Network/Solana/RPC/HTTP/Token.hs view
@@ -0,0 +1,162 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.RPC.HTTP.Token+-- Description : Solana RPC methods for interacting with SPL Token accounts.+--+-- This module provides access to Solana JSON-RPC methods related to SPL Token accounts.+-- It includes queries for fetching token balances, owned accounts, delegated accounts,+-- largest token holders, and token supply information.+--+-- It is useful for building wallets, explorers, or token dashboards that interact+-- with SPL-compliant tokens deployed on the Solana blockchain.+module Network.Solana.RPC.HTTP.Token where++import Data.Aeson+import Data.Word+import GHC.Generics (Generic)+import Network.JsonRpc.TinyClient (JsonRpc (..))+import Network.Solana.Core.Account (Account)+import Network.Solana.Core.Crypto (SolanaPublicKey)+import Network.Solana.RPC.HTTP.Types++------------------------------------------------------------------------------------------------++-- * getTokenAccountBalance++------------------------------------------------------------------------------------------------++-- | Returns the token balance of an SPL Token account.+-- Returns 'RPCResponse' 'AmountObject' with detailed balance information.+getTokenAccountBalance' :: (JsonRpc m) => SolanaPublicKey -> m (RPCResponse AmountObject)+getTokenAccountBalance' = do+ remote "getTokenAccountBalance"++-- | Returns the token balance of an SPL Token account.+getTokenAccountBalance :: (JsonRpc m) => SolanaPublicKey -> m AmountObject+getTokenAccountBalance = fmap value . getTokenAccountBalance'++-- | Contains SPL token balance details.+data AmountObject = AmountObject+ { -- | The raw balance without decimals, a string representation of 'Word64'.+ amount :: String,+ -- | Number of base 10 digits to the right of the decimal place.+ decimals :: Word8,+ -- | The balance using mint-prescribed decimals (deprecated).+ uiAmount :: Maybe Double,+ -- | The balance as a string, using mint-prescribed decimals.+ uiAmountString :: String+ }+ deriving (Generic, Show, Eq)+ deriving anyclass (FromJSON)++------------------------------------------------------------------------------------------------++-- * getTokenAccountsByDelegate++------------------------------------------------------------------------------------------------++-- | Returns all SPL Token accounts delegated to the provided delegate address, using the given configuration.+getTokenAccountsByDelegate' :: (JsonRpc m) => SolanaPublicKey -> SolanaPubKeyWithPurpose -> ConfigurationObject -> m (RPCResponse [Account])+getTokenAccountsByDelegate' = do+ remote "getTokenAccountsByDelegate"+{-# INLINE getTokenAccountsByDelegate' #-}++-- | Returns all SPL Token accounts delegated to the provided delegate+-- address, requesting base64 encoding.+getTokenAccountsByDelegate :: (JsonRpc m) => SolanaPublicKey -> SolanaPubKeyWithPurpose -> m [Account]+getTokenAccountsByDelegate pk pkwv = value <$> getTokenAccountsByDelegate' pk pkwv cfgJustEncodingBase64+{-# INLINE getTokenAccountsByDelegate #-}++------------------------------------------------------------------------------------------------++-- * getTokenAccountsByOwner++------------------------------------------------------------------------------------------------++-- | Specifies either a mint or a program to filter token accounts.+data SolanaPubKeyWithPurpose = Mint SolanaPublicKey | Program SolanaPublicKey+ deriving (Generic)++instance ToJSON SolanaPubKeyWithPurpose where+ toJSON (Mint key) = object ["mint" .= key]+ toJSON (Program key) = object ["programId" .= key]++-- | Returns all SPL Token accounts owned by the specified wallet.+getTokenAccountsByOwner' :: (JsonRpc m) => SolanaPublicKey -> SolanaPubKeyWithPurpose -> ConfigurationObject -> m (RPCResponse [Account])+getTokenAccountsByOwner' = do+ remote "getTokenAccountsByOwner"+{-# INLINE getTokenAccountsByOwner' #-}++-- | Returns all SPL Token accounts owned by the specified wallet.+getTokenAccountsByOwner :: (JsonRpc m) => SolanaPublicKey -> SolanaPubKeyWithPurpose -> m [Account]+getTokenAccountsByOwner pk pkwv = value <$> getTokenAccountsByOwner' pk pkwv cfgJustEncodingBase64+{-# INLINE getTokenAccountsByOwner #-}++-- | Returns all SPL Token accounts for the specified owner and mint address.+getTokenAccountsByOwnerAndMint :: (JsonRpc m) => SolanaPublicKey -> SolanaPublicKey -> m [Account]+getTokenAccountsByOwnerAndMint pk pkwv = value <$> getTokenAccountsByOwner' pk (Mint pkwv) cfgJustEncodingBase64+{-# INLINE getTokenAccountsByOwnerAndMint #-}++-- | Returns all SPL Token accounts for the specified owner and program ID.+getTokenAccountsByOwnerAndProgram :: (JsonRpc m) => SolanaPublicKey -> SolanaPublicKey -> m [Account]+getTokenAccountsByOwnerAndProgram pk pkwv = value <$> getTokenAccountsByOwner' pk (Program pkwv) cfgJustEncodingBase64+{-# INLINE getTokenAccountsByOwnerAndProgram #-}++------------------------------------------------------------------------------------------------++-- * getTokenLargestAccounts++------------------------------------------------------------------------------------------------++-- | Returns the largest accounts for a given SPL Token mint, sorted by balance.+-- Returns 'RPCResponse' @['AmountObjectWithAddr']@.+getTokenLargestAccounts' :: (JsonRpc m) => SolanaPublicKey -> m (RPCResponse [AmountObjectWithAddr])+getTokenLargestAccounts' = do+ remote "getTokenLargestAccounts"++-- | Returns the largest accounts for a given SPL Token mint, sorted by balance.+getTokenLargestAccounts :: (JsonRpc m) => SolanaPublicKey -> m [AmountObjectWithAddr]+getTokenLargestAccounts = fmap value . getTokenLargestAccounts'++-- | Contains address and balance information for an SPL Token account.+data AmountObjectWithAddr = AmountObjectWithAddr+ { -- | The account address.+ address' :: SolanaPublicKey,+ -- | The raw balance without decimals, a string representation of 'Word64'.+ amount' :: String,+ -- | Number of base 10 digits to the right of the decimal place.+ decimals' :: Word8,+ -- | The balance using mint-prescribed decimals (deprecated).+ uiAmount' :: Maybe Double,+ -- | The balance as a string, using mint-prescribed decimals.+ uiAmountString' :: String+ }+ deriving (Generic, Show)++instance FromJSON AmountObjectWithAddr where+ parseJSON = withObject "AmountObjectWithAddr" $ \v ->+ AmountObjectWithAddr+ <$> v .: "address"+ <*> v .: "amount"+ <*> v .: "decimals"+ <*> v .: "uiAmount"+ <*> v .: "uiAmountString"++------------------------------------------------------------------------------------------------++-- * getTokenSupply++------------------------------------------------------------------------------------------------++-- | Returns the total supply of an SPL Token.+-- Returns 'RPCResponse' 'AmountObject' with the supply balance.+getTokenSupply' :: (JsonRpc m) => SolanaPublicKey -> m (RPCResponse AmountObject)+getTokenSupply' = do+ remote "getTokenSupply"++-- | Returns the total supply of an SPL Token.+getTokenSupply :: (JsonRpc m) => SolanaPublicKey -> m AmountObject+getTokenSupply = fmap value . getTokenSupply'
+ src/Network/Solana/RPC/HTTP/Tokenomics.hs view
@@ -0,0 +1,232 @@+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.RPC.HTTP.Tokenomics+-- Description : Solana RPC methods for querying inflation, staking, supply, and vote account data.+--+-- This module exposes Solana JSON-RPC methods for interacting with protocol-level+-- tokenomics: inflation schedules, rewards, token supply, staking parameters, and+-- validator vote accounts.+--+-- Useful for dashboards, analytics tools, staking services, or indexers.+module Network.Solana.RPC.HTTP.Tokenomics where++import Data.Aeson+import Data.Aeson.Types+import Data.Int (Int64)+import Data.Word+import GHC.Generics+import Network.JsonRpc.TinyClient (JsonRpc (..))+import Network.Solana.Core.Account (Lamport)+import Network.Solana.Core.Crypto (SolanaPublicKey)+import Network.Solana.RPC.HTTP.Types++------------------------------------------------------------------------------------------------++-- * getInflationGovernor++------------------------------------------------------------------------------------------------++-- | Returns the current inflation governor parameters.+--+-- These parameters define how inflation is distributed and how it changes over time.+getInflationGovernor :: (JsonRpc m) => m InflationGovernor+getInflationGovernor = do+ remote "getInflationGovernor"+{-# INLINE getInflationGovernor #-}++-- | Parameters defining the inflation configuration.+data InflationGovernor = InflationGovernor+ { -- | Percentage of inflation allocated to the foundation.+ foundation :: Double,+ -- | Duration of the foundation pool inflation (in years).+ foundationTerm :: Double,+ -- | Initial inflation rate at genesis (percentage).+ initial :: Double,+ -- | Rate per year at which inflation is lowered. (Rate reduction is derived using the target slot time in genesis config)+ taper :: Double,+ -- | Terminal inflation rate (percentage).+ terminal :: Double+ }+ deriving (Show, Generic, FromJSON)++------------------------------------------------------------------------------------------------++-- * getInflationRate++------------------------------------------------------------------------------------------------++-- | Returns the inflation rate values for the current epoch.+getInflationRate :: (JsonRpc m) => m InflationRate+getInflationRate = do+ remote "getInflationRate"+{-# INLINE getInflationRate #-}++-- | Inflation breakdown for the current epoch.+data InflationRate = InflationRate+ { -- | Total inflation rate (percentage).+ totalInflation :: Double,+ -- | Portion allocated to validators.+ validatorInflation :: Double,+ -- | Portion allocated to the foundation.+ foundationInflation :: Double,+ -- | Epoch index for which these values apply.+ epochInflation :: Int64+ }+ deriving (Show)++instance FromJSON InflationRate where+ parseJSON :: Value -> Parser InflationRate+ parseJSON = withObject "InflationRate" $ \v ->+ InflationRate+ <$> v .: "total"+ <*> v .: "validator"+ <*> v .: "foundation"+ <*> v .: "epoch"++------------------------------------------------------------------------------------------------++-- * getInflationReward++------------------------------------------------------------------------------------------------++-- | Returns the inflation reward for the specified accounts during an epoch.+--+-- Takes a list of public keys and returns a list of optional rewards.+-- Entries may be 'Nothing' if the reward could not be determined for the given account.+getInflationReward :: (JsonRpc m) => [SolanaPublicKey] -> m [Maybe InflationReward]+getInflationReward = do+ remote "getInflationReward"+{-# INLINE getInflationReward #-}++-- | Contains the inflation reward information for a given account.+data InflationReward = InflationReward+ { -- | Epoch in which the reward was issued.+ epochReward :: Word64,+ -- | Slot in which the reward became effective.+ effectiveSlot :: Slot,+ -- | Amount of reward, in lamports.+ amountReward :: Lamport,+ -- | Account balance after the reward was applied.+ postBalance :: Lamport,+ -- | Vote account commission when the reward was credited.+ commissionIR :: Maybe Word8+ }+ deriving (Show, Generic)++instance FromJSON InflationReward where+ parseJSON :: Value -> Parser InflationReward+ parseJSON = withObject "InflationReward" $ \v ->+ InflationReward+ <$> v .: "epoch"+ <*> v .: "effectiveSlot"+ <*> v .: "amount"+ <*> v .: "postBalance"+ <*> v .: "commission"++------------------------------------------------------------------------------------------------++-- * getMinimumBalanceForRentExemption++------------------------------------------------------------------------------------------------++-- | Returns the minimum lamport balance required for a rent-exempt account.+--+-- Takes the account's data size in bytes and returns the required balance.+getMinimumBalanceForRentExemption :: (JsonRpc m) => Int -> m Lamport+getMinimumBalanceForRentExemption = do+ remote "getMinimumBalanceForRentExemption"+{-# INLINE getMinimumBalanceForRentExemption #-}++------------------------------------------------------------------------------------------------++-- * getStakeMinimumDelegation++------------------------------------------------------------------------------------------------++-- | Returns the minimum delegation amount required to stake.+-- Returns @RPCResponse Lamport@ with value field set to @Lamport@.+getStakeMinimumDelegation' :: (JsonRpc m) => m (RPCResponse Lamport)+getStakeMinimumDelegation' = do+ remote "getStakeMinimumDelegation"+{-# INLINE getStakeMinimumDelegation' #-}++-- | Returns the minimum amount (in lamports) required for stake delegation.+getStakeMinimumDelegation :: (JsonRpc m) => m Lamport+getStakeMinimumDelegation = value <$> getStakeMinimumDelegation'+{-# INLINE getStakeMinimumDelegation #-}++------------------------------------------------------------------------------------------------++-- * getSupply++------------------------------------------------------------------------------------------------++-- | Returns the current token supply information.+-- Returns @RPCResponse SolanaSupply@ with value field set to @SolanaSupply@.+getSupply' :: (JsonRpc m) => m (RPCResponse SolanaSupply)+getSupply' = do+ remote "getSupply"++-- | Returns the current token supply information.+getSupply :: (JsonRpc m) => m SolanaSupply+getSupply = value <$> getSupply'++-- | Contains information about the total, circulating, and non-circulating token supply.+data SolanaSupply = SolanaSupply+ { -- | Total supply in lamports.+ total :: Lamport,+ -- | Circulating supply in lamports.+ circulating :: Lamport,+ -- | Non-circulating supply in lamports.+ nonCirculating :: Lamport,+ -- | Accounts holding non-circulating tokens.+ nonCirculatingAccounts :: [SolanaPublicKey]+ }+ deriving (Generic, Show, Eq)+ deriving anyclass (FromJSON)++------------------------------------------------------------------------------------------------++-- * getVoteAccounts++------------------------------------------------------------------------------------------------++-- | Returns vote account information for all validators in the current bank.+--+-- Includes both current and delinquent vote accounts.+getVoteAccounts :: (JsonRpc m) => m VoteAccounts+getVoteAccounts = do+ remote "getVoteAccounts"++-- | Lists current and delinquent vote accounts.+data VoteAccounts = VoteAccounts+ { -- | Currently active vote accounts.+ current :: [VoteAccountsResult],+ -- | Delinquent vote accounts.+ delinquent :: [VoteAccountsResult]+ }+ deriving (Generic, Show, FromJSON)++-- | Information about a vote account.+data VoteAccountsResult = VoteAccountsResult+ { -- | Address of the vote account.+ votePubkey :: SolanaPublicKey,+ -- | Identity of the validator node.+ nodePubkey :: SolanaPublicKey,+ -- | Stake delegated to this vote account (active in this epoch).+ activatedStake :: Word64,+ -- | Whether the vote account is active this epoch.+ epochVoteAccount :: Bool,+ -- | Commission percentage charged by the validator (0–100).+ commission :: Int,+ -- | Most recent slot voted on.+ lastVote :: Slot,+ -- | Historical epoch credits: [epoch, credits, previousCredits].+ epochCredits :: [[Word64]],+ -- | Current root slot for this vote account.+ rootSlot :: Slot+ }+ deriving (Generic, Show, FromJSON)
+ src/Network/Solana/RPC/HTTP/Transaction.hs view
@@ -0,0 +1,143 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.RPC.HTTP.Transaction+-- Description : Solana RPC methods for submitting, inspecting, and simulating transactions.+--+-- This module provides Solana JSON-RPC bindings related to transaction lifecycle operations:+-- fee estimation, transaction broadcasting, simulation, airdrops (on devnet), and retrieving+-- metadata for finalized transactions.+--+-- These endpoints are essential for any client application that signs and sends transactions.+module Network.Solana.RPC.HTTP.Transaction where++import Data.Aeson+import Data.Int (Int64)+import GHC.Generics (Generic)+import Network.JsonRpc.TinyClient (JsonRpc (..))+import Network.Solana.Core.Account (Lamport)+import Network.Solana.Core.Crypto (SolanaPublicKey, SolanaSignature)+import Network.Solana.Core.Transaction+import Network.Solana.RPC.HTTP.Types++------------------------------------------------------------------------------------------------++-- * getFeeForMessage++------------------------------------------------------------------------------------------------++-- | Returns the fee the network will charge for a particular message (base64-encoded).+-- Returns 'RPCResponse' ('Maybe' 'Int') where the value is the fee in lamports, or 'Nothing' if the fee couldn't be calculated.+getFeeForMessage' :: (JsonRpc m) => String -> m (RPCResponse (Maybe Int))+getFeeForMessage' = do+ remote "getFeeForMessage"+{-# INLINE getFeeForMessage' #-}++-- | Returns the fee the network will charge for a particular message (base64-encoded).+-- Returns 'Maybe Int' fee in lamports.+getFeeForMessage :: (JsonRpc m) => String -> m (Maybe Int)+getFeeForMessage = fmap value . getFeeForMessage'+{-# INLINE getFeeForMessage #-}++------------------------------------------------------------------------------------------------++-- * getTransaction++------------------------------------------------------------------------------------------------++-- | Returns metadata and content for a confirmed transaction identified by+-- its signature, using the given configuration.+-- Returns 'Nothing' if the signature is unknown or has expired.+getTransaction' :: (JsonRpc m) => SolanaSignature -> ConfigurationObject -> m (Maybe TransactionResult)+getTransaction' = do+ remote "getTransaction"+{-# INLINE getTransaction' #-}++-- | Returns metadata and content for a confirmed transaction identified by+-- its signature. Sets @maxSupportedTransactionVersion@ so that versioned+-- (v0) transactions can be decoded (without it, the node responds with+-- error -32015); as a result, v0 transactions are returned without their+-- address-lookup-table data, so instruction account indices may reference+-- addresses not present in the parsed account keys.+-- Returns 'Nothing' if the signature is unknown or has expired.+getTransaction :: (JsonRpc m) => SolanaSignature -> m (Maybe TransactionResult)+getTransaction sig = getTransaction' sig (defaultConfigObject {encoding = Just "json", maxSupportedTransactionVersion = Just 0})+{-# INLINE getTransaction #-}++-- | Contains metadata and transaction information returned by 'getTransaction'.+data TransactionResult = TransactionResult+ { -- | The slot this transaction was processed in.+ slotTx :: Slot,+ -- | Estimated production time, as Unix timestamp (seconds since the Unix epoch) when the transaction was processed.+ blockTimeTx :: Maybe Int64,+ -- | Optional transaction metadata.+ metaTx :: Maybe Object,+ -- | The transaction content.+ transactionTx :: Transaction+ }+ deriving (Generic, Show)++instance FromJSON TransactionResult where+ parseJSON = withObject "TransactionResult" $ \v ->+ TransactionResult+ <$> v .: "slot"+ <*> v .: "blockTime"+ <*> v .: "meta"+ <*> v .: "transaction"++------------------------------------------------------------------------------------------------++-- * requestAirdrop++------------------------------------------------------------------------------------------------++-- | Requests an airdrop of the specified number of lamports to the given address.+requestAirdrop :: (JsonRpc m) => SolanaPublicKey -> Lamport -> m SolanaSignature+requestAirdrop = do+ remote "requestAirdrop"+{-# INLINE requestAirdrop #-}++------------------------------------------------------------------------------------------------++-- * sendTransaction++------------------------------------------------------------------------------------------------++-- | Default configuration used for sending transactions. Leaves preflight+-- checks and retry behavior at the node's own defaults; callers who want+-- fire-and-forget behavior (no preflight simulation, no rebroadcast) can use+-- 'sendTransaction'' with an explicit configuration instead.+defaultRpcSendTransactionConfig :: ConfigurationObject+defaultRpcSendTransactionConfig =+ defaultConfigObject+ { encoding = Just "base64"+ }++-- | Sends a base64-encoded transaction to the cluster using the default configuration.+sendTransaction :: (JsonRpc m) => String -> m SolanaSignature+sendTransaction tx = sendTransaction' tx defaultRpcSendTransactionConfig+{-# INLINE sendTransaction #-}++-- | Sends a base64-encoded transaction to the cluster with the specified configuration.+sendTransaction' :: (JsonRpc m) => String -> ConfigurationObject -> m SolanaSignature+sendTransaction' = do+ remote "sendTransaction"+{-# INLINE sendTransaction' #-}++------------------------------------------------------------------------------------------------++-- * simulateTransaction++------------------------------------------------------------------------------------------------++-- | Simulates a base64-encoded transaction with the given configuration.+simulateTransaction' :: (JsonRpc m) => String -> ConfigurationObject -> m Object+simulateTransaction' = do+ remote "simulateTransaction"+{-# INLINE simulateTransaction' #-}++-- | Simulates a base64-encoded transaction using a basic configuration with base64 encoding.+simulateTransaction :: (JsonRpc m) => String -> m Object+simulateTransaction tx = simulateTransaction' tx cfgJustEncodingBase64+{-# INLINE simulateTransaction #-}
+ src/Network/Solana/RPC/HTTP/Types.hs view
@@ -0,0 +1,129 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.RPC.HTTP.Types+-- Description : Common RPC types used across Solana HTTP JSON-RPC endpoints.+--+-- This module defines shared types used in Solana RPC responses and configuration payloads.+-- It includes generic RPC response envelopes, context metadata, and configuration options+-- for request customization.+--+-- These types are reused across many Solana JSON-RPC methods and should be imported+-- wherever Solana RPC requests or responses are constructed or parsed.+module Network.Solana.RPC.HTTP.Types where++import Data.Aeson.Types+import Data.Text+import Data.Word+import GHC.Generics++------------------------------------------------------------------------------------------------++-- * RPCResponse++------------------------------------------------------------------------------------------------++-- | Alias for a Solana slot number.+type Slot = Word64++-- | Contains contextual information returned with most Solana RPC responses.+--+-- Includes API version and the slot at which the response is valid.+data Context = Context+ { -- | API version string returned by the cluster (e.g. @"1.17.0"@).+ apiVersion :: Text,+ -- | The slot at which the data in the response is valid.+ contextSlot :: Slot+ }+ deriving (Show, Generic)++instance FromJSON Context where+ parseJSON :: Value -> Parser Context+ parseJSON = withObject "Context" $ \v ->+ Context+ <$> v .: "apiVersion"+ <*> v .: "slot"++-- | Generic wrapper for Solana RPC responses that include a context and a value.+--+-- Many Solana RPC methods return a response shaped like:+--+-- > { "context": { ... }, "value": <data> }+data RPCResponse a = RPCResponse+ { -- | Metadata about the cluster state at the time of the response.+ context :: Context,+ -- | The actual value returned by the RPC method.+ value :: a+ }+ deriving (Show)++instance (FromJSON a) => FromJSON (RPCResponse a) where+ parseJSON :: (FromJSON a) => Value -> Parser (RPCResponse a)+ parseJSON = withObject "RPCResponse" $ \v ->+ RPCResponse+ <$> v .: "context"+ <*> v .: "value"++------------------------------------------------------------------------------------------------++-- * ConfigurationObject++------------------------------------------------------------------------------------------------++-- | Configuration options used to customize Solana RPC requests.+--+-- Many RPC methods accept a configuration object to control encoding,+-- commitment level, preflight behavior, and more.+data ConfigurationObject = ConfigurationObject+ { -- | Optional commitment level (e.g. @"finalized"@, @"confirmed"@).+ commitment :: Maybe String,+ -- | Desired encoding for returned data (e.g. @"base58"@, @"base64"@).+ encoding :: Maybe String,+ -- | Optional partial data slice configuration.+ dataSlice :: Maybe Object,+ -- | Whether to skip preflight checks (use with caution).+ skipPreflight :: Maybe Bool,+ -- | Commitment level used during preflight simulation.+ preflightCommitment :: Maybe String,+ -- | Maximum number of retry attempts for transaction submission.+ maxRetries :: Maybe Int,+ -- | Minimum slot that the RPC response must be based on.+ minContextSlot :: Maybe Int,+ -- | Whether to search older confirmed transaction history.+ searchTransactionHistory :: Maybe Bool,+ -- | The maximum transaction version to return in responses. Required to+ -- fetch blocks or transactions containing versioned (v0) transactions;+ -- omitting it causes the RPC to reject them with error -32015.+ maxSupportedTransactionVersion :: Maybe Int+ }+ deriving (Generic, Show)++instance ToJSON ConfigurationObject where+ toJSON :: ConfigurationObject -> Value+ toJSON = genericToJSON defaultOptions {omitNothingFields = True}++-- | A default configuration object with all fields set to 'Nothing'.+--+-- Use this as a base and override fields selectively.+defaultConfigObject :: ConfigurationObject+defaultConfigObject =+ ConfigurationObject+ { commitment = Nothing,+ encoding = Nothing,+ dataSlice = Nothing,+ skipPreflight = Nothing,+ preflightCommitment = Nothing,+ maxRetries = Nothing,+ minContextSlot = Nothing,+ searchTransactionHistory = Nothing,+ maxSupportedTransactionVersion = Nothing+ }++-- | A basic configuration object that only sets the encoding to @"base64"@.+--+-- Useful for methods that require base64-encoded input or output.+cfgJustEncodingBase64 :: ConfigurationObject+cfgJustEncodingBase64 =+ defaultConfigObject+ { encoding = Just "base64"+ }
+ src/Network/Solana/RPC/WebSocket.hs view
@@ -0,0 +1,332 @@+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.RPC.WebSocket+-- Description : Solana PubSub (WebSocket) subscriptions and push-based confirmation.+--+-- Solana nodes expose a PubSub endpoint alongside the JSON-RPC one (by+-- convention port @8900@ next to the RPC port @8899@; @wss://@ on hosted+-- clusters). Instead of polling for a transaction's status, a client+-- subscribes once and is pushed a notification the moment the signature+-- reaches the requested commitment.+--+-- This module is transport-agnostic on purpose: it builds the exact bytes to+-- send, parses the bytes received, and drives the confirmation handshake over+-- a 'WsTransport' that the caller supplies. The SDK therefore needs no+-- WebSocket dependency of its own, and the same code works against plain+-- @ws://@ and TLS @wss://@ endpoints.+--+-- Wiring it to the @websockets@ package takes a few lines:+--+-- > import Network.WebSockets qualified as WS+-- >+-- > WS.runClient "127.0.0.1" 8900 "/" $ \conn -> do+-- > let transport = WsTransport (WS.sendTextData conn) (WS.receiveData conn)+-- > result <- awaitSignature transport (RequestId 1) (Just "confirmed") 30 signature+-- > print result+--+-- For @wss://@ endpoints, use @wuss@'s @runSecureClient@ in place of+-- @runClient@; nothing else changes.+module Network.Solana.RPC.WebSocket+ ( -- * Identifiers+ RequestId (..),+ SubscriptionId (..),++ -- * Requests+ signatureSubscribeRequest,+ accountSubscribeRequest,+ signatureUnsubscribeRequest,+ accountUnsubscribeRequest,++ -- * Incoming messages+ WsMessage (..),+ SignatureNotification (..),+ AccountNotification (..),+ parseWsMessage,++ -- * Transport+ WsTransport (..),++ -- * Confirmation+ awaitSignature,+ )+where++import Data.Aeson+import Data.Aeson.Encoding qualified as E+import Data.Aeson.Types (Parser, parseEither)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.Text (Text)+import Data.Maybe (fromMaybe, isNothing)+import Data.Text qualified as Text+import Data.Word (Word64)+import Network.Solana.Core.Account (AccountInfo)+import Network.Solana.Core.Crypto (SolanaPublicKey, SolanaSignature)+import Network.Solana.RPC.HTTP.Types (Slot)+import System.Timeout (timeout)++------------------------------------------------------------------------------------------------++-- * Identifiers++------------------------------------------------------------------------------------------------++-- | A client-supplied JSON-RPC request id. The node echoes it in the+-- subscription acknowledgement, which is how a reply is matched to its+-- request.+newtype RequestId = RequestId Word64+ deriving stock (Eq, Ord, Show)+ deriving newtype (FromJSON, ToJSON)++-- | A server-assigned subscription id, returned by a @*Subscribe@ call and+-- carried by every notification belonging to that subscription. Pass it to+-- the matching @*Unsubscribe@ request to cancel early.+newtype SubscriptionId = SubscriptionId Word64+ deriving stock (Eq, Ord, Show)+ deriving newtype (FromJSON, ToJSON)++------------------------------------------------------------------------------------------------++-- * Requests++------------------------------------------------------------------------------------------------++-- | Encodes a JSON-RPC request with its fields in the documented order.+encodeRequest :: RequestId -> Text -> E.Encoding -> BS.ByteString+encodeRequest (RequestId i) method params =+ BL.toStrict . E.encodingToLazyByteString . E.pairs $+ E.pair "jsonrpc" (E.text "2.0")+ <> E.pair "id" (E.word64 i)+ <> E.pair "method" (E.text method)+ <> E.pair "params" params++-- | Optional @commitment@ field: omitted entirely when unset, in which case+-- the node applies its default (@finalized@).+commitmentField :: Maybe String -> E.Series+commitmentField = foldMap (E.pair "commitment" . E.string)++-- | A @signatureSubscribe@ request for the given signature.+--+-- The subscription ends by itself once the signature reaches the requested+-- commitment, so a successful wait needs no unsubscribe. When the last+-- argument is 'True', the node may additionally send an early+-- @receivedSignature@ notification (see 'snReceived').+signatureSubscribeRequest :: RequestId -> SolanaSignature -> Maybe String -> Bool -> BS.ByteString+signatureSubscribeRequest reqId sig mCommitment enableReceived =+ encodeRequest reqId "signatureSubscribe" $+ E.list+ id+ [ E.string (show sig),+ E.pairs (commitmentField mCommitment <> E.pair "enableReceivedNotification" (E.bool enableReceived))+ ]++-- | An @accountSubscribe@ request for the given account.+--+-- Account data is requested @base64@-encoded, matching+-- 'Network.Solana.RPC.HTTP.Account.getAccountInfo', so every state decoder in+-- this library applies unchanged to 'anAccount'.+accountSubscribeRequest :: RequestId -> SolanaPublicKey -> Maybe String -> BS.ByteString+accountSubscribeRequest reqId pk mCommitment =+ encodeRequest reqId "accountSubscribe" $+ E.list+ id+ [ E.string (show pk),+ E.pairs (commitmentField mCommitment <> E.pair "encoding" (E.string "base64"))+ ]++-- | A @signatureUnsubscribe@ request cancelling the given subscription.+signatureUnsubscribeRequest :: RequestId -> SubscriptionId -> BS.ByteString+signatureUnsubscribeRequest reqId (SubscriptionId s) =+ encodeRequest reqId "signatureUnsubscribe" (E.list id [E.word64 s])++-- | An @accountUnsubscribe@ request cancelling the given subscription.+accountUnsubscribeRequest :: RequestId -> SubscriptionId -> BS.ByteString+accountUnsubscribeRequest reqId (SubscriptionId s) =+ encodeRequest reqId "accountUnsubscribe" (E.list id [E.word64 s])++------------------------------------------------------------------------------------------------++-- * Incoming messages++------------------------------------------------------------------------------------------------++-- | The status of a subscribed signature.+data SignatureNotification = SignatureNotification+ { -- | The slot the notification is valid for.+ snSlot :: Slot,+ -- | 'Nothing' when the transaction succeeded at the subscribed+ -- commitment; the node's @TransactionError@ otherwise.+ snErr :: Maybe Value,+ -- | 'True' for the early @receivedSignature@ notification, which reports+ -- that the node has seen the transaction but says nothing about whether+ -- it succeeded. Such a notification is not terminal: the subscription+ -- stays open until the signature reaches the requested commitment.+ snReceived :: Bool+ }+ deriving (Eq, Show)++-- | A subscribed account's state after a change.+data AccountNotification = AccountNotification+ { -- | The slot the notification is valid for.+ anSlot :: Slot,+ -- | The account as of that slot, shaped exactly like a @getAccountInfo@+ -- value.+ anAccount :: AccountInfo+ }+ deriving (Eq, Show)++-- | A message received from a Solana PubSub endpoint.+data WsMessage+ = -- | A @*Subscribe@ request succeeded, yielding a subscription id.+ SubscribeAck RequestId SubscriptionId+ | -- | An @*Unsubscribe@ request completed.+ UnsubscribeAck RequestId Bool+ | -- | A @signatureNotification@ for an active subscription.+ SignatureNotice SubscriptionId SignatureNotification+ | -- | An @accountNotification@ for an active subscription.+ AccountNotice SubscriptionId AccountNotification+ | -- | A JSON-RPC error, with its code and message. The request id is+ -- 'Nothing' when the node could not attribute the error to a request.+ WsErrorMessage (Maybe RequestId) Int String+ deriving (Eq, Show)++-- | Parses one PubSub frame.+--+-- Note that PubSub notifications carry a @context@ object holding only a+-- @slot@ -- unlike the HTTP RPC responses modelled by+-- 'Network.Solana.RPC.HTTP.Types.Context', they omit @apiVersion@ -- so they+-- are parsed here rather than through @RPCResponse@.+parseWsMessage :: BS.ByteString -> Either String WsMessage+parseWsMessage raw = eitherDecodeStrict' raw >>= parseEither wsMessageParser++wsMessageParser :: Value -> Parser WsMessage+wsMessageParser = withObject "WsMessage" $ \o -> do+ mMethod <- o .:? "method"+ case mMethod :: Maybe Text of+ Just "signatureNotification" -> notice o SignatureNotice signatureNotificationParser+ Just "accountNotification" -> notice o AccountNotice accountNotificationParser+ Just other -> fail ("unsupported notification method: " <> Text.unpack other)+ Nothing -> do+ mError <- o .:? "error"+ case mError of+ Just err ->+ WsErrorMessage+ <$> o .:? "id"+ <*> err .: "code"+ <*> err .: "message"+ Nothing -> do+ reqId <- o .: "id"+ result <- o .: "result"+ case result of+ Bool ok -> pure (UnsubscribeAck reqId ok)+ Number _ -> SubscribeAck reqId . SubscriptionId <$> parseJSON result+ _ -> fail "result is neither a subscription id nor an unsubscribe flag"+ where+ notice o build parser = do+ params <- o .: "params"+ sub <- params .: "subscription"+ result <- params .: "result"+ build sub <$> parser result++-- | Both notification kinds wrap their payload in @{context: {slot}, value}@.+withNotificationContext :: (Slot -> Value -> Parser a) -> Value -> Parser a+withNotificationContext build = withObject "notification result" $ \result -> do+ ctx <- result .: "context"+ slot <- ctx .: "slot"+ value <- result .: "value"+ build slot value++signatureNotificationParser :: Value -> Parser SignatureNotification+signatureNotificationParser = withNotificationContext $ \slot value ->+ case value of+ String "receivedSignature" -> pure (SignatureNotification slot Nothing True)+ _ -> flip (withObject "signature notification value") value $ \v -> do+ err <- v .:? "err"+ pure (SignatureNotification slot err False)++accountNotificationParser :: Value -> Parser AccountNotification+accountNotificationParser = withNotificationContext $ \slot value ->+ AccountNotification slot <$> parseJSON value++------------------------------------------------------------------------------------------------++-- * Transport and confirmation++------------------------------------------------------------------------------------------------++-- | A minimal bidirectional message transport: everything this module needs+-- from a WebSocket connection.+--+-- Supplying this rather than a concrete connection type is what keeps the+-- library free of a WebSocket dependency (see the module header for the+-- @websockets@ wiring), and lets the confirmation handshake be tested without+-- a network.+data WsTransport = WsTransport+ { -- | Send one text frame.+ wsSend :: BS.ByteString -> IO (),+ -- | Receive one text frame, blocking until it arrives.+ wsReceive :: IO BS.ByteString+ }++-- | Subscribes to a signature and waits for its terminal notification,+-- returning the slot it was confirmed in.+--+-- This is the push-based counterpart to+-- 'Network.Solana.SolanaWeb3.confirmTransaction': the node sends the result+-- as soon as the signature reaches @commitment@ rather than being polled for+-- it. Because @signatureSubscribe@ cancels itself once that notification is+-- sent, a successful wait leaves nothing to clean up.+--+-- Frames that belong to other subscriptions, and early @receivedSignature@+-- notifications, are skipped. The whole exchange -- subscribe, acknowledge,+-- notify -- is bounded by @timeoutSeconds@.+--+-- Returns the confirming slot, or 'Left' describing a transaction that failed+-- on-chain, a JSON-RPC error, an unparseable frame, or the timeout. Exceptions+-- raised by the transport itself (a closed connection, for instance) are not+-- caught.+--+-- A wait that ends in a timeout, a bad frame, or an on-chain failure may leave+-- the subscription open, because only the terminal notification retires it.+-- That costs nothing if the connection is about to be closed, which is the+-- common case; a caller that keeps the connection alive should cancel it with+-- 'signatureUnsubscribeRequest'. Note also that this reads frames directly+-- from the transport, so one connection supports one wait at a time —+-- multiplexing several concurrent subscriptions needs a reader loop+-- dispatching on 'parseWsMessage', which this function deliberately is not.+awaitSignature :: WsTransport -> RequestId -> Maybe String -> Int -> SolanaSignature -> IO (Either String Slot)+awaitSignature transport reqId mCommitment timeoutSeconds sig = do+ result <- timeout (timeoutSeconds * 1000000) $ do+ wsSend transport (signatureSubscribeRequest reqId sig mCommitment False)+ subId <- awaitAck+ either (pure . Left) awaitNotice subId+ pure (fromMaybe (Left ("awaitSignature: timed out waiting for " <> show sig)) result)+ where+ -- Read until the acknowledgement for our own request id arrives.+ awaitAck = do+ msg <- next+ case msg of+ Left err -> pure (Left err)+ Right (SubscribeAck rid subId) | rid == reqId -> pure (Right subId)+ Right (WsErrorMessage rid code message)+ | rid == Just reqId || isNothing rid ->+ pure (Left ("awaitSignature: subscription failed (" <> show code <> "): " <> message))+ Right _ -> awaitAck++ -- Read until this subscription's terminal notification arrives.+ awaitNotice subId = do+ msg <- next+ case msg of+ Left err -> pure (Left err)+ Right (SignatureNotice sub n)+ | sub == subId,+ not (snReceived n) ->+ pure $ case snErr n of+ Nothing -> Right (snSlot n)+ Just err -> Left ("awaitSignature: transaction failed on-chain: " <> show err)+ Right _ -> awaitNotice subId++ next = either (Left . ("awaitSignature: " <>)) Right . parseWsMessage <$> wsReceive transport
+ src/Network/Solana/SolanaWeb3.hs view
@@ -0,0 +1,271 @@+-- |+-- Module : Network.Solana.SolanaWeb3+-- Description : High-level helpers that bundle common Solana client workflows.+--+-- Convenience layer on top of the JSON-RPC bindings: build, sign, and submit a+-- transaction in one call, print account balances, and pause execution while+-- waiting for confirmation. Intended for scripts and demos; for finer control+-- over blockhash selection, error handling, and confirmation strategy use+-- "Network.Solana.Core.Message" and "Network.Solana.RPC.HTTP.Transaction"+-- directly.+--+-- Also bundles typed fetch helpers ('getTokenAccount', 'getMint',+-- 'getLookupTable', 'getStakeAccount', 'getNonceAccount',+-- 'getMetadataAccount') that fetch an account over RPC and decode its state+-- with the corresponding on-chain-state decoder, so callers don't have to+-- extract and decode 'Network.Solana.Core.Account.AccountData' by hand; like+-- every other helper in this module, they require a reachable RPC node and+-- are compile-verified only.+module Network.Solana.SolanaWeb3 where++import Control.Concurrent (threadDelay)+import Control.Exception (throwIO)+import Control.Monad.IO.Class+import Data.ByteString qualified as BS+import Data.Maybe (fromMaybe, isNothing)+import Data.Word (Word64)+import Network.Solana.Core.Account (AccountData (..), AccountInfo (dataField))+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction+import Network.Solana.Core.Message (newDurableNonceTransactionIntentWithPayer, newTransactionIntent)+import Network.Solana.Core.VersionedMessage qualified as VM+import Network.Solana.Metaplex.TokenMetadata qualified as TM+import Network.Solana.NativePrograms.AddressLookupTable qualified as ALT+import Network.Solana.NativePrograms.Stake qualified as Stake+import Network.Solana.NativePrograms.SystemProgram qualified as SP+import Network.Solana.RPC.HTTP.Account (confirmationStatusTxStatus, errTxStatus, getAccountInfo, getAccountInfo', getBalance, getSignatureStatuses)+import Network.Solana.RPC.HTTP.Block (getTheLatestBlockhash)+import Network.Solana.RPC.HTTP.Chain (PrioritizationFee (prioritizationFee), getRecentPrioritizationFees, percentilePriorityFee)+import Network.Solana.RPC.HTTP.Transaction+import Network.Solana.RPC.HTTP.Types (ConfigurationObject, cfgJustEncodingBase64, commitment, value)+import Network.Solana.SplPrograms.Token qualified as Tok+import Network.Web3 hiding (AccountData, value)++-- | Builds, signs, and submits a transaction that executes the given+-- instructions, returning its signature.+--+-- Fetches the latest blockhash from the cluster, compiles the instructions+-- into a message, signs it with the given keys (the first key is the fee+-- payer), and broadcasts the result with 'sendTransaction'.+--+-- Throws a 'CompileException' if an instruction references an account key+-- that cannot be resolved in the compiled message.+newTransaction :: [SolanaPrivateKey] -> [Instruction] -> Web3 SolanaSignature+newTransaction signers instructions = do+ let newTxInt = newTransactionIntent signers instructions+ bh <- getTheLatestBlockhash+ signedTx <- either (liftIO . throwIO) pure (newTxInt bh)+ sendTransaction signedTx++-- | Configuration used to fetch the nonce account in 'newNonceTransaction':+-- base64 encoding (needed to decode the account's data, same as+-- 'Network.Solana.RPC.HTTP.Account.getAccountInfo') plus an explicit+-- @confirmed@ commitment, so a recently created or recently advanced nonce+-- account is not missed by the node's default @finalized@ commitment.+cfgNonceAccountConfirmed :: ConfigurationObject+cfgNonceAccountConfirmed = cfgJustEncodingBase64 {commitment = Just "confirmed"}++-- | Builds, signs, and submits a durable-nonce transaction with an+-- explicitly named fee payer that executes the given instructions,+-- returning its signature.+--+-- Reads the given nonce account at @confirmed@ commitment to avoid+-- stale-nonce races (a nonce account fetched at the node's default+-- @finalized@ commitment may appear not-found or stale immediately after+-- creation or after being advanced), then builds the transaction with+-- 'newDurableNonceTransactionIntentWithPayer', which prepends the+-- nonce-advance instruction ahead of the given instructions and uses the+-- nonce account's durable nonce in place of a recent block hash (so the+-- transaction never expires, unlike 'newTransaction'). The fee payer is+-- always account 0 (sponsored fees are supported), and the given signers+-- may be listed in any order — they must include private keys+-- corresponding to both the payer and the nonce account's authority+-- (@nsAuthority@), or the resulting transaction will be rejected on+-- submission. Requires a reachable RPC node.+--+-- Throws @'userError' "newNonceTransaction: nonce account not found"@ if+-- the account does not exist, and @'userError' "newNonceTransaction: nonce+-- account not initialized"@ if it exists but has not been initialized as a+-- nonce account -- distinct from each other and from the 'CompileException'+-- thrown if an instruction references an account key that cannot be+-- resolved in the compiled message.+newNonceTransaction :: SolanaPublicKey -> [SolanaPrivateKey] -> SolanaPublicKey -> [Instruction] -> Web3 SolanaSignature+newNonceTransaction payer signers nonceAccount instructions = do+ mAccInfo <- value <$> getAccountInfo' nonceAccount cfgNonceAccountConfirmed+ case mAccInfo of+ Nothing -> liftIO . throwIO . userError $ "newNonceTransaction: nonce account not found"+ Just acc -> do+ nonceState <-+ either+ (liftIO . throwIO . userError . ("newNonceTransaction: state decode failed: " <>))+ pure+ (accountDataBytes (dataField acc) >>= SP.decodeNonceAccount)+ case nonceState of+ SP.NonceUninitialized -> liftIO . throwIO . userError $ "newNonceTransaction: nonce account not initialized"+ SP.NonceInitialized authority durableNonce _ -> do+ let newTxInt = newDurableNonceTransactionIntentWithPayer payer signers nonceAccount authority instructions+ signedTx <- either (liftIO . throwIO) pure (newTxInt durableNonce)+ sendTransaction signedTx++-- | Estimates a priority fee (in micro-lamports per compute unit) for+-- landing a transaction that writes to the given accounts, as the @p@-th+-- percentile of recent per-compute-unit fees observed for them (via+-- 'getRecentPrioritizationFees' and 'percentilePriorityFee').+--+-- Heuristic only: recent fees are no guarantee of what is needed to land+-- the next transaction. Returns @0@ if no recent priority fees were+-- observed for the given accounts. Requires a reachable RPC node.+estimatePriorityFee :: [SolanaPublicKey] -> Double -> Web3 Word64+estimatePriorityFee addresses p = do+ fees <- getRecentPrioritizationFees (Just addresses)+ pure (percentilePriorityFee p (map prioritizationFee fees))++-- | Prints the balance of each of the given accounts to standard output using 'printBalance'.+printBalances :: [SolanaPublicKey] -> Web3 ()+printBalances = mapM_ printBalance++-- | Fetches the balance of the given account with 'getBalance' and prints it to standard output.+printBalance :: SolanaPublicKey -> Web3 ()+printBalance addr = do+ balance <- getBalance addr+ liftIO $ putStrLn $ "Balance for " <> show addr <> " is: " <> show balance++-- | Suspends execution for the given number of seconds, printing a notice first.+-- A crude way to wait for transaction confirmation; prefer polling+-- 'Network.Solana.RPC.HTTP.Account.getSignatureStatuses' in real applications.+wait :: Int -> Web3 ()+wait s = liftIO $ do+ putStrLn ("Wait " <> show s <> " seconds to make sure tx is confirmed ..")+ threadDelay (s * 1000000)++-- | Polls 'Network.Solana.RPC.HTTP.Account.getSignatureStatuses' once a+-- second, up to 30 times, until the given signature reaches @confirmed@ or+-- @finalized@ status.+--+-- Returns 'True' only if the status reaches the target commitment /and/ the+-- node reports no on-chain error for it (its @err@ field is 'Nothing'); a+-- transaction that landed but failed on-chain (e.g. a program error) yields+-- 'False', not 'True'. Also returns 'False' if it does not confirm within+-- the poll budget.+confirmTransaction :: SolanaSignature -> Web3 Bool+confirmTransaction sig = go (30 :: Int)+ where+ go 0 = pure False+ go n = do+ statuses <- getSignatureStatuses [sig]+ case statuses of+ [Just s]+ | confirmationStatusTxStatus s `elem` [Just "confirmed", Just "finalized"] ->+ pure (isNothing (errTxStatus s))+ [_] -> wait 1 >> go (n - 1)+ _ -> liftIO . throwIO . userError $+ "confirmTransaction: expected exactly one status for one signature, got " <> show (length statuses)++------------------------------------------------------------------------------------------------++-- * Account-state fetch helpers++------------------------------------------------------------------------------------------------++-- | Extracts the raw bytes backing an account's @data@ field. Every fetch+-- helper in this module requests base64 encoding (see+-- 'Network.Solana.RPC.HTTP.Account.getAccountInfo'), so+-- 'Network.Solana.Core.Account.AccountDataJSON' should never occur in+-- practice; if it does, it is reported the same way as any other decode+-- failure.+accountDataBytes :: AccountData -> Either String BS.ByteString+accountDataBytes (AccountDataBinary bs) = Right bs+accountDataBytes (AccountDataJSON _) = Left "account data was not base64-encoded"++-- | Fetches the given account with 'Network.Solana.RPC.HTTP.Account.getAccountInfo'+-- and decodes its data with the given decoder, prefixing any failure message+-- with the given label.+--+-- Returns 'Nothing' if the account does not exist. Propagates the underlying+-- JSON-RPC exception on RPC failure, same as every other RPC-backed helper in+-- this module. Throws @'userError' (label <> ": state decode failed: " <> err)@+-- if the account exists but its data cannot be decoded -- distinct from the+-- not-found case.+fetchAccountState :: String -> (BS.ByteString -> Either String a) -> SolanaPublicKey -> Web3 (Maybe a)+fetchAccountState label decodeFn addr = do+ macc <- getAccountInfo addr+ case macc of+ Nothing -> pure Nothing+ Just acc ->+ either+ (liftIO . throwIO . userError . ((label <> ": state decode failed: ") <>))+ (pure . Just)+ (accountDataBytes (dataField acc) >>= decodeFn)++-- | Fetches the given account and decodes it as an SPL Token account with+-- 'Tok.decodeTokenAccount'.+--+-- Returns 'Nothing' if the account does not exist. Throws on RPC failure, per+-- 'fetchAccountState'. Throws @'userError'+-- ("getTokenAccount: state decode failed: " <> err)@ if the account exists+-- but is not a well-formed SPL Token account -- distinct from the not-found+-- case.+getTokenAccount :: SolanaPublicKey -> Web3 (Maybe Tok.TokenAccount)+getTokenAccount = fetchAccountState "getTokenAccount" Tok.decodeTokenAccount++-- | Fetches the given account and decodes it as an SPL Token mint with+-- 'Tok.decodeMint'.+--+-- Returns 'Nothing' if the account does not exist. Throws on RPC failure, per+-- 'fetchAccountState'. Throws @'userError'+-- ("getMint: state decode failed: " <> err)@ if the account exists but is+-- not a well-formed mint -- distinct from the not-found case.+getMint :: SolanaPublicKey -> Web3 (Maybe Tok.Mint)+getMint = fetchAccountState "getMint" Tok.decodeMint++-- | Fetches the given address lookup table account, decodes it with+-- 'ALT.decodeLookupTable', and bridges it into the+-- 'VM.AddressLookupTableAccount' shape 'Network.Solana.Core.VersionedMessage.compileV0Message'+-- expects (via 'ALT.lookupTableToAccount'), using the queried address as the+-- table's own key.+--+-- Returns 'Nothing' if the account does not exist. Throws on RPC failure, per+-- 'fetchAccountState'. Throws @'userError'+-- ("getLookupTable: state decode failed: " <> err)@ if the account exists but+-- is not a well-formed lookup table -- distinct from the not-found case.+getLookupTable :: SolanaPublicKey -> Web3 (Maybe VM.AddressLookupTableAccount)+getLookupTable key = do+ mState <- fetchAccountState "getLookupTable" ALT.decodeLookupTable key+ pure (ALT.lookupTableToAccount key <$> mState)++-- | Fetches the given account and decodes it as a stake account with+-- 'Stake.decodeStakeAccount'.+--+-- Returns 'Nothing' if the account does not exist. Throws on RPC failure, per+-- 'fetchAccountState'. Throws @'userError'+-- ("getStakeAccount: state decode failed: " <> err)@ if the account exists+-- but is not a well-formed stake account -- distinct from the not-found case.+getStakeAccount :: SolanaPublicKey -> Web3 (Maybe Stake.StakeState)+getStakeAccount = fetchAccountState "getStakeAccount" Stake.decodeStakeAccount++-- | Fetches the given account and decodes it as a nonce account with+-- 'SP.decodeNonceAccount'.+--+-- Returns 'Nothing' if the account does not exist. Throws on RPC failure, per+-- 'fetchAccountState'. Throws @'userError'+-- ("getNonceAccount: state decode failed: " <> err)@ if the account exists+-- but is not a well-formed nonce account -- distinct from the not-found case.+getNonceAccount :: SolanaPublicKey -> Web3 (Maybe SP.NonceState)+getNonceAccount = fetchAccountState "getNonceAccount" SP.decodeNonceAccount++-- | Fetches the Metaplex metadata account for the given mint (deriving its+-- PDA with 'TM.deriveMetadataAddress') and decodes it with+-- 'TM.decodeMetadata'.+--+-- Calls 'error' if the metadata PDA cannot be derived, matching the+-- precedent set by 'Network.Solana.Metaplex.TokenMetadata.createMetadataAccountV3'+-- (practically unreachable: requires every bump candidate to land on-curve).+-- Otherwise, returns 'Nothing' if the metadata account does not exist.+-- Throws on RPC failure, per 'fetchAccountState'. Throws @'userError'+-- ("getMetadataAccount: state decode failed: " <> err)@ if the account+-- exists but is not well-formed metadata -- distinct from the not-found case.+getMetadataAccount :: SolanaPublicKey -> Web3 (Maybe TM.Metadata)+getMetadataAccount mint =+ fetchAccountState "getMetadataAccount" TM.decodeMetadata pda+ where+ pda = fromMaybe (error "getMetadataAccount: metadata PDA derivation failed") (TM.deriveMetadataAddress mint)
+ src/Network/Solana/SplPrograms/AssociatedTokenAccount.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Client for the Associated Token Account (ATA) program: derives the+-- canonical token account address for a (wallet, mint) pair and builds+-- create instructions. <https://spl.solana.com/associated-token-account>+module Network.Solana.SplPrograms.AssociatedTokenAccount where++import Data.Binary (Binary (..), Get, Put)+import Data.Binary.Get (getWord8)+import Data.Binary.Put (putWord8)+import Data.Maybe (fromMaybe)+import Network.Solana.Core.Crypto (SolanaPublicKey, getSolanaPublicKeyRaw)+import Network.Solana.Core.Instruction+import Network.Solana.Core.Pda (findProgramAddress)+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.SplPrograms.Token qualified as Token++-- | Associated Token Account program address.+associatedTokenProgramId :: SolanaPublicKey+associatedTokenProgramId = "ATokenGPvbdGVxr1b2hvZbsiqW5xWH25efTNsLJA8knL"++-- | System program reference (re-exported for account-meta lists).+systemProgramRef :: SolanaPublicKey+systemProgramRef = SystemProgram.systemProgramId++-- | ATA instruction data: a single borsh discriminant byte.+data AtaInstruction = Create | CreateIdempotent+ deriving (Eq, Show)++instance Binary AtaInstruction where+ put :: AtaInstruction -> Put+ put Create = putWord8 0+ put CreateIdempotent = putWord8 1+ get :: Get AtaInstruction+ get = do+ b <- getWord8+ case b of+ 0 -> pure Create+ 1 -> pure CreateIdempotent+ _ -> fail ("AtaInstruction: unknown discriminant " <> show b)++-- | Derive the associated token account address for a wallet and mint:+-- the PDA of [wallet, token program, mint] under the ATA program.+getAssociatedTokenAddress :: SolanaPublicKey -> SolanaPublicKey -> Maybe SolanaPublicKey+getAssociatedTokenAddress wallet mint =+ fst+ <$> findProgramAddress+ [ getSolanaPublicKeyRaw wallet,+ getSolanaPublicKeyRaw Token.tokenProgramId,+ getSolanaPublicKeyRaw mint+ ]+ associatedTokenProgramId++ataMetas :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [AccountMeta]+ataMetas funder wallet mint =+ let ata = fromMaybe (error "getAssociatedTokenAddress: derivation failed") (getAssociatedTokenAddress wallet mint)+ in [ AccountMeta {accountPubKey = funder, isSigner = True, isWritable = True},+ AccountMeta {accountPubKey = ata, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = wallet, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = systemProgramRef, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Token.tokenProgramId, isSigner = False, isWritable = False}+ ]++-- | Create the associated token account for (wallet, mint), paid by the funder.+-- Fails the transaction if it already exists.+createAssociatedTokenAccount :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+createAssociatedTokenAccount funder wallet mint =+ mkInstruction associatedTokenProgramId (ataMetas funder wallet mint) Create++-- | Like 'createAssociatedTokenAccount' but succeeds (no-op) if the account+-- already exists.+createAssociatedTokenAccountIdempotent :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+createAssociatedTokenAccountIdempotent funder wallet mint =+ mkInstruction associatedTokenProgramId (ataMetas funder wallet mint) CreateIdempotent
+ src/Network/Solana/SplPrograms/Memo.hs view
@@ -0,0 +1,44 @@+{-# LANGUAGE OverloadedStrings #-}++module Network.Solana.SplPrograms.Memo where++import Data.Binary+import Data.Binary.Get (getRemainingLazyByteString)+import Data.Binary.Put (putByteString)+import Data.ByteString.Lazy qualified as BL+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Network.Solana.Core.Crypto (SolanaPublicKey)+import Network.Solana.Core.Instruction++-- | SPL Memo program (v2) address. The program validates a string of UTF-8+-- encoded characters and verifies that any accounts provided are signers of+-- the transaction.+memoProgramId :: SolanaPublicKey+memoProgramId = "MemoSq4gqABAXKb96qnH8TysNcWxMyWCqXgDLGmfcHr"++-- | Memo instruction data: the raw UTF-8 bytes of the memo text+-- (no discriminant, no length prefix). The 'Binary' 'get' decodes leniently+-- by design: invalid UTF-8 sequences are replaced (never fails), and all+-- remaining input is consumed as the memo text. Encoding via 'put' is the+-- production path used when building instructions; decoding exists mainly+-- for round-tripping and inspection.+newtype MemoData = MemoData String+ deriving (Eq, Show)++instance Binary MemoData where+ put :: MemoData -> Put+ put (MemoData s) = putByteString (TE.encodeUtf8 (T.pack s))+ get :: Get MemoData+ get = MemoData . T.unpack . TE.decodeUtf8Lenient . BL.toStrict <$> getRemainingLazyByteString++-- | Creates a memo instruction from the memo text and the list of signer accounts+-- (may be empty). The memo program verifies each provided account signed the transaction.+-- # Account references+-- 0..n. `[SIGNER]` Signer accounts+buildMemo :: String -> [SolanaPublicKey] -> Instruction+buildMemo text signers =+ mkInstruction+ memoProgramId+ [AccountMeta {accountPubKey = s, isSigner = True, isWritable = False} | s <- signers]+ (MemoData text)
+ src/Network/Solana/SplPrograms/Token.hs view
@@ -0,0 +1,499 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Client for the SPL Token program: <https://spl.solana.com/token>+-- Instruction data uses SPL Token's hand-rolled pack format (u8 discriminant,+-- little-endian integers, raw 32-byte pubkeys, and optional pubkeys encoded+-- as a 1-byte tag followed by the key when present) — this is NOT bincode.+module Network.Solana.SplPrograms.Token where++import Data.Binary+import Data.Binary.Get+import Data.Binary.Put+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import GHC.Generics (Generic)+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction+import Network.Solana.Sysvar qualified as Sysvar++-- | Token account state: Uninitialized (0), Initialized (1), or Frozen (2).+data AccountState = TokenAccountUninitialized | TokenAccountInitialized | TokenAccountFrozen+ deriving (Eq, Show, Enum)++-- | SPL Token account state (165 bytes fixed).+data TokenAccount = TokenAccount+ { taMint :: SolanaPublicKey,+ taOwner :: SolanaPublicKey,+ taAmount :: Word64,+ taDelegate :: Maybe SolanaPublicKey,+ taState :: AccountState,+ taIsNative :: Maybe Word64,+ taDelegatedAmount :: Word64,+ taCloseAuthority :: Maybe SolanaPublicKey+ }+ deriving (Eq, Show)++-- | SPL Token mint state (82 bytes fixed).+data Mint = Mint+ { mMintAuthority :: Maybe SolanaPublicKey,+ mSupply :: Word64,+ mDecimals :: Word8,+ mIsInitialized :: Bool,+ mFreezeAuthority :: Maybe SolanaPublicKey+ }+ deriving (Eq, Show)++-- | Helper for parsing fixed-width state COption (4-byte LE tag + payload).+getStateCOption :: Int -> Get a -> Get (Maybe a)+getStateCOption payloadLen inner = do+ tag <- getWord32le+ case tag of+ 0 -> skip payloadLen >> pure Nothing+ 1 -> Just <$> inner+ _ -> fail ("state COption: invalid tag " <> show tag)++-- | Decode a SPL Token account state from bytes (exactly 165 bytes).+decodeTokenAccount :: BS.ByteString -> Either String TokenAccount+decodeTokenAccount bs+ | BS.length bs /= 165 = Left ("TokenAccount: expected 165 bytes, got " <> show (BS.length bs))+ | otherwise = case runGetOrFail getTokenAccount (BL.fromStrict bs) of+ Left (_, _, err) -> Left err+ Right (_, _, ta) -> Right ta+ where+ getTokenAccount =+ TokenAccount+ <$> get+ <*> get+ <*> getWord64le+ <*> getStateCOption 32 get+ <*> getAccountState+ <*> getStateCOption 8 getWord64le+ <*> getWord64le+ <*> getStateCOption 32 get+ getAccountState = do+ byte <- getWord8+ if byte <= 2+ then pure (toEnum (fromIntegral byte))+ else fail ("AccountState: invalid value " <> show byte)++-- | Decode a SPL Token mint state from bytes (exactly 82 bytes).+decodeMint :: BS.ByteString -> Either String Mint+decodeMint bs+ | BS.length bs /= 82 = Left ("Mint: expected 82 bytes, got " <> show (BS.length bs))+ | otherwise = case runGetOrFail getMint (BL.fromStrict bs) of+ Left (_, _, err) -> Left err+ Right (_, _, m) -> Right m+ where+ getMint =+ Mint+ <$> getStateCOption 32 get+ <*> getWord64le+ <*> getWord8+ <*> getIsInitialized+ <*> getStateCOption 32 get+ getIsInitialized = do+ byte <- getWord8+ case byte of+ 0 -> pure False+ 1 -> pure True+ _ -> fail ("Mint: invalid is_initialized byte " <> show byte)++-- | SPL Token program address.+tokenProgramId :: SolanaPublicKey+tokenProgramId = "TokenkegQfeZyiNwAJbNbGKPFXCWuBvf9Ss623VQ5DA"++-- | Authorities a token mint or account can carry (SPL @AuthorityType@, u8 0-3).+data AuthorityType+ = MintTokens+ | FreezeAuthority+ | AccountOwner+ | CloseAuthority+ deriving (Eq, Show, Enum, Bounded, Generic)++-- | SPL Token instructions 0-20 (instructions 21-24 are deferred post-1.0).+data TokenInstruction+ = InitializeMint {tiDecimals :: Word8, tiMintAuthority :: SolanaPublicKey, tiFreezeAuthority :: Maybe SolanaPublicKey}+ | InitializeAccount+ | InitializeMultisig {tiM :: Word8}+ | Transfer {tiAmount :: Word64}+ | Approve {tiAmount :: Word64}+ | Revoke+ | SetAuthority {tiAuthorityType :: AuthorityType, tiNewAuthority :: Maybe SolanaPublicKey}+ | MintTo {tiAmount :: Word64}+ | Burn {tiAmount :: Word64}+ | CloseAccount+ | FreezeAccount+ | ThawAccount+ | TransferChecked {tiAmount :: Word64, tiDecimals :: Word8}+ | ApproveChecked {tiAmount :: Word64, tiDecimals :: Word8}+ | MintToChecked {tiAmount :: Word64, tiDecimals :: Word8}+ | BurnChecked {tiAmount :: Word64, tiDecimals :: Word8}+ | InitializeAccount2 {tiOwner :: SolanaPublicKey}+ | SyncNative+ | InitializeAccount3 {tiOwner :: SolanaPublicKey}+ | InitializeMultisig2 {tiM :: Word8}+ | InitializeMint2 {tiDecimals :: Word8, tiMintAuthority :: SolanaPublicKey, tiFreezeAuthority :: Maybe SolanaPublicKey}+ deriving (Eq, Show, Generic)++putCOptionPubkey :: Maybe SolanaPublicKey -> Put+putCOptionPubkey Nothing = putWord8 0+putCOptionPubkey (Just pk) = do+ putWord8 1+ putByteString (getSolanaPublicKeyRaw pk)++getCOptionPubkey :: Get (Maybe SolanaPublicKey)+getCOptionPubkey = do+ tag <- getWord8+ case tag of+ 0 -> pure Nothing+ 1 -> Just <$> get+ _ -> fail ("COption<Pubkey>: invalid tag " <> show tag)++instance Binary TokenInstruction where+ put :: TokenInstruction -> Put+ put (InitializeMint decimals mintAuth freezeAuth) = do+ putWord8 0+ putWord8 decimals+ putByteString (getSolanaPublicKeyRaw mintAuth)+ putCOptionPubkey freezeAuth+ put InitializeAccount = putWord8 1+ put (InitializeMultisig m) = do+ putWord8 2+ putWord8 m+ put (Transfer amount) = do+ putWord8 3+ putWord64le amount+ put (Approve amount) = do+ putWord8 4+ putWord64le amount+ put Revoke = putWord8 5+ put (SetAuthority authType newAuth) = do+ putWord8 6+ putWord8 (fromIntegral (fromEnum authType))+ putCOptionPubkey newAuth+ put (MintTo amount) = do+ putWord8 7+ putWord64le amount+ put (Burn amount) = do+ putWord8 8+ putWord64le amount+ put CloseAccount = putWord8 9+ put FreezeAccount = putWord8 10+ put ThawAccount = putWord8 11+ put (TransferChecked amount decimals) = do+ putWord8 12+ putWord64le amount+ putWord8 decimals+ put (ApproveChecked amount decimals) = do+ putWord8 13+ putWord64le amount+ putWord8 decimals+ put (MintToChecked amount decimals) = do+ putWord8 14+ putWord64le amount+ putWord8 decimals+ put (BurnChecked amount decimals) = do+ putWord8 15+ putWord64le amount+ putWord8 decimals+ put (InitializeAccount2 owner) = do+ putWord8 16+ putByteString (getSolanaPublicKeyRaw owner)+ put SyncNative = putWord8 17+ put (InitializeAccount3 owner) = do+ putWord8 18+ putByteString (getSolanaPublicKeyRaw owner)+ put (InitializeMultisig2 m) = do+ putWord8 19+ putWord8 m+ put (InitializeMint2 decimals mintAuth freezeAuth) = do+ putWord8 20+ putWord8 decimals+ putByteString (getSolanaPublicKeyRaw mintAuth)+ putCOptionPubkey freezeAuth++ get :: Get TokenInstruction+ get = do+ disc <- getWord8+ case disc of+ 0 -> InitializeMint <$> getWord8 <*> get <*> getCOptionPubkey+ 1 -> pure InitializeAccount+ 2 -> InitializeMultisig <$> getWord8+ 3 -> Transfer <$> getWord64le+ 4 -> Approve <$> getWord64le+ 5 -> pure Revoke+ 6 -> SetAuthority <$> getAuthorityType <*> getCOptionPubkey+ 7 -> MintTo <$> getWord64le+ 8 -> Burn <$> getWord64le+ 9 -> pure CloseAccount+ 10 -> pure FreezeAccount+ 11 -> pure ThawAccount+ 12 -> TransferChecked <$> getWord64le <*> getWord8+ 13 -> ApproveChecked <$> getWord64le <*> getWord8+ 14 -> MintToChecked <$> getWord64le <*> getWord8+ 15 -> BurnChecked <$> getWord64le <*> getWord8+ 16 -> InitializeAccount2 <$> get+ 17 -> pure SyncNative+ 18 -> InitializeAccount3 <$> get+ 19 -> InitializeMultisig2 <$> getWord8+ 20 -> InitializeMint2 <$> getWord8 <*> get <*> getCOptionPubkey+ _ -> fail ("TokenInstruction: unknown discriminant " <> show disc)+ where+ getAuthorityType = do+ b <- getWord8+ if b <= 3+ then pure (toEnum (fromIntegral b))+ else fail ("AuthorityType: invalid value " <> show b)++-- | Rent sysvar (re-exported for account-meta lists).+rentSysvar :: SolanaPublicKey+rentSysvar = Sysvar.rent++-- Owner-or-multisig meta convention (mirrors the Rust @spl-token@ builders):+-- with an empty signer list the owner itself signs; with a non-empty list the+-- owner is a readonly non-signer (the multisig account) and each listed key+-- is a readonly signer.+ownerMetas :: SolanaPublicKey -> [SolanaPublicKey] -> [AccountMeta]+ownerMetas owner signers =+ AccountMeta {accountPubKey = owner, isSigner = null signers, isWritable = False}+ : [AccountMeta {accountPubKey = s, isSigner = True, isWritable = False} | s <- signers]++-- | Initialize a new mint. Accounts: 0. `[WRITE]` mint, 1. `[]` rent sysvar.+initializeMint :: SolanaPublicKey -> Word8 -> SolanaPublicKey -> Maybe SolanaPublicKey -> Instruction+initializeMint mint decimals mintAuthority freezeAuthority =+ mkInstruction+ tokenProgramId+ [ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = rentSysvar, isSigner = False, isWritable = False}+ ]+ (InitializeMint decimals mintAuthority freezeAuthority)++-- | Initialize a token account. Accounts: 0. `[WRITE]` account, 1. `[]` mint, 2. `[]` owner, 3. `[]` rent sysvar.+initializeAccount :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+initializeAccount account mint owner =+ mkInstruction+ tokenProgramId+ [ AccountMeta {accountPubKey = account, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = owner, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = rentSysvar, isSigner = False, isWritable = False}+ ]+ InitializeAccount++-- | Transfer tokens. Accounts: 0. `[WRITE]` source, 1. `[WRITE]` destination,+-- then owner-or-multisig metas.+transfer :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Word64 -> Instruction+transfer source destination owner signers amount =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = source, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = destination, isSigner = False, isWritable = True}+ ]+ <> ownerMetas owner signers+ )+ (Transfer amount)++-- | Approve a delegate. Accounts: 0. `[WRITE]` source, 1. `[]` delegate, then owner metas.+approve :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Word64 -> Instruction+approve source delegate owner signers amount =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = source, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = delegate, isSigner = False, isWritable = False}+ ]+ <> ownerMetas owner signers+ )+ (Approve amount)++-- | Revoke a delegate. Accounts: 0. `[WRITE]` source, then owner metas.+revoke :: SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Instruction+revoke source owner signers =+ mkInstruction+ tokenProgramId+ (AccountMeta {accountPubKey = source, isSigner = False, isWritable = True} : ownerMetas owner signers)+ Revoke++-- | Change a mint or account authority. Accounts: 0. `[WRITE]` mint/account, then owner metas.+setAuthority :: SolanaPublicKey -> AuthorityType -> Maybe SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Instruction+setAuthority owned authorityType newAuthority currentAuthority signers =+ mkInstruction+ tokenProgramId+ (AccountMeta {accountPubKey = owned, isSigner = False, isWritable = True} : ownerMetas currentAuthority signers)+ (SetAuthority authorityType newAuthority)++-- | Mint new tokens. Accounts: 0. `[WRITE]` mint, 1. `[WRITE]` destination account, then owner metas.+mintTo :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Word64 -> Instruction+mintTo mint destination mintAuthority signers amount =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = destination, isSigner = False, isWritable = True}+ ]+ <> ownerMetas mintAuthority signers+ )+ (MintTo amount)++-- | Burn tokens. Accounts: 0. `[WRITE]` account, 1. `[WRITE]` mint, then owner metas.+burn :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Word64 -> Instruction+burn account mint owner signers amount =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = account, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = True}+ ]+ <> ownerMetas owner signers+ )+ (Burn amount)++-- | Close a token account, reclaiming its lamports. Accounts: 0. `[WRITE]` account,+-- 1. `[WRITE]` lamport destination, then owner metas.+closeAccount :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Instruction+closeAccount account destination owner signers =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = account, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = destination, isSigner = False, isWritable = True}+ ]+ <> ownerMetas owner signers+ )+ CloseAccount++-- | Freeze a token account. Accounts: 0. `[WRITE]` account, 1. `[]` mint, then freeze-authority metas.+freezeAccount :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Instruction+freezeAccount account mint freezeAuthority signers =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = account, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = False}+ ]+ <> ownerMetas freezeAuthority signers+ )+ FreezeAccount++-- | Thaw a frozen token account. Same accounts as 'freezeAccount'.+thawAccount :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Instruction+thawAccount account mint freezeAuthority signers =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = account, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = False}+ ]+ <> ownerMetas freezeAuthority signers+ )+ ThawAccount++-- | Transfer with decimals check. Accounts: 0. `[WRITE]` source, 1. `[]` mint,+-- 2. `[WRITE]` destination, then owner metas.+transferChecked :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Word64 -> Word8 -> Instruction+transferChecked source mint destination owner signers amount decimals =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = source, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = destination, isSigner = False, isWritable = True}+ ]+ <> ownerMetas owner signers+ )+ (TransferChecked amount decimals)++-- | Sync a native (wrapped SOL) account's balance. Accounts: 0. `[WRITE]` account.+syncNative :: SolanaPublicKey -> Instruction+syncNative account =+ mkInstruction+ tokenProgramId+ [AccountMeta {accountPubKey = account, isSigner = False, isWritable = True}]+ SyncNative++-- | Initialize a multisig account. The signer pubkeys are the full member set;+-- m is the number of required signatures (the Rust SDK validates 1 <= m <= 11 <= length signers+-- client-side; this builder, like the others in this module, performs no client-side validation).+-- # Account references+-- 0. `[WRITE]` Multisig account+-- 1. `[]` Rent sysvar+-- 2..n. `[]` Signer member accounts+initializeMultisig :: SolanaPublicKey -> [SolanaPublicKey] -> Word8 -> Instruction+initializeMultisig multisig members m =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = multisig, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = rentSysvar, isSigner = False, isWritable = False}+ ]+ <> [AccountMeta {accountPubKey = s, isSigner = False, isWritable = False} | s <- members]+ )+ (InitializeMultisig m)++-- | Like 'initializeMultisig' without the rent sysvar account.+initializeMultisig2 :: SolanaPublicKey -> [SolanaPublicKey] -> Word8 -> Instruction+initializeMultisig2 multisig members m =+ mkInstruction+ tokenProgramId+ ( AccountMeta {accountPubKey = multisig, isSigner = False, isWritable = True}+ : [AccountMeta {accountPubKey = s, isSigner = False, isWritable = False} | s <- members]+ )+ (InitializeMultisig2 m)++-- | 'approve' with decimals check. Accounts: 0. `[WRITE]` source, 1. `[]` mint, 2. `[]` delegate, then owner metas.+approveChecked :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Word64 -> Word8 -> Instruction+approveChecked source mint delegate owner signers amount decimals =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = source, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = delegate, isSigner = False, isWritable = False}+ ]+ <> ownerMetas owner signers+ )+ (ApproveChecked amount decimals)++-- | 'mintTo' with decimals check. Accounts: 0. `[WRITE]` mint, 1. `[WRITE]` destination, then owner metas.+mintToChecked :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Word64 -> Word8 -> Instruction+mintToChecked mint destination mintAuthority signers amount decimals =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = destination, isSigner = False, isWritable = True}+ ]+ <> ownerMetas mintAuthority signers+ )+ (MintToChecked amount decimals)++-- | 'burn' with decimals check. Accounts: 0. `[WRITE]` account, 1. `[WRITE]` mint, then owner metas.+burnChecked :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> [SolanaPublicKey] -> Word64 -> Word8 -> Instruction+burnChecked account mint owner signers amount decimals =+ mkInstruction+ tokenProgramId+ ( [ AccountMeta {accountPubKey = account, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = True}+ ]+ <> ownerMetas owner signers+ )+ (BurnChecked amount decimals)++-- | 'initializeAccount' with the owner in instruction data. Accounts: 0. `[WRITE]` account, 1. `[]` mint, 2. `[]` rent sysvar.+initializeAccount2 :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+initializeAccount2 account mint owner =+ mkInstruction+ tokenProgramId+ [ AccountMeta {accountPubKey = account, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = rentSysvar, isSigner = False, isWritable = False}+ ]+ (InitializeAccount2 owner)++-- | Like 'initializeAccount2' without the rent sysvar account. Accounts: 0. `[WRITE]` account, 1. `[]` mint.+initializeAccount3 :: SolanaPublicKey -> SolanaPublicKey -> SolanaPublicKey -> Instruction+initializeAccount3 account mint owner =+ mkInstruction+ tokenProgramId+ [ AccountMeta {accountPubKey = account, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mint, isSigner = False, isWritable = False}+ ]+ (InitializeAccount3 owner)++-- | Like 'initializeMint' without the rent sysvar account. Accounts: 0. `[WRITE]` mint.+initializeMint2 :: SolanaPublicKey -> Word8 -> SolanaPublicKey -> Maybe SolanaPublicKey -> Instruction+initializeMint2 mint decimals mintAuthority freezeAuthority =+ mkInstruction+ tokenProgramId+ [AccountMeta {accountPubKey = mint, isSigner = False, isWritable = True}]+ (InitializeMint2 decimals mintAuthority freezeAuthority)
+ src/Network/Solana/Sysvar.hs view
@@ -0,0 +1,65 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module : Network.Solana.Sysvar+-- Description : Definitions of Solana Sysvar public keys for accessing blockchain state data.+-- Copyright : (c) 2024+--+-- This module provides convenient access to Solana's sysvars, special accounts that+-- store critical state data of the blockchain. These sysvars provide real-time data+-- such as the current slot, epoch schedules, fee rates, recent blockhashes, and more.+-- They are frequently referenced by Solana programs to obtain necessary blockchain+-- information during transaction execution.+module Network.Solana.Sysvar where++import Network.Solana.Core.Crypto (SolanaPublicKey)++-- | The Clock sysvar contains data on cluster time, including the current slot, epoch, and+-- estimated wall-clock Unix timestamp. It is updated every slot.+clock :: SolanaPublicKey+clock = "SysvarC1ock11111111111111111111111111111111"++-- | The EpochSchedule sysvar contains epoch scheduling constants that are set in genesis,+-- and enables calculating the number of slots in a given epoch, the epoch for a given slot, etc.+epochSchedule :: SolanaPublicKey+epochSchedule = "SysvarEpochSchedu1e111111111111111111111111"++-- | The Fees sysvar contains the fee calculator for the current slot.+-- It is updated every slot, based on the fee-rate governor.+fees :: SolanaPublicKey+fees = "SysvarFees111111111111111111111111111111111"++-- | The Instructions sysvar contains the serialized instructions in a Message while that Message is being processed.+-- This allows program instructions to reference other instructions in the same transaction.+instructions :: SolanaPublicKey+instructions = "Sysvar1nstructions1111111111111111111111111"++-- | The RecentBlockhashes sysvar contains the active recent blockhashes as well as their associated fee calculators.+-- It is updated every slot.+recentBlockhashes :: SolanaPublicKey+recentBlockhashes = "SysvarRecentB1ockHashes11111111111111111111"++-- | The Rent sysvar contains the rental rate.+rent :: SolanaPublicKey+rent = "SysvarRent111111111111111111111111111111111"++-- | The SlotHashes sysvar contains the most recent hashes of the slot's parent banks. It is updated every slot.+slotHashes :: SolanaPublicKey+slotHashes = "SysvarS1otHashes111111111111111111111111111"++-- | The SlotHistory sysvar contains a bitvector of slots present over the last epoch. It is updated every slot.+slotHistory :: SolanaPublicKey+slotHistory = "SysvarS1otHistory11111111111111111111111111"++-- | The StakeHistory sysvar contains the history of cluster-wide stake activations and de-activations per epoch.+-- It is updated at the start of every epoch.+stakeHistory :: SolanaPublicKey+stakeHistory = "SysvarStakeHistory1111111111111111111111111"++-- | The EpochRewards sysvar holds a record of epoch rewards distribution in Solana, including block rewards and staking rewards.+epochRewards :: SolanaPublicKey+epochRewards = "SysvarEpochRewards1111111111111111111111111"++-- | The LastRestartSlot sysvar contains the slot number of the last restart or 0 (zero) if none ever happened.+lastRestartSlot :: SolanaPublicKey+lastRestartSlot = "SysvarLastRestartS1ot1111111111111111111111"
+ test-integration/Main.hs view
@@ -0,0 +1,62 @@+-- 'sequentialTestGroup' (used below) is deprecated as of tasty-1.5.4 in+-- favor of 'dependentTestGroup', which has the same signature but only+-- exists since 1.5.4 -- newer than this project's declared @tasty ^>=1.5@+-- lower bound. Using the deprecated name keeps the suite building against+-- the whole declared range instead of silently requiring 1.5.4+; suppressed+-- here rather than left as a stray warning.+{-# OPTIONS_GHC -Wno-deprecations #-}++module Main (main) where++import Control.Exception (SomeException, try)+import Network.Solana.RPC.HTTP.Chain (getHealth)+import Network.Web3.Provider (Provider (HttpProvider), runWeb3')+import System.Environment (lookupEnv)+import System.Exit (exitSuccess)+import System.IO (BufferMode (LineBuffering), hSetBuffering, stdout)+import System.Timeout (timeout)+import Test.Integration.Alt qualified as Alt+import Test.Integration.Nonce qualified as Nonce+import Test.Integration.PriorityFee qualified as PriorityFee+import Test.Integration.Setup (rpcUrl)+import Test.Integration.Token qualified as Token+import Test.Integration.Transfer qualified as Transfer+import Test.Integration.WebSocket qualified as WebSocket+import Test.Tasty+import Test.Tasty.HUnit++-- | Probes 'rpcUrl' for a healthy validator (3 s timeout) before running the+-- suite. No validator reachable: skip green, unless @SOLANA_INTEGRATION=1@ is+-- set, in which case an unreachable validator is a loud failure instead of a+-- silent skip.+main :: IO ()+main = do+ hSetBuffering stdout LineBuffering+ url <- rpcUrl+ probe <- timeout 3000000 (try @SomeException (runWeb3' (HttpProvider url) getHealth))+ case probe of+ Just (Right (Right "ok")) -> defaultMain integrationTests+ _ -> do+ force <- lookupEnv "SOLANA_INTEGRATION"+ if force == Just "1"+ then defaultMain (testCase "validator reachable" (assertFailure ("SOLANA_INTEGRATION=1 but no healthy validator at " <> url)))+ else do+ putStrLn ("integration-tests: no validator at " <> url <> " - skipping (start solana-test-validator, or set SOLANA_INTEGRATION=1 to require it)")+ exitSuccess++-- | The suite has no @-threaded@/@-N@ RTS options, so 'testGroup' already+-- runs its children one at a time today; 'sequentialTestGroup' makes that a+-- load-bearing property of the test tree itself rather than an accident of+-- the cabal stanza, so the five groups below (each hitting the same local+-- validator with fresh airdrops) can't start running concurrently if+-- @-threaded@ is ever added. 'AllFinish' keeps every group's results visible+-- even if an earlier one fails, matching today's behaviour.+--+-- One consequence of the dependency chain 'sequentialTestGroup' builds:+-- filtering to a single later group (e.g. @Alt@) with tasty's @-p@ pattern+-- option also force-includes every earlier group in that run (tasty's+-- pattern filter keeps whatever a dependency-chained test depends on), so+-- @-p@ no longer isolates just the matched test the way it would under a+-- plain 'testGroup'.+integrationTests :: TestTree+integrationTests = sequentialTestGroup "integration" AllFinish [Transfer.tests, Token.tests, Nonce.tests, PriorityFee.tests, Alt.tests, WebSocket.tests]
+ test-integration/Test/Integration/Alt.hs view
@@ -0,0 +1,63 @@+-- | Live address-lookup-table coverage: create a table, extend it with+-- addresses, decode it back, and send a v0 transaction that resolves its+-- recipient through the table (the fee payer and the System Program id stay+-- static keys -- signers and program ids are never eligible for a lookup).+module Test.Integration.Alt (tests) where++import Control.Exception (throwIO)+import Control.Monad.IO.Class (liftIO)+import Network.Solana.Core.Crypto (createSolanaKeyPair)+import Network.Solana.Core.VersionedMessage (altAddresses, newV0TransactionIntent)+import Network.Solana.NativePrograms.AddressLookupTable (createLookupTable, extendLookupTable)+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.RPC.HTTP.Account (getBalance)+import Network.Solana.RPC.HTTP.Block (getTheLatestBlockhash)+import Network.Solana.RPC.HTTP.Ledger (getSlot)+import Network.Solana.SolanaWeb3 (getLookupTable)+import Network.Web3.Provider (Web3)+import Test.Integration.Setup+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "Alt"+ [testCase "on-chain ALT: create, extend, decode, v0 transfer through the table" (run altV0Flow)]++-- | Creates a lookup table at the current finalized slot (guaranteed present+-- in the SlotHashes sysvar for the on-chain create check), extends it with a+-- recipient and a spare address, waits for the extension to finalize, checks+-- the decoded table holds the extended addresses, then sends a v0+-- transaction that resolves the recipient through the table and checks the+-- transfer lands with the exact amount.+--+-- The v0 send goes through 'sendConfirmedPreflight' rather than a+-- @finalized@-commitment send: an address added to a lookup table in slot+-- @S@ (the extend's landing slot, exposed on-chain as+-- @last_extended_slot@) only resolves in slots strictly greater than @S@.+-- 'confirmFinalized' guarantees the rooted bank has reached @S@, not passed+-- it, so a @finalized@-commitment preflight can simulate against a bank+-- sitting exactly at @S@ -- where the table's active-address count is still+-- zero (it was empty before this extend) -- and reject the send with+-- \"Transaction address table lookup uses an invalid index\", even though+-- the extend is itself finalized and a fresh 'getLookupTable' read shows the+-- addresses. See 'sendConfirmedPreflight' for the full rationale.+altV0Flow :: Web3 ()+altV0Flow = do+ (payerPk, payerSk) <- fundedKeypair 3_000_000_000+ recipient <- fst <$> liftIO createSolanaKeyPair+ extra <- fst <$> liftIO createSolanaKeyPair+ slot <- getSlot+ let (createIx, tablePk) = createLookupTable payerPk payerPk slot+ _ <- sendAndConfirm [payerSk] [createIx]+ extendSig <- sendAndConfirm [payerSk] [extendLookupTable tablePk payerPk (Just payerPk) [recipient, extra]]+ confirmFinalized extendSig+ table <- requireJust "lookup table" =<< getLookupTable tablePk+ liftIO (assertBool "extended addresses present" (recipient `elem` altAddresses table))+ bh <- getTheLatestBlockhash+ tx <- either (liftIO . throwIO) pure (newV0TransactionIntent [payerSk] [SystemProgram.transfer payerPk recipient 200_000_000] [table] bh)+ sig <- sendConfirmedPreflight tx+ confirmFinalized sig+ bal <- getBalance recipient+ liftIO (bal @?= 200_000_000)
+ test-integration/Test/Integration/Nonce.hs view
@@ -0,0 +1,56 @@+-- | Live durable-nonce coverage: create and initialize a nonce account, use+-- it via 'newNonceTransaction' to send a transfer, and check the durable+-- nonce advances and the transfer lands.+module Test.Integration.Nonce (tests) where++import Control.Exception (throwIO)+import Control.Monad.IO.Class (liftIO)+import Network.Solana.Core.Crypto (createSolanaKeyPair)+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.RPC.HTTP.Account (getBalance)+import Network.Solana.RPC.HTTP.Tokenomics (getMinimumBalanceForRentExemption)+import Network.Solana.SolanaWeb3 (getNonceAccount, newNonceTransaction)+import Network.Web3.Provider (Web3)+import Test.Integration.Setup+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "Nonce"+ [testCase "durable-nonce flow: create, use via newNonceTransaction, nonce advances" (run nonceFlow)]++-- | Creates and initializes a nonce account (payer as authority), checks its+-- decoded state before use, sends a transfer through 'newNonceTransaction',+-- and checks the durable nonce advanced and the transfer landed with the+-- exact amount.+--+-- 'newNonceTransaction' reads the nonce account at @confirmed@ commitment+-- internally, but the node preflights its send against the @finalized@+-- bank, so the create transaction is finalized before it is called.+nonceFlow :: Web3 ()+nonceFlow = do+ (payerPk, payerSk) <- fundedKeypair 2_000_000_000+ (noncePk, nonceSk) <- liftIO createSolanaKeyPair+ rent <- getMinimumBalanceForRentExemption 80+ createSig <-+ sendAndConfirm+ [payerSk, nonceSk]+ [ SystemProgram.createAccount payerPk noncePk rent 80 SystemProgram.systemProgramId,+ SystemProgram.initializeNonceAccount noncePk payerPk+ ]+ confirmFinalized createSig -- newNonceTransaction preflights against the finalized bank+ before <- requireJust "nonce account (before)" =<< getNonceAccount noncePk+ nonceBefore <- case before of+ SystemProgram.NonceInitialized auth dn _ -> liftIO (auth @?= payerPk) >> pure dn+ _ -> liftIO (throwIO (userError "nonce account not initialized"))+ recipient <- fst <$> liftIO createSolanaKeyPair+ sig <- newNonceTransaction payerPk [payerSk] noncePk [SystemProgram.transfer payerPk recipient 100_000_000]+ confirmFinalized sig+ afterAcc <- requireJust "nonce account (after)" =<< getNonceAccount noncePk+ case afterAcc of+ SystemProgram.NonceInitialized _ dn _ -> liftIO (assertBool "durable nonce advanced" (dn /= nonceBefore))+ _ -> liftIO (throwIO (userError "nonce account no longer initialized"))+ bal <- getBalance recipient+ liftIO (bal @?= 100_000_000)
+ test-integration/Test/Integration/PriorityFee.hs view
@@ -0,0 +1,52 @@+-- | Live priority-fee coverage: a transfer prioritized with Compute Budget+-- instructions, and a smoke check that 'estimatePriorityFee' returns without+-- throwing.+module Test.Integration.PriorityFee (tests) where++import Control.Monad.IO.Class (liftIO)+import Network.Solana.Core.Crypto (createSolanaKeyPair)+import Network.Solana.NativePrograms.ComputeBudget qualified as ComputeBudget+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.RPC.HTTP.Account (getBalance)+import Network.Solana.SolanaWeb3 (estimatePriorityFee)+import Network.Web3.Provider (Web3)+import Test.Integration.Setup+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "PriorityFee"+ [ testCase "prioritized transfer lands with the exact amount" (run priorityFeeTransfer),+ testCase "estimatePriorityFee smoke: returns without throwing" (run estimateSmoke)+ ]++-- | Sends a transfer prioritized with a compute unit limit and price, and+-- checks the recipient receives exactly the transferred amount.+priorityFeeTransfer :: Web3 ()+priorityFeeTransfer = do+ (payerPk, payerSk) <- fundedKeypair 2_000_000_000+ recipient <- fst <$> liftIO createSolanaKeyPair+ sig <-+ sendAndConfirm+ [payerSk]+ [ ComputeBudget.setComputeUnitLimit 20_000,+ ComputeBudget.setComputeUnitPrice 1_000,+ SystemProgram.transfer payerPk recipient 300_000_000+ ]+ confirmFinalized sig+ bal <- getBalance recipient+ liftIO (bal @?= 300_000_000)++-- | Smoke check only -- queries a fresh random pubkey with no fee history of+-- its own (the address list is just a filter passed to+-- 'Network.Solana.RPC.HTTP.Chain.getRecentPrioritizationFees', not a+-- dependency on 'priorityFeeTransfer'), and the estimate is+-- validator-dependent besides, so this asserts 'estimatePriorityFee' returns+-- without throwing rather than any particular value.+estimateSmoke :: Web3 ()+estimateSmoke = do+ pk <- fst <$> liftIO createSolanaKeyPair+ fee <- estimatePriorityFee [pk] 0.5+ liftIO (fee `seq` pure ())
+ test-integration/Test/Integration/Setup.hs view
@@ -0,0 +1,184 @@+-- | Shared plumbing for the local-validator integration suite.+--+-- Every helper here runs against a real 'Web3' RPC connection (see 'run')+-- rather than fixtures, so tests built on top of this module only pass+-- against a live @solana-test-validator@ (or another reachable cluster).+--+-- Commitment discipline: the node's default commitment is @finalized@, and+-- so is the default preflight commitment used for submitted transactions.+-- 'fundedKeypair' and 'fundedKeypairs' therefore finalize their airdrops+-- before returning (later sends preflight against the finalized bank), and+-- 'sendAndConfirm' (via 'sendConfirmedPreflight') pins preflight at+-- @confirmed@ so multi-step flows can build on merely-confirmed intermediate+-- state. Callers are expected to 'confirmFinalized' the last transaction of+-- a flow before asserting on account state or balances (finalization is+-- monotone by slot, so one wait covers every prior transaction).+module Test.Integration.Setup+ ( rpcUrl,+ wsEndpoint,+ run,+ fundedKeypair,+ fundedKeypairs,+ confirmOrFail,+ confirmFinalized,+ sendAndConfirm,+ sendConfirmedPreflight,+ requireJust,+ )+where++import Control.Concurrent (threadDelay)+import Control.Exception (throwIO)+import Control.Monad.IO.Class (liftIO)+import Data.List (stripPrefix)+import Data.Maybe (fromMaybe)+import Network.Solana.Core.Account (Lamport)+import Network.Solana.Core.Crypto (SolanaPrivateKey, SolanaPublicKey, SolanaSignature, createSolanaKeyPair, toSolanaPublicKey)+import Network.Solana.Core.Instruction (Instruction)+import Network.Solana.Core.Message (newTransactionIntentWithPayer)+import Network.Solana.RPC.HTTP.Account (confirmationStatusTxStatus, errTxStatus, getSignatureStatuses)+import Network.Solana.RPC.HTTP.Block (getTheLatestBlockhash)+import Network.Solana.RPC.HTTP.Transaction (requestAirdrop, sendTransaction')+import Network.Solana.RPC.HTTP.Types (defaultConfigObject, encoding, preflightCommitment)+import Network.Solana.SolanaWeb3 (confirmTransaction)+import Network.Web3.Provider (Provider (HttpProvider), Web3, runWeb3')+import System.Environment (lookupEnv)++-- | The RPC endpoint under test: @SOLANA_RPC_URL@ if set, otherwise the+-- default local validator address.+rpcUrl :: IO String+rpcUrl = fromMaybe "http://127.0.0.1:8899" <$> lookupEnv "SOLANA_RPC_URL"++-- | The PubSub (WebSocket) endpoint matching 'rpcUrl' as host and port.+--+-- Solana nodes serve PubSub on the RPC port plus one -- 8899 becomes 8900 --+-- which is what @solana-test-validator@ does by default.+wsEndpoint :: IO (String, Int)+wsEndpoint = do+ url <- rpcUrl+ let authority = takeWhile (/= '/') (dropScheme url)+ (host, rest) = break (== ':') authority+ pure (host, rpcPort rest + 1)+ where+ dropScheme s+ | Just rest <- stripPrefix "http://" s = rest+ | Just rest <- stripPrefix "https://" s = rest+ | otherwise = s+ rpcPort (':' : digits) | [(p, "")] <- reads digits = p+ rpcPort _ = 8899++-- | Runs a 'Web3' action against 'rpcUrl', throwing a 'userError' describing+-- the underlying 'Network.Web3.Provider.Web3Error' on RPC failure.+run :: Web3 a -> IO a+run action = do+ url <- rpcUrl+ result <- runWeb3' (HttpProvider url) action+ either (throwIO . userError . ("web3 error: " <>) . show) pure result++-- | Generates a fresh random keypair and airdrops it the given amount,+-- waiting for the airdrop to reach @finalized@ commitment before returning.+--+-- Later sends preflight against the finalized bank, so funds must be+-- finalized before the first spend.+fundedKeypair :: Lamport -> Web3 (SolanaPublicKey, SolanaPrivateKey)+fundedKeypair amount = do+ (pk, sk) <- liftIO createSolanaKeyPair+ sig <- requestAirdrop pk amount+ confirmFinalized sig+ pure (pk, sk)++-- | Generates fresh random keypairs and airdrops each the corresponding+-- amount. Airdrops are all requested before any is finalized, so the waits+-- for each signature overlap instead of running back-to-back.+fundedKeypairs :: [Lamport] -> Web3 [(SolanaPublicKey, SolanaPrivateKey)]+fundedKeypairs amounts = do+ pairs <- liftIO (mapM (const createSolanaKeyPair) amounts)+ sigs <- mapM (\(amount, (pk, _)) -> requestAirdrop pk amount) (zip amounts pairs)+ mapM_ confirmFinalized sigs+ pure pairs++-- | Confirms the given signature with 'confirmTransaction' (reaches+-- @confirmed@ or @finalized@ with no on-chain error), throwing a 'userError'+-- naming the given label and the signature if it does not.+--+-- 'confirmTransaction' returns 'False' both when the signature never reaches+-- the target commitment (e.g. it times out) and when it lands but fails+-- on-chain; on failure this re-reads 'getSignatureStatuses' to tell the two+-- apart, including the on-chain error in the message when there is one+-- (mirroring 'confirmFinalized').+confirmOrFail :: String -> SolanaSignature -> Web3 ()+confirmOrFail what sig = do+ ok <- confirmTransaction sig+ if ok+ then pure ()+ else do+ statuses <- getSignatureStatuses [sig]+ case statuses of+ [Just s] | Just err <- errTxStatus s ->+ liftIO . throwIO . userError $ what <> " failed on-chain: " <> show sig <> ": " <> show err+ _ -> liftIO . throwIO . userError $ what <> " failed to confirm: " <> show sig++-- | Polls 'getSignatureStatuses' once a second, up to 60 times, until the+-- given signature reaches @finalized@ status.+--+-- Throws a 'userError' if the transaction finalizes with an on-chain error,+-- or if it does not finalize within the poll budget (naming the signature in+-- both cases).+confirmFinalized :: SolanaSignature -> Web3 ()+confirmFinalized sig = go (60 :: Int)+ where+ go 0 = liftIO . throwIO . userError $ "confirmFinalized: timed out waiting for finalization of " <> show sig+ go n = do+ statuses <- getSignatureStatuses [sig]+ case statuses of+ [Just s] | confirmationStatusTxStatus s == Just "finalized" ->+ case errTxStatus s of+ Nothing -> pure ()+ Just err -> liftIO . throwIO . userError $ "confirmFinalized: " <> show sig <> " failed on-chain: " <> show err+ _ -> liftIO (threadDelay 1000000) >> go (n - 1)++-- | Sends an already-encoded transaction with preflight pinned at+-- @confirmed@ -- the suite's one commitment override, single-sourced here so+-- every caller that must build/sign its own transaction (e.g. a v0 send+-- referencing an address lookup table, which 'sendAndConfirm' can't compile)+-- shares the same discipline instead of repeating the config literal.+--+-- @confirmed@ multi-step flows build on merely-confirmed state; the node's+-- default preflight at @finalized@ would reject them. This also matters for+-- v0 sends specifically: an address added to a lookup table in slot @S@ only+-- resolves in a bank at a slot strictly greater than @S@ (see+-- 'Network.Solana.Core.VersionedMessage.compileV0Message'), and a+-- @finalized@-commitment preflight can simulate against a bank sitting+-- exactly at @S@ even after the extending transaction is itself finalized,+-- rejecting the send with \"Transaction address table lookup uses an+-- invalid index\". @confirmed@ preflight is not a general fix for that+-- invariant (see 'Network.Solana.Core.VersionedMessage.compileV0Message');+-- it only works for this suite's flows because every caller of this+-- function that touches a lookup table (e.g. 'Test.Integration.Alt') first+-- 'confirmFinalized's the extend, which by then puts the confirmed bank+-- many slots past @S@.+sendConfirmedPreflight :: String -> Web3 SolanaSignature+sendConfirmedPreflight tx = sendTransaction' tx (defaultConfigObject {encoding = Just "base64", preflightCommitment = Just "confirmed"})++-- | Compiles the given signers and instructions with+-- 'newTransactionIntentWithPayer', naming the first signer as the fee payer+-- (forced writable regardless of what the given instructions themselves+-- declare -- plain 'newTransactionIntent' derives writability from the+-- instructions alone, which leaves the sole signer of an authority-only+-- instruction such as 'Network.Solana.SplPrograms.Token.mintTo' or+-- 'Network.Solana.SplPrograms.Token.transferChecked' non-writable, and every+-- Solana transaction requires its fee payer to be writable). Sends the+-- result with 'sendConfirmedPreflight', and confirms it with 'confirmOrFail'.+sendAndConfirm :: [SolanaPrivateKey] -> [Instruction] -> Web3 SolanaSignature+sendAndConfirm [] _ = liftIO (throwIO (userError "sendAndConfirm: no signers given"))+sendAndConfirm signers@(feePayer : _) ixs = do+ bh <- getTheLatestBlockhash+ tx <- either (liftIO . throwIO) pure (newTransactionIntentWithPayer (toSolanaPublicKey feePayer) signers ixs bh)+ sig <- sendConfirmedPreflight tx+ confirmOrFail "transaction" sig+ pure sig++-- | Unwraps a 'Just', throwing a 'userError' naming the given label if it is+-- 'Nothing'.+requireJust :: String -> Maybe a -> Web3 a+requireJust what = maybe (liftIO (throwIO (userError (what <> ": expected Just")))) pure
+ test-integration/Test/Integration/Token.hs view
@@ -0,0 +1,53 @@+-- | Live SPL token lifecycle coverage: create a mint, derive both parties'+-- associated token accounts, mint the initial supply, transfer part of it,+-- and check the decoded mint and token account state matches.+module Test.Integration.Token (tests) where++import Control.Monad.IO.Class (liftIO)+import Network.Solana.Core.Crypto (createSolanaKeyPair)+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.RPC.HTTP.Tokenomics (getMinimumBalanceForRentExemption)+import Network.Solana.SolanaWeb3 (getMint, getTokenAccount)+import Network.Solana.SplPrograms.AssociatedTokenAccount qualified as ATA+import Network.Solana.SplPrograms.Token qualified as Token+import Network.Web3.Provider (Web3)+import Test.Integration.Setup+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "Token"+ [testCase "mint -> ATAs -> mintTo -> transferChecked, decoded state matches" (run tokenLifecycle)]++-- | Creates a mint (payer as mint authority, no freeze authority), derives+-- the associated token accounts for the payer and a second wallet, mints+-- the initial supply into the payer's ATA, transfers part of it to the+-- second wallet's ATA, and checks the decoded mint and both token accounts+-- reflect the expected supply, decimals, authority, balances, and owners.+tokenLifecycle :: Web3 ()+tokenLifecycle = do+ (payerPk, payerSk) <- fundedKeypair 3_000_000_000+ (mintPk, mintSk) <- liftIO createSolanaKeyPair+ walletB <- fst <$> liftIO createSolanaKeyPair+ mintRent <- getMinimumBalanceForRentExemption 82+ _ <-+ sendAndConfirm+ [payerSk, mintSk]+ [ SystemProgram.createAccount payerPk mintPk mintRent 82 Token.tokenProgramId,+ Token.initializeMint2 mintPk 6 payerPk Nothing+ ]+ ataA <- requireJust "ATA A derivation" (ATA.getAssociatedTokenAddress payerPk mintPk)+ ataB <- requireJust "ATA B derivation" (ATA.getAssociatedTokenAddress walletB mintPk)+ _ <- sendAndConfirm [payerSk] [ATA.createAssociatedTokenAccount payerPk payerPk mintPk]+ _ <- sendAndConfirm [payerSk] [Token.mintTo mintPk ataA payerPk [] 1_000_000]+ _ <- sendAndConfirm [payerSk] [ATA.createAssociatedTokenAccount payerPk walletB mintPk]+ lastSig <- sendAndConfirm [payerSk] [Token.transferChecked ataA mintPk ataB payerPk [] 250_000 6]+ confirmFinalized lastSig+ mint <- requireJust "mint" =<< getMint mintPk+ liftIO ((Token.mSupply mint @?= 1_000_000) >> (Token.mDecimals mint @?= 6) >> (Token.mMintAuthority mint @?= Just payerPk))+ accA <- requireJust "token account A" =<< getTokenAccount ataA+ liftIO ((Token.taAmount accA @?= 750_000) >> (Token.taMint accA @?= mintPk) >> (Token.taOwner accA @?= payerPk))+ accB <- requireJust "token account B" =<< getTokenAccount ataB+ liftIO ((Token.taAmount accB @?= 250_000) >> (Token.taOwner accB @?= walletB))
+ test-integration/Test/Integration/Transfer.hs view
@@ -0,0 +1,72 @@+-- | Live SOL transfer coverage: a plain transfer from a freshly airdropped+-- payer, and a sponsored transfer where the fee payer and the transfer's+-- signer are different accounts.+module Test.Integration.Transfer (tests) where++import Control.Exception (throwIO)+import Control.Monad (void)+import Control.Monad.IO.Class (liftIO)+import Network.Solana.Core.Crypto (createSolanaKeyPair)+import Network.Solana.Core.Message (newTransactionIntentWithPayer)+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.RPC.HTTP.Account (getBalance)+import Network.Solana.RPC.HTTP.Block (getTheLatestBlockhash)+import Network.Solana.RPC.HTTP.Chain (getVersion)+import Network.Solana.RPC.HTTP.Transaction (sendTransaction)+import Network.Solana.SolanaWeb3 (newTransaction)+import Network.Web3.Provider (Web3)+import Test.Integration.Setup+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "Transfer"+ [ testCase "getVersion answers" (run (void getVersion)),+ testCase "airdropped SOL transfer lands with the exact amount" (run basicTransfer),+ testCase "sponsored transfer: sponsor pays the fee, signer order is free" (run sponsoredTransfer)+ ]++-- | Airdrops a payer, sends it through 'newTransaction' (which builds its+-- own blockhash and derives the fee payer from signer order), and checks the+-- recipient receives exactly the transferred amount. Live-covers+-- 'newTransaction' with every dependency (airdrop, blockhash, confirmation)+-- finalized.+basicTransfer :: Web3 ()+basicTransfer = do+ (payerPk, payerSk) <- fundedKeypair 2_000_000_000+ recipient <- fst <$> liftIO createSolanaKeyPair+ sig <- newTransaction [payerSk] [SystemProgram.transfer payerPk recipient 1_000_000_000]+ confirmFinalized sig+ bal <- getBalance recipient+ liftIO (bal @?= 1_000_000_000)++-- | A sponsor pays the fee for a transfer sent by another funded account, with+-- the private keys deliberately passed in the wrong order to+-- 'newTransactionIntentWithPayer' -- its auto-ordering must still produce a+-- valid transaction. Checks that the recipient and sender balances reflect+-- only the transfer amount (the sender pays no fee) and that the sponsor's+-- balance dropped by more than the transfer (it paid the fee).+sponsoredTransfer :: Web3 ()+sponsoredTransfer = do+ pairs <- fundedKeypairs [2_000_000_000, 1_000_000_000]+ ((sponsorPk, sponsorSk), (senderPk, senderSk)) <- case pairs of+ [a, b] -> pure (a, b)+ _ -> liftIO (throwIO (userError "expected two keypairs"))+ recipient <- fst <$> liftIO createSolanaKeyPair+ bh <- getTheLatestBlockhash+ -- signers deliberately in the WRONG order: auto-ordering must fix it+ tx <-+ either+ (liftIO . throwIO)+ pure+ (newTransactionIntentWithPayer sponsorPk [senderSk, sponsorSk] [SystemProgram.transfer senderPk recipient 500_000_000] bh)+ sig <- sendTransaction tx+ confirmFinalized sig+ recipientBal <- getBalance recipient+ liftIO (recipientBal @?= 500_000_000)+ senderBal <- getBalance senderPk+ liftIO (senderBal @?= 500_000_000) -- sender paid NO fee: exactly the transfer left+ sponsorBal <- getBalance sponsorPk+ liftIO (assertBool "sponsor paid the fee" (sponsorBal < 2_000_000_000))
+ test-integration/Test/Integration/WebSocket.hs view
@@ -0,0 +1,66 @@+-- | Live PubSub coverage: confirm a real transaction by subscribing to its+-- signature over a WebSocket instead of polling for its status.+--+-- This is also the worked example of wiring+-- 'Network.Solana.RPC.WebSocket.WsTransport' to the @websockets@ package,+-- which the SDK deliberately does not depend on (see that module's header).+module Test.Integration.WebSocket (tests) where++import Control.Exception (throwIO)+import Control.Monad.IO.Class (liftIO)+import Network.Solana.Core.Crypto (SolanaPublicKey, SolanaSignature, createSolanaKeyPair)+import Network.Solana.Core.Message (newTransactionIntentWithPayer)+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.RPC.HTTP.Account (getBalance)+import Network.Solana.RPC.HTTP.Block (getTheLatestBlockhash)+import Network.Solana.RPC.WebSocket+import Network.Web3.Provider (Web3)+import Network.WebSockets qualified as WS+import Test.Integration.Setup+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "WebSocket"+ [testCase "signature subscription pushes the confirmation" wsConfirmFlow]++-- | Submits a transfer, then waits for its confirmation over the PubSub+-- endpoint rather than polling.+--+-- The transaction is sent first and subscribed to immediately afterwards, at+-- @finalized@ commitment: finalization takes on the order of ten seconds even+-- on a local validator, so the subscription is established far in advance of+-- the notification it is waiting for.+wsConfirmFlow :: IO ()+wsConfirmFlow = do+ (recipient, sig) <- run submitTransfer+ (host, port) <- wsEndpoint+ result <-+ WS.runClient host port "/" $ \conn ->+ let transport = WsTransport (WS.sendTextData conn) (WS.receiveData conn)+ in awaitSignature transport (RequestId 1) (Just "finalized") 90 sig+ slot <- either assertFailure' pure result+ assertBool "confirmation reports a real slot" (slot > 0)+ balance <- run (getBalance recipient)+ balance @?= 400_000_000++-- | Airdrops a payer and sends it a transfer, returning the recipient and the+-- submitted signature without waiting for confirmation -- that is what the+-- subscription is for.+submitTransfer :: Web3 (SolanaPublicKey, SolanaSignature)+submitTransfer = do+ (payerPk, payerSk) <- fundedKeypair 2_000_000_000+ recipient <- fst <$> liftIO createSolanaKeyPair+ bh <- getTheLatestBlockhash+ tx <-+ either+ (liftIO . throwIO)+ pure+ (newTransactionIntentWithPayer payerPk [payerSk] [SystemProgram.transfer payerPk recipient 400_000_000] bh)+ sig <- sendConfirmedPreflight tx+ pure (recipient, sig)++assertFailure' :: String -> IO a+assertFailure' = assertFailure
+ test/Main.hs view
@@ -0,0 +1,57 @@+module Main (main) where++import Test.Core.Account qualified+import Test.Core.Block qualified+import Test.Core.Borsh qualified+import Test.Core.Compact qualified+import Test.Core.Crypto qualified+import Test.Core.Instruction qualified+import Test.Core.Message qualified+import Test.Core.Pda qualified+import Test.Core.VersionedMessage qualified+import Test.Metaplex.TokenMetadata qualified+import Test.NativePrograms.AddressLookupTable qualified+import Test.NativePrograms.BpfLoaderUpgradeable qualified+import Test.NativePrograms.ComputeBudget qualified+import Test.NativePrograms.Secp256k1 qualified+import Test.NativePrograms.Stake qualified+import Test.NativePrograms.SystemProgram qualified+import Test.NativePrograms.Vote qualified+import Test.RPC.Chain qualified+import Test.RPC.Parsers qualified+import Test.RPC.WebSocket qualified+import Test.SplPrograms.AssociatedTokenAccount qualified+import Test.SplPrograms.Memo qualified+import Test.SplPrograms.Token qualified+import Test.Tasty++main :: IO ()+main =+ defaultMain+ ( testGroup+ "solana-haskell-sdk"+ [ Test.Core.Account.tests,+ Test.Core.Block.tests,+ Test.Core.Borsh.tests,+ Test.Core.Compact.tests,+ Test.Core.Crypto.tests,+ Test.Core.Instruction.tests,+ Test.Core.Message.tests,+ Test.Core.Pda.tests,+ Test.Core.VersionedMessage.tests,+ Test.Metaplex.TokenMetadata.tests,+ Test.NativePrograms.AddressLookupTable.tests,+ Test.NativePrograms.BpfLoaderUpgradeable.tests,+ Test.NativePrograms.ComputeBudget.tests,+ Test.NativePrograms.Secp256k1.tests,+ Test.NativePrograms.Stake.tests,+ Test.NativePrograms.SystemProgram.tests,+ Test.NativePrograms.Vote.tests,+ Test.RPC.Chain.tests,+ Test.RPC.Parsers.tests,+ Test.RPC.WebSocket.tests,+ Test.SplPrograms.AssociatedTokenAccount.tests,+ Test.SplPrograms.Memo.tests,+ Test.SplPrograms.Token.tests+ ]+ )
+ test/Test/Core/Account.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Core.Account (tests) where++import Data.Aeson (eitherDecode)+import Network.Solana.Core.Account+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "account"+ [ testCase "AccountData FromJSON rejects an unsupported encoding tag" $+ case eitherDecode "[\"abcd\",\"unknownEncoding\"]" :: Either String AccountData of+ Left _ -> pure ()+ Right ad -> assertFailure ("expected parse failure, got " <> show ad),+ testCase "AccountData FromJSON rejects invalid base58 in a base58-tagged pair" $+ case eitherDecode "[\"0OIl\",\"base58\"]" :: Either String AccountData of+ Left _ -> pure ()+ Right ad -> assertFailure ("expected parse failure, got " <> show ad)+ ]
+ test/Test/Core/Block.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Core.Block (tests) where++import Data.Aeson (eitherDecode)+import Data.Binary (decode, encode)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy.Char8 qualified as LC8+import Network.Solana.Core.Block+import Network.Solana.Core.Crypto (toBase58String)+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "block"+ [ testCase "BlockHash FromJSON rejects invalid base58" $+ case eitherDecode "\"0OIl\"" :: Either String BlockHash of+ Left _ -> pure ()+ Right bh -> assertFailure ("expected parse failure, got " <> show bh),+ testCase "BlockHash FromJSON rejects valid base58 of the wrong length" $+ let wrongLengthBase58 = toBase58String (BS.replicate 5 7)+ json = LC8.pack (show wrongLengthBase58)+ in case eitherDecode json :: Either String BlockHash of+ Left _ -> pure ()+ Right bh -> assertFailure ("expected parse failure, got " <> show bh),+ testCase "BlockHash Binary round-trip (32-byte hash)" $+ let bh = BlockHash (BS.replicate 32 7)+ in decode (encode bh) @?= bh+ ]
+ test/Test/Core/Borsh.hs view
@@ -0,0 +1,146 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Core.Borsh (tests) where++import Data.Binary.Get (runGetOrFail)+import Data.Binary.Put (runPut)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.Maybe (isNothing)+import Network.Solana.Core.Borsh+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck as QC++tests :: TestTree+tests =+ testGroup+ "borsh"+ [ testGroup+ "string"+ [ testCase "putBorshString produces u32-prefixed UTF-8" $+ let bs = BL.toStrict (runPut (putBorshString "ab"))+ expected = BS.pack [0x02, 0x00, 0x00, 0x00, 0x61, 0x62]+ in bs @?= expected,+ testCase "putBorshString counts UTF-8 bytes, not characters" $+ -- "é" is 1 character but 2 UTF-8 bytes (0xC3 0xA9); the u32 prefix+ -- must be the byte length (2), not the char count (1).+ let bs = BL.toStrict (runPut (putBorshString "é"))+ expected = BS.pack [0x02, 0x00, 0x00, 0x00, 0xC3, 0xA9]+ in bs @?= expected,+ testCase "getBorshString decodes u32-prefixed UTF-8" $+ let bs = BS.pack [0x02, 0x00, 0x00, 0x00, 0x61, 0x62]+ in case runGetOrFail getBorshString (BL.fromStrict bs) of+ Right (_, _, s) -> s @?= "ab"+ Left (_, _, err) -> assertFailure $ "getBorshString failed: " <> err,+ testCase "getBorshString fails on invalid UTF-8" $+ let bs = BS.pack [0x02, 0x00, 0x00, 0x00, 0xFF, 0xFE]+ in case runGetOrFail getBorshString (BL.fromStrict bs) of+ Right (_, _, _) -> assertFailure "expected UTF-8 decode failure"+ Left _ -> pure (),+ QC.testProperty "string round-trip (ASCII)" $ \s ->+ let printable = filter (\c -> c >= ' ' && c <= '~') s+ bs = BL.toStrict (runPut (putBorshString printable))+ in case runGetOrFail getBorshString (BL.fromStrict bs) of+ Right (_, _, decoded) -> decoded == printable+ Left _ -> False+ ],+ testGroup+ "option"+ [ testCase "putBorshOption Nothing produces tag 0" $+ let bs = BL.toStrict (runPut (putBorshOption putBorshString Nothing))+ in bs @?= BS.pack [0x00],+ testCase "putBorshOption Just encodes tag 1 + value" $+ let bs = BL.toStrict (runPut (putBorshOption putBorshString (Just "a")))+ -- Tag 1, then string "a": length 1 (u32 LE = 0x01 0x00 0x00 0x00), then 0x61 (a)+ expected = BS.pack [0x01, 0x01, 0x00, 0x00, 0x00, 0x61]+ in bs @?= expected,+ testCase "getBorshOption decodes Nothing (tag 0)" $+ let bs = BS.pack [0x00]+ in case runGetOrFail (getBorshOption getBorshString) (BL.fromStrict bs) of+ Right (_, _, opt) -> opt @?= Nothing+ Left (_, _, err) -> assertFailure $ "getBorshOption failed: " <> err,+ testCase "getBorshOption decodes Just (tag 1)" $+ let bs = BS.pack [0x01, 0x01, 0x00, 0x00, 0x00, 0x61]+ in case runGetOrFail (getBorshOption getBorshString) (BL.fromStrict bs) of+ Right (_, _, opt) -> opt @?= Just "a"+ Left (_, _, err) -> assertFailure $ "getBorshOption failed: " <> err,+ testCase "getBorshOption fails on invalid tag (>1)" $+ let bs = BS.pack [0x02]+ in case runGetOrFail (getBorshOption getBorshString) (BL.fromStrict bs) of+ Right (_, _, _) -> assertFailure "expected tag validation failure"+ Left _ -> pure (),+ QC.testProperty "option round-trip (Nothing)" $+ let bs = BL.toStrict (runPut (putBorshOption putBorshString (Nothing :: Maybe String)))+ in case runGetOrFail (getBorshOption getBorshString) (BL.fromStrict bs) of+ Right (_, _, opt) -> isNothing opt+ Left _ -> False,+ QC.testProperty "option round-trip (Just)" $ \s ->+ let printable = filter (\c -> c >= ' ' && c <= '~') s+ bs = BL.toStrict (runPut (putBorshOption putBorshString (Just printable)))+ in case runGetOrFail (getBorshOption getBorshString) (BL.fromStrict bs) of+ Right (_, _, opt) -> opt == Just printable+ Left _ -> False+ ],+ testGroup+ "vec"+ [ testCase "putBorshVec empty produces count 0" $+ let bs = BL.toStrict (runPut (putBorshVec putBorshBool []))+ in bs @?= BS.pack [0x00, 0x00, 0x00, 0x00],+ testCase "putBorshVec encodes u32 count + elements" $+ let bs = BL.toStrict (runPut (putBorshVec putBorshBool [True, False]))+ -- Count 2 (u32 LE = 0x02 0x00 0x00 0x00), then True (0x01), False (0x00)+ expected = BS.pack [0x02, 0x00, 0x00, 0x00, 0x01, 0x00]+ in bs @?= expected,+ testCase "getBorshVec decodes empty list" $+ let bs = BS.pack [0x00, 0x00, 0x00, 0x00]+ in case runGetOrFail (getBorshVec getBorshBool) (BL.fromStrict bs) of+ Right (_, _, xs) -> xs @?= []+ Left (_, _, err) -> assertFailure $ "getBorshVec failed: " <> err,+ testCase "getBorshVec decodes count + elements" $+ let bs = BS.pack [0x02, 0x00, 0x00, 0x00, 0x01, 0x00]+ in case runGetOrFail (getBorshVec getBorshBool) (BL.fromStrict bs) of+ Right (_, _, xs) -> xs @?= [True, False]+ Left (_, _, err) -> assertFailure $ "getBorshVec failed: " <> err,+ QC.testProperty "vec round-trip (bools)" $ \bs ->+ let truncated = take 10 bs -- small list for reasonable test+ putVec = runPut (putBorshVec putBorshBool truncated)+ in case runGetOrFail (getBorshVec getBorshBool) putVec of+ Right (_, _, decoded) -> decoded == truncated+ Left _ -> False+ ],+ testGroup+ "bool"+ [ testCase "putBorshBool False produces 0x00" $+ let bs = BL.toStrict (runPut (putBorshBool False))+ in bs @?= BS.pack [0x00],+ testCase "putBorshBool True produces 0x01" $+ let bs = BL.toStrict (runPut (putBorshBool True))+ in bs @?= BS.pack [0x01],+ testCase "getBorshBool decodes False (0x00)" $+ let bs = BS.pack [0x00]+ in case runGetOrFail getBorshBool (BL.fromStrict bs) of+ Right (_, _, b) -> b @?= False+ Left (_, _, err) -> assertFailure $ "getBorshBool failed: " <> err,+ testCase "getBorshBool decodes True (0x01)" $+ let bs = BS.pack [0x01]+ in case runGetOrFail getBorshBool (BL.fromStrict bs) of+ Right (_, _, b) -> b @?= True+ Left (_, _, err) -> assertFailure $ "getBorshBool failed: " <> err,+ testCase "getBorshBool fails on invalid byte (2)" $+ let bs = BS.pack [0x02]+ in case runGetOrFail getBorshBool (BL.fromStrict bs) of+ Right (_, _, _) -> assertFailure "expected bool validation failure"+ Left _ -> pure (),+ testCase "getBorshBool fails on invalid byte (255)" $+ let bs = BS.pack [0xFF]+ in case runGetOrFail getBorshBool (BL.fromStrict bs) of+ Right (_, _, _) -> assertFailure "expected bool validation failure"+ Left _ -> pure (),+ QC.testProperty "bool round-trip" $ \b ->+ let bs = BL.toStrict (runPut (putBorshBool b))+ in case runGetOrFail getBorshBool (BL.fromStrict bs) of+ Right (_, _, decoded) -> decoded == b+ Left _ -> False+ ]+ ]
+ test/Test/Core/Compact.hs view
@@ -0,0 +1,44 @@+module Test.Core.Compact (tests) where++import Data.Binary (decode, encode)+import Data.ByteString.Lazy qualified as BL+import Data.Word (Word8)+import Network.Solana.Core.Compact+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++tests :: TestTree+tests =+ testGroup+ "compact-u16"+ [ testCase "known encodings" $ do+ BL.unpack (encodeCompactU16 0) @?= [0x00]+ BL.unpack (encodeCompactU16 1) @?= [0x01]+ BL.unpack (encodeCompactU16 127) @?= [0x7f]+ BL.unpack (encodeCompactU16 128) @?= [0x80, 0x01]+ BL.unpack (encodeCompactU16 16383) @?= [0xff, 0x7f]+ BL.unpack (encodeCompactU16 16384) @?= [0x80, 0x80, 0x01]+ BL.unpack (encodeCompactU16 65535) @?= [0xff, 0xff, 0x03],+ testProperty "decode . encode == id" $ \w ->+ decodeCompactU16 (encodeCompactU16 w) === Right w,+ testProperty "encoded length matches value range" $ \w ->+ let len = fromIntegral (BL.length (encodeCompactU16 w)) :: Int+ in if w < 0x80+ then len === 1+ else+ if w < 0x4000+ then len === 2+ else len === 3,+ testCase "rejects overlong encoding" $+ assertLeft (decodeCompactU16 (BL.pack [0x80, 0x80, 0x80, 0x01])),+ testCase "rejects aliased encoding" $+ assertLeft (decodeCompactU16 (BL.pack [0x80, 0x00])),+ testProperty "CompactArray Binary decode . encode == id" $+ forAll (resize 500 (listOf arbitrary)) $ \(xs :: [Word8]) ->+ let ca = mkCompact xs in decode (encode ca) === ca+ ]++assertLeft :: (Show b) => Either a b -> Assertion+assertLeft (Left _) = pure ()+assertLeft (Right v) = assertFailure ("expected decode failure, got " <> show v)
+ test/Test/Core/Crypto.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Core.Crypto (tests) where++import Data.Aeson (eitherDecode)+import Data.Binary (decode, encode)+import Data.ByteString qualified as BS+import Network.Solana.Core.Crypto+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++newtype Bytes32 = Bytes32 BS.ByteString+ deriving (Show)++instance Arbitrary Bytes32 where+ arbitrary = Bytes32 . BS.pack <$> vectorOf 32 arbitrary++tests :: TestTree+tests =+ testGroup+ "crypto"+ [ testProperty "base58 round-trip" $ \(Bytes32 bs) ->+ fromBase58String (toBase58String bs) === Just bs,+ testProperty "base64 round-trip" $ \(Bytes32 bs) ->+ fromBase64String (toBase64String bs) === bs,+ testProperty "public key Binary round-trip" $ \(Bytes32 bs) ->+ let pk = unsafeSolanaPublicKeyRaw (BS.unpack bs)+ in decode (encode pk) === pk,+ testCase "signature Binary round-trip (64 bytes)" $ do+ Just (_, priv) <- pure (createSolanaKeypairFromSeed (BS.replicate 32 1))+ let sig = dsign priv "solana-haskell-sdk"+ decode (encode sig) @?= sig,+ testCase "private key Base58 round-trip (64-byte NaCl secret key)" $ do+ (_, priv) <- createSolanaKeyPair+ case mkPrivateKeyFromString (show priv) of+ Left err -> assertFailure ("mkPrivateKeyFromString failed on a genuine keypair: " <> err)+ Right priv' -> do+ show priv' @?= show priv+ dsign priv' "solana-haskell-sdk" @?= dsign priv "solana-haskell-sdk",+ testCase "SolanaPublicKey FromJSON rejects invalid base58" $+ case eitherDecode "\"0OIl\"" :: Either String SolanaPublicKey of+ Left _ -> pure ()+ Right pk -> assertFailure ("expected parse failure, got " <> show pk),+ testCase "SolanaSignature FromJSON rejects invalid base58" $+ case eitherDecode "\"0OIl\"" :: Either String SolanaSignature of+ Left _ -> pure ()+ Right sig -> assertFailure ("expected parse failure, got " <> show sig)+ ]
+ test/Test/Core/Instruction.hs view
@@ -0,0 +1,28 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Core.Instruction (tests) where++import Data.Aeson (eitherDecode)+import Network.Solana.Core.Crypto (SolanaPublicKey, unsafeSolanaPublicKeyRaw)+import Network.Solana.Core.Instruction+import Test.Tasty+import Test.Tasty.HUnit++progPk, accPk :: SolanaPublicKey+progPk = unsafeSolanaPublicKeyRaw (replicate 32 11)+accPk = unsafeSolanaPublicKeyRaw (replicate 32 12)++tests :: TestTree+tests =+ testGroup+ "instruction"+ [ testCase "mkInstruction keeps exactly the given account metas" $ do+ let meta = AccountMeta {accountPubKey = accPk, isSigner = True, isWritable = True}+ ix = mkInstruction progPk [meta] ()+ iAccounts ix @?= [meta]+ iProgramId ix @?= progPk,+ testCase "CompiledInstruction FromJSON rejects invalid base58 data" $+ case eitherDecode "{\"programIdIndex\":0,\"accounts\":[0,1],\"data\":\"0OIl\"}" :: Either String CompiledInstruction of+ Left _ -> pure ()+ Right _ -> assertFailure "expected parse failure on invalid base58"+ ]
+ test/Test/Core/Message.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Core.Message (tests) where++import Data.ByteString qualified as BS+import Data.List (isInfixOf, nub)+import Data.Map.Strict qualified as Map+import Data.Maybe (fromMaybe)+import Data.Set qualified as Set+import Network.Solana.Core.Block (BlockHash (..))+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction+import Network.Solana.Core.Message+import Network.Solana.NativePrograms.ComputeBudget qualified as CB+import Network.Solana.NativePrograms.Stake qualified as Stake+import Network.Solana.NativePrograms.SystemProgram qualified as SP+import Network.Solana.SplPrograms.AssociatedTokenAccount qualified as Ata+import Network.Solana.SplPrograms.Memo qualified as Memo+import Network.Solana.SplPrograms.Token qualified as Tok+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++fixedBlockhash :: BlockHash+fixedBlockhash = BlockHash (BS.replicate 32 9)++recipientPk :: SolanaPublicKey+recipientPk = unsafeSolanaPublicKeyRaw (replicate 32 2)++ownerPk :: SolanaPublicKey+ownerPk = unsafeSolanaPublicKeyRaw (replicate 32 5)++votePk' :: SolanaPublicKey+votePk' = unsafeSolanaPublicKeyRaw (replicate 32 17)++custodianPk' :: SolanaPublicKey+custodianPk' = unsafeSolanaPublicKeyRaw (replicate 32 18)++payerKeys :: (SolanaPublicKey, SolanaPrivateKey)+payerKeys =+ case createSolanaKeypairFromSeed (BS.replicate 32 1) of+ Just kp -> kp+ Nothing -> error "failed to derive payer keypair from seed"++newAccountKeys :: (SolanaPublicKey, SolanaPrivateKey)+newAccountKeys =+ case createSolanaKeypairFromSeed (BS.replicate 32 10) of+ Just kp -> kp+ Nothing -> error "failed to derive new-account keypair from seed"++extraKeys :: (SolanaPublicKey, SolanaPrivateKey)+extraKeys =+ case createSolanaKeypairFromSeed (BS.replicate 32 40) of+ Just kp -> kp+ Nothing -> error "failed to derive extra keypair from seed"++keyPool :: [SolanaPublicKey]+keyPool = [unsafeSolanaPublicKeyRaw (replicate 32 b) | b <- [10 .. 15]]++genInstruction :: Gen Instruction+genInstruction = do+ progId <- elements keyPool+ n <- chooseInt (1, 4)+ metas <- vectorOf n genMeta+ pure (mkInstruction progId metas ())+ where+ genMeta = do+ k <- elements keyPool+ s <- arbitrary+ w <- arbitrary+ pure AccountMeta {accountPubKey = k, isSigner = s, isWritable = w}++expectedPrivileges :: [Instruction] -> Map.Map SolanaPublicKey (Bool, Bool)+expectedPrivileges instrs = Map.fromListWith merge (concatMap entries instrs)+ where+ merge (s1, w1) (s2, w2) = (s1 || s2, w1 || w2)+ entries i =+ (iProgramId i, (False, False))+ : [(accountPubKey m, (isSigner m, isWritable m)) | m <- iAccounts i]++prop_messageInvariants :: Property+prop_messageInvariants =+ forAll (resize 5 (listOf1 genInstruction)) $ \instrs ->+ let msg = mkNewMessage fixedBlockhash instrs+ keys = mAccountKeys msg+ privs = expectedPrivileges instrs+ hdr = mHeader msg+ nrs = fromIntegral (numRequiredSignatures hdr)+ nros = fromIntegral (numReadonlySignedAccounts hdr)+ nrou = fromIntegral (numReadonlyUnsignedAccounts hdr)+ (signed, unsigned) = splitAt nrs keys+ (sw, sr) = splitAt (nrs - nros) signed+ (uw, ur) = splitAt (length unsigned - nrou) unsigned+ signerOf k = maybe False fst (Map.lookup k privs)+ writableOf k = maybe False snd (Map.lookup k privs)+ in conjoin+ [ counterexample "duplicate keys" (keys === nub keys),+ counterexample "key set mismatch" (Map.keysSet privs === Set.fromList keys),+ counterexample "non-signer in signed section" (property (all signerOf signed)),+ counterexample "signer in unsigned section" (property (not (any signerOf unsigned))),+ counterexample "readonly key in writable section" (property (all writableOf (sw <> uw))),+ counterexample "writable key in readonly section" (property (not (any writableOf (sr <> ur))))+ ]++tests :: TestTree+tests =+ testGroup+ "message and transaction (golden)"+ [ testCase "payer pubkey from seed matches Rust" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ getSolanaPublicKeyRaw (fst payerKeys) @?= requireFixture "payer-pubkey" fs,+ testCase "single transfer message bytes match Rust" $ do+ fs <- loadFixtures "test/fixtures/messages.json"+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ case newMessage fixedBlockhash [ix] of+ Left err -> assertFailure (show err)+ Right bytes -> bytes @?= requireFixture "transfer-message" fs,+ testCase "signed transfer transaction matches Rust" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ case newTransactionIntent [snd payerKeys] [ix] fixedBlockhash of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "transfer-transaction" fs),+ testCase "transfer + allocate message bytes match Rust" $ do+ fs <- loadFixtures "test/fixtures/messages.json"+ let transferIx = SP.transfer (fst payerKeys) recipientPk 1000000000+ allocateIx = SP.allocate (fst payerKeys) 200+ case newMessage fixedBlockhash [transferIx, allocateIx] of+ Left err -> assertFailure (show err)+ Right bytes -> bytes @?= requireFixture "transfer-allocate-message" fs,+ testCase "priority-fee transaction matches Rust" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ let ixs =+ [ CB.setComputeUnitLimit 200000,+ CB.setComputeUnitPrice 1000,+ SP.transfer (fst payerKeys) recipientPk 1000000000,+ Memo.buildMemo "hello-memo" [fst payerKeys]+ ]+ case newTransactionIntent [snd payerKeys] ixs fixedBlockhash of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "priority-transfer-transaction" fs),+ testCase "new-account pubkey from seed matches Rust" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ getSolanaPublicKeyRaw (fst newAccountKeys) @?= requireFixture "new-account-pubkey" fs,+ testCase "two-signer create-account transaction matches Rust (payer pinned, not sorted)" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ let ix = SP.createAccount (fst payerKeys) (fst newAccountKeys) 1000000 165 ownerPk+ case newTransactionIntent [snd payerKeys, snd newAccountKeys] [ix] fixedBlockhash of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "two-signer-create-transaction" fs),+ testCase "ATA create + transferChecked transaction matches Rust" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ let mintPk = unsafeSolanaPublicKeyRaw (replicate 32 12)+ walletPk = unsafeSolanaPublicKeyRaw (replicate 32 11)+ payerPk = fst payerKeys+ srcAta = fromMaybe (error "no src ata") (Ata.getAssociatedTokenAddress payerPk mintPk)+ dstAta = fromMaybe (error "no dst ata") (Ata.getAssociatedTokenAddress walletPk mintPk)+ ixs =+ [ Ata.createAssociatedTokenAccountIdempotent payerPk walletPk mintPk,+ Tok.transferChecked srcAta mintPk dstAta payerPk [] 1000000 6+ ]+ case newTransactionIntent [snd payerKeys] ixs fixedBlockhash of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "ata-transfer-transaction" fs),+ testCase "stake setup transaction matches Rust" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ let stakePk = fst newAccountKeys+ authorized = Stake.Authorized {Stake.aStaker = fst payerKeys, Stake.aWithdrawer = fst payerKeys}+ lockup = Stake.Lockup {Stake.lUnixTimestamp = 1700000000, Stake.lEpoch = 300, Stake.lCustodian = custodianPk'}+ ixs =+ [ SP.createAccount (fst payerKeys) stakePk 1000000 200 Stake.stakeProgramId,+ Stake.initialize stakePk authorized lockup,+ Stake.delegateStake stakePk (fst payerKeys) votePk'+ ]+ case newTransactionIntent [snd payerKeys, snd newAccountKeys] ixs fixedBlockhash of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "stake-setup-transaction" fs),+ testCase "sponsored transfer via explicit fee payer matches Rust (signers in wrong order)" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ case newTransactionIntentWithPayer (fst newAccountKeys) [snd payerKeys, snd newAccountKeys] [ix] fixedBlockhash of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "sponsored-transfer-transaction" fs),+ testCase "sponsored transfer via explicit fee payer matches Rust (signers in message order)" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ case newTransactionIntentWithPayer (fst newAccountKeys) [snd newAccountKeys, snd payerKeys] [ix] fixedBlockhash of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "sponsored-transfer-transaction" fs),+ testCase "two-signer create-account via explicit fee payer matches Rust (signers permuted)" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ let ix = SP.createAccount (fst payerKeys) (fst newAccountKeys) 1000000 165 ownerPk+ case newTransactionIntentWithPayer (fst payerKeys) [snd newAccountKeys, snd payerKeys] [ix] fixedBlockhash of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "two-signer-create-transaction" fs),+ testCase "explicit fee payer: missing signer key is reported" $ do+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ case newTransactionIntentWithPayer (fst newAccountKeys) [snd payerKeys] [ix] fixedBlockhash of+ Right _ -> assertFailure "expected Left for missing signer"+ Left (MissingIndex msg) -> assertBool ("expected \"missing signer\" in: " <> msg) ("missing signer" `isInfixOf` msg),+ testCase "explicit fee payer: unused signing key is reported" $ do+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ case newTransactionIntentWithPayer (fst newAccountKeys) [snd payerKeys, snd newAccountKeys, snd extraKeys] [ix] fixedBlockhash of+ Right _ -> assertFailure "expected Left for unused signing key"+ Left (MissingIndex msg) -> assertBool ("expected \"unused signing key\" in: " <> msg) ("unused signing key" `isInfixOf` msg),+ testCase "durable-nonce transfer transaction matches Rust" $ do+ txFs <- loadFixtures "test/fixtures/transactions.json"+ stateFs <- loadFixtures "test/fixtures/state_fixtures.json"+ let noncePk = unsafeSolanaPublicKeyRaw (replicate 32 37)+ durableNonceBh = BlockHash (requireFixture "nonce-durable-hash" stateFs)+ ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ case newDurableNonceTransactionIntent [snd payerKeys] noncePk (fst payerKeys) [ix] durableNonceBh of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "nonce-transfer-transaction" txFs),+ testCase "durable-nonce transfer via explicit fee payer matches Rust (payer == authority)" $ do+ txFs <- loadFixtures "test/fixtures/transactions.json"+ stateFs <- loadFixtures "test/fixtures/state_fixtures.json"+ let noncePk = unsafeSolanaPublicKeyRaw (replicate 32 37)+ durableNonceBh = BlockHash (requireFixture "nonce-durable-hash" stateFs)+ ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ case newDurableNonceTransactionIntentWithPayer (fst payerKeys) [snd payerKeys] noncePk (fst payerKeys) [ix] durableNonceBh of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "nonce-transfer-transaction" txFs),+ testCase "durable-nonce-only message via explicit fee payer seeds payer as writable signer" $ do+ stateFs <- loadFixtures "test/fixtures/state_fixtures.json"+ let noncePk = unsafeSolanaPublicKeyRaw (replicate 32 37)+ durableNonceBh = BlockHash (requireFixture "nonce-durable-hash" stateFs)+ sponsorPk = fst newAccountKeys+ sponsorPriv = snd newAccountKeys+ authorityPk = fst payerKeys+ authorityPriv = snd payerKeys+ case newDurableNonceTransactionIntentWithPayer sponsorPk [sponsorPriv, authorityPriv] noncePk authorityPk [] durableNonceBh of+ Left err -> assertFailure (show err)+ Right b64 -> BS.head (fromBase64String b64) @?= 2,+ testProperty "message header/key-ordering invariants" prop_messageInvariants+ ]
+ test/Test/Core/Pda.hs view
@@ -0,0 +1,36 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Core.Pda (tests) where++import Data.ByteString qualified as BS+import Data.Either (isLeft)+import Network.Solana.Core.Crypto (SolanaPublicKey, getSolanaPublicKeyRaw, unsafeSolanaPublicKey)+import Network.Solana.Core.Pda+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++tokenProgram :: SolanaPublicKey+tokenProgram = unsafeSolanaPublicKey "TokenkegQfeZyiNwAJbNbGKPFXCWuBvf9Ss623VQ5DA"++tests :: TestTree+tests =+ withResource (loadFixtures "test/fixtures/pda.json") (const (pure ())) $ \getFixtures ->+ testGroup+ "PDA derivation"+ [ testCase "findProgramAddress matches Rust (address and bump)" $ do+ fs <- getFixtures+ case findProgramAddress ["solana-haskell-sdk/1"] tokenProgram of+ Nothing -> assertFailure "no PDA found"+ Just (addr, bump) -> do+ getSolanaPublicKeyRaw addr @?= requireFixture "generic-pda-address" fs+ BS.singleton bump @?= requireFixture "generic-pda-bump" fs,+ testCase "seed longer than 32 bytes is rejected" $+ assertBool "expected Left" (isLeft (createProgramAddress [BS.replicate 33 0] tokenProgram)),+ testProperty "createProgramAddress never returns an on-curve address" $+ forAll (BS.pack <$> vectorOf 8 arbitrary) $ \seed ->+ case createProgramAddress [seed, "bump"] tokenProgram of+ Left _ -> property True+ Right addr -> property (getSolanaPublicKeyRaw addr /= BS.replicate 32 0)+ ]
+ test/Test/Core/VersionedMessage.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Core.VersionedMessage (tests) where++import Data.ByteString qualified as BS+import Data.List (isInfixOf)+import Network.Solana.Core.Block (BlockHash (..))+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction (AccountMeta (..), CompileException (..), mkInstruction)+import Network.Solana.Core.VersionedMessage+import Network.Solana.NativePrograms.AddressLookupTable qualified as ALT+import Network.Solana.NativePrograms.SystemProgram qualified as SP+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit++fixedBlockhash :: BlockHash+fixedBlockhash = BlockHash (BS.replicate 32 9)++payerKeys :: (SolanaPublicKey, SolanaPrivateKey)+payerKeys =+ case createSolanaKeypairFromSeed (BS.replicate 32 1) of+ Just kp -> kp+ Nothing -> error "failed to derive payer keypair from seed"++recipientPk :: SolanaPublicKey+recipientPk = unsafeSolanaPublicKeyRaw (replicate 32 2)++addr29 :: SolanaPublicKey+addr29 = unsafeSolanaPublicKeyRaw (replicate 32 29)++addr30 :: SolanaPublicKey+addr30 = unsafeSolanaPublicKeyRaw (replicate 32 30)++tableKey :: SolanaPublicKey+tableKey = unsafeSolanaPublicKeyRaw (replicate 32 31)++unrelatedKey :: SolanaPublicKey+unrelatedKey = unsafeSolanaPublicKeyRaw (replicate 32 99)++otherTableKey :: SolanaPublicKey+otherTableKey = unsafeSolanaPublicKeyRaw (replicate 32 33)++dummyProgramId :: SolanaPublicKey+dummyProgramId = unsafeSolanaPublicKeyRaw (replicate 32 40)++keyK :: SolanaPublicKey+keyK = unsafeSolanaPublicKeyRaw (replicate 32 41)++fillerKey :: SolanaPublicKey+fillerKey = unsafeSolanaPublicKeyRaw (replicate 32 50)++lookupTable :: AddressLookupTableAccount+lookupTable = AddressLookupTableAccount tableKey [recipientPk, addr29, addr30]++tests :: TestTree+tests =+ testGroup+ "v0 message compilation (golden + behavior)"+ [ testCase "v0 message bytes match Rust" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ let ixs =+ [ SP.transfer (fst payerKeys) recipientPk 1000000000,+ SP.transfer (fst payerKeys) addr29 500000+ ]+ case compileV0Message fixedBlockhash ixs [lookupTable] of+ Left err -> assertFailure (show err)+ Right bytes -> bytes @?= requireFixture "v0-message" fs,+ testCase "v0 signed transaction matches Rust" $ do+ fs <- loadFixtures "test/fixtures/transactions.json"+ let ixs =+ [ SP.transfer (fst payerKeys) recipientPk 1000000000,+ SP.transfer (fst payerKeys) addr29 500000+ ]+ case newV0TransactionIntent [snd payerKeys] ixs [lookupTable] fixedBlockhash of+ Left err -> assertFailure (show err)+ Right b64 -> b64 @?= toBase64String (requireFixture "v0-transfer-transaction" fs),+ testCase "table containing only the program id yields no lookups" $ do+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ table = AddressLookupTableAccount tableKey [SP.systemProgramId]+ assertSameCompile+ (compileV0Message fixedBlockhash [ix] [table])+ (compileV0Message fixedBlockhash [ix] []),+ testCase "table containing the fee payer (a signer) yields no lookups" $ do+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ table = AddressLookupTableAccount tableKey [fst payerKeys]+ assertSameCompile+ (compileV0Message fixedBlockhash [ix] [table])+ (compileV0Message fixedBlockhash [ix] []),+ testCase "table with no keys used by the instructions yields no lookups" $ do+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ table = AddressLookupTableAccount tableKey [unrelatedKey]+ assertSameCompile+ (compileV0Message fixedBlockhash [ix] [table])+ (compileV0Message fixedBlockhash [ix] []),+ testCase "a key readonly in one instruction and writable in another drains as writable" $ do+ let payerPk = fst payerKeys+ ixReadonly =+ mkInstruction+ dummyProgramId+ [AccountMeta payerPk True True, AccountMeta keyK False False]+ ()+ ixWritable =+ mkInstruction+ dummyProgramId+ [AccountMeta payerPk True True, AccountMeta keyK False True]+ ()+ table = AddressLookupTableAccount tableKey [keyK]+ assertSameCompile+ (compileV0Message fixedBlockhash [ixReadonly, ixWritable] [table])+ (compileV0Message fixedBlockhash [ixWritable, ixWritable] [table]),+ testCase "the first table containing a key wins over a later one" $ do+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ table1 = AddressLookupTableAccount tableKey [recipientPk]+ table2 = AddressLookupTableAccount otherTableKey [recipientPk]+ assertSameCompile+ (compileV0Message fixedBlockhash [ix] [table1, table2])+ (compileV0Message fixedBlockhash [ix] [table1]),+ testCase "a lookup index beyond byte range fails to compile" $ do+ let ix = SP.transfer (fst payerKeys) recipientPk 1000000000+ -- 256 filler addresses (indexes 0..255) push recipientPk to+ -- index 256, one past what a Word8 lookup index can hold.+ oversizedTable = AddressLookupTableAccount tableKey (replicate 256 fillerKey <> [recipientPk])+ case compileV0Message fixedBlockhash [ix] [oversizedTable] of+ Left (MissingIndex msg) -> assertBool ("expected an \"overflow\" message, got: " <> msg) ("overflow" `isInfixOf` msg)+ Right _ -> assertFailure "expected an oversized lookup table to fail compilation",+ testCase "decoded lookup table state feeds v0 compilation end-to-end (bridge)" $ do+ stateFs <- loadFixtures "test/fixtures/state_fixtures.json"+ txFs <- loadFixtures "test/fixtures/transactions.json"+ case ALT.decodeLookupTable (requireFixture "lookup-table" stateFs) of+ Left err -> assertFailure ("decode failed: " <> err)+ Right lts -> do+ let table = ALT.lookupTableToAccount tableKey lts+ ixs =+ [ SP.transfer (fst payerKeys) recipientPk 1000000000,+ SP.transfer (fst payerKeys) addr29 500000+ ]+ case compileV0Message fixedBlockhash ixs [table] of+ Left err -> assertFailure (show err)+ Right bytes -> bytes @?= requireFixture "v0-message" txFs+ ]++-- | Compare two compile results by their message bytes ('CompileException'+-- has no 'Eq' instance to compare), failing loudly if either side failed.+assertSameCompile :: Either CompileException BS.ByteString -> Either CompileException BS.ByteString -> Assertion+assertSameCompile lhs rhs = case (lhs, rhs) of+ (Right l, Right r) -> l @?= r+ (Left err, _) -> assertFailure ("left side failed: " <> show err)+ (_, Left err) -> assertFailure ("right side failed: " <> show err)
+ test/Test/Fixtures.hs view
@@ -0,0 +1,66 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Fixtures+ ( Fixture (..),+ loadFixtures,+ requireFixture,+ RpcFixture (..),+ loadRpcFixtures,+ requireRpcResult,+ )+where++import Data.Aeson+import Data.Aeson.Types (parseEither)+import Data.ByteString qualified as BS+import Data.ByteString.Base16 qualified as B16+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE++data Fixture = Fixture+ { fixtureName :: String,+ fixtureHex :: T.Text+ }+ deriving (Show)++instance FromJSON Fixture where+ parseJSON = withObject "Fixture" $ \v ->+ Fixture <$> v .: "name" <*> v .: "hex"++loadFixtures :: FilePath -> IO [Fixture]+loadFixtures path = either fail pure =<< eitherDecodeFileStrict path++requireFixture :: String -> [Fixture] -> BS.ByteString+requireFixture name fs =+ case filter ((== name) . fixtureName) fs of+ [f] -> either (error . badHex) id (B16.decode (TE.encodeUtf8 (fixtureHex f)))+ _ -> error ("fixture not found (or duplicated): " <> name)+ where+ badHex err = "bad hex in fixture " <> name <> ": " <> err++-- | One recorded JSON-RPC exchange: the whole response envelope a real node+-- returned, as captured by @tools/rpc-record/record.py@.+data RpcFixture = RpcFixture+ { rpcFixtureName :: String,+ rpcFixtureMethod :: String,+ rpcFixtureResponse :: Value+ }+ deriving (Show)++instance FromJSON RpcFixture where+ parseJSON = withObject "RpcFixture" $ \v ->+ RpcFixture <$> v .: "name" <*> v .: "method" <*> v .: "response"++loadRpcFixtures :: FilePath -> IO [RpcFixture]+loadRpcFixtures path = either fail pure =<< eitherDecodeFileStrict path++-- | The @result@ payload of a recorded response -- what the SDK's parsers+-- actually receive, the JSON-RPC envelope having been stripped by the+-- transport.+requireRpcResult :: String -> [RpcFixture] -> Value+requireRpcResult name fs =+ case filter ((== name) . rpcFixtureName) fs of+ [f] -> either (error . badResult) id (parseEither (withObject "response" (.: "result")) (rpcFixtureResponse f))+ _ -> error ("rpc fixture not found (or duplicated): " <> name)+ where+ badResult err = "no result in rpc fixture " <> name <> ": " <> err
+ test/Test/Metaplex/TokenMetadata.hs view
@@ -0,0 +1,301 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Metaplex.TokenMetadata (tests) where++import Data.Aeson (FromJSON (..), Value, eitherDecodeFileStrict, withObject, (.:))+import Data.Aeson.Types (parseMaybe)+import Data.Binary (decode, decodeOrFail, encode)+import Data.Binary.Get (ByteOffset)+import Data.ByteString qualified as BS+import Data.ByteString.Base16 qualified as B16+import Data.ByteString.Lazy qualified as BL+import Data.List (find, isInfixOf)+import Data.Maybe (mapMaybe)+import Data.Text qualified as T+import Data.Text.Encoding qualified as TE+import Network.Solana.Core.Crypto (SolanaPublicKey, createSolanaKeypairFromSeed, getSolanaPublicKeyRaw, unsafeSolanaPublicKeyRaw)+import Network.Solana.Core.Instruction (AccountMeta (..), iAccounts)+import Network.Solana.Metaplex.TokenMetadata qualified as TM+import Network.Solana.NativePrograms.SystemProgram qualified as SystemProgram+import Network.Solana.SplPrograms.Token qualified as Token+import Network.Solana.Sysvar qualified as Sysvar+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++-- Fixed constants (ratified in Task 1 against the mpl-token-metadata crate).++mintPk :: SolanaPublicKey+mintPk = unsafeSolanaPublicKeyRaw (replicate 32 12)++payerPk :: SolanaPublicKey+payerPk =+ case createSolanaKeypairFromSeed (BS.replicate 32 1) of+ Just (pk, _) -> pk+ Nothing -> error "failed to derive payer"++secondCreatorPk :: SolanaPublicKey+secondCreatorPk = unsafeSolanaPublicKeyRaw (replicate 32 33)++collectionKeyPk :: SolanaPublicKey+collectionKeyPk = unsafeSolanaPublicKeyRaw (replicate 32 34)++dataV2Full :: TM.DataV2+dataV2Full =+ TM.DataV2+ { TM.dName = "Solana Haskell NFT",+ TM.dSymbol = "SHSDK",+ TM.dUri = "https://example.com/nft.json",+ TM.dSellerFeeBasisPoints = 550,+ TM.dCreators = Just [TM.Creator payerPk True 60, TM.Creator secondCreatorPk False 40],+ TM.dCollection = Just (TM.Collection False collectionKeyPk),+ TM.dUses = Just (TM.Uses TM.Multiple 10 10)+ }++dataV2Minimal :: TM.DataV2+dataV2Minimal =+ TM.DataV2+ { TM.dName = "Solana Haskell NFT",+ TM.dSymbol = "SHSDK",+ TM.dUri = "https://example.com/nft.json",+ TM.dSellerFeeBasisPoints = 550,+ TM.dCreators = Nothing,+ TM.dCollection = Nothing,+ TM.dUses = Nothing+ }++-- metadata_instruction_data.json mixes two shapes in one array: six+-- {name, hex} entries (the golden vectors) and one {name, accounts} entry+-- (create-v3-full-accounts). Test.Fixtures.loadFixtures decodes the whole+-- file as [Fixture], which requires every element to carry a "hex" field, so+-- it can't be used directly here. Load the file as [Value] instead and pick+-- out each shape locally, without extending the shared loader.++-- | Like 'loadFixtures', but tolerant of the extra {name, accounts} entry:+-- elements that don't parse as a {name, hex} 'Fixture' are simply skipped.+loadDataFixtures :: FilePath -> IO [Fixture]+loadDataFixtures path = do+ vals <- either fail pure =<< eitherDecodeFileStrict path+ pure (mapMaybe (parseMaybe parseJSON) (vals :: [Value]))++-- Local decode of the `create-v3-full-accounts` entry (ground truth for the+-- createMetadataAccountV3 meta test).++data FixtureAccountMeta = FixtureAccountMeta T.Text Bool Bool++instance FromJSON FixtureAccountMeta where+ parseJSON = withObject "FixtureAccountMeta" $ \v ->+ FixtureAccountMeta <$> v .: "pubkey" <*> v .: "signer" <*> v .: "writable"++data AccountsFixture = AccountsFixture+ { afName :: String,+ afAccounts :: [FixtureAccountMeta]+ }++instance FromJSON AccountsFixture where+ parseJSON = withObject "AccountsFixture" $ \v ->+ AccountsFixture <$> v .: "name" <*> v .: "accounts"++loadCreateV3FullAccounts :: FilePath -> IO [AccountMeta]+loadCreateV3FullAccounts path = do+ vals <- either fail pure =<< eitherDecodeFileStrict path+ case find ((== "create-v3-full-accounts") . afName) (mapMaybe (parseMaybe parseJSON) (vals :: [Value])) of+ Just af -> pure (map toAccountMeta (afAccounts af))+ Nothing -> fail "create-v3-full-accounts entry not found"+ where+ toAccountMeta (FixtureAccountMeta hexPubkey signer writable) =+ AccountMeta+ { accountPubKey = unsafeSolanaPublicKeyRaw (BS.unpack (decodeHex hexPubkey)),+ isSigner = signer,+ isWritable = writable+ }+ decodeHex hexPubkey = either (error . ("bad hex in create-v3-full-accounts: " <>)) id (B16.decode (TE.encodeUtf8 hexPubkey))++-- Small QuickCheck generators covering every support type and instruction+-- variant, for the round-trip property below.++genPk :: Gen SolanaPublicKey+genPk = unsafeSolanaPublicKeyRaw <$> vectorOf 32 arbitrary++genAsciiString :: Gen String+genAsciiString = listOf (elements ['a' .. 'z'])++genUseMethod :: Gen TM.UseMethod+genUseMethod = elements [TM.Burn, TM.Multiple, TM.Single]++genCreator :: Gen TM.Creator+genCreator = TM.Creator <$> genPk <*> arbitrary <*> arbitrary++genCollection :: Gen TM.Collection+genCollection = TM.Collection <$> arbitrary <*> genPk++genUses :: Gen TM.Uses+genUses = TM.Uses <$> genUseMethod <*> arbitrary <*> arbitrary++genCollectionDetails :: Gen TM.CollectionDetails+genCollectionDetails = TM.CollectionDetailsV1 <$> arbitrary++genMaybe :: Gen a -> Gen (Maybe a)+genMaybe g = oneof [pure Nothing, Just <$> g]++genDataV2 :: Gen TM.DataV2+genDataV2 =+ TM.DataV2+ <$> genAsciiString+ <*> genAsciiString+ <*> genAsciiString+ <*> arbitrary+ <*> genMaybe (resize 3 (listOf genCreator))+ <*> genMaybe genCollection+ <*> genMaybe genUses++genTokenMetadataInstruction :: Gen TM.TokenMetadataInstruction+genTokenMetadataInstruction =+ oneof+ [ TM.CreateMetadataAccountV3 <$> genDataV2 <*> arbitrary <*> genMaybe genCollectionDetails,+ TM.UpdateMetadataAccountV2+ <$> genMaybe genDataV2+ <*> genMaybe genPk+ <*> genMaybe arbitrary+ <*> genMaybe arbitrary,+ TM.CreateMasterEditionV3 <$> genMaybe arbitrary+ ]++enc :: TM.TokenMetadataInstruction -> BS.ByteString+enc = BL.toStrict . encode++tests :: TestTree+tests =+ withResource (loadDataFixtures "test/fixtures/metadata_instruction_data.json") (const (pure ())) $ \getFixtures ->+ withResource (loadFixtures "test/fixtures/pda.json") (const (pure ())) $ \getPdaFixtures ->+ withResource (loadCreateV3FullAccounts "test/fixtures/metadata_instruction_data.json") (const (pure ())) $ \getCreateV3Accounts ->+ withResource (loadFixtures "test/fixtures/state_fixtures.json") (const (pure ())) $ \getStateFixtures ->+ testGroup+ "Metaplex Token Metadata"+ [ testGroup+ "Metadata account state (golden + rejection)"+ [ testCase "decodeMetadata: metadata-account golden (full tail)" $ do+ fs <- getStateFixtures+ let bs = requireFixture "metadata-account" fs+ case TM.decodeMetadata bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right md -> do+ TM.mdKey md @?= 4+ TM.mdUpdateAuthority md @?= payerPk+ TM.mdMint md @?= mintPk+ TM.mdName md @?= "Solana Haskell NFT"+ TM.mdSymbol md @?= "SHSDK"+ TM.mdUri md @?= "https://example.com/nft.json"+ TM.mdSellerFeeBasisPoints md @?= 550+ TM.mdCreators md @?= Just [TM.Creator payerPk True 60, TM.Creator secondCreatorPk False 40]+ TM.mdPrimarySaleHappened md @?= False+ TM.mdIsMutable md @?= True+ TM.mdEditionNonce md @?= Just 253+ TM.mdTokenStandard md @?= Just 0+ TM.mdCollection md @?= Just (TM.Collection False collectionKeyPk)+ TM.mdUses md @?= Just (TM.Uses TM.Multiple 10 10),+ testCase "decodeMetadata: metadata-account-legacy golden (empty tail)" $ do+ fs <- getStateFixtures+ let bs = requireFixture "metadata-account-legacy" fs+ case TM.decodeMetadata bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right md -> do+ TM.mdKey md @?= 4+ TM.mdUpdateAuthority md @?= payerPk+ TM.mdMint md @?= mintPk+ TM.mdName md @?= "Solana Haskell NFT"+ TM.mdSymbol md @?= "SHSDK"+ TM.mdUri md @?= "https://example.com/nft.json"+ TM.mdSellerFeeBasisPoints md @?= 550+ TM.mdCreators md @?= Just [TM.Creator payerPk True 60, TM.Creator secondCreatorPk False 40]+ TM.mdPrimarySaleHappened md @?= False+ TM.mdIsMutable md @?= True+ TM.mdEditionNonce md @?= Nothing+ TM.mdTokenStandard md @?= Nothing+ TM.mdCollection md @?= Nothing+ TM.mdUses md @?= Nothing,+ testCase "decodeMetadata: rejects empty bytes" $+ case TM.decodeMetadata BS.empty of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for empty bytes",+ testCase "decodeMetadata: rejects truncated mid-pubkey (40 bytes)" $+ case TM.decodeMetadata (BS.replicate 40 0) of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for 40 bytes",+ testCase "decodeMetadata: rejects bad discriminator (key byte != 4)" $ do+ fs <- getStateFixtures+ let bs = requireFixture "metadata-account" fs+ let corrupted = BS.cons 5 (BS.drop 1 bs)+ case TM.decodeMetadata corrupted of+ Left err -> assertBool "error message includes 'unexpected account key'" $+ "unexpected account key" `isInfixOf` err+ Right _ -> assertFailure "expected decode failure for bad discriminator"+ ],+ testGroup+ "PDA derivation"+ [ testCase "deriveMetadataAddress matches fixture" $ do+ fs <- getPdaFixtures+ case TM.deriveMetadataAddress mintPk of+ Nothing -> assertFailure "no metadata PDA found"+ Just addr -> getSolanaPublicKeyRaw addr @?= requireFixture "metadata-address" fs,+ testCase "deriveMasterEditionAddress matches fixture" $ do+ fs <- getPdaFixtures+ case TM.deriveMasterEditionAddress mintPk of+ Nothing -> assertFailure "no master edition PDA found"+ Just addr -> getSolanaPublicKeyRaw addr @?= requireFixture "master-edition-address" fs+ ],+ testGroup+ "instruction data (golden)"+ [ goldenCase getFixtures "CreateMetadataAccountV3-full" (TM.CreateMetadataAccountV3 dataV2Full True (Just (TM.CollectionDetailsV1 0))),+ goldenCase getFixtures "CreateMetadataAccountV3-minimal" (TM.CreateMetadataAccountV3 dataV2Minimal True Nothing),+ goldenCase getFixtures "UpdateMetadataAccountV2-some" (TM.UpdateMetadataAccountV2 (Just dataV2Full) (Just payerPk) (Just True) (Just True)),+ goldenCase getFixtures "UpdateMetadataAccountV2-none" (TM.UpdateMetadataAccountV2 Nothing Nothing Nothing Nothing),+ goldenCase getFixtures "CreateMasterEditionV3-some" (TM.CreateMasterEditionV3 (Just 100)),+ goldenCase getFixtures "CreateMasterEditionV3-none" (TM.CreateMasterEditionV3 Nothing)+ ],+ testGroup+ "properties"+ [ testProperty "Binary round-trip" $+ forAll genTokenMetadataInstruction $ \i -> decode (encode i) === i,+ testCase "decode fails on unknown discriminant" $+ case decodeOrFail (BL.pack [200]) :: Either (BL.ByteString, ByteOffset, String) (BL.ByteString, ByteOffset, TM.TokenMetadataInstruction) of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for discriminant 200"+ ],+ testGroup+ "builder metas"+ [ testCase "createMetadataAccountV3 matches create-v3-full-accounts fixture" $ do+ expected <- getCreateV3Accounts+ iAccounts (TM.createMetadataAccountV3 mintPk payerPk payerPk payerPk True dataV2Full True (Just (TM.CollectionDetailsV1 0)))+ @?= expected,+ testCase "updateMetadataAccountV2 metas" $+ case TM.deriveMetadataAddress mintPk of+ Nothing -> assertFailure "no metadata PDA found"+ Just metadataAddr ->+ iAccounts (TM.updateMetadataAccountV2 mintPk payerPk Nothing Nothing Nothing Nothing)+ @?= [ AccountMeta {accountPubKey = metadataAddr, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = payerPk, isSigner = True, isWritable = False}+ ],+ testCase "createMasterEditionV3 metas" $+ case (TM.deriveMasterEditionAddress mintPk, TM.deriveMetadataAddress mintPk) of+ (Just editionAddr, Just metadataAddr) ->+ iAccounts (TM.createMasterEditionV3 mintPk payerPk payerPk payerPk (Just 100))+ @?= [ AccountMeta {accountPubKey = editionAddr, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = mintPk, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = payerPk, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = payerPk, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = payerPk, isSigner = True, isWritable = True},+ AccountMeta {accountPubKey = metadataAddr, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Token.tokenProgramId, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = SystemProgram.systemProgramId, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.rent, isSigner = False, isWritable = False}+ ]+ _ -> assertFailure "PDA derivation failed"+ ]+ ]+ where+ goldenCase getFixtures name i =+ testCase name $ do+ fs <- getFixtures+ enc i @?= requireFixture name fs
+ test/Test/NativePrograms/AddressLookupTable.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.NativePrograms.AddressLookupTable (tests) where++import Data.Binary (decode, decodeOrFail, encode)+import Data.Binary.Get (ByteOffset)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.Word (Word8)+import Network.Solana.Core.Crypto (SolanaPublicKey, createSolanaKeypairFromSeed, getSolanaPublicKeyRaw, unsafeSolanaPublicKeyRaw)+import Network.Solana.Core.Instruction (AccountMeta (..), iAccounts)+import Network.Solana.Core.VersionedMessage qualified as VM+import Network.Solana.NativePrograms.AddressLookupTable qualified as ALT+import Network.Solana.NativePrograms.SystemProgram qualified as SP+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++payerPk :: SolanaPublicKey+payerPk =+ case createSolanaKeypairFromSeed (BS.replicate 32 1) of+ Just (pk, _) -> pk+ Nothing -> error "failed to derive payer"++tablePk, addrA, addrB, recipientPk, funderPk :: SolanaPublicKey+tablePk = unsafeSolanaPublicKeyRaw (replicate 32 31)+addrA = unsafeSolanaPublicKeyRaw (replicate 32 29)+addrB = unsafeSolanaPublicKeyRaw (replicate 32 30)+recipientPk = unsafeSolanaPublicKeyRaw (replicate 32 22)++-- | Distinct from 'payerPk' (used as the authority) so that a builder+-- accidentally swapping its authority/payer arguments would be caught by+-- the meta tests below.+funderPk = unsafeSolanaPublicKeyRaw (replicate 32 32)++-- | The bump seed for (payerPk, 12345), used to build the CreateLookupTable+-- golden without hard-coding it (it must equal the derivation, which is+-- separately checked against the Rust fixture).+lutBump :: Word8+lutBump =+ case ALT.deriveLookupTableAddress payerPk 12345 of+ Just (_, bump) -> bump+ Nothing -> error "no lookup table PDA found"++enc :: ALT.AddressLookupTableInstruction -> BS.ByteString+enc = BL.toStrict . encode++genAltInstruction :: Gen ALT.AddressLookupTableInstruction+genAltInstruction =+ oneof+ [ ALT.CreateLookupTable <$> arbitrary <*> arbitrary,+ pure ALT.FreezeLookupTable,+ ALT.ExtendLookupTable <$> listOf genPubkey,+ pure ALT.DeactivateLookupTable,+ pure ALT.CloseLookupTable+ ]+ where+ genPubkey = unsafeSolanaPublicKeyRaw <$> vectorOf 32 arbitrary++tests :: TestTree+tests =+ withResource (loadFixtures "test/fixtures/alt_instruction_data.json") (const (pure ())) $ \getFixtures ->+ withResource (loadFixtures "test/fixtures/pda.json") (const (pure ())) $ \getPdaFixtures ->+ withResource (loadFixtures "test/fixtures/state_fixtures.json") (const (pure ())) $ \getStateFixtures ->+ testGroup+ "AddressLookupTable instruction data (golden + properties)"+ [ testCase "decodeLookupTable: lookup-table golden" $ do+ fs <- getStateFixtures+ let bs = requireFixture "lookup-table" fs+ case ALT.decodeLookupTable bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right lts -> do+ ALT.ltDeactivationSlot lts @?= maxBound+ ALT.ltLastExtendedSlot lts @?= 12345+ ALT.ltLastExtendedSlotStartIndex lts @?= 1+ ALT.ltAuthority lts @?= Just payerPk+ ALT.ltAddresses lts+ @?= [ unsafeSolanaPublicKeyRaw (replicate 32 2),+ addrA,+ addrB+ ],+ testCase "lookupTableToAccount builds the VersionedMessage account" $ do+ fs <- getStateFixtures+ let bs = requireFixture "lookup-table" fs+ case ALT.decodeLookupTable bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right lts ->+ ALT.lookupTableToAccount tablePk lts+ @?= VM.AddressLookupTableAccount+ tablePk+ [unsafeSolanaPublicKeyRaw (replicate 32 2), addrA, addrB],+ testCase "decodeLookupTable: rejects 55 bytes (below the fixed meta region)" $ do+ let bs = BS.replicate 55 0+ case ALT.decodeLookupTable bs of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for 55 bytes",+ testCase "decodeLookupTable: rejects an addresses remainder not divisible by 32" $ do+ fs <- getStateFixtures+ let bs = requireFixture "lookup-table" fs <> BS.singleton 0+ case ALT.decodeLookupTable bs of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for a non-multiple-of-32 remainder",+ testCase "decodeLookupTable: rejects uninitialized (discriminant 0)" $ do+ let bs = BS.replicate 56 0+ case ALT.decodeLookupTable bs of+ Left err -> assertBool "error message mentions uninitialized" ("uninitialized" `elem` words err)+ Right _ -> assertFailure "expected decode failure for discriminant 0",+ testCase "decodeLookupTable: decodes None authority" $ do+ let addr7 = unsafeSolanaPublicKeyRaw (replicate 32 7)+ meta =+ BS.pack+ ( [1, 0, 0, 0] -- discriminant = 1 (initialized)+ <> replicate 8 0xff -- deactivationSlot = maxBound (u64 LE)+ <> replicate 8 0 -- lastExtendedSlot = 0 (u64 LE)+ <> [0] -- lastExtendedSlotStartIndex = 0+ <> [0] -- authority option tag = None+ <> replicate 34 0 -- padding to the 56-byte meta boundary+ )+ bs = meta <> getSolanaPublicKeyRaw addr7+ case ALT.decodeLookupTable bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right lts -> do+ ALT.ltAuthority lts @?= Nothing+ ALT.ltAddresses lts @?= [addr7],+ testCase "decodeLookupTable: rejects invalid authority tag" $ do+ let meta =+ BS.pack+ ( [1, 0, 0, 0]+ <> replicate 8 0xff+ <> replicate 8 0+ <> [0]+ <> [2] -- invalid authority option tag+ <> replicate 34 0+ )+ bs = meta <> getSolanaPublicKeyRaw (unsafeSolanaPublicKeyRaw (replicate 32 7))+ case ALT.decodeLookupTable bs of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for invalid authority tag",+ testCase "deriveLookupTableAddress matches Rust (address and bump)" $ do+ fs <- getPdaFixtures+ case ALT.deriveLookupTableAddress payerPk 12345 of+ Nothing -> assertFailure "no lookup table PDA found"+ Just (addr, bump) -> do+ getSolanaPublicKeyRaw addr @?= requireFixture "lookup-table-address" fs+ BS.singleton bump @?= requireFixture "lookup-table-bump" fs,+ goldenCase getFixtures "CreateLookupTable" (ALT.CreateLookupTable 12345 lutBump),+ goldenCase getFixtures "FreezeLookupTable" ALT.FreezeLookupTable,+ goldenCase getFixtures "ExtendLookupTable" (ALT.ExtendLookupTable [addrA, addrB]),+ goldenCase getFixtures "DeactivateLookupTable" ALT.DeactivateLookupTable,+ goldenCase getFixtures "CloseLookupTable" ALT.CloseLookupTable,+ testProperty "Binary round-trip" $+ forAll genAltInstruction $ \ai -> decode (encode ai) === ai,+ testCase "decode fails on unknown discriminant" $+ case decodeOrFail (BL.pack [5, 0, 0, 0]) :: Either (BL.ByteString, ByteOffset, String) (BL.ByteString, ByteOffset, ALT.AddressLookupTableInstruction) of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for discriminant 5",+ testCase "createLookupTable metas (and returned table address)" $ do+ fs <- getPdaFixtures+ let (ix, table) = ALT.createLookupTable payerPk funderPk 12345+ getSolanaPublicKeyRaw table @?= requireFixture "lookup-table-address" fs+ iAccounts ix+ @?= [ AccountMeta table False True,+ AccountMeta payerPk False False,+ AccountMeta funderPk True True,+ AccountMeta SP.systemProgramId False False+ ],+ testCase "freezeLookupTable metas" $+ iAccounts (ALT.freezeLookupTable tablePk payerPk)+ @?= [ AccountMeta tablePk False True,+ AccountMeta payerPk True False+ ],+ testCase "extendLookupTable metas (no payer)" $+ iAccounts (ALT.extendLookupTable tablePk payerPk Nothing [addrA, addrB])+ @?= [ AccountMeta tablePk False True,+ AccountMeta payerPk True False+ ],+ testCase "extendLookupTable metas (with payer)" $+ iAccounts (ALT.extendLookupTable tablePk payerPk (Just funderPk) [addrA, addrB])+ @?= [ AccountMeta tablePk False True,+ AccountMeta payerPk True False,+ AccountMeta funderPk True True,+ AccountMeta SP.systemProgramId False False+ ],+ testCase "deactivateLookupTable metas" $+ iAccounts (ALT.deactivateLookupTable tablePk payerPk)+ @?= [ AccountMeta tablePk False True,+ AccountMeta payerPk True False+ ],+ testCase "closeLookupTable metas" $+ iAccounts (ALT.closeLookupTable tablePk payerPk recipientPk)+ @?= [ AccountMeta tablePk False True,+ AccountMeta payerPk True False,+ AccountMeta recipientPk False True+ ]+ ]+ where+ goldenCase getFixtures name li =+ testCase name $ do+ fs <- getFixtures+ enc li @?= requireFixture name fs
+ test/Test/NativePrograms/BpfLoaderUpgradeable.hs view
@@ -0,0 +1,150 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.NativePrograms.BpfLoaderUpgradeable (tests) where++import Data.Binary (decode, decodeOrFail, encode)+import Data.Binary.Get (ByteOffset)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Network.Solana.Core.Crypto (SolanaPublicKey, createSolanaKeypairFromSeed, getSolanaPublicKeyRaw, unsafeSolanaPublicKeyRaw)+import Network.Solana.Core.Instruction (AccountMeta (..), iAccounts)+import Network.Solana.NativePrograms.BpfLoaderUpgradeable qualified as Loader+import Network.Solana.NativePrograms.SystemProgram qualified as SP+import Network.Solana.Sysvar qualified as Sysvar+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++bufferPk, programPk, spillPk, newAuthPk :: SolanaPublicKey+bufferPk = unsafeSolanaPublicKeyRaw (replicate 32 24)+programPk = unsafeSolanaPublicKeyRaw (replicate 32 23)+spillPk = unsafeSolanaPublicKeyRaw (replicate 32 22)+newAuthPk = unsafeSolanaPublicKeyRaw (replicate 32 20)++programDataPk, recipientPk, authorityPk' :: SolanaPublicKey+programDataPk = unsafeSolanaPublicKeyRaw (replicate 32 25)+recipientPk = unsafeSolanaPublicKeyRaw (replicate 32 26)+authorityPk' = unsafeSolanaPublicKeyRaw (replicate 32 27)++payerPk :: SolanaPublicKey+payerPk =+ case createSolanaKeypairFromSeed (BS.replicate 32 1) of+ Just (pk, _) -> pk+ Nothing -> error "failed to derive payer"++enc :: Loader.UpgradeableLoaderInstruction -> BS.ByteString+enc = BL.toStrict . encode++genLoaderInstruction :: Gen Loader.UpgradeableLoaderInstruction+genLoaderInstruction =+ oneof+ [ pure Loader.InitializeBuffer,+ Loader.Write <$> arbitrary <*> (BS.pack <$> listOf arbitrary),+ Loader.DeployWithMaxDataLen <$> arbitrary,+ pure Loader.Upgrade,+ pure Loader.SetAuthority,+ pure Loader.Close,+ Loader.ExtendProgram <$> arbitrary,+ pure Loader.SetAuthorityChecked+ ]++tests :: TestTree+tests =+ withResource (loadFixtures "test/fixtures/loader_instruction_data.json") (const (pure ())) $ \getFixtures ->+ withResource (loadFixtures "test/fixtures/pda.json") (const (pure ())) $ \getPdaFixtures ->+ testGroup+ "BpfLoaderUpgradeable instruction data (golden + properties)"+ [ goldenCase getFixtures "InitializeBuffer" Loader.InitializeBuffer,+ goldenCase getFixtures "Write" (Loader.Write 128 (BS.replicate 64 0xAB)),+ goldenCase getFixtures "DeployWithMaxDataLen" (Loader.DeployWithMaxDataLen 1048576),+ goldenCase getFixtures "Upgrade" Loader.Upgrade,+ goldenCase getFixtures "SetAuthority" Loader.SetAuthority,+ goldenCase getFixtures "Close" Loader.Close,+ goldenCase getFixtures "ExtendProgram" (Loader.ExtendProgram 4096),+ goldenCase getFixtures "SetAuthorityChecked" Loader.SetAuthorityChecked,+ testProperty "Binary round-trip" $+ forAll genLoaderInstruction $ \li -> decode (encode li) === li,+ testCase "decode fails on unknown discriminant" $+ case decodeOrFail (BL.pack [8, 0, 0, 0]) :: Either (BL.ByteString, ByteOffset, String) (BL.ByteString, ByteOffset, Loader.UpgradeableLoaderInstruction) of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for discriminant 8",+ testCase "programDataAddress matches Rust" $ do+ fs <- getPdaFixtures+ case Loader.programDataAddress programPk of+ Nothing -> assertFailure "no programdata PDA found"+ Just addr -> getSolanaPublicKeyRaw addr @?= requireFixture "programdata-address" fs,+ testCase "initializeBuffer metas" $+ iAccounts (Loader.initializeBuffer bufferPk payerPk)+ @?= [ AccountMeta bufferPk False True,+ AccountMeta payerPk False False+ ],+ testCase "write metas" $+ iAccounts (Loader.write bufferPk payerPk 128 (BS.replicate 64 0xAB))+ @?= [ AccountMeta bufferPk False True,+ AccountMeta payerPk True False+ ],+ testCase "deployWithMaxDataLen metas" $+ iAccounts (Loader.deployWithMaxDataLen payerPk programDataPk programPk bufferPk authorityPk' 1048576)+ @?= [ AccountMeta payerPk True True,+ AccountMeta programDataPk False True,+ AccountMeta programPk False True,+ AccountMeta bufferPk False True,+ AccountMeta Sysvar.rent False False,+ AccountMeta Sysvar.clock False False,+ AccountMeta SP.systemProgramId False False,+ AccountMeta authorityPk' True False+ ],+ testCase "upgrade metas" $+ iAccounts (Loader.upgrade programDataPk programPk bufferPk spillPk payerPk)+ @?= [ AccountMeta programDataPk False True,+ AccountMeta programPk False True,+ AccountMeta bufferPk False True,+ AccountMeta spillPk False True,+ AccountMeta Sysvar.rent False False,+ AccountMeta Sysvar.clock False False,+ AccountMeta payerPk True False+ ],+ testCase "setAuthority metas" $+ iAccounts (Loader.setAuthority bufferPk payerPk newAuthPk)+ @?= [ AccountMeta bufferPk False True,+ AccountMeta payerPk True False,+ AccountMeta newAuthPk False False+ ],+ testCase "setAuthorityChecked metas" $+ iAccounts (Loader.setAuthorityChecked bufferPk payerPk newAuthPk)+ @?= [ AccountMeta bufferPk False True,+ AccountMeta payerPk True False,+ AccountMeta newAuthPk True False+ ],+ testCase "closeAccount metas (no associated program)" $+ iAccounts (Loader.closeAccount bufferPk recipientPk payerPk Nothing)+ @?= [ AccountMeta bufferPk False True,+ AccountMeta recipientPk False True,+ AccountMeta payerPk True False+ ],+ testCase "closeAccount metas (programdata close)" $+ iAccounts (Loader.closeAccount programDataPk recipientPk payerPk (Just programPk))+ @?= [ AccountMeta programDataPk False True,+ AccountMeta recipientPk False True,+ AccountMeta payerPk True False,+ AccountMeta programPk False True+ ],+ testCase "extendProgram metas (no payer)" $+ iAccounts (Loader.extendProgram programDataPk programPk Nothing 4096)+ @?= [ AccountMeta programDataPk False True,+ AccountMeta programPk False True+ ],+ testCase "extendProgram metas (with payer)" $+ iAccounts (Loader.extendProgram programDataPk programPk (Just payerPk) 4096)+ @?= [ AccountMeta programDataPk False True,+ AccountMeta programPk False True,+ AccountMeta SP.systemProgramId False False,+ AccountMeta payerPk True True+ ]+ ]+ where+ goldenCase getFixtures name li =+ testCase name $ do+ fs <- getFixtures+ enc li @?= requireFixture name fs
+ test/Test/NativePrograms/ComputeBudget.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.NativePrograms.ComputeBudget (tests) where++import Data.Binary (decode, decodeOrFail, encode)+import Data.Binary.Get (ByteOffset)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Network.Solana.Core.Instruction+import Network.Solana.NativePrograms.ComputeBudget qualified as CB+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++dataOf :: Instruction -> BS.ByteString+dataOf = instrData . iData++genComputeBudgetInstruction :: Gen CB.ComputeBudgetInstruction+genComputeBudgetInstruction =+ oneof+ [ CB.RequestHeapFrame <$> arbitrary,+ CB.SetComputeUnitLimit <$> arbitrary,+ CB.SetComputeUnitPrice <$> arbitrary,+ CB.SetLoadedAccountsDataSizeLimit <$> arbitrary+ ]++tests :: TestTree+tests =+ withResource+ (loadFixtures "test/fixtures/compute_budget_instruction_data.json")+ (const (pure ()))+ $ \getFixtures ->+ testGroup+ "ComputeBudget (golden + properties)"+ [ testCase "RequestHeapFrame" $ do+ fs <- getFixtures+ dataOf (CB.requestHeapFrame 32768) @?= requireFixture "RequestHeapFrame" fs,+ testCase "SetComputeUnitLimit" $ do+ fs <- getFixtures+ dataOf (CB.setComputeUnitLimit 200000) @?= requireFixture "SetComputeUnitLimit" fs,+ testCase "SetComputeUnitPrice" $ do+ fs <- getFixtures+ dataOf (CB.setComputeUnitPrice 1000) @?= requireFixture "SetComputeUnitPrice" fs,+ testCase "SetLoadedAccountsDataSizeLimit" $ do+ fs <- getFixtures+ dataOf (CB.setLoadedAccountsDataSizeLimit 65536)+ @?= requireFixture "SetLoadedAccountsDataSizeLimit" fs,+ testCase "builders take no accounts" $ do+ iAccounts (CB.requestHeapFrame 1024) @?= []+ iAccounts (CB.setComputeUnitLimit 1) @?= []+ iAccounts (CB.setComputeUnitPrice 1) @?= []+ iAccounts (CB.setLoadedAccountsDataSizeLimit 1) @?= [],+ testProperty "Binary round-trip" $+ forAll genComputeBudgetInstruction $ \cbi -> decode (encode cbi) === cbi,+ testCase "decode fails on unknown discriminant" $+ case decodeOrFail (BL.pack [5]) :: Either (BL.ByteString, ByteOffset, String) (BL.ByteString, ByteOffset, CB.ComputeBudgetInstruction) of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for discriminant 5"+ ]
+ test/Test/NativePrograms/Secp256k1.hs view
@@ -0,0 +1,75 @@+module Test.NativePrograms.Secp256k1 (tests) where++import Control.Exception (ErrorCall, evaluate, try)+import Data.Binary (decode, encode)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Network.Solana.Core.Instruction (iAccounts, iData, instrData)+import Network.Solana.NativePrograms.Secp256k1 qualified as Secp+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++genOffsets :: Gen Secp.SecpSignatureOffsets+genOffsets =+ Secp.SecpSignatureOffsets+ <$> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary+ <*> arbitrary++tests :: TestTree+tests =+ withResource (loadFixtures "test/fixtures/secp256k1.json") (const (pure ())) $ \getFixtures ->+ testGroup+ "Secp256k1 instruction data (golden + properties)"+ [ testCase "newSecp256k1Instruction reconstructs the full instruction data" $ do+ fs <- getFixtures+ let ethAddress = requireFixture "secp-eth-address" fs+ signature = requireFixture "secp-signature" fs+ recoveryId = BS.head (requireFixture "secp-recovery-id" fs)+ message = requireFixture "secp-message" fs+ ix = Secp.newSecp256k1Instruction ethAddress signature recoveryId message+ instrData (iData ix) @?= requireFixture "secp-full-instruction-data" fs,+ testCase "offsets golden: decode from the full instruction data" $ do+ fs <- getFixtures+ let full = requireFixture "secp-full-instruction-data" fs+ offsets = decode (BL.fromStrict (BS.take 11 (BS.drop 1 full))) :: Secp.SecpSignatureOffsets+ offsets+ @?= Secp.SecpSignatureOffsets+ { Secp.ssoSignatureOffset = 32,+ Secp.ssoSignatureInstructionIndex = 0,+ Secp.ssoEthAddressOffset = 12,+ Secp.ssoEthAddressInstructionIndex = 0,+ Secp.ssoMessageDataOffset = 97,+ Secp.ssoMessageDataSize = 10,+ Secp.ssoMessageInstructionIndex = 0+ },+ testProperty "SecpSignatureOffsets Binary round-trip" $+ forAll genOffsets $ \o -> decode (encode o) === o,+ testCase "newSecp256k1Instruction rejects a 19-byte ethAddress" $ do+ result <-+ try+ ( evaluate+ (Secp.newSecp256k1Instruction (BS.replicate 19 0) (BS.replicate 64 0) 0 (BS.replicate 10 0))+ )+ case result of+ Left (_ :: ErrorCall) -> pure ()+ Right _ -> assertFailure "expected error for a 19-byte ethAddress",+ testCase "newSecp256k1Instruction rejects a 63-byte signature" $ do+ result <-+ try+ ( evaluate+ (Secp.newSecp256k1Instruction (BS.replicate 20 0) (BS.replicate 63 0) 0 (BS.replicate 10 0))+ )+ case result of+ Left (_ :: ErrorCall) -> pure ()+ Right _ -> assertFailure "expected error for a 63-byte signature",+ testCase "newSecp256k1Instruction takes no accounts" $+ iAccounts (Secp.newSecp256k1Instruction (BS.replicate 20 0) (BS.replicate 64 0) 0 (BS.replicate 10 0))+ @?= []+ ]
+ test/Test/NativePrograms/Stake.hs view
@@ -0,0 +1,236 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.NativePrograms.Stake (tests) where++import Data.Binary (decode, decodeOrFail, encode)+import Data.Binary.Get (ByteOffset)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Network.Solana.Core.Crypto (SolanaPublicKey, createSolanaKeypairFromSeed, unsafeSolanaPublicKeyRaw)+import Network.Solana.Core.Instruction (AccountMeta (..), iAccounts)+import Network.Solana.NativePrograms.Stake qualified as Stake+import Network.Solana.Sysvar qualified as Sysvar+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++custodianPk, newAuthPk, withdrawerPk :: SolanaPublicKey+custodianPk = unsafeSolanaPublicKeyRaw (replicate 32 18)+newAuthPk = unsafeSolanaPublicKeyRaw (replicate 32 20)+withdrawerPk = unsafeSolanaPublicKeyRaw (replicate 32 28)++stakeAcctPk, votePk, recipientPk' :: SolanaPublicKey+stakeAcctPk = unsafeSolanaPublicKeyRaw (replicate 32 21)+votePk = unsafeSolanaPublicKeyRaw (replicate 32 17)+recipientPk' = unsafeSolanaPublicKeyRaw (replicate 32 22)++payerPk :: SolanaPublicKey+payerPk =+ case createSolanaKeypairFromSeed (BS.replicate 32 1) of+ Just (pk, _) -> pk+ Nothing -> error "failed to derive payer"++fixedAuthorized :: Stake.Authorized+fixedAuthorized = Stake.Authorized {Stake.aStaker = payerPk, Stake.aWithdrawer = payerPk}++fixedLockup :: Stake.Lockup+fixedLockup = Stake.Lockup {Stake.lUnixTimestamp = 1700000000, Stake.lEpoch = 300, Stake.lCustodian = custodianPk}++enc :: Stake.StakeInstruction -> BS.ByteString+enc = BL.toStrict . encode++genStakeInstruction :: Gen Stake.StakeInstruction+genStakeInstruction =+ oneof+ [ Stake.Initialize <$> genAuthorized <*> genLockup,+ Stake.Authorize <$> genPk <*> genAuth,+ pure Stake.DelegateStake,+ Stake.Split <$> arbitrary,+ Stake.Withdraw <$> arbitrary,+ pure Stake.Deactivate,+ Stake.SetLockup <$> genLockupArgs,+ pure Stake.Merge,+ pure Stake.InitializeChecked,+ Stake.AuthorizeChecked <$> genAuth,+ pure Stake.GetMinimumDelegation+ ]+ where+ genPk = unsafeSolanaPublicKeyRaw <$> vectorOf 32 arbitrary+ genAuth = elements [Stake.AuthorizeStaker, Stake.AuthorizeWithdrawer]+ genAuthorized = Stake.Authorized <$> genPk <*> genPk+ genLockup = Stake.Lockup <$> arbitrary <*> arbitrary <*> genPk+ genLockupArgs =+ Stake.LockupArgs+ <$> oneof [pure Nothing, Just <$> arbitrary]+ <*> oneof [pure Nothing, Just <$> arbitrary]+ <*> oneof [pure Nothing, Just <$> genPk]++tests :: TestTree+tests = testGroup "Stake" [instructionDataTests, stakeStateTests]++stakeStateTests :: TestTree+stakeStateTests =+ withResource (loadFixtures "test/fixtures/state_fixtures.json") (const (pure ())) $ \getStateFixtures ->+ testGroup+ "Stake account state (golden + rejection)"+ [ testCase "decodeStakeAccount: stake-account golden (StakeActive)" $ do+ fs <- getStateFixtures+ let bs = requireFixture "stake-account" fs+ case Stake.decodeStakeAccount bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right (Stake.StakeActive meta delegation credits flags) -> do+ Stake.smRentExemptReserve meta @?= 2282880+ Stake.smAuthorized meta @?= fixedAuthorized+ Stake.smLockup meta @?= fixedLockup+ Stake.sdVoter delegation @?= votePk+ Stake.sdStake delegation @?= 1000000+ Stake.sdActivationEpoch delegation @?= 250+ Stake.sdDeactivationEpoch delegation @?= maxBound+ Stake.sdWarmupCooldownRate delegation @?= 0.25+ credits @?= 42+ flags @?= 0+ Right other -> assertFailure ("expected StakeActive, got " <> show other),+ testCase "decodeStakeAccount: stake-account-initialized golden (StakeInitialized)" $ do+ fs <- getStateFixtures+ let bs = requireFixture "stake-account-initialized" fs+ case Stake.decodeStakeAccount bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right (Stake.StakeInitialized meta) -> do+ Stake.smRentExemptReserve meta @?= 2282880+ Stake.smAuthorized meta @?= fixedAuthorized+ Stake.smLockup meta @?= fixedLockup+ Right other -> assertFailure ("expected StakeInitialized, got " <> show other),+ testCase "decodeStakeAccount: rejects discriminant 4" $ do+ let bs = BS.pack ([4, 0, 0, 0] <> replicate 196 0)+ case Stake.decodeStakeAccount bs of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for discriminant 4",+ testCase "decodeStakeAccount: decode tolerates trailing padding" $ do+ fs <- getStateFixtures+ let bs = requireFixture "stake-account" fs+ padded = bs <> BS.replicate 3 0+ Stake.decodeStakeAccount padded @?= Stake.decodeStakeAccount bs+ ]++instructionDataTests :: TestTree+instructionDataTests =+ withResource (loadFixtures "test/fixtures/stake_instruction_data.json") (const (pure ())) $ \getFixtures ->+ testGroup+ "Stake instruction data (golden + properties)"+ [ goldenCase getFixtures "Initialize" (Stake.Initialize fixedAuthorized fixedLockup),+ goldenCase getFixtures "Authorize-staker" (Stake.Authorize newAuthPk Stake.AuthorizeStaker),+ goldenCase getFixtures "Authorize-withdrawer" (Stake.Authorize newAuthPk Stake.AuthorizeWithdrawer),+ goldenCase getFixtures "DelegateStake" Stake.DelegateStake,+ goldenCase getFixtures "Split" (Stake.Split 250000),+ goldenCase getFixtures "Withdraw" (Stake.Withdraw 500000),+ goldenCase getFixtures "Deactivate" Stake.Deactivate,+ goldenCase getFixtures "SetLockup-some" (Stake.SetLockup (Stake.LockupArgs (Just 1700000000) (Just 300) (Just custodianPk))),+ goldenCase getFixtures "SetLockup-none" (Stake.SetLockup (Stake.LockupArgs Nothing Nothing Nothing)),+ goldenCase getFixtures "Merge" Stake.Merge,+ goldenCase getFixtures "InitializeChecked" Stake.InitializeChecked,+ goldenCase getFixtures "AuthorizeChecked" (Stake.AuthorizeChecked Stake.AuthorizeWithdrawer),+ goldenCase getFixtures "GetMinimumDelegation" Stake.GetMinimumDelegation,+ testProperty "Binary round-trip" $+ forAll genStakeInstruction $ \si -> decode (encode si) === si,+ testCase "decode fails on unknown discriminant" $+ case decodeOrFail (BL.pack [16, 0, 0, 0]) :: Either (BL.ByteString, ByteOffset, String) (BL.ByteString, ByteOffset, Stake.StakeInstruction) of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for discriminant 16",+ testCase "initialize metas" $+ iAccounts (Stake.initialize stakeAcctPk fixedAuthorized fixedLockup)+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta Sysvar.rent False False+ ],+ testCase "authorize metas (no custodian)" $+ iAccounts (Stake.authorize stakeAcctPk payerPk newAuthPk Stake.AuthorizeStaker Nothing)+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta Sysvar.clock False False,+ AccountMeta payerPk True False+ ],+ testCase "authorize metas (custodian)" $+ iAccounts (Stake.authorize stakeAcctPk payerPk newAuthPk Stake.AuthorizeWithdrawer (Just custodianPk))+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta Sysvar.clock False False,+ AccountMeta payerPk True False,+ AccountMeta custodianPk True False+ ],+ testCase "delegateStake metas" $+ iAccounts (Stake.delegateStake stakeAcctPk payerPk votePk)+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta votePk False False,+ AccountMeta Sysvar.clock False False,+ AccountMeta Sysvar.stakeHistory False False,+ AccountMeta Stake.stakeConfigId False False,+ AccountMeta payerPk True False+ ],+ testCase "split metas" $+ iAccounts (Stake.split stakeAcctPk recipientPk' payerPk 250000)+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta recipientPk' False True,+ AccountMeta payerPk True False+ ],+ testCase "withdraw metas (no custodian)" $+ iAccounts (Stake.withdraw stakeAcctPk recipientPk' payerPk 500000 Nothing)+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta recipientPk' False True,+ AccountMeta Sysvar.clock False False,+ AccountMeta Sysvar.stakeHistory False False,+ AccountMeta payerPk True False+ ],+ testCase "withdraw metas (custodian)" $+ iAccounts (Stake.withdraw stakeAcctPk recipientPk' payerPk 500000 (Just custodianPk))+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta recipientPk' False True,+ AccountMeta Sysvar.clock False False,+ AccountMeta Sysvar.stakeHistory False False,+ AccountMeta payerPk True False,+ AccountMeta custodianPk True False+ ],+ testCase "deactivate metas" $+ iAccounts (Stake.deactivate stakeAcctPk payerPk)+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta Sysvar.clock False False,+ AccountMeta payerPk True False+ ],+ testCase "setLockup metas" $+ iAccounts (Stake.setLockup stakeAcctPk (Stake.LockupArgs Nothing Nothing Nothing) custodianPk)+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta custodianPk True False+ ],+ testCase "merge metas" $+ iAccounts (Stake.merge stakeAcctPk recipientPk' payerPk)+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta recipientPk' False True,+ AccountMeta Sysvar.clock False False,+ AccountMeta Sysvar.stakeHistory False False,+ AccountMeta payerPk True False+ ],+ testCase "initializeChecked metas" $+ iAccounts (Stake.initializeChecked stakeAcctPk (Stake.Authorized {Stake.aStaker = payerPk, Stake.aWithdrawer = withdrawerPk}))+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta Sysvar.rent False False,+ AccountMeta payerPk False False,+ AccountMeta withdrawerPk True False+ ],+ testCase "authorizeChecked metas" $+ iAccounts (Stake.authorizeChecked stakeAcctPk payerPk newAuthPk Stake.AuthorizeStaker Nothing)+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta Sysvar.clock False False,+ AccountMeta payerPk True False,+ AccountMeta newAuthPk True False+ ],+ testCase "authorizeChecked metas (custodian)" $+ iAccounts (Stake.authorizeChecked stakeAcctPk payerPk newAuthPk Stake.AuthorizeWithdrawer (Just custodianPk))+ @?= [ AccountMeta stakeAcctPk False True,+ AccountMeta Sysvar.clock False False,+ AccountMeta payerPk True False,+ AccountMeta newAuthPk True False,+ AccountMeta custodianPk True False+ ]+ ]+ where+ goldenCase getFixtures name si =+ testCase name $ do+ fs <- getFixtures+ enc si @?= requireFixture name fs
+ test/Test/NativePrograms/SystemProgram.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.NativePrograms.SystemProgram (tests) where++import Data.Binary (decode, decodeOrFail, encode)+import Data.Binary.Get (ByteOffset)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Network.Solana.Core.Block (BlockHash (..))+import Network.Solana.Core.Crypto (SolanaPublicKey, createSolanaKeypairFromSeed, unsafeSolanaPublicKeyRaw)+import Network.Solana.Core.Instruction+import Network.Solana.NativePrograms.SystemProgram qualified as SP+import Network.Solana.Sysvar qualified as Sysvar+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++basePk, ownerPk, authorityPk, funderPk, newAccountPk :: SolanaPublicKey+basePk = unsafeSolanaPublicKeyRaw (replicate 32 3)+ownerPk = unsafeSolanaPublicKeyRaw (replicate 32 5)+authorityPk = unsafeSolanaPublicKeyRaw (replicate 32 6)+funderPk = unsafeSolanaPublicKeyRaw (replicate 32 7)+newAccountPk = unsafeSolanaPublicKeyRaw (replicate 32 8)++seedStr :: String+seedStr = "hello-seed"++dataOf :: Instruction -> BS.ByteString+dataOf = instrData . iData++genSystemInstruction :: Gen SP.SystemInstruction+genSystemInstruction =+ oneof+ [ SP.CreateAccount <$> arbitrary <*> arbitrary <*> genPk,+ SP.Assign <$> genPk,+ SP.Transfer <$> arbitrary,+ SP.CreateAccountWithSeed <$> genPk <*> genSeed <*> arbitrary <*> arbitrary <*> genPk,+ pure SP.AdvanceNonceAccount,+ SP.WithdrawNonceAccount <$> arbitrary,+ SP.InitializeNonceAccount <$> genPk,+ SP.AuthorizeNonceAccount <$> genPk,+ SP.Allocate <$> arbitrary,+ SP.AllocateWithSeed <$> genPk <*> genSeed <*> arbitrary <*> genPk,+ SP.AssignWithSeed <$> genPk <*> genSeed <*> genPk,+ SP.TransferWithSeed <$> arbitrary <*> genSeed <*> genPk,+ pure SP.UpgradeNonceAccount+ ]+ where+ genPk = unsafeSolanaPublicKeyRaw <$> vectorOf 32 arbitrary+ genSeed = listOf (elements (['a' .. 'z'] ++ ['0' .. '9'] ++ "-_"))++payerPk :: SolanaPublicKey+payerPk =+ case createSolanaKeypairFromSeed (BS.replicate 32 1) of+ Just (pk, _) -> pk+ Nothing -> error "failed to derive payer"++tests :: TestTree+tests = testGroup "SystemProgram" [instructionDataTests, nonceStateTests]++nonceStateTests :: TestTree+nonceStateTests =+ withResource (loadFixtures "test/fixtures/state_fixtures.json") (const (pure ())) $ \getStateFixtures ->+ testGroup+ "SystemProgram nonce account state (golden + rejection)"+ [ testCase "decodeNonceAccount: nonce-account golden" $ do+ fs <- getStateFixtures+ let bs = requireFixture "nonce-account" fs+ durableNonceBytes = requireFixture "nonce-durable-hash" fs+ case SP.decodeNonceAccount bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right ns -> case ns of+ SP.NonceUninitialized -> assertFailure "expected NonceInitialized, got NonceUninitialized"+ SP.NonceInitialized {SP.nsAuthority = auth, SP.nsDurableNonce = BlockHash nonceBytes, SP.nsLamportsPerSignature = fee} -> do+ auth @?= payerPk+ nonceBytes @?= durableNonceBytes+ fee @?= 5000,+ testCase "decodeNonceAccount: rejects unsupported version" $ do+ let bs = BS.pack ([2, 0, 0, 0] <> replicate 76 0)+ case SP.decodeNonceAccount bs of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for unsupported version",+ testCase "decodeNonceAccount: rejects unknown state" $ do+ let bs = BS.pack ([1, 0, 0, 0, 2, 0, 0, 0] <> replicate 72 0)+ case SP.decodeNonceAccount bs of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for unknown state"+ ]++instructionDataTests :: TestTree+instructionDataTests =+ withResource+ (loadFixtures "test/fixtures/system_instruction_data.json")+ (const (pure ()))+ $ \getFixtures ->+ testGroup+ "SystemProgram instruction data (golden)"+ [ testCase "CreateAccount" $ do+ fs <- getFixtures+ dataOf (SP.createAccount funderPk newAccountPk 1000000 165 ownerPk)+ @?= requireFixture "CreateAccount" fs,+ testCase "Assign" $ do+ fs <- getFixtures+ dataOf (SP.assignAccount newAccountPk ownerPk)+ @?= requireFixture "Assign" fs,+ testCase "Transfer" $ do+ fs <- getFixtures+ dataOf (SP.transfer funderPk newAccountPk 1000000)+ @?= requireFixture "Transfer" fs,+ testCase "CreateAccountWithSeed" $ do+ fs <- getFixtures+ dataOf (SP.createAccountWithSeed basePk seedStr funderPk newAccountPk 1000000 165 ownerPk)+ @?= requireFixture "CreateAccountWithSeed" fs,+ testCase "AdvanceNonceAccount" $ do+ fs <- getFixtures+ dataOf (SP.advanceNonceAccount newAccountPk authorityPk)+ @?= requireFixture "AdvanceNonceAccount" fs,+ testCase "WithdrawNonceAccount" $ do+ fs <- getFixtures+ dataOf (SP.withdrawNonceAccount newAccountPk authorityPk funderPk 1000000)+ @?= requireFixture "WithdrawNonceAccount" fs,+ testCase "InitializeNonceAccount" $ do+ fs <- getFixtures+ dataOf (SP.initializeNonceAccount newAccountPk authorityPk)+ @?= requireFixture "InitializeNonceAccount" fs,+ testCase "AuthorizeNonceAccount" $ do+ fs <- getFixtures+ dataOf (SP.authorizeNonceAccount newAccountPk basePk authorityPk)+ @?= requireFixture "AuthorizeNonceAccount" fs,+ testCase "UpgradeNonceAccount" $ do+ fs <- getFixtures+ dataOf (SP.upgradeNonceAccount newAccountPk)+ @?= requireFixture "UpgradeNonceAccount" fs,+ testCase "Allocate" $ do+ fs <- getFixtures+ dataOf (SP.allocate newAccountPk 165)+ @?= requireFixture "Allocate" fs,+ testCase "AllocateWithSeed" $ do+ fs <- getFixtures+ dataOf (SP.allocateWithSeed newAccountPk basePk seedStr 165 ownerPk)+ @?= requireFixture "AllocateWithSeed" fs,+ testCase "AssignWithSeed" $ do+ fs <- getFixtures+ dataOf (SP.assignWithSeed newAccountPk basePk seedStr ownerPk)+ @?= requireFixture "AssignWithSeed" fs,+ testCase "TransferWithSeed" $ do+ fs <- getFixtures+ dataOf (SP.transferWithSeed funderPk basePk seedStr ownerPk newAccountPk 1000000)+ @?= requireFixture "TransferWithSeed" fs,+ testCase "advanceNonceAccount account metas" $+ iAccounts (SP.advanceNonceAccount newAccountPk authorityPk)+ @?= [ AccountMeta {accountPubKey = newAccountPk, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.recentBlockhashes, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = authorityPk, isSigner = True, isWritable = False}+ ],+ testCase "withdrawNonceAccount account metas" $+ iAccounts (SP.withdrawNonceAccount newAccountPk authorityPk funderPk 1000000)+ @?= [ AccountMeta {accountPubKey = newAccountPk, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = funderPk, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = Sysvar.recentBlockhashes, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Sysvar.rent, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = authorityPk, isSigner = True, isWritable = False}+ ],+ testCase "allocateWithSeed account metas" $+ iAccounts (SP.allocateWithSeed newAccountPk basePk seedStr 165 ownerPk)+ @?= [ AccountMeta {accountPubKey = newAccountPk, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = basePk, isSigner = True, isWritable = False}+ ],+ testCase "transferWithSeed account metas" $+ iAccounts (SP.transferWithSeed funderPk basePk seedStr ownerPk newAccountPk 1000000)+ @?= [ AccountMeta {accountPubKey = funderPk, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = basePk, isSigner = True, isWritable = False},+ AccountMeta {accountPubKey = newAccountPk, isSigner = False, isWritable = True}+ ],+ testProperty "SystemInstruction Binary round-trip" $+ forAll genSystemInstruction $ \si -> decode (encode si) === si,+ testCase "decode fails on unknown discriminant" $+ case decodeOrFail (BL.pack [13, 0, 0, 0]) :: Either (BL.ByteString, ByteOffset, String) (BL.ByteString, ByteOffset, SP.SystemInstruction) of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for discriminant 13",+ testCase "getBincodeString rejects length beyond Int range" $+ -- discriminant 3 (CreateAccountWithSeed) -> base pk (32 bytes) -> u64 length 2^63+ let bytes = BL.pack ([3, 0, 0, 0] <> replicate 32 3 <> [0, 0, 0, 0, 0, 0, 0, 0x80])+ in case decodeOrFail bytes :: Either (BL.ByteString, ByteOffset, String) (BL.ByteString, ByteOffset, SP.SystemInstruction) of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for absurd length"+ ]
+ test/Test/NativePrograms/Vote.hs view
@@ -0,0 +1,120 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.NativePrograms.Vote (tests) where++import Data.Binary (decode, decodeOrFail, encode)+import Data.Binary.Get (ByteOffset)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Network.Solana.Core.Crypto (SolanaPublicKey, createSolanaKeypairFromSeed, getSolanaPublicKeyRaw, toBase58String, unsafeSolanaPublicKeyRaw)+import Network.Solana.Core.Instruction (AccountMeta (..), iAccounts)+import Network.Solana.NativePrograms.Vote qualified as Vote+import Network.Solana.Sysvar qualified as Sysvar+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++votePk, nodePk, newAuthPk, recipientPk' :: SolanaPublicKey+votePk = unsafeSolanaPublicKeyRaw (replicate 32 17)+nodePk = unsafeSolanaPublicKeyRaw (replicate 32 19)+newAuthPk = unsafeSolanaPublicKeyRaw (replicate 32 20)+recipientPk' = unsafeSolanaPublicKeyRaw (replicate 32 22)++payerPk :: SolanaPublicKey+payerPk =+ case createSolanaKeypairFromSeed (BS.replicate 32 1) of+ Just (pk, _) -> pk+ Nothing -> error "failed to derive payer"++fixedVoteInit :: Vote.VoteInit+fixedVoteInit =+ Vote.VoteInit+ { Vote.viNodePubkey = nodePk,+ Vote.viAuthorizedVoter = payerPk,+ Vote.viAuthorizedWithdrawer = payerPk,+ Vote.viCommission = 5+ }++enc :: Vote.VoteInstruction -> BS.ByteString+enc = BL.toStrict . encode++genVoteInstruction :: Gen Vote.VoteInstruction+genVoteInstruction =+ oneof+ [ Vote.InitializeAccount <$> genVoteInit,+ Vote.Authorize <$> genPk <*> genAuth,+ Vote.Withdraw <$> arbitrary,+ pure Vote.UpdateValidatorIdentity,+ Vote.UpdateCommission <$> arbitrary,+ Vote.AuthorizeChecked <$> genAuth+ ]+ where+ genPk = unsafeSolanaPublicKeyRaw <$> vectorOf 32 arbitrary+ genAuth = elements [Vote.AuthorizeVoter, Vote.AuthorizeWithdrawer]+ genVoteInit = Vote.VoteInit <$> genPk <*> genPk <*> genPk <*> arbitrary++tests :: TestTree+tests =+ withResource (loadFixtures "test/fixtures/vote_instruction_data.json") (const (pure ())) $ \getFixtures ->+ testGroup+ "Vote instruction data (golden + properties)"+ [ goldenCase getFixtures "InitializeAccount" (Vote.InitializeAccount fixedVoteInit),+ goldenCase getFixtures "Authorize-voter" (Vote.Authorize newAuthPk Vote.AuthorizeVoter),+ goldenCase getFixtures "Authorize-withdrawer" (Vote.Authorize newAuthPk Vote.AuthorizeWithdrawer),+ goldenCase getFixtures "Withdraw" (Vote.Withdraw 500000),+ goldenCase getFixtures "UpdateValidatorIdentity" Vote.UpdateValidatorIdentity,+ goldenCase getFixtures "UpdateCommission" (Vote.UpdateCommission 5),+ goldenCase getFixtures "AuthorizeChecked" (Vote.AuthorizeChecked Vote.AuthorizeWithdrawer),+ testProperty "Binary round-trip" $+ forAll genVoteInstruction $ \vi -> decode (encode vi) === vi,+ testCase "decode fails on unknown discriminant" $+ case decodeOrFail (BL.pack [2, 0, 0, 0]) :: Either (BL.ByteString, ByteOffset, String) (BL.ByteString, ByteOffset, Vote.VoteInstruction) of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for discriminant 2",+ testCase "initializeVoteAccount metas" $+ iAccounts (Vote.initializeVoteAccount votePk fixedVoteInit)+ @?= [ AccountMeta votePk False True,+ AccountMeta Sysvar.rent False False,+ AccountMeta Sysvar.clock False False,+ AccountMeta nodePk True False+ ],+ testCase "authorizeVote metas" $+ iAccounts (Vote.authorizeVote votePk payerPk newAuthPk Vote.AuthorizeVoter)+ @?= [ AccountMeta votePk False True,+ AccountMeta Sysvar.clock False False,+ AccountMeta payerPk True False+ ],+ testCase "withdrawVote metas" $+ iAccounts (Vote.withdrawVote votePk recipientPk' payerPk 500000)+ @?= [ AccountMeta votePk False True,+ AccountMeta recipientPk' False True,+ AccountMeta payerPk True False+ ],+ testCase "updateValidatorIdentity metas" $+ iAccounts (Vote.updateValidatorIdentity votePk nodePk payerPk)+ @?= [ AccountMeta votePk False True,+ AccountMeta nodePk True False,+ AccountMeta payerPk True False+ ],+ testCase "updateCommission metas" $+ iAccounts (Vote.updateCommission votePk payerPk 5)+ @?= [ AccountMeta votePk False True,+ AccountMeta payerPk True False+ ],+ testCase "authorizeVoteChecked metas" $+ iAccounts (Vote.authorizeVoteChecked votePk payerPk newAuthPk Vote.AuthorizeWithdrawer)+ @?= [ AccountMeta votePk False True,+ AccountMeta Sysvar.clock False False,+ AccountMeta payerPk True False,+ AccountMeta newAuthPk True False+ ],+ testCase "voteProgramId decodes to canonical bytes" $ do+ toBase58String (getSolanaPublicKeyRaw Vote.voteProgramId) @?= "Vote111111111111111111111111111111111111111"+ BS.length (getSolanaPublicKeyRaw Vote.voteProgramId) @?= 32+ ]+ where+ goldenCase getFixtures name vi =+ testCase name $ do+ fs <- getFixtures+ enc vi @?= requireFixture name fs
+ test/Test/RPC/Chain.hs view
@@ -0,0 +1,20 @@+module Test.RPC.Chain (tests) where++import Network.Solana.RPC.HTTP.Chain (percentilePriorityFee)+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "percentilePriorityFee"+ [ testCase "empty samples -> 0" $ percentilePriorityFee 0.5 [] @?= 0,+ testCase "all-zero samples -> 0" $ percentilePriorityFee 0.5 [0, 0] @?= 0,+ testCase "single sample" $ percentilePriorityFee 0.5 [5] @?= 5,+ testCase "median of four" $ percentilePriorityFee 0.5 [1, 2, 3, 4] @?= 2,+ testCase "p75 of four" $ percentilePriorityFee 0.75 [1, 2, 3, 4] @?= 3,+ testCase "p100 picks max" $ percentilePriorityFee 1.0 [7, 3] @?= 7,+ testCase "negative p clamps to 0" $ percentilePriorityFee (-1) [9] @?= 9,+ testCase "p above 1 clamps to 1" $ percentilePriorityFee 2 [1, 9] @?= 9,+ testCase "zeros filtered before ranking" $ percentilePriorityFee 0.5 [0, 5, 0, 1] @?= 1+ ]
+ test/Test/RPC/Parsers.hs view
@@ -0,0 +1,194 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++-- | Golden tests for the RPC response parsers.+--+-- Every fixture here is a real response captured from a local validator by+-- @tools/rpc-record/record.py@ -- not a hand-written sample -- so these tests+-- pin the @FromJSON@ instances against JSON a node actually produces,+-- including the fields it omits. That is the one thing the Rust-generated+-- byte vectors cannot cover, since the RPC layer's input is JSON rather than+-- a struct's serialization.+--+-- The assertions deliberately reach past "it parsed": each one checks a value+-- that could only be right if the field mapping is, which is what catches a+-- parser wired to the wrong key.+module Test.RPC.Parsers (tests) where++import Data.Aeson (FromJSON, Value)+import Data.Aeson.Types (parseEither, parseJSON)+import Data.Maybe (isJust)+import Network.Solana.Core.Account (Account, AccountInfo, Lamport (..), executable, lamports)+import Network.Solana.Core.Block (BlockHash, BlockHeight)+import Network.Solana.Core.Crypto (SolanaPublicKey)+import Network.Solana.RPC.HTTP.Account hiding (lamports)+import Network.Solana.RPC.HTTP.Account qualified as RpcAccount+import Network.Solana.RPC.HTTP.Block+import Network.Solana.RPC.HTTP.Chain+import Network.Solana.RPC.HTTP.Ledger+import Network.Solana.RPC.HTTP.Token+import Network.Solana.RPC.HTTP.Tokenomics+import Network.Solana.RPC.HTTP.Transaction+import Network.Solana.RPC.HTTP.Types+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit++fixturePath :: FilePath+fixturePath = "test/fixtures/rpc_responses.json"++-- | Decodes a recorded response's @result@ into the type its RPC binding+-- returns, failing the test with the parse error if the instance rejects what+-- the node actually sent.+withResult :: forall a. (FromJSON a) => String -> (a -> Assertion) -> Assertion+withResult name check = do+ fs <- loadRpcFixtures fixturePath+ case parseEither (parseJSON @a) (requireRpcResult name fs) of+ Left err -> assertFailure ("failed to parse recorded " <> name <> " response: " <> err)+ Right parsed -> check parsed++-- | For results the bindings hand back untouched (plain numbers, strings).+withRawResult :: String -> (Value -> Assertion) -> Assertion+withRawResult name check = do+ fs <- loadRpcFixtures fixturePath+ check (requireRpcResult name fs)++tests :: TestTree+tests =+ testGroup+ "RPC response parsers (recorded from a live node)"+ [ testGroup "cluster and node" clusterTests,+ testGroup "ledger and epoch" ledgerTests,+ testGroup "blocks" blockTests,+ testGroup "tokenomics" tokenomicsTests,+ testGroup "accounts" accountTests,+ testGroup "transactions" transactionTests,+ testGroup "SPL token" tokenTests+ ]++clusterTests :: [TestTree]+clusterTests =+ [ testCase "getVersion" $ withResult @SolanaVersion "getVersion" $ \v ->+ assertBool "reports a solana-core version" (not (null (solana_core v))),+ testCase "getIdentity" $ withResult @NodeIdentity "getIdentity" $ \_ ->+ pure (),+ testCase "getClusterNodes" $ withResult @[ClusterNodes] "getClusterNodes" $ \nodes ->+ assertBool "the local validator lists itself" (not (null nodes)),+ testCase "getHealth" $ withResult @String "getHealth" $ \health ->+ health @?= "ok",+ testCase "getRecentPerformanceSamples" $ withResult @[PerformanceSample] "getRecentPerformanceSamples" $ \samples ->+ assertBool "samples cover a non-zero period" (all ((> 0) . samplePeriodSecs) samples)+ ]++ledgerTests :: [TestTree]+ledgerTests =+ [ testCase "getEpochInfo" $ withResult @EpochInfo "getEpochInfo" $ \info ->+ assertBool "absolute slot is at least the slot index" (absoluteSlot info >= slotIndex info),+ testCase "getEpochSchedule" $ withResult @EpochSchedule "getEpochSchedule" $ \schedule ->+ assertBool "an epoch spans some slots" (slotsPerEpoch schedule > 0),+ testCase "getGenesisHash" $ withResult @BlockHash "getGenesisHash" $ \_ ->+ pure (),+ testCase "getSlot" $ withResult @Slot "getSlot" $ \slot ->+ assertBool "slot advanced past genesis" (slot > 0),+ testCase "getBlockHeight" $ withResult @BlockHeight "getBlockHeight" $ \height ->+ assertBool "block height advanced past genesis" (height > 0),+ testCase "getTransactionCount" $ withRawResult "getTransactionCount" $ \_ ->+ pure (),+ testCase "getFirstAvailableBlock" $ withResult @Slot "getFirstAvailableBlock" $ \_ ->+ pure (),+ testCase "getStakeMinimumDelegation" $ withResult @(RPCResponse Lamport) "getStakeMinimumDelegation" $ \r ->+ assertBool "context slot is populated" (contextSlot (context r) > 0)+ ]++blockTests :: [TestTree]+blockTests =+ [ testCase "getLatestBlockhash" $ withResult @(RPCResponse LatestBlockHash) "getLatestBlockhash" $ \r ->+ assertBool "blockhash is valid for some future block" (lastValidBlockHeight (value r) > 0),+ testCase "isBlockhashValid" $ withResult @(RPCResponse Bool) "isBlockhashValid" $ \r ->+ value r @?= True,+ testCase "getBlock" $ withResult @(Maybe BlockInfo) "getBlock" $ \block ->+ assertBool "the recorded slot holds a block" (isJust block),+ testCase "getBlock carries the recorded transfer" $ withResult @(Maybe BlockInfo) "getBlock" $ \case+ Nothing -> assertFailure "expected a block"+ Just b -> assertBool "block lists transactions" (not (null (transactionsBI b))),+ testCase "getBlockCommitment" $ withResult @BlockCommitment "getBlockCommitment" $ \c ->+ assertBool "total stake is positive" (totalStake c > 0),+ testCase "getBlockProduction" $ withResult @(RPCResponse BlockProduction) "getBlockProduction" $ \r ->+ case value r of+ BlockProduction identities _ -> assertBool "at least one leader produced blocks" (not (null identities)),+ testCase "getBlocks" $ withResult @[Slot] "getBlocks" $ \slots ->+ assertBool "the queried range is non-empty" (not (null slots))+ ]++tokenomicsTests :: [TestTree]+tokenomicsTests =+ [ testCase "getInflationGovernor" $ withResult @InflationGovernor "getInflationGovernor" $ \g ->+ assertBool "taper is a fraction" (taper g > 0 && taper g <= 1),+ testCase "getInflationRate" $ withResult @InflationRate "getInflationRate" $ \r ->+ assertBool "total is validator plus foundation" (abs (totalInflation r - (validatorInflation r + foundationInflation r)) < 1e-9),+ testCase "getSupply" $ withResult @(RPCResponse SolanaSupply) "getSupply" $ \r ->+ assertBool "total supply covers circulating" (total (value r) >= circulating (value r)),+ testCase "getVoteAccounts" $ withResult @VoteAccounts "getVoteAccounts" $ \accounts ->+ assertBool "the test validator votes" (not (null (current accounts))),+ testCase "getMinimumBalanceForRentExemption" $ withResult @Lamport "getMinimumBalanceForRentExemption" $ \rent ->+ assertBool "rent exemption for 165 bytes is non-trivial" (rent > Lamport 1000000)+ ]++accountTests :: [TestTree]+accountTests =+ [ testCase "getBalance" $ withResult @(RPCResponse Lamport) "getBalance" $ \r ->+ assertBool "the airdropped payer holds SOL" (value r > Lamport 0),+ testCase "getAccountInfo" $ withResult @(RPCResponse (Maybe AccountInfo)) "getAccountInfo" $ \r ->+ case value r of+ Nothing -> assertFailure "expected the payer account to exist"+ Just info -> do+ assertBool "payer holds lamports" (lamports info > Lamport 0)+ executable info @?= False,+ -- A node reports an absent account as a null value, not an error; the+ -- parser has to model that rather than fail.+ testCase "getAccountInfo (missing account)" $ withResult @(RPCResponse (Maybe AccountInfo)) "getAccountInfo-missing" $ \r ->+ value r @?= Nothing,+ testCase "getMultipleAccounts" $ withResult @(RPCResponse [Maybe AccountInfo]) "getMultipleAccounts" $ \r ->+ length (value r) @?= 2,+ testCase "getLargestAccounts" $ withResult @(RPCResponse [AddressAndLamports]) "getLargestAccounts" $ \r ->+ assertBool "accounts are listed with balances" (not (null (value r)) && all ((> Lamport 0) . RpcAccount.lamports) (value r)),+ testCase "getProgramAccounts" $ withResult @[Account] "getProgramAccounts" $ \accounts ->+ assertBool "the token program owns the mint and token account" (length accounts >= 2)+ ]++transactionTests :: [TestTree]+transactionTests =+ [ testCase "getSignaturesForAddress" $ withResult @[TransactionSignatureInformation] "getSignaturesForAddress" $ \case+ [] -> assertFailure "expected the recipient's transfer to be listed"+ (s : _) -> do+ err s @?= Nothing+ assertBool "signature is attributed to a slot" (slotTxSig s > 0),+ testCase "getSignatureStatuses" $ withResult @(RPCResponse [Maybe TransactionSignatureStatus]) "getSignatureStatuses" $ \r ->+ case value r of+ [Just s] -> do+ errTxStatus s @?= Nothing+ confirmationStatusTxStatus s @?= Just "finalized"+ other -> assertFailure ("expected exactly one status, got " <> show (length other)),+ testCase "getTransaction" $ withResult @(Maybe TransactionResult) "getTransaction" $ \result ->+ assertBool "the recorded transfer is retrievable" (isJust result)+ ]++tokenTests :: [TestTree]+tokenTests =+ [ testCase "getTokenSupply" $ withResult @(RPCResponse AmountObject) "getTokenSupply" $ \r -> do+ -- The recorder mints 42 tokens at 6 decimals.+ amount (value r) @?= "42000000"+ decimals (value r) @?= 6+ uiAmountString (value r) @?= "42",+ testCase "getTokenAccountBalance" $ withResult @(RPCResponse AmountObject) "getTokenAccountBalance" $ \r -> do+ amount (value r) @?= "42000000"+ decimals (value r) @?= 6,+ testCase "getTokenLargestAccounts" $ withResult @(RPCResponse [AmountObjectWithAddr]) "getTokenLargestAccounts" $ \r ->+ case value r of+ [] -> assertFailure "expected the minted account to be listed"+ (a : _) -> amount' a @?= "42000000",+ testCase "getTokenAccountsByOwner" $ withResult @(RPCResponse [Account]) "getTokenAccountsByOwner" $ \r ->+ length (value r) @?= 1+ ]
+ test/Test/RPC/WebSocket.hs view
@@ -0,0 +1,192 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++-- | Tests for the Solana PubSub (WebSocket) protocol layer.+--+-- The request goldens and notification payloads below are the canonical+-- examples from the Solana WebSocket RPC documentation, so they pin this+-- module against the documented wire format rather than against our own+-- encoder's habits.+module Test.RPC.WebSocket (tests) where++import Control.Concurrent.MVar (newEmptyMVar, takeMVar)+import Data.ByteString qualified as BS+import Data.ByteString.Char8 qualified as BS8+import Data.IORef+import Data.List (isInfixOf)+import Data.Maybe (isJust)+import Network.Solana.Core.Account (AccountData (..), AccountInfo (..), Lamport (..))+import Network.Solana.Core.Crypto (mkPublicKeyFromString, unsafeSigFromString)+import Network.Solana.RPC.WebSocket+import Test.Tasty+import Test.Tasty.HUnit++tests :: TestTree+tests =+ testGroup+ "Network.Solana.RPC.WebSocket"+ [ testGroup "requests" requestTests,+ testGroup "incoming messages" parseTests,+ testGroup "awaitSignature" awaitTests+ ]++-- | The signature used throughout the Solana WebSocket documentation.+docSignature :: String+docSignature = "2EBVM6cB8vAAD93Ktr6Vd8p67XPbQzCJX47MpReuiCXJAtcjaxpvWpcg9Ege1Nr5Tk3a2GFrByT7WPBjdsTycY9b"++-- | The account pubkey used in the documented @accountSubscribe@ example.+docPubkey :: String+docPubkey = "CM78CPUeXjn8o3yroDHxUtKsZZgoy4GPkPPXfouKNH12"++requestTests :: [TestTree]+requestTests =+ [ testCase "signatureSubscribe matches the documented request" $+ signatureSubscribeRequest (RequestId 1) (unsafeSigFromString docSignature) (Just "finalized") False+ @?= BS8.pack+ ( "{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"signatureSubscribe\",\"params\":[\""+ <> docSignature+ <> "\",{\"commitment\":\"finalized\",\"enableReceivedNotification\":false}]}"+ ),+ testCase "signatureSubscribe omits commitment when unset and honours the received flag" $+ signatureSubscribeRequest (RequestId 7) (unsafeSigFromString docSignature) Nothing True+ @?= BS8.pack+ ( "{\"jsonrpc\":\"2.0\",\"id\":7,\"method\":\"signatureSubscribe\",\"params\":[\""+ <> docSignature+ <> "\",{\"enableReceivedNotification\":true}]}"+ ),+ testCase "accountSubscribe matches the documented request" $ do+ pk <- either assertFailure' pure (mkPublicKeyFromString docPubkey)+ accountSubscribeRequest (RequestId 1) pk (Just "finalized")+ @?= BS8.pack+ ( "{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"accountSubscribe\",\"params\":[\""+ <> docPubkey+ <> "\",{\"commitment\":\"finalized\",\"encoding\":\"base64\"}]}"+ ),+ testCase "signatureUnsubscribe matches the documented request" $+ signatureUnsubscribeRequest (RequestId 1) (SubscriptionId 0)+ @?= "{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"signatureUnsubscribe\",\"params\":[0]}",+ testCase "accountUnsubscribe matches the documented request" $+ accountUnsubscribeRequest (RequestId 1) (SubscriptionId 0)+ @?= "{\"jsonrpc\":\"2.0\",\"id\":1,\"method\":\"accountUnsubscribe\",\"params\":[0]}"+ ]++parseTests :: [TestTree]+parseTests =+ [ testCase "subscribe acknowledgement carries the subscription id" $+ parseWsMessage "{\"jsonrpc\":\"2.0\",\"result\":23784,\"id\":1}"+ @?= Right (SubscribeAck (RequestId 1) (SubscriptionId 23784)),+ testCase "unsubscribe acknowledgement is distinguished by its boolean result" $+ parseWsMessage "{\"jsonrpc\":\"2.0\",\"result\":true,\"id\":1}"+ @?= Right (UnsubscribeAck (RequestId 1) True),+ -- PubSub omits context.apiVersion, unlike the HTTP RPC responses that+ -- 'Network.Solana.RPC.HTTP.Types.Context' models; parsing must not+ -- require it.+ testCase "signature notification without context.apiVersion parses as success" $+ parseWsMessage+ "{\"jsonrpc\":\"2.0\",\"method\":\"signatureNotification\",\"params\":{\"result\":{\"context\":{\"slot\":5207624},\"value\":{\"err\":null}},\"subscription\":24006}}"+ @?= Right (SignatureNotice (SubscriptionId 24006) (SignatureNotification 5207624 Nothing False)),+ testCase "signature notification surfaces an on-chain error" $+ case parseWsMessage+ "{\"jsonrpc\":\"2.0\",\"method\":\"signatureNotification\",\"params\":{\"result\":{\"context\":{\"slot\":10},\"value\":{\"err\":{\"InstructionError\":[0,{\"Custom\":1}]}}},\"subscription\":1}}" of+ Right (SignatureNotice sub n) -> do+ sub @?= SubscriptionId 1+ snSlot n @?= 10+ snReceived n @?= False+ assertBool "error preserved" (isJust (snErr n))+ other -> assertFailure ("expected a signature notification, got " <> show other),+ testCase "receivedSignature notification is flagged, not treated as terminal" $+ parseWsMessage+ "{\"jsonrpc\":\"2.0\",\"method\":\"signatureNotification\",\"params\":{\"result\":{\"context\":{\"slot\":9},\"value\":\"receivedSignature\"},\"subscription\":2}}"+ @?= Right (SignatureNotice (SubscriptionId 2) (SignatureNotification 9 Nothing True)),+ testCase "account notification decodes into the shared AccountInfo type" $+ case parseWsMessage+ "{\"jsonrpc\":\"2.0\",\"method\":\"accountNotification\",\"params\":{\"result\":{\"context\":{\"slot\":5199307},\"value\":{\"data\":[\"AQID\",\"base64\"],\"executable\":false,\"lamports\":33594,\"owner\":\"11111111111111111111111111111111\",\"rentEpoch\":635,\"space\":3}},\"subscription\":23784}}" of+ Right (AccountNotice sub n) -> do+ sub @?= SubscriptionId 23784+ anSlot n @?= 5199307+ lamports (anAccount n) @?= Lamport 33594+ executable (anAccount n) @?= False+ dataField (anAccount n) @?= AccountDataBinary (BS8.pack "\SOH\STX\ETX")+ other -> assertFailure ("expected an account notification, got " <> show other),+ testCase "JSON-RPC error responses are reported, not silently dropped" $+ parseWsMessage "{\"jsonrpc\":\"2.0\",\"error\":{\"code\":-32602,\"message\":\"Invalid Request\"},\"id\":3}"+ @?= Right (WsErrorMessage (Just (RequestId 3)) (-32602) "Invalid Request"),+ testCase "JSON-RPC error with a null id is still reported" $+ parseWsMessage "{\"jsonrpc\":\"2.0\",\"error\":{\"code\":-32700,\"message\":\"Parse error\"},\"id\":null}"+ @?= Right (WsErrorMessage Nothing (-32700) "Parse error"),+ testCase "malformed JSON is rejected" $+ assertBool "expected a Left" (isLeft (parseWsMessage "not json")),+ testCase "an unknown notification method is rejected rather than misread" $+ assertBool+ "expected a Left"+ (isLeft (parseWsMessage "{\"jsonrpc\":\"2.0\",\"method\":\"slotNotification\",\"params\":{\"result\":{\"slot\":1},\"subscription\":1}}"))+ ]++-- | A 'WsTransport' that replays a fixed script of incoming frames and+-- records everything sent, so the confirmation handshake can be driven+-- without a network. Receiving past the end of the script blocks forever,+-- which is how the timeout case is exercised.+scriptedTransport :: [BS.ByteString] -> IO (WsTransport, IORef [BS.ByteString])+scriptedTransport incoming = do+ remaining <- newIORef incoming+ sent <- newIORef []+ let recv = do+ next <- atomicModifyIORef' remaining (\case [] -> ([], Nothing); (y : ys) -> (ys, Just y))+ maybe (newEmptyMVar >>= takeMVar) pure next+ send frame = modifyIORef' sent (<> [frame])+ pure (WsTransport send recv, sent)++ack :: BS.ByteString+ack = "{\"jsonrpc\":\"2.0\",\"result\":24006,\"id\":1}"++terminalNotice :: BS.ByteString+terminalNotice =+ "{\"jsonrpc\":\"2.0\",\"method\":\"signatureNotification\",\"params\":{\"result\":{\"context\":{\"slot\":5207624},\"value\":{\"err\":null}},\"subscription\":24006}}"++awaitTests :: [TestTree]+awaitTests =+ [ testCase "returns the confirming slot and sends the documented subscribe request" $ do+ (transport, sent) <- scriptedTransport [ack, terminalNotice]+ result <- awaitSignature transport (RequestId 1) (Just "confirmed") 5 (unsafeSigFromString docSignature)+ result @?= Right 5207624+ frames <- readIORef sent+ frames @?= [signatureSubscribeRequest (RequestId 1) (unsafeSigFromString docSignature) (Just "confirmed") False],+ testCase "reports a transaction that failed on-chain" $ do+ (transport, _) <- scriptedTransport+ [ ack,+ "{\"jsonrpc\":\"2.0\",\"method\":\"signatureNotification\",\"params\":{\"result\":{\"context\":{\"slot\":11},\"value\":{\"err\":{\"InstructionError\":[0,{\"Custom\":1}]}}},\"subscription\":24006}}"+ ]+ result <- awaitSignature transport (RequestId 1) Nothing 5 (unsafeSigFromString docSignature)+ assertBool ("expected an on-chain failure, got " <> show result) (either ("failed on-chain" `isInfixOf`) (const False) result),+ testCase "skips other subscriptions' frames and the early receivedSignature" $ do+ (transport, _) <- scriptedTransport+ [ -- a notification for a subscription we never made+ "{\"jsonrpc\":\"2.0\",\"method\":\"signatureNotification\",\"params\":{\"result\":{\"context\":{\"slot\":1},\"value\":{\"err\":null}},\"subscription\":999}}",+ -- an acknowledgement for somebody else's request+ "{\"jsonrpc\":\"2.0\",\"result\":31337,\"id\":42}",+ ack,+ -- our own early received notification: seen, but not terminal+ "{\"jsonrpc\":\"2.0\",\"method\":\"signatureNotification\",\"params\":{\"result\":{\"context\":{\"slot\":5207600},\"value\":\"receivedSignature\"},\"subscription\":24006}}",+ terminalNotice+ ]+ result <- awaitSignature transport (RequestId 1) (Just "confirmed") 5 (unsafeSigFromString docSignature)+ result @?= Right 5207624,+ testCase "reports a subscription rejected by the node" $ do+ (transport, _) <- scriptedTransport ["{\"jsonrpc\":\"2.0\",\"error\":{\"code\":-32602,\"message\":\"Invalid Request\"},\"id\":1}"]+ result <- awaitSignature transport (RequestId 1) Nothing 5 (unsafeSigFromString docSignature)+ assertBool ("expected a subscription failure, got " <> show result) (either ("subscription failed" `isInfixOf`) (const False) result),+ testCase "reports an unparseable frame instead of hanging" $ do+ (transport, _) <- scriptedTransport ["not json"]+ result <- awaitSignature transport (RequestId 1) Nothing 5 (unsafeSigFromString docSignature)+ assertBool ("expected a parse failure, got " <> show result) (either (const True) (const False) result),+ testCase "times out when the node never answers" $ do+ (transport, _) <- scriptedTransport []+ result <- awaitSignature transport (RequestId 1) Nothing 1 (unsafeSigFromString docSignature)+ assertBool ("expected a timeout, got " <> show result) (either ("timed out" `isInfixOf`) (const False) result)+ ]++isLeft :: Either a b -> Bool+isLeft = either (const True) (const False)++assertFailure' :: String -> IO a+assertFailure' = assertFailure
+ test/Test/SplPrograms/AssociatedTokenAccount.hs view
@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.SplPrograms.AssociatedTokenAccount (tests) where++import Data.ByteString qualified as BS+import Network.Solana.Core.Crypto+import Network.Solana.Core.Instruction+import Network.Solana.SplPrograms.AssociatedTokenAccount qualified as Ata+import Network.Solana.SplPrograms.Token qualified as Tok+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit++mintPk :: SolanaPublicKey+mintPk = unsafeSolanaPublicKeyRaw (replicate 32 12)++payerPk :: SolanaPublicKey+payerPk =+ case createSolanaKeypairFromSeed (BS.replicate 32 1) of+ Just (pk, _) -> pk+ Nothing -> error "failed to derive payer"++tests :: TestTree+tests =+ withResource (loadFixtures "test/fixtures/pda.json") (const (pure ())) $ \getFixtures ->+ testGroup+ "Associated Token Account"+ [ testCase "getAssociatedTokenAddress matches Rust" $ do+ fs <- getFixtures+ case Ata.getAssociatedTokenAddress payerPk mintPk of+ Nothing -> assertFailure "no ATA derivable"+ Just ata -> getSolanaPublicKeyRaw ata @?= requireFixture "ata-address" fs,+ testCase "create-idempotent data byte" $ do+ case Ata.getAssociatedTokenAddress payerPk mintPk of+ Nothing -> assertFailure "no ATA derivable"+ Just _ ->+ instrData (iData (Ata.createAssociatedTokenAccountIdempotent payerPk payerPk mintPk))+ @?= BS.singleton 1,+ testCase "create data byte" $+ instrData (iData (Ata.createAssociatedTokenAccount payerPk payerPk mintPk))+ @?= BS.singleton 0,+ testCase "create metas" $ do+ fs <- getFixtures+ let expectedAta = unsafeSolanaPublicKeyRaw (BS.unpack (requireFixture "ata-address" fs))+ iAccounts (Ata.createAssociatedTokenAccount payerPk payerPk mintPk)+ @?= [ AccountMeta {accountPubKey = payerPk, isSigner = True, isWritable = True},+ AccountMeta {accountPubKey = expectedAta, isSigner = False, isWritable = True},+ AccountMeta {accountPubKey = payerPk, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = mintPk, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Ata.systemProgramRef, isSigner = False, isWritable = False},+ AccountMeta {accountPubKey = Tok.tokenProgramId, isSigner = False, isWritable = False}+ ]+ ]
+ test/Test/SplPrograms/Memo.hs view
@@ -0,0 +1,31 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.SplPrograms.Memo (tests) where++import Data.ByteString qualified as BS+import Network.Solana.Core.Crypto (SolanaPublicKey, unsafeSolanaPublicKeyRaw)+import Network.Solana.Core.Instruction+import Network.Solana.SplPrograms.Memo qualified as Memo+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit++signerPk :: SolanaPublicKey+signerPk = unsafeSolanaPublicKeyRaw (replicate 32 4)++dataOf :: Instruction -> BS.ByteString+dataOf = instrData . iData++tests :: TestTree+tests =+ testGroup+ "Memo"+ [ testCase "memo data bytes match Rust" $ do+ fs <- loadFixtures "test/fixtures/memo_instruction_data.json"+ dataOf (Memo.buildMemo "hello-memo" []) @?= requireFixture "memo-data" fs,+ testCase "signers become readonly-signer metas" $+ iAccounts (Memo.buildMemo "m" [signerPk])+ @?= [AccountMeta {accountPubKey = signerPk, isSigner = True, isWritable = False}],+ testCase "no signers means no account metas" $+ iAccounts (Memo.buildMemo "m" []) @?= []+ ]
+ test/Test/SplPrograms/Token.hs view
@@ -0,0 +1,320 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.SplPrograms.Token (tests) where++import Data.Binary (decode, decodeOrFail, encode)+import Data.Binary.Get (ByteOffset)+import Data.ByteString qualified as BS+import Data.ByteString.Lazy qualified as BL+import Data.List (isInfixOf)+import Network.Solana.Core.Crypto (SolanaPublicKey, unsafeSolanaPublicKeyRaw)+import Network.Solana.Core.Instruction (AccountMeta (..), iAccounts)+import Network.Solana.SplPrograms.Token qualified as Tok+import Test.Fixtures+import Test.Tasty+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++ownerKey :: SolanaPublicKey+ownerKey = unsafeSolanaPublicKeyRaw (map fromIntegral [0x8a :: Int, 0x88, 0xe3, 0xdd, 0x74, 0x09, 0xf1, 0x95, 0xfd, 0x52, 0xdb, 0x2d, 0x3c, 0xba, 0x5d, 0x72, 0xca, 0x67, 0x09, 0xbf, 0x1d, 0x94, 0x12, 0x1b, 0xf3, 0x74, 0x88, 0x01, 0xb4, 0x0f, 0x6f, 0x5c])++walletPk, delegatePk, mintPk, sig1Pk, sig2Pk, accountPk :: SolanaPublicKey+walletPk = unsafeSolanaPublicKeyRaw (replicate 32 11)+delegatePk = unsafeSolanaPublicKeyRaw (replicate 32 13)+mintPk = unsafeSolanaPublicKeyRaw (replicate 32 12)+sig1Pk = unsafeSolanaPublicKeyRaw (replicate 32 14)+sig2Pk = unsafeSolanaPublicKeyRaw (replicate 32 15)+accountPk = unsafeSolanaPublicKeyRaw (replicate 32 16)++enc :: Tok.TokenInstruction -> BS.ByteString+enc = BL.toStrict . encode++genTokenInstruction :: Gen Tok.TokenInstruction+genTokenInstruction =+ oneof+ [ Tok.InitializeMint <$> arbitrary <*> genPk <*> genMaybePk,+ pure Tok.InitializeAccount,+ Tok.InitializeMultisig <$> arbitrary,+ Tok.Transfer <$> arbitrary,+ Tok.Approve <$> arbitrary,+ pure Tok.Revoke,+ Tok.SetAuthority <$> genAuthType <*> genMaybePk,+ Tok.MintTo <$> arbitrary,+ Tok.Burn <$> arbitrary,+ pure Tok.CloseAccount,+ pure Tok.FreezeAccount,+ pure Tok.ThawAccount,+ Tok.TransferChecked <$> arbitrary <*> arbitrary,+ Tok.ApproveChecked <$> arbitrary <*> arbitrary,+ Tok.MintToChecked <$> arbitrary <*> arbitrary,+ Tok.BurnChecked <$> arbitrary <*> arbitrary,+ Tok.InitializeAccount2 <$> genPk,+ pure Tok.SyncNative,+ Tok.InitializeAccount3 <$> genPk,+ Tok.InitializeMultisig2 <$> arbitrary,+ Tok.InitializeMint2 <$> arbitrary <*> genPk <*> genMaybePk+ ]+ where+ genPk = unsafeSolanaPublicKeyRaw <$> vectorOf 32 arbitrary+ genMaybePk = oneof [pure Nothing, Just <$> genPk]+ genAuthType = elements [Tok.MintTokens, Tok.FreezeAuthority, Tok.AccountOwner, Tok.CloseAuthority]++tests :: TestTree+tests =+ testGroup+ "SPL Token"+ [ withResource (loadFixtures "test/fixtures/token_instruction_data.json") (const (pure ())) $ \getFixtures ->+ testGroup+ "SPL Token instruction data (golden + properties)"+ [ goldenCase getFixtures "InitializeMint-some" (Tok.InitializeMint 6 walletPk (Just delegatePk)),+ goldenCase getFixtures "InitializeMint-none" (Tok.InitializeMint 6 walletPk Nothing),+ goldenCase getFixtures "InitializeAccount" Tok.InitializeAccount,+ goldenCase getFixtures "InitializeMultisig" (Tok.InitializeMultisig 2),+ goldenCase getFixtures "Transfer" (Tok.Transfer 1000000),+ goldenCase getFixtures "Approve" (Tok.Approve 1000000),+ goldenCase getFixtures "Revoke" Tok.Revoke,+ goldenCase getFixtures "SetAuthority-some" (Tok.SetAuthority Tok.AccountOwner (Just delegatePk)),+ goldenCase getFixtures "SetAuthority-none" (Tok.SetAuthority Tok.CloseAuthority Nothing),+ goldenCase getFixtures "SetAuthority-mint-tokens" (Tok.SetAuthority Tok.MintTokens (Just delegatePk)),+ goldenCase getFixtures "SetAuthority-freeze" (Tok.SetAuthority Tok.FreezeAuthority Nothing),+ goldenCase getFixtures "MintTo" (Tok.MintTo 1000000),+ goldenCase getFixtures "Burn" (Tok.Burn 1000000),+ goldenCase getFixtures "CloseAccount" Tok.CloseAccount,+ goldenCase getFixtures "FreezeAccount" Tok.FreezeAccount,+ goldenCase getFixtures "ThawAccount" Tok.ThawAccount,+ goldenCase getFixtures "TransferChecked" (Tok.TransferChecked 1000000 6),+ goldenCase getFixtures "ApproveChecked" (Tok.ApproveChecked 1000000 6),+ goldenCase getFixtures "MintToChecked" (Tok.MintToChecked 1000000 6),+ goldenCase getFixtures "BurnChecked" (Tok.BurnChecked 1000000 6),+ goldenCase getFixtures "InitializeAccount2" (Tok.InitializeAccount2 walletPk),+ goldenCase getFixtures "SyncNative" Tok.SyncNative,+ goldenCase getFixtures "InitializeAccount3" (Tok.InitializeAccount3 walletPk),+ goldenCase getFixtures "InitializeMultisig2" (Tok.InitializeMultisig2 2),+ goldenCase getFixtures "InitializeMint2-some" (Tok.InitializeMint2 6 walletPk (Just delegatePk)),+ testCase "transfer metas (single owner)" $+ iAccounts (Tok.transfer accountPk delegatePk walletPk [] 1000000)+ @?= [ AccountMeta accountPk False True,+ AccountMeta delegatePk False True,+ AccountMeta walletPk True False+ ],+ testCase "transfer metas (multisig)" $+ iAccounts (Tok.transfer accountPk delegatePk walletPk [sig1Pk, sig2Pk] 1000000)+ @?= [ AccountMeta accountPk False True,+ AccountMeta delegatePk False True,+ AccountMeta walletPk False False,+ AccountMeta sig1Pk True False,+ AccountMeta sig2Pk True False+ ],+ testCase "transferChecked metas" $+ iAccounts (Tok.transferChecked accountPk mintPk delegatePk walletPk [] 1000000 6)+ @?= [ AccountMeta accountPk False True,+ AccountMeta mintPk False False,+ AccountMeta delegatePk False True,+ AccountMeta walletPk True False+ ],+ testCase "initializeMint metas" $+ iAccounts (Tok.initializeMint mintPk 6 walletPk (Just delegatePk))+ @?= [ AccountMeta mintPk False True,+ AccountMeta Tok.rentSysvar False False+ ],+ testCase "mintTo metas" $+ iAccounts (Tok.mintTo mintPk accountPk walletPk [] 1000000)+ @?= [ AccountMeta mintPk False True,+ AccountMeta accountPk False True,+ AccountMeta walletPk True False+ ],+ testCase "burn metas" $+ iAccounts (Tok.burn accountPk mintPk walletPk [] 1000000)+ @?= [ AccountMeta accountPk False True,+ AccountMeta mintPk False True,+ AccountMeta walletPk True False+ ],+ testCase "closeAccount metas" $+ iAccounts (Tok.closeAccount accountPk delegatePk walletPk [])+ @?= [ AccountMeta accountPk False True,+ AccountMeta delegatePk False True,+ AccountMeta walletPk True False+ ],+ testCase "approve metas" $+ iAccounts (Tok.approve accountPk delegatePk walletPk [] 1000000)+ @?= [ AccountMeta accountPk False True,+ AccountMeta delegatePk False False,+ AccountMeta walletPk True False+ ],+ testCase "revoke metas" $+ iAccounts (Tok.revoke accountPk walletPk [])+ @?= [ AccountMeta accountPk False True,+ AccountMeta walletPk True False+ ],+ testCase "setAuthority metas" $+ iAccounts (Tok.setAuthority mintPk Tok.AccountOwner (Just delegatePk) walletPk [])+ @?= [ AccountMeta mintPk False True,+ AccountMeta walletPk True False+ ],+ testCase "initializeAccount metas" $+ iAccounts (Tok.initializeAccount accountPk mintPk walletPk)+ @?= [ AccountMeta accountPk False True,+ AccountMeta mintPk False False,+ AccountMeta walletPk False False,+ AccountMeta Tok.rentSysvar False False+ ],+ testCase "freezeAccount metas" $+ iAccounts (Tok.freezeAccount accountPk mintPk walletPk [])+ @?= [ AccountMeta accountPk False True,+ AccountMeta mintPk False False,+ AccountMeta walletPk True False+ ],+ testCase "thawAccount metas" $+ iAccounts (Tok.thawAccount accountPk mintPk walletPk [])+ @?= [ AccountMeta accountPk False True,+ AccountMeta mintPk False False,+ AccountMeta walletPk True False+ ],+ testCase "syncNative metas" $+ iAccounts (Tok.syncNative accountPk)+ @?= [AccountMeta accountPk False True],+ testCase "initializeMultisig metas" $+ iAccounts (Tok.initializeMultisig accountPk [sig1Pk, sig2Pk] 2)+ @?= [ AccountMeta accountPk False True,+ AccountMeta Tok.rentSysvar False False,+ AccountMeta sig1Pk False False,+ AccountMeta sig2Pk False False+ ],+ testCase "initializeMultisig2 metas" $+ iAccounts (Tok.initializeMultisig2 accountPk [sig1Pk, sig2Pk] 2)+ @?= [ AccountMeta accountPk False True,+ AccountMeta sig1Pk False False,+ AccountMeta sig2Pk False False+ ],+ testCase "approveChecked metas" $+ iAccounts (Tok.approveChecked accountPk mintPk delegatePk walletPk [] 1000000 6)+ @?= [ AccountMeta accountPk False True,+ AccountMeta mintPk False False,+ AccountMeta delegatePk False False,+ AccountMeta walletPk True False+ ],+ testCase "mintToChecked metas" $+ iAccounts (Tok.mintToChecked mintPk accountPk walletPk [] 1000000 6)+ @?= [ AccountMeta mintPk False True,+ AccountMeta accountPk False True,+ AccountMeta walletPk True False+ ],+ testCase "burnChecked metas" $+ iAccounts (Tok.burnChecked accountPk mintPk walletPk [] 1000000 6)+ @?= [ AccountMeta accountPk False True,+ AccountMeta mintPk False True,+ AccountMeta walletPk True False+ ],+ testCase "initializeAccount2 (builder) metas" $+ iAccounts (Tok.initializeAccount2 accountPk mintPk walletPk)+ @?= [ AccountMeta accountPk False True,+ AccountMeta mintPk False False,+ AccountMeta Tok.rentSysvar False False+ ],+ testCase "initializeAccount3 (builder) metas" $+ iAccounts (Tok.initializeAccount3 accountPk mintPk walletPk)+ @?= [ AccountMeta accountPk False True,+ AccountMeta mintPk False False+ ],+ testCase "initializeMint2 (builder) metas" $+ iAccounts (Tok.initializeMint2 mintPk 6 walletPk (Just delegatePk))+ @?= [AccountMeta mintPk False True],+ testProperty "Binary round-trip" $+ forAll genTokenInstruction $ \ti -> decode (encode ti) === ti,+ testCase "decode fails on unknown discriminant" $+ case decodeOrFail (BL.pack [21]) :: Either (BL.ByteString, ByteOffset, String) (BL.ByteString, ByteOffset, Tok.TokenInstruction) of+ Left _ -> pure ()+ Right _ -> assertFailure "expected decode failure for discriminant 21"+ ],+ withResource (loadFixtures "test/fixtures/state_fixtures.json") (const (pure ())) $ \getFixtures ->+ testGroup+ "SPL Token state decoders (golden + rejection)"+ [ testCase "decodeTokenAccount: token-account golden" $ do+ fs <- getFixtures+ let bs = requireFixture "token-account" fs+ case Tok.decodeTokenAccount bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right ta -> do+ Tok.taMint ta @?= unsafeSolanaPublicKeyRaw (replicate 32 12)+ Tok.taOwner ta @?= ownerKey+ Tok.taAmount ta @?= 5000000+ Tok.taDelegate ta @?= Just (unsafeSolanaPublicKeyRaw (replicate 32 13))+ Tok.taState ta @?= Tok.TokenAccountFrozen+ Tok.taIsNative ta @?= Just 2039280+ Tok.taDelegatedAmount ta @?= 1000+ Tok.taCloseAuthority ta @?= Just (unsafeSolanaPublicKeyRaw (replicate 32 20)),+ testCase "decodeTokenAccount: token-account-minimal golden" $ do+ fs <- getFixtures+ let bs = requireFixture "token-account-minimal" fs+ case Tok.decodeTokenAccount bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right ta -> do+ Tok.taMint ta @?= unsafeSolanaPublicKeyRaw (replicate 32 12)+ Tok.taOwner ta @?= ownerKey+ Tok.taAmount ta @?= 5000000+ Tok.taDelegate ta @?= Nothing+ Tok.taState ta @?= Tok.TokenAccountInitialized+ Tok.taIsNative ta @?= Nothing+ Tok.taDelegatedAmount ta @?= 0+ Tok.taCloseAuthority ta @?= Nothing,+ testCase "decodeMint: mint golden" $ do+ fs <- getFixtures+ let bs = requireFixture "mint" fs+ case Tok.decodeMint bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right m -> do+ Tok.mMintAuthority m @?= Just ownerKey+ Tok.mSupply m @?= 1000000000+ Tok.mDecimals m @?= 6+ Tok.mIsInitialized m @?= True+ Tok.mFreezeAuthority m @?= Just (unsafeSolanaPublicKeyRaw (replicate 32 20)),+ testCase "decodeMint: mint-minimal golden" $ do+ fs <- getFixtures+ let bs = requireFixture "mint-minimal" fs+ case Tok.decodeMint bs of+ Left err -> assertFailure $ "decode failed: " <> err+ Right m -> do+ Tok.mMintAuthority m @?= Nothing+ Tok.mSupply m @?= 1000000000+ Tok.mDecimals m @?= 6+ Tok.mIsInitialized m @?= True+ Tok.mFreezeAuthority m @?= Nothing,+ testCase "decodeTokenAccount: reject 164 bytes" $ do+ let bs = BS.replicate 164 0+ case Tok.decodeTokenAccount bs of+ Left err -> assertBool "error message contains length" ("164" `elem` words err)+ Right _ -> assertFailure "expected decode failure for 164 bytes",+ testCase "decodeTokenAccount: reject 166 bytes" $ do+ let bs = BS.replicate 166 0+ case Tok.decodeTokenAccount bs of+ Left err -> assertBool "error message contains length" ("166" `elem` words err)+ Right _ -> assertFailure "expected decode failure for 166 bytes",+ testCase "decodeTokenAccount: reject invalid COption tag" $ do+ let bs = BS.replicate 165 0xFF+ case Tok.decodeTokenAccount bs of+ Left err -> assertBool "error message contains COption tag" ("COption" `isInfixOf` err || "tag" `isInfixOf` err)+ Right _ -> assertFailure "expected decode failure for 0xFF bytes",+ testCase "decodeMint: reject 81 bytes" $ do+ let bs = BS.replicate 81 0+ case Tok.decodeMint bs of+ Left err -> assertBool "error message contains length" ("81" `elem` words err)+ Right _ -> assertFailure "expected decode failure for 81 bytes",+ testCase "decodeMint: reject 83 bytes" $ do+ let bs = BS.replicate 83 0+ case Tok.decodeMint bs of+ Left err -> assertBool "error message contains length" ("83" `elem` words err)+ Right _ -> assertFailure "expected decode failure for 83 bytes",+ testCase "decodeMint: reject invalid is_initialized byte" $ do+ fs <- getFixtures+ let validBS = requireFixture "mint" fs+ modifiedBS = BS.concat [BS.take 45 validBS, BS.singleton 0x02, BS.drop 46 validBS]+ case Tok.decodeMint modifiedBS of+ Left err -> assertBool "error message contains is_initialized" ("is_initialized" `isInfixOf` err)+ Right _ -> assertFailure "expected decode failure for invalid is_initialized byte"+ ]+ ]+ where+ goldenCase getFixtures name ti =+ testCase name $ do+ fs <- getFixtures+ enc ti @?= requireFixture name fs
+ test/fixtures/alt_instruction_data.json view
@@ -0,0 +1,22 @@+[+ {+ "hex": "000000003930000000000000fe",+ "name": "CreateLookupTable"+ },+ {+ "hex": "01000000",+ "name": "FreezeLookupTable"+ },+ {+ "hex": "0200000002000000000000001d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e",+ "name": "ExtendLookupTable"+ },+ {+ "hex": "03000000",+ "name": "DeactivateLookupTable"+ },+ {+ "hex": "04000000",+ "name": "CloseLookupTable"+ }+]
+ test/fixtures/compute_budget_instruction_data.json view
@@ -0,0 +1,18 @@+[+ {+ "hex": "0100800000",+ "name": "RequestHeapFrame"+ },+ {+ "hex": "02400d0300",+ "name": "SetComputeUnitLimit"+ },+ {+ "hex": "03e803000000000000",+ "name": "SetComputeUnitPrice"+ },+ {+ "hex": "0400000100",+ "name": "SetLoadedAccountsDataSizeLimit"+ }+]
+ test/fixtures/loader_instruction_data.json view
@@ -0,0 +1,34 @@+[+ {+ "hex": "00000000",+ "name": "InitializeBuffer"+ },+ {+ "hex": "01000000800000004000000000000000abababababababababababababababababababababababababababababababababababababababababababababababababababababababababababababababab",+ "name": "Write"+ },+ {+ "hex": "020000000000100000000000",+ "name": "DeployWithMaxDataLen"+ },+ {+ "hex": "03000000",+ "name": "Upgrade"+ },+ {+ "hex": "04000000",+ "name": "SetAuthority"+ },+ {+ "hex": "05000000",+ "name": "Close"+ },+ {+ "hex": "0600000000100000",+ "name": "ExtendProgram"+ },+ {+ "hex": "07000000",+ "name": "SetAuthorityChecked"+ }+]
+ test/fixtures/memo_instruction_data.json view
@@ -0,0 +1,6 @@+[+ {+ "hex": "68656c6c6f2d6d656d6f",+ "name": "memo-data"+ }+]
+ test/fixtures/messages.json view
@@ -0,0 +1,10 @@+[+ {+ "hex": "010001038a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c02020202020202020202020202020202020202020202020202020202020202020000000000000000000000000000000000000000000000000000000000000000090909090909090909090909090909090909090909090909090909090909090901020200010c0200000000ca9a3b00000000",+ "name": "transfer-message"+ },+ {+ "hex": "010001038a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c02020202020202020202020202020202020202020202020202020202020202020000000000000000000000000000000000000000000000000000000000000000090909090909090909090909090909090909090909090909090909090909090902020200010c0200000000ca9a3b000000000201000c08000000c800000000000000",+ "name": "transfer-allocate-message"+ }+]
+ test/fixtures/metadata_instruction_data.json view
@@ -0,0 +1,61 @@+[+ {+ "hex": "2112000000536f6c616e61204861736b656c6c204e465405000000534853444b1c00000068747470733a2f2f6578616d706c652e636f6d2f6e66742e6a736f6e260201020000008a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c013c212121212121212121212121212121212121212121212121212121212121212100280100222222222222222222222222222222222222222222222222222222222222222201010a000000000000000a000000000000000101000000000000000000",+ "name": "CreateMetadataAccountV3-full"+ },+ {+ "hex": "2112000000536f6c616e61204861736b656c6c204e465405000000534853444b1c00000068747470733a2f2f6578616d706c652e636f6d2f6e66742e6a736f6e26020000000100",+ "name": "CreateMetadataAccountV3-minimal"+ },+ {+ "hex": "0f0112000000536f6c616e61204861736b656c6c204e465405000000534853444b1c00000068747470733a2f2f6578616d706c652e636f6d2f6e66742e6a736f6e260201020000008a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c013c212121212121212121212121212121212121212121212121212121212121212100280100222222222222222222222222222222222222222222222222222222222222222201010a000000000000000a00000000000000018a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c01010101",+ "name": "UpdateMetadataAccountV2-some"+ },+ {+ "hex": "0f00000000",+ "name": "UpdateMetadataAccountV2-none"+ },+ {+ "hex": "11016400000000000000",+ "name": "CreateMasterEditionV3-some"+ },+ {+ "hex": "1100",+ "name": "CreateMasterEditionV3-none"+ },+ {+ "accounts": [+ {+ "pubkey": "56a9c8b183e68c0582ef458b28a9f28894971e5aa21bd380aa210f6824f6ea89",+ "signer": false,+ "writable": true+ },+ {+ "pubkey": "0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c",+ "signer": false,+ "writable": false+ },+ {+ "pubkey": "8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c",+ "signer": true,+ "writable": false+ },+ {+ "pubkey": "8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c",+ "signer": true,+ "writable": true+ },+ {+ "pubkey": "8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c",+ "signer": true,+ "writable": false+ },+ {+ "pubkey": "0000000000000000000000000000000000000000000000000000000000000000",+ "signer": false,+ "writable": false+ }+ ],+ "name": "create-v3-full-accounts"+ }+]
+ test/fixtures/pda.json view
@@ -0,0 +1,42 @@+[+ {+ "hex": "8642e4d3a0e598c38a1973a5b357ec0e42aeae1c3b39c4120c7d5a822caa5d98",+ "name": "generic-pda-address"+ },+ {+ "hex": "fc",+ "name": "generic-pda-bump"+ },+ {+ "hex": "4795b40be0d30fa6202595ebcb06c94d134885ba92d230a6a77ca2aa035a7c05",+ "name": "ata-address"+ },+ {+ "hex": "fe",+ "name": "ata-bump"+ },+ {+ "hex": "6efe5d2accdbecfa532915bef37b76201a30d63af47e53dd1879b0d9acbdd5c9",+ "name": "dest-ata-address"+ },+ {+ "hex": "aca38e9d399501ebcc6c1e29c009874293d8d7f05250ef64a4cf62f9ac282b21",+ "name": "programdata-address"+ },+ {+ "hex": "59379caaad88710221975f8e4519c1f6f471825269818cd96ee5c14ea20adeba",+ "name": "lookup-table-address"+ },+ {+ "hex": "fe",+ "name": "lookup-table-bump"+ },+ {+ "hex": "56a9c8b183e68c0582ef458b28a9f28894971e5aa21bd380aa210f6824f6ea89",+ "name": "metadata-address"+ },+ {+ "hex": "a8b0140612ffc013e3300b768c9e666c6e1712d945bf6ca2cead99fbaa29c1e7",+ "name": "master-edition-address"+ }+]
+ test/fixtures/rpc_responses.json view
@@ -0,0 +1,1163 @@+[+ {+ "name": "getVersion",+ "method": "getVersion",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "feature-set": 3271415109,+ "solana-core": "2.1.16"+ },+ "id": 1+ }+ },+ {+ "name": "getIdentity",+ "method": "getIdentity",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "identity": "EWEDURnEjTRSa5Uz99Kf3hdThUD8X2Rv7RvMFLSQ1DCm"+ },+ "id": 1+ }+ },+ {+ "name": "getClusterNodes",+ "method": "getClusterNodes",+ "response": {+ "jsonrpc": "2.0",+ "result": [+ {+ "featureSet": 3271415109,+ "gossip": "127.0.0.1:1024",+ "pubkey": "EWEDURnEjTRSa5Uz99Kf3hdThUD8X2Rv7RvMFLSQ1DCm",+ "pubsub": "127.0.0.1:8900",+ "rpc": "127.0.0.1:8899",+ "serveRepair": "127.0.0.1:1035",+ "shredVersion": 24374,+ "tpu": "127.0.0.1:1027",+ "tpuForwards": "127.0.0.1:1028",+ "tpuForwardsQuic": "127.0.0.1:1034",+ "tpuQuic": "127.0.0.1:1033",+ "tpuVote": "127.0.0.1:1029",+ "tvu": "127.0.0.1:1025",+ "version": "2.1.16"+ }+ ],+ "id": 1+ }+ },+ {+ "name": "getHealth",+ "method": "getHealth",+ "response": {+ "jsonrpc": "2.0",+ "result": "ok",+ "id": 1+ }+ },+ {+ "name": "getEpochInfo",+ "method": "getEpochInfo",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "absoluteSlot": 41,+ "blockHeight": 41,+ "epoch": 0,+ "slotIndex": 41,+ "slotsInEpoch": 432000,+ "transactionCount": 45+ },+ "id": 1+ }+ },+ {+ "name": "getEpochSchedule",+ "method": "getEpochSchedule",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "firstNormalEpoch": 0,+ "firstNormalSlot": 0,+ "leaderScheduleSlotOffset": 432000,+ "slotsPerEpoch": 432000,+ "warmup": false+ },+ "id": 1+ }+ },+ {+ "name": "getGenesisHash",+ "method": "getGenesisHash",+ "response": {+ "jsonrpc": "2.0",+ "result": "SDdtDuPR4GB5dZDmAwuQbYTwP4x3EZcsDN4QvwJQHe4",+ "id": 1+ }+ },+ {+ "name": "getSlot",+ "method": "getSlot",+ "response": {+ "jsonrpc": "2.0",+ "result": 41,+ "id": 1+ }+ },+ {+ "name": "getBlockHeight",+ "method": "getBlockHeight",+ "response": {+ "jsonrpc": "2.0",+ "result": 41,+ "id": 1+ }+ },+ {+ "name": "getTransactionCount",+ "method": "getTransactionCount",+ "response": {+ "jsonrpc": "2.0",+ "result": 45,+ "id": 1+ }+ },+ {+ "name": "getFirstAvailableBlock",+ "method": "getFirstAvailableBlock",+ "response": {+ "jsonrpc": "2.0",+ "result": 0,+ "id": 1+ }+ },+ {+ "name": "getRecentPerformanceSamples",+ "method": "getRecentPerformanceSamples",+ "response": {+ "jsonrpc": "2.0",+ "result": [],+ "id": 1+ },+ "params": [+ 2+ ]+ },+ {+ "name": "getStakeMinimumDelegation",+ "method": "getStakeMinimumDelegation",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": 1000000000+ },+ "id": 1+ }+ },+ {+ "name": "getLatestBlockhash",+ "method": "getLatestBlockhash",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": {+ "blockhash": "FZjZju6aDpmcT8AhLTyvt7igyL4cwTRCUsyJNoinpQgS",+ "lastValidBlockHeight": 191+ }+ },+ "id": 1+ }+ },+ {+ "name": "isBlockhashValid",+ "method": "isBlockhashValid",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 72+ },+ "value": true+ },+ "id": 1+ },+ "params": [+ "FZjZju6aDpmcT8AhLTyvt7igyL4cwTRCUsyJNoinpQgS",+ {+ "commitment": "processed"+ }+ ]+ },+ {+ "name": "getBlock",+ "method": "getBlock",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "blockHeight": 5,+ "blockTime": 1785728550,+ "blockhash": "EXVev5y6y5FHypiG2c1QmQ7WR7jUeU1rwesbfTS8XML3",+ "parentSlot": 4,+ "previousBlockhash": "4phmBxWpU7uba3moNmwyDKbH1iADu4zsUUKHbXyVbqfx",+ "transactions": [+ {+ "meta": {+ "computeUnitsConsumed": 2100,+ "err": null,+ "fee": 10000,+ "innerInstructions": [],+ "loadedAddresses": {+ "readonly": [],+ "writable": []+ },+ "logMessages": [+ "Program Vote111111111111111111111111111111111111111 invoke [1]",+ "Program Vote111111111111111111111111111111111111111 success"+ ],+ "postBalances": [+ 499999977500,+ 1000000000000000,+ 1+ ],+ "postTokenBalances": [],+ "preBalances": [+ 499999987500,+ 1000000000000000,+ 1+ ],+ "preTokenBalances": [],+ "rewards": null,+ "status": {+ "Ok": null+ }+ },+ "transaction": {+ "message": {+ "accountKeys": [+ "EWEDURnEjTRSa5Uz99Kf3hdThUD8X2Rv7RvMFLSQ1DCm",+ "3nsvie2PSWMWitUgkKNzKqzaFEUhGahKW51HhR8ThqTc",+ "Vote111111111111111111111111111111111111111"+ ],+ "header": {+ "numReadonlySignedAccounts": 0,+ "numReadonlyUnsignedAccounts": 1,+ "numRequiredSignatures": 2+ },+ "instructions": [+ {+ "accounts": [+ 1,+ 1+ ],+ "data": "FMkqDfKmbTuLt2xkJs2QxzsZaVMEoSdQwbEzyF2LEjFHRAGq6Q1zFhNzyUNcBvC5DeMjm87vWA6u5RBkg5JD3XA8S9Hwq8fPEo4HS4KUfYx9viFQHaQa7xHLwfbvtP9H",+ "programIdIndex": 2,+ "stackHeight": null+ }+ ],+ "recentBlockhash": "4phmBxWpU7uba3moNmwyDKbH1iADu4zsUUKHbXyVbqfx"+ },+ "signatures": [+ "4h86FydrrWzWxWnFpSBxFhbh8zbuyUcKSXUZa58Pv9Xx97oosuCdrZk5KB67QVhpDtHbwu8JoG3bx7iVW2XQagBm",+ "9QCQT8kz1t256TtJbG7iLMKwtagGVgxbY1BubfKjdxWD5RRzqpkozRKJ9zmLNMXyAFRd7nTtMqb1yhMpkRJmxme"+ ]+ },+ "version": "legacy"+ },+ {+ "meta": {+ "computeUnitsConsumed": 150,+ "err": null,+ "fee": 5000,+ "innerInstructions": [],+ "loadedAddresses": {+ "readonly": [],+ "writable": []+ },+ "logMessages": [+ "Program 11111111111111111111111111111111 invoke [1]",+ "Program 11111111111111111111111111111111 success"+ ],+ "postBalances": [+ 8999995000,+ 1000000000,+ 1+ ],+ "postTokenBalances": [],+ "preBalances": [+ 10000000000,+ 0,+ 1+ ],+ "preTokenBalances": [],+ "rewards": null,+ "status": {+ "Ok": null+ }+ },+ "transaction": {+ "message": {+ "accountKeys": [+ "6o185vKXeS8D27dPfAKxJ2dNVD8iNjmRpFwdYYk3uSrT",+ "HR7KwDBsCkkoe9VPCuZhtwgcJMUMLMgFJb6n9WuLqyop",+ "11111111111111111111111111111111"+ ],+ "header": {+ "numReadonlySignedAccounts": 0,+ "numReadonlyUnsignedAccounts": 1,+ "numRequiredSignatures": 1+ },+ "instructions": [+ {+ "accounts": [+ 0,+ 1+ ],+ "data": "3Bxs3zzLZLuLQEYX",+ "programIdIndex": 2,+ "stackHeight": null+ }+ ],+ "recentBlockhash": "4phmBxWpU7uba3moNmwyDKbH1iADu4zsUUKHbXyVbqfx"+ },+ "signatures": [+ "4xzhXw7xxNCGfC74NKbZNEcr92zWdGviq4GJbksRxdXz2NGYFh8Jzyox5X7trorYyYvKEnPHkfNsAfCQA5KAhFRC"+ ]+ },+ "version": "legacy"+ }+ ]+ },+ "id": 1+ },+ "params": [+ 5,+ {+ "encoding": "json",+ "maxSupportedTransactionVersion": 0,+ "transactionDetails": "full",+ "rewards": false+ }+ ]+ },+ {+ "name": "getBlockCommitment",+ "method": "getBlockCommitment",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "commitment": [+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 0,+ 999999997717120+ ],+ "totalStake": 999999997717120+ },+ "id": 1+ },+ "params": [+ 5+ ]+ },+ {+ "name": "getBlockProduction",+ "method": "getBlockProduction",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": {+ "byIdentity": {+ "EWEDURnEjTRSa5Uz99Kf3hdThUD8X2Rv7RvMFLSQ1DCm": [+ 42,+ 42+ ]+ },+ "range": {+ "firstSlot": 0,+ "lastSlot": 41+ }+ }+ },+ "id": 1+ }+ },+ {+ "name": "getBlocks",+ "method": "getBlocks",+ "response": {+ "jsonrpc": "2.0",+ "result": [+ 3,+ 4,+ 5+ ],+ "id": 1+ },+ "params": [+ 3,+ 5+ ]+ },+ {+ "name": "getInflationGovernor",+ "method": "getInflationGovernor",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "foundation": 0.05,+ "foundationTerm": 7.0,+ "initial": 0.08,+ "taper": 0.15,+ "terminal": 0.015+ },+ "id": 1+ }+ },+ {+ "name": "getInflationRate",+ "method": "getInflationRate",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "epoch": 0,+ "foundation": 0.004,+ "total": 0.08,+ "validator": 0.076+ },+ "id": 1+ }+ },+ {+ "name": "getSupply",+ "method": "getSupply",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": {+ "circulating": 503000508500862375,+ "nonCirculating": 0,+ "nonCirculatingAccounts": [+ "8W58E8JVJjH1jCy5CeHJQgvwFXTyAVyesuXRZGbcSUGG",+ "DrKzW5koKSZp4mg4BdHLwr72MMXscd2kTiWgckCvvPXz",+ "GmyW1nqYcrw7P7JqrcyP9ivU9hYNbrgZ1r5SYJJH41Fs",+ "HbZ5FfmKWNHC7uwk6TF1hVi6TCs7dtYfdjEcuPGgzFAg",+ "nGME7HgBT6tAJN1f6YuCCngpqT5cvSTndZUVLjQ4jwA",+ "2WWb1gRzuXDd5viZLQF7pNRR6Y7UiyeaPpaL35X6j3ve",+ "3ZrsTmNM6AkMcqFfv3ryfhQ2jMfqP64RQbqVyAaxqhrQ",+ "CzAHrrrHKx9Lxf6wdCMrsZkLvk74c7J2vGv8VYPUmY6v",+ "6o5v1HC7WhBnLfRHp8mQTtCP2khdXXjhuyGyYEoy2Suy",+ "5khMKAcvmsFaAhoKkdg3u5abvKsmjUQNmhTNP624WB1F",+ "4vuWt1oHRqLMhf8Nv1zyEXZsYaeK7dipwrfKLoYU9Riq",+ "EMhn1U3TMimW3bvWYbPUvN2eZnCfsuBN4LGWhzzYhiWR",+ "Ep5Y58PaSyALPrdFxDVAdfKtVdP55vApvsWjb3jSmXsG",+ "HQJtLqvEGGxgNYfRXUurfxV8E1swvCnsbC3456ik27HY",+ "5D5NxsNVTgXHyVziwV7mDFwVDS6voaBsyyGxUbhQrhNW",+ "GdnSyH3YtwcxFvQrVVJMm1JhTS4QVX7MFsX56uJLUfiZ",+ "EMAY24PrS6rWfvpqffFCsTsFJypeeYYmtUc26wdh3Wup",+ "P8aKfWQPeRnsZtpBrwWTYzyAoRk74KMz56xc6NEpC4J",+ "GpxpMVhrBBBEYbEJxdR62w3daWz444V7m6dxYDZKH77D",+ "8rT45mqpuDBR1vcnDc9kwP9DrZAXDR4ZeuKWw3u1gTGa",+ "AsrYX4FeLXnZcrjcZmrASY2Eq1jvEeQfwxtNTxS5zojA",+ "14FUT96s9swbmH7ZjpDvfEDywnAYy9zaNhv4xvezySGu",+ "8pNBEppa1VcFAsx4Hzq9CpdXUXZjUXbvQwLX2K7QsCwb",+ "CsUqV42gVQLJwQsKyjWHqGkfHarxn9hcY4YeSjgaaeTd",+ "9S2M3UYPpnPZTBtbcUvehYmiWFK3kBhwfzV2iWuwvaVy",+ "Ab1UcdsFXZVnkSt1Z3vcYU65GQk5MvCbs54SviaiaqHb",+ "CY7X5o3Wi2eQhTocLmUS6JSWyx1NinBfW7AXRrkRCpi8",+ "GK8R4uUmrawcREZ5xJy5dAzVV5V7aFvYg77id37pVTK",+ "9xbcBZoGYFnfJZe81EDuDYKUm8xGkjzW8z4EgnVhNvsv",+ "HuqDWJodFhAEWh6aWdsDVUqsjRket5DYXMYyDYtD8hdN",+ "3itU5ME8L6FDqtMiRoUiT1F7PwbkTtHBbW51YWD5jtjm",+ "5PLJZLJiRR9vf7d1JCCg7UuWjtyN9nkab9uok6TqSyuP",+ "CUageMFi49kzoDqtdU8NvQ4Bq3sbtJygjKDAXJ45nmAi",+ "4pV47TiPzZ7SSBPHmgUvSLmH9mMSe8tjyPhQZGbi1zPC",+ "CVgyXrbEd1ctEuvq11QdpnCQVnPit8NLdhyqXQHLprM2",+ "5XdtyEDREHJXXW1CTtCsVjJRjBapAwK78ZquzvnNVRrV",+ "BsKsunvENxAraBrL77UfAn1Gi7unVEmQAdCbhsjUN6tU",+ "7Np41oeYqPefeNQEHSv1UDhYrehxin3NStELsSKCT4K2",+ "5q54XjQ7vDx4y6KphPeE97LUNiYGtP55spjvXAWPGBuf",+ "3fV2GaDKa3pZxyDcpMh5Vrh2FVAMUiWUKbYmnBFv8As3",+ "Dc2oHxFXQaC2QfLStuU7txtD3U5HZ82MrCSGDooWjbsv",+ "3iPvAS4xdhYr6SkhVDHCLr7tJjMAFK4wvvHWJxFQVg15",+ "Br3aeVGapRb2xTq17RU2pYZCoJpWA7bq6TKBCcYtMSmt",+ "6yKHERk8rsbmJxvMpPuwPs1ct3hRiP7xaJF2tvnGU6nK",+ "7Y8smnoUrYKGGuDq2uaFKVxJYhojgg7DVixHyAtGTYEV",+ "GvpCiTgq9dmEeojCDBivoLoZqc4AkbUDACpqPMwYLWKh",+ "CakcnaRDHka2gXyfbEd2d3xsvkJkqsLw2akB3zsN1D2S",+ "8vqrX3H2BYLaXVintse3gorPEM4TgTwTFZNN1Fm9TdYs",+ "3bTGcGB9F98XxnrBNftmmm48JGfPgi5sYxDEKiCjQYk3",+ "BUnRE27mYXN9p8H1Ay24GXhJC88q2CuwLoNU2v2CrW4W",+ "GEWSkfWgHkpiLbeKaAnwvqnECGdRNf49at5nFccVey7c",+ "8ndGYFjav6NDXvzYcxs449Aub3AxYv4vYpk89zRDwgj7",+ "CuatS6njAcfkFHnvai7zXCs7syA9bykXWsDCJEWfhjHG",+ "AG3m2bAibcY8raMt4oXEGqRHwX4FWKPPJVjZxn1LySDX",+ "GumSE5HsMV5HCwBTv2D2D81yy9x17aDkvobkqAfTRgmo",+ "FwfaykN7ACnsEUDHANzGHqTGQZMcGnUSsahAHUqbdPrz",+ "F9MWFw8cnYVwsRq8Am1PGfFL3cQUZV37mbGoxZftzLjN",+ "BUjkdqUuH5Lz9XzcMcR4DdEMnFG6r8QzUMBm16Rfau96",+ "C7C8odR8oashR5Feyrq2tJKaXL18id1dSj2zbkDGL2C2",+ "CHmdL15akDcJgBkY6BP3hzs98Dqr6wbdDC5p8odvtSbq",+ "FR84wZQy3Y3j2gWz6pgETUiUoJtreMEuWfbg6573UCj9",+ "8CUUMKYNGxdgYio5CLHRHyzMEhhVRMcqefgE6dLqnVRK",+ "AzHQ8Bia1grVVbcGyci7wzueSWkgvu7YZVZ4B9rkL5P6",+ "63DtkW7zuARcd185EmHAkfF44bDcC2SiTSEj2spLP3iA",+ "xQadXQiUTCCFhfHjvQx1hyJK6KVWr1w2fD6DT3cdwj7",+ "HUAkU5psJXZuw54Lrg1ksbXzHv2fzczQ9sNbmisVMeJU",+ "AVYpwVou2BhdLivAwLxKPALZQsY7aZNkNmGbP2fZw7RU",+ "CWeRmXme7LmbaUWTZWFLt6FMnpzLCHaQLuR2TdgFn4Lq",+ "Fg12tB1tz8w6zJSQ4ZAGotWoCztdMJF9hqK8R11pakog",+ "6nN69B4uZuESZYxr9nrLDjmKRtjDZQXrehwkfQTKw62U",+ "FiWYY85b58zEEcPtxe3PuqzWPjqBJXqdwgZeqSBmT9Cn",+ "HCV5dGFJXRrJ3jhDYA4DCeb9TEDTwGGYXtT3wHksu2Zr",+ "GNiz4Mq886bTNDT3pijGsu2gbw6it7sqrwncro45USeB",+ "GK2zqSsXLA2rwVZk347RYhh6jJpRsCA69FjLW93ZGi3B",+ "4sxwau4mdqZ8zEJsfryXq4QFYnMJSCp3HWuZQod8WU5k",+ "H3Ni7vG1CsmJZdTvxF7RkAf9UM5qk4RsohJsmPvtZNnu",+ "7cvkjYAkUYs4W8XcXsca7cBrEGFeSUjeZmKoNBvEwyri",+ "Hz9nydgN1k15wnwffKX7CSmZp4VFTnTwLXAEdomFGNXy",+ "H1rt8KvXkNhQExTRfkY8r9wjZbZ8yCih6J4wQ5Fz9HGP",+ "Es13uD2p64UVPFpEWfDtd6SERdoNR2XVgqBQBZcZSLqW",+ "E8jcgWvrvV7rwYHJThwfiBeQ8VAH4FgNEEMG9aAuCMAq",+ "AzVV9ZZDxTgW4wWfJmsG6ytaHpQGSe1yz76Nyy84VbQF",+ "Mc5XB47H3DKJHym5RLa9mPzWv5snERsF3KNv5AauXK8",+ "9huDUZfxoJ7wGMTffUE7vh1xePqef7gyrLJu9NApncqA",+ "CND6ZjRTzaCFVdX7pSSWgjTfHZuhxqFDoUBqWBJguNoA",+ "JCwT5Ygmq3VeBEbDjL8s8E82Ra2rP9bq45QfZE7Xyaq7",+ "7xJ9CLtEAcEShw9kW2gSoZkRWL566Dg12cvgzANJwbTr",+ "DE1bawNcRJB9rVm3buyMVfr8mBEoyyu73NBovf2oXJsJ",+ "EziVYi3Sv5kJWxmU77PnbrT8jmkVuqwdiFLLzZpLVEn7",+ "Eyr9P5XsjK2NUKNCnfu39eqpGoiLFgVAv1LSQgMZCwiQ",+ "CQDYc4ET2mbFhVpgj41gXahL6Exn5ZoPcGAzSHuYxwmE",+ "DQQGPtj7pphPHCLzzBuEyDDQByUcKGrsJdsH7SP3hAug",+ "3o6xgkJ9sTmDeQWyfj3sxwon18fXJB9PV5LDc8sfgR4a",+ "Hm9JW7of5i9dnrboS8pCUCSeoQUPh7JsP1rkbJnW7An4",+ "BhvLngiqqKeZ8rpxch2uGjeCiC88zzewoWPRuoxpp1aS",+ "BuCEvc9ze8UoAQwwsQLy8d447C8sA4zeVtVpc6m5wQeS",+ "GhsotwFMH6XUrRLJCxcx62h7748N2Uq8mf87hUGkmPhg",+ "8UVjvYyoqP6sqcctTso3xpCdCfgTMiv3VRh7vraC2eJk",+ "8DE8fqPfv1fp9DHyGyDFFaMjpopMgDeXspzoi9jpBJjC",+ "HKJgYGTTYYR2ZkfJKHbn58w676fKueQXmvbtpyvrSM3N",+ "3jnknRabs7G2V9dKhxd2KP85pNWXKXiedYnYxtySnQMs",+ "Fgyh8EeYGZtbW8sS33YmNQnzx54WXPrJ5KWNPkCfWPot",+ "5smrYwb1Hr2T8XMnvsqccTgXxuqQs14iuE8RbHFYf2Cf",+ "6zw7em7uQdmMpuS9fGz8Nq9TLHa5YQhEKKwPjo5PwDK4",+ "9hknftBZAQL4f48tWfk3bUEV5YSLcYYtDRqNmpNnhCWG",+ "DUS1KxwUhUyDKB4A81E8vdnTe3hSahd92Abtn9CXsEcj",+ "GLUmCeJpXB8veNcchPwibkRYwCwvQbKodex5mEjrgToi",+ "EAJJD6nDqtXcZ4DnQb19F9XEz8y8bRDHxbWbahatZNbL",+ "GpYnVDgB7dzvwSgsjQFeHznjG6Kt1DLBFYrKxjGU1LuD",+ "CTvhdUVf8KNyMbyEdnvRrBCHJjBKtQwkbj6zwoqcEssG"+ ],+ "total": 503000508500862375+ }+ },+ "id": 1+ }+ },+ {+ "name": "getVoteAccounts",+ "method": "getVoteAccounts",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "current": [+ {+ "activatedStake": 999999997717120,+ "commission": 0,+ "epochCredits": [+ [+ 0,+ 144,+ 0+ ]+ ],+ "epochVoteAccount": true,+ "lastVote": 40,+ "nodePubkey": "EWEDURnEjTRSa5Uz99Kf3hdThUD8X2Rv7RvMFLSQ1DCm",+ "rootSlot": 9,+ "votePubkey": "3nsvie2PSWMWitUgkKNzKqzaFEUhGahKW51HhR8ThqTc"+ }+ ],+ "delinquent": []+ },+ "id": 1+ }+ },+ {+ "name": "getMinimumBalanceForRentExemption",+ "method": "getMinimumBalanceForRentExemption",+ "response": {+ "jsonrpc": "2.0",+ "result": 2039280,+ "id": 1+ },+ "params": [+ 165+ ]+ },+ {+ "name": "getBalance",+ "method": "getBalance",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": 8996474120+ },+ "id": 1+ },+ "params": [+ "6o185vKXeS8D27dPfAKxJ2dNVD8iNjmRpFwdYYk3uSrT"+ ]+ },+ {+ "name": "getAccountInfo",+ "method": "getAccountInfo",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": {+ "data": [+ "",+ "base64"+ ],+ "executable": false,+ "lamports": 8996474120,+ "owner": "11111111111111111111111111111111",+ "rentEpoch": 18446744073709551615,+ "space": 0+ }+ },+ "id": 1+ },+ "params": [+ "6o185vKXeS8D27dPfAKxJ2dNVD8iNjmRpFwdYYk3uSrT",+ {+ "encoding": "base64"+ }+ ]+ },+ {+ "name": "getAccountInfo-missing",+ "method": "getAccountInfo",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": null+ },+ "id": 1+ },+ "params": [+ "11111111111111111111111111111112",+ {+ "encoding": "base64"+ }+ ]+ },+ {+ "name": "getMultipleAccounts",+ "method": "getMultipleAccounts",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": [+ {+ "data": [+ "",+ "base64"+ ],+ "executable": false,+ "lamports": 8996474120,+ "owner": "11111111111111111111111111111111",+ "rentEpoch": 18446744073709551615,+ "space": 0+ },+ {+ "data": [+ "",+ "base64"+ ],+ "executable": false,+ "lamports": 1000000000,+ "owner": "11111111111111111111111111111111",+ "rentEpoch": 18446744073709551615,+ "space": 0+ }+ ]+ },+ "id": 1+ },+ "params": [+ [+ "6o185vKXeS8D27dPfAKxJ2dNVD8iNjmRpFwdYYk3uSrT",+ "HR7KwDBsCkkoe9VPCuZhtwgcJMUMLMgFJb6n9WuLqyop"+ ],+ {+ "encoding": "base64"+ }+ ]+ },+ {+ "name": "getLargestAccounts",+ "method": "getLargestAccounts",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": [+ {+ "address": "594C9C199Zp8fK2zvmXrSveE359gijrM6tsoZLYk9obv",+ "lamports": 500000000000000000+ },+ {+ "address": "BxqNA9vLoWDNiEBzZ4na79hBvUUke2jfTXiki4sfr5J4",+ "lamports": 1000000000000000+ },+ {+ "address": "3nsvie2PSWMWitUgkKNzKqzaFEUhGahKW51HhR8ThqTc",+ "lamports": 1000000000000000+ },+ {+ "address": "D758ERd8UUz83zLzxG2ykpTGSWog3HFjST7Bu1nd3bPm",+ "lamports": 999989999995000+ },+ {+ "address": "EWEDURnEjTRSa5Uz99Kf3hdThUD8X2Rv7RvMFLSQ1DCm",+ "lamports": 499999815000+ },+ {+ "address": "6o185vKXeS8D27dPfAKxJ2dNVD8iNjmRpFwdYYk3uSrT",+ "lamports": 8996474120+ },+ {+ "address": "DoU57AYuPFu2QU514RktNPG22QhApEjnKxnBcu4BHDTY",+ "lamports": 3773078640+ },+ {+ "address": "HR7KwDBsCkkoe9VPCuZhtwgcJMUMLMgFJb6n9WuLqyop",+ "lamports": 1000000000+ },+ {+ "address": "So11111111111111111111111111111111111111112",+ "lamports": 1000000000+ },+ {+ "address": "TokenkegQfeZyiNwAJbNbGKPFXCWuBvf9Ss623VQ5DA",+ "lamports": 929020800+ },+ {+ "address": "SysvarS1otHistory11111111111111111111111111",+ "lamports": 913326000+ },+ {+ "address": "ATokenGPvbdGVxr1b2hvZbsiqW5xWH25efTNsLJA8knL",+ "lamports": 731913600+ },+ {+ "address": "MemoSq4gqABAXKb96qnH8TysNcWxMyWCqXgDLGmfcHr",+ "lamports": 521498880+ },+ {+ "address": "SysvarS1otHashes111111111111111111111111111",+ "lamports": 143487360+ },+ {+ "address": "Memo1UhkJRfHyvLMcVucJwxXeuD728EqVDDwQDxFMNo",+ "lamports": 119712000+ },+ {+ "address": "SysvarStakeHistory1111111111111111111111111",+ "lamports": 114979200+ },+ {+ "address": "SysvarRecentB1ockHashes11111111111111111111",+ "lamports": 42706560+ },+ {+ "address": "B2kGD5aSJLL8yHUUC8v7VWWyF6DRN6m2kpjhiPin53oe",+ "lamports": 2039280+ },+ {+ "address": "nsAeRzrkWAUJkGnTnnx1nhr3DokGui17CLUNuEwnoaw",+ "lamports": 1461600+ },+ {+ "address": "SysvarC1ock11111111111111111111111111111111",+ "lamports": 1169280+ }+ ]+ },+ "id": 1+ }+ },+ {+ "name": "getProgramAccounts",+ "method": "getProgramAccounts",+ "response": {+ "jsonrpc": "2.0",+ "result": [+ {+ "account": {+ "data": [+ "AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAJAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==",+ "base64"+ ],+ "executable": false,+ "lamports": 1000000000,+ "owner": "TokenkegQfeZyiNwAJbNbGKPFXCWuBvf9Ss623VQ5DA",+ "rentEpoch": 1,+ "space": 82+ },+ "pubkey": "So11111111111111111111111111111111111111112"+ },+ {+ "account": {+ "data": [+ "AQAAAFYTSjtFgV37DhAKCpVZ7UaTRdOtkDEDLd/1PcZokXcYgN6AAgAAAAAGAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA==",+ "base64"+ ],+ "executable": false,+ "lamports": 1461600,+ "owner": "TokenkegQfeZyiNwAJbNbGKPFXCWuBvf9Ss623VQ5DA",+ "rentEpoch": 18446744073709551615,+ "space": 82+ },+ "pubkey": "nsAeRzrkWAUJkGnTnnx1nhr3DokGui17CLUNuEwnoaw"+ },+ {+ "account": {+ "data": [+ "C7/cEE+JL6u+L/IR/d1bk+Y8tafJlr26pB6MKVNffjBWE0o7RYFd+w4QCgqVWe1Gk0XTrZAxAy3f9T3GaJF3GIDegAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA",+ "base64"+ ],+ "executable": false,+ "lamports": 2039280,+ "owner": "TokenkegQfeZyiNwAJbNbGKPFXCWuBvf9Ss623VQ5DA",+ "rentEpoch": 18446744073709551615,+ "space": 165+ },+ "pubkey": "B2kGD5aSJLL8yHUUC8v7VWWyF6DRN6m2kpjhiPin53oe"+ }+ ],+ "id": 1+ },+ "params": [+ "TokenkegQfeZyiNwAJbNbGKPFXCWuBvf9Ss623VQ5DA",+ {+ "encoding": "base64"+ }+ ]+ },+ {+ "name": "getSignaturesForAddress",+ "method": "getSignaturesForAddress",+ "response": {+ "jsonrpc": "2.0",+ "result": [+ {+ "blockTime": 1785728550,+ "confirmationStatus": "finalized",+ "err": null,+ "memo": null,+ "signature": "4xzhXw7xxNCGfC74NKbZNEcr92zWdGviq4GJbksRxdXz2NGYFh8Jzyox5X7trorYyYvKEnPHkfNsAfCQA5KAhFRC",+ "slot": 5+ }+ ],+ "id": 1+ },+ "params": [+ "HR7KwDBsCkkoe9VPCuZhtwgcJMUMLMgFJb6n9WuLqyop",+ {+ "limit": 3+ }+ ]+ },+ {+ "name": "getSignatureStatuses",+ "method": "getSignatureStatuses",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 72+ },+ "value": [+ {+ "confirmationStatus": "finalized",+ "confirmations": null,+ "err": null,+ "slot": 5,+ "status": {+ "Ok": null+ }+ }+ ]+ },+ "id": 1+ },+ "params": [+ [+ "4xzhXw7xxNCGfC74NKbZNEcr92zWdGviq4GJbksRxdXz2NGYFh8Jzyox5X7trorYyYvKEnPHkfNsAfCQA5KAhFRC"+ ],+ {+ "searchTransactionHistory": true+ }+ ]+ },+ {+ "name": "getTransaction",+ "method": "getTransaction",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "blockTime": 1785728550,+ "meta": {+ "computeUnitsConsumed": 150,+ "err": null,+ "fee": 5000,+ "innerInstructions": [],+ "loadedAddresses": {+ "readonly": [],+ "writable": []+ },+ "logMessages": [+ "Program 11111111111111111111111111111111 invoke [1]",+ "Program 11111111111111111111111111111111 success"+ ],+ "postBalances": [+ 8999995000,+ 1000000000,+ 1+ ],+ "postTokenBalances": [],+ "preBalances": [+ 10000000000,+ 0,+ 1+ ],+ "preTokenBalances": [],+ "rewards": [],+ "status": {+ "Ok": null+ }+ },+ "slot": 5,+ "transaction": {+ "message": {+ "accountKeys": [+ "6o185vKXeS8D27dPfAKxJ2dNVD8iNjmRpFwdYYk3uSrT",+ "HR7KwDBsCkkoe9VPCuZhtwgcJMUMLMgFJb6n9WuLqyop",+ "11111111111111111111111111111111"+ ],+ "header": {+ "numReadonlySignedAccounts": 0,+ "numReadonlyUnsignedAccounts": 1,+ "numRequiredSignatures": 1+ },+ "instructions": [+ {+ "accounts": [+ 0,+ 1+ ],+ "data": "3Bxs3zzLZLuLQEYX",+ "programIdIndex": 2,+ "stackHeight": null+ }+ ],+ "recentBlockhash": "4phmBxWpU7uba3moNmwyDKbH1iADu4zsUUKHbXyVbqfx"+ },+ "signatures": [+ "4xzhXw7xxNCGfC74NKbZNEcr92zWdGviq4GJbksRxdXz2NGYFh8Jzyox5X7trorYyYvKEnPHkfNsAfCQA5KAhFRC"+ ]+ },+ "version": "legacy"+ },+ "id": 1+ },+ "params": [+ "4xzhXw7xxNCGfC74NKbZNEcr92zWdGviq4GJbksRxdXz2NGYFh8Jzyox5X7trorYyYvKEnPHkfNsAfCQA5KAhFRC",+ {+ "encoding": "json",+ "maxSupportedTransactionVersion": 0+ }+ ]+ },+ {+ "name": "getTokenSupply",+ "method": "getTokenSupply",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": {+ "amount": "42000000",+ "decimals": 6,+ "uiAmount": 42.0,+ "uiAmountString": "42"+ }+ },+ "id": 1+ },+ "params": [+ "nsAeRzrkWAUJkGnTnnx1nhr3DokGui17CLUNuEwnoaw"+ ]+ },+ {+ "name": "getTokenAccountBalance",+ "method": "getTokenAccountBalance",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": {+ "amount": "42000000",+ "decimals": 6,+ "uiAmount": 42.0,+ "uiAmountString": "42"+ }+ },+ "id": 1+ },+ "params": [+ "B2kGD5aSJLL8yHUUC8v7VWWyF6DRN6m2kpjhiPin53oe"+ ]+ },+ {+ "name": "getTokenLargestAccounts",+ "method": "getTokenLargestAccounts",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": [+ {+ "address": "B2kGD5aSJLL8yHUUC8v7VWWyF6DRN6m2kpjhiPin53oe",+ "amount": "42000000",+ "decimals": 6,+ "uiAmount": 42.0,+ "uiAmountString": "42"+ }+ ]+ },+ "id": 1+ },+ "params": [+ "nsAeRzrkWAUJkGnTnnx1nhr3DokGui17CLUNuEwnoaw"+ ]+ },+ {+ "name": "getTokenAccountsByOwner",+ "method": "getTokenAccountsByOwner",+ "response": {+ "jsonrpc": "2.0",+ "result": {+ "context": {+ "apiVersion": "2.1.16",+ "slot": 41+ },+ "value": [+ {+ "account": {+ "data": [+ "C7/cEE+JL6u+L/IR/d1bk+Y8tafJlr26pB6MKVNffjBWE0o7RYFd+w4QCgqVWe1Gk0XTrZAxAy3f9T3GaJF3GIDegAIAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAQAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA",+ "base64"+ ],+ "executable": false,+ "lamports": 2039280,+ "owner": "TokenkegQfeZyiNwAJbNbGKPFXCWuBvf9Ss623VQ5DA",+ "rentEpoch": 18446744073709551615,+ "space": 165+ },+ "pubkey": "B2kGD5aSJLL8yHUUC8v7VWWyF6DRN6m2kpjhiPin53oe"+ }+ ]+ },+ "id": 1+ },+ "params": [+ "6o185vKXeS8D27dPfAKxJ2dNVD8iNjmRpFwdYYk3uSrT",+ {+ "mint": "nsAeRzrkWAUJkGnTnnx1nhr3DokGui17CLUNuEwnoaw"+ },+ {+ "encoding": "base64"+ }+ ]+ }+]
+ test/fixtures/secp256k1.json view
@@ -0,0 +1,22 @@+[+ {+ "hex": "012000000c000061000a0000b0e5863d0ddf7e105e409fee0ecc0123a362e14b6f4018a4be9555bc3f9879434192f73257b55acabc2d792c99651a9c010b734c01cf890b938bfc154b456453dcdd3115e0b83cc8b08145712a1fbf0b4464233a0068656c6c6f2d73656370",+ "name": "secp-full-instruction-data"+ },+ {+ "hex": "b0e5863d0ddf7e105e409fee0ecc0123a362e14b",+ "name": "secp-eth-address"+ },+ {+ "hex": "6f4018a4be9555bc3f9879434192f73257b55acabc2d792c99651a9c010b734c01cf890b938bfc154b456453dcdd3115e0b83cc8b08145712a1fbf0b4464233a",+ "name": "secp-signature"+ },+ {+ "hex": "00",+ "name": "secp-recovery-id"+ },+ {+ "hex": "68656c6c6f2d73656370",+ "name": "secp-message"+ }+]
+ test/fixtures/stake_instruction_data.json view
@@ -0,0 +1,54 @@+[+ {+ "hex": "000000008a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c00f15365000000002c010000000000001212121212121212121212121212121212121212121212121212121212121212",+ "name": "Initialize"+ },+ {+ "hex": "01000000141414141414141414141414141414141414141414141414141414141414141400000000",+ "name": "Authorize-staker"+ },+ {+ "hex": "01000000141414141414141414141414141414141414141414141414141414141414141401000000",+ "name": "Authorize-withdrawer"+ },+ {+ "hex": "02000000",+ "name": "DelegateStake"+ },+ {+ "hex": "0300000090d0030000000000",+ "name": "Split"+ },+ {+ "hex": "0400000020a1070000000000",+ "name": "Withdraw"+ },+ {+ "hex": "05000000",+ "name": "Deactivate"+ },+ {+ "hex": "060000000100f1536500000000012c01000000000000011212121212121212121212121212121212121212121212121212121212121212",+ "name": "SetLockup-some"+ },+ {+ "hex": "06000000000000",+ "name": "SetLockup-none"+ },+ {+ "hex": "07000000",+ "name": "Merge"+ },+ {+ "hex": "09000000",+ "name": "InitializeChecked"+ },+ {+ "hex": "0a00000001000000",+ "name": "AuthorizeChecked"+ },+ {+ "hex": "0d000000",+ "name": "GetMinimumDelegation"+ }+]
+ test/fixtures/state_fixtures.json view
@@ -0,0 +1,46 @@+[+ {+ "hex": "0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c404b4c0000000000010000000d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0201000000f01d1f0000000000e803000000000000010000001414141414141414141414141414141414141414141414141414141414141414",+ "name": "token-account"+ },+ {+ "hex": "0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c404b4c0000000000000000000000000000000000000000000000000000000000000000000000000000000000010000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000",+ "name": "token-account-minimal"+ },+ {+ "hex": "010000008a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c00ca9a3b000000000601010000001414141414141414141414141414141414141414141414141414141414141414",+ "name": "mint"+ },+ {+ "hex": "00000000000000000000000000000000000000000000000000000000000000000000000000ca9a3b000000000601000000000000000000000000000000000000000000000000000000000000000000000000",+ "name": "mint-minimal"+ },+ {+ "hex": "01000000ffffffffffffffff393000000000000001018a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c000002020202020202020202020202020202020202020202020202020202020202021d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1d1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e1e",+ "name": "lookup-table"+ },+ {+ "hex": "01000000010000008a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c25bdedad9fd7d269184d58d8f80e149acc1ceb154afc3c77363d7859c1febf2e8813000000000000",+ "name": "nonce-account"+ },+ {+ "hex": "25bdedad9fd7d269184d58d8f80e149acc1ceb154afc3c77363d7859c1febf2e",+ "name": "nonce-durable-hash"+ },+ {+ "hex": "0200000080d52200000000008a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c00f15365000000002c010000000000001212121212121212121212121212121212121212121212121212121212121212111111111111111111111111111111111111111111111111111111111111111140420f0000000000fa00000000000000ffffffffffffffff000000000000d03f2a0000000000000000",+ "name": "stake-account"+ },+ {+ "hex": "0100000080d52200000000008a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c00f15365000000002c010000000000001212121212121212121212121212121212121212121212121212121212121212",+ "name": "stake-account-initialized"+ },+ {+ "hex": "048a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c20000000536f6c616e61204861736b656c6c204e465400000000000000000000000000000a000000534853444b0000000000c800000068747470733a2f2f6578616d706c652e636f6d2f6e66742e6a736f6e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000260201020000008a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c013c21212121212121212121212121212121212121212121212121212121212121210028000101fd01000100222222222222222222222222222222222222222222222222222222222222222201010a000000000000000a000000000000000000",+ "name": "metadata-account"+ },+ {+ "hex": "048a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c20000000536f6c616e61204861736b656c6c204e465400000000000000000000000000000a000000534853444b0000000000c800000068747470733a2f2f6578616d706c652e636f6d2f6e66742e6a736f6e00000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000260201020000008a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c013c212121212121212121212121212121212121212121212121212121212121212100280001",+ "name": "metadata-account-legacy"+ }+]
+ test/fixtures/system_instruction_data.json view
@@ -0,0 +1,54 @@+[+ {+ "hex": "0000000040420f0000000000a5000000000000000505050505050505050505050505050505050505050505050505050505050505",+ "name": "CreateAccount"+ },+ {+ "hex": "010000000505050505050505050505050505050505050505050505050505050505050505",+ "name": "Assign"+ },+ {+ "hex": "0200000040420f0000000000",+ "name": "Transfer"+ },+ {+ "hex": "0300000003030303030303030303030303030303030303030303030303030303030303030a0000000000000068656c6c6f2d7365656440420f0000000000a5000000000000000505050505050505050505050505050505050505050505050505050505050505",+ "name": "CreateAccountWithSeed"+ },+ {+ "hex": "04000000",+ "name": "AdvanceNonceAccount"+ },+ {+ "hex": "0500000040420f0000000000",+ "name": "WithdrawNonceAccount"+ },+ {+ "hex": "060000000606060606060606060606060606060606060606060606060606060606060606",+ "name": "InitializeNonceAccount"+ },+ {+ "hex": "070000000606060606060606060606060606060606060606060606060606060606060606",+ "name": "AuthorizeNonceAccount"+ },+ {+ "hex": "08000000a500000000000000",+ "name": "Allocate"+ },+ {+ "hex": "0900000003030303030303030303030303030303030303030303030303030303030303030a0000000000000068656c6c6f2d73656564a5000000000000000505050505050505050505050505050505050505050505050505050505050505",+ "name": "AllocateWithSeed"+ },+ {+ "hex": "0a00000003030303030303030303030303030303030303030303030303030303030303030a0000000000000068656c6c6f2d736565640505050505050505050505050505050505050505050505050505050505050505",+ "name": "AssignWithSeed"+ },+ {+ "hex": "0b00000040420f00000000000a0000000000000068656c6c6f2d736565640505050505050505050505050505050505050505050505050505050505050505",+ "name": "TransferWithSeed"+ },+ {+ "hex": "0c000000",+ "name": "UpgradeNonceAccount"+ }+]
+ test/fixtures/token_instruction_data.json view
@@ -0,0 +1,102 @@+[+ {+ "hex": "00060b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b010d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d",+ "name": "InitializeMint-some"+ },+ {+ "hex": "00060b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b00",+ "name": "InitializeMint-none"+ },+ {+ "hex": "01",+ "name": "InitializeAccount"+ },+ {+ "hex": "0202",+ "name": "InitializeMultisig"+ },+ {+ "hex": "0340420f0000000000",+ "name": "Transfer"+ },+ {+ "hex": "0440420f0000000000",+ "name": "Approve"+ },+ {+ "hex": "05",+ "name": "Revoke"+ },+ {+ "hex": "0602010d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d",+ "name": "SetAuthority-some"+ },+ {+ "hex": "060300",+ "name": "SetAuthority-none"+ },+ {+ "hex": "0600010d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d",+ "name": "SetAuthority-mint-tokens"+ },+ {+ "hex": "060100",+ "name": "SetAuthority-freeze"+ },+ {+ "hex": "0740420f0000000000",+ "name": "MintTo"+ },+ {+ "hex": "0840420f0000000000",+ "name": "Burn"+ },+ {+ "hex": "09",+ "name": "CloseAccount"+ },+ {+ "hex": "0a",+ "name": "FreezeAccount"+ },+ {+ "hex": "0b",+ "name": "ThawAccount"+ },+ {+ "hex": "0c40420f000000000006",+ "name": "TransferChecked"+ },+ {+ "hex": "0d40420f000000000006",+ "name": "ApproveChecked"+ },+ {+ "hex": "0e40420f000000000006",+ "name": "MintToChecked"+ },+ {+ "hex": "0f40420f000000000006",+ "name": "BurnChecked"+ },+ {+ "hex": "100b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b",+ "name": "InitializeAccount2"+ },+ {+ "hex": "11",+ "name": "SyncNative"+ },+ {+ "hex": "120b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b",+ "name": "InitializeAccount3"+ },+ {+ "hex": "1302",+ "name": "InitializeMultisig2"+ },+ {+ "hex": "14060b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b010d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d0d",+ "name": "InitializeMint2-some"+ }+]
+ test/fixtures/transactions.json view
@@ -0,0 +1,46 @@+[+ {+ "hex": "0125fa015d7db091ebdb465348df3e35e6dc3419ea6fa2192fe3ff616872fd5eb77736a5d9ad37ba02b92633ac6f0d677bc675a9cdd1b7adf43221193548dada07010001038a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c02020202020202020202020202020202020202020202020202020202020202020000000000000000000000000000000000000000000000000000000000000000090909090909090909090909090909090909090909090909090909090909090901020200010c0200000000ca9a3b00000000",+ "name": "transfer-transaction"+ },+ {+ "hex": "8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c",+ "name": "payer-pubkey"+ },+ {+ "hex": "01474dd29de6780343762dc629a06cd12335951e3846d8d47ac3055284ba4df539618940da8c45f9f67dbf885010d3402b6abd678679cea57c980016f44971e704010003058a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c020202020202020202020202020202020202020202020202020202020202020200000000000000000000000000000000000000000000000000000000000000000306466fe5211732ffecadba72c39be7bc8ce5bbc5f7126b2c439b3a40000000054a535a992921064d24e87160da387c7c35b5ddbc92bb81e41fa8404105448d09090909090909090909090909090909090909090909090909090909090909090403000502400d030003000903e803000000000000020200010c0200000000ca9a3b000000000401000a68656c6c6f2d6d656d6f",+ "name": "priority-transfer-transaction"+ },+ {+ "hex": "02496d36d26d7e55952bb5fe7b71cd4e1e7143b7f0f1e6a6e9045d4940238d652654b57b7b5532971ee57d42bfad82039490f65730d860f3ba2e791ac4bb51260179d754e17640aae8f7a5c91609e3d2e003a037d61a7830e2a8cfcb5fb3de5d3ad94e2329f65ab3a74dfb9ab774b6fbc0de806dfe74b5cd6e34d24b29d275720c020001038a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c43a72e714401762df66b68c26dfbdf2682aaec9f2474eca4613e424a0fbafd3c000000000000000000000000000000000000000000000000000000000000000009090909090909090909090909090909090909090909090909090909090909090102020001340000000040420f0000000000a5000000000000000505050505050505050505050505050505050505050505050505050505050505",+ "name": "two-signer-create-transaction"+ },+ {+ "hex": "43a72e714401762df66b68c26dfbdf2682aaec9f2474eca4613e424a0fbafd3c",+ "name": "new-account-pubkey"+ },+ {+ "hex": "01cf64ab743c12701893ad306fb6d6f0a0df4922b383a0a71956631553e6fb8757a67170cc3520929d322835feb10b94ef89e1b78a46f9d37a016f93268bdb8708010005088a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c4795b40be0d30fa6202595ebcb06c94d134885ba92d230a6a77ca2aa035a7c056efe5d2accdbecfa532915bef37b76201a30d63af47e53dd1879b0d9acbdd5c9000000000000000000000000000000000000000000000000000000000000000006ddf6e1d765a193d9cbe146ceeb79ac1cb485ed5f5b37913a8cf5857eff00a90b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0b0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c0c8c97258f4e2489f1bb3d1029148e0d830b5a1399daff1084048e7bd8dbe9f859090909090909090909090909090909090909090909090909090909090909090902070600020506030401010404010602000a0c40420f000000000006",+ "name": "ata-transfer-transaction"+ },+ {+ "hex": "02b5ee5467feac98940c3ba1814502341943132dcdab74f260ca3ef843a16a2d08b2e394cf30c8352bfcd0590e5e18c598439bc3db10c67cded63ba12118f71b0896b9d4214c9f1c952187c3de6fa3798799540995089763aa25524f9e1f96ac34f55faf8af3a206ba2221069b0753b8697ee73a9bb230f718507a44eb3eeb3b0f020007098a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c43a72e714401762df66b68c26dfbdf2682aaec9f2474eca4613e424a0fbafd3c000000000000000000000000000000000000000000000000000000000000000006a1d8179137542a983437bdfe2a7ab2557f535c8a78722b68a49dc00000000006a1d817a502050b680791e6ce6db88e1e5b7150f61fc6790a4eb4d10000000006a7d51718c774c928566398691d5eb68b5eb8a39b4b6d5c73555b210000000006a7d517192c5c51218cc94c3d4af17f58daee089ba1fd44e3dbd98a0000000006a7d517193584d0feed9bb3431d13206be544281b57b8566cc5375ff4000000111111111111111111111111111111111111111111111111111111111111111109090909090909090909090909090909090909090909090909090909090909090302020001340000000040420f0000000000c80000000000000006a1d8179137542a983437bdfe2a7ab2557f535c8a78722b68a49dc0000000000302010674000000008a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c00f15365000000002c01000000000000121212121212121212121212121212121212121212121212121212121212121203060108050704000402000000",+ "name": "stake-setup-transaction"+ },+ {+ "hex": "80010001028a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c0000000000000000000000000000000000000000000000000000000000000000090909090909090909090909090909090909090909090909090909090909090902010200020c0200000000ca9a3b00000000010200030c0200000020a1070000000000011f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f02000100",+ "name": "v0-message"+ },+ {+ "hex": "01bbad9bf52a3921cda14afbb700043da146f16e8a9abc15dbcb18e3c234b8ab1af041a495878f987d0f455f1798f0a0ca1d236b9f2d98908c36508554e415600a80010001028a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c0000000000000000000000000000000000000000000000000000000000000000090909090909090909090909090909090909090909090909090909090909090902010200020c0200000000ca9a3b00000000010200030c0200000020a1070000000000011f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f1f02000100",+ "name": "v0-transfer-transaction"+ },+ {+ "hex": "02a697cf2a40af467245d288f0907c0d26a1407b67a5bfd046aca106ae9e958bb397b7d5b96c30ecd2676ee8ee00310742a7aa45f1dc0160ed071f68f9388fae0aa8f4ce8546ac9eab1f56eff658b7359099cbfcf8d8f528411e18c04f2c0b201ffd4905d3dbd16236017bbe5f9fe80c5aec3d28dc3f72483f527003fd74ae6b050200010443a72e714401762df66b68c26dfbdf2682aaec9f2474eca4613e424a0fbafd3c8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c02020202020202020202020202020202020202020202020202020202020202020000000000000000000000000000000000000000000000000000000000000000090909090909090909090909090909090909090909090909090909090909090901030201020c0200000000ca9a3b00000000",+ "name": "sponsored-transfer-transaction"+ },+ {+ "hex": "01fcffc6cc51a4de7b7259f429eabff20a3a06fd71eaf9463baae5a1955eb6599778cc1576701e78db8398ce733d9c0e0a63021a4e4ce7c7de049f638bc3301002010002058a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c02020202020202020202020202020202020202020202020202020202020202022525252525252525252525252525252525252525252525252525252525252525000000000000000000000000000000000000000000000000000000000000000006a7d517192c568ee08a845f73d29788cf035c3145b21ab344d8062ea940000025bdedad9fd7d269184d58d8f80e149acc1ceb154afc3c77363d7859c1febf2e0203030204000404000000030200010c0200000000ca9a3b00000000",+ "name": "nonce-transfer-transaction"+ }+]
+ test/fixtures/vote_instruction_data.json view
@@ -0,0 +1,30 @@+[+ {+ "hex": "0000000013131313131313131313131313131313131313131313131313131313131313138a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c8a88e3dd7409f195fd52db2d3cba5d72ca6709bf1d94121bf3748801b40f6f5c05",+ "name": "InitializeAccount"+ },+ {+ "hex": "01000000141414141414141414141414141414141414141414141414141414141414141400000000",+ "name": "Authorize-voter"+ },+ {+ "hex": "01000000141414141414141414141414141414141414141414141414141414141414141401000000",+ "name": "Authorize-withdrawer"+ },+ {+ "hex": "0300000020a1070000000000",+ "name": "Withdraw"+ },+ {+ "hex": "04000000",+ "name": "UpdateValidatorIdentity"+ },+ {+ "hex": "0500000005",+ "name": "UpdateCommission"+ },+ {+ "hex": "0700000001000000",+ "name": "AuthorizeChecked"+ }+]