Skip to content

Commit edbb3de

Browse files
mikekekemikekeke
authored
Merge pull request #111 from mlabs-haskell/fix-local-cluster-args
args parsing fix
2 parents 1964a15 + 405c3e0 commit edbb3de

File tree

3 files changed

+126
-100
lines changed

3 files changed

+126
-100
lines changed

‎local-cluster/Main.hs‎

Lines changed: 123 additions & 94 deletions
Original file line numberDiff line numberDiff line change
@@ -1,127 +1,156 @@
1-
{-# LANGUAGE NumericUnderscores #-}
2-
{-# LANGUAGE ImportQualifiedPost #-}
31
{-# LANGUAGE DerivingStrategies #-}
2+
{-# LANGUAGE ImportQualifiedPost #-}
3+
{-# LANGUAGE NamedFieldPuns #-}
4+
{-# LANGUAGE NumericUnderscores #-}
45

56
module Main (main) where
67

78
import Control.Applicative (optional, (<**>))
8-
import Control.Monad (void, replicateM, forM_)
9+
import Control.Monad (forM_, replicateM, void)
910
import Control.Monad.IO.Class (liftIO)
1011
import Control.Monad.Reader (ReaderT (ReaderT))
1112
import Data.Default (def)
13+
import Numeric.Positive (Positive)
14+
import Options.Applicative (Parser, helper, info)
1215
import Options.Applicative qualified as Options
13-
import Options.Applicative (Parser, info, helper)
14-
import Test.Plutip.Config (
15-
WorkingDirectory (Temporary, Fixed),
16-
PlutipConfig (clusterWorkingDir),
17-
)
18-
import Test.Plutip.Internal.BotPlutusInterface.Wallet (walletPkh, addSomeWalletDir)
16+
import Test.Plutip.Config
17+
( PlutipConfig (clusterWorkingDir),
18+
WorkingDirectory (Fixed, Temporary),
19+
)
20+
import Test.Plutip.Internal.BotPlutusInterface.Wallet (addSomeWalletDir, walletPkh)
1921
import Test.Plutip.Internal.Types (nodeSocket)
20-
import Test.Plutip.LocalCluster (
21-
mkMainnetAddress,
22-
startCluster,
23-
stopCluster,
24-
waitSeconds,
25-
)
22+
import Test.Plutip.LocalCluster
23+
( mkMainnetAddress,
24+
startCluster,
25+
stopCluster,
26+
waitSeconds,
27+
)
28+
import GHC.Natural (Natural)
2629

2730
main :: IO ()
2831
main = do
29-
args <- Options.execParser (info (pClusterConfig <**> helper) mempty)
30-
let workingDir = maybe Temporary (flip Fixed False) (workDir args)
31-
plutipConfig = def {clusterWorkingDir = workingDir}
32-
(st, _) <- startCluster plutipConfig $ do
33-
let nWall = numWallets args
34-
wPath = dirWallets args
35-
adaAmt = toAda (fromInteger $ abs $ adaAmount args) + fromInteger (abs $ lvlAmount args)
36-
nUtxos = numUtxos args
37-
ws <- replicateM (max 0 nWall) $ addSomeWalletDir (replicate nUtxos adaAmt) wPath
38-
waitSeconds 2 -- let wallet Tx finish, it can take more time with bigger slot length
39-
separate
40-
forM_ (zip ws [(1 :: Int)..]) $ \(w,n) -> liftIO $ do
41-
putStrLn $ "Wallet " ++ show n ++ " PKH: " ++ show (walletPkh w)
42-
putStrLn $ "Wallet " ++ show n ++ " mainnet address: " ++ show (mkMainnetAddress w)
43-
prtNodeRelatedInfo
44-
separate
45-
46-
putStrLn "Cluster is running. Press Enter to stop."
47-
>> void getLine
48-
putStrLn "Stopping cluster"
49-
50-
stopCluster st
32+
config <- Options.execParser (info (pClusterConfig <**> helper) mempty)
33+
case totalAmount config of
34+
Left e -> error e
35+
Right amt -> do
36+
let CWalletConfig {numWallets, dirWallets, numUtxos, workDir} = config
37+
workingDir = maybe Temporary (`Fixed` False) workDir
38+
plutipConfig = def {clusterWorkingDir = workingDir}
39+
40+
(st, _) <- startCluster plutipConfig $ do
41+
ws <- initWallets numWallets numUtxos amt dirWallets
42+
waitSeconds 2 -- let wallet Tx finish, it can take more time with bigger slot length
43+
44+
separate
45+
liftIO $ forM_ (zip ws [(1 :: Int) ..]) printWallet
46+
printNodeRelatedInfo
47+
separate
48+
49+
putStrLn "Cluster is running. Press Enter to stop."
50+
>> void getLine
51+
putStrLn "Stopping cluster"
52+
53+
stopCluster st
5154
where
52-
prtNodeRelatedInfo = ReaderT $ \cEnv -> do
55+
printNodeRelatedInfo = ReaderT $ \cEnv -> do
5356
putStrLn $ "Node socket: " <> show (nodeSocket cEnv)
5457

5558
separate = liftIO $ putStrLn "\n------------\n"
5659

57-
toAda = (* 1_000_000)
60+
totalAmount :: CWalletConfig -> Either String Positive
61+
totalAmount cwc =
62+
case toAda (adaAmount cwc) + lvlAmount cwc of
63+
0 -> Left "One of --ada or --lovelace arguments should not be 0"
64+
amt -> Right $ fromInteger . toInteger $ amt
5865

66+
initWallets numWallets numUtxos amt dirWallets = do
67+
replicateM (max 0 numWallets) $
68+
addSomeWalletDir (replicate numUtxos amt) dirWallets
5969

60-
pnumWallets :: Parser Int
61-
pnumWallets = Options.option Options.auto
62-
( Options.long "num-wallets"
63-
<> Options.long "wallets"
64-
<> Options.short 'n'
65-
<> Options.metavar "NUM_WALLETS"
66-
<> Options.value 1
67-
)
70+
printWallet (w, n) = do
71+
putStrLn $ "Wallet " ++ show n ++ " PKH: " ++ show (walletPkh w)
72+
putStrLn $ "Wallet " ++ show n ++ " mainnet address: " ++ show (mkMainnetAddress w)
6873

69-
pdirWallets :: Parser (Maybe FilePath)
70-
pdirWallets = optional $ Options.strOption
71-
( Options.long "wallets-dir"
72-
<> Options.long "wallet-dir"
73-
<> Options.short 'd'
74-
<> Options.metavar "FILEPATH"
75-
)
74+
toAda = (* 1_000_000)
7675

77-
padaAmount :: Parser Integer
78-
padaAmount = Options.option Options.auto
79-
( Options.long "ada"
80-
<> Options.short 'a'
81-
<> Options.metavar "ADA"
82-
<> Options.value 10_000
83-
)
76+
pnumWallets :: Parser Int
77+
pnumWallets =
78+
Options.option
79+
Options.auto
80+
( Options.long "num-wallets"
81+
<> Options.long "wallets"
82+
<> Options.short 'n'
83+
<> Options.metavar "NUM_WALLETS"
84+
<> Options.value 1
85+
)
8486

85-
plvlAmount :: Parser Integer
86-
plvlAmount = Options.option Options.auto
87-
( Options.long "lovelave"
88-
<> Options.short 'l'
89-
<> Options.metavar "Lovelace"
90-
<> Options.value 0
91-
)
87+
pdirWallets :: Parser (Maybe FilePath)
88+
pdirWallets =
89+
optional $
90+
Options.strOption
91+
( Options.long "wallets-dir"
92+
<> Options.long "wallet-dir"
93+
<> Options.short 'd'
94+
<> Options.metavar "FILEPATH"
95+
)
96+
97+
padaAmount :: Parser Natural
98+
padaAmount =
99+
Options.option
100+
Options.auto
101+
( Options.long "ada"
102+
<> Options.short 'a'
103+
<> Options.metavar "ADA"
104+
<> Options.value 10_000
105+
)
106+
107+
plvlAmount :: Parser Natural
108+
plvlAmount =
109+
Options.option
110+
Options.auto
111+
( Options.long "lovelace"
112+
<> Options.short 'l'
113+
<> Options.metavar "Lovelace"
114+
<> Options.value 0
115+
)
92116

93117
pnumUtxos :: Parser Int
94-
pnumUtxos = Options.option Options.auto
95-
( Options.long "utxos"
96-
<> Options.short 'u'
97-
<> Options.metavar "NUM_UTXOS"
98-
<> Options.value 1
99-
)
118+
pnumUtxos =
119+
Options.option
120+
Options.auto
121+
( Options.long "utxos"
122+
<> Options.short 'u'
123+
<> Options.metavar "NUM_UTXOS"
124+
<> Options.value 1
125+
)
100126

101127
pWorkDir :: Parser (Maybe FilePath)
102-
pWorkDir = optional $ Options.strOption
103-
( Options.long "working-dir"
104-
<> Options.short 'w'
105-
<> Options.metavar "FILEPATH"
106-
)
128+
pWorkDir =
129+
optional $
130+
Options.strOption
131+
( Options.long "working-dir"
132+
<> Options.short 'w'
133+
<> Options.metavar "FILEPATH"
134+
)
107135

108136
pClusterConfig :: Parser CWalletConfig
109-
pClusterConfig = CWalletConfig
110-
<$> pnumWallets
111-
<*> pdirWallets
112-
<*> padaAmount
113-
<*> plvlAmount
114-
<*> pnumUtxos
115-
<*> pWorkDir
137+
pClusterConfig =
138+
CWalletConfig
139+
<$> pnumWallets
140+
<*> pdirWallets
141+
<*> padaAmount
142+
<*> plvlAmount
143+
<*> pnumUtxos
144+
<*> pWorkDir
116145

117146
-- | Basic info about the cluster, to
118147
-- be used by the command-line
119148
data CWalletConfig = CWalletConfig
120-
{ numWallets :: Int
121-
, dirWallets :: Maybe FilePath
122-
, adaAmount :: Integer
123-
, lvlAmount :: Integer
124-
, numUtxos :: Int
125-
, workDir :: Maybe FilePath
126-
} deriving stock (Show, Eq)
127-
149+
{ numWallets :: Int,
150+
dirWallets :: Maybe FilePath,
151+
adaAmount :: Natural,
152+
lvlAmount :: Natural,
153+
numUtxos :: Int,
154+
workDir :: Maybe FilePath
155+
}
156+
deriving stock (Show, Eq)

‎local-cluster/README.md‎

Lines changed: 2 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -58,11 +58,7 @@ This puts `AMOUNT` Lovelace into each UTxO in every wallet created, in addition
5858
the amount specified by the `--ada` argument. Note that if you don't specify the
5959
amount of ADA to add, the total amount will be 10,000 ADA + `AMOUNT` lovelace.
6060

61-
62-
Note that for both `--ada` and `--lovelace`, the values' absolute values are taken
63-
and then added together to get the total amount to use for the UTxOs. Note that this
64-
means that if you use a command like `local-cluster --ada 5 --lovelace -1`, the final
65-
amount will be 5.000001 ADA instead of 4.999999 ADA.
61+
Note that both `--ada` and `--lovelace` can not be 0 at the same time.
6662

6763
```
6864
--utxos NUM
@@ -81,4 +77,4 @@ This determines where the node database, chain-index database, and bot-plutus-in
8177
files will be stored for a running cluster. If specified, this will store cluster
8278
data in the provided path (can be relative or absolute), the files will be deleted
8379
on cluster shutdown by default. Otherwise, the cluster data is stored in a temporary
84-
directory and will be deleted on cluster shutdown.
80+
directory and will be deleted on cluster shutdown.

‎plutip.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -241,5 +241,6 @@ executable local-cluster
241241
, mtl
242242
, optparse-applicative
243243
, plutip
244+
, positive
244245

245246
ghc-options: -Wall -threaded -rtsopts

0 commit comments

Comments
 (0)