temp commit: add minimum amount to reserve an address

client/Main.hs

@@ -221,6 +221,22 @@ currentProfileParser :: Parser ProfileCommand
 currentProfileParser = hsubparser
   ( command "get" (GetCurrentProfile <$> getCurrentProfileInfo)
  <> command "update" (UpdateCurrentProfile <$> updateCurrentProfileInfo)
+ <> command "get-wallet-address" (GetProfileWalletAddress <$> getWalletAddressInfo)
+ <> command "get-balance" (GetProfileBalance <$> getBalanceInfo)
+  )
+
+getBalanceInfo :: ParserInfo Auth
+getBalanceInfo = info authParser
+  ( fullDesc
+  <> header "plutus-certification-client profile get-balance — Get the balance of the current profile"
+  )
+
+
+
+getWalletAddressInfo :: ParserInfo Auth
+getWalletAddressInfo = info authParser
+  ( fullDesc
+  <> header "plutus-certification-client profile get-wallet-address — Get the wallet address of the current profile"
   )
 
 updateCurrentProfileInfo :: ParserInfo UpdateCurrentProfileArgs
@@ -369,6 +385,8 @@ data GetRepositoryInfoArgs = GetGitHubAddressArgs
 data ProfileCommand
     = GetCurrentProfile !Auth
     | UpdateCurrentProfile !UpdateCurrentProfileArgs
+    | GetProfileWalletAddress !Auth
+    | GetProfileBalance !Auth
 
 data UpdateCurrentProfileArgs = UpdateCurrentProfileArgs !Auth !ProfileBody
 
@@ -498,7 +516,12 @@ main = do
       withAuth auth $ \c authKey -> c.getCurrentProfile authKey
     CmdCurrentProfile (UpdateCurrentProfile (UpdateCurrentProfileArgs auth profileBody)) ->
       withAuth auth $ \c authKey -> c.updateCurrentProfile authKey profileBody
+    CmdCurrentProfile (GetProfileWalletAddress auth) ->
+      withAuth auth $ \c authKey -> c.getProfileWalletAddress authKey
+    CmdCurrentProfile (GetProfileBalance auth) ->
+      withAuth auth $ \c authKey -> c.getProfileBalance authKey
     CmdLogin loginBody -> do
       handle $ apiClient.login loginBody
     CmdServerTimestamp ->
       handle $ apiClient.serverTimestamp
+

server/Main.hs

@@ -63,11 +63,15 @@ import Plutus.Certification.ProfileWallet
 import Paths_plutus_certification qualified as Package
 import IOHK.Certification.Persistence qualified as DB
 import Data.HashSet as HashSet
+import Data.Word
 
 import qualified Data.ByteString.Lazy.Char8 as LBS
 import qualified Data.Text as Text
 import System.Environment (lookupEnv)
 
+oneAda :: Word64
+oneAda = 1000000
+
 data Backend
   = Local
   | Cicero !BaseUrl
@@ -81,6 +85,7 @@ data Args = Args
   , auth :: !AuthMode
   , signatureTimeout :: !Seconds
   , useWhitelist :: !Bool
+  , minAmountForAddressAssessment :: !Word64
   }
 
 baseUrlReader :: ReadM BaseUrl
@@ -138,6 +143,13 @@ argsParser =  Args
       )
   <*> switch
       ( long "use-whitelist" <> help "use the whitelist for authentication" )
+  <*> option auto
+      ( long "min-amount-for-address-assessment"
+     <> metavar "MIN_AMOUNT"
+     <> help "the minimum amount of Lovelace required to perform an address assessment"
+     <> showDefault
+     <> Opts.value oneAda
+      )
 
 data AuthMode = JWTAuth JWTArgs | PlainAddressAuth
 
@@ -360,7 +372,9 @@ main = do
       whitelist <- if not args.useWhitelist then pure Nothing else Just <$> whitelisted
       addressRotation <- liftIO $ newMVar emptyAddressRotation
       _ <- initDb
-      _ <- forkIO $ startTransactionsMonitor (narrowEventBackend InjectSynchronizer eb) (args.wallet) 10
+      _ <- forkIO $ startTransactionsMonitor
+             (narrowEventBackend InjectSynchronizer eb)
+             (args.wallet) 10 (args.minAmountForAddressAssessment)
       -- TODO: this has to be refactored
       runSettings settings . application (narrowEventBackend InjectServeRequest eb) $
         cors (const $ Just corsPolicy) .

src/Plutus/Certification/ProfileWallet.hs

@@ -201,9 +201,10 @@ type WalletBackend m r = EventBackend m r ProfileWalletSyncSelector
 resyncWallets :: (MonadIO m,MonadMask m)
               => WalletBackend m r
               -> WalletArgs
+              -> Word64
               -> PrevAssignments
               -> m PrevAssignments
-resyncWallets eb wargs prevAssignments = withEvent eb ResyncWallets \ev -> do
+resyncWallets eb wargs minAmount prevAssignments = withEvent eb ResyncWallets \ev -> do
   -- fetch the db transactions and create wallets
   (errors,trans) <- DB.withDb ( DB.getAllTransactions False )
     <&> (lefts &&& rights) . fmap fromDbTransaction'
@@ -220,7 +221,7 @@ resyncWallets eb wargs prevAssignments = withEvent eb ResyncWallets \ev -> do
   reassignOverlappingAddresses eb wargs profileWallets prevAssignments
 
   where
-  fromDbTransaction' = uncurry (fromDbTransaction isOurAddress)
+  fromDbTransaction' = uncurry (fromDbTransaction isOurAddress minAmount)
   mainHash = hash wargs.walletAddress
   hash = Sig.bech32AddressHash . Sig.Bech32Address
   isOurAddress = (== mainHash) . hash
