summaryrefslogtreecommitdiff
path: root/KeyRing.hs
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2016-04-23 00:35:03 -0400
committerjoe <joe@jerkface.net>2016-04-23 00:35:03 -0400
commit64202f804429053058ac3efce527f77c2e12948b (patch)
treecf301c570fa9b2266abd8def3106805c970040bc /KeyRing.hs
parentf11640aecb9ba8e1693bcc8fa80a53dc5feb2bac (diff)
WIP: tar command.
Diffstat (limited to 'KeyRing.hs')
-rw-r--r--KeyRing.hs21
1 files changed, 12 insertions, 9 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 7369acf..d4bb099 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -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
992selectPublicKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet 992selectPublicKey :: (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
993selectPublicKey (spec,mtag) db = selectKey0 True (spec,mtag) db 993selectPublicKey (spec,mtag) db = selectKey0 True (spec,mtag) db
994 994
995selectPublicKeyAndSigs :: (KeySpec,Maybe String) -> KeyDB -> [(Packet,[Packet])] 995selectPublicKeyAndSigs :: (KeySpec,Maybe String) -> KeyDB -> [(KeyKey,Packet,[Packet])]
996selectPublicKeyAndSigs (spec,mtag) db = 996selectPublicKeyAndSigs (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
1020selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet 1023selectKey0 :: Bool -> (KeySpec,Maybe String) -> KeyDB -> Maybe Packet
1021selectKey0 wantPublic (spec,mtag) db = do 1024selectKey0 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{-
1030selectAll :: Bool -> (KeySpec,Maybe String) -> KeyDB -> [(Packet,Maybe Packet)] 1033selectAll :: Bool -> (KeySpec,Maybe String) -> KeyDB -> [(Packet,Maybe Packet)]