commit fe6daba521ed47be7b5d948b5fb0b076eda46185
parent 8a570aabcad0ad96c96bb946513452eb8ed1404e
Author: Vint Leenaars <vl.software@leenaa.rs>
Date: Wed, 7 May 2025 15:18:04 +0200
Add config to test files
Diffstat:
3 files changed, 107 insertions(+), 95 deletions(-)
diff --git a/test/Tests/Check.hs b/test/Tests/Check.hs
@@ -14,6 +14,7 @@ import Control.Monad (when)
import Data.Map (Map, toList)
import KYCheck.Check
+import KYCheck.Config
import KYCheck.GLS.Type as GLS
import KYCheck.SSL as SSL
import KYCheck.Type
@@ -24,10 +25,10 @@ import Tests.Targets.Fake
import Test.Tasty
import Test.Tasty.HUnit
-tests :: Targets -> TestTree
-tests targets = testGroup "target tests"
- [ personTests (SSL.individuals targets)
- ]
+tests :: Config -> Targets -> TestTree
+tests config targets = testGroup "target tests"
+ [ personTests config (SSL.individuals targets)
+ ]
data Distribution = Distribution
{ threshold_address :: Maybe Float
@@ -41,24 +42,24 @@ data Distribution = Distribution
-- | Test fake target (found in target_SSID.xml, not found in sanction list)
-testFakeTarget :: Bool -> Int -> NaturalPerson -> Map Int Individual -> Distribution -> TestTree
-testFakeTarget verbose number target sanction_list distribution =
+testFakeTarget :: Config -> Bool -> Int -> NaturalPerson -> Map Int Individual -> Distribution -> TestTree
+testFakeTarget config verbose number target sanction_list distribution =
testGroup ("Test fake target " ++ show number)
- [ testSingleTarget verbose number target distribution Nothing
- , dontFindTarget verbose target sanction_list ("target " ++ show number)
+ [ testSingleTarget config verbose number target distribution Nothing
+ , dontFindTarget config verbose target sanction_list ("target " ++ show number)
]
-- | Test real target (found in target_SSID.xml, found in sanction list)
-testTarget :: Bool -> Int -> NaturalPerson -> Map Int Individual -> Distribution -> TestTree
-testTarget verbose number target sanction_list distribution =
+testTarget :: Config -> Bool -> Int -> NaturalPerson -> Map Int Individual -> Distribution -> TestTree
+testTarget config verbose number target sanction_list distribution =
testGroup ("Test target " ++ show number)
- [ testSingleTarget verbose number target distribution Nothing
- , findRealTarget verbose number target distribution sanction_list
+ [ testSingleTarget config verbose number target distribution Nothing
+ , findRealTarget config verbose number target distribution sanction_list
]
-testTargetVersions :: Bool -> Int -> Map Int Individual -> [(NaturalPerson, String, Distribution)] -> TestTree
-testTargetVersions verbose number sanction_list versions =
+testTargetVersions :: Config -> Bool -> Int -> Map Int Individual -> [(NaturalPerson, String, Distribution)] -> TestTree
+testTargetVersions config verbose number sanction_list versions =
withResource getResource (\_ -> pure ()) $ \ssl ->
testGroup ("Test versions of target " ++ show number)
[ testCase "Sanction list parsing" $ do
@@ -69,10 +70,10 @@ testTargetVersions verbose number sanction_list versions =
testGroup "Versions:" $
map (\(target, title, dist) ->
testGroup ("Test target version " ++ title)
- [ testSingleTarget verbose number target dist $ Just ssl
+ [ testSingleTarget config verbose number target dist $ Just ssl
, case (threshold_confidence dist) of
- Nothing -> dontFindTarget verbose target sanction_list ("target " ++ show number)
- _ -> findRealTarget verbose number target dist sanction_list
+ Nothing -> dontFindTarget config verbose target sanction_list ("target " ++ show number)
+ _ -> findRealTarget config verbose number target dist sanction_list
]
) versions
]
@@ -81,8 +82,8 @@ testTargetVersions verbose number sanction_list versions =
return ssl
-- | Find target in sanction list
-findRealTarget :: Bool -> Int -> NaturalPerson -> Distribution -> Map Int Individual -> TestTree
-findRealTarget verbose number target distribution sanction_list =
+findRealTarget :: Config -> Bool -> Int -> NaturalPerson -> Distribution -> Map Int Individual -> TestTree
+findRealTarget config verbose number target distribution sanction_list =
testCase ("Find target " ++ show number ++ " in Swiss Sanction List") $ do
let score = checkPersons sanction_list target
@@ -91,8 +92,8 @@ findRealTarget verbose number target distribution sanction_list =
assertBool ("Should find target " ++ show number ++ ", but found " ++ (show . references) score ++ " instead") (number `elem` references score)
-- | Dont find target in sanction list
-dontFindTarget :: Bool -> NaturalPerson -> Map Int Individual -> String -> TestTree
-dontFindTarget verbose target sanction_list title =
+dontFindTarget :: Config -> Bool -> NaturalPerson -> Map Int Individual -> String -> TestTree
+dontFindTarget config verbose target sanction_list title =
testCase ("Do not find " ++ title ++ " in Swiss Sanction List") $ do
let score = checkPersons sanction_list target
@@ -102,8 +103,8 @@ dontFindTarget verbose target sanction_list title =
-- | Test if target matches target described in target_SSID.xml
-testSingleTarget :: Bool -> Int -> NaturalPerson -> Distribution -> Maybe (IO (Map Int Individual)) -> TestTree
-testSingleTarget verbose number target distribution ssl_target =
+testSingleTarget :: Config -> Bool -> Int -> NaturalPerson -> Distribution -> Maybe (IO (Map Int Individual)) -> TestTree
+testSingleTarget config verbose number target distribution ssl_target =
testCase ("Find target " ++ show number ++ " in test file") $ do
ssl <- case ssl_target of
Just ssl -> ssl
@@ -144,69 +145,74 @@ compareScore maybe_threshold score title =
-- | Test individuals
-personTests :: Map Int Individual -> TestTree
-personTests sanction_list =
- testGroup "Individuals"
- [ testGroup "Known Sanctioned"
- {- testTarget False SSID target_SSID sanction_list $ distribution ADDRESS DATE ID NAME NATIONALITY CONFIDENCE
- MAX_SCORE 150 100 200 125 50 0.75 -}
- [ testTarget False 5144 target_5144 sanction_list $ distribution 125 100 0 125 0 0.9
- , testTarget False 5266 target_5266 sanction_list $ distribution 0 0 0 125 0 0.5
- , testTarget False 43462 target_43462 sanction_list $ distribution 0 100 0 125 0 0.75
- , testTarget False 43616 target_43616 sanction_list $ distribution 0 0 0 125 0 0.75
- , testTarget False 43641 target_43641 sanction_list $ distribution 0 100 0 125 0 0.75
- , testTarget False 43718 target_43718 sanction_list $ distribution 0 100 0 125 0 0.75
- , testTarget False 43662 target_43662 sanction_list $ distribution 0 100 0 125 0 0.75
- , testTarget False 43611 target_43611 sanction_list $ distribution 0 0 0 125 0 0.75
- , testTarget False 29723 target_29723 sanction_list $ distribution 0 100 0 125 0 0.75
- , testTarget False 68815 target_68815 sanction_list $ distribution 75 100 0 125 50 0.75
-
- {- testTargetVersions False SSID sanction_list $
- , (target_SSID_vN, "vN", distribution ADDRESS DATE ID NAME NATIONALITY CONFIDENCE -}
- , testTargetVersions False 49816 sanction_list $
- [ (target_49816_v1, "v1", distribution 0 100 0 125 0 0.75) -- Name and date
- , (target_49816_v2, "v2", distribution 0 100 0 0 0 0 ) -- First name and date
- , (target_49816_v3, "v3", distribution 0 0 0 0 0 0 ) -- Nothing
- , (target_49816_v4, "v4", distribution 0 100 0 125 0 0.75) -- Name
- ]
-
- , testTargetVersions False 38925 sanction_list $
- [ (target_38925_v1, "v1", distribution 100 0 0 0 0 0.75) -- Only address
- , (target_38925_v2, "v2", distribution 0 0 0 125 0 0 ) -- Only name
- , (target_38925_v3, "v3", distribution 0 100 0 0 0 0 ) -- Only birthdate
- , (target_38925_v4, "v4", distribution 100 0 0 0 0 0.75) -- Only address
- , (target_38925_v5, "v5", distribution 100 100 0 125 0 0.75) -- Address + name + birthdate
- ]
-
- , testTargetVersions False 57355 sanction_list $
- [ (target_57355_v1, "v1", distribution 100 100 0 125 50 0.75) -- Name, date and address
- , (target_57355_v2, "v2", distribution 100 100 0 0 50 0.75) -- Alias, date and address
- , (target_57355_v3, "v3", distribution 100 0 0 100 50 0.75) -- Name, address
- , (target_57355_v4, "v4", distribution 0 0 0 100 50 0 ) -- Name with spelling mistake
- , (target_57355_v5, "v5", distribution 0 100 0 100 50 0.75) -- Name with spelling mistake and date
- , (target_57355_v6, "v6", distribution 0 0 0 100 50 0 ) -- Shortened name
- ]
-
- ]
-
- , testGroup "Fake target with XML file"
- {- testFakeTarget False SSID target_SSID sanction_list $ distribution ADDRESS DATE ID NAME NATIONALITY CONFIDENCE
- 150 100 200 125 50 0.75 -}
- [ testFakeTarget False 6 target_6 sanction_list $ distribution 0 100 0 125 0 0.75
- ]
-
- , testGroup "Public and imaginary figures"
- [ dontFindTarget False public_figure_1 sanction_list "Hergé"
- , dontFindTarget False public_figure_2 sanction_list "Bezos"
- , dontFindTarget False public_figure_3 sanction_list "Lincoln"
- , dontFindTarget False public_figure_4 sanction_list "Willem-Alexander"
- , dontFindTarget False public_figure_5 sanction_list "Da Vinci"
- , dontFindTarget False imaginary_figure_1 sanction_list "Smurf"
- , dontFindTarget False imaginary_figure_2 sanction_list "Donald"
- , dontFindTarget False imaginary_figure_3 sanction_list "Wonka"
- , dontFindTarget False imaginary_figure_4 sanction_list "Bilbo"
- , dontFindTarget False imaginary_figure_5 sanction_list "Batman"
- ]
- ]
- where distribution addr date id' name nat conf = Distribution (toMaybe addr) (toMaybe date) (toMaybe id') (toMaybe name) (toMaybe nat) (toMaybe conf)
- toMaybe float = case float of 0 -> Nothing; f -> Just f
+personTests :: Config -> Map Int Individual -> TestTree
+personTests config sanction_list =
+ let
+ testT = testTarget config False
+ testFT = testFakeTarget config False
+ dontFindT = dontFindTarget config False
+ toMaybe float = case float of 0 -> Nothing; f -> Just f
+ distribution addr date id' name nat conf = Distribution (toMaybe addr) (toMaybe date) (toMaybe id') (toMaybe name) (toMaybe nat) (toMaybe conf)
+ in
+ testGroup "Individuals"
+ [ testGroup "Known Sanctioned"
+ {- testTarget False SSID target_SSID sanction_list $ distribution ADDRESS DATE ID NAME NATIONALITY CONFIDENCE
+ MAX_SCORE 150 100 200 125 50 0.75 -}
+ [ testT 5144 target_5144 sanction_list $ distribution 125 100 0 125 0 0.9
+ , testT 5266 target_5266 sanction_list $ distribution 0 0 0 125 0 0.5
+ , testT 43462 target_43462 sanction_list $ distribution 0 100 0 125 0 0.75
+ , testT 43616 target_43616 sanction_list $ distribution 0 0 0 125 0 0.75
+ , testT 43641 target_43641 sanction_list $ distribution 0 100 0 125 0 0.75
+ , testT 43718 target_43718 sanction_list $ distribution 0 100 0 125 0 0.75
+ , testT 43662 target_43662 sanction_list $ distribution 0 100 0 125 0 0.75
+ , testT 43611 target_43611 sanction_list $ distribution 0 0 0 125 0 0.75
+ , testT 29723 target_29723 sanction_list $ distribution 0 100 0 125 0 0.75
+ , testT 68815 target_68815 sanction_list $ distribution 75 100 0 125 50 0.75
+
+ {- testTargetVersions False SSID sanction_list $
+ , (target_SSID_vN, "vN", distribution ADDRESS DATE ID NAME NATIONALITY CONFIDENCE -}
+ , testTargetVersions config False 49816 sanction_list $
+ [ (target_49816_v1, "v1", distribution 0 100 0 125 0 0.75) -- Name and date
+ , (target_49816_v2, "v2", distribution 0 100 0 0 0 0 ) -- First name and date
+ , (target_49816_v3, "v3", distribution 0 0 0 0 0 0 ) -- Nothing
+ , (target_49816_v4, "v4", distribution 0 100 0 125 0 0.75) -- Name
+ ]
+
+ , testTargetVersions config False 38925 sanction_list $
+ [ (target_38925_v1, "v1", distribution 100 0 0 0 0 0.75) -- Only address
+ , (target_38925_v2, "v2", distribution 0 0 0 125 0 0 ) -- Only name
+ , (target_38925_v3, "v3", distribution 0 100 0 0 0 0 ) -- Only birthdate
+ , (target_38925_v4, "v4", distribution 100 0 0 0 0 0.75) -- Only address
+ , (target_38925_v5, "v5", distribution 100 100 0 125 0 0.75) -- Address + name + birthdate
+ ]
+
+ , testTargetVersions config False 57355 sanction_list $
+ [ (target_57355_v1, "v1", distribution 100 100 0 125 50 0.75) -- Name, date and address
+ , (target_57355_v2, "v2", distribution 100 100 0 0 50 0.75) -- Alias, date and address
+ , (target_57355_v3, "v3", distribution 100 0 0 100 50 0.75) -- Name, address
+ , (target_57355_v4, "v4", distribution 0 0 0 100 50 0 ) -- Name with spelling mistake
+ , (target_57355_v5, "v5", distribution 0 100 0 100 50 0.75) -- Name with spelling mistake and date
+ , (target_57355_v6, "v6", distribution 0 0 0 100 50 0 ) -- Shortened name
+ ]
+
+ ]
+
+ , testGroup "Fake target with XML file"
+ {- testFT SSID target_SSID sanction_list $ distribution ADDRESS DATE ID NAME NATIONALITY CONFIDENCE
+ 150 100 200 125 50 0.75 -}
+ [ testFT 6 target_6 sanction_list $ distribution 0 100 0 125 0 0.75
+ ]
+
+ , testGroup "Public and imaginary figures"
+ [ dontFindT public_figure_1 sanction_list "Hergé"
+ , dontFindT public_figure_2 sanction_list "Bezos"
+ , dontFindT public_figure_3 sanction_list "Lincoln"
+ , dontFindT public_figure_4 sanction_list "Willem-Alexander"
+ , dontFindT public_figure_5 sanction_list "Da Vinci"
+ , dontFindT imaginary_figure_1 sanction_list "Smurf"
+ , dontFindT imaginary_figure_2 sanction_list "Donald"
+ , dontFindT imaginary_figure_3 sanction_list "Wonka"
+ , dontFindT imaginary_figure_4 sanction_list "Bilbo"
+ , dontFindT imaginary_figure_5 sanction_list "Batman"
+ ]
+ ]
diff --git a/test/data/test.config.dhall b/test/data/test.config.dhall
@@ -7,7 +7,7 @@
let Verbosity = < Silent | Info | Errors | Debug >
in { verbosity = Verbosity.Silent
- , ssl_location = "files/consolidated-list_2024-07-30.xml"
+ , ssl_location = "test-sanction-list.xml"
, threshold_percentage = 0.8 -- Percentage
, threshold_points = 200 -- Points needed to flag entry as match
, perfect_points = 300 -- Amount of points required to get 100% confidence
diff --git a/test/test-kycheck.hs b/test/test-kycheck.hs
@@ -3,6 +3,8 @@
-- SPDX-License-Identifier: AGPL-3.0-or-later
-- SPDX-License-Identifier: EUPL-1.2
+{-# LANGUAGE OverloadedStrings #-}
+
module Main (main) where
import qualified Tests.Check
@@ -13,11 +15,14 @@ import System.Directory ( getCurrentDirectory, setCurrentDirectory )
import Test.Tasty
import KYCheck.SSL
+import KYCheck.Config
+
+import Dhall
-- | Group all tests
-tests :: Targets -> TestTree
-tests targets = testGroup "Tests" [ Tests.Check.tests targets
- ]
+tests :: Config -> Targets -> TestTree
+tests config targets = testGroup "Tests" [ Tests.Check.tests config targets
+ ]
-- | Function to move testing into right directory
inDirectory :: FilePath -> IO a -> IO a
@@ -30,6 +35,7 @@ inDirectory path action = bracket
main :: IO ()
main = do
inDirectory "test/data" $ do
- targets <- xmlToSSL <$> parseSwissSanctionsList "test-sanction-list.xml"
+ config <- input auto "./test.config.dhall"
+ targets <- xmlToSSL <$> parseSwissSanctionsList (ssl_location config)
- defaultMain (tests targets)
+ defaultMain (tests config targets)
