From dce171d83043fae0e5c771ff743d31c4ec19c1ae Mon Sep 17 00:00:00 2001
From: Rene Vergara <rene@vergara.network>
Date: Fri, 12 Jan 2024 09:46:26 -0600
Subject: [PATCH] Encode transparent addresses

---
 CHANGELOG.md                    | 12 +++++-
 librustzcash-wrapper/src/lib.rs | 55 ++++++++++++++++++++++++++-
 package.yaml                    |  5 ++-
 src/C/Zcash.chs                 |  5 ++-
 src/ZcashHaskell/Orchard.hs     | 28 ++++++++++++--
 src/ZcashHaskell/Transparent.hs | 34 +++++++++++++++++
 src/ZcashHaskell/Types.hs       | 66 +++++++++++++++++++++++++++++++++
 test/Spec.hs                    | 19 +++++++---
 zcash-haskell.cabal             |  6 ++-
 9 files changed, 214 insertions(+), 16 deletions(-)
 create mode 100644 src/ZcashHaskell/Transparent.hs

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 14e77d4..7b07525 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -5,7 +5,17 @@ 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.3.0]
+
+### Added
+
+- Type to represent a transparent address/receiver
+
+### Changed
+
+- Full decoding of Unified Address
+
+## [0.2.0]
 
 ### Added
 
diff --git a/librustzcash-wrapper/src/lib.rs b/librustzcash-wrapper/src/lib.rs
index 41c3441..8973af8 100644
--- a/librustzcash-wrapper/src/lib.rs
+++ b/librustzcash-wrapper/src/lib.rs
@@ -189,6 +189,38 @@ impl<RW> ToHaskell<RW> for Hnote {
     }
 }
 
