rvv040 - Add new function to decode a Transparent Address in HRF

The function  retunrs a TransparentAddress object.

CHANGELOG.md

@@ -5,6 +5,13 @@ 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).
 
+## [0.5.5.0]
+
+- Added unction to decode Transparent Address in Human Readable Format
+- TransparentAddress type refactored
+- TransparentReceiver added to replace old TransparentAddress 
+- sha256 Functionmoved outside of encodeTransparentReceiver
+
 ## [0.5.4.0]
 
 - Function to decode Orchard actions with a spending key

src/ZcashHaskell/Orchard.hs

@@ -95,9 +95,9 @@ isValidUnifiedAddress str =
            then Just $ SaplingReceiver (raw_s x)
            else Nothing)
         (if not (BS.null (raw_t x))
-           then Just $ TransparentAddress P2PKH (fromRawBytes $ raw_t x)
+           then Just $ TransparentReceiver P2PKH (fromRawBytes $ raw_t x)
            else if not (BS.null (raw_to x))
-                  then Just $ TransparentAddress P2SH (fromRawBytes $ raw_to x)
+                  then Just $ TransparentReceiver P2SH (fromRawBytes $ raw_to x)
                   else Nothing)
 
 -- | Encode a 'UnifiedAddress' per [ZIP-316](https://zips.z.cash/zip-0316)
@@ -113,9 +113,9 @@ encodeUnifiedAddress ua = encodeBech32m (E.encodeUtf8 hr) b
       case t_rec ua of
         Nothing -> BS.empty
         Just t ->
-          case ta_type t of
-            P2SH -> packReceiver 0x01 $ Just $ toBytes $ ta_bytes t
-            P2PKH -> packReceiver 0x00 $ Just $ toBytes $ ta_bytes t
+          case tr_type t of
+            P2SH -> packReceiver 0x01 $ Just $ toBytes $ tr_bytes t
+            P2PKH -> packReceiver 0x00 $ Just $ toBytes $ tr_bytes t
     sReceiver = packReceiver 0x02 $ getBytes <$> s_rec ua
     oReceiver = packReceiver 0x03 $ getBytes <$> o_rec ua
     padding = E.encodeUtf8 $ T.justifyLeft 16 '\NUL' hr

src/ZcashHaskell/Transparent.hs

@@ -20,11 +20,12 @@ import Crypto.Hash
 import Crypto.Secp256k1
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString as BS
-import Data.ByteString.Base58 (bitcoinAlphabet, encodeBase58)
+import Data.ByteString.Base58 (bitcoinAlphabet, encodeBase58, decodeBase58)
 import Data.HexString
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Word
+import Data.Char (chr)
 import Haskoin.Address (Address(..))
 import qualified Haskoin.Crypto.Hash as H
 import Haskoin.Crypto.Keys.Extended
@@ -34,6 +35,7 @@ import ZcashHaskell.Types
   , Scope(..)
   , Seed(..)
   , ToBytes(..)
+  , TransparentReceiver(..)
   , TransparentAddress(..)
   , TransparentSpendingKey(..)
   , TransparentType(..)
@@ -42,21 +44,23 @@ import ZcashHaskell.Types
   , getValue
   )
 
--- | Encodes a `TransparentAddress` into the human-readable format per the Zcash Protocol section 5.6.1.1
-encodeTransparent ::
+-- | Required for `TransparentReceiver` encoding and decoding 
+sha256 :: BS.ByteString -> BS.ByteString
+sha256 bs = BA.convert (hash bs :: Digest SHA256)
+
+-- | Encodes a `TransparentReceiver` into the human-readable format per the Zcash Protocol section 5.6.1.1
+encodeTransparentReceiver ::
      ZcashNet -- ^ The network, `MainNet` or `TestNet`
-  -> TransparentAddress -- ^ The address to encode
+  -> TransparentReceiver -- ^ The address to encode
   -> T.Text
-encodeTransparent zNet t =
-  encodeTransparent' (getTransparentPrefix zNet (ta_type t)) $
-  toBytes $ ta_bytes t
+encodeTransparentReceiver zNet t =
+  encodeTransparent' (getTransparentPrefix zNet (tr_type t)) $
+  toBytes $ tr_bytes t
   where
     encodeTransparent' :: (Word8, Word8) -> BS.ByteString -> T.Text
     encodeTransparent' (a, b) h =
       E.decodeUtf8 $ 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
 
@@ -78,7 +82,7 @@ genTransparentReceiver ::
      Int -- ^ The index of the address to be created
   -> Scope -- ^ `External` for wallet addresses or `Internal` for change addresses
   -> XPrvKey -- ^ The transparent private key
-  -> IO TransparentAddress
+  -> IO TransparentReceiver
 genTransparentReceiver i scope xprvk = do
   ioCtx <- createContext
   let s =
@@ -90,6 +94,38 @@ genTransparentReceiver i scope xprvk = do
   let childPubKey = deriveXPubKey ioCtx childPrvKey
   let x = xPubAddr ioCtx childPubKey
   case x of
-    PubKeyAddress k -> return $ TransparentAddress P2PKH $ fromBinary k
-    ScriptAddress j -> return $ TransparentAddress P2SH $ fromBinary j
+    PubKeyAddress k -> return $ TransparentReceiver P2PKH $ fromBinary k
+    ScriptAddress j -> return $ TransparentReceiver P2SH $ fromBinary j
     _anyOtherKind -> throwIO $ userError "Unsupported transparent address type"
