Improve handling of Unicode memos

CHANGELOG.md

@@ -7,6 +7,16 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 ## [Unreleased]
 
+## [0.3.1.0]
+
+### Added
+
+- Added option to include Reply-To address when using URIs to generate transaction
+
+### Changed
+
+- Improved `encodeHexText` to handle Unicode characters correctly.
+
 ## [0.3.0.0]
 
 ### Changed

app/Main.hs

@@ -113,10 +113,9 @@ sendZec user pwd =
                     (T.pack t)
                     amt
                     (if repTo
-                       then m ++
-                            "\nReply-To:\n" ++
-                            T.unpack (addy (addList !! (idx - 1)))
-                       else m)
+                       then T.pack m <>
+                            "\nReply-To:\n" <> addy (addList !! (idx - 1))
+                       else T.pack m)
               Nothing -> liftIO . putStrLn $ "  Invalid amount"
           else liftIO . putStrLn $ "  Invalid address, cancelling."
         return NoAction
@@ -175,7 +174,12 @@ processUri user pwd =
       else do
         liftIO . putStrLn $ "  Sending from " ++ show (addList !! (idx - 1))
         u <- liftIO . prompt $ " > Enter URI: "
-        _ <- liftIO $ sendWithUri user pwd (addList !! (idx - 1)) u
+        rt <- liftIO . prompt $ " > Include reply-to? (Y/N): "
+        let repTo =
+              case T.toLower (T.pack rt) of
+                "y" -> True
+                _ -> False
+        _ <- liftIO $ sendWithUri user pwd (addList !! (idx - 1)) u repTo
         return NoAction
 
 main :: IO ()

package.yaml

@@ -1,5 +1,5 @@
 name:                zenith
-version:             0.2.0.0
+version:             0.3.1.0
 github:              "pitmutt/zenit"
 license:             MIT
 author:              "Rene Vergara"
@@ -40,6 +40,7 @@ library:
   - http-types
   - array
   - base64-bytestring
+  - hexstring
 
 executables:
   zenith:

src/Zenith.hs

@@ -16,11 +16,13 @@ import qualified Data.ByteString.Char8 as C
 import qualified Data.ByteString.Lazy as LB
 import Data.Char
 import Data.Functor (void)
+import Data.HexString
 import Data.Maybe
 import qualified Data.Scientific as Scientific
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as E
 import Data.Text.Encoding.Error (lenientDecode)
+import qualified Data.Text.IO as TIO
 import qualified Data.Vector as V
 import Data.Word
 import GHC.Generics
@@ -310,6 +312,9 @@ encodeHexText t = mconcat (map padHex t)
         then "0" ++ (showHex . ord) x ""
         else showHex (ord x) ""
 
+encodeHexText' :: T.Text -> String
+encodeHexText' t = T.unpack . toText . fromBytes $ E.encodeUtf8 t
+
 -- | Helper function to extract addresses from AddressGroups
 getAddresses :: AddressGroup -> [ZcashAddress]
 getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
@@ -392,7 +397,7 @@ sendTx ::
   -> ZcashAddress
   -> T.Text
   -> Double
-  -> String
+  -> T.Text
   -> IO ()
 sendTx user pwd fromAddy toAddy amount memo = do
   bal <- getBalance user pwd fromAddy
@@ -412,7 +417,7 @@ sendTx user pwd fromAddy toAddy amount memo = do
                        [ object
                            [ "address" .= toAddy
                            , "amount" .= amount
-                           , "memo" .= encodeHexText memo
+                           , "memo" .= encodeHexText' memo
                            ]
                        ])
                 , Data.Aeson.Number $ Scientific.scientific 1 1
@@ -450,7 +455,7 @@ makeZcashCall username password m p = do
     500 -> do
       let rpcResp = decode body :: Maybe (RpcResponse String)
       case rpcResp of
-        Nothing -> fail "Unknown server error"
+        Nothing -> fail $ "Unknown server error " ++ show response
         Just x -> fail (result x)
     401 -> fail "Incorrect full node credentials"
     200 -> return body
@@ -567,8 +572,9 @@ checkServer user pwd = do
       where isNodeValid (NodeVersion i) = i >= 5000000
 
 -- | Read ZIP-321 URI
-sendWithUri :: B.ByteString -> B.ByteString -> ZcashAddress -> String -> IO ()
-sendWithUri user pwd fromAddy uri = do
+sendWithUri ::
+     B.ByteString -> B.ByteString -> ZcashAddress -> String -> Bool -> IO ()
+sendWithUri user pwd fromAddy uri repTo = do
   let uriRegex = mkRegex "^zcash:(\\w+)\\?amount=(.*)\\&memo=(.*)$"
   if matchTest uriRegex uri
     then do
@@ -583,14 +589,18 @@ sendWithUri user pwd fromAddy uri = do
             Nothing -> putStrLn "   Invalid amount."
             Just amt -> do
               putStrLn $ "   Valid ZEC amount: " ++ show amt
-              let decodedMemo = B64.decodeLenient $ C.pack parsedEncodedMemo
-              putStrLn $ "   Memo: " ++ C.unpack decodedMemo
+              let decodedMemo =
+                    E.decodeUtf8With lenientDecode $
+                    B64.decodeLenient $ C.pack parsedEncodedMemo
+              TIO.putStrLn $ "   Memo: " <> decodedMemo
               sendTx
                 user
                 pwd
                 fromAddy
                 (T.pack parsedAddress)
                 amt
-                (C.unpack decodedMemo)
+                (if repTo
+                   then T.concat [decodedMemo, "\nReply-To:\n", addy fromAddy]
+                   else decodedMemo)
         else putStrLn "   Invalid address"
     else putStrLn "URI is not compliant with ZIP-321"

stack.yaml

@@ -42,6 +42,9 @@ packages:
 #   commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a
 #
 # extra-deps: []
+extra-deps:
+  - git: https://github.com/reach-sh/haskell-hexstring.git
+    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
 #
 # Override default flag values for local packages and extra-deps
 # flags: {}

stack.yaml.lock

@@ -3,7 +3,18 @@
 # For more information, please see the documentation at:
 #   https://docs.haskellstack.org/en/stable/lock_files
 
-packages: []
+packages:
+- completed:
+    name: hexstring
+    version: 0.11.1
+    git: https://github.com/reach-sh/haskell-hexstring.git
+    pantry-tree:
+      size: 687
+      sha256: 9ecf67856f59dfb382b283eceb42e4fc1865935d1a7e59111556ed381c6a2ffd
+    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
+  original:
+    git: https://github.com/reach-sh/haskell-hexstring.git
+    commit: 085c16fb21b9f856a435a3faab980e7e0b319341
 snapshots:
 - completed:
     size: 618507

zenith.cabal

@@ -5,7 +5,7 @@ cabal-version: 1.12
 -- see: https://github.com/sol/hpack
 
 name:           zenith
-version:        0.2.0.0
+version:        0.3.0.0
 description:    Please see the README on GitLab at <https://gitlab.com/pitmutt/zenit#readme>
 homepage:       https://github.com/pitmutt/zenit#readme
 bug-reports:    https://github.com/pitmutt/zenit/issues
@@ -38,6 +38,7 @@ library
     , base64-bytestring
     , bytestring
     , haskoin-core
+    , hexstring
     , http-conduit
     , http-types
     , process