Add unit test for 'patternFromText'.

Author: KtorZ

.hlint.yaml

@@ -55,6 +55,8 @@
 - ignore: {name: "Use newTMVarIO"}
 - ignore: {name: "Use newEmptyTMVarIO"}
 - ignore: {name: "Use newTVarIO"}
+- ignore: {name: "Use catMaybes"}
+- ignore: {name: "Use head"}
 
 # Add custom hints for this project
 #

kupo.cabal

@@ -36,18 +36,17 @@ library:
   dependencies:
     - aeson
     - base16
+    - base64
     - bech32
     - bech32-th
     - binary
     - bytestring
-    - cardano-binary
     - cardano-crypto-class
     - cardano-ledger-alonzo
     - cardano-ledger-shelley
     - cardano-ledger-shelley-ma
     - cardano-ledger-byron
     - cardano-ledger-core
-    - cardano-protocol-tpraos
     - cardano-slotting
     - containers
     - contra-tracer
@@ -73,6 +72,22 @@ library:
     - unix
     - yaml
 
+tests:
+  unit:
+    main: Spec.hs
+    source-dirs: test
+    ghc-options: *ghc-options-test
+    dependencies:
+    - base
+    - bytestring
+    - containers
+    - hspec
+    - kupo
+    - relude
+    - QuickCheck
+    build-tools:
+    - hspec-discover
+
 executables:
   kupo:
     main: Main.hs

package.yaml

@@ -53,7 +53,7 @@ import Kupo.Data.ChainSync
     , Point (..)
     , SlotNo (..)
     )
-import Kupo.Data.Pattern.Address
+import Kupo.Data.Pattern
     ( Pattern (..), patternFromText )
 import Ouroboros.Consensus.BlockchainTime.WallClock.Types
     ( SystemStart (..) )

src/Kupo/Configuration.hs

@@ -4,7 +4,7 @@
 
 {-# LANGUAGE QuasiQuotes #-}
 
-module Kupo.Data.Pattern.Address
+module Kupo.Data.Pattern
     ( -- * Pattern
       Pattern (..)
     , patternFromText
@@ -22,8 +22,6 @@ import Kupo.Prelude
 
 import Codec.Binary.Bech32.TH
     ( humanReadablePart )
-import Data.ByteString.Base16
-    ( decodeBase16 )
 import Kupo.Data.ChainSync
     ( Address
     , Blake2b_224
@@ -90,10 +88,10 @@ patternFromText txt =
                 if  | payment == wildcard && delegation == wildcard ->
                         pure (MatchAny onlyShelley)
                     | payment == wildcard ->
-                        MatchPayment
+                        MatchDelegation
                             <$> readerCredential delegation
                     | delegation == wildcard ->
-                        MatchDelegation
+                        MatchPayment
                             <$> readerCredential payment
                     | otherwise -> do
                         MatchPaymentAndDelegation

src/Kupo/Data/Pattern/Address.hs src/Kupo/Data/Pattern.hs

@@ -9,8 +9,16 @@ module Kupo.Prelude
     , view
     , (^.)
     , (^?)
+    , encodeBase16
+    , decodeBase16
+    , encodeBase64
+    , decodeBase64
     ) where
 
+import Data.ByteString.Base16
+    ( decodeBase16, encodeBase16 )
+import Data.ByteString.Base64
+    ( decodeBase64, encodeBase64 )
 import Data.Generics.Internal.VL.Lens
     ( view, (^.) )
 import Data.Profunctor.Unsafe

src/Kupo/Prelude.hs

@@ -0,0 +1,91 @@
+-- This Source Code Form is subject to the terms of the Mozilla Public
+-- License, v. 2.0. If a copy of the MPL was not distributed with this
+-- file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+module Kupo.Data.PatternSpec
+    ( spec
+    ) where
+
+import Kupo.Prelude
+
+import Data.List
+    ( (!!) )
+import Kupo.Configuration
+    ( StandardCrypto )
+import Kupo.Data.ChainSync
+    ( Address, addressFromBytes )
+import Kupo.Data.Pattern
+    ( Pattern (..)
+    , includingBootstrap
+    , matching
+    , onlyShelley
+    , patternFromText
+    )
+import Test.Hspec
+    ( Spec, context, parallel, shouldBe, specify )
+
+spec :: Spec
+spec = parallel $ do
+    context "patternFromText" $ forM_ patterns $ \(str, expectation) -> do
+        specify (toString str) $ do
+            patternFromText str `shouldBe` Just expectation
+
+--
+-- Test Vectors
+--
+
+patterns :: [(Text, Pattern StandardCrypto)]
+patterns =
+    [ ( "*"
+      , MatchAny includingBootstrap
+      )
+    , ( "*/*"
+      , MatchAny onlyShelley
+      )
+    , ( "addr1vyc29pvl2uyzqt8nwxrcxnf558ffm27u3d9calxn8tdudjgz4xq9p"
+      , MatchExact (addresses !! 0)
+      )
+    , ( "379bd7fd5493ebb21e199526b1a1b389ddb85cd70fccd4ca169bfdc4f59042ec/*"
+      , MatchPayment (credentials !! 0)
+      )
+    , ( "adec17c2784d97ed403c011ab73aa32bdf74ee10ce44258bf72c256b/*"
+      , MatchPayment (credentials !! 0)
+      )
+    , ( "*/379bd7fd5493ebb21e199526b1a1b389ddb85cd70fccd4ca169bfdc4f59042ec"
+      , MatchDelegation (credentials !! 0)
+      )
+    , ( "*/stake_vkh14hkp0sncfkt76spuqydtww4r900hfmsseezztzlh9sjkkjx6d7q"
+      , MatchDelegation (credentials !! 0)
+      )
+    , ( "addr_vkh14hkp0sncfkt76spuqydtww4r900hfmsseezztzlh9sjkkvjxtmr/\
+        \script1cda3khwqv60360rp5m7akt50m6ttapacs8rqhn5w342z7r35m37"
+      , MatchPaymentAndDelegation (credentials !! 0) (credentials !! 1)
+      )
+    , ( "stake1uyehkck0lajq8gr28t9uxnuvgcqrc6070x3k9r8048z8y5gh6ffgw"
+      , MatchDelegation (credentials !! 2)
+      )
+    , ( "script1cda3khwqv60360rp5m7akt50m6ttapacs8rqhn5w342z7r35m37/*"
+      , MatchPayment (credentials !! 1)
+      )
+    ]
+
+addresses :: [Address StandardCrypto]
+addresses =
+    [ addr
+    | Just addr <- either (const Nothing) addressFromBytes . decodeBase16 <$>
+        [ "6130a2859f5708202cf37187834d34a1d29dabdc8b4b8efcd33adbc6c9"
+        ]
+    ]
+
+credentials :: [ByteString]
+credentials =
+    [ credential
+    | Right credential <- decodeBase16 <$>
+        -- Verification Key Hash
+        [ "adec17c2784d97ed403c011ab73aa32bdf74ee10ce44258bf72c256b"
+        -- Script Hash
+        , "c37b1b5dc0669f1d3c61a6fddb2e8fde96be87b881c60bce8e8d542f"
+        -- Verification Key Hash
+        , "337b62cfff6403a06a3acbc34f8c46003c69fe79a3628cefa9c47251"
+        ]
+    ]

test/Kupo/Data/PatternSpec.hs

@@ -0,0 +1,5 @@
+-- This Source Code Form is subject to the terms of the Mozilla Public
+-- License, v. 2.0. If a copy of the MPL was not distributed with this
+-- file, You can obtain one at http://mozilla.org/MPL/2.0/.
+
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}