@@ -319,10 +320,10 @@ reassignOverlappingAddresses eb wargs profileWallets prevAssignments = do
       Right prevAddress -> return prevAddress
   isOverlappingAddress :: ProfileWallet -> Bool
   isOverlappingAddress (ProfileWallet (Overlapping,address) profileAddress _) =
-    let isAlreadyAssigned =
-          any (\Assignment{..} -> assgnOverlappingAddress == address
-                               && assgnProfileAddress == profileAddress
-              ) prevAssignments
+    let isAlreadyAssigned = any
+          (\Assignment{..} -> assgnOverlappingAddress == address
+                           && assgnProfileAddress == profileAddress
+          ) prevAssignments
     in not isAlreadyAssigned
   isOverlappingAddress _ = False
   wasAssignedBefore :: Wallet.WalletAddressInfo -> Bool
@@ -334,27 +335,30 @@ reassignOverlappingAddresses eb wargs profileWallets prevAssignments = do
 
 -- | Transform a transaction coming from the database into a `Transaction`
 fromDbTransaction :: (Text -> Bool)
+                  -> Word64
                   -> DB.MinimalTransaction
                   -> [DB.MinimalTransactionEntry]
                   -> Either String Transaction
-fromDbTransaction isOurAddress DB.MinimalTransaction{..} entries =
+fromDbTransaction isOurAddress minAmount DB.MinimalTransaction{..} entries =
   case (paymentMetadata,addressAssignmentMetadata,firstOutWalletAddress) of
     -- address assignment
     (_,Right (AddressAssignmentMetadata address),Just walletAddress)
       | mtxAmount < 0 && not (isOurAddress address)
-        -> Right $ WalletAddressAssignment (ProfileAddress address) walletAddress
-      | isOurAddress address -> Left "Address assignment should belong to our wallet"
-      | otherwise -> Left "Address assignment transaction must be a withdrawal"
+          -> Right $ WalletAddressAssignment (ProfileAddress address) walletAddress
+      | isOurAddress address
+          -> Left "Address assignment shouldn't belong to our wallet"
+      | otherwise
+          -> Left "Address assignment transaction must be a withdrawal"
 
     (_,Right (AddressAssignmentMetadata _),Nothing) ->
       Left "InternalError: no wallet address found for address assignment"
 
     (Right (PayerMetadata address),_,Just walletAddress)
-      | mtxAmount > 0 && not (isOurAddress address)
-        -> Right $ DesignatedPayment (ProfileAddress address)
+      | mtxAmount >= fromIntegral minAmount && not (isOurAddress address)
+          -> Right $ DesignatedPayment (ProfileAddress address)
             walletAddress (fromIntegral mtxAmount)
-      | isOurAddress address ->
-        Left "Payer address should not belong to our wallet"
+      | isOurAddress address
+          -> Left "Payer address should not belong to our wallet"
 
     (_,_,Just walletAddress)
       | mtxAmount > 0 -> Right $ SimplePayment walletAddress (fromIntegral mtxAmount)

src/Plutus/Certification/Synchronizer.hs

@@ -39,6 +39,7 @@ import Observe.Event.Backend
 import Observe.Event
 import Plutus.Certification.ProfileWallet
 import Data.IORef
+import Data.Word (Word64)
 
 data InitializingField
   = WalletArgsField WalletArgs
@@ -154,9 +155,10 @@ fromInputToDbInput (TxInput index _ (Just TxOutput{..})) = Just $ DB.Transaction
 monitorWalletTransactions :: (MonadIO m, MonadMask m,MonadError IOException m)
                           => EventBackend m r SynchronizerSelector
                           -> WalletArgs
+                          -> Word64
                           -> IORef PrevAssignments
                           -> m ()
-monitorWalletTransactions eb args refAssignments = withEvent eb MonitorTransactions $ \ev -> do
+monitorWalletTransactions eb args minAssignmentAmount refAssignments = withEvent eb MonitorTransactions $ \ev -> do
   -- fetch the list of transactions from the wallet
   -- TODO: fetch only the transactions that are not in the database
   -- or starting from the first pending transaction
@@ -165,7 +167,7 @@ monitorWalletTransactions eb args refAssignments = withEvent eb MonitorTransacti
   synchronizeDbTransactions transactions
   -- synchronize wallets
   liftIO (readIORef refAssignments)
-    >>= resyncWallets (narrowEventBackend InjectProfileWalletSync eb) args
+    >>= resyncWallets (narrowEventBackend InjectProfileWalletSync eb) args minAssignmentAmount
     >>= liftIO . writeIORef refAssignments
 
 
@@ -233,15 +235,16 @@ startTransactionsMonitor :: (MonadIO m,MonadMask m,MonadError IOException m)
                          => EventBackend m r SynchronizerSelector
                          -> WalletArgs
                          -> Int
+                         -> Word64
                          -> m b
-startTransactionsMonitor eb args delayInSeconds = withEvent eb InitializingSynchronizer $ \ev -> do
+startTransactionsMonitor eb args delayInSeconds minAssignmentAmount = withEvent eb InitializingSynchronizer $ \ev -> do
   addField ev $ WalletArgsField args
   addField ev $ DelayField delayInSeconds
   -- TODO maybe a forkIO here will be better than into the calling function
   -- hence, now, the parent instrumentation event will never terminate
   ref <- liftIO $ newIORef []
   forever $ do
-    monitorWalletTransactions (subEventBackend ev) args ref
+    monitorWalletTransactions (subEventBackend ev) args minAssignmentAmount ref
     liftIO $ threadDelay delayInMicroseconds
   where
     delayInMicroseconds = delayInSeconds * 1000000