Continue

cardano-faucet/src/Cardano/Faucet.hs

@@ -18,11 +18,10 @@ module Cardano.Faucet (main) where
 
 import Cardano.Address.Derivation (Depth(AccountK), XPrv)
 import Cardano.Address.Style.Shelley (getKey, Shelley)
-import Cardano.Api (TxInMode, CardanoMode, AddressAny, EraInMode, IsShelleyBasedEra, QueryInMode(QueryInEra, QueryCurrentEra), UTxO(unUTxO), QueryUTxOFilter(QueryUTxOByAddress), BlockInMode, ChainPoint, AnyCardanoEra(AnyCardanoEra), CardanoEraStyle(ShelleyBasedEra), LocalNodeConnectInfo(LocalNodeConnectInfo), LocalNodeClientProtocols(LocalNodeClientProtocols, localChainSyncClient, localStateQueryClient, localTxSubmissionClient, localTxMonitoringClient), ConsensusMode(CardanoMode), QueryInEra(QueryInShelleyBasedEra), QueryInShelleyBasedEra(QueryUTxO, QueryStakeAddresses), LocalStateQueryClient(LocalStateQueryClient), ConsensusModeIsMultiEra(CardanoModeIsMultiEra), cardanoEraStyle, connectToLocalNode, LocalChainSyncClient(NoLocalChainSyncClient), SigningKey(PaymentExtendedSigningKey), getVerificationKey, Lovelace, serialiseAddress,  ShelleyWitnessSigningKey(WitnessPaymentExtendedKey), File(File), AddressAny(AddressShelley))
+import Cardano.Api (TxInMode, AddressAny, IsShelleyBasedEra, QueryInMode(QueryInEra, QueryCurrentEra), UTxO(unUTxO), QueryUTxOFilter(QueryUTxOByAddress), BlockInMode, ChainPoint, AnyCardanoEra(AnyCardanoEra), LocalNodeConnectInfo(LocalNodeConnectInfo), LocalNodeClientProtocols(LocalNodeClientProtocols, localChainSyncClient, localStateQueryClient, localTxSubmissionClient, localTxMonitoringClient), QueryInEra(QueryInShelleyBasedEra), QueryInShelleyBasedEra(QueryUTxO, QueryStakeAddresses), LocalStateQueryClient(LocalStateQueryClient), connectToLocalNode, LocalChainSyncClient(NoLocalChainSyncClient), SigningKey(PaymentExtendedSigningKey), getVerificationKey, serialiseAddress,  ShelleyWitnessSigningKey(WitnessPaymentExtendedKey), File(File), AddressAny(AddressShelley), ShelleyBasedEra)
 import Cardano.Api.Byron ()
 --import Cardano.CLI.Run.Friendly (friendlyTxBS)
-import Cardano.Api.Shelley (makeStakeAddress, StakeCredential(StakeCredentialByKey), verificationKeyHash, castVerificationKey, SigningKey(StakeExtendedSigningKey), StakeAddress, PoolId, NetworkId, StakeExtendedKey, queryExpr, LocalStateQueryExpr, determineEraExpr, CardanoEra, CardanoEra(ConwayEra, ShelleyEra, AllegraEra, AlonzoEra, MaryEra, BabbageEra, ByronEra), shelleyBasedEra, IsCardanoEra, LocalTxMonitorClient(..), SlotNo, UnsupportedNtcVersionError)
-import Cardano.CLI.Legacy.Run.Address (buildShelleyAddress)
+import Cardano.Api.Shelley (makeStakeAddress, StakeCredential(StakeCredentialByKey), verificationKeyHash, castVerificationKey, SigningKey(StakeExtendedSigningKey), StakeAddress, PoolId, NetworkId, StakeExtendedKey, queryExpr, LocalStateQueryExpr, CardanoEra, CardanoEra(ConwayEra, ShelleyEra, AllegraEra, AlonzoEra, MaryEra, BabbageEra, ByronEra), shelleyBasedEra, IsCardanoEra, LocalTxMonitorClient(..), SlotNo, UnsupportedNtcVersionError)
 import Cardano.Faucet.Misc
 import Cardano.Faucet.Types (FaucetState(..), FaucetConfigFile(..), FaucetValue, FaucetError(..), StakeKeyIntermediateState(..), StakeKeyState(..), accountKeyToStakeKey, parseConfig, mnemonicToRootKey, rootKeytoAcctKey, renderFaucetError, accountKeyToPaymentKey)
 import Cardano.Faucet.Utils
