122 lines
4 KiB
Haskell
122 lines
4 KiB
Haskell
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Zenith.Utils where
|
|
|
|
import Data.Aeson
|
|
import Data.Functor (void)
|
|
import Data.Maybe
|
|
import Data.Ord (clamp)
|
|
import Data.Scientific (Scientific(..), scientific)
|
|
import qualified Data.Text as T
|
|
import qualified Data.Text.Encoding as E
|
|
import System.Process (createProcess_, shell)
|
|
import Text.Regex.Posix
|
|
import ZcashHaskell.Orchard (encodeUnifiedAddress, isValidUnifiedAddress)
|
|
import ZcashHaskell.Sapling (decodeSaplingAddress, isValidShieldedAddress)
|
|
import ZcashHaskell.Transparent
|
|
( decodeExchangeAddress
|
|
, decodeTransparentAddress
|
|
)
|
|
import ZcashHaskell.Types
|
|
( SaplingAddress(..)
|
|
, TransparentAddress(..)
|
|
, UnifiedAddress(..)
|
|
, ZcashNet(..)
|
|
)
|
|
import Zenith.Types
|
|
( AddressGroup(..)
|
|
, UnifiedAddressDB(..)
|
|
, ZcashAddress(..)
|
|
, ZcashPool(..)
|
|
)
|
|
|
|
-- | Helper function to convert numbers into JSON
|
|
jsonNumber :: Int -> Value
|
|
jsonNumber i = Number $ scientific (fromIntegral i) 0
|
|
|
|
-- | Helper function to display small amounts of ZEC
|
|
displayZec :: Integer -> String
|
|
displayZec s
|
|
| abs s < 100 = show s ++ " zats"
|
|
| abs s < 100000 = show (fromIntegral s / 100) ++ " μZEC"
|
|
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mZEC"
|
|
| otherwise = show (fromIntegral s / 100000000) ++ " ZEC "
|
|
|
|
-- | Helper function to display small amounts of ZEC
|
|
displayTaz :: Integer -> String
|
|
displayTaz s
|
|
| abs s < 100 = show s ++ " tazs"
|
|
| abs s < 100000 = show (fromIntegral s / 100) ++ " μTAZ"
|
|
| abs s < 100000000 = show (fromIntegral s / 100000) ++ " mTAZ"
|
|
| otherwise = show (fromIntegral s / 100000000) ++ " TAZ"
|
|
|
|
displayAmount :: ZcashNet -> Integer -> T.Text
|
|
displayAmount n a =
|
|
if n == MainNet
|
|
then T.pack $ displayZec a
|
|
else T.pack $ displayTaz a
|
|
|
|
-- | Helper function to display abbreviated Unified Address
|
|
showAddress :: UnifiedAddressDB -> T.Text
|
|
showAddress u = T.take 20 t <> "..."
|
|
where
|
|
t = getUA u
|
|
|
|
-- | Helper function to extract addresses from AddressGroups
|
|
getAddresses :: AddressGroup -> [ZcashAddress]
|
|
getAddresses ag = agtransparent ag <> agsapling ag <> agunified ag
|
|
|
|
-- | Helper function to validate potential Zcash addresses
|
|
validateAddress :: T.Text -> Maybe ZcashPool
|
|
validateAddress txt --(tReg || sReg && isJust chk) || (uReg && isJust chk)
|
|
| tReg = Just Transparent
|
|
| sReg && chkS = Just Sapling
|
|
| uReg && chk = Just Orchard
|
|
| otherwise = Nothing
|
|
where
|
|
transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
|
|
shieldedRegex = "^zs[a-zA-Z0-9]{76}$" :: String
|
|
unifiedRegex = "^u[a-zA-Z0-9]" :: String
|
|
tReg = T.unpack txt =~ transparentRegex :: Bool
|
|
sReg = T.unpack txt =~ shieldedRegex :: Bool
|
|
uReg = T.unpack txt =~ unifiedRegex :: Bool
|
|
chk = isJust $ isValidUnifiedAddress $ E.encodeUtf8 txt
|
|
chkS = isValidShieldedAddress $ E.encodeUtf8 txt
|
|
|
|
-- | Copy an address to the clipboard
|
|
copyAddress :: ZcashAddress -> IO ()
|
|
copyAddress a =
|
|
void $
|
|
createProcess_ "toClipboard" $
|
|
shell $ "echo " ++ T.unpack (addy a) ++ " | xclip -r -selection clipboard"
|
|
|
|
-- | Bound a value to the 0..1 range, used for progress reporting on UIs
|
|
validBarValue :: Float -> Float
|
|
validBarValue = clamp (0, 1)
|
|
|
|
isRecipientValid :: T.Text -> Bool
|
|
isRecipientValid a =
|
|
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
|
Just _a1 -> True
|
|
Nothing ->
|
|
isValidShieldedAddress (E.encodeUtf8 a) ||
|
|
(case decodeTransparentAddress (E.encodeUtf8 a) of
|
|
Just _a3 -> True
|
|
Nothing ->
|
|
case decodeExchangeAddress a of
|
|
Just _a4 -> True
|
|
Nothing -> False)
|
|
|
|
parseAddress :: T.Text -> ZcashNet -> Maybe UnifiedAddress
|
|
parseAddress a znet =
|
|
case isValidUnifiedAddress (E.encodeUtf8 a) of
|
|
Just a1 -> Just a1
|
|
Nothing ->
|
|
case decodeSaplingAddress (E.encodeUtf8 a) of
|
|
Just a2 ->
|
|
Just $ UnifiedAddress znet Nothing (Just $ sa_receiver a2) Nothing
|
|
Nothing ->
|
|
case decodeTransparentAddress (E.encodeUtf8 a) of
|
|
Just a3 ->
|
|
Just $ UnifiedAddress znet Nothing Nothing (Just $ ta_receiver a3)
|
|
Nothing -> Nothing
|