commit 65e5c74fa6f6642dda29c827e3678474a8169982
parent 28ab4fadc2e0315698e1b852c51a4b2f96301c7b
Author: Gust Leenaars <gl.nlnet@leenaa.rs>
Date: Sun, 4 May 2025 17:30:41 +0200
Improve testsuite
Diffstat:
3 files changed, 102 insertions(+), 13 deletions(-)
diff --git a/test/Tests/Check.hs b/test/Tests/Check.hs
@@ -23,15 +23,6 @@ tests targets = testGroup "target tests"
[ personTests (SSL.individuals targets)
]
-personTests :: Map Int Individual -> TestTree
-personTests map_ind = testGroup "person"
- [ testTarget False 5144 target_5144 map_ind $ distribution 125 100 0 125 0 0.9
- , testTarget True 5266 target_5266 map_ind $ distribution 0 0 0 125 0 0.5
- , testTarget False 49816 target_49816 map_ind $ distribution 0 100 0 125 0 0.75
- ]
- 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
-
data Distribution = Distribution
{ threshold_address :: Maybe Float
, threshold_date :: Maybe Float
@@ -41,9 +32,17 @@ data Distribution = Distribution
, threshold_confidence :: Maybe Float
} deriving (Show, Eq)
+testTrusted :: Bool -> NaturalPerson -> Map Int Individual -> String -> TestTree
+testTrusted verbose person sanction_list title = testCase ("Do not find " ++ title) $ do
+ let score = checkPersons sanction_list person
+
+ when verbose $ print score
+ compareScore (Just 0) (confidence score) "Score"
+ assertBool "Should not have found any match" ([] == references score)
+
testTarget :: Bool -> Int -> NaturalPerson -> Map Int Individual -> Distribution -> TestTree
testTarget verbose number target ind_map distribution =
- testGroup ("test target " ++ show number)
+ testGroup ("Test target " ++ show number)
[ testPerfectTarget verbose (show number) target distribution
, findPerfectTarget verbose number target distribution ind_map
]
@@ -54,7 +53,7 @@ findPerfectTarget verbose number target distribution ind_map = testCase ("Find t
when verbose $ print score
compareScore (threshold_confidence distribution) (confidence score) "Score"
- assertBool ("should find target" ++ show number) (number `elem` references score)
+ assertBool ("Should find target " ++ show number) (number `elem` references score)
testPerfectTarget :: Bool -> String -> NaturalPerson -> Distribution -> TestTree
testPerfectTarget verbose number target distribution = testCase ("Find target " ++ number ++ " in test file") $ do
@@ -91,6 +90,23 @@ compareScore maybe_threshold score title =
Just pts -> assertBool (title ++ " should return >= " ++ show pts ++ " points") (score >= pts)
Nothing -> assertBool (title ++ " should return 0 points" ) (score == 0 )
+personTests :: Map Int Individual -> TestTree
+personTests map_ind = testGroup "Individuals"
+ [ testGroup "Known Sanctioned"
+-- testTarget False SSID target_SSID map_ind $ distribution ADDRESS DATE ID NAME NATIONALITY CONFIDENCE
+-- MAX_SCORE 150 100 200 125 50 0.75
+ [ testTarget False 5144 target_5144 map_ind $ distribution 125 100 0 125 0 0.9
+ , testTarget False 5266 target_5266 map_ind $ distribution 0 0 0 125 0 0.5
+ , testTarget False 49816 target_49816 map_ind $ distribution 0 100 0 125 0 0.75
+ , testTarget False 43462 target_43462 map_ind $ distribution 0 100 0 125 0 0.75
+ ]
+ , testGroup "Public and imaginary figures"
+ [ testTrusted False public_figure_1 map_ind "Hergé"
+ ]
+ ]
+ 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
+
-- target :: NaturalPerson
-- target = NaturalPerson
-- { full_name =
@@ -138,7 +154,7 @@ target_5266 = NaturalPerson
, national_id = "012345ABCDEF"
, residential = GLS.Address { GLS.country = RU
, street_name = "Non existent"
- , street_number = "0"
+ , street_number = "Non existent"
, GLS.lines = Nothing
, building_name = Nothing
, building_number = Nothing
@@ -168,3 +184,43 @@ target_49816 = NaturalPerson
, country_subdivision = Just "Krasnodar Krai"
}
}
+
+target_43462 :: NaturalPerson
+target_43462 = NaturalPerson
+ { full_name = "Aleksandr Petrovich Barsukov"
+ , last_name = "Barsukov"
+ , birthdate = YearMonthDay 1965 04 29
+ , nationality = BY
+ , national_id = "012345ABCDEF"
+ , residential = GLS.Address { GLS.country = BY
+ , street_name = "Non existent"
+ , street_number = "Non existent"
+ , GLS.lines = Nothing
+ , building_name = Nothing
+ , building_number = Nothing
+ , zipcode = "Non existent"
+ , town_location = Nothing
+ , town_district = Nothing
+ , country_subdivision = Nothing
+ }
+ }
+
+public_figure_1 :: NaturalPerson
+public_figure_1 = NaturalPerson
+ { full_name = "Georges Prosper Remi"
+ , last_name = "Remi"
+ , birthdate = YearMonthDay 1907 05 22
+ , nationality = BE
+ , national_id = "012345ABCDEF"
+ , residential = GLS.Address { GLS.country = BE
+ , street_name = "Non existent"
+ , street_number = "Non existent"
+ , GLS.lines = Nothing
+ , building_name = Nothing
+ , building_number = Nothing
+ , zipcode = "Non existent"
+ , town_location = Just "Etterbeek"
+ , town_district = Just "Bruxelles"
+ , country_subdivision = Just "Brussels"
+ }
+ }
diff --git a/test/data/target_43462.xml b/test/data/target_43462.xml
@@ -0,0 +1,33 @@
+<swiss-sanctions-list list-type="whole-list" date="2024-07-30">
+ <target ssid="43458">
+ <sanctions-set-id>4387</sanctions-set-id>
+ <individual>
+ <identity ssid="43462" main="true">
+ <name ssid="43465" name-type="primary-name" quality="good" lang="eng">
+ <name-part order="1" name-part-type="family-name">
+ <value>Barsukou</value>
+ <spelling-variant lang="RUS" script="LATN" spelling-variant-type="not-defined">Barsukov</spelling-variant>
+ <spelling-variant lang="BEL" script="CYRL" spelling-variant-type="not-defined">БАРСУКОЎ</spelling-variant>
+ <spelling-variant lang="RUS" script="CYRL" spelling-variant-type="not-defined">БАРСУКОВ</spelling-variant>
+ </name-part>
+ <name-part order="2" name-part-type="given-name">
+ <value>Aliaksandr</value>
+ <spelling-variant lang="RUS" script="LATN" spelling-variant-type="not-defined">Aleksandr</spelling-variant>
+ <spelling-variant lang="BEL" script="CYRL" spelling-variant-type="not-defined">Аляксандр</spelling-variant>
+ <spelling-variant lang="RUS" script="CYRL" spelling-variant-type="not-defined">Александр</spelling-variant>
+ </name-part>
+ <name-part order="3" name-part-type="father-name">
+ <value>Piatrovich</value>
+ <spelling-variant lang="RUS" script="LATN" spelling-variant-type="not-defined">Petrovich</spelling-variant>
+ <spelling-variant lang="BEL" script="CYRL" spelling-variant-type="not-defined">Пятровiч</spelling-variant>
+ <spelling-variant lang="RUS" script="CYRL" spelling-variant-type="not-defined">Петрович</spelling-variant>
+ </name-part>
+ </name>
+ <day-month-year ssid="43463" day="29" month="4" year="1965" calendar="Gregorian" quality="good"/>
+ <place-of-birth ssid="43464" place-id="43461" quality="good"/>
+ </identity>
+ <justification ssid="43459">In his leadership position as Deputy Minister of the Ministry of Internal Affairs (MoIA), he is responsible for the repression and intimidation campaign led by MoIA forces in the wake of the 2020 presidential election, in particular with arbitrary arrests and ill-treatment, including torture, of peaceful demonstrators as well as intimidation and violence against journalists.</justification>
+ <other-information ssid="43460">Deputy Minister of the Ministry of Internal Affairs, Major-General of Militia (police force)</other-information>
+ </individual>
+ </target>
+</swiss-sanctions-list>
diff --git a/test/test-kyc.hs b/test/test-kyc.hs
@@ -26,6 +26,6 @@ inDirectory path action = bracket
main :: IO ()
main = do
inDirectory "test/data" $ do
- targets <- xmlToSSL <$> parseSwissSanctionsList "all.xml"
+ targets <- xmlToSSL <$> parseSwissSanctionsList "ssl.xml"
defaultMain (tests targets)