+
+-- } decode a Transparent Address in HRF and return a TransparentAddress object
+decodeTransparentAddress :: BS.ByteString -> Maybe TransparentAddress
+decodeTransparentAddress taddress = do
+  if BS.length taddress <  34
+    then Nothing -- Not a valid transparent address
+    else do 
+      let maybeDecoded = decodeBase58  bitcoinAlphabet taddress
+      case maybeDecoded of 
+        Nothing -> Nothing 
+        Just decoded -> do 
+          let digest = BS.take 22 decoded
+          let chksum = BS.drop 22 decoded
+          let chksumd = BS.take 4 (sha256 $ sha256 digest)
+          if chksum /= chksum
+            then Nothing -- Invalid address ( invalid checksum )
+            else do 
+              -- build the TransparentAddress Object
+              let addressType = BS.take 2 digest
+              let transparentReceiver = BS.drop 2 digest
+              let fb = BS.index addressType 0
+              let sb = BS.index addressType 1  
+              case fb of
+                28 -> case sb of 
+                        189 -> Just $ TransparentAddress MainNet $ TransparentReceiver P2SH (fromRawBytes digest)
+                        186 -> Just $ TransparentAddress TestNet $ TransparentReceiver P2SH (fromRawBytes digest)  
+                        184 -> Just $ TransparentAddress MainNet $ TransparentReceiver P2PKH (fromRawBytes digest)
+                        _ -> Nothing
+                29 -> if sb  == 37
+                        then Just $ TransparentAddress TestNet $ TransparentReceiver P2PKH (fromRawBytes digest)
+                        else Nothing
+                _  -> Nothing            

src/ZcashHaskell/Types.hs

@@ -94,7 +94,7 @@ data ZcashNet
 
 type AccountId = Int
 
--- | Function to get the Base58 prefix for encoding a 'TransparentAddress'
+-- | Function to get the Base58 prefix for encoding a 'TransparentReceiver'
 getTransparentPrefix :: ZcashNet -> TransparentType -> (Word8, Word8)
 getTransparentPrefix n t =
   case t of
@@ -422,10 +422,16 @@ data TransparentType
 -- | Type for transparent spending key
 type TransparentSpendingKey = XPrvKey
 
+-- | Type to represent a transparent Zcash addresses
+data TransparentReceiver = TransparentReceiver
+  { tr_type :: !TransparentType
+  , tr_bytes :: !HexString
+  } deriving (Eq, Prelude.Show, Read)
+
 -- | Type to represent a transparent Zcash addresses
 data TransparentAddress = TransparentAddress
-  { ta_type :: !TransparentType
-  , ta_bytes :: !HexString
+  { ta_network :: !ZcashNet
+  , ta_receiver :: !TransparentReceiver
   } deriving (Eq, Prelude.Show, Read)
 
 -- | Wrapper types for transparent elements
@@ -541,7 +547,7 @@ data UnifiedAddress = UnifiedAddress
   { ua_net :: !ZcashNet
   , o_rec :: !(Maybe OrchardReceiver)
   , s_rec :: !(Maybe SaplingReceiver)
-  , t_rec :: !(Maybe TransparentAddress)
+  , t_rec :: !(Maybe TransparentReceiver)
   } deriving (Prelude.Show, Eq, Read)
 
 -- | Helper type for marshalling UAs 

test/Spec.hs

@@ -77,6 +77,7 @@ import ZcashHaskell.Types
   , Seed(..)
   , ShieldedOutput(..)
   , ToBytes(..)
+  , TransparentReceiver(..)
   , TransparentAddress(..)
   , TransparentBundle(..)
   , TransparentType(..)
@@ -513,7 +514,7 @@ main = do
               case isValidUnifiedAddress ua of
                 Nothing -> "Bad UA"
                 Just u ->
-                  maybe "No transparent" (encodeTransparent (ua_net u)) $
+                  maybe "No transparent" (encodeTransparentReceiver (ua_net u)) $
                   t_rec u
         msg `shouldBe` "t1LPWuQnjCRH7JAeEErSXKixcUteLJRJjKD"
       it "Recover UA from YWallet" $
@@ -807,7 +808,7 @@ main = do
                             BS.drop 3 $
                             (\(TxOut v s) -> s) (head (tb_vout myTb'))
                       pkHash `shouldBe`
-                        maybe "" (hexBytes . ta_bytes) (t_rec addr)
+                        maybe "" (hexBytes . tr_bytes) (t_rec addr)
               myTb `shouldNotBe` Nothing
         it "Sapling component is read" $ do
           case t of
@@ -856,7 +857,11 @@ main = do
         let sr = getSaplingFromUA "u14a5c4ufn9qfevxssnvscep29j5cse4gjpg0w3w5vjhafn74hg9k73xgnxqv6m255n23weggr6j97c8kdwvn4pkz7rz6my52z8248gjmr7knlw536tcurs5km7knqnzez4cywudt3q6shr553hurduvljfeqvfzgegenfjashslkz3y4ykhxel6mrjp9gsm9xk7k6kdxn9y84kccmv8l"
         it "Try to extract sapling address from invalid UA" $ do
           sr `shouldBe` Nothing 
-
+      describe "Decode a Transparent Address" $ do
+        let ta = decodeTransparentAddress "t1dMjvesbzdG41xgKaGU3HgwYJwSgbCK54e"
+        it "Try to decode a valid Transparent Address" $ do
+          print ta
+          ta `shouldNotBe` Nothing
 
 -- | Properties
 prop_PhraseLength :: Property
@@ -930,7 +935,7 @@ prop_TransparentReceiver s coinType scope (NonNegative i) (NonNegative j) =
   ioProperty $ do
     k <- genTransparentPrvKey s coinType i
     r <- genTransparentReceiver j scope k
-    return $ ta_type r == P2PKH
+    return $ tr_type r == P2PKH
 
 -- | Generators
 genOrcArgs :: Gen (CoinType, Int, Int)