gnunet-svn
[Top][All Lists]
Advanced

[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.



reply via email to

[Prev in Thread] Current Thread [Next in Thread]