+#[derive(BorshSerialize, BorshDeserialize)]
+pub struct Hua {
+    net: u8,
+    o_rec: Vec<u8>,
+    s_rec: Vec<u8>,
+    t_rec: Vec<u8>,
+    to_rec: Vec<u8>
+}
+
+impl<RW> ToHaskell<RW> for Hua {
+    fn to_haskell<W: Write>(&self, writer: &mut W, _tag: PhantomData<RW>) -> Result<()> {
+        self.serialize(writer)?;
+        Ok(())
+    }
+}
+
+impl Hua {
+    fn add_rec(&mut self, rec: &Receiver) {
+        if let Receiver::Orchard(x) = rec {
+            self.o_rec = x.to_vec();
+        }
+        if let Receiver::Sapling(y) = rec {
+            self.s_rec = y.to_vec();
+        }
+        if let Receiver::P2pkh(z) = rec {
+            self.t_rec = z.to_vec();
+        }
+        if let Receiver::P2sh(w) = rec {
+            self.to_rec = w.to_vec();
+        }
+    }
+}
 
 #[derive(BorshSerialize, BorshDeserialize)]
 pub struct Hufvk {
@@ -261,9 +293,28 @@ pub extern "C" fn rust_wrapper_f4unjumble(
 #[no_mangle]
 pub extern "C" fn rust_wrapper_ua_decode(
     input: *const u8,
-    input_len: usize,) -> bool {
+    input_len: usize,
+    out: *mut u8,
+    out_len: &mut usize) {
     let input: String = marshall_from_haskell_var(input, input_len, RW);
-    Address::decode(&input).is_ok()
+    let dec_addy = Address::decode(&input);
+    match dec_addy {
+        Ok((n, ua)) => {
+            let x = match n {
+                Network::Main => 1,
+                Network::Test => 2,
+                Network::Regtest => 3
+                };
+            let mut hk = Hua { net: x, o_rec: vec![0], s_rec: vec![0], t_rec: vec![0], to_rec: vec![0] };
+            let recvs = ua.items();
+            recvs.iter().for_each(|k| hk.add_rec(k));
+            marshall_to_haskell_var(&hk, out, out_len, RW);
+        }
+        Err(_e) => {
+            let hk0 = Hua { net: 0, o_rec: vec![0], s_rec: vec![0], t_rec: vec![0], to_rec: vec![0]};
+            marshall_to_haskell_var(&hk0, out, out_len, RW);
+        }
+    }
     //marshall_to_haskell_var(&result, out, out_len, RW);
 }
 
diff --git a/package.yaml b/package.yaml
index 8e4d03f..4856888 100644
--- a/package.yaml
+++ b/package.yaml
@@ -1,5 +1,5 @@
 name:                zcash-haskell
-version:             0.2.1
+version:             0.3.0
 git:                 "https://git.vergara.tech/Vergara_Tech/zcash-haskell"
 license:             LGPL-3
 author:              "Rene Vergara"
@@ -33,6 +33,9 @@ library:
   - generics-sop
   - aeson
   - http-conduit
+  - base58-bytestring
+  - cryptonite
+  - memory
   pkg-config-dependencies:
   - rustzcash_wrapper-uninstalled
 
diff --git a/src/C/Zcash.chs b/src/C/Zcash.chs
index 38e9e30..ebda582 100644
--- a/src/C/Zcash.chs
+++ b/src/C/Zcash.chs
@@ -58,10 +58,11 @@ import ZcashHaskell.Types
   -> `()'
 #}
 
-{# fun pure unsafe rust_wrapper_ua_decode as rustWrapperIsUA
+{# fun unsafe rust_wrapper_ua_decode as rustWrapperUADecode
      { toBorshVar* `BS.ByteString'&
+     , getVarBuffer `Buffer RawUA'&
      }
-  -> `Bool'
+  -> `()'
 #}
 
 {# fun pure unsafe rust_wrapper_shielded_decode as rustWrapperIsShielded
diff --git a/src/ZcashHaskell/Orchard.hs b/src/ZcashHaskell/Orchard.hs
index 4ccfb34..44d17a5 100644
--- a/src/ZcashHaskell/Orchard.hs
+++ b/src/ZcashHaskell/Orchard.hs
@@ -29,9 +29,9 @@
 module ZcashHaskell.Orchard where
 
 import C.Zcash
-  ( rustWrapperIsUA
-  , rustWrapperOrchardCheck
+  ( rustWrapperOrchardCheck
   , rustWrapperOrchardNoteDecode
+  , rustWrapperUADecode
   , rustWrapperUfvkDecode
   )
 import qualified Data.ByteString as BS
@@ -39,8 +39,28 @@ import Foreign.Rust.Marshall.Variable
 import ZcashHaskell.Types
 
 -- | Checks if given bytestring is a valid encoded unified address
-isValidUnifiedAddress :: BS.ByteString -> Bool
-isValidUnifiedAddress = rustWrapperIsUA
+isValidUnifiedAddress :: BS.ByteString -> Maybe UnifiedAddress
+isValidUnifiedAddress str =
+  case raw_net decodedAddress of
+    0 -> Nothing
+    _ -> Just $ makeUA decodedAddress
+  where
+    decodedAddress = (withPureBorshVarBuffer . rustWrapperUADecode) str
+    whichNet =
+      case raw_net decodedAddress of
+        1 -> MainNet
+        2 -> TestNet
+        3 -> RegTestNet
+    makeUA x =
+      UnifiedAddress
+        whichNet
+        (raw_o x)
+        (raw_s x)
+        (if not (BS.null (raw_t x))
+           then Just $ TransparentAddress P2PKH whichNet (raw_t x)
+           else if not (BS.null (raw_to x))
+                  then Just $ TransparentAddress P2SH whichNet (raw_to x)
+                  else Nothing)
 
 -- | Attempts to decode the given bytestring into a Unified Full Viewing Key
 decodeUfvk :: BS.ByteString -> Maybe UnifiedFullViewingKey
diff --git a/src/ZcashHaskell/Transparent.hs b/src/ZcashHaskell/Transparent.hs
new file mode 100644
index 0000000..bbc10d6
--- /dev/null
+++ b/src/ZcashHaskell/Transparent.hs
@@ -0,0 +1,34 @@
+{- Copyright 2022-2024 Vergara Technologies LLC
+
+  This file is part of Zcash-Haskell.
+ 
+  Zcash-Haskell is free software: you can redistribute it and/or modify it
+  under the terms of the GNU Lesser General Public License as published by the Free
+  Software Foundation, either version 3 of the License, or (at your option) any
+  later version.
+ 
+  Zcash-Haskell is distributed in the hope that it will be useful, but WITHOUT
+  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
+  FOR A PARTICULAR PURPOSE. See the GNU Lesser General Public License for more
+  details.
+
+  You should have received a copy of the GNU Lesser General Public License along with
+  Zcash-Haskell. If not, see <https://www.gnu.org/licenses/>.
+
+-}
+{-# LANGUAGE OverloadedStrings #-}
+
+-- |
+-- Module      :  ZcashHaskell.Transparent
+-- Copyright   :  2022-2024 Vergara Technologies
+-- License     :  LGPL-3
+--
+-- Maintainer  :  pitmutt@vergara.tech
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- Functions to interact with the transparent addresses in the Zcash blockchain
+--
+module ZcashHaskell.Transparent where
+
+import qualified Data.ByteString as BS
diff --git a/src/ZcashHaskell/Types.hs b/src/ZcashHaskell/Types.hs
index 2db0906..47df822 100644
--- a/src/ZcashHaskell/Types.hs
+++ b/src/ZcashHaskell/Types.hs
@@ -37,12 +37,17 @@
 module ZcashHaskell.Types where
 
 import Codec.Borsh
+import Control.Exception (MaskingState(Unmasked))
+import Crypto.Hash
 import Data.Aeson
+import qualified Data.ByteArray as BA
 import qualified Data.ByteString as BS
+import Data.ByteString.Base58 (bitcoinAlphabet, encodeBase58)
 import qualified Data.ByteString.Char8 as C
 import Data.Int
 import Data.Structured
 import qualified Data.Text as T
+import qualified Data.Text.Encoding as E
 import Data.Word
 import qualified GHC.Generics as GHC
 import qualified Generics.SOP as SOP
@@ -128,6 +133,47 @@ data RawTxResponse = RawTxResponse
   , rt_blocktime :: Integer
   } deriving (Prelude.Show, Eq)
 
+data ZcashNet
+  = MainNet
+  | TestNet
+  | RegTestNet
+  deriving (Eq, Prelude.Show)
+
+-- * Transparent
+-- | Type to represent the two kinds of transparent addresses
+data TransparentType
+  = P2SH
+  | P2PKH
+  deriving (Eq)
+
+-- | Type to represent a transparent Zcash addresses
+data TransparentAddress = TransparentAddress
+  { ta_type :: TransparentType
+  , ta_net :: ZcashNet
+  , ta_bytes :: BS.ByteString
+  } deriving (Eq)
+
+instance Prelude.Show TransparentAddress where
+  show t =
+    case ta_type t of
+      P2SH ->
+        case ta_net t of
+          MainNet -> Prelude.show $ encodeTransparent (0x1c, 0xbd) $ ta_bytes t
+          _ -> Prelude.show $ encodeTransparent (0x1c, 0xba) $ ta_bytes t
+      P2PKH ->
+        case ta_net t of
+          MainNet -> Prelude.show $ encodeTransparent (0x1c, 0xb8) $ ta_bytes t
+          _ -> Prelude.show $ encodeTransparent (0x1d, 0x25) $ ta_bytes t
+    where
+      encodeTransparent :: (Word8, Word8) -> BS.ByteString -> BS.ByteString
+      encodeTransparent (a, b) h =
+        encodeBase58 bitcoinAlphabet $ digest <> BS.take 4 checksum
+        where
+          sha256 :: BS.ByteString -> BS.ByteString
+          sha256 bs = BA.convert (hash bs :: Digest SHA256)
+          digest = BS.pack [a, b] <> h
+          checksum = sha256 $ sha256 digest
+
 -- * Sapling
 -- | Type to represent a Sapling Shielded Output as provided by the @getrawtransaction@ RPC method of @zcashd@.
 data ShieldedOutput = ShieldedOutput
@@ -161,6 +207,26 @@ instance FromJSON ShieldedOutput where
           (decodeHexText p)
 
 -- * Orchard
+-- | Type to represent a Unified Address
+data UnifiedAddress = UnifiedAddress
+  { ua_net :: ZcashNet
+  , o_rec :: BS.ByteString
+  , s_rec :: BS.ByteString
+  , t_rec :: Maybe TransparentAddress
+  } deriving (Prelude.Show, Eq)
+
+-- | Helper type for marshalling UAs 
+data RawUA = RawUA
+  { raw_net :: Word8
+  , raw_o :: BS.ByteString
+  , raw_s :: BS.ByteString
+  , raw_t :: BS.ByteString
+  , raw_to :: 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 RawUA
+
 -- | 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@.
diff --git a/test/Spec.hs b/test/Spec.hs
index 1eaaecc..8007b19 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -18,10 +18,11 @@
 -}
 {-# LANGUAGE OverloadedStrings #-}
 
-import C.Zcash (rustWrapperIsUA)
+import C.Zcash (rustWrapperUADecode)
 import Data.Aeson
 import Data.Bool (Bool(True))
 import qualified Data.ByteString as BS
+import Data.Maybe
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import qualified Data.Text.Lazy.Encoding as LE
@@ -30,7 +31,6 @@ import Data.Word
 import GHC.Float.RealFracMethods (properFractionDoubleInteger)
 import Test.Hspec
 import ZcashHaskell.Orchard
-import ZcashHaskell.Orchard (matchOrchardAddress)
 import ZcashHaskell.Sapling
   ( decodeSaplingOutput
   , getShieldedOutputs
@@ -45,11 +45,11 @@ import ZcashHaskell.Types
   , RawData(..)
   , RawTxResponse(..)
   , ShieldedOutput(..)
+  , UnifiedAddress(..)
   , UnifiedFullViewingKey(..)
   , decodeHexText
   )
 import ZcashHaskell.Utils
-import ZcashHaskell.Utils (decodeBech32)
 
 main :: IO ()
 main = do
@@ -315,11 +315,11 @@ main = do
       it "succeeds with correct UA" $ do
         let ua =
               "u1salpdyefywvsg2dlmxg9589yznh0h9v6qjr478k80amtkqkws5pr408lxt2953dpprvu06mahxt99cv65fgsm7sw8hlchplfg5pl89ur"
-        isValidUnifiedAddress ua `shouldBe` True
+        isJust (isValidUnifiedAddress ua) `shouldBe` True
       it "fails with incorrect UA" $ do
         let ua =
               "u1salpdyefbreakingtheaddressh0h9v6qjr478k80amtkqkws5pr408lxt2953dpprvu06mahxt99cv65fgsm7sw8hlchplfg5pl89ur"
-        isValidUnifiedAddress ua `shouldBe` False
+        isValidUnifiedAddress ua `shouldBe` Nothing
     describe "Decode UVK from YWallet" $ do
       let uvk =
             "uview1u833rp8yykd7h4druwht6xp6k8krle45fx8hqsw6vzw63n24atxpcatws82z092kryazuu6d7rayyut8m36wm4wpjy2z8r9hj48fx5pf49gw4sjrq8503qpz3vqj5hg0vg9vsqeasg5qjuyh94uyfm7v76udqcm2m0wfc25hcyqswcn56xxduq3xkgxkr0l73cjy88fdvf90eq5fda9g6x7yv7d0uckpevxg6540wc76xrc4axxvlt03ptaa2a0rektglmdy68656f3uzcdgqqyu0t7wk5cvwghyyvgqc0rp3vgu5ye4nd236ml57rjh083a2755qemf6dk6pw0qrnfm7246s8eg2hhzkzpf9h73chhng7xhmyem2sjh8rs2m9nhfcslsgenm"
@@ -420,3 +420,12 @@ main = do
           let msg = maybe "" a_memo decryptedNote2
           msg `shouldBe`
             "Hello World!\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL\NUL"
+    describe "Address tests" $ do
+      it "Encode transparent" $ do
+        let ua =
+              "u17n7hpwaujyq7ux8f9jpyymtnk5urw7pyrf60smp5mawy7jgz325hfvz3jn3zsfya8yxryf9q7ldk8nu8df0emra5wne28zq9d9nm2pu4x6qwjha565av9aze0xgujgslz74ufkj0c0cylqwjyrh9msjfh7jzal6d3qzrnhkkqy3pqm8j63y07jxj7txqeac982778rmt64f32aum94x"
+        let msg =
+              case isValidUnifiedAddress ua of
+                Nothing -> "Bad UA"
+                Just u -> maybe "No transparent" show $ t_rec u
+        msg `shouldBe` "Got it"
diff --git a/zcash-haskell.cabal b/zcash-haskell.cabal
index 0ae068e..30803ce 100644
--- a/zcash-haskell.cabal
+++ b/zcash-haskell.cabal
@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zcash-haskell
-version:        0.2.1
+version:        0.3.0
 synopsis:       Utilities to interact with the Zcash blockchain
 description:    Please see the README on the repo at <https://git.vergara.tech/Vergara_Tech/zcash-haskell#readme>
 category:       Blockchain
@@ -28,6 +28,7 @@ library
       C.Zcash
       ZcashHaskell.Orchard
       ZcashHaskell.Sapling
+      ZcashHaskell.Transparent
       ZcashHaskell.Types
       ZcashHaskell.Utils
   other-modules:
@@ -39,11 +40,14 @@ library
   build-depends:
       aeson
     , base >=4.7 && <5
+    , base58-bytestring
     , borsh >=0.2
     , bytestring
+    , cryptonite
     , foreign-rust
     , generics-sop
     , http-conduit
+    , memory
     , text
   default-language: Haskell2010