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

Reviewed-on: #1

CHANGELOG.md

@@ -9,10 +9,20 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ### 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
 
 ### Changed
 
+- Rearranged modules for cleaner dependencies.
 - Upgrade to Haskell LTS 21.6
 
 ## [0.1.0] - 2023-06-14 

block.json

@@ -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"
+}

librustzcash-wrapper/src/lib.rs

@@ -1,7 +1,10 @@
 
 use std::{
     marker::PhantomData,
-    io::Write,
+    io::{
+        Write,
+        Cursor
+    },
     fmt::{Debug, Display, Formatter}
 };
 
@@ -19,18 +22,24 @@ use haskell_ffi::{
 use zcash_primitives::{
     zip32::Scope as SaplingScope,
     transaction::components::sapling::{
+        read_zkproof,
         GrothProofBytes,
         OutputDescription,
         CompactOutputDescription
     },
     sapling::{
         value::ValueCommitment as SaplingValueCommitment,
-        keys::FullViewingKey as SaplingViewingKey,
+        keys::{
+            FullViewingKey as SaplingViewingKey,
+            PreparedIncomingViewingKey as SaplingPreparedIncomingViewingKey
+        },
         note_encryption::SaplingDomain,
         PaymentAddress,
         note::ExtractedNoteCommitment as SaplingExtractedNoteCommitment
     },
+    transaction::Transaction,
     consensus::{
+        BranchId::Nu5,
         MainNetwork,
         BlockHeight
     }
@@ -38,7 +47,7 @@ use zcash_primitives::{
 
 use zcash_address::{
     Network,
-    unified::{Address, Encoding, Ufvk, Container, Fvk},
+    unified::{Address, Encoding, Ufvk, Container, Fvk, Receiver},
     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)]
 pub struct HshieldedOutput {
     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)]
 pub struct Haction {
     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]
 pub extern "C" fn rust_wrapper_ufvk_decode(
     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]
 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);
+        }
+    }
+}

package.yaml

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

src/C/Zcash.chs

@@ -72,6 +72,21 @@ import ZcashHaskell.Types
   -> `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
      { toBorshVar* `BS.ByteString'&
      , getVarBuffer `Buffer UnifiedFullViewingKey'&
@@ -82,7 +97,14 @@ import ZcashHaskell.Types
 {# fun unsafe rust_wrapper_orchard_note_decrypt as rustWrapperOrchardNoteDecode
      { toBorshVar* `BS.ByteString'&
      , toBorshVar* `OrchardAction'&
-     , getVarBuffer `Buffer OrchardDecodedAction'&
+     , getVarBuffer `Buffer DecodedNote'&
      }
   -> `()'
-  #}
+#}
+
+{# fun unsafe rust_wrapper_tx_parse as rustWrapperTxParse
+     { toBorshVar* `BS.ByteString'&
+     , getVarBuffer `Buffer [BS.ByteString]'&
+     }
+  -> `()'
+#}

src/ZcashHaskell/Orchard.hs

@@ -13,6 +13,7 @@ module ZcashHaskell.Orchard where
 
 import C.Zcash
   ( rustWrapperIsUA
+  , rustWrapperOrchardCheck
   , rustWrapperOrchardNoteDecode
   , rustWrapperUfvkDecode
   )
@@ -33,10 +34,14 @@ decodeUfvk str =
   where
     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@.
 decryptOrchardAction ::
-     OrchardAction -> UnifiedFullViewingKey -> Maybe OrchardDecodedAction
+     UnifiedFullViewingKey -> OrchardAction -> Maybe DecodedNote
-decryptOrchardAction encAction key =
+decryptOrchardAction key encAction =
   case a_value decodedAction of
     0 -> Nothing
     _ -> Just decodedAction

src/ZcashHaskell/Sapling.hs

@@ -1,20 +1,84 @@
+{-# LANGUAGE OverloadedStrings #-}
+
 module ZcashHaskell.Sapling where
 
 import C.Zcash
   ( rustWrapperIsShielded
   , rustWrapperSaplingCheck
+  , rustWrapperSaplingNoteDecode
   , rustWrapperSaplingVkDecode
+  , rustWrapperTxParse
   )
+import Data.Aeson
 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
 isValidShieldedAddress :: BS.ByteString -> Bool
 isValidShieldedAddress = rustWrapperIsShielded
 
+getShieldedOutputs :: BS.ByteString -> [BS.ByteString]
+getShieldedOutputs t = withPureBorshVarBuffer $ rustWrapperTxParse t
+
 -- | Check if given bytestring is a valid Sapling viewing key
 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
 matchSaplingAddress :: BS.ByteString -> BS.ByteString -> Bool
 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

src/ZcashHaskell/Types.hs

@@ -1,7 +1,9 @@
 {-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DerivingVia #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE OverloadedStrings #-}
 
 -- |
 -- Module      :  ZcashHaskell.Types
@@ -17,13 +19,17 @@
 module ZcashHaskell.Types where
 
 import Codec.Borsh
+import Data.Aeson
 import qualified Data.ByteString as BS
+import qualified Data.ByteString.Char8 as C
 import Data.Int
 import Data.Structured
+import qualified Data.Text as T
 import Data.Word
 import qualified GHC.Generics as GHC
 import qualified Generics.SOP as SOP
 
+-- * General
 -- | Type to represent data after Bech32 decoding
 data RawData = RawData
   { hrp :: BS.ByteString -- ^ Human-readable part of the Bech32 encoding
@@ -33,17 +39,78 @@ data RawData = RawData
     deriving anyclass (Data.Structured.Show)
     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@.
 data ShieldedOutput = ShieldedOutput
   { s_cv :: BS.ByteString -- ^ Value commitment to the input note
@@ -57,6 +124,36 @@ data ShieldedOutput = ShieldedOutput
     deriving anyclass (Data.Structured.Show)
     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)
 data OrchardAction = OrchardAction
   { nf :: BS.ByteString -- ^ The nullifier of the input note
@@ -72,12 +169,46 @@ data OrchardAction = OrchardAction
     deriving anyclass (Data.Structured.Show)
     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_recipient :: BS.ByteString -- ^ The recipient Orchard receiver.
   , a_memo :: BS.ByteString -- ^ The decoded shielded memo field.
   } deriving stock (Eq, Prelude.Show, GHC.Generic)
     deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
     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

src/ZcashHaskell/Utils.hs

@@ -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.
 --
+{-# LANGUAGE OverloadedStrings #-}
+
 module ZcashHaskell.Utils where
 
 import C.Zcash
@@ -16,22 +18,14 @@ import C.Zcash
   , rustWrapperF4Jumble
   , rustWrapperF4UnJumble
   )
-
+import Control.Monad.IO.Class
+import Data.Aeson
 import qualified Data.ByteString as BS
+import qualified Data.Text as T
 import Foreign.Rust.Marshall.Variable
+import Network.HTTP.Simple
 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
 decodeBech32 :: BS.ByteString -> RawData
 decodeBech32 = withPureBorshVarBuffer . rustWrapperBech32Decode
@@ -43,3 +37,20 @@ f4Jumble = withPureBorshVarBuffer . rustWrapperF4Jumble
 -- | Apply the inverse F4Jumble transformation to the given bytestring
 f4UnJumble :: BS.ByteString -> BS.ByteString
 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

zcash-haskell.cabal

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