Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

add custom network support #82

Draft
wants to merge 3 commits into
base: mlabs/private-sale-staging
Choose a base branch
from
Draft

add custom network support #82

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
3 commits
Select commit Hold shift + click to select a range
b3baa28
[update dep] update blockfrost libs to have preprod and preview netwo…
augucharles Mar 15, 2023
7bd823b
[network] add proper preprod network support
augucharles Mar 17, 2023
ebefce7
[network] add custom network support
augucharles Mar 21, 2023
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
9 changes: 3 additions & 6 deletions cabal.project
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -14,9 +14,9 @@ repository cardano-haskell-packages
-- Note: We repeat the hackage index-state because haskell.nix has trouble parsing the index-state with multiple repositories
-- Cabal will ignore the first index-state anyway.
-- cf. https://github.com/input-output-hk/cardano-ledger/pull/3265#issue-1548330220
index-state: 2022-10-29T00:00:00Z
index-state: 2023-03-09T12:19:31Z
index-state:
, hackage.haskell.org 2022-10-29T00:00:00Z
, hackage.haskell.org 2023-03-09T12:19:31Z
, cardano-haskell-packages 2022-12-14T00:40:15Z

profiling: False
Expand Down Expand Up @@ -200,13 +200,9 @@ source-repository-package
tag: 18a931648550246695c790578d4a55ee2f10463e
--sha256: sha256-3Rnj/g3KLzOW5YSieqsUa9IF1Td22Eskk5KuVsOFgEQ=
subdir:
lib/cli
lib/core
lib/core-integration
lib/dbvar
lib/launcher
lib/numeric
lib/shelley
lib/strict-non-empty-containers
lib/test-utils
lib/text-class
Expand Down Expand Up @@ -282,3 +278,4 @@ allow-newer:
*:aeson,
*:servant,
*:time,
playground-common:recursion-schemes,
30 changes: 12 additions & 18 deletions cabal.project.freeze
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -74,7 +74,7 @@ constraints: any.Boolean ==0.2.4,
bech32 -release -static,
any.bech32-th ==1.1.1,
bech32-th -release,
any.bifunctors ==5.5.7,
any.bifunctors ==5.5.15,
bifunctors +semigroups +tagged,
any.bimap ==0.4.0,
any.bin ==0.1,
Expand All @@ -85,11 +85,11 @@ constraints: any.Boolean ==0.2.4,
any.blaze-markup ==0.8.2.8,
any.blaze-textual ==0.2.2.1,
blaze-textual -developer -integer-simple +native,
any.blockfrost-api ==0.4.0.0,
any.blockfrost-api ==0.7.1.0,
blockfrost-api +buildfast -production,
any.blockfrost-client ==0.4.0.1,
any.blockfrost-client ==0.7.1.1,
blockfrost-client +buildfast -examples -production,
any.blockfrost-client-core ==0.4.0.2,
any.blockfrost-client-core ==0.6.0.0,
blockfrost-client-core +buildfast -production,
any.boring ==0.2,
boring +tagged,
Expand Down Expand Up @@ -153,14 +153,8 @@ constraints: any.Boolean ==0.2.4,
any.cardano-streaming ==1.1.0.0,
any.cardano-wallet ==2022.7.1,
cardano-wallet -release,
any.cardano-wallet-cli ==2022.7.1,
cardano-wallet-cli -release,
any.cardano-wallet-core ==2022.7.1,
cardano-wallet-core -release +scrypt,
any.cardano-wallet-core-integration ==2022.7.1,
cardano-wallet-core-integration -release,
any.cardano-wallet-launcher ==2022.7.1,
cardano-wallet-launcher -release,
any.cardano-wallet-test-utils ==2022.7.1,
cardano-wallet-test-utils -release,
any.case-insensitive ==1.2.1.0,
Expand Down Expand Up @@ -267,7 +261,7 @@ constraints: any.Boolean ==0.2.4,
any.formatting ==6.3.7,
any.foundation ==0.0.29,
foundation -bench-all -bounds-check -doctest -experimental -linktest -minimal-deps,
any.free ==5.1.3,
any.free ==5.1.10,
any.freer-extras ==1.1.0.0,
any.freer-simple ==1.2.1.2,
any.fusion-plugin-types ==0.1.0,
Expand Down Expand Up @@ -358,7 +352,7 @@ constraints: any.Boolean ==0.2.4,
any.lattices ==2.0.3,
any.lazy-search ==0.1.3.0,
any.lazysmallcheck ==0.6,
any.lens ==4.19.2,
any.lens ==5.2.1,
lens -benchmark-uniplate -dump-splices +inlining -j -old-inline-pragmas -safe +test-doctests +test-hunit +test-properties +test-templates +trustworthy,
any.lens-aeson ==1.1.3,
any.libyaml ==0.1.2,
Expand All @@ -384,7 +378,7 @@ constraints: any.Boolean ==0.2.4,
mersenne-random-pure64 -small_base,
any.microlens ==0.4.13.0,
any.microlens-mtl ==0.2.0.2,
any.microlens-th ==0.4.3.6,
any.microlens-th ==0.4.3.11,
any.microstache ==1.0.2.2,
any.mime-types ==0.1.1.0,
any.mmorph ==1.2.0,
Expand Down Expand Up @@ -494,7 +488,7 @@ constraints: any.Boolean ==0.2.4,
any.primitive-addr ==0.1.0.2,
any.process ==1.6.13.2,
any.process-extras ==0.7.4,
any.profunctors ==5.6,
any.profunctors ==5.6.2,
any.protolude ==0.3.0,
protolude -dev,
any.psqueues ==0.2.7.3,
Expand All @@ -514,7 +508,7 @@ constraints: any.Boolean ==0.2.4,
any.random ==1.2.1.1,
any.random-shuffle ==0.0.4,
any.readable ==0.3.1,
any.recursion-schemes ==5.1.3,
any.recursion-schemes ==5.2.2.4,
recursion-schemes +template-haskell,
any.recv ==0.0.0,
any.reducers ==3.12.4,
Expand All @@ -539,7 +533,7 @@ constraints: any.Boolean ==0.2.4,
any.selective ==0.5,
any.semialign ==1.2.0.1,
semialign +semigroupoids,
any.semigroupoids ==5.3.4,
any.semigroupoids ==5.3.7,
semigroupoids +comonad +containers +contravariant +distributive +doctests +tagged +unordered-containers,
any.semigroups ==0.20,
semigroups +binary +bytestring -bytestring-builder +containers +deepseq +hashable +tagged +template-haskell +text +transformers +unordered-containers,
Expand Down Expand Up @@ -637,7 +631,7 @@ constraints: any.Boolean ==0.2.4,
any.text-short ==0.1.5,
text-short -asserts,
any.tf-random ==0.5,
any.th-abstraction ==0.3.2.0,
any.th-abstraction ==0.4.5.0,
any.th-compat ==0.1.4,
any.th-expand-syns ==0.4.7.0,
any.th-extras ==0.0.0.4,
Expand Down Expand Up @@ -732,4 +726,4 @@ constraints: any.Boolean ==0.2.4,
any.zlib ==0.6.3.0,
zlib -bundled-c-zlib -non-blocking-ffi -pkg-config,
any.zlib-bindings ==0.1.1.5
index-state: cardano-haskell-packages 2022-12-13T23:38:19Z, hackage.haskell.org 2022-10-28T22:57:46Z
index-state: cardano-haskell-packages 2022-12-13T23:38:19Z, hackage.haskell.org 2023-03-09T12:19:31Z
91 changes: 59 additions & 32 deletions src/Tokenomia/CLI.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,3 +1,4 @@
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ImportQualifiedPost #-}
Expand All @@ -22,16 +23,18 @@ import Data.List.NonEmpty
as NonEmpty ( NonEmpty, fromList )
import Shh ( ExecReference(SearchPath), load )
import Streamly.Prelude qualified as S

