Merge pull request 'Addition of functinality for manipulating Unified Addresses and Viewing Keys' (#1) from dev020 into master

Reviewed-on: #1
This commit is contained in:
pitmutt 2023-12-04 16:31:16 +00:00 committed by Vergara Technologies LLC
commit c17f450253
Signed by: Vergara Technologies LLC
GPG key ID: 99DB473BB4715618
12 changed files with 658 additions and 70 deletions

View file

@ -9,10 +9,20 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
### Added ### Added
- `matchOrchardAddress` function to ensure a UA matches a UVK and corresponding tests
- `makeZcashCall` function moved into this library
- `RpcResponse`, `RpcCall` types moved into this library
- Functions to decode Sapling transactions
- Tests for Sapling decoding
- Type for block response
- Type for raw transaction response
- JSON parsers for block response, transaction response, `ShieldedOutput` and `OrchardAction`
- Tests for JSON parsers
- Haddock annotations - Haddock annotations
### Changed ### Changed
- Rearranged modules for cleaner dependencies.
- Upgrade to Haskell LTS 21.6 - Upgrade to Haskell LTS 21.6
## [0.1.0] - 2023-06-14 ## [0.1.0] - 2023-06-14

75
block.json Normal file
View file

@ -0,0 +1,75 @@
{
"hash": "000000000079250b2cb5f3a04f47623db0f2552abeeb5fef914d8833c827ff63",
"confirmations": 5,
"size": 19301,
"height": 2196277,
"version": 4,
"merkleroot": "bbeb085e2e69afd760e48512f2cc4af788331a19ad03cf1442dc2c38bf1819ef",
"blockcommitments": "9af507deaee501f8a9a9efb367d199b21d08874393f0408412c408352f967845",
"authdataroot": "562acdacbf061ef8ef5b84917247669b45935f83280adfedcd0f9b39efaf25ef",
"finalsaplingroot": "625ebbfa357830e0ecf7b14b149939e9c95c75ef19ae17b32f660783add33196",
"finalorchardroot": "d54d40365258b350642ede76ec8d411220b93b4bd16c63bff803715b87154e0b",
"chainhistoryroot": "b4438f23544049ed0185baca65cfbc06a09eee7577b4fe567e3f6bb08f107c56",
"tx": [
"795fabb4070cc221480e3b8deba2f76a9c5d16026a5f8e2c29c833e5b6088eb4",
"66637dc7703bbacc385ef7f2e087bd5fcc56763515217822906e352f504eb820",
"b2384cd27fb12cb119754f91077453ffdc553da3be384d156b1f16ce4e88a9c5",
"c4c1c3d962f2e56b65585be3b5a09c7b42e1a6ea66c0f6492ad3d3ea2e0775d0",
"e1acb17e24b7d2df5a2c23349a1fc66d1084b1a9a85cfe760ed72fb37f960a12",
"e5aeac0d023259551616cdec6727219048535aa619bba4e722e887424cf9ebef"
],
"time": 1692399702,
"nonce": "ddca0340000000000000000000370000000000000000000000000000093e790d",
"solution": "003b65d98e5199710d69e661f6def0120bc519c7bd1a4ec4b727edf953746a261046760f1dd584f743781478251d65a4b7e1f775c192c8f01aecf2301753bd1eb472ea4b9bb33d9c6236d6f94551c6ee699a20be02342d54196ed2a1ce43c0a56cb20baeda8578498a2cd783b49970a65b8bc2c9d45d7b6863b86e5fb5291b5af986da9e11f5342477173b68cd8e58099791b028031725459bb81353f398baee5acb0390243e36e1039720df4108697dab0772b844ded785119a3cb4f30483221042c965efcb0190dbcbe8eac0f4c0ac51a404ec0f06bf83cfae33a9163c73e7402e07c1f59fb01b692167359a5ea2fd30452b723443454e22ec32de0556e899860cb029439e04642f2cc4815265b521e207ba7d794d498157d1f0e364762f32b32a375e483c19f4a7419846fc75be75729a2cff99f8f5b690d58d40a3bd1043a2caeb79aa44a97d792b0d60d1d6c2460105c304c9418fd5f859b1ebb649854a9473394057103edad7e518bf7afe1165ceff7e50365c7b1dac6c3b9e35ea842ce251b041566c3f576e961485770806459a1e752ee2fac542693999ad7c268aecd87d37550285a6a1420ba2af5007c2ac3c678401c92dbb63a423f003537bd7b93961c32314667dc8dddfc49b84dc0896bb7611da7d5347b1019f7aacf3e19c16ddf91d30ddec8f40ea919156aa75b8644981ae909f98f433012173489f443a11e1d9e50649a95299d0aa91b9d50343c70b4c209ce77222a2200dc1406d98bfacc9ac09f98d1e1d440af18b3c8327d0a1c0027e9c7fadfe181a4d62b9d3869d38c542e1b22c271b6f491f49ea0b684b4a3ca841c1ebb5b1efe443cd1b94653cc8d70c220dc95e9611c561f19188391fe2be3b9bf84e2615ca99f87a4d7421964002018b4199c8a9037b44304133c7c4bcd6a55d7aeec4f5d12d9359dbc97802350072885f8f2ea93feaa3e3b03e7afc2ad581b6aea30cafb2ea8891cc0df673b2b8ca5e1a692d3ab32b31132b3e6882937443e872c34818305f390500bb37a921b1094e05d894c6e62913c402bc6deef5989f98990256b0f99c212bd3d810f1459a30f281196edebf531392d72368df449b3ee2a2c3c8a36349bd985215630701decafe90648edebec3f263bd70969955bb839b37a724a9c9d0420abc80e8172fc1ca5a7d3b587ea305fd1d2c021e760cf662f19079bbe56a454e9e284e465adebb3c12d4d9353fa5c002c037af529f3fb9ab067ebf1a7b30807b89803751665f6b5aeea117f03e15d66e1b1aef675b9674d512b5d0d895ca5cd5cc920f35020eaaa76637c198124c2dc33da4d71bdfc49e15f5c79ca4b33f0df22682d5541f2714cba71207d91acecb0fe88dd960eb61a3c8aec32b822b4abc11ba1f63b920191a62b4e4bc42b2b151ed1e701cbd408100bb2b4fe393da9b81b708f3884cee7e7414944a481b1e1c5f2851477acc7803e622ffab7e444d7e8faa3c46d6187ed31d02f3c6790453e67f7ac622db35ac5edee7b72aa4acf16f6bd8cb3dd878c7b0223ef2ce017dcf919d120dc0c83d5401bf4c6baaed245eabea031b3c2fbce6d7a3bd3ea0886e1e0c8067bd724de003c837947284569e5a39666bb7ce0a21af3d11f82114b75d5556504d31e229b3c2942a28f51b378bdb15059e0073e9a60f515770315c0d8dd58ab3b89bd6cd3e9bd2109b67cfe5732ff68cdb6aa0f29b90f92f3707cbed01a0c20bec9c427735af54983ec4369a253521d4c42e4ca1bff59adb02878cd8b26cb952b71a0506305b8ffe695581eae625d23bb4e3be2e84bed7ac193d0267386846efa7ccd1b3b6bd04d52271bf62dd08590125c49f9fefe32a859380bc638fd4f31eecc11087e627b44a7a73786b23614b6864bec39afacf18",
"bits": "1c01b44d",
"difficulty": 78752260.61608158,
"chainwork": "0000000000000000000000000000000000000000000000000e4f2c44f6a82cfb",
"anchor": "638a7385e9910d3e18ae4240735ed4a5f6b0f410b0a1bef9d831452e0cff0a3c",
"chainSupply": {
"monitored": false,
"valueDelta": 3.12500000,
"valueDeltaZat": 312500000
},
"valuePools": [
{
"id": "transparent",
"monitored": false,
"valueDelta": -134.79807867,
"valueDeltaZat": -13479807867
},
{
"id": "sprout",
"monitored": true,
"chainValue": 26762.63007004,
"chainValueZat": 2676263007004,
"valueDelta": 0.00000000,
"valueDeltaZat": 0
},
{
"id": "sapling",
"monitored": true,
"chainValue": 1155712.35104510,
"chainValueZat": 115571235104510,
"valueDelta": 68.96131433,
"valueDeltaZat": 6896131433
},
{
"id": "orchard",
"monitored": true,
"chainValue": 96151.73011093,
"chainValueZat": 9615173011093,
"valueDelta": 68.96176434,
"valueDeltaZat": 6896176434
}
],
"trees": {
"sapling": {
"size": 72943241
},
"orchard": {
"size": 48645942
}
},
"previousblockhash": "0000000000a67420fd68bf269b63d821b158cd1da20d067e219adaa66977970d",
"nextblockhash": "00000000016ebe0a0da97446c677478aa30df66b1b503fd297ad895ee7941d5e"
}

View file

@ -1,7 +1,10 @@
use std::{ use std::{
marker::PhantomData, marker::PhantomData,
io::Write, io::{
Write,
Cursor
},
fmt::{Debug, Display, Formatter} fmt::{Debug, Display, Formatter}
}; };
@ -19,18 +22,24 @@ use haskell_ffi::{
use zcash_primitives::{ use zcash_primitives::{
zip32::Scope as SaplingScope, zip32::Scope as SaplingScope,
transaction::components::sapling::{ transaction::components::sapling::{
read_zkproof,
GrothProofBytes, GrothProofBytes,
OutputDescription, OutputDescription,
CompactOutputDescription CompactOutputDescription
}, },
sapling::{ sapling::{
value::ValueCommitment as SaplingValueCommitment, value::ValueCommitment as SaplingValueCommitment,
keys::FullViewingKey as SaplingViewingKey, keys::{
FullViewingKey as SaplingViewingKey,
PreparedIncomingViewingKey as SaplingPreparedIncomingViewingKey
},
note_encryption::SaplingDomain, note_encryption::SaplingDomain,
PaymentAddress, PaymentAddress,
note::ExtractedNoteCommitment as SaplingExtractedNoteCommitment note::ExtractedNoteCommitment as SaplingExtractedNoteCommitment
}, },
transaction::Transaction,
consensus::{ consensus::{
BranchId::Nu5,
MainNetwork, MainNetwork,
BlockHeight BlockHeight
} }
@ -38,7 +47,7 @@ use zcash_primitives::{
use zcash_address::{ use zcash_address::{
Network, Network,
unified::{Address, Encoding, Ufvk, Container, Fvk}, unified::{Address, Encoding, Ufvk, Container, Fvk, Receiver},
ZcashAddress ZcashAddress
}; };
@ -86,6 +95,20 @@ impl<RW> ToHaskell<RW> for RawData {
//} //}
//} //}
#[derive(BorshSerialize, BorshDeserialize)]
pub struct HrawTx {
bytes: Vec<u8>,
s: bool,
o: bool
}
impl<RW> ToHaskell<RW> for HrawTx {
fn to_haskell<W: Write>(&self, writer: &mut W, _tag: PhantomData<RW>) -> Result<()> {
self.serialize(writer)?;
Ok(())
}
}
#[derive(BorshSerialize, BorshDeserialize)] #[derive(BorshSerialize, BorshDeserialize)]
pub struct HshieldedOutput { pub struct HshieldedOutput {
cv: Vec<u8>, cv: Vec<u8>,
@ -103,6 +126,20 @@ impl<RW> FromHaskell<RW> for HshieldedOutput {
} }
} }
impl<RW> ToHaskell<RW> for HshieldedOutput {
fn to_haskell<W: Write>(&self, writer: &mut W, _tag: PhantomData<RW>) -> Result<()> {
self.serialize(writer)?;
Ok(())
}
}
impl HshieldedOutput {
fn from_object(s: OutputDescription<GrothProofBytes>) -> Result<HshieldedOutput> {
let o = HshieldedOutput { cv: s.cv().to_bytes().to_vec(), cmu: s.cmu().to_bytes().to_vec(), eph_key: s.ephemeral_key().0.to_vec(), enc_txt: s.enc_ciphertext().to_vec(), out_txt: s.out_ciphertext().to_vec(), proof: s.zkproof().to_vec() };
Ok(o)
}
}
#[derive(BorshSerialize, BorshDeserialize)] #[derive(BorshSerialize, BorshDeserialize)]
pub struct Haction { pub struct Haction {
nf: Vec<u8>, nf: Vec<u8>,
@ -283,6 +320,42 @@ pub extern "C" fn rust_wrapper_svk_check_address(
} }
} }
#[no_mangle]
pub extern "C" fn rust_wrapper_ufvk_check_address(
key_input: *const u8,
key_input_len: usize,
address_input: *const u8,
address_input_len: usize
) -> bool {
let key: String = marshall_from_haskell_var(key_input, key_input_len, RW);
let addy: String = marshall_from_haskell_var(address_input, address_input_len, RW);
let dec_key = Ufvk::decode(&key);
let dec_addy = Address::decode(&addy);
match dec_key {
Ok((n, ufvk)) => {
let i = ufvk.items();
if let Fvk::Orchard(k) = i[0] {
let orch_key = FullViewingKey::from_bytes(&k).unwrap();
let orch_addy = orch_key.address_at(0u32, Scope::External).to_raw_address_bytes();
match dec_addy {
Ok((n, recs)) => {
let j = recs.items();
j[0] == Receiver::Orchard(orch_addy)
},
Err(_e) => {
false
}
}
} else {
false
}
},
Err(_e) => {
false
}
}
}
#[no_mangle] #[no_mangle]
pub extern "C" fn rust_wrapper_ufvk_decode( pub extern "C" fn rust_wrapper_ufvk_decode(
input: *const u8, input: *const u8,
@ -311,35 +384,51 @@ pub extern "C" fn rust_wrapper_ufvk_decode(
} }
} }
//#[no_mangle] #[no_mangle]
//pub extern "C" fn rust_wrapper_sapling_note_decrypt( pub extern "C" fn rust_wrapper_sapling_note_decrypt_v2(
//key: *const u8, key: *const u8,
//key_len: usize, key_len: usize,
//note: *const u8, note: *const u8,
//note_len: usize, note_len: usize,
//out: *mut u8, out: *mut u8,
//out_len: &mut usize out_len: &mut usize
//){ ){
//let evk: Vec<u8> = marshall_from_haskell_var(key, key_len, RW); let evk: Vec<u8> = marshall_from_haskell_var(key, key_len, RW);
//let note_input: HshieldedOutput = marshall_from_haskell_var(note,note_len,RW); let note_input: Vec<u8> = marshall_from_haskell_var(note,note_len,RW);
//let svk = ExtendedFullViewingKey::read(&*evk); let mut note_reader = Cursor::new(note_input);
//match svk { let svk = ExtendedFullViewingKey::read(&*evk);
//Ok(k) => { match svk {
//let domain = SaplingDomain::for_height(MainNetwork, BlockHeight::from_u32(2000000)); Ok(k) => {
//let action: CompactOutputDescription = CompactOutputDescription { let domain = SaplingDomain::for_height(MainNetwork, BlockHeight::from_u32(2000000));
//ephemeral_key: EphemeralKeyBytes(to_array(note_input.eph_key)), let action2 = OutputDescription::read(&mut note_reader);
//cmu: SaplingExtractedNoteCommitment::from_bytes(&to_array(note_input.cmu)).unwrap(), match action2 {
//enc_ciphertext: to_array(note_input.enc_txt) Ok(action3) => {
//}; let fvk = k.to_diversifiable_full_viewing_key().to_ivk(SaplingScope::External);
//let fvk = k.to_diversifiable_full_viewing_key().to_ivk(SaplingScope::External); let pivk = SaplingPreparedIncomingViewingKey::new(&fvk);
//let result = zcash_note_encryption::try_note_decryption(&domain, &ivk, &action); let result = zcash_note_encryption::try_note_decryption(&domain, &pivk, &action3);
//} match result {
//Err(_e) => { Some((n, r, m)) => {
//let hn0 = Hnote { note: 0, recipient: vec![0], memo: vec![0] }; let hn = Hnote {note: n.value().inner(), recipient: r.to_bytes().to_vec(), memo: m.as_slice().to_vec() };
//marshall_to_haskell_var(&hn0, out, out_len, RW); marshall_to_haskell_var(&hn, out, out_len, RW);
//} }
//} None => {
//} let hn0 = Hnote { note: 0, recipient: vec![0], memo: vec![0] };
marshall_to_haskell_var(&hn0, out, out_len, RW);
}
}
},
Err(_e1) => {
let hn0 = Hnote { note: 0, recipient: vec![0], memo: vec![0] };
marshall_to_haskell_var(&hn0, out, out_len, RW);
}
}
}
Err(_e) => {
let hn0 = Hnote { note: 0, recipient: vec![0], memo: vec![0] };
marshall_to_haskell_var(&hn0, out, out_len, RW);
}
}
}
#[no_mangle] #[no_mangle]
pub extern "C" fn rust_wrapper_orchard_note_decrypt( pub extern "C" fn rust_wrapper_orchard_note_decrypt(
@ -384,3 +473,45 @@ pub extern "C" fn rust_wrapper_orchard_note_decrypt(
} }
} }
} }
#[no_mangle]
pub extern "C" fn rust_wrapper_tx_parse(
tx: *const u8,
tx_len: usize,
out: *mut u8,
out_len: &mut usize
){
let tx_input: Vec<u8> = marshall_from_haskell_var(tx, tx_len, RW);
let tx_bytes: Vec<u8> = tx_input.clone();
let mut tx_reader = Cursor::new(tx_input);
let s_o = false;
let o_a = false;
let parsed_tx = Transaction::read(&mut tx_reader, Nu5);
match parsed_tx {
Ok(t) => {
let s_bundle = t.sapling_bundle();
match s_bundle {
Some(b) => {
let mut s_output = Vec::new();
for s_each_out in b.shielded_outputs().iter() {
let mut out_bytes = Vec::new();
let _ = s_each_out.write_v4(&mut out_bytes);
s_output.push(out_bytes);
}
marshall_to_haskell_var(&s_output, out, out_len, RW);
},
None => {
let mut z = Vec::new();
z.push(vec![0]);
marshall_to_haskell_var(&z, out, out_len, RW);
}
}
},
Err(_e) => {
let mut y = Vec::new();
y.push(vec![0]);
marshall_to_haskell_var(&y, out, out_len, RW);
}
}
}

