commit 800f184698ba15ffbad1e479b21e1b03cb23e752
parent 4aebf67215006ffb494dc7b6195d639d034e85a0
Author: Vint Leenaars <vl.software@leenaa.rs>
Date: Thu, 8 May 2025 14:37:56 +0200
Remove hardcoded threshold values
Diffstat:
10 files changed, 195 insertions(+), 198 deletions(-)
diff --git a/README.md b/README.md
@@ -11,7 +11,7 @@ KYCheck is a Counter Terrorist Financing (CTF) tool written in Haskell.
Uses data from the Swiss [State Secretariat for Economic Affairs](https://www.seco.admin.ch/) (SECO)
-Most recent XML sanction list can be found [here](https://www.sesam.search.admin.ch/sesam-search-web/pages/downloadXmlGesamtliste.xhtml?lang=en&action=downloadXmlGesamtlisteAction)
+Most recent [XML sanction list](https://www.sesam.search.admin.ch/sesam-search-web/pages/downloadXmlGesamtliste.xhtml?lang=en&action=downloadXmlGesamtlisteAction) can be found here.
## Installation
diff --git a/app/Main.hs b/app/Main.hs
@@ -11,8 +11,11 @@ import Control.Exception
import Control.Monad (when)
import Data.Time
+import qualified Data.Text as T
+import Dhall
import KYCheck.Config
+import KYCheck.Error
import KYCheck.SSL
import KYCheck.SSL.XML.Type
import KYCheck.Type
@@ -20,8 +23,8 @@ import KYCheck.Type
import Options.Applicative (execParser)
import System.Directory
+import System.FilePath
-import Dhall
getJSON :: Targets -> IO ()
getJSON sanction_list = do
@@ -44,18 +47,21 @@ main = do
dhall <- input auto "./config.dhall" :: IO DhallConfig
let config = inputToConfig dhall $ Just cl
-
valid_config <- checkConfig config
let v = verbosity config
- start <- getCurrentTime
- when (v > Silent) $ print $ "Starting at: " ++ show start
+ case valid_config of
+ False -> return ()
+ True -> do start <- getCurrentTime
+ when (v > Silent) $ print $ "Starting at: " ++ show start
- sanction_list <- try $ parseSwissSanctionsList (ssl_location config) :: IO (Either SomeException SwissSanctionsList)
+ sanction_list <- try $ parseSwissSanctionsList (ssl_location config) :: IO (Either SomeException SwissSanctionsList)
- case sanction_list of
- Left err -> do print err
- Right xml -> do getJSON $ xmlToSSL xml
- time_to_parse_ssl <- getCurrentTime
- print $ "Time to parse sanctions: " ++ (show $ diffUTCTime time_to_parse_ssl start)
+ case sanction_list of
+ Left err -> do curr_dir <- getCurrentDirectory
+ _ <- handleError v $ Left $ KYCheck_InvalidXML (T.pack $ curr_dir </> ssl_location config) (show err)
+ return ()
+ Right xml -> do getJSON $ xmlToSSL xml
+ time_to_parse_ssl <- getCurrentTime
+ print $ "Time to parse sanctions: " ++ (show $ diffUTCTime time_to_parse_ssl start)
diff --git a/config.dhall b/config.dhall
@@ -6,14 +6,14 @@
-- Verbosity levels
let Verbosity = < Test | Silent | Info | Errors | Debug >
-in { verbosity = Verbosity.Silent
- , ssl_location = "files/consolidated-list_2024-07-30.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
- , points_address = 150
- , points_date = 100
- , points_id = 200
- , points_name = 125
- , points_nationality = 50
+in { verbosity = Verbosity.Silent
+ , ssl_location = "files/consolidated-list_2024-07-30.xml"
+ , threshold_ratio = 0.8 -- Percentage
+ , threshold_points = 200 -- Points needed to flag entry as match
+ , perfect_points = 300 -- Amount of points required to get 100% confidence
+ , points_address = 150
+ , points_date = 100
+ , points_id = 200
+ , points_name = 125
+ , points_nationality = 50
}
diff --git a/src/KYCheck/Check.hs b/src/KYCheck/Check.hs
@@ -31,7 +31,6 @@ import Data.Text.Metrics
import Data.Time.Calendar
import Data.Time.Calendar.OrdinalDate
-import KYCheck.Config
import KYCheck.Type
import KYCheck.SSL.Type as SSL
import KYCheck.GLS.Type as GLS
@@ -45,15 +44,6 @@ data Score = Score
, references :: [Int]
} deriving (Show, Eq)
-threshold_ratio :: Ratio Int
-threshold_ratio = 4 % 5
-
-threshold_float :: Float
-threshold_float = 0.8
-
--- threshold_points :: Float
--- threshold_points = 200
-
suspicious_dates :: (Int, Int)
suspicious_dates = (3, 75) -- Difference in years and days that will be marked suspicious (exponential)
@@ -74,20 +64,21 @@ findMatchingEntities :: Config -> LegalEntity -> [(Int, Entity)] -> [(Float, Int
findMatchingEntities _ _ [] = []
findMatchingEntities config entity ((ssid,ent):ents) =
let
- points = compareEntity entity ent
+ points = compareEntity config entity ent
score = if points >= 300 then 1 else points / 300
in
if points >= threshold_points config
then (score,ssid):findMatchingEntities config entity ents
else findMatchingEntities config entity ents
-compareEntity :: LegalEntity -> Entity -> Float
-compareEntity legal_entity entity = foldl1 (+) [ multFloats 300 address_score (removeQuality . removeSSID)
- , multFloats 300 name_score (removeQuality . removeSSID)
- -- , multFloats 300 info_score removeSSID
- ]
- where address_score = checkAddress (entity_addresses entity) (address legal_entity)
- name_score = checkNames (entity_names entity) (company_name legal_entity)
+compareEntity :: Config -> LegalEntity -> Entity -> Float
+compareEntity config legal_entity entity =
+ foldl1 (+) [ multFloats 300 address_score (removeQuality . removeSSID)
+ , multFloats 300 name_score (removeQuality . removeSSID)
+ -- , multFloats 300 info_score removeSSID
+ ]
+ where address_score = checkAddress config (entity_addresses entity) (address legal_entity)
+ name_score = checkNames config (entity_names entity) (company_name legal_entity)
-- info_score = ...
@@ -104,12 +95,12 @@ checkPersons' :: Config -> NaturalPerson -> (Float, [Int]) -> [(Int, Individual)
checkPersons' _ _ score [] = score
checkPersons' config person (score, ssids) ((ssid,ind):inds) =
let
- points = checkPerson person ind
- max_points = foldl1 (+) [ if toList (addresses ind) == [] then 0 else points_address config
- , if toList (birth_dates ind) == [] then 0 else points_date config
- , if toList (ids ind) == [] then 0 else points_id config
- , if toList (names ind) == [] then 0 else points_name config
- , if toList (nationalities ind) == [] then 0 else points_nationality config
+ points = checkPerson config person ind
+ max_points = foldl1 (+) [ if toList (addresses ind) == [] then 0 else weight_address config
+ , if toList (birth_dates ind) == [] then 0 else weight_date config
+ , if toList (ids ind) == [] then 0 else weight_id config
+ , if toList (names ind) == [] then 0 else weight_name config
+ , if toList (nationalities ind) == [] then 0 else weight_nationality config
]
new_score = if max_points >= threshold_points config
then if points >= 300 then 1 else points / 300
@@ -119,20 +110,20 @@ checkPersons' config person (score, ssids) ((ssid,ind):inds) =
then checkPersons' config person (max score new_score, ssid:ssids) inds
else checkPersons' config person (score, ssids) inds
-checkPerson :: NaturalPerson -> Individual -> Float
-checkPerson person individual = foldl1 (+) [ address_points
- , multFloats 200 id_score removeSSID
- , multFloats 100 date_score (removeQuality . removeSSID)
- , 50 * nationality_score
- , name_points
- ]
- where address_score = checkAddress (addresses individual) (residential person)
- id_score = checkID (ids individual) (national_id person)
- nationality_score = checkCountryCode (nationalities individual) (nationality person)
- name_score = checkNames (names individual) (full_name person)
+checkPerson :: Config -> NaturalPerson -> Individual -> Float
+checkPerson config person individual = foldl1 (+) [ address_points
+ , multFloats 200 id_score removeSSID
+ , multFloats 100 date_score (removeQuality . removeSSID)
+ , 50 * nationality_score
+ , name_points
+ ]
+ where address_score = checkAddress config (addresses individual) (residential person)
+ id_score = checkID config (ids individual) (national_id person)
+ nationality_score = checkCountryCode config (nationalities individual) (nationality person)
+ name_score = checkNames config (names individual) (full_name person)
date_score = if name_points == 0
then []
- else checkBirthDate (birth_dates individual) (birthdate person)
+ else checkBirthDate config (birth_dates individual) (birthdate person)
address_points = multFloats 150 address_score (removeQuality . removeSSID)
name_points = if address_points >= 100
then 125
@@ -143,78 +134,78 @@ multFloats factor list toFloat = factor * foldl (\n x -> max n $ toFloat x) 0 li
-checkBirthDate :: Map Int (Quality (Year, Maybe DayOfYear)) -> Day -> [WithSSID QualityFloat]
-checkBirthDate dates date = catMaybes $ map compareDate $ toList dates
+checkBirthDate :: Config -> Map Int (Quality (Year, Maybe DayOfYear)) -> Day -> [WithSSID QualityFloat]
+checkBirthDate config dates date = catMaybes $ map compareDate $ toList dates
where compareDate (ssid, quality) = let
ratio = case removeQuality quality of
- (year, Just day_of_year) -> compareFullDate year day_of_year date
- (year, Nothing) -> compareYear year date
+ (year, Just day_of_year) -> compareFullDate config year day_of_year date
+ (year, Nothing) -> compareYear config year date
in
- if ratio >= threshold_float
+ if ratio >= threshold_ratio config
then Just $ WithSSID ssid $ liftQuality (\_ -> ratio) quality
else Nothing
-compareFullDate :: Year -> DayOfYear -> Day -> Float
-compareFullDate year day_of_year day = max ratio_text ratio_date
+compareFullDate :: Config -> Year -> DayOfYear -> Day -> Float
+compareFullDate config year day_of_year day = max ratio_text ratio_date
where day' = fromOrdinalDate year day_of_year
day_to_text d = pack $ showGregorian d
+ threshold = threshold_ratio config
ratio_text = let
- ratio = damerauLevenshteinNorm (day_to_text day) (day_to_text day')
+ ratio = ratioToFloat $ damerauLevenshteinNorm (day_to_text day) (day_to_text day')
in
- if ratio >= threshold_ratio then ratioToFloat ratio else 0
+ if ratio >= threshold then ratio else 0
(year', day_of_year') = toOrdinalDate day
(sus_years, sus_days) = suspicious_dates
- ratio_days = threshold_float**((fromIntegral $ abs $ day_of_year - day_of_year') / fromIntegral sus_days)
- ratio_years = threshold_float**((fromIntegral $ abs $ year - year') / fromIntegral sus_years)
+ ratio_days = threshold**((fromIntegral $ abs $ day_of_year - day_of_year') / fromIntegral sus_days)
+ ratio_years = threshold**((fromIntegral $ abs $ year - year') / fromIntegral sus_years)
ratio_date = let
ratio = ratio_days * ratio_years
in
- if ratio >= threshold_float then ratio else 0
+ if ratio >= threshold then ratio else 0
-compareYear :: Year -> Day -> Float
-compareYear year day = if ratio >= threshold_float then ratio else 0
+compareYear :: Config -> Year -> Day -> Float
+compareYear config year day = if ratio >= threshold then ratio else 0
where (year', _) = toOrdinalDate day
(sus_years, _) = suspicious_dates
- ratio = threshold_float**((fromIntegral $ abs $ year - year') / fromIntegral sus_years)
+ threshold = threshold_ratio config
+ ratio = threshold**((fromIntegral $ abs $ year - year') / fromIntegral sus_years)
-checkNames :: Map Int (Quality [Text]) -> Text -> [WithSSID QualityFloat]
-checkNames names' name = catMaybes $ map compareName $ toList names'
+checkNames :: Config -> Map Int (Quality [Text]) -> Text -> [WithSSID QualityFloat]
+checkNames config names' name = catMaybes $ map compareName $ toList names'
where compareName (ssid, quality) = let
- ratio = compareText name 0 (removeQuality quality)
+ ratio = ratioToFloat $ compareText name 0 (removeQuality quality)
in
- if ratio >= threshold_ratio
- then Just $ WithSSID ssid $ liftQuality (\_ -> ratioToFloat ratio) quality
+ if ratio >= threshold_ratio config
+ then Just $ WithSSID ssid $ liftQuality (\_ -> ratio) quality
else Nothing
-checkCountryCode :: Map Int CountryCode -> CountryCode -> Float
-checkCountryCode countries country' = if foldl (\b (_,c) -> c == country' || b) False $ toList countries
- then 1
- else 0
+checkCountryCode :: Config -> Map Int CountryCode -> CountryCode -> Float
+checkCountryCode _ countries country' = if foldl (\b (_,c) -> c == country' || b) False $ toList countries then 1 else 0
-checkID :: Map Int Text -> Text -> [WithSSID Float]
-checkID ids' id' = catMaybes $ map compareID $ toList ids'
+checkID :: Config -> Map Int Text -> Text -> [WithSSID Float]
+checkID config ids' id' = catMaybes $ map compareID $ toList ids'
where compareID (ssid, id'') = let
- ratio = compareText id' 0 [id'']
+ ratio = ratioToFloat $ compareText id' 0 [id'']
in
- if ratio >= 9 % 10
- then Just $ WithSSID ssid $ ratioToFloat ratio
+ if ratio >= (threshold_ratio config + 1) / 2
+ then Just $ WithSSID ssid ratio
else Nothing
-checkAddress :: Map Int (Quality SSL.Address) -> GLS.Address -> [WithSSID QualityFloat]
-checkAddress addresses' address' = catMaybes $ map (compareAddress address') $ toList addresses'
+checkAddress :: Config -> Map Int (Quality SSL.Address) -> GLS.Address -> [WithSSID QualityFloat]
+checkAddress config addresses' address' = catMaybes $ map (compareAddress config address') $ toList addresses'
-compareAddress :: GLS.Address -> (Int, Quality SSL.Address) -> Maybe (WithSSID QualityFloat)
-compareAddress gls_address (ssid, quality) = if country_score >= 0.75
- then Just $ WithSSID ssid $ liftQuality (\_ -> country_score) quality
- else Nothing
+compareAddress :: Config -> GLS.Address -> (Int, Quality SSL.Address) -> Maybe (WithSSID QualityFloat)
+compareAddress config gls_address (ssid, quality) = if country_score >= 0.75
+ then Just $ WithSSID ssid $ liftQuality (\_ -> country_score) quality
+ else Nothing
where ssl_address = removeQuality quality
total_score = totalFromMaybes [ details_score
, area_score
@@ -238,14 +229,14 @@ compareAddress gls_address (ssid, quality) = if country_score >= 0.75
, Just $ zipcode gls_address
]
possible_details = possible_numbers ++ possible_info
- perms = permutateText possible_details
- clean_details = cleanText det
- ratio = compareTexts clean_details 0 perms
- perfect_matches = foldl (\c i -> if foldl (\b d -> b || i `T.isInfixOf` d) False clean_details then c + 1 else c) 0 possible_info
+ perms = permutateText possible_details
+ clean_details = cleanText det
+ ratio = ratioToFloat $ compareTexts clean_details 0 perms
+ perfect_matches = foldl (\c i -> if foldl (\b d -> b || i `T.isInfixOf` d) False clean_details then c + 1 else c) 0 possible_info
in
- Just $ if ratio >= threshold_ratio
- then ratioToFloat ratio
- else if perfect_matches /= 0 then 0.5 else 0
+ Just $ if ratio >= threshold_ratio config
+ then ratio
+ else if perfect_matches >= 3 then perfect_matches * 0.2 else if perfect_matches > 1 then 0.5 else 0
Nothing -> Nothing
area_score = case area ssl_address of
Just areas -> let
@@ -253,9 +244,9 @@ compareAddress gls_address (ssid, quality) = if country_score >= 0.75
, town_district gls_address
, country_subdivision gls_address
]
- ratio = compareTexts areas 0 perms
+ ratio = ratioToFloat $ compareTexts areas 0 perms
in
- if ratio >= threshold_ratio then Just $ ratioToFloat ratio else Nothing
+ if ratio >= threshold_ratio config then Just ratio else Nothing
Nothing -> Nothing
location_score = case location ssl_address of
Just lcs -> let
@@ -263,15 +254,15 @@ compareAddress gls_address (ssid, quality) = if country_score >= 0.75
, town_district gls_address
, country_subdivision gls_address
]
- ratio = compareTexts lcs 0 perms
+ ratio = ratioToFloat $ compareTexts lcs 0 perms
in
- if ratio >= threshold_ratio then Just $ ratioToFloat ratio else Nothing
+ if ratio >= threshold_ratio config then Just ratio else Nothing
Nothing -> Nothing
zip_code_score = case zip_code ssl_address of
Just zc -> let
- ratio = compareText zc 0 [zipcode gls_address]
+ ratio = ratioToFloat $ compareText zc 0 [zipcode gls_address]
in
- if ratio >= threshold_ratio then Just $ ratioToFloat ratio else Nothing
+ if ratio >= threshold_ratio config then Just ratio else Nothing
Nothing -> Nothing
diff --git a/src/KYCheck/Config.hs b/src/KYCheck/Config.hs
@@ -27,39 +27,39 @@ import System.FilePath
inputToConfig :: DhallConfig -> Maybe CommandLine -> Config
inputToConfig dhall commandline =
let
- d_v = dhall_verbosity dhall
- d_ssl = dhall_ssl_location dhall
- d_pct = realToFrac $ dhall_threshold_percentage dhall
- d_pts = fromIntegral $ dhall_threshold_points dhall
- d_pp = fromIntegral $ dhall_perfect_points dhall
- d_addr = fromIntegral $ dhall_points_address dhall
- d_date = fromIntegral $ dhall_points_date dhall
- d_id = fromIntegral $ dhall_points_id dhall
- d_name = fromIntegral $ dhall_points_name dhall
- d_nat = fromIntegral $ dhall_points_nationality dhall
+ d_v = dhall_verbosity dhall
+ d_ssl = dhall_ssl_location dhall
+ d_pct = realToFrac $ dhall_threshold_ratio dhall
+ d_pts = fromIntegral $ dhall_threshold_points dhall
+ d_pp = fromIntegral $ dhall_perfect_points dhall
+ d_addr = fromIntegral $ dhall_weight_address dhall
+ d_date = fromIntegral $ dhall_weight_date dhall
+ d_id = fromIntegral $ dhall_weight_id dhall
+ d_name = fromIntegral $ dhall_weight_name dhall
+ d_nat = fromIntegral $ dhall_weight_nationality dhall
in
case commandline of
- Just cl -> Config { verbosity = case cl_verbosity cl of Just v -> v; Nothing -> d_v
- , ssl_location = case cl_ssl_location cl of Just l -> l; Nothing -> d_ssl
- , threshold_percentage = case cl_threshold_percentage cl of Just p -> p; Nothing -> d_pct
- , threshold_points = case cl_threshold_points cl of Just p -> p; Nothing -> d_pts
- , perfect_points = case cl_perfect_points cl of Just p -> p; Nothing -> d_pp
- , points_address = case cl_points_address cl of Just p -> p; Nothing -> d_addr
- , points_date = case cl_points_date cl of Just p -> p; Nothing -> d_date
- , points_id = case cl_points_id cl of Just p -> p; Nothing -> d_id
- , points_name = case cl_points_name cl of Just p -> p; Nothing -> d_name
- , points_nationality = case cl_points_nationality cl of Just p -> p; Nothing -> d_nat
+ Just cl -> Config { verbosity = case cl_verbosity cl of Just v -> v; Nothing -> d_v
+ , ssl_location = case cl_ssl_location cl of Just l -> l; Nothing -> d_ssl
+ , threshold_ratio = case cl_threshold_ratio cl of Just p -> p; Nothing -> d_pct
+ , threshold_points = case cl_threshold_points cl of Just p -> p; Nothing -> d_pts
+ , perfect_points = case cl_perfect_points cl of Just p -> p; Nothing -> d_pp
+ , weight_address = case cl_weight_address cl of Just p -> p; Nothing -> d_addr
+ , weight_date = case cl_weight_date cl of Just p -> p; Nothing -> d_date
+ , weight_id = case cl_weight_id cl of Just p -> p; Nothing -> d_id
+ , weight_name = case cl_weight_name cl of Just p -> p; Nothing -> d_name
+ , weight_nationality = case cl_weight_nationality cl of Just p -> p; Nothing -> d_nat
}
- Nothing -> Config { verbosity = d_v
- , ssl_location = d_ssl
- , threshold_percentage = d_pct
- , threshold_points = d_pts
- , perfect_points = d_pp
- , points_address = d_addr
- , points_date = d_date
- , points_id = d_id
- , points_name = d_name
- , points_nationality = d_nat
+ Nothing -> Config { verbosity = d_v
+ , ssl_location = d_ssl
+ , threshold_ratio = d_pct
+ , threshold_points = d_pts
+ , perfect_points = d_pp
+ , weight_address = d_addr
+ , weight_date = d_date
+ , weight_id = d_id
+ , weight_name = d_name
+ , weight_nationality = d_nat
}
checkConfig :: Config -> IO Bool
@@ -89,11 +89,11 @@ checkPoints :: Config -> IO Bool
checkPoints config = do
let v = verbosity config
- bool <- do let total = foldl1 (+) [ points_address config
- , points_date config
- , points_id config
- , points_name config
- , points_nationality config
+ bool <- do let total = foldl1 (+) [ weight_address config
+ , weight_date config
+ , weight_id config
+ , weight_name config
+ , weight_nationality config
]
threshold = threshold_points config
when (total < threshold) $ do (handleError v . Left) $ KYCheck_InvalidDistribution $ T.pack ("Total points obtainable (" ++ show total ++ ") lower than threshold (" ++ show threshold ++ ")")
@@ -138,9 +138,9 @@ commandLine = CommandLine
<> metavar "FILENAME"
<> help "Location of Swiss Sanction List" ) )
<*> optional ( option auto
- ( long "threshold-percentage"
+ ( long "threshold-ratio"
<> metavar "Float"
- <> help "Float between 0-1" ) )
+ <> help "Ratio between 0-1" ) )
<*> optional ( option auto
( long "threshold-points"
<> metavar "Integer"
@@ -150,23 +150,23 @@ commandLine = CommandLine
<> metavar "Integer"
<> help "Amount of points required to get a 100% confidence result" ) )
<*> optional ( option auto
- ( long "address"
+ ( long "address-weight"
<> metavar "Integer"
<> help "Points given to a 100% address match" ) )
<*> optional ( option auto
- ( long "date"
+ ( long "date-weight"
<> metavar "Integer"
<> help "Points given to a 100% birthdate match" ) )
<*> optional ( option auto
- ( long "id"
+ ( long "id-weight"
<> metavar "Integer"
<> help "Points given to a 100% identification document match" ) )
<*> optional ( option auto
- ( long "name"
+ ( long "name-weight"
<> metavar "Integer"
<> help "Points given to a 100% name match" ) )
<*> optional ( option auto
- ( long "nationality"
+ ( long "nationality-weight"
<> metavar "Integer"
<> help "Points given to a 100% nationality match" ) )
diff --git a/src/KYCheck/Type.hs b/src/KYCheck/Type.hs
@@ -58,31 +58,31 @@ removeSSID (WithSSID _ x) = x
-- | Data type containing all configuration information (config.dhall)
data Config = Config
- { verbosity :: Verbosity
- , ssl_location :: FilePath
- , threshold_percentage :: Float
- , threshold_points :: Float
- , perfect_points :: Float
- , points_address :: Float
- , points_date :: Float
- , points_id :: Float
- , points_name :: Float
- , points_nationality :: Float
+ { verbosity :: Verbosity
+ , ssl_location :: FilePath
+ , threshold_ratio :: Float
+ , threshold_points :: Float
+ , perfect_points :: Float
+ , weight_address :: Float
+ , weight_date :: Float
+ , weight_id :: Float
+ , weight_name :: Float
+ , weight_nationality :: Float
} deriving (Show, Eq, Generic)
data Verbosity = Test | Silent | Info | Errors | Debug deriving (Show, Eq, Generic, Ord)
data DhallConfig = DhallConfig
- { dhall_verbosity :: Verbosity
- , dhall_ssl_location :: FilePath
- , dhall_threshold_percentage :: Double
- , dhall_threshold_points :: Natural
- , dhall_perfect_points :: Natural
- , dhall_points_address :: Natural
- , dhall_points_date :: Natural
- , dhall_points_id :: Natural
- , dhall_points_name :: Natural
- , dhall_points_nationality :: Natural
+ { dhall_verbosity :: Verbosity
+ , dhall_ssl_location :: FilePath
+ , dhall_threshold_ratio :: Double
+ , dhall_threshold_points :: Natural
+ , dhall_perfect_points :: Natural
+ , dhall_weight_address :: Natural
+ , dhall_weight_date :: Natural
+ , dhall_weight_id :: Natural
+ , dhall_weight_name :: Natural
+ , dhall_weight_nationality :: Natural
} deriving (Show, Eq, Generic)
instance FromDhall DhallConfig where
@@ -91,14 +91,14 @@ instance FromDhall Verbosity
-- | Data type for user configuration via commandline
data CommandLine = CommandLine
- { cl_verbosity :: Maybe Verbosity
- , cl_ssl_location :: Maybe FilePath
- , cl_threshold_percentage :: Maybe Float
- , cl_threshold_points :: Maybe Float
- , cl_perfect_points :: Maybe Float
- , cl_points_address :: Maybe Float
- , cl_points_date :: Maybe Float
- , cl_points_id :: Maybe Float
- , cl_points_name :: Maybe Float
- , cl_points_nationality :: Maybe Float
+ { cl_verbosity :: Maybe Verbosity
+ , cl_ssl_location :: Maybe FilePath
+ , cl_threshold_ratio :: Maybe Float
+ , cl_threshold_points :: Maybe Float
+ , cl_perfect_points :: Maybe Float
+ , cl_weight_address :: Maybe Float
+ , cl_weight_date :: Maybe Float
+ , cl_weight_id :: Maybe Float
+ , cl_weight_name :: Maybe Float
+ , cl_weight_nationality :: Maybe Float
} deriving (Show, Eq, Generic)
diff --git a/test/Tests/Check.hs b/test/Tests/Check.hs
@@ -14,7 +14,6 @@ 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
@@ -117,12 +116,12 @@ testSingleTarget config verbose number target distribution ssl_target =
assertBool ("SSID should be " ++ show number) (ssid == number)
let
- address_score = multFloats 150 (checkAddress (addresses individual) (residential target)) (removeQuality . removeSSID)
- date_score = multFloats 100 (checkBirthDate (birth_dates individual) (birthdate target)) (removeQuality . removeSSID)
- id_score = multFloats 200 (checkID (ids individual) (national_id target)) removeSSID
- name_score = multFloats 125 (checkNames (names individual) (full_name target)) (removeQuality . removeSSID)
+ address_score = multFloats 150 (checkAddress config (addresses individual) (residential target)) (removeQuality . removeSSID)
+ date_score = multFloats 100 (checkBirthDate config (birth_dates individual) (birthdate target)) (removeQuality . removeSSID)
+ id_score = multFloats 200 (checkID config (ids individual) (national_id target)) removeSSID
+ name_score = multFloats 125 (checkNames config (names individual) (full_name target)) (removeQuality . removeSSID)
- nationality_score = 50 * checkCountryCode (nationalities individual) (nationality target)
+ nationality_score = 50 * checkCountryCode config (nationalities individual) (nationality target)
total_score = checkPersons config ssl target
diff --git a/test/Tests/Targets/Real.hs b/test/Tests/Targets/Real.hs
@@ -427,11 +427,11 @@ target_68815 = NaturalPerson
, residential = GLS.Address { GLS.country = HT
, street_name = "Non existent"
, street_number = "Non existent"
- , GLS.lines = Nothing
+ , GLS.lines = Just "Tabarre 49"
, building_name = Nothing
, building_number = Just "64"
, zipcode = "Non existent"
- , town_location = Just "Tabarre"
+ , town_location = Just "Port-au-Prince"
, town_district = Nothing
, country_subdivision = Nothing
}
diff --git a/test/data/test.config.dhall b/test/data/test.config.dhall
@@ -6,14 +6,14 @@
-- Verbosity levels
let Verbosity = < Test | Silent | Info | Errors | Debug >
-in { verbosity = Verbosity.Test
- , 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
- , points_address = 150
- , points_date = 100
- , points_id = 200
- , points_name = 125
- , points_nationality = 50
+in { verbosity = Verbosity.Test
+ , ssl_location = "test-sanction-list.xml"
+ , threshold_ratio = 0.8 -- Percentage
+ , threshold_points = 200 -- Points needed to flag entry as match
+ , perfect_points = 300 -- Amount of points required to get 100% confidence
+ , weight_address = 150
+ , weight_date = 100
+ , weight_id = 200
+ , weight_name = 125
+ , weight_nationality = 50
}
diff --git a/test/test-kycheck.hs b/test/test-kycheck.hs
@@ -41,6 +41,7 @@ main = do
valid_config <- checkConfig config
- targets <- xmlToSSL <$> parseSwissSanctionsList (ssl_location config)
-
- defaultMain (tests config targets)
+ case valid_config of
+ False -> return ()
+ True -> do targets <- xmlToSSL <$> parseSwissSanctionsList (ssl_location config)
+ defaultMain (tests config targets)
