diff --git a/CHANGELOG.md b/CHANGELOG.md index aa0b028..a4a73d3 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -5,8 +5,19 @@ All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0.html). +## [0.5.3.1-beta] + +### Added + +- Docker image + ## [0.5.3.0-beta] +### Added + +- Address Book functionality. Allows users to store frequently used zcash addresses and + generate transactions using them. + ### Changed - Improved formatting of sync progress @@ -17,11 +28,6 @@ and this project adheres to [Semantic Versioning](https://semver.org/spec/v2.0.0 ## [0.5.2.0-beta] -### Added - -- Address Book functionality. Allows users to store frequently used zcash addresses and - generate transactions using them. - ### Changed - Update to `zcash-haskell-0.6.2.0` to increase performance of transaction creation diff --git a/src/Zenith/CLI.hs b/src/Zenith/CLI.hs index f107dfd..830a1d7 100644 --- a/src/Zenith/CLI.hs +++ b/src/Zenith/CLI.hs @@ -3,7 +3,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} - module Zenith.CLI where import qualified Brick.AttrMap as A @@ -11,8 +10,10 @@ import qualified Brick.BChan as BC import qualified Brick.Focus as F import Brick.Forms ( Form(..) + , FormFieldState , (@@=) , allFieldsValid + , editShowableField , editShowableFieldWithValidate , editTextField , focusedFormInputAttr @@ -22,8 +23,6 @@ import Brick.Forms , renderForm , setFieldValid , updateFormState - , FormFieldState - , editShowableField ) import qualified Brick.Main as M import qualified Brick.Types as BT @@ -43,8 +42,8 @@ import Brick.Widgets.Core , joinBorders , padAll , padBottom - , padTop , padLeft + , padTop , setAvailableSize , str , strWrap @@ -54,8 +53,8 @@ import Brick.Widgets.Core , txtWrapWith , updateAttrMap , vBox - , viewport , vLimit + , viewport , withAttr , withBorderStyle ) @@ -197,7 +196,7 @@ data State = State , _txForm :: !(Form SendInput () Name) , _abAddresses :: !(L.List Name (Entity AddressBook)) , _abForm :: !(Form AdrBookEntry () Name) - , _abCurAdrs :: !T.Text -- used for address book CRUD operations + , _abCurAdrs :: !T.Text -- used for address book CRUD operations , _sentTx :: !(Maybe HexString) } @@ -216,10 +215,11 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] show (st ^. network) <> " - " <> (T.unpack - (maybe - "(None)" - (\(_, w) -> zcashWalletName $ entityVal w) - (L.listSelectedElement (st ^. wallets)))) ++ " ")) + (maybe + "(None)" + (\(_, w) -> zcashWalletName $ entityVal w) + (L.listSelectedElement (st ^. wallets)))) ++ + " ")) (C.hCenter (str ("Account: " ++ @@ -236,7 +236,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] else displayTaz (st ^. balance))) <=> listAddressBox " Addresses " (st ^. addresses) <+> B.vBorder <+> - (C.hCenter (str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=> + (C.hCenter + (str ("Last block seen: " ++ show (st ^. syncBlock) ++ "\n")) <=> listTxBox " Transactions " (st ^. network) (st ^. transactions))) <=> C.hCenter (hBox @@ -313,7 +314,8 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] vBox ([str "Actions", B.hBorder] <> actionList)) else emptyWidget where - keyList = map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "q"] + keyList = + map (C.hCenter . str) ["?", "Esc", "w", "a", "v", "s", "b", "q"] actionList = map (hLimit 40 . str) @@ -374,50 +376,55 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] -- Address Book List AdrBook -> D.renderDialog - (D.dialog (Just $ str " Address Book ") Nothing 60) - (withAttr abDefAttr $ - setAvailableSize (50,20) $ - viewport ABViewport BT.Vertical $ - vLimit 20 $ - hLimit 50 $ - vBox [vLimit 16 $ - hLimit 50 $ - vBox $ [ L.renderList listDrawAB True (s ^. abAddresses) ], - padTop Max $ - vLimit 4 $ - hLimit 50 $ - withAttr abMBarAttr $ - vBox $ [C.hCenter $ - (capCommand "N" "ew Address" <+> - capCommand "E" "dit Address" <+> - capCommand3 "" "C" "opy Address"), - C.hCenter $ - (capCommand "D" "elete Address" <+> - capCommand "S" "end Zcash" <+> - capCommand3 "E" "x" "it")]]) + (D.dialog (Just $ str " Address Book ") Nothing 60) + (withAttr abDefAttr $ + setAvailableSize (50, 20) $ + viewport ABViewport BT.Vertical $ + vLimit 20 $ + hLimit 50 $ + vBox + [ vLimit 16 $ + hLimit 50 $ + vBox $ [L.renderList listDrawAB True (s ^. abAddresses)] + , padTop Max $ + vLimit 4 $ + hLimit 50 $ + withAttr abMBarAttr $ + vBox $ + [ C.hCenter $ + (capCommand "N" "ew Address" <+> + capCommand "E" "dit Address" <+> + capCommand3 "" "C" "opy Address") + , C.hCenter $ + (capCommand "D" "elete Address" <+> + capCommand "S" "end Zcash" <+> capCommand3 "E" "x" "it") + ] + ]) -- Address Book new entry form AdrBookForm -> D.renderDialog (D.dialog (Just $ str " New Address Book Entry ") Nothing 50) (renderForm (st ^. abForm) <=> C.hCenter - (hBox [capCommand "↲" " Save", capCommand3 "" "" " Cancel"])) + (hBox [capCommand "↲" " Save", capCommand3 "" "" " Cancel"])) -- Address Book edit/update entry form AdrBookUpdForm -> D.renderDialog (D.dialog (Just $ str " Edit Address Book Entry ") Nothing 50) (renderForm (st ^. abForm) <=> C.hCenter - (hBox [capCommand "↲" " Save", capCommand3 "" "" " Cancel"])) + (hBox [capCommand "↲" " Save", capCommand3 "" "" " Cancel"])) -- Address Book edit/update entry form AdrBookDelForm -> D.renderDialog (D.dialog (Just $ str " Delete Address Book Entry ") Nothing 50) (renderForm (st ^. abForm) <=> C.hCenter - (hBox [capCommand "C" "onfirm delete", capCommand3 "" "" " Cancel"])) + (hBox + [ capCommand "C" "onfirm delete" + , capCommand3 "" "" " Cancel" + ])) -- - splashDialog :: State -> Widget Name splashDialog st = if st ^. splashBox @@ -429,16 +436,14 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (str " _____ _ _ _ \n|__ /___ _ __ (_) |_| |__\n / // _ \\ '_ \\| | __| '_ \\\n / /| __/ | | | | |_| | | |\n/____\\___|_| |_|_|\\__|_| |_|") <=> C.hCenter - (withAttr titleAttr (str "Zcash Wallet v0.5.3.0-beta")) <=> + (withAttr titleAttr (str "Zcash Wallet v0.5.3.1-beta")) <=> C.hCenter (withAttr blinkAttr $ str "Press any key...")) else emptyWidget - capCommand3 :: String -> String -> String -> Widget Name capCommand3 l h e = hBox [str l, withAttr titleAttr (str h), str e] - capCommand2 :: String -> String -> String -> Widget Name - capCommand2 l h e = hBox [str l, withAttr titleAttr (str h), str e, str " | "] - + capCommand2 l h e = + hBox [str l, withAttr titleAttr (str h), str e, str " | "] capCommand :: String -> String -> Widget Name capCommand k comm = hBox [withAttr titleAttr (str k), str comm, str " | "] xCommand :: Widget Name @@ -562,20 +567,21 @@ drawUI s = [splashDialog s, helpDialog s, displayDialog s, inputDialog s, ui s] (strWrapWith (WrapSettings False True NoFill FillAfterFirst) (st ^. msg))) - AdrBookEntryDisplay -> do - case L.listSelectedElement $ st ^. abAddresses of + AdrBookEntryDisplay -> do + case L.listSelectedElement $ st ^. abAddresses of Just (_, a) -> do - let abentry = T.pack $ - " Descr: " ++ - T.unpack (addressBookAbdescrip (entityVal a)) ++ - "\n Address: " ++ - T.unpack (addressBookAbaddress (entityVal a)) + let abentry = + T.pack $ + " Descr: " ++ + T.unpack (addressBookAbdescrip (entityVal a)) ++ + "\n Address: " ++ + T.unpack (addressBookAbaddress (entityVal a)) withBorderStyle unicodeBold $ D.renderDialog - (D.dialog (Just $ txt " Address Book Entry ") Nothing 60) - (padAll 1 $ - txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ - abentry) + (D.dialog (Just $ txt " Address Book Entry ") Nothing 60) + (padAll 1 $ + txtWrapWith (WrapSettings False True NoFill FillAfterFirst) $ + abentry) _ -> emptyWidget BlankDisplay -> emptyWidget @@ -602,7 +608,7 @@ mkSendForm bal = padBottom (Pad 1) $ vLimit 1 (hLimit 15 $ str s <+> fill ' ') <+> w mkNewABForm :: AdrBookEntry -> Form AdrBookEntry e Name -mkNewABForm = +mkNewABForm = newForm [ label "Descrip: " @@= editTextField descrip DescripField (Just 1) , label "Address: " @@= editTextField address AddressField (Just 1) @@ -684,9 +690,9 @@ listDrawAB :: Bool -> Entity AddressBook -> Widget Name listDrawAB sel ab = let selStr s = if sel - then withAttr abSelAttr (txt $ " " <> s ) + then withAttr abSelAttr (txt $ " " <> s) else txt $ " " <> s - in selStr $ addressBookAbdescrip (entityVal ab) + in selStr $ addressBookAbdescrip (entityVal ab) customAttr :: A.AttrName customAttr = L.listSelectedAttr <> A.attrName "custom" @@ -726,7 +732,8 @@ scanZebra dbP zHost zPort b eChan = do dbBlock <- runNoLoggingT $ getMaxBlock pool let sb = max dbBlock b if sb > zgb_blocks bStatus || sb < 1 - then liftIO $ BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" + then liftIO $ + BC.writeBChan eChan $ TickMsg "Invalid starting block for scan" else do let bList = [(sb + 1) .. (zgb_blocks bStatus)] if not (null bList) @@ -931,7 +938,7 @@ appEvent (BT.VtyEvent e) = do _ev -> return () SendDisplay -> BT.modify $ set displayBox BlankDisplay SyncDisplay -> BT.modify $ set displayBox BlankDisplay - AdrBookEntryDisplay -> BT.modify $ set displayBox BlankDisplay + AdrBookEntryDisplay -> BT.modify $ set displayBox BlankDisplay BlankDisplay -> do case s ^. dialogBox of WName -> do @@ -1072,19 +1079,21 @@ appEvent (BT.VtyEvent e) = do BT.modify $ set msg "Invalid inputs" BT.modify $ set displayBox MsgDisplay BT.modify $ set dialogBox Blank - ev -> BT.zoom txForm $ do - handleFormEvent (BT.VtyEvent ev) - fs <- BT.gets formState - BT.modify $ - setFieldValid - (isRecipientValid (fs ^. sendTo)) - RecField + ev -> + BT.zoom txForm $ do + handleFormEvent (BT.VtyEvent ev) + fs <- BT.gets formState + BT.modify $ + setFieldValid + (isRecipientValid (fs ^. sendTo)) + RecField AdrBook -> do case e of V.EvKey (V.KChar 'x') [] -> BT.modify $ set dialogBox Blank - V.EvKey (V.KChar 'c') [] -> do + V.EvKey (V.KChar 'c') [] -- Copy Address to Clipboard + -> do case L.listSelectedElement $ s ^. abAddresses of Just (_, a) -> do liftIO $ @@ -1092,53 +1101,72 @@ appEvent (BT.VtyEvent e) = do T.unpack $ addressBookAbaddress (entityVal a) BT.modify $ set msg $ - "Address copied to Clipboard from >>\n" ++ - T.unpack (addressBookAbdescrip (entityVal a)) + "Address copied to Clipboard from >>\n" ++ + T.unpack (addressBookAbdescrip (entityVal a)) BT.modify $ set displayBox MsgDisplay _ -> do - BT.modify $ set msg "Error while copying the address!!" - BT.modify $ set displayBox MsgDisplay + BT.modify $ + set msg "Error while copying the address!!" + BT.modify $ set displayBox MsgDisplay -- Send Zcash transaction V.EvKey (V.KChar 's') [] -> do case L.listSelectedElement $ s ^. abAddresses of Just (_, a) -> do - BT.modify $ - set txForm $ - mkSendForm (s ^. balance) (SendInput (addressBookAbaddress (entityVal a)) 0.0 "") - BT.modify $ set dialogBox SendTx + BT.modify $ + set txForm $ + mkSendForm + (s ^. balance) + (SendInput + (addressBookAbaddress (entityVal a)) + 0.0 + "") + BT.modify $ set dialogBox SendTx _ -> do - BT.modify $ set msg "No receiver address available!!" - BT.modify $ set displayBox MsgDisplay + BT.modify $ + set msg "No receiver address available!!" + BT.modify $ set displayBox MsgDisplay -- Edit an entry in Address Book V.EvKey (V.KChar 'e') [] -> do case L.listSelectedElement $ s ^. abAddresses of Just (_, a) -> do - BT.modify $ set abCurAdrs (addressBookAbaddress (entityVal a)) - BT.modify $ - set abForm $ - mkNewABForm (AdrBookEntry (addressBookAbdescrip (entityVal a)) (addressBookAbaddress (entityVal a))) - BT.modify $ set dialogBox AdrBookUpdForm + BT.modify $ + set + abCurAdrs + (addressBookAbaddress (entityVal a)) + BT.modify $ + set abForm $ + mkNewABForm + (AdrBookEntry + (addressBookAbdescrip (entityVal a)) + (addressBookAbaddress (entityVal a))) + BT.modify $ set dialogBox AdrBookUpdForm _ -> do - BT.modify $ set dialogBox Blank + BT.modify $ set dialogBox Blank -- Delete an entry from Address Book V.EvKey (V.KChar 'd') [] -> do case L.listSelectedElement $ s ^. abAddresses of Just (_, a) -> do - BT.modify $ set abCurAdrs (addressBookAbaddress (entityVal a)) - BT.modify $ - set abForm $ - mkNewABForm (AdrBookEntry (addressBookAbdescrip (entityVal a)) (addressBookAbaddress (entityVal a))) - BT.modify $ set dialogBox AdrBookDelForm + BT.modify $ + set + abCurAdrs + (addressBookAbaddress (entityVal a)) + BT.modify $ + set abForm $ + mkNewABForm + (AdrBookEntry + (addressBookAbdescrip (entityVal a)) + (addressBookAbaddress (entityVal a))) + BT.modify $ set dialogBox AdrBookDelForm _ -> do - BT.modify $ set dialogBox Blank + BT.modify $ set dialogBox Blank -- Create a new entry in Address Book V.EvKey (V.KChar 'n') [] -> do - BT.modify $ set abForm $ mkNewABForm (AdrBookEntry "" "") - BT.modify $ set dialogBox AdrBookForm + BT.modify $ + set abForm $ mkNewABForm (AdrBookEntry "" "") + BT.modify $ set dialogBox AdrBookForm -- Show AddressBook entry data - V.EvKey V.KEnter [] -> do - BT.modify $ set displayBox AdrBookEntryDisplay - + V.EvKey V.KEnter [] -> do + BT.modify $ set displayBox AdrBookEntryDisplay -- Process any other event ev -> BT.zoom abAddresses $ L.handleListEvent ev -- Process new address book entry @@ -1146,75 +1174,101 @@ appEvent (BT.VtyEvent e) = do case e of V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook V.EvKey V.KEnter [] -> do - pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath - fs <- BT.zoom abForm $ BT.gets formState - let idescr = T.unpack $ T.strip (fs ^. descrip) - let iabadr = fs ^. address - if not (null idescr) && isRecipientValid iabadr - then do - res <- liftIO $ saveAdrsInAdrBook pool $ AddressBook (ZcashNetDB (s ^. network)) (fs ^. descrip) (fs ^.address) - case res of - Nothing -> do - BT.modify $ set msg ("AddressBook Entry already exists: " ++ T.unpack (fs ^.address)) - BT.modify $ set displayBox MsgDisplay - Just _ -> do - BT.modify $ set msg ("New AddressBook entry created!!\n" ++ T.unpack (fs ^.address)) - BT.modify $ set displayBox MsgDisplay + pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath + fs <- BT.zoom abForm $ BT.gets formState + let idescr = T.unpack $ T.strip (fs ^. descrip) + let iabadr = fs ^. address + if not (null idescr) && isRecipientValid iabadr + then do + res <- + liftIO $ + saveAdrsInAdrBook pool $ + AddressBook + (ZcashNetDB (s ^. network)) + (fs ^. descrip) + (fs ^. address) + case res of + Nothing -> do + BT.modify $ + set + msg + ("AddressBook Entry already exists: " ++ + T.unpack (fs ^. address)) + BT.modify $ set displayBox MsgDisplay + Just _ -> do + BT.modify $ + set + msg + ("New AddressBook entry created!!\n" ++ + T.unpack (fs ^. address)) + BT.modify $ set displayBox MsgDisplay -- case end - s' <- liftIO $ refreshAddressBook s - BT.put s' - BT.modify $ set dialogBox AdrBook - else do - BT.modify $ set msg "Invalid or missing data!!: " - BT.modify $ set displayBox MsgDisplay - BT.modify $ set dialogBox AdrBookForm - ev -> BT.zoom abForm $ do - handleFormEvent (BT.VtyEvent ev) - fs <- BT.gets formState - BT.modify $ - setFieldValid - (isRecipientValid (fs ^. address)) - AddressField - AdrBookUpdForm -> do + s' <- liftIO $ refreshAddressBook s + BT.put s' + BT.modify $ set dialogBox AdrBook + else do + BT.modify $ set msg "Invalid or missing data!!: " + BT.modify $ set displayBox MsgDisplay + BT.modify $ set dialogBox AdrBookForm + ev -> + BT.zoom abForm $ do + handleFormEvent (BT.VtyEvent ev) + fs <- BT.gets formState + BT.modify $ + setFieldValid + (isRecipientValid (fs ^. address)) + AddressField + AdrBookUpdForm -> do case e of V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook V.EvKey V.KEnter [] -> do - pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath - fs <- BT.zoom abForm $ BT.gets formState - let idescr = T.unpack $ T.strip (fs ^. descrip) - let iabadr = fs ^. address - if not (null idescr) && isRecipientValid iabadr - then do - res <- liftIO $ updateAdrsInAdrBook pool (fs ^. descrip) (fs ^.address) (s ^. abCurAdrs) - BT.modify $ set msg ("AddressBook entry modified!!\n" ++ T.unpack (fs ^.address)) - BT.modify $ set displayBox MsgDisplay + pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath + fs <- BT.zoom abForm $ BT.gets formState + let idescr = T.unpack $ T.strip (fs ^. descrip) + let iabadr = fs ^. address + if not (null idescr) && isRecipientValid iabadr + then do + res <- + liftIO $ + updateAdrsInAdrBook + pool + (fs ^. descrip) + (fs ^. address) + (s ^. abCurAdrs) + BT.modify $ + set + msg + ("AddressBook entry modified!!\n" ++ + T.unpack (fs ^. address)) + BT.modify $ set displayBox MsgDisplay -- case end - s' <- liftIO $ refreshAddressBook s - BT.put s' - BT.modify $ set dialogBox AdrBook - else do - BT.modify $ set msg "Invalid or missing data!!: " - BT.modify $ set displayBox MsgDisplay - BT.modify $ set dialogBox AdrBookForm - ev -> BT.zoom abForm $ do - handleFormEvent (BT.VtyEvent ev) - fs <- BT.gets formState - BT.modify $ - setFieldValid - (isRecipientValid (fs ^. address)) - AddressField + s' <- liftIO $ refreshAddressBook s + BT.put s' + BT.modify $ set dialogBox AdrBook + else do + BT.modify $ set msg "Invalid or missing data!!: " + BT.modify $ set displayBox MsgDisplay + BT.modify $ set dialogBox AdrBookForm + ev -> + BT.zoom abForm $ do + handleFormEvent (BT.VtyEvent ev) + fs <- BT.gets formState + BT.modify $ + setFieldValid + (isRecipientValid (fs ^. address)) + AddressField -- Process delete AddresBook entry AdrBookDelForm -> do - case e of - V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook - V.EvKey (V.KChar 'c') [] -> do - pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath - fs <- BT.zoom abForm $ BT.gets formState - res <- liftIO $ deleteAdrsFromAB pool (fs ^.address) - s' <- liftIO $ refreshAddressBook s - BT.put s' - BT.modify $ set dialogBox AdrBook - ev -> BT.modify $ set dialogBox AdrBookDelForm + case e of + V.EvKey V.KEsc [] -> BT.modify $ set dialogBox AdrBook + V.EvKey (V.KChar 'c') [] -> do + pool <- liftIO $ runNoLoggingT $ initPool $ s ^. dbPath + fs <- BT.zoom abForm $ BT.gets formState + res <- liftIO $ deleteAdrsFromAB pool (fs ^. address) + s' <- liftIO $ refreshAddressBook s + BT.put s' + BT.modify $ set dialogBox AdrBook + ev -> BT.modify $ set dialogBox AdrBookDelForm -- Process any other event Blank -> do case e of @@ -1321,9 +1375,7 @@ runZenithTUI config = do if not (null walList) then zcashWalletLastSync $ entityVal $ head walList else 0 - abookList <- getAdrBook pool $ zgb_net chainInfo - bal <- if not (null accList) then getBalance pool $ entityKey $ head accList @@ -1451,8 +1503,7 @@ addNewAccount n s = do Right zA' -> do r <- saveAccount pool zA' case r of - Nothing -> - return $ s & msg .~ "Account already exists: " ++ T.unpack n + Nothing -> return $ s & msg .~ "Account already exists: " ++ T.unpack n Just x -> do aL <- runNoLoggingT $ getAccounts pool (entityKey selWallet) let nL = @@ -1519,10 +1570,11 @@ refreshAddressBook s = do do case L.listSelectedElement $ s ^. abAddresses of Nothing -> do let fAdd = - L.listSelectedElement $ L.listMoveToBeginning $ s ^. abAddresses + L.listSelectedElement $ + L.listMoveToBeginning $ s ^. abAddresses return fAdd Just a2 -> return $ Just a2 - abookList <- getAdrBook pool (s ^. network) + abookList <- getAdrBook pool (s ^. network) let tL' = L.listReplace (Vec.fromList abookList) (Just 0) (s ^. abAddresses) return $ s & abAddresses .~ tL' @@ -1547,8 +1599,7 @@ addNewAddress n scope s = do Right uA' -> do nAddr <- saveAddress pool uA' case nAddr of - Nothing -> - return $ s & msg .~ "Address already exists: " ++ T.unpack n + Nothing -> return $ s & msg .~ "Address already exists: " ++ T.unpack n Just x -> do addrL <- runNoLoggingT $ getAddresses pool (entityKey selAccount) let nL = diff --git a/zenith.cabal b/zenith.cabal index c7dedb1..c54b192 100644 --- a/zenith.cabal +++ b/zenith.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: zenith -version: 0.5.3.0-beta +version: 0.5.3.1-beta license: MIT license-file: LICENSE author: Rene Vergara