@@ -48,6 +47,7 @@ import Prelude qualified
 import Servant
 import System.Environment (lookupEnv)
 import System.IO (hSetBuffering, BufferMode(LineBuffering))
+import qualified Cardano.Api.Ledger as L
 
 -- remove once stm is upgraded
 writeTMVar :: TMVar a -> a -> STM ()
@@ -118,11 +118,9 @@ unmaybe :: Maybe Prelude.String -> ExceptT FaucetError IO Prelude.String
 unmaybe (Just path) = pure path
 unmaybe Nothing = left FaucetErrorConfigFileNotSet
 
-getUtxoQuery :: forall era2 mode . IsShelleyBasedEra era2 => AddressAny -> Maybe (EraInMode era2 mode) ->  QueryInMode mode (Either EraMismatch (UTxO era2))
-getUtxoQuery _address Nothing = Prelude.error "not handled"
-getUtxoQuery address (Just eInMode) = QueryInEra eInMode query
+getUtxoQuery :: ShelleyBasedEra era -> AddressAny -> QueryInMode (Either EraMismatch (UTxO era))
+getUtxoQuery sbe address = QueryInEra query
   where
-    sbe = shelleyBasedEra @era2
     qfilter :: QueryUTxOFilter
     qfilter = QueryUTxOByAddress $ Set.singleton address
     query   = QueryInShelleyBasedEra sbe (QueryUTxO qfilter)
@@ -149,7 +147,7 @@ reAcquireThen cb = do
     , Net.Query.recvMsgFailure = Prelude.error "not implemented"
     }
 
-sortStakeKeys :: (Map StakeAddress Lovelace, Map StakeAddress PoolId) -> Map StakeAddress (Word32, SigningKey StakeExtendedKey, StakeCredential) -> ([Word32],[(Word32, SigningKey StakeExtendedKey, StakeCredential)],[(Word32, Lovelace, PoolId)])
+sortStakeKeys :: (Map StakeAddress L.Coin, Map StakeAddress PoolId) -> Map StakeAddress (Word32, SigningKey StakeExtendedKey, StakeCredential) -> ([Word32],[(Word32, SigningKey StakeExtendedKey, StakeCredential)],[(Word32, L.Coin, PoolId)])
 sortStakeKeys (registeredStakeKeys, delegatedStakeKeys) manyStakeKeys = do
   let
     intermediateMerge :: Map StakeAddress StakeKeyIntermediateState
@@ -175,7 +173,7 @@ sortStakeKeys (registeredStakeKeys, delegatedStakeKeys) manyStakeKeys = do
     notDelegated :: [(Word32, SigningKey StakeExtendedKey, StakeCredential)]
     notDelegated = mapMaybe filterOnlyRegistered finalMergeValues
 
-    delegated :: [(Word32, Lovelace, PoolId)]
+    delegated :: [(Word32, L.Coin, PoolId)]
     delegated = mapMaybe filterOnlyDelegated finalMergeValues
   (notRegistered,notDelegated,delegated)
   where
@@ -198,14 +196,14 @@ sortStakeKeys (registeredStakeKeys, delegatedStakeKeys) manyStakeKeys = do
     filterOnlyRegistered :: StakeKeyState -> Maybe (Word32, SigningKey StakeExtendedKey, StakeCredential)
     filterOnlyRegistered (StakeKeyRegistered index skey vkey _rewards) = Just (index, skey, vkey)
     filterOnlyRegistered _ = Nothing
-    filterOnlyDelegated :: StakeKeyState -> Maybe (Word32, Lovelace, PoolId)
+    filterOnlyDelegated :: StakeKeyState -> Maybe (Word32, L.Coin, PoolId)
     filterOnlyDelegated (StakeKeyDelegated index reward poolid) = Just (index, reward, poolid)
     filterOnlyDelegated _ = Nothing
 
