diff options
author | Andrew Cady <d@jerkface.net> | 2019-07-16 20:33:23 -0400 |
---|---|---|
committer | Andrew Cady <d@jerkface.net> | 2019-07-16 20:33:23 -0400 |
commit | 8af08303e56fc109135e2ade91299338d03b57b0 (patch) | |
tree | 7131b086733c62c610e667638a3f7893b7304618 /lib/KeyRing.hs | |
parent | 7a94f5103671011295f818bfcf30280423c44042 (diff) |
this compiles
Diffstat (limited to 'lib/KeyRing.hs')
-rw-r--r-- | lib/KeyRing.hs | 22 |
1 files changed, 12 insertions, 10 deletions
diff --git a/lib/KeyRing.hs b/lib/KeyRing.hs index cd69042..8c92a81 100644 --- a/lib/KeyRing.hs +++ b/lib/KeyRing.hs | |||
@@ -425,7 +425,7 @@ selectPublicKeyAndSigs (spec,mtag) db = | |||
425 | : map (\(SubKey sub sigs)-> (packet sub, map (packet . fst) sigs)) | 425 | : map (\(SubKey sub sigs)-> (packet sub, map (packet . fst) sigs)) |
426 | (Map.elems $ keySubKeys kd) | 426 | (Map.elems $ keySubKeys kd) |
427 | where | 427 | where |
428 | ismatch (p,sigs) = matchpr g p ==g | 428 | ismatch (p,sigs) = matchpr' g p |
429 | findbyspec spec kd = if matchSpec spec kd then [topresult kd] else [] | 429 | findbyspec spec kd = if matchSpec spec kd then [topresult kd] else [] |
430 | 430 | ||
431 | findsubs tag (kk, KeyData topk _ _ subs) = Map.elems subs >>= gettag | 431 | findsubs tag (kk, KeyData topk _ _ subs) = Map.elems subs >>= gettag |
@@ -673,7 +673,7 @@ isauth rt keydata = dont_have keydata && maybe False (`has_good_sig` keydata) wk | |||
673 | workingKey grip use_db = listToMaybe $ do | 673 | workingKey grip use_db = listToMaybe $ do |
674 | fp <- maybeToList grip | 674 | fp <- maybeToList grip |
675 | elm <- keyData use_db | 675 | elm <- keyData use_db |
676 | guard $ matchSpec (KeyGrip fp) elm | 676 | guard $ matchSpec (KeyGrip $ show fp) elm |
677 | return $ keyPacket elm | 677 | return $ keyPacket elm |
678 | 678 | ||
679 | mkarmor :: Access -> L.ByteString -> [Armor] | 679 | mkarmor :: Access -> L.ByteString -> [Armor] |
@@ -734,7 +734,7 @@ writeRingKeys krd rt {- db wk secring pubring -} unspilled report_manips = do | |||
734 | case fill stream of | 734 | case fill stream of |
735 | KF_Match usage -> do grip <- maybeToList $ rtGrip rt | 735 | KF_Match usage -> do grip <- maybeToList $ rtGrip rt |
736 | flattenTop f only_public | 736 | flattenTop f only_public |
737 | $ filterNewSubs f (parseSpec grip usage) d -- TODO: parseSpec3 | 737 | $ filterNewSubs f (parseSpec (Just grip) usage) d -- TODO: parseSpec3 |
738 | _ -> flattenTop f only_public d | 738 | _ -> flattenTop f only_public d |
739 | new_packets = filter isnew x | 739 | new_packets = filter isnew x |
740 | where isnew p = isNothing (Map.lookup (resolveForReport Nothing f0) $ locations p) | 740 | where isnew p = isNothing (Map.lookup (resolveForReport Nothing f0) $ locations p) |
@@ -945,7 +945,7 @@ writePEMKeys doDecrypt db exports = do | |||
945 | initializeMissingPEMFiles :: | 945 | initializeMissingPEMFiles :: |
946 | KeyRingOperation | 946 | KeyRingOperation |
947 | -> InputFileContext | 947 | -> InputFileContext |
948 | -> Maybe String | 948 | -> Maybe Fingerprint |
949 | -> Maybe MappedPacket | 949 | -> Maybe MappedPacket |
950 | -> PacketTranscoder | 950 | -> PacketTranscoder |
951 | -> KeyDB | 951 | -> KeyDB |
@@ -974,7 +974,7 @@ initializeMissingPEMFiles operation ctx grip mwk transcode db = do | |||
974 | usage <- maybeToList mutableTag | 974 | usage <- maybeToList mutableTag |
975 | -- TODO: Use parseSpec3 | 975 | -- TODO: Use parseSpec3 |
976 | -- TODO: Report error if generating without specifying usage tag. | 976 | -- TODO: Report error if generating without specifying usage tag. |
977 | let (topspec,subspec) = parseSpec (fromMaybe "" grip) usage | 977 | let (topspec,subspec) = parseSpec grip usage |
978 | -- ms will contain duplicates if a top key has multiple matching | 978 | -- ms will contain duplicates if a top key has multiple matching |
979 | -- subkeys. This is intentional. | 979 | -- subkeys. This is intentional. |
980 | -- ms = map (keykey . fst) $ selectAll True (topspec,subspec) db | 980 | -- ms = map (keykey . fst) $ selectAll True (topspec,subspec) db |
@@ -1026,7 +1026,7 @@ initializeMissingPEMFiles operation ctx grip mwk transcode db = do | |||
1026 | let internals = mapMaybe getParams $ do | 1026 | let internals = mapMaybe getParams $ do |
1027 | (f,stream) <- nonexistents | 1027 | (f,stream) <- nonexistents |
1028 | usage <- take 1 $ mapMaybe usageFromFilter [fill stream,spill stream] | 1028 | usage <- take 1 $ mapMaybe usageFromFilter [fill stream,spill stream] |
1029 | let (topspec,subspec) = parseSpec (fromMaybe "" grip) usage | 1029 | let (topspec,subspec) = parseSpec grip usage |
1030 | guard $ null $ do | 1030 | guard $ null $ do |
1031 | (kk,kd) <- filterMatches topspec $ kkData db | 1031 | (kk,kd) <- filterMatches topspec $ kkData db |
1032 | subkeysForExport subspec kd | 1032 | subkeysForExport subspec kd |
@@ -1071,7 +1071,7 @@ runKeyRing operation = | |||
1071 | 1071 | ||
1072 | withLockedKeyring :: Maybe FilePath | 1072 | withLockedKeyring :: Maybe FilePath |
1073 | -> Map.Map InputFile StreamInfo | 1073 | -> Map.Map InputFile StreamInfo |
1074 | -> (InputFileContext -> Maybe String -> IO (KikiResult a)) | 1074 | -> (InputFileContext -> Maybe Fingerprint -> IO (KikiResult a)) |
1075 | -> IO (KikiResult a) | 1075 | -> IO (KikiResult a) |
1076 | withLockedKeyring homespec opfiles go = do | 1076 | withLockedKeyring homespec opfiles go = do |
1077 | -- get homedir and keyring files + fingerprint for working key | 1077 | -- get homedir and keyring files + fingerprint for working key |
@@ -1099,7 +1099,7 @@ withLockedKeyring homespec opfiles go = do | |||
1099 | return ret | 1099 | return ret |
1100 | 1100 | ||
1101 | 1101 | ||
1102 | realRunKeyRing :: KeyRingOperation -> InputFileContext -> Maybe String -> IO (KikiResult KeyRingRuntime) | 1102 | realRunKeyRing :: KeyRingOperation -> InputFileContext -> Maybe Fingerprint -> IO (KikiResult KeyRingRuntime) |
1103 | realRunKeyRing operation ctx grip0 = do | 1103 | realRunKeyRing operation ctx grip0 = do |
1104 | bresult <- buildKeyDB ctx grip0 operation | 1104 | bresult <- buildKeyDB ctx grip0 operation |
1105 | try' bresult $ \((db, grip, wk, hs, accs,transcode,unspilled), report_imports) -> do | 1105 | try' bresult $ \((db, grip, wk, hs, accs,transcode,unspilled), report_imports) -> do |
@@ -1163,7 +1163,7 @@ parseOptionFile fname = do | |||
1163 | -- , path to public ring | 1163 | -- , path to public ring |
1164 | -- , fingerprint of working key | 1164 | -- , fingerprint of working key |
1165 | -- ) | 1165 | -- ) |
1166 | getHomeDir :: Maybe FilePath -> IO (KikiCondition (FilePath,FilePath,FilePath,Maybe String)) | 1166 | getHomeDir :: Maybe FilePath -> IO (KikiCondition (FilePath,FilePath,FilePath,Maybe Fingerprint)) |
1167 | getHomeDir protohome = do | 1167 | getHomeDir protohome = do |
1168 | homedir <- envhomedir protohome | 1168 | homedir <- envhomedir protohome |
1169 | flip (maybe (return CantFindHome)) | 1169 | flip (maybe (return CantFindHome)) |
@@ -1183,6 +1183,7 @@ getHomeDir protohome = do | |||
1183 | return $ val | 1183 | return $ val |
1184 | 1184 | ||
1185 | -- TODO: rename this to getGrip | 1185 | -- TODO: rename this to getGrip |
1186 | getWorkingKey :: String -> IO (Maybe Fingerprint) | ||
1186 | getWorkingKey homedir = do | 1187 | getWorkingKey homedir = do |
1187 | let o = Nothing | 1188 | let o = Nothing |
1188 | h = Just homedir | 1189 | h = Just homedir |
@@ -1196,5 +1197,6 @@ getHomeDir protohome = do | |||
1196 | \(forgive,fname) -> parseOptionFile fname | 1197 | \(forgive,fname) -> parseOptionFile fname |
1197 | let config = map (topair . words) args | 1198 | let config = map (topair . words) args |
1198 | where topair (x:xs) = (x,xs) | 1199 | where topair (x:xs) = (x,xs) |
1199 | return $ lookup "default-key" config >>= listToMaybe | 1200 | -- return $ lookup "default-key" config >>= listToMaybe |
1201 | return Nothing | ||
1200 | 1202 | ||