summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorRoman Smrž <roman.smrz@seznam.cz>2023-09-19 20:51:59 +0200
committerRoman Smrž <roman.smrz@seznam.cz>2023-09-19 20:51:59 +0200
commitee9ab16d4c1f85cdc1582edfbeb7d61f291b7c35 (patch)
tree121bbc18181a513e3537931167d4a5e986870987 /src
parentb09df3cbdc0e1ee56a4b07e3bd7594bb3ce7fd50 (diff)
Identity validation diagnostics
Diffstat (limited to 'src')
-rw-r--r--src/Identity.hs20
1 files changed, 13 insertions, 7 deletions
diff --git a/src/Identity.hs b/src/Identity.hs
index 9653077..8bee231 100644
--- a/src/Identity.hs
+++ b/src/Identity.hs
@@ -6,7 +6,7 @@ module Identity (
emptyIdentityData,
createIdentity,
- validateIdentity, validateIdentityF,
+ validateIdentity, validateIdentityF, validateIdentityFE,
loadIdentity, loadUnifiedIdentity,
mergeIdentity, toUnifiedIdentity, toComposedIdentity,
@@ -140,19 +140,24 @@ validateIdentity :: Stored (Signed IdentityData) -> Maybe UnifiedIdentity
validateIdentity = validateIdentityF . I.Identity
validateIdentityF :: Foldable m => m (Stored (Signed IdentityData)) -> Maybe (Identity m)
-validateIdentityF mdata = do
+validateIdentityF = either (const Nothing) Just . runExcept . validateIdentityFE
+
+validateIdentityFE :: Foldable m => m (Stored (Signed IdentityData)) -> Except String (Identity m)
+validateIdentityFE mdata = do
let idata = filterAncestors $ toList mdata
- guard $ not $ null idata
+ when (null idata) $ throwError "null data"
mapM_ verifySignatures $ gatherPrevious S.empty idata
Identity
<$> pure mdata
<*> pure (lookupProperty iddName idata)
<*> case lookupProperty iddOwner idata of
Nothing -> return Nothing
- Just owner -> Just <$> validateIdentityF [owner]
+ Just owner -> return <$> validateIdentityFE [owner]
<*> pure []
<*> pure (iddKeyIdentity $ fromStored $ signedData $ fromStored $ minimum idata)
- <*> lookupProperty iddKeyMessage idata
+ <*> case lookupProperty iddKeyMessage idata of
+ Nothing -> throwError "no message key"
+ Just mk -> return mk
loadIdentity :: String -> LoadRec ComposedIdentity
loadIdentity name = maybe (throwError "identity validation failed") return . validateIdentityF =<< loadRefs name
@@ -166,7 +171,7 @@ gatherPrevious res (n:ns) | n `S.member` res = gatherPrevious res ns
| otherwise = gatherPrevious (S.insert n res) $ (iddPrev $ fromStored $ signedData $ fromStored n) ++ ns
gatherPrevious res [] = res
-verifySignatures :: Stored (Signed IdentityData) -> Maybe ()
+verifySignatures :: Stored (Signed IdentityData) -> Except String ()
verifySignatures sidd = do
let idd = fromStored $ signedData $ fromStored sidd
required = concat
@@ -174,7 +179,8 @@ verifySignatures sidd = do
, map (iddKeyIdentity . fromStored . signedData . fromStored) $ iddPrev idd
, map (iddKeyIdentity . fromStored . signedData . fromStored) $ toList $ iddOwner idd
]
- guard $ all (fromStored sidd `isSignedBy`) required
+ unless (all (fromStored sidd `isSignedBy`) required) $ do
+ throwError "signature verification failed"
lookupProperty :: forall a. (IdentityData -> Maybe a) -> [Stored (Signed IdentityData)] -> Maybe a
lookupProperty sel topHeads = findResult filteredLayers