From 10f8898ab2ba5952dda6ec4dc64f751b0b5f4074 Mon Sep 17 00:00:00 2001 From: Bogdan Manole Date: Wed, 23 Aug 2023 14:49:42 +0300 Subject: [PATCH] temp: fix isOurAddress and add test project --- .../Certification/SignatureVerification.hs | 1 + plutus-certification.cabal | 14 +++++++++ src/Plutus/Certification/ProfileWallet.hs | 31 ++++++++++++++----- src/Plutus/Certification/Synchronizer.hs | 21 ++++++++----- test/ProfileWalletSpec.hs | 21 +++++++++++++ test/Spec.hs | 17 ++++++++++ 6 files changed, 91 insertions(+), 14 deletions(-) create mode 100644 test/ProfileWalletSpec.hs create mode 100644 test/Spec.hs diff --git a/dapps-certification-signature-verification/src/IOHK/Certification/SignatureVerification.hs b/dapps-certification-signature-verification/src/IOHK/Certification/SignatureVerification.hs index a9a36013..ad1e1ba1 100644 --- a/dapps-certification-signature-verification/src/IOHK/Certification/SignatureVerification.hs +++ b/dapps-certification-signature-verification/src/IOHK/Certification/SignatureVerification.hs @@ -9,6 +9,7 @@ module IOHK.Certification.SignatureVerification , encodeHex , decodeHex , bech32AddressHash + , HashError(..) ) where import IOHK.Certification.SignatureVerification.CBOR as CBOR diff --git a/plutus-certification.cabal b/plutus-certification.cabal index cecc6019..45e55be1 100644 --- a/plutus-certification.cabal +++ b/plutus-certification.cabal @@ -148,3 +148,17 @@ executable plutus-certification-client main-is: Main.hs hs-source-dirs: client default-language: Haskell2010 + +test-suite plutus-certification-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + hs-source-dirs: test + other-modules: + ProfileWalletSpec + build-depends: + base >= 4.14.3 && < 4.18 + , hspec + , QuickCheck + , plutus-certification + , text + diff --git a/src/Plutus/Certification/ProfileWallet.hs b/src/Plutus/Certification/ProfileWallet.hs index e599624e..f976ebaf 100644 --- a/src/Plutus/Certification/ProfileWallet.hs +++ b/src/Plutus/Certification/ProfileWallet.hs @@ -29,7 +29,7 @@ import Data.List import Control.Monad as M import Control.Lens.Internal.CTypes (Word64) import Data.Text (Text) -import Conduit (MonadIO) +import Conduit (MonadIO (liftIO)) import Control.Arrow import Data.Functor import Control.Monad.Catch (MonadMask) @@ -44,7 +44,6 @@ import Data.Function import qualified Plutus.Certification.WalletClient as Wallet import qualified IOHK.Certification.Persistence as DB -import qualified IOHK.Certification.SignatureVerification as Sig import qualified Data.Vector as V import qualified Data.Text.Encoding as T import qualified Data.Map as Map @@ -202,10 +201,11 @@ type WalletBackend m r = EventBackend m r ProfileWalletSyncSelector resyncWallets :: (MonadIO m,MonadMask m,MonadReader env m,HasDb env) => WalletBackend m r -> WalletArgs + -> (Text -> Bool) -> Word64 -> PrevAssignments -> m PrevAssignments -resyncWallets eb wargs minAmount prevAssignments = withEvent eb ResyncWallets \ev -> do +resyncWallets eb wargs ourAddress minAmount prevAssignments = withEvent eb ResyncWallets \ev -> do -- fetch the db transactions and create wallets (errors,trans) <- withDb ( DB.getAllTransactions False ) <&> (lefts &&& rights) . fmap fromDbTransaction' @@ -222,15 +222,32 @@ resyncWallets eb wargs minAmount prevAssignments = withEvent eb ResyncWallets \e reassignOverlappingAddresses eb wargs profileWallets prevAssignments where - fromDbTransaction' = uncurry (fromDbTransaction isOurAddress minAmount) - mainHash = hash wargs.walletAddress - hash = Sig.bech32AddressHash . Sig.Bech32Address - isOurAddress = (== mainHash) . hash + fromDbTransaction' = uncurry (fromDbTransaction ourAddress minAmount) + countTransactions = foldl' (\(a,b,c) -> \case SimplePayment{} -> (a+1,b,c) DesignatedPayment{} -> (a,b+1,c) WalletAddressAssignment{} -> (a,b,c+1) ) (0,0,0) + + +{- +>>> hash "addr_test1qphgqts20fhx0yx7ug42xehcnryukchy5k7hpaksgxax2fzt5w2gu33s8wrw3c9tjs97dr5pulsvf39e56v7c9ar39asptcrtp" +Right "6e802e0a7a6e6790dee22aa366f898c9cb62e4a5bd70f6d041ba6524" + +>>> addr2 = "addr_test1qql086jk0tlggvk6yxdkndsusk5ukp799spddm9kv4mmlzjt5w2gu33s8wrw3c9tjs97dr5pulsvf39e56v7c9ar39asqf3an7" :: Text +>>> addr3 = "addr_test1qzckmdsshwr3a540zl63vtdqsqc69fm3mgnu2tu2m64tn62t5w2gu33s8wrw3c9tjs97dr5pulsvf39e56v7c9ar39aspjgn83" :: Text +>>> hash addr2 +Right "3ef3ea567afe8432da219b69b61c85a9cb07c52c02d6ecb66577bf8a" +>>> hash addr3 +Right "b16db610bb871ed2af17f5162da08031a2a771da27c52f8adeaab9e9" + +>>> Sig.Bech32Address addr2 +Bech32Address {unBech32Address = "addr_test1qql086jk0tlggvk6yxdkndsusk5ukp799spddm9kv4mmlzjt5w2gu33s8wrw3c9tjs97dr5pulsvf39e56v7c9ar39asqf3an7"} + +-} + + -------------------------------------------------------------------------------- -- | ADDRESS ASSIGNMENT DISSEMINATION diff --git a/src/Plutus/Certification/Synchronizer.hs b/src/Plutus/Certification/Synchronizer.hs index 85ec63c2..3b5b0433 100644 --- a/src/Plutus/Certification/Synchronizer.hs +++ b/src/Plutus/Certification/Synchronizer.hs @@ -30,9 +30,6 @@ import Plutus.Certification.CertificationBroadcaster import Observe.Event.Render.JSON import Control.Exception import Observe.Event.Crash - -import qualified IOHK.Certification.Persistence as DB - import Data.Function (on) import Data.UUID (UUID) import Control.Monad.Except @@ -46,6 +43,10 @@ import Observe.Event.BackendModification (setAncestor) import Plutus.Certification.ProfileWallet import Data.IORef import Data.Word (Word64) +import qualified Data.HashSet as HashSet + +import qualified Plutus.Certification.WalletClient as Wallet +import qualified IOHK.Certification.Persistence as DB data InitializingField = WalletArgsField WalletArgs @@ -183,18 +184,24 @@ monitorWalletTransactions eb args minAssignmentAmount refAssignments = withEvent synchronizeDbTransactions transactions activateSubscriptions (subEventBackend ev) -- synchronize wallets + isOurAddress <- getIsOurAddress liftIO (readIORef refAssignments) - >>= resyncWallets (narrowEventBackend InjectProfileWalletSync eb) args minAssignmentAmount + >>= resyncWallets (narrowEventBackend InjectProfileWalletSync eb) args isOurAddress minAssignmentAmount >>= liftIO . writeIORef refAssignments certifyRuns (subEventBackend ev) args where -- handle the response from the wallet - -- TODO: crash the server if the connection with the wallet is lost handleResponse (Left err) = do - liftIO $ putStrLn $ "Error while fetching transactions: " ++ show err - return [] + throwError (userError $ "Error while fetching transactions: " ++ show err) handleResponse (Right transactions) = return transactions + getIsOurAddress = do + resp <- liftIO $ Wallet.getWalletAddresses args Nothing + case resp of + Left err -> throwError (userError $ "Error while fetching addresses: " ++ show err) + Right addresses -> do + let set = HashSet.fromList $ map addressId addresses + return $ \addr -> HashSet.member addr set type CertificationProcess m = DB.ProfileId -> UUID -> m DB.L1CertificationDTO diff --git a/test/ProfileWalletSpec.hs b/test/ProfileWalletSpec.hs new file mode 100644 index 00000000..8babd430 --- /dev/null +++ b/test/ProfileWalletSpec.hs @@ -0,0 +1,21 @@ +{-# LANGUAGE OverloadedStrings #-} +module ProfileWalletSpec () where + +import Test.Hspec +import Test.QuickCheck +import Control.Exception (evaluate) +import Plutus.Certification.ProfileWallet +import Control.Monad (forM, forM_) +import Data.Text + +{- +mainAddress :: Text +mainAddress = "addr_test1qphgqts20fhx0yx7ug42xehcnryukchy5k7hpaksgxax2fzt5w2gu33s8wrw3c9tjs97dr5pulsvf39e56v7c9ar39asptcrtp" +spec = + describe "Wallet address" $ do + forM_ ["addr_test1qql086jk0tlggvk6yxdkndsusk5ukp799spddm9kv4mmlzjt5w2gu33s8wrw3c9tjs97dr5pulsvf39e56v7c9ar39asqf3an7"] + $ \addr -> do + it "returns the first element of a list" $ + sameWallet mainAddress addr `shouldBe` True + +-} diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 00000000..fbd7958c --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1,17 @@ +import Test.Hspec +import Test.QuickCheck +import Control.Exception (evaluate) +--import qualified ProfileWalletSpec as ProfileWallet + +main :: IO () +main = hspec $ do + describe "Prelude.head" $ do + it "returns the first element of a list" $ do + head [23 ..] `shouldBe` (23 :: Int) + + it "returns the first element of an *arbitrary* list" $ + property $ \x xs -> head (x:xs) == (x :: Int) + + it "throws an exception if used with an empty list" $ do + evaluate (head []) `shouldThrow` anyException + --ProfileWallet.spec