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

.gitignore

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

src/Zenith/Types.hs

@@ -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)

src/Zenith/Utils.hs

@@ -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)
@@ -277,3 +282,43 @@ getZcashPrice currency = do
           _ -> 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
+            }
+
+
+ 

test/ServerSpec.hs

@@ -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

test/Spec.hs

@@ -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