diff options
Diffstat (limited to 'src/Erebos')
| -rw-r--r-- | src/Erebos/Identity.hs | 32 | 
1 files changed, 12 insertions, 20 deletions
| diff --git a/src/Erebos/Identity.hs b/src/Erebos/Identity.hs index 8761fde..c0af02b 100644 --- a/src/Erebos/Identity.hs +++ b/src/Erebos/Identity.hs @@ -35,7 +35,6 @@ import Data.Foldable  import Data.Function  import Data.List  import Data.Maybe -import Data.Ord  import Data.Set (Set)  import qualified Data.Set as S  import Data.Text (Text) @@ -304,25 +303,18 @@ verifySignatures sidd = do          throwError "signature verification failed"  lookupProperty :: forall a m. Foldable m => (ExtendedIdentityData -> Maybe a) -> m (Stored (Signed ExtendedIdentityData)) -> Maybe a -lookupProperty sel topHeads = findResult filteredLayers -    where findPropHeads :: Stored (Signed ExtendedIdentityData) -> [(Stored (Signed ExtendedIdentityData), a)] -          findPropHeads sobj | Just x <- sel $ fromSigned sobj = [(sobj, x)] -                             | otherwise = findPropHeads =<< (eiddPrev $ fromSigned sobj) - -          propHeads :: [(Stored (Signed ExtendedIdentityData), a)] -          propHeads = findPropHeads =<< toList topHeads - -          historyLayers :: [Set (Stored (Signed ExtendedIdentityData))] -          historyLayers = generations $ map fst propHeads - -          filteredLayers :: [[(Stored (Signed ExtendedIdentityData), a)]] -          filteredLayers = scanl (\cur obsolete -> filter ((`S.notMember` obsolete) . fst) cur) propHeads historyLayers - -          findResult ([(_, x)] : _) = Just x -          findResult ([] : _) = Nothing -          findResult [] = Nothing -          findResult [xs] = Just $ snd $ minimumBy (comparing fst) xs -          findResult (_:rest) = findResult rest +lookupProperty sel topHeads = findResult propHeads +  where +    findPropHeads :: Stored (Signed ExtendedIdentityData) -> [ Stored (Signed ExtendedIdentityData) ] +    findPropHeads sobj | Just _ <- sel $ fromSigned sobj = [ sobj ] +                       | otherwise = findPropHeads =<< (eiddPrev $ fromSigned sobj) + +    propHeads :: [ Stored (Signed ExtendedIdentityData) ] +    propHeads = filterAncestors $ findPropHeads =<< toList topHeads + +    findResult :: [ Stored (Signed ExtendedIdentityData) ] -> Maybe a +    findResult [] = Nothing +    findResult xs = sel $ fromSigned $ minimum xs  mergeIdentity :: (MonadStorage m, MonadError String m, MonadIO m) => Identity f -> m UnifiedIdentity  mergeIdentity idt | Just idt' <- toUnifiedIdentity idt = return idt' |