rvv001 - Issue 085 - [Zenith GUI] Read a payment URI

New type to support URI data structure created (Types.hs)
	 Function to parse an URI string created (in Utils.hs)
	 Test case added to Benchmark Suite
This commit is contained in:
Rene V. Vergara 2024-12-30 21:00:57 -05:00
parent 56bf19a6f6
commit d476183a1d
5 changed files with 68 additions and 1 deletions

4
.gitignore vendored
View file

@ -5,3 +5,7 @@ zenith.db
zenith.log
zenith.db-shm
zenith.db-wal
test.db
test.db-shm
test.db-wal

View file

@ -508,3 +508,12 @@ encodeHexText' t =
if T.length t > 0
then C.unpack . B64.encode $ E.encodeUtf8 t
else C.unpack . B64.encode $ E.encodeUtf8 "Sent from Zenith"
-- | Define a data structure for the parsed components
data ZcashPaymentURI = ZcashPaymentURI
{ uriAddress :: String
, uriAmount :: Maybe Double
, uriMemo :: C.ByteString
, uriLabel :: Maybe String
, uriMessage :: Maybe String
} deriving (Show, Eq)

View file

@ -15,12 +15,16 @@ import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import Control.Exception (try, SomeException)
import Control.Monad (when)
import qualified Data.ByteString.Base64 as B64
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as B
import qualified Data.ByteString.Lazy.Char8 as BL
import System.Directory
import System.Process (createProcess_, shell)
import Text.Regex.Posix
import Text.Read (readMaybe)
import Text.Printf (printf)
import qualified Data.Text.Encoding as TE
import ZcashHaskell.Orchard
( encodeUnifiedAddress
, isValidUnifiedAddress
@ -46,6 +50,7 @@ import Zenith.Types
, UnifiedAddressDB(..)
, ZcashAddress(..)
, ZcashPool(..)
, ZcashPaymentURI (..)
)
import Network.HTTP.Simple
import Data.Scientific (Scientific, toRealFloat)
@ -276,4 +281,44 @@ getZcashPrice currency = do
_ -> return Nothing
_ -> return Nothing
_ -> return Nothing
-- Parse memo result to convert it to a ByteString
processEither :: Either String BC.ByteString -> BC.ByteString
processEither (Right bs) = bs
processEither (Left e) = BC.pack e -- Returns the error
-- Parse the query string into key-value pairs
parseQuery :: String -> [(String, String)]
parseQuery query = map (breakOn '=') (splitOn '&' query)
where
splitOn :: Char -> String -> [String]
splitOn _ [] = [""]
splitOn delim (c:cs)
| c == delim = "" : rest
| otherwise = (c : head rest) : tail rest
where
rest = splitOn delim cs
breakOn :: Char -> String -> (String, String)
breakOn delim str = (key, drop 1 value)
where (key, value) = span (/= delim) str
-- Parse a ZIP-321 encoded string into a ZcashPayment structure
parseZcashPayment :: String -> Either String ZcashPaymentURI
parseZcashPayment input
| not (T.isPrefixOf "zcash:" (T.pack input)) = Left "Invalid scheme: must start with 'zcash:'"
| otherwise =
let (addrPart, queryPart) = break (== '?') (drop 6 input)
queryParams = parseQuery (drop 1 queryPart)
in Right ZcashPaymentURI
{ uriAddress = addrPart
, uriAmount = lookup "amount" queryParams >>= readMaybe
, uriMemo = case lookup "memo" queryParams of
Just m -> processEither $ B64.decode $ BC.pack m
_ -> ""
, uriLabel = lookup "label" queryParams
, uriMessage = lookup "message" queryParams
}

View file

@ -58,7 +58,8 @@ main = do
zebraPort <- require config "zebraPort"
zebraHost <- require config "zebraHost"
nodePort <- require config "nodePort"
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort
currencyCode <- require config "currencyCode"
let myConfig = Config dbFilePath zebraHost zebraPort nodeUser nodePwd nodePort currencyCode
hspec $ do
describe "RPC methods" $ do
beforeAll_ (startAPI myConfig) $ do

View file

@ -1111,3 +1111,11 @@ main = do
case price of
Just p -> p `shouldNotBe` 0.0
Nothing -> assertFailure "Failed to get ZEC price"
describe "Parse an URI payment string" $ do
it ("Parsing URI -> " ++ "zcash:ztestsapling10yy2ex5....") $ do
let zcashURI2 = "zcash:ztestsapling10yy2ex5dcqkclhc7z7yrnjq2z6feyjad56ptwlfgmy77dmaqqrl9gyhprdx59qgmsnyfska2kez?amount=100&memo=SGVsbG8sIFdvcmxkIQ==&message=Test"
case parseZcashPayment zcashURI2 of
Right p -> do
print p
(uriAmount p) `shouldBe` Just 100.0
Left e -> assertFailure $ "Error: " ++ e