From 8b992df381546593903071cc913336a9feb705b0 Mon Sep 17 00:00:00 2001
From: Clemens Schmid <clemens@nevrome.de>
Date: Sun, 27 Nov 2022 05:04:32 +0100
Subject: [PATCH 1/2] added ORCID validation

---
 src/NASSA/Types.hs | 50 +++++++++++++++++++++++++++++++++++++---------
 1 file changed, 41 insertions(+), 9 deletions(-)

diff --git a/src/NASSA/Types.hs b/src/NASSA/Types.hs
index 87bacc2..dbdde00 100644
--- a/src/NASSA/Types.hs
+++ b/src/NASSA/Types.hs
@@ -4,11 +4,11 @@
 module NASSA.Types where
 
 import           Control.Applicative        ((<|>))
-import           Control.Monad              (mzero)
+import           Control.Monad              (mzero, guard)
 import           Data.Aeson                 (FromJSON,
                                              parseJSON, withObject,
-                                             (.:), (.:?), withText, 
-                                             Value (String))
+                                             (.:), (.:?), withText,
+                                             Value (String), ToJSON (..))
 import qualified Data.Text                  as T
 import qualified Data.Text.Encoding         as TS
 import           Data.Time                  (Day)
@@ -16,6 +16,8 @@ import           Data.Version               (Version, makeVersion, showVersion)
 import qualified Text.Parsec                as P
 import qualified Text.Parsec.Text           as P
 import qualified Text.Email.Validate        as TEV
+import Data.Char (digitToInt)
+import Data.List (intercalate)
 
 newtype NassaModule = NassaModule (FilePath, NassaModuleYamlStruct)
     deriving (Show, Eq)
@@ -171,8 +173,10 @@ instance FromJSON Email where
         Just x  -> pure $ Email x
     parseJSON _ = mzero
 
+-- | A data type to represent an ORCID
+-- see https://support.orcid.org/hc/en-us/articles/360006897674-Structure-of-the-ORCID-Identifier
 data ORCID = ORCID
-    { _orcidNums :: [Char]
+    { _orcidNums     :: [Char]
     , _orcidChecksum :: Char
     }
     deriving (Show, Eq)
@@ -183,19 +187,47 @@ instance FromJSON ORCID where
         Right x  -> pure x
     parseJSON _          = mzero
 
+instance ToJSON ORCID where
+    toJSON x = String $ T.pack $ renderORCID x
+
 parseORCID :: P.Parser ORCID
 parseORCID = do
-  (\a b c d e -> ORCID (concat [a,b,c,d]) e) <$>
-        fourBlock <* m
-    <*> fourBlock <* m
-    <*> fourBlock <* m
-    <*> threeBlock <*> checksumDigit <* P.eof
+    orcid <- (\a b c d e -> ORCID (concat [a,b,c,d]) e) <$>
+            fourBlock <* m
+        <*> fourBlock <* m
+        <*> fourBlock <* m
+        <*> threeBlock <*> checksumDigit <* P.eof
+    guard (validateORCID orcid) P.<?> "ORCID is not valid"
+    return orcid
   where
       fourBlock = P.count 4 P.digit
       m = P.oneOf "-"
       threeBlock = P.count 3 P.digit
       checksumDigit = P.digit P.<|> P.char 'X'
 
+validateORCID :: ORCID -> Bool
+validateORCID (ORCID nums check) =
+    let numsInt = map digitToInt nums
+        total = makeTotal 0 numsInt
+        remainder = total `mod` 11
+        result = (12 - remainder) `mod` 11
+        checkInt = if check == 'X' then 10 else digitToInt check
+    in result == checkInt
+    where
+        makeTotal :: Int -> [Int] -> Int
+        makeTotal a []     = a
+        makeTotal a (x:xs) = makeTotal ((a + x) * 2) xs
+
+renderORCID :: ORCID -> String
+renderORCID (ORCID nums check) =
+    intercalate "-" (chunks 4 nums) ++ [check]
+    where
+        chunks :: Int -> [a] -> [[a]]
+        chunks _ [] = []
+        chunks n xs =
+            let (ys, zs) = splitAt n xs
+            in  ys : chunks n zs
+
 data ReferenceStruct = ReferenceStruct
     { _referencesBibFile :: FilePath
     , _referencesModuleReferences :: Maybe [String]

From 5bd7c53875578e213a995a349e79c35a959a69ea Mon Sep 17 00:00:00 2001
From: Clemens Schmid <clemens@nevrome.de>
Date: Sun, 27 Nov 2022 05:12:20 +0100
Subject: [PATCH 2/2] version bump

---
 CHANGELOG.md | 1 +
 nassa.cabal  | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/CHANGELOG.md b/CHANGELOG.md
index 86adf60..7cbb087 100644
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -1,3 +1,4 @@
+- V 0.8.0: Added validation of the ORCID identifier
 - V 0.7.0: Adapted checks on softwareDependencies to nassa-schema v0.3.0
 - V 0.6.1: Discarded checks on designDetailsFile field
 - V 0.6.0: Added all the necessary mechanisms to make nassa aware of the NASSA standard versions of modules
diff --git a/nassa.cabal b/nassa.cabal
index 25cc1fc..181a207 100644
--- a/nassa.cabal
+++ b/nassa.cabal
@@ -1,5 +1,5 @@
 name:                nassa
-version:             0.7.0
+version:             0.8.0
 synopsis:            A package to validate NASSA modules
 description:         NASSA maintains a library of agent-based-modelling algorithms in individual code modules. Each module is defined by a NASSA.yml file. nassa-hs validates these .yml files.
 license:             MIT