-submissionClient :: Bool -> TQueue (TxInMode CardanoMode, ByteString) -> Net.Tx.LocalTxSubmissionClient (TxInMode CardanoMode) reject IO a2
+submissionClient :: Bool -> TQueue (TxInMode, ByteString) -> Net.Tx.LocalTxSubmissionClient TxInMode reject IO a2
 submissionClient dryRun txQueue = Net.Tx.LocalTxSubmissionClient waitForTxAndLoop
   where
-    waitForTxAndLoop :: IO (Net.Tx.LocalTxClientStIdle (TxInMode CardanoMode) reject IO a)
+    waitForTxAndLoop :: IO (Net.Tx.LocalTxClientStIdle TxInMode reject IO a)
     waitForTxAndLoop = do
       (tx, prettyTx) <- atomically $ readTQueue txQueue
       case dryRun of
@@ -227,13 +225,10 @@ withEra (Right (AnyCardanoEra ShelleyEra)) action = action ShelleyEra
 withEra (Right (AnyCardanoEra ConwayEra)) action = action ConwayEra
 withEra (Left _) _ = Prelude.error "withEra ntc error"
 
-queryManyStakeAddr :: forall era mode . IsShelleyBasedEra era => NetworkId -> Maybe (EraInMode era mode) -> [StakeCredential] -> QueryInMode mode (Either EraMismatch (Map StakeAddress Lovelace, Map StakeAddress PoolId))
-queryManyStakeAddr _ Nothing _ = Prelude.error "not handled"
-queryManyStakeAddr network (Just eInMode) creds = QueryInEra eInMode (QueryInShelleyBasedEra sbe (QueryStakeAddresses (Set.fromList creds) network))
-  where
-    sbe = shelleyBasedEra @era
+queryManyStakeAddr :: NetworkId -> [StakeCredential] -> QueryInMode (Either EraMismatch (Map StakeAddress L.Coin, Map StakeAddress PoolId))
+queryManyStakeAddr network creds = QueryInEra eInMode (QueryInShelleyBasedEra sbe (QueryStakeAddresses (Set.fromList creds) network))
 
-newFaucetState :: IsCardanoEra era => FaucetConfigFile -> TQueue (TxInMode CardanoMode, ByteString) -> ExceptT FaucetError IO (FaucetState era)
+newFaucetState :: IsCardanoEra era => FaucetConfigFile -> TQueue (TxInMode, ByteString) -> ExceptT FaucetError IO (FaucetState era)
 newFaucetState fsConfig fsTxQueue = do
   (fsUtxoTMVar,fsStakeTMVar,fsSendMoneyRateLimitState,fsDelegationRateLimitState) <- liftIO $ (,,,) <$> newEmptyTMVarIO <*> newEmptyTMVarIO <*> newTMVarIO mempty <*> newTMVarIO mempty
   fsRootKey <- mnemonicToRootKey $ fcfMnemonic fsConfig
@@ -255,8 +250,8 @@ finish = do
   pure $ Net.Query.SendMsgRelease $
     pure $ Net.Query.SendMsgDone ()
 
-queryStakeKeyLoop :: IsShelleyBasedEra era => NetworkId -> Maybe (EraInMode era mode) -> Map StakeAddress (Word32, SigningKey StakeExtendedKey, StakeCredential) -> Bool -> FaucetState era -> Bool -> IO (Net.Query.ClientStAcquired block point (QueryInMode mode) IO ())
-queryStakeKeyLoop network era manyStakeKeys debug faucetState initial = do
+queryStakeKeyLoop :: NetworkId -> Map StakeAddress (Word32, SigningKey StakeExtendedKey, StakeCredential) -> Bool -> FaucetState era -> Bool -> IO (Net.Query.ClientStAcquired block point QueryInMode IO ())
+queryStakeKeyLoop network manyStakeKeys debug faucetState initial = do
   let
     stakeCredentials :: [StakeCredential]
     stakeCredentials = Map.elems $ map (\(_,_,v) -> v) manyStakeKeys
@@ -276,7 +271,7 @@ queryStakeKeyLoop network era manyStakeKeys debug faucetState initial = do
         queryStakeKeyLoop network era manyStakeKeys debug faucetState False
     Left _ -> Prelude.error "not handled"
 