View file

@ -31,6 +31,8 @@ library:
- text - text
- foreign-rust - foreign-rust
- generics-sop - generics-sop
- aeson
- http-conduit
pkg-config-dependencies: pkg-config-dependencies:
- rustzcash_wrapper-uninstalled - rustzcash_wrapper-uninstalled
@ -47,3 +49,4 @@ tests:
- hspec - hspec
- bytestring - bytestring
- text - text
- aeson

View file

@ -72,6 +72,21 @@ import ZcashHaskell.Types
-> `Bool' -> `Bool'
#} #}
{# fun pure unsafe rust_wrapper_ufvk_check_address as rustWrapperOrchardCheck
{ toBorshVar* `BS.ByteString'&
, toBorshVar* `BS.ByteString'&
}
-> `Bool'
#}
{# fun unsafe rust_wrapper_sapling_note_decrypt_v2 as rustWrapperSaplingNoteDecode
{ toBorshVar* `BS.ByteString'&
, toBorshVar* `BS.ByteString'&
, getVarBuffer `Buffer DecodedNote'&
}
-> `()'
#}
{# fun unsafe rust_wrapper_ufvk_decode as rustWrapperUfvkDecode {# fun unsafe rust_wrapper_ufvk_decode as rustWrapperUfvkDecode
{ toBorshVar* `BS.ByteString'& { toBorshVar* `BS.ByteString'&
, getVarBuffer `Buffer UnifiedFullViewingKey'& , getVarBuffer `Buffer UnifiedFullViewingKey'&
@ -82,7 +97,14 @@ import ZcashHaskell.Types
{# fun unsafe rust_wrapper_orchard_note_decrypt as rustWrapperOrchardNoteDecode {# fun unsafe rust_wrapper_orchard_note_decrypt as rustWrapperOrchardNoteDecode
{ toBorshVar* `BS.ByteString'& { toBorshVar* `BS.ByteString'&
, toBorshVar* `OrchardAction'& , toBorshVar* `OrchardAction'&
, getVarBuffer `Buffer OrchardDecodedAction'& , getVarBuffer `Buffer DecodedNote'&
}
-> `()'
#}
{# fun unsafe rust_wrapper_tx_parse as rustWrapperTxParse
{ toBorshVar* `BS.ByteString'&
, getVarBuffer `Buffer [BS.ByteString]'&
} }
-> `()' -> `()'
#} #}

View file

@ -13,6 +13,7 @@ module ZcashHaskell.Orchard where
import C.Zcash import C.Zcash
( rustWrapperIsUA ( rustWrapperIsUA
, rustWrapperOrchardCheck
, rustWrapperOrchardNoteDecode , rustWrapperOrchardNoteDecode
, rustWrapperUfvkDecode , rustWrapperUfvkDecode
) )
@ -33,10 +34,14 @@ decodeUfvk str =
where where
decodedKey = (withPureBorshVarBuffer . rustWrapperUfvkDecode) str decodedKey = (withPureBorshVarBuffer . rustWrapperUfvkDecode) str
-- | Check if the given UVK matches the UA given
matchOrchardAddress :: BS.ByteString -> BS.ByteString -> Bool
matchOrchardAddress = rustWrapperOrchardCheck
-- | Attempts to decode the given @OrchardAction@ using the given @UnifiedFullViewingKey@. -- | Attempts to decode the given @OrchardAction@ using the given @UnifiedFullViewingKey@.
decryptOrchardAction :: decryptOrchardAction ::
OrchardAction -> UnifiedFullViewingKey -> Maybe OrchardDecodedAction UnifiedFullViewingKey -> OrchardAction -> Maybe DecodedNote
decryptOrchardAction encAction key = decryptOrchardAction key encAction =
case a_value decodedAction of case a_value decodedAction of
0 -> Nothing 0 -> Nothing
_ -> Just decodedAction _ -> Just decodedAction

View file

@ -1,20 +1,84 @@
{-# LANGUAGE OverloadedStrings #-}
module ZcashHaskell.Sapling where module ZcashHaskell.Sapling where
import C.Zcash import C.Zcash
( rustWrapperIsShielded ( rustWrapperIsShielded
, rustWrapperSaplingCheck , rustWrapperSaplingCheck
, rustWrapperSaplingNoteDecode
, rustWrapperSaplingVkDecode , rustWrapperSaplingVkDecode
, rustWrapperTxParse
) )
import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import Foreign.Rust.Marshall.Variable (withPureBorshVarBuffer)
import ZcashHaskell.Types
( DecodedNote(..)
, RawData(..)
, RawTxResponse(..)
, ShieldedOutput(..)
, decodeHexText
)
import ZcashHaskell.Utils (decodeBech32)
-- | Check if given bytesting is a valid encoded shielded address -- | Check if given bytesting is a valid encoded shielded address
isValidShieldedAddress :: BS.ByteString -> Bool isValidShieldedAddress :: BS.ByteString -> Bool
isValidShieldedAddress = rustWrapperIsShielded isValidShieldedAddress = rustWrapperIsShielded
getShieldedOutputs :: BS.ByteString -> [BS.ByteString]
getShieldedOutputs t = withPureBorshVarBuffer $ rustWrapperTxParse t
-- | Check if given bytestring is a valid Sapling viewing key -- | Check if given bytestring is a valid Sapling viewing key
isValidSaplingViewingKey :: BS.ByteString -> Bool isValidSaplingViewingKey :: BS.ByteString -> Bool
isValidSaplingViewingKey = rustWrapperSaplingVkDecode isValidSaplingViewingKey k =
case hrp decodedKey of
"zxviews" -> rustWrapperSaplingVkDecode $ bytes decodedKey
_ -> False
where
decodedKey = decodeBech32 k
-- | Check if the given bytestring for the Sapling viewing key matches the second bytestring for the address -- | Check if the given bytestring for the Sapling viewing key matches the second bytestring for the address
matchSaplingAddress :: BS.ByteString -> BS.ByteString -> Bool matchSaplingAddress :: BS.ByteString -> BS.ByteString -> Bool
matchSaplingAddress = rustWrapperSaplingCheck matchSaplingAddress = rustWrapperSaplingCheck
-- | Attempt to decode the given raw tx with the given Sapling viewing key
decodeSaplingOutput :: BS.ByteString -> BS.ByteString -> Maybe DecodedNote
decodeSaplingOutput key out =
case a_value decodedAction of
0 -> Nothing
_ -> Just decodedAction
where
decodedAction =
withPureBorshVarBuffer $ rustWrapperSaplingNoteDecode key out
instance FromJSON RawTxResponse where
parseJSON =
withObject "RawTxResponse" $ \obj -> do
i <- obj .: "txid"
o <- obj .:? "orchard"
h <- obj .: "hex"
ht <- obj .: "height"
c <- obj .: "confirmations"
b <- obj .: "blocktime"
case o of
Nothing ->
pure $
RawTxResponse
i
(decodeHexText h)
(getShieldedOutputs (decodeHexText h))
[]
ht
c
b
Just o' -> do
a <- o' .: "actions"
pure $
RawTxResponse
i
(decodeHexText h)
(getShieldedOutputs (decodeHexText h))
a
ht
c
b

View file

@ -1,7 +1,9 @@
{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-} {-# LANGUAGE DerivingVia #-}
{-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE OverloadedStrings #-}
-- | -- |
-- Module : ZcashHaskell.Types -- Module : ZcashHaskell.Types
@ -17,13 +19,17 @@
module ZcashHaskell.Types where module ZcashHaskell.Types where
import Codec.Borsh import Codec.Borsh
import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Char8 as C
import Data.Int import Data.Int
import Data.Structured import Data.Structured
import qualified Data.Text as T
import Data.Word import Data.Word
import qualified GHC.Generics as GHC import qualified GHC.Generics as GHC
import qualified Generics.SOP as SOP import qualified Generics.SOP as SOP
-- * General
-- | Type to represent data after Bech32 decoding -- | Type to represent data after Bech32 decoding
data RawData = RawData data RawData = RawData
{ hrp :: BS.ByteString -- ^ Human-readable part of the Bech32 encoding { hrp :: BS.ByteString -- ^ Human-readable part of the Bech32 encoding
@ -33,17 +39,78 @@ data RawData = RawData
deriving anyclass (Data.Structured.Show) deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct RawData deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct RawData
-- | Type to represent a Unified Full Viewing Key -- * `zcashd` RPC
data UnifiedFullViewingKey = UnifiedFullViewingKey -- | A type to model Zcash RPC calls
{ net :: Word8 -- ^ Number representing the network the key belongs to. @1@ for @mainnet@, @2@ for @testnet@ and @3@ for @regtestnet@. data RpcCall = RpcCall
, o_key :: BS.ByteString -- ^ Raw bytes of the Orchard Full Viewing Key as specified in [ZIP-316](https://zips.z.cash/zip-0316) { jsonrpc :: T.Text
, s_key :: BS.ByteString -- ^ Raw bytes of the Sapling Full Viewing Key as specified in [ZIP-316](https://zips.z.cash/zip-0316) , callId :: T.Text
, t_key :: BS.ByteString -- ^ Raw bytes of the P2PKH chain code and public key as specified in [ZIP-316](https://zips.z.cash/zip-0316) , method :: T.Text
} deriving stock (Eq, Prelude.Show, GHC.Generic) , parameters :: [Data.Aeson.Value]
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) } deriving stock (Prelude.Show, GHC.Generic)
deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct UnifiedFullViewingKey
instance ToJSON RpcCall where
toJSON (RpcCall j c m p) =
object ["jsonrpc" .= j, "id" .= c, "method" .= m, "params" .= p]
-- | A type to model the response of the Zcash RPC
data RpcResponse r = MakeRpcResponse
{ err :: Maybe RpcError
, respId :: T.Text
, result :: Maybe r
} deriving stock (Prelude.Show, GHC.Generic)
deriving anyclass (ToJSON)
instance (FromJSON r) => FromJSON (RpcResponse r) where
parseJSON =
withObject "RpcResponse" $ \obj -> do
e <- obj .: "error"
i <- obj .: "id"
r <- obj .: "result"
pure $ MakeRpcResponse e i r
-- | A type to model the errors from the Zcash RPC
data RpcError = RpcError
{ ecode :: Double
, emessage :: T.Text
} deriving stock (Prelude.Show, GHC.Generic)
deriving anyclass (ToJSON)
instance FromJSON RpcError where
parseJSON =
withObject "RpcError" $ \obj -> do
c <- obj .: "code"
m <- obj .: "message"
pure $ RpcError c m
-- | Type to represent response from the `zcashd` RPC `getblock` method
data BlockResponse = BlockResponse
{ bl_confirmations :: Integer -- ^ Block confirmations
, bl_height :: Integer -- ^ Block height
, bl_time :: Integer -- ^ Block time
, bl_txs :: [T.Text] -- ^ List of transaction IDs in the block
} deriving (Prelude.Show, Eq)
instance FromJSON BlockResponse where
parseJSON =
withObject "BlockResponse" $ \obj -> do
c <- obj .: "confirmations"
h <- obj .: "height"
t <- obj .: "time"
txs <- obj .: "tx"
pure $ BlockResponse c h t txs
-- | Type to represent response from the `zcashd` RPC `getrawtransaction`
data RawTxResponse = RawTxResponse
{ rt_id :: T.Text
, rt_hex :: BS.ByteString
, rt_shieldedOutputs :: [BS.ByteString]
, rt_orchardActions :: [OrchardAction]
, rt_blockheight :: Integer
, rt_confirmations :: Integer
, rt_blocktime :: Integer
} deriving (Prelude.Show, Eq)
-- * Sapling
-- | Type to represent a Sapling Shielded Output as provided by the @getrawtransaction@ RPC method of @zcashd@. -- | Type to represent a Sapling Shielded Output as provided by the @getrawtransaction@ RPC method of @zcashd@.
data ShieldedOutput = ShieldedOutput data ShieldedOutput = ShieldedOutput
{ s_cv :: BS.ByteString -- ^ Value commitment to the input note { s_cv :: BS.ByteString -- ^ Value commitment to the input note
@ -57,6 +124,36 @@ data ShieldedOutput = ShieldedOutput
deriving anyclass (Data.Structured.Show) deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct ShieldedOutput deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct ShieldedOutput
instance FromJSON ShieldedOutput where
parseJSON =
withObject "ShieldedOutput" $ \obj -> do
cv <- obj .: "cv"
cmu <- obj .: "cmu"
ephKey <- obj .: "ephemeralKey"
encText <- obj .: "encCiphertext"
outText <- obj .: "outCiphertext"
p <- obj .: "proof"
pure $
ShieldedOutput
(decodeHexText cv)
(decodeHexText cmu)
(decodeHexText ephKey)
(decodeHexText encText)
(decodeHexText outText)
(decodeHexText p)
-- * Orchard
-- | Type to represent a Unified Full Viewing Key
data UnifiedFullViewingKey = UnifiedFullViewingKey
{ net :: Word8 -- ^ Number representing the network the key belongs to. @1@ for @mainnet@, @2@ for @testnet@ and @3@ for @regtestnet@.
, o_key :: BS.ByteString -- ^ Raw bytes of the Orchard Full Viewing Key as specified in [ZIP-316](https://zips.z.cash/zip-0316)
, s_key :: BS.ByteString -- ^ Raw bytes of the Sapling Full Viewing Key as specified in [ZIP-316](https://zips.z.cash/zip-0316)
, t_key :: BS.ByteString -- ^ Raw bytes of the P2PKH chain code and public key as specified in [ZIP-316](https://zips.z.cash/zip-0316)
} deriving stock (Eq, Prelude.Show, GHC.Generic)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct UnifiedFullViewingKey
-- | Type to represent an Orchard Action as provided by the @getrawtransaction@ RPC method of @zcashd@, and defined in the [Zcash Protocol](https://zips.z.cash/protocol/protocol.pdf) -- | Type to represent an Orchard Action as provided by the @getrawtransaction@ RPC method of @zcashd@, and defined in the [Zcash Protocol](https://zips.z.cash/protocol/protocol.pdf)
data OrchardAction = OrchardAction data OrchardAction = OrchardAction
{ nf :: BS.ByteString -- ^ The nullifier of the input note { nf :: BS.ByteString -- ^ The nullifier of the input note
@ -72,12 +169,46 @@ data OrchardAction = OrchardAction
deriving anyclass (Data.Structured.Show) deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct OrchardAction deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct OrchardAction
-- | Type to represent a decoded Orchard Action instance FromJSON OrchardAction where
data OrchardDecodedAction = OrchardDecodedAction parseJSON =
withObject "OrchardAction" $ \obj -> do
n <- obj .: "nullifier"
r <- obj .: "rk"
c <- obj .: "cmx"
ephKey <- obj .: "ephemeralKey"
encText <- obj .: "encCiphertext"
outText <- obj .: "outCiphertext"
cval <- obj .: "cv"
a <- obj .: "spendAuthSig"
pure $
OrchardAction
(decodeHexText n)
(decodeHexText r)
(decodeHexText c)
(decodeHexText ephKey)
(decodeHexText encText)
(decodeHexText outText)
(decodeHexText cval)
(decodeHexText a)
-- | Type to represent a decoded note
data DecodedNote = DecodedNote
{ a_value :: Int64 -- ^ The amount of the transaction in _zatoshis_. { a_value :: Int64 -- ^ The amount of the transaction in _zatoshis_.
, a_recipient :: BS.ByteString -- ^ The recipient Orchard receiver. , a_recipient :: BS.ByteString -- ^ The recipient Orchard receiver.
, a_memo :: BS.ByteString -- ^ The decoded shielded memo field. , a_memo :: BS.ByteString -- ^ The decoded shielded memo field.
} deriving stock (Eq, Prelude.Show, GHC.Generic) } deriving stock (Eq, Prelude.Show, GHC.Generic)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo) deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving anyclass (Data.Structured.Show) deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct OrchardDecodedAction deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct DecodedNote
-- * Helpers
-- | Helper function to turn a hex-encoded string to bytestring
decodeHexText :: String -> BS.ByteString
decodeHexText h = BS.pack $ hexRead h
where
hexRead hexText
| null chunk = []
| otherwise =
fromIntegral (read ("0x" <> chunk)) : hexRead (drop 2 hexText)
where
chunk = take 2 hexText

View file

@ -9,6 +9,8 @@
-- --
-- A set of functions to assist in the handling of elements of the Zcash protocol, allowing for decoding of memos, addresses and viewing keys. -- A set of functions to assist in the handling of elements of the Zcash protocol, allowing for decoding of memos, addresses and viewing keys.
-- --
{-# LANGUAGE OverloadedStrings #-}
module ZcashHaskell.Utils where module ZcashHaskell.Utils where
import C.Zcash import C.Zcash
@ -16,22 +18,14 @@ import C.Zcash
, rustWrapperF4Jumble , rustWrapperF4Jumble
, rustWrapperF4UnJumble , rustWrapperF4UnJumble
) )
import Control.Monad.IO.Class
import Data.Aeson
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.Text as T
import Foreign.Rust.Marshall.Variable import Foreign.Rust.Marshall.Variable
import Network.HTTP.Simple
import ZcashHaskell.Types import ZcashHaskell.Types
-- | Helper function to turn a hex-encoded string to bytestring
decodeHexText :: String -> BS.ByteString
decodeHexText h = BS.pack $ hexRead h
where
hexRead hexText
| null chunk = []
| otherwise =
fromIntegral (read ("0x" <> chunk)) : hexRead (drop 2 hexText)
where
chunk = take 2 hexText
-- | Decode the given bytestring using Bech32 -- | Decode the given bytestring using Bech32
decodeBech32 :: BS.ByteString -> RawData decodeBech32 :: BS.ByteString -> RawData
decodeBech32 = withPureBorshVarBuffer . rustWrapperBech32Decode decodeBech32 = withPureBorshVarBuffer . rustWrapperBech32Decode
@ -43,3 +37,20 @@ f4Jumble = withPureBorshVarBuffer . rustWrapperF4Jumble
-- | Apply the inverse F4Jumble transformation to the given bytestring -- | Apply the inverse F4Jumble transformation to the given bytestring
f4UnJumble :: BS.ByteString -> BS.ByteString f4UnJumble :: BS.ByteString -> BS.ByteString
f4UnJumble = withPureBorshVarBuffer . rustWrapperF4UnJumble f4UnJumble = withPureBorshVarBuffer . rustWrapperF4UnJumble
-- | Make a Zcash RPC call
makeZcashCall ::
(MonadIO m, FromJSON a)
=> BS.ByteString
-> BS.ByteString
-> T.Text
-> [Data.Aeson.Value]
-> m (Response a)
makeZcashCall username password m p = do
let payload = RpcCall "1.0" "test" m p
let myRequest =
setRequestBodyJSON payload $
setRequestPort 8232 $
setRequestBasicAuth username password $
setRequestMethod "POST" defaultRequest
httpJSON myRequest

File diff suppressed because one or more lines are too long

70
tx.json Normal file

File diff suppressed because one or more lines are too long

View file

@ -38,11 +38,13 @@ library
pkgconfig-depends: pkgconfig-depends:
rustzcash_wrapper-uninstalled rustzcash_wrapper-uninstalled
build-depends: build-depends:
base >=4.7 && <5 aeson
, base >=4.7 && <5
, borsh >=0.2 , borsh >=0.2
, bytestring , bytestring
, foreign-rust , foreign-rust
, generics-sop , generics-sop
, http-conduit
, text , text
default-language: Haskell2010 default-language: Haskell2010
@ -55,7 +57,8 @@ test-suite zcash-haskell-test
test test
ghc-options: -threaded -rtsopts -with-rtsopts=-N ghc-options: -threaded -rtsopts -with-rtsopts=-N
build-depends: build-depends:
base >=4.7 && <5 aeson
, base >=4.7 && <5
, bytestring , bytestring
, hspec , hspec
, text , text