diff options
| -rw-r--r-- | src/Identity.hs | 20 |
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 |