-queryClient :: FaucetConfigFile -> TQueue (TxInMode CardanoMode, ByteString) -> Port -> Net.Query.LocalStateQueryClient (BlockInMode CardanoMode) ChainPoint (QueryInMode CardanoMode) IO ()
+queryClient :: FaucetConfigFile -> TQueue (TxInMode, ByteString) -> Port -> Net.Query.LocalStateQueryClient BlockInMode ChainPoint QueryInMode IO ()
 queryClient config txQueue port = LocalStateQueryClient $ do
   aquireConnection $ do
     runQueryThen (QueryCurrentEra CardanoModeIsMultiEra) $ \(AnyCardanoEra era3) -> do
@@ -285,41 +280,40 @@ queryClient config txQueue port = LocalStateQueryClient $ do
         faucetState = fromRight (Prelude.error "cant create state") eFaucetState
       putStrLn $ format ("lovelace values for api keys " % sh) $ fsBucketSizes faucetState
       putStrLn $ "faucet address: " <> serialiseAddress (fsOwnAddress faucetState)
-      case cardanoEraStyle era3 of
-        ShelleyBasedEra _ -> do
-          _child <- forkIO $ startApiServer era3 faucetState port
-          runQueryThen (getUtxoQuery (fsOwnAddress faucetState) (toEraInMode era3 CardanoMode)) $ \case
-            Right result -> do
+      -- case cardanoEraStyle era3 of
+      --   _ -> do
+      _child <- forkIO $ startApiServer era3 faucetState port
+      runQueryThen (getUtxoQuery (fsOwnAddress faucetState) (toEraInMode era3 CardanoMode)) $ \case
+        Right result -> do
+          let
+            --reduceTxo :: TxOut ctx era -> (L.Coin, TxOut ctx era)
+            --reduceTxo out@(TxOut _ value _ _) = (getValue value, out)
+            --reducedUtxo :: Map TxIn (L.Coin, TxOut CtxUTxO era)
+            --reducedUtxo = Map.map reduceTxo $ unUTxO result
+          --atomically $ putTMVar utxoTMVar $ unUTxO result
+          let stats = computeUtxoStats (unUTxO result)
+          print stats
+          atomically $ putTMVar (fsUtxoTMVar faucetState) (unUTxO result)
+          putStrLn @Text "utxo set initialized"
+
+          case fcfMaxStakeKeyIndex config of
+            Nothing -> finish
+            Just count -> do
               let
-                --reduceTxo :: TxOut ctx era -> (Lovelace, TxOut ctx era)
-                --reduceTxo out@(TxOut _ value _ _) = (getValue value, out)
-                --reducedUtxo :: Map TxIn (Lovelace, TxOut CtxUTxO era)
-                --reducedUtxo = Map.map reduceTxo $ unUTxO result
-              --atomically $ putTMVar utxoTMVar $ unUTxO result
-              let stats = computeUtxoStats (unUTxO result)
-              print stats
-              atomically $ putTMVar (fsUtxoTMVar faucetState) (unUTxO result)
-              putStrLn @Text "utxo set initialized"
-
-              case fcfMaxStakeKeyIndex config of
-                Nothing -> finish
-                Just count -> do
-                  let
-                    manyStakeKeys :: Map StakeAddress (Word32, SigningKey StakeExtendedKey, StakeCredential)
-                    manyStakeKeys = createManyStakeKeys (fsAcctKey faucetState) (fcfNetwork config) count
-                  queryStakeKeyLoop (fcfNetwork config) (toEraInMode era3 CardanoMode) manyStakeKeys (fcfDebug config) faucetState True
-            Left _e -> Prelude.error "not handled"
-        _ -> Prelude.error "not handled"
-
-txMonitor :: FaucetConfigFile -> LocalTxMonitorClient txid (TxInMode CardanoMode) SlotNo IO a
+                manyStakeKeys :: Map StakeAddress (Word32, SigningKey StakeExtendedKey, StakeCredential)
+                manyStakeKeys = createManyStakeKeys (fsAcctKey faucetState) (fcfNetwork config) count
+              queryStakeKeyLoop (fcfNetwork config) (toEraInMode era3 CardanoMode) manyStakeKeys (fcfDebug config) faucetState True
+        Left _e -> Prelude.error "not handled"
+
+txMonitor :: FaucetConfigFile -> LocalTxMonitorClient txid TxInMode SlotNo IO a
 txMonitor FaucetConfigFile{fcfDebug} = LocalTxMonitorClient $ return $ CTxMon.SendMsgAcquire getSnapshot
   where