import Tokenomia.Ada.Transfer qualified as Ada
import Tokenomia.Common.Environment
( Environment
, getMainnetEnvironmment
, getPreprodEnvironmment
, getTestnetEnvironmment
( CustomNetworkArgs(..)
, Environment
, TokenomiaNetwork(..)
, getNetworkEnvironment
, readCustomNetworkArgsFile
)
import Tokenomia.Common.Error ( TokenomiaError(..) )
import Tokenomia.Common.Shell.Console ( clearConsole, printLn, printOpt )
import Tokenomia.Common.Shell.InteractiveMenu ( DisplayMenuItem(..), askMenu )
import Tokenomia.Common.Shell.InteractiveMenu ( DisplayMenuItem(..), askMenu, askString )
import Tokenomia.Node.Status qualified as Node
import Tokenomia.Token.CLAPStyle.Burn qualified as Token
import Tokenomia.Token.CLAPStyle.Mint qualified as Token
Expand All @@ -43,64 +46,87 @@ import Tokenomia.Wallet.Collateral.Write qualified as Wallet

load SearchPath ["cardano-cli"]

main :: IO ()
main :: IO ()
main = do
clearConsole
printLn "#############################"
printLn "# Welcome to Tokenomia #"
printLn "#############################"
printLn ""
selectNetwork
network <- liftIO selectNetwork
environment <- getNetworkEnvironment network
clearConsole
runExceptT (runReaderT recursiveMenu environment) >>= \case
Left e -> printLn $ "An unexpected error occured :" <> show e
Right _ -> return ()

printLn "#############################"
printLn "# End of Tokenomia #"
printLn "#############################"

waitAndClear :: IO()
waitAndClear = do
_ <- printOpt "-n" "> press enter to continue..." >> getLine
clearConsole

selectNetwork :: IO()
selectNetwork :: IO TokenomiaNetwork
selectNetwork = do
printLn "----------------------"
printLn " Select a network"
printLn "----------------------"
environment <- liftIO $ askMenu networks >>= \case
SelectMainnet -> getMainnetEnvironmment 764824073
SelectPreprod -> getPreprodEnvironmment 1
SelectTestnet -> getTestnetEnvironmment 1097911063
clearConsole
result :: Either TokenomiaError () <- runExceptT $ runReaderT recursiveMenu environment
case result of
Left e -> printLn $ "An unexpected error occured :" <> show e
Right _ -> return ()
printLn "----------------------"
printLn " Select a network"
printLn "----------------------"
askMenu networks >>= \case
SelectMainnet -> pure MainnetNetwork
SelectPreprod -> pure PreprodNetwork
SelectTestnet -> pure TestnetNetwork
SelectCustom -> CustomNetwork <$> inputCustomNetworkArgs


inputCustomNetworkArgs :: IO CustomNetworkArgs
inputCustomNetworkArgs = do
clearConsole
printLn "--------------------------------------------"
printLn " Enter custom network arguments file path"
printLn "--------------------------------------------"
path <- askString "- File path : "
readCustomNetworkArgsFile path >>= \case
Right args -> pure args
Left e -> do
printLn ""
printLn $ "Invalid custom network arguments :" <> e
printLn ""
waitAndClear
inputCustomNetworkArgs


networks :: NonEmpty SelectEnvironment
networks = NonEmpty.fromList [
SelectMainnet,
SelectPreprod,
SelectTestnet
networks = NonEmpty.fromList
[ SelectMainnet
, SelectPreprod
, SelectTestnet
, SelectCustom
]

data SelectEnvironment
= SelectMainnet
| SelectPreprod
| SelectTestnet
| SelectCustom

instance DisplayMenuItem SelectEnvironment where
displayMenuItem item = case item of
SelectMainnet -> "Mainnet (magicNumber 764824073)"
SelectPreprod -> "Preprod (magicNumber 1)"
SelectTestnet -> "`Old` Testnet (magicNumber 1097911063)"
SelectCustom -> "Use a custom network"


recursiveMenu
:: ( S.MonadAsync m
, MonadReader Environment m
, MonadError TokenomiaError m) => m ()
waitAndClear :: IO ()
waitAndClear = do
_ <- printOpt "-n" "> press enter to continue..." >> getLine
clearConsole


recursiveMenu ::
( S.MonadAsync m
, MonadReader Environment m
, MonadError TokenomiaError m
) => m ()
recursiveMenu = do
printLn "----------------------"
printLn " Select an action"
Expand All @@ -109,6 +135,7 @@ recursiveMenu = do
runAction action
`catchError`
(\case
NetworkNotSupported errorMsg -> printLn $ "Network not supported : " <> errorMsg
NoWalletRegistered -> printLn "Register a Wallet First..."
NoWalletWithoutCollateral -> printLn "All Wallets contain collateral..."
NoWalletWithCollateral -> printLn "No Wallets with collateral..."
Expand Down
31 changes: 18 additions & 13 deletions src/Tokenomia/Common/Blockfrost.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -1,13 +1,7 @@
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE ExtendedDefaultRules #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
{-# OPTIONS_GHC -fno-warn-unused-top-binds #-}
{-# LANGUAGE RecordWildCards #-}

module Tokenomia.Common.Blockfrost
( projectFromEnv''
Expand All @@ -17,15 +11,26 @@ module Tokenomia.Common.Blockfrost
import Blockfrost.Client qualified as B

import Prelude hiding ( head )
import Tokenomia.Common.Environment ( Environment(Mainnet, Testnet) )
import Tokenomia.Common.Environment ( Environment(..), TokenomiaNetwork(..), networkMagicNumber )

import Control.Monad.Except ( MonadError(throwError) )
import Control.Monad.Reader ( MonadIO(..), MonadReader, asks )
import Tokenomia.Common.Error ( TokenomiaError(NetworkNotSupported) )

projectFromEnv''
:: ( MonadIO m
, MonadReader Environment m) => m B.Project
, MonadReader Environment m, MonadError TokenomiaError m) => m B.Project
projectFromEnv'' = do
environmentPath <- asks (\case
Testnet {} -> "BLOCKFROST_TOKEN_TESTNET_PATH"
Mainnet {} -> "BLOCKFROST_TOKEN_MAINNET_PATH")
liftIO $ B.projectFromEnv' environmentPath
environmentPath <- asks
(\case
Mainnet {}
-> Right "BLOCKFROST_TOKEN_MAINNET_PATH"
Testnet {..} | magicNumber == networkMagicNumber PreprodNetwork
-> Right "BLOCKFROST_TOKEN_PREPROD_PATH"
Testnet {..} | magicNumber == networkMagicNumber TestnetNetwork
-> Left "Blockfrost does not support the legacy Testnet anymore"
_ -> Left "Blockfrost only supports Mainnet, Preprod and Preview networks"
)
case environmentPath of
Left err -> throwError (NetworkNotSupported err)
Right env -> liftIO $ B.projectFromEnv' env
Loading