temp: fix isOurAddress and add test project

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

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
+

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
 

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
 

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
+
+-}

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