[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[robocop] branch master updated: change score printing to match expectat
From: |
Admin |
Subject: |
[robocop] branch master updated: change score printing to match expectations of taler-exchange-sanctionscheck |
Date: |
Thu, 05 Jun 2025 11:46:47 +0200 |
This is an automated email from the git hooks/post-receive script.
grothoff pushed a commit to branch master
in repository robocop.
The following commit(s) were added to refs/heads/master by this push:
new 53ec32c change score printing to match expectations of
taler-exchange-sanctionscheck
53ec32c is described below
commit 53ec32cf745a27c4b6a91da79c7774e57b9e3400
Author: Christian Grothoff <christian@grothoff.org>
AuthorDate: Thu Jun 5 11:46:43 2025 +0200
change score printing to match expectations of taler-exchange-sanctionscheck
---
app/Main.hs | 10 +++++++---
src/Robocop/Check.hs | 43 +++++++++++++++++++++++++------------------
2 files changed, 32 insertions(+), 21 deletions(-)
diff --git a/app/Main.hs b/app/Main.hs
index f38d18d..912921b 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -31,9 +31,12 @@ import System.IO
import Toml (decodeFile)
+printScores :: [Score] -> IO ()
+printScores scores = mapM_ (putStrLn . scoreToString) scores
+
+
readJSON :: Config -> Targets -> IO ()
readJSON config sanction_list = do
- when (verbosity config >= Info) $ hPutStrLn stderr "Sanction list loaded.
Ready for your input.\n(Paste subject data into the terminal. Use JSONlines
format.)\nType 'CTRL-D' to exit."
eof <- isEOF
if eof
then hPutStrLn stderr "Thank you for using Robocop."
@@ -43,8 +46,8 @@ readJSON config sanction_list = do
Left err -> hPutStrLn stderr $ "Failed to decode JSON (" ++
show err ++ ")"
Right entry -> do
case entry of
- NP person -> mapM_ print $ checkPersons config
(individuals sanction_list) person
- LE entity -> mapM_ print $ checkEntity config
(entities sanction_list) entity
+ NP person -> printScores $ checkPersons config
(individuals sanction_list) person
+ LE entity -> printScores $ checkEntity config
(entities sanction_list) entity
readJSON config sanction_list
main :: IO ()
@@ -83,4 +86,5 @@ main = do
Just age -> hPutStrLn stderr $ "Seconds
since epoch: " ++ (show (floor $ diffUTCTime start (UTCTime age 0) :: Int))
Nothing -> hPutStrLn stderr $ "Could not
find age of sanction list"
+ when (verbosity config >= Info) $ hPutStrLn
stderr "Sanction list loaded. Ready for your input.\n(Paste subject data into
the terminal. Use JSONlines format.)\nType 'CTRL-D' to exit."
readJSON config tgts
diff --git a/src/Robocop/Check.hs b/src/Robocop/Check.hs
index cb2c63e..acc0f0a 100644
--- a/src/Robocop/Check.hs
+++ b/src/Robocop/Check.hs
@@ -16,6 +16,7 @@ module Robocop.Check
, compareFullDate
, multFloats
, Score(..)
+ , scoreToString
) where
import Data.ISO3166_CountryCodes
@@ -24,15 +25,17 @@ import Data.Maybe
import Data.Map (Map, toList)
import Data.Ratio
-import Data.Text (intercalate, pack, snoc, Text)
+import Data.Text (intercalate, pack, snoc, Text)
import qualified Data.Text as T
import Data.Text.Metrics
import Data.Time.Calendar
import Data.Time.Calendar.OrdinalDate
+import Text.Printf (printf)
+
import Robocop.Type
-import Robocop.SSL.Type as SSL
+import Robocop.SSL.Type as SSL
import Robocop.GLS.Type as GLS
import Prelude hiding (lines)
@@ -44,6 +47,10 @@ data Score = Score
, reference :: Int
} deriving (Show, Eq)
+scoreToString :: Score -> String
+scoreToString (Score mq conf expiresec ref) =
+ printf "%f %f %d %d" mq conf expiresec ref
+
suspicious_dates :: (Int, Int)
suspicious_dates = (3, 75) -- Difference in years and days that will be marked
suspicious (exponential)
@@ -56,7 +63,7 @@ checkEntity config entities' entity = findMatchingEntities
config entity $ toLis
findMatchingEntities :: Config -> LegalEntity -> [(Int, Entity)] -> [Score]
findMatchingEntities _ _ [] = []
-findMatchingEntities config entity ((ssid,ent):ents) =
+findMatchingEntities config entity ((ssid,ent):ents) =
let
points = compareEntity config entity ent
max_points = foldl1 (+) [ if toList (entity_addresses ent) == [] then 0
else weight_address config
@@ -67,7 +74,7 @@ findMatchingEntities config entity ((ssid,ent):ents) =
then let
score = Score { match_quality = if points >= perfect_points config
then 1 else points / perfect_points config
, confidence = points / max_points
- , expiration = 0
+ , expiration = 0
, reference = ssid
}
in
@@ -91,7 +98,7 @@ checkPersons :: Config -> Map Int Individual -> NaturalPerson
-> [Score]
checkPersons config individuals' person = checkPersons' config person $ toList
individuals'
checkPersons' :: Config -> NaturalPerson -> [(Int, Individual)] -> [Score]
-checkPersons' _ _ [] = []
+checkPersons' _ _ [] = []
checkPersons' config person ((ssid,ind):inds) =
let
points = checkPerson config person ind
@@ -108,7 +115,7 @@ checkPersons' config person ((ssid,ind):inds) =
, confidence = points / max_points
, expiration = 0
, reference = ssid
- }
+ }
in
score:checkPersons' config person inds
else checkPersons' config person inds
@@ -119,11 +126,11 @@ checkPerson config person individual = foldl1 (+) [
address_points
, multFloats 100 date_score
(removeQuality . removeSSID)
, 50 * nationality_score
, name_points
- ]
- where address_score = checkAddress config (addresses individual)
(residential person)
+ ]
+ 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)
+ name_score = checkNames config (names individual)
(full_name person)
date_score = if name_points == 0
then []
else checkBirthDate config (birth_dates
individual) (birthdate person)
@@ -148,7 +155,7 @@ checkBirthDate config dates (Day' date) = catMaybes $ map
compareDate $ toList d
then Just $ WithSSID ssid $
liftQuality (\_ -> ratio) quality
else Nothing
-compareFullDate :: Config -> Year -> DayOfYear -> Day -> Float
+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
@@ -177,7 +184,7 @@ compareYear config year day = if ratio >= threshold then
ratio else 0
-checkNames :: Config -> Map Int (Quality [Text]) -> Text -> [WithSSID
QualityFloat]
+checkNames :: Config -> Map Int (Quality [Text]) -> Text -> [WithSSID
QualityFloat]
checkNames config names' name = catMaybes $ map compareName $ toList names'
where compareName (ssid, quality) = let
ratio = ratioToFloat $ compareText
name 0 (removeQuality quality)
@@ -206,18 +213,18 @@ checkAddress :: Config -> Map Int (Quality SSL.Address)
-> GLS.Address -> [WithS
checkAddress config addresses' address' = catMaybes $ map (compareAddress
config address') $ toList addresses'
compareAddress :: Config -> GLS.Address -> (Int, Quality SSL.Address) -> Maybe
(WithSSID QualityFloat)
-compareAddress config gls_address (ssid, quality) = if country_score >= 0.75
+compareAddress config gls_address (ssid, quality) = if country_score >= 0.75
then Just $ WithSSID ssid
$ liftQuality (\_ -> country_score) quality
- else Nothing
+ else Nothing
where ssl_address = removeQuality quality
total_score = totalFromMaybes [ details_score
, area_score
- , location_score
+ , location_score
, zip_code_score
]
country_score = case SSL.country ssl_address of
- Just c -> if c == GLS.country gls_address then 0.5
* (total_score + 1) else 0
- Nothing -> total_score
+ Just c -> if c == GLS.country gls_address then 0.5
* (total_score + 1) else 0
+ Nothing -> total_score
details_score = case details ssl_address of
Just det -> let
possible_numbers = catMaybes [ Just $
street_number gls_address
@@ -265,7 +272,7 @@ compareAddress config gls_address (ssid, quality) = if
country_score >= 0.75
Just zc -> let
ratio = ratioToFloat $ compareText zc
0 [zipcode gls_address]
in
- if ratio >= threshold_ratio config
then Just ratio else Nothing
+ if ratio >= threshold_ratio config
then Just ratio else Nothing
Nothing -> Nothing
@@ -274,7 +281,7 @@ cleanText text = map (T.foldl (\new_text char -> if char
`elem` chars_to_rm
then new_text
else snoc new_text char
) start_text) text
- where chars_to_rm = ".,-" :: String
+ where chars_to_rm = ".,-" :: String
start_text = "" :: Text
permutateText :: [Text] -> [Text]
--
To stop receiving notification emails like this one, please contact
gnunet@gnunet.org.
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [robocop] branch master updated: change score printing to match expectations of taler-exchange-sanctionscheck,
Admin <=