diff options
Diffstat (limited to 'KeyRing.hs')
-rw-r--r-- | KeyRing.hs | 21 |
1 files changed, 12 insertions, 9 deletions
@@ -938,7 +938,7 @@ parseSpec grip spec = (topspec,subspec) | |||
938 | "fp" | top=="" -> Nothing | 938 | "fp" | top=="" -> Nothing |
939 | "" | top=="" && is40digitHex sub -> Nothing | 939 | "" | top=="" && is40digitHex sub -> Nothing |
940 | "" -> listToMaybe sub >> Just sub | 940 | "" -> listToMaybe sub >> Just sub |
941 | -- "fp" -> ??? TODO: non-ehaustive patterns in case: fp:7/fp: | 941 | _ -> Nothing |
942 | 942 | ||
943 | is40digitHex xs = ys == xs && length ys==40 | 943 | is40digitHex xs = ys == xs && length ys==40 |
944 | where | 944 | where |
@@ -992,11 +992,14 @@ selectSecretKey (spec,mtag) db = selectKey0 False (spec,mtag) db | |||
992 | selectPublicKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet | 992 | selectPublicKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet |
993 | selectPublicKey (spec,mtag) db = selectKey0 True (spec,mtag) db | 993 | selectPublicKey (spec,mtag) db = selectKey0 True (spec,mtag) db |
994 | 994 | ||
995 | selectPublicKeyAndSigs :: (KeySpec,Maybe String) -> KeyDB -> [(Packet,[Packet])] | 995 | selectPublicKeyAndSigs :: (KeySpec,Maybe String) -> KeyDB -> [(KeyKey,Packet,[Packet])] |
996 | selectPublicKeyAndSigs (spec,mtag) db = | 996 | selectPublicKeyAndSigs (spec,mtag) db = |
997 | case mtag of | 997 | case mtag of |
998 | Nothing -> concat $ Map.elems $ fmap (findbyspec spec) db | 998 | Nothing -> do |
999 | Just tag -> Map.elems (Map.filter (matchSpec spec) db) >>= findsubs tag | 999 | (kk,r) <- Map.toList $ fmap (findbyspec spec) db |
1000 | (sub,sigs) <- r | ||
1001 | return (kk,sub,sigs) | ||
1002 | Just tag -> Map.toList (Map.filter (matchSpec spec) db) >>= findsubs tag | ||
1000 | where | 1003 | where |
1001 | topresult kd = (keyPacket kd, map (packet .fst) $ keySigAndTrusts kd) | 1004 | topresult kd = (keyPacket kd, map (packet .fst) $ keySigAndTrusts kd) |
1002 | 1005 | ||
@@ -1009,22 +1012,22 @@ selectPublicKeyAndSigs (spec,mtag) db = | |||
1009 | ismatch (p,sigs) = matchpr g p ==g | 1012 | ismatch (p,sigs) = matchpr g p ==g |
1010 | findbyspec spec kd = if matchSpec spec kd then [topresult kd] else [] | 1013 | findbyspec spec kd = if matchSpec spec kd then [topresult kd] else [] |
1011 | 1014 | ||
1012 | findsubs tag (KeyData topk _ _ subs) = Map.elems subs >>= gettag | 1015 | findsubs tag (kk, KeyData topk _ _ subs) = Map.elems subs >>= gettag |
1013 | where | 1016 | where |
1014 | gettag (SubKey sub sigs) = do | 1017 | gettag (SubKey sub sigs) = do |
1015 | let (_,mb,_) = findTag [mkUsage tag] (packet topk) (packet sub) sigs | 1018 | let (_,mb,_) = findTag [mkUsage tag] (packet topk) (packet sub) sigs |
1016 | (hastag,_) <- maybeToList mb | 1019 | (hastag,_) <- maybeToList mb |
1017 | guard hastag | 1020 | guard hastag |
1018 | return $ (packet sub, map (packet . fst) sigs) | 1021 | return $ (kk, packet sub, map (packet . fst) sigs) |
1019 | 1022 | ||
1020 | selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet | 1023 | selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet |
1021 | selectKey0 wantPublic (spec,mtag) db = do | 1024 | selectKey0 wantPublic (spec,mtag) db = do |
1022 | let Message ps = flattenKeys wantPublic db | 1025 | let Message ps = flattenKeys wantPublic db |
1023 | ys = snd $ seek_key spec ps | 1026 | ys = snd $ seek_key spec ps |
1024 | flip (maybe (listToMaybe ys)) mtag $ \tag -> do | 1027 | flip (maybe (listToMaybe ys)) mtag $ \tag -> do |
1025 | let (subspec,ys1) = (KeyTag y tag,ys1) where y:ys1 = ys | 1028 | case ys of |
1026 | zs = snd $ seek_key subspec ys1 | 1029 | y:ys1 -> listToMaybe $ snd $ seek_key (KeyTag y tag) ys1 |
1027 | listToMaybe zs | 1030 | [] -> Nothing |
1028 | 1031 | ||
1029 | {- | 1032 | {- |
1030 | selectAll :: Bool -> (KeySpec,Maybe String) -> KeyDB -> [(Packet,Maybe Packet)] | 1033 | selectAll :: Bool -> (KeySpec,Maybe String) -> KeyDB -> [(Packet,Maybe Packet)] |