diff --git a/CHANGELOG.md b/CHANGELOG.md index 16a9670..d45407c 100644 --- a/CHANGELOG.md +++ b/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 diff --git a/app/Main.hs b/app/Main.hs index ced5fdc..b2ce01e 100644 --- a/app/Main.hs +++ b/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 () diff --git a/package.yaml b/package.yaml index 1ff8b69..5ed1fcc 100644 --- a/package.yaml +++ b/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: diff --git a/src/Zenith.hs b/src/Zenith.hs index df0c5c7..b612db5 100644 --- a/src/Zenith.hs +++ b/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" diff --git a/stack.yaml b/stack.yaml index 1b94afe..ada522e 100644 --- a/stack.yaml +++ b/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: {} diff --git a/stack.yaml.lock b/stack.yaml.lock index 7a63f03..02f3c66 100644 --- a/stack.yaml.lock +++ b/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 diff --git a/zenith.cabal b/zenith.cabal index 8fe6b38..e5b9681 100644 --- a/zenith.cabal +++ b/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 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