CHANGELOG.md

@@ -25,6 +25,7 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0
 
 - Detection of changes in database schema for automatic re-scan
 - Block tracking for chain re-org detection
+- Refactored `ZcashPool`
 
 ## [0.6.0.0-beta]
 

src/Zenith/DB.hs

@@ -347,7 +347,7 @@ trToZcashNoteAPI pool n = do
       return $
         ZcashNoteAPI
           (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
-          Zenith.Types.Transparent -- pool
+          Zenith.Types.TransparentPool -- pool
           (fromIntegral (walletTrNoteValue (entityVal n)) / 100000000.0) -- zec
           (walletTrNoteValue $ entityVal n) -- zats
           "" -- memo
@@ -368,7 +368,7 @@ sapToZcashNoteAPI pool n = do
       return $
         ZcashNoteAPI
           (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
-          Zenith.Types.Sapling -- pool
+          Zenith.Types.SaplingPool -- pool
           (fromIntegral (walletSapNoteValue (entityVal n)) / 100000000.0) -- zec
           (walletSapNoteValue $ entityVal n) -- zats
           (walletSapNoteMemo $ entityVal n) -- memo
@@ -389,7 +389,7 @@ orchToZcashNoteAPI pool n = do
       return $
         ZcashNoteAPI
           (getHex $ walletTransactionTxId $ entityVal t') -- tx ID
-          Orchard
+          OrchardPool
           (fromIntegral (walletOrchNoteValue (entityVal n)) / 100000000.0) -- zec
           (walletOrchNoteValue $ entityVal n) -- zats
           (walletOrchNoteMemo $ entityVal n) -- memo

src/Zenith/GUI.hs

@@ -413,43 +413,43 @@ buildUI wenv model = widgetTree
                [ vstack
                    [ tooltip "Unified" $
                      box_
-                       [onClick (SetPool Orchard)]
+                       [onClick (SetPool OrchardPool)]
                        (remixIcon remixShieldCheckFill `styleBasic`
                         [ textSize 14
                         , padding 4
                         , styleIf
-                            (model ^. selPool == Orchard)
+                            (model ^. selPool == OrchardPool)
                             (bgColor btnColor)
                         , styleIf
-                            (model ^. selPool == Orchard)
+                            (model ^. selPool == OrchardPool)
                             (textColor white)
                         ])
                    , filler
                    , tooltip "Legacy Shielded" $
                      box_
-                       [onClick (SetPool Sapling)]
+                       [onClick (SetPool SaplingPool)]
                        (remixIcon remixShieldLine `styleBasic`
                         [ textSize 14
                         , padding 4
                         , styleIf
-                            (model ^. selPool == Sapling)
+                            (model ^. selPool == SaplingPool)
                             (bgColor btnColor)
                         , styleIf
-                            (model ^. selPool == Sapling)
+                            (model ^. selPool == SaplingPool)
                             (textColor white)
                         ])
                    , filler
                    , tooltip "Transparent" $
                      box_
-                       [onClick (SetPool Transparent)]
+                       [onClick (SetPool TransparentPool)]
                        (remixIcon remixEyeLine `styleBasic`
                         [ textSize 14
                         , padding 4
                         , styleIf
-                            (model ^. selPool == Transparent)
+                            (model ^. selPool == TransparentPool)
                             (bgColor btnColor)
                         , styleIf
-                            (model ^. selPool == Transparent)
+                            (model ^. selPool == TransparentPool)
                             (textColor white)
                         ])
                    ] `styleBasic`
@@ -462,10 +462,10 @@ buildUI wenv model = widgetTree
                        (hstack
                           [ label
                               (case model ^. selPool of
-                                 Orchard -> "Unified"
-                                 Sapling -> "Legacy Shielded"
-                                 Transparent -> "Transparent"
-                                 Sprout -> "Unknown") `styleBasic`
+                                 OrchardPool -> "Unified"
+                                 SaplingPool -> "Legacy Shielded"
+                                 TransparentPool -> "Transparent"
+                                 SproutPool -> "Unknown") `styleBasic`
                             [textColor white]
                           , remixIcon remixFileCopyFill `styleBasic`
                             [textSize 14, padding 4, textColor white]
@@ -944,9 +944,9 @@ generateQRCodes config = do
       if not (null s)
         then return ()
         else do
-          generateOneQr pool Orchard wAddr
-          generateOneQr pool Sapling wAddr
-          generateOneQr pool Transparent wAddr
+          generateOneQr pool OrchardPool wAddr
+          generateOneQr pool SaplingPool wAddr
+          generateOneQr pool TransparentPool wAddr
     generateOneQr ::
          ConnectionPool -> ZcashPool -> Entity WalletAddress -> IO ()
     generateOneQr p zp wAddr =
@@ -981,7 +981,7 @@ generateQRCodes config = do
     dispAddr :: ZcashPool -> WalletAddress -> Maybe T.Text
     dispAddr zp w =
       case zp of
-        Transparent ->
+        TransparentPool ->
           T.append "zcash:" .
           encodeTransparentReceiver
             (maybe
@@ -993,11 +993,12 @@ generateQRCodes config = do
           (t_rec =<<
            (isValidUnifiedAddress . E.encodeUtf8 . getUA . walletAddressUAddress)
              w)
-        Sapling ->
+        SaplingPool ->
           T.append "zcash:" <$>
           (getSaplingFromUA . E.encodeUtf8 . getUA . walletAddressUAddress) w
-        Orchard -> Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
-        Sprout -> Nothing
+        OrchardPool ->
+          Just $ (T.append "zcash:" . getUA . walletAddressUAddress) w
+        SproutPool -> Nothing
 
 handleEvent ::
      WidgetEnv AppModel AppEvent
@@ -1111,7 +1112,7 @@ handleEvent wenv node model evt =
             Just wAddr -> getUserTx dbPool $ entityKey wAddr
       ]
     SwitchQr q -> [Model $ model & qrCodeWidget .~ q]
-    SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool Orchard]
+    SwitchAddr i -> [Model $ model & selAddr .~ i, Event $ SetPool OrchardPool]
     SwitchAcc i ->
       [ Model $ model & selAcc .~ i
       , Task $
@@ -1129,7 +1130,7 @@ handleEvent wenv node model evt =
               b <- getBalance dbPool $ entityKey acc
               u <- getUnconfirmedBalance dbPool $ entityKey acc
               return (b, u)
-      , Event $ SetPool Orchard
+      , Event $ SetPool OrchardPool
       ]
     SwitchWal i ->
       [ Model $ model & selWallet .~ i & selAcc .~ 0 & selAddr .~ 0
@@ -1152,14 +1153,15 @@ handleEvent wenv node model evt =
       , setClipboardData $
         ClipboardText $
         case model ^. selPool of
-          Orchard -> maybe "None" (getUA . walletAddressUAddress . entityVal) a
-          Sapling ->
+          OrchardPool ->
+            maybe "None" (getUA . walletAddressUAddress . entityVal) a
+          SaplingPool ->
             fromMaybe "None" $
             (getSaplingFromUA .
              E.encodeUtf8 . getUA . walletAddressUAddress . entityVal) =<<
             a
-          Sprout -> "None"
-          Transparent ->
+          SproutPool -> "None"
+          TransparentPool ->
             maybe "None" (encodeTransparentReceiver (model ^. network)) $
             t_rec =<<
             (isValidUnifiedAddress .
@@ -1182,7 +1184,7 @@ handleEvent wenv node model evt =
       if not (null a)
         then [ Model $ model & addresses .~ a
              , Event $ SwitchAddr $ model ^. selAddr
-             , Event $ SetPool Orchard
+             , Event $ SetPool OrchardPool
              ]
         else [Event $ NewAddress currentAccount]
     LoadAccs a ->
@@ -1584,7 +1586,8 @@ runZenithGUI config = do
                       else return []
                   qr <-
                     if not (null addrList)
-                      then getQrCode pool Orchard $ entityKey $ head addrList
+                      then getQrCode pool OrchardPool $
+                           entityKey $ head addrList
                       else return Nothing
                   bal <-
                     if not (null accList)
@@ -1613,7 +1616,7 @@ runZenithGUI config = do
                           (if unconfBal == 0
                              then Nothing
                              else Just unconfBal)
-                          Orchard
+                          OrchardPool
                           qr
                           False
                           False

src/Zenith/Types.hs

@@ -104,10 +104,10 @@ data Config = Config
   } deriving (Eq, Prelude.Show)
 
 data ZcashPool
-  = Transparent
-  | Sprout
-  | Sapling
-  | Orchard
+  = TransparentPool
+  | SproutPool
+  | SaplingPool
+  | OrchardPool
   deriving (Show, Read, Eq)
 
 derivePersistField "ZcashPool"
@@ -115,18 +115,18 @@ derivePersistField "ZcashPool"
 instance ToJSON ZcashPool where
   toJSON zp =
     case zp of
-      Transparent -> Data.Aeson.String "p2pkh"
-      Sprout -> Data.Aeson.String "sprout"
-      Sapling -> Data.Aeson.String "sapling"
-      Orchard -> Data.Aeson.String "orchard"
+      TransparentPool -> Data.Aeson.String "p2pkh"
+      SproutPool -> Data.Aeson.String "sprout"
+      SaplingPool -> Data.Aeson.String "sapling"
+      OrchardPool -> Data.Aeson.String "orchard"
 
 instance FromJSON ZcashPool where
   parseJSON =
     withText "ZcashPool" $ \case
-      "p2pkh" -> return Transparent
-      "sprout" -> return Sprout
-      "sapling" -> return Sapling
-      "orchard" -> return Orchard
+      "p2pkh" -> return TransparentPool
+      "sprout" -> return SproutPool
+      "sapling" -> return SaplingPool
+      "orchard" -> return OrchardPool
       _ -> fail "Not a known Zcash pool"
 
 newtype ZenithUuid = ZenithUuid
@@ -298,7 +298,8 @@ instance FromJSON AddressGroup where
           Nothing -> return []
           Just x -> do
             x' <- x .:? "addresses"
-            return $ maybe [] (map (ZcashAddress s1 [Transparent] Nothing)) x'
+            return $
+              maybe [] (map (ZcashAddress s1 [TransparentPool] Nothing)) x'
       processSapling k s2 =
         case k of
           Nothing -> return []
@@ -306,7 +307,7 @@ instance FromJSON AddressGroup where
             where processOneSapling sx =
                     withObject "Sapling" $ \oS -> do
                       oS' <- oS .: "addresses"
-                      return $ map (ZcashAddress sx [Sapling] Nothing) oS'
+                      return $ map (ZcashAddress sx [SaplingPool] Nothing) oS'
       processUnified u =
         case u of
           Nothing -> return []

src/Zenith/Utils.hs

@@ -3,13 +3,13 @@
 module Zenith.Utils where
 
 import Data.Aeson
+import Data.Char (isAlphaNum, isSpace)
 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 Data.Char (isAlphaNum, isSpace)
 import System.Directory
 import System.Process (createProcess_, shell)
 import Text.Regex.Posix
@@ -71,9 +71,9 @@ 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
+  | tReg = Just TransparentPool
+  | sReg && chkS = Just SaplingPool
+  | uReg && chk = Just OrchardPool
   | otherwise = Nothing
   where
     transparentRegex = "^t1[a-zA-Z0-9]{33}$" :: String
@@ -137,16 +137,16 @@ parseAddress a znet =
             Nothing -> Nothing
 
 isValidContent :: String -> Bool
-isValidContent [] = False         --  an empty string is invalid   
+isValidContent [] = False --  an empty string is invalid   
 isValidContent (x:xs)
-  | not (isAlphaNum x ) = False   --  string must start with an alphanumeric character
-  | otherwise = allValidChars xs  --  process the rest of the string 
+  | not (isAlphaNum x) = False --  string must start with an alphanumeric character
+  | otherwise = allValidChars xs --  process the rest of the string 
   where
     allValidChars :: String -> Bool
-    allValidChars [] = True  -- if we got here, string is valid
+    allValidChars [] = True -- if we got here, string is valid
     allValidChars (y:ys)
       | isAlphaNum y || isSpace y = allValidChars ys -- char is valid, continue
-      | otherwise = False  -- found an invalid character, return false  
+      | otherwise = False -- found an invalid character, return false  
 
 isValidString :: T.Text -> Bool
 isValidString c = do
@@ -155,10 +155,9 @@ isValidString c = do
 
 padWithZero :: Int -> String -> String
 padWithZero n s
-  | (length s) >= n  = s 
-  | otherwise  = padWithZero n ("0" ++ s)
+  | (length s) >= n = s
+  | otherwise = padWithZero n ("0" ++ s)
 
 isEmpty :: [a] -> Bool
 isEmpty [] = True
-isEmpty _  = False
-  
+isEmpty _ = False

src/Zenith/Zcashd.hs

@@ -123,9 +123,10 @@ sendTx user pwd fromAddy toAddy amount memo = do
       if source fromAddy /= ImportedWatchOnly
         then do
           let privacyPolicy
-                | valAdd == Just Transparent = "AllowRevealedRecipients"
+                | valAdd == Just TransparentPool = "AllowRevealedRecipients"
                 | isNothing (account fromAddy) &&
-                    elem Transparent (pool fromAddy) = "AllowRevealedSenders"
+                    elem TransparentPool (pool fromAddy) =
+                  "AllowRevealedSenders"
                 | otherwise = "AllowRevealedAmounts"
           let pd =
                 case memo of
@@ -301,7 +302,7 @@ sendWithUri user pwd fromAddy uri repTo = do
       let addType = validateAddress $ T.pack parsedAddress
       case addType of
         Nothing -> putStrLn "   Invalid address"
-        Just Transparent -> do
+        Just TransparentPool -> do
           putStrLn $ "   Address is valid: " ++ parsedAddress
           case (readMaybe parsedAmount :: Maybe Double) of
             Nothing -> putStrLn "   Invalid amount."