-    getSnapshot :: SlotNo -> IO (CTxMon.ClientStAcquired txid1 (TxInMode CardanoMode) SlotNo IO a1)
+    getSnapshot :: SlotNo -> IO (CTxMon.ClientStAcquired txid1 TxInMode SlotNo IO a1)
     getSnapshot _slot = do
       --when fcfDebug $ do
         --putStrLn $ format ("got mempool snapshot at slot " % sh) $ slot
       return $ CTxMon.SendMsgNextTx getNextTx
-    getNextTx :: Show tx => Maybe tx -> IO (CTxMon.ClientStAcquired txid1 (TxInMode CardanoMode) SlotNo IO a1)
+    getNextTx :: Show tx => Maybe tx -> IO (CTxMon.ClientStAcquired txid1 TxInMode SlotNo IO a1)
     getNextTx (Just tx) = do
       when fcfDebug $ do
         putStrLn $ format ("found tx in snapshot: " % sh) $ tx
@@ -353,7 +347,7 @@ main = do
     fsConfig <- parseConfig bar
     Right sockPath <- liftIO $ readEnvSocketPath
     let
-      localNodeConnInfo :: LocalNodeConnectInfo CardanoMode
+      localNodeConnInfo :: LocalNodeConnectInfo
       localNodeConnInfo = LocalNodeConnectInfo defaultCModeParams (fcfNetwork fsConfig) (File sockPath)
 
     liftIO $ connectToLocalNode

cardano-faucet/src/Cardano/Faucet/Web.hs

@@ -12,6 +12,7 @@
 {-# LANGUAGE TypeOperators #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE NumericUnderscores #-}
 
 module Cardano.Faucet.Web (userAPI, server, SiteVerifyRequest(..)) where
 
@@ -293,7 +294,7 @@ handleDelegateStake era FaucetState{fsPaymentSkey,fsUtxoTMVar,fsTxQueue,fsStakeT
               -- get an unused stake key
               stakeKey <- getKeyToDelegate fsStakeTMVar poolId
               -- and get a txout to fund the delegation tx
-              txinout <- findUtxoOfSize fsUtxoTMVar $ Ada $ Lovelace ((fcfDelegationUtxoSize fsConfig) * 1000000)
+              txinout <- findUtxoOfSize fsUtxoTMVar $ Ada $ L.Coin ((fcfDelegationUtxoSize fsConfig) * 1_000_000)
               pure $ Right (stakeKey, txinout)
             RateLimitResultDeny waitPeriod -> throwSTM $ FaucetWebErrorRateLimitExeeeded waitPeriod (serialiseToBech32 poolId)
       -- getKeyToDelegate and findUtxoOfSize can use throwSTM to report an error, and undo the entire atomic action
@@ -411,7 +412,7 @@ handleMetrics FaucetState{fsUtxoTMVar,fsBucketSizes,fsConfig,fsStakeTMVar} = do
       missingUtxo = Map.difference (Map.fromList $ map (\fv -> (fv,0)) fsBucketSizes) stats
       isRequiredSize :: FaucetValue -> Maybe (Text, MetricValue)
       isRequiredSize v = if (elem v fsBucketSizes) then Just ("is_valid",MetricValueInt 1) else Nothing
-      isForDelegation v = if (v == Lovelace ((fcfDelegationUtxoSize fsConfig) * 1000000)) then Just ("for_delegation",MetricValueInt 1) else Nothing
+      isForDelegation v = if (v == L.Coin ((fcfDelegationUtxoSize fsConfig) * 1_000_000)) then Just ("for_delegation",MetricValueInt 1) else Nothing
       valueAttribute :: FaucetValue -> [Maybe (Text, MetricValue)]
       valueAttribute fv = [Just ("lovelace", MetricValueInt l), Just ("ada",MetricValueFloat $ (fromIntegral l) / 1000000)]
         where