Compare commits

..

6 commits

13 changed files with 1129 additions and 41 deletions

View file

@ -5,12 +5,23 @@ All notable changes to this project will be documented in this file.
The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html).
## [Unreleased]
## [0.1.0] - 2023-06-14
### Added
- Function `decodeHexText`
- Function `decodeBech32`
- Function `f4Jumble`
- Function `isValidUnifiedAddress`
- Function `f4UnJumble`
- Function `isValidShieldedAddress`
- Function `decodeBech32`
- Function `isValidSaplingViewingKey`
- Function `matchSaplingAddress`
- Function `isValidUnifiedAddress`
- Function `decodeUfvk`
- Function `decryptOrchardAction`
- Type `RawData`
- Type `ShieldedOutput`
- Type `OrchardAction`
- Type `OrchardDecodedAction`
- Type `UnifiedFullViewingKey`

View file

@ -4,7 +4,10 @@ rustlib := librustzcash-wrapper/target/x86_64-unknown-linux-gnu/debug
all: haskell
haskell: src/Zcash.hs src/C/Zcash.chs package.yaml stack.yaml $(rustlib)/rustzcash_wrapper.h $(rustlib)/librustzcash_wrapper.a $(rustlib)/librustzcash_wrapper.so $(rustlib)/rustzcash_wrapper-uninstalled.pc
test: test/Spec.hs haskell
stack test
haskell: src/ZcashHaskell/Orchard.hs src/ZcashHaskell/Sapling.hs src/ZcashHaskell/Types.hs src/ZcashHaskell/Utils.hs src/C/Zcash.chs package.yaml stack.yaml $(rustlib)/rustzcash_wrapper.h $(rustlib)/librustzcash_wrapper.a $(rustlib)/librustzcash_wrapper.so $(rustlib)/rustzcash_wrapper-uninstalled.pc
stack build
$(rustlib)/rustzcash_wrapper.h: librustzcash-wrapper/src/lib.rs librustzcash-wrapper/Cargo.toml

File diff suppressed because it is too large Load diff

View file

@ -14,6 +14,8 @@ borsh = "0.10"
bech32 = "0.9.1"
orchard = "0.4.0"
zcash_note_encryption = "0.3.0"
zcash_primitives = "0.11.0"
zcash_client_backend = "0.9.0"
[features]
capi = []

View file

@ -16,12 +16,34 @@ use haskell_ffi::{
FromHaskell, HaskellSize, ToHaskell
};
use zcash_primitives::{
zip32::Scope as SaplingScope,
transaction::components::sapling::{
GrothProofBytes,
OutputDescription,
CompactOutputDescription
},
sapling::{
value::ValueCommitment as SaplingValueCommitment,
keys::FullViewingKey as SaplingViewingKey,
note_encryption::SaplingDomain,
PaymentAddress,
note::ExtractedNoteCommitment as SaplingExtractedNoteCommitment
},
consensus::{
MainNetwork,
BlockHeight
}
};
use zcash_address::{
Network,
unified::{Address, Encoding, Ufvk, Container, Fvk},
ZcashAddress
};
use zcash_client_backend::keys::sapling::ExtendedFullViewingKey;
use orchard::{
Action,
keys::{FullViewingKey, PreparedIncomingViewingKey, Scope},
@ -31,11 +53,14 @@ use orchard::{
value::ValueCommitment
};
use zcash_note_encryption;
use zcash_note_encryption::EphemeralKeyBytes;
use bech32::{
decode,
u5
u5,
FromBase32,
ToBase32,
Variant
};
pub enum RW {}
@ -61,6 +86,23 @@ impl<RW> ToHaskell<RW> for RawData {
//}
//}
#[derive(BorshSerialize, BorshDeserialize)]
pub struct HshieldedOutput {
cv: Vec<u8>,
cmu: Vec<u8>,
eph_key: Vec<u8>,
enc_txt: Vec<u8>,
out_txt: Vec<u8>,
proof: Vec<u8>
}
impl<RW> FromHaskell<RW> for HshieldedOutput {
fn from_haskell(buf: &mut &[u8], _tag: PhantomData<RW>) -> Result<Self> {
let x = HshieldedOutput::deserialize(buf)?;
Ok(x)
}
}
#[derive(BorshSerialize, BorshDeserialize)]
pub struct Haction {
nf: Vec<u8>,
@ -124,6 +166,19 @@ impl Hufvk {
}
}
#[derive(BorshSerialize, BorshDeserialize)]
pub struct Hsvk {
vk: Vec<u8>,
ovk: Vec<u8>
}
impl<RW> ToHaskell<RW> for Hsvk {
fn to_haskell<W: Write>(&self, writer: &mut W, _tag: PhantomData<RW>) -> Result<()> {
self.serialize(writer)?;
Ok(())
}
}
fn to_array<T, const N: usize>(v: Vec<T>) -> [T; N] {
v.try_into().unwrap_or_else(|v: Vec<T>| panic!("Expected a Vec of length {} but it was {}", N, v.len()))
}
@ -175,9 +230,57 @@ pub extern "C" fn rust_wrapper_bech32decode(
out_len: &mut usize
) {
let input: String = marshall_from_haskell_var(input, input_len, RW);
let (hrp, bytes) = bech32::decode_without_checksum(&input).unwrap();
let rd = RawData {hrp: hrp.into(), bytes: bytes.iter().map(|&x| bech32::u5::to_u8(x)).collect()};
let decodedBytes = bech32::decode(&input);
match decodedBytes {
Ok((hrp, bytes, variant)) => {
let rd = RawData {hrp: hrp.into(), bytes: Vec::<u8>::from_base32(&bytes).unwrap()};
marshall_to_haskell_var(&rd, out, out_len, RW);
}
Err(_e) => {
let rd1 = RawData {hrp: "fail".into(), bytes: vec![0]};
marshall_to_haskell_var(&rd1, out, out_len, RW);
}
}
}
#[no_mangle]
pub extern "C" fn rust_wrapper_svk_decode(
input: *const u8,
input_len: usize
) -> bool {
let input: Vec<u8> = marshall_from_haskell_var(input, input_len, RW);
let svk = ExtendedFullViewingKey::read(&*input);
match svk {
Ok(k) => {
true
}
Err(e) => {
print!("{}", e);
false
}
}
}
#[no_mangle]
pub extern "C" fn rust_wrapper_svk_check_address(
key_input: *const u8,
key_input_len: usize,
address_input: *const u8,
address_input_len: usize
) -> bool {
let key_input: Vec<u8> = marshall_from_haskell_var(key_input, key_input_len, RW);
let address_input: Vec<u8> = marshall_from_haskell_var(address_input, address_input_len, RW);
let svk = ExtendedFullViewingKey::read(&*key_input);
let sa = PaymentAddress::from_bytes(&to_array(address_input)).unwrap();
match svk {
Ok(k) => {
let (div_index, def_address) = k.default_address();
sa == def_address
}
Err(e) => {
false
}
}
}
#[no_mangle]
@ -208,6 +311,36 @@ pub extern "C" fn rust_wrapper_ufvk_decode(
}
}
//#[no_mangle]
//pub extern "C" fn rust_wrapper_sapling_note_decrypt(
//key: *const u8,
//key_len: usize,
//note: *const u8,
//note_len: usize,
//out: *mut u8,
//out_len: &mut usize
//){
//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 svk = ExtendedFullViewingKey::read(&*evk);
//match svk {
//Ok(k) => {
//let domain = SaplingDomain::for_height(MainNetwork, BlockHeight::from_u32(2000000));
//let action: CompactOutputDescription = CompactOutputDescription {
//ephemeral_key: EphemeralKeyBytes(to_array(note_input.eph_key)),
//cmu: SaplingExtractedNoteCommitment::from_bytes(&to_array(note_input.cmu)).unwrap(),
//enc_ciphertext: to_array(note_input.enc_txt)
//};
//let fvk = k.to_diversifiable_full_viewing_key().to_ivk(SaplingScope::External);
//let result = zcash_note_encryption::try_note_decryption(&domain, &ivk, &action);
//}
//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(
key: *const u8,

View file

@ -23,7 +23,7 @@ import Foreign.Rust.Serialisation.Raw
import Foreign.Rust.Serialisation.Raw.Base16
import qualified Generics.SOP as SOP
import qualified GHC.Generics as GHC
import HaskellZcash.Types
import ZcashHaskell.Types
{# fun unsafe rust_wrapper_f4jumble as rustWrapperF4Jumble
@ -59,6 +59,19 @@ import HaskellZcash.Types
-> `()'
#}
{# fun pure unsafe rust_wrapper_svk_decode as rustWrapperSaplingVkDecode
{ toBorshVar* `BS.ByteString'&
}
-> `Bool'
#}
{# fun pure unsafe rust_wrapper_svk_check_address as rustWrapperSaplingCheck
{ toBorshVar* `BS.ByteString'&
, toBorshVar* `BS.ByteString'&
}
-> `Bool'
#}
{# fun unsafe rust_wrapper_ufvk_decode as rustWrapperUfvkDecode
{ toBorshVar* `BS.ByteString'&
, getVarBuffer `Buffer UnifiedFullViewingKey'&

View file

@ -1,8 +0,0 @@
module HaskellZcash.Sapling where
import C.Zcash (rustWrapperIsShielded)
import qualified Data.ByteString as BS
-- | Check if given bytesting is a valid encoded shielded address
isValidShieldedAddress :: BS.ByteString -> Bool
isValidShieldedAddress = rustWrapperIsShielded

View file

@ -1,4 +1,4 @@
module HaskellZcash.Orchard where
module ZcashHaskell.Orchard where
import C.Zcash
( rustWrapperIsUA
@ -7,7 +7,7 @@ import C.Zcash
)
import qualified Data.ByteString as BS
import Foreign.Rust.Marshall.Variable
import HaskellZcash.Types
import ZcashHaskell.Types
-- | Check if given bytestring is a valid encoded unified address
isValidUnifiedAddress :: BS.ByteString -> Bool

View file

@ -0,0 +1,20 @@
module ZcashHaskell.Sapling where
import C.Zcash
( rustWrapperIsShielded
, rustWrapperSaplingCheck
, rustWrapperSaplingVkDecode
)
import qualified Data.ByteString as BS
-- | Check if given bytesting is a valid encoded shielded address
isValidShieldedAddress :: BS.ByteString -> Bool
isValidShieldedAddress = rustWrapperIsShielded
-- | Check if given bytestring is a valid Sapling viewing key
isValidSaplingViewingKey :: BS.ByteString -> Bool
isValidSaplingViewingKey = rustWrapperSaplingVkDecode
-- | 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

View file

@ -1,11 +1,9 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module HaskellZcash.Types where
module ZcashHaskell.Types where
import qualified Data.ByteString as BS
import Codec.Borsh
@ -33,6 +31,20 @@ data UnifiedFullViewingKey =
deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct UnifiedFullViewingKey
data ShieldedOutput =
ShieldedOutput
{ s_cv :: BS.ByteString
, s_cmu :: BS.ByteString
, s_ephKey :: BS.ByteString
, s_encCipherText :: BS.ByteString
, s_outCipherText :: BS.ByteString
, s_proof :: BS.ByteString
}
deriving stock (Eq, Prelude.Show, GHC.Generic)
deriving anyclass (SOP.Generic, SOP.HasDatatypeInfo)
deriving anyclass (Data.Structured.Show)
deriving (BorshSize, ToBorsh, FromBorsh) via AsStruct ShieldedOutput
data OrchardAction =
OrchardAction
{ nf :: BS.ByteString

View file

@ -1,4 +1,4 @@
module HaskellZcash.Utils where
module ZcashHaskell.Utils where
import C.Zcash
( rustWrapperBech32Decode
@ -8,7 +8,7 @@ import C.Zcash
import qualified Data.ByteString as BS
import Foreign.Rust.Marshall.Variable
import HaskellZcash.Types
import ZcashHaskell.Types
-- | Helper function to turn a hex-encoded strings to bytestring
decodeHexText :: String -> BS.ByteString

View file

@ -4,19 +4,30 @@ import C.Zcash (rustWrapperIsUA)
import qualified Data.ByteString as BS
import qualified Data.Text.Encoding as E
import Data.Word
import HaskellZcash.Orchard
import HaskellZcash.Types
import Test.Hspec
import ZcashHaskell.Orchard
import ZcashHaskell.Sapling
( isValidSaplingViewingKey
, isValidShieldedAddress
, matchSaplingAddress
)
import ZcashHaskell.Types
( OrchardAction(..)
, OrchardDecodedAction(..)
, RawData(..)
, UnifiedFullViewingKey(..)
)
import HaskellZcash.Utils
import Test.Hspec
import ZcashHaskell.Utils
main :: IO ()
main = do
hspec $ do
describe "Bech32" $ do
let s = "bech321qqqsyrhqy2a"
let decodedString = decodeBech32 s
it "hrp matches" $ do hrp decodedString `shouldBe` "bech32"
it "data matches" $ do
bytes decodedString `shouldBe` BS.pack ([0x00, 0x01, 0x02] :: [Word8])
describe "F4Jumble" $ do
it "jumble a string" $ do
let input =
@ -222,6 +233,37 @@ main = do
, 0x22
] :: [Word8]
f4UnJumble (BS.pack out) `shouldBe` BS.pack input
describe "Sapling address" $ do
it "succeeds with valid address" $ do
let sa =
"zs17faa6l5ma55s55exq9rnr32tu0wl8nmqg7xp3e6tz0m5ajn2a6yxlc09t03mqdmvyphavvf3sl8"
isValidShieldedAddress sa `shouldBe` True
it "fails with invalid address" $ do
let sa =
"zs17faa6l5ma55s55exq9rnr32tu0wl8nmqg7xp3e6tz0m5ajn2a6yxlc09t03mqdmvyphavvffake"
isValidShieldedAddress sa `shouldBe` False
describe "Decode Sapling VK" $ do
let vk =
"zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwcpjs"
let sa =
"zs1g2ne5w2r8kvalwzngsk3kfzppx3qcx5560pnfmw9rj5xfd3zfg9dkm7hyxnfyhc423fev5wuue4"
let sa' =
"zs17faa6l5ma55s55exq9rnr32tu0wl8nmqg7xp3e6tz0m5ajn2a6yxlc09t03mqdmvyphavvf3sl8"
let rawKey = decodeBech32 vk
let rawSa = decodeBech32 sa
let rawSa' = decodeBech32 sa'
it "is mainnet" $ do hrp rawKey `shouldBe` "zxviews"
it "is valid Sapling extended full viewing key" $ do
isValidSaplingViewingKey (bytes rawKey) `shouldBe` True
it "matches the right Sapling address" $ do
matchSaplingAddress (bytes rawKey) (bytes rawSa) `shouldBe` True
it "doesn't match the wrong Sapling address" $ do
matchSaplingAddress (bytes rawKey) (bytes rawSa') `shouldBe` False
describe "Decode invalid Sapling VK" $ do
let vk =
"zxviews1qdjagrrpqqqqpq8es75mlu6rref0qyrstchf8dxzeygtsejwfqu8ckhwl2qj5m8am7lmupxk3vkvdjm8pawjpmesjfapvsqw96pa46c2z0kk7letrxf7mkltwz54fwpxc7kc79mm5kce3rwn5ssl009zwsra2spppwgrx25s9k5hq65f69l4jz2tjmqgy0pl49qmtaj3nudk6wglwe2hpa327hydlchtyq9av6wjd6hu68e04ahwk9a9n2kt0kj3nj99nue65awtu5cwwfake"
let rawKey = decodeBech32 vk
it "is not mainnet" $ do hrp rawKey `shouldBe` "fail"
describe "Unified address" $ do
it "succeeds with correct UA" $ do
let ua =

View file

@ -27,10 +27,10 @@ source-repository head
library
exposed-modules:
C.Zcash
HaskellZcash.Orchard
HaskellZcash.Sapling
HaskellZcash.Types
HaskellZcash.Utils
ZcashHaskell.Orchard
ZcashHaskell.Sapling
ZcashHaskell.Types
ZcashHaskell.Utils
other-modules:
Paths_zcash_haskell
hs-source-dirs: