summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorjoe <joe@jerkface.net>2014-04-14 22:27:59 -0400
committerjoe <joe@jerkface.net>2014-04-14 22:27:59 -0400
commit6b3ecc5010905d42c0a3c33e6850210a8cf615fc (patch)
tree6a4d5094a1b7f38e71ec1e537204201999003c71
parent8ae8570ca4d03314b52045c5a4e71078e7db9593 (diff)
FailedToMakeSignature error
-rw-r--r--KeyRing.hs21
1 files changed, 12 insertions, 9 deletions
diff --git a/KeyRing.hs b/KeyRing.hs
index 9854b84..a2485c4 100644
--- a/KeyRing.hs
+++ b/KeyRing.hs
@@ -86,7 +86,8 @@ data KeyRingAction a = KeyRingAction a | RunTimeAction (KeyRingRuntime -> a)
86 86
87data KeyRingData = KeyRingData 87data KeyRingData = KeyRingData
88 { kFiles :: Map.Map InputFile (RefType,FileType) 88 { kFiles :: Map.Map InputFile (RefType,FileType)
89 , kImports :: Map.Map String (KeyData -> Bool) 89 , kImports :: Map.Map FilePath (KeyData -> Bool)
90 -- ^ indicates what pgp packets get written to which keyring files
90 , homeSpec :: Maybe String 91 , homeSpec :: Maybe String
91 } 92 }
92 93
@@ -165,13 +166,14 @@ data RSAPrivateKey = RSAPrivateKey
165 deriving Show 166 deriving Show
166 167
167 168
168data KikiCondition a = KikiSuccess a | FailedToLock [FilePath] | BadPassphrase 169data KikiCondition a = KikiSuccess a | FailedToLock [FilePath] | BadPassphrase | FailedToMakeSignature
169 170
170#define TRIVIAL(OP) fmap _ (OP) = OP 171#define TRIVIAL(OP) fmap _ (OP) = OP
171instance Functor KikiCondition where 172instance Functor KikiCondition where
172 fmap f (KikiSuccess a) = KikiSuccess (f a) 173 fmap f (KikiSuccess a) = KikiSuccess (f a)
173 TRIVIAL( FailedToLock x ) 174 TRIVIAL( FailedToLock x )
174 TRIVIAL( BadPassphrase ) 175 TRIVIAL( BadPassphrase )
176 TRIVIAL( FailedToMakeSignature )
175instance FunctorToMaybe KikiCondition where 177instance FunctorToMaybe KikiCondition where
176 functorToMaybe (KikiSuccess a) = Just a 178 functorToMaybe (KikiSuccess a) = Just a
177 functorToMaybe _ = Nothing 179 functorToMaybe _ = Nothing
@@ -185,7 +187,7 @@ data KikiReportAction =
185 | YieldSignature 187 | YieldSignature
186 | YieldSecretKeyPacket String 188 | YieldSecretKeyPacket String
187 | UnableToUpdateExpiredSignature 189 | UnableToUpdateExpiredSignature
188 | FailedToMakeSignature 190 | WarnFailedToMakeSignature
189 191
190data KikiResult a = KikiResult 192data KikiResult a = KikiResult
191 { kikiCondition :: KikiCondition a 193 { kikiCondition :: KikiCondition a
@@ -538,7 +540,7 @@ doImportG doDecrypt db m0 tag fname key = do
538 tor_ov 540 tor_ov
539 SHA1 541 SHA1
540 (fingerprint wkun) 542 (fingerprint wkun)
541 flip (maybe $ return $ KikiSuccess (uids,[(fname, FailedToMakeSignature)])) 543 flip (maybe $ return $ KikiSuccess (uids,[(fname, WarnFailedToMakeSignature)]))
542 (sig_ov >>= listToMaybe . signatures_over) 544 (sig_ov >>= listToMaybe . signatures_over)
543 $ \sig -> do 545 $ \sig -> do
544 let om = Map.singleton fname (origin sig (-1)) 546 let om = Map.singleton fname (origin sig (-1))
@@ -862,11 +864,11 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
862 try wkun $ \wkun -> do 864 try wkun $ \wkun -> do
863 let grip = fingerprint wk 865 let grip = fingerprint wk
864 addOrigin new_sig = do 866 addOrigin new_sig = do
865 flip (maybe $ error "Failed to make signature.") 867 flip (maybe $ return FailedToMakeSignature)
866 (new_sig >>= listToMaybe . signatures_over) 868 (new_sig >>= listToMaybe . signatures_over)
867 $ \new_sig -> do 869 $ \new_sig -> do
868 let mp' = mappedPacket fname new_sig 870 let mp' = mappedPacket fname new_sig
869 return (mp', Map.empty) 871 return $ KikiSuccess (mp', Map.empty)
870 parsedkey = [packet $ subkey_p] 872 parsedkey = [packet $ subkey_p]
871 hashed0 = 873 hashed0 =
872 [ KeyFlagsPacket 874 [ KeyFlagsPacket
@@ -910,8 +912,8 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
910 SHA1 912 SHA1
911 grip 913 grip
912 let newSig = do 914 let newSig = do
913 (k,o) <- addOrigin new_sig 915 r <- addOrigin new_sig
914 return $ KikiSuccess ((k,o),[]) 916 return $ fmap (,[]) r
915 flip (maybe newSig) mbsig $ \(mp,trustmap) -> do 917 flip (maybe newSig) mbsig $ \(mp,trustmap) -> do
916 let sig = packet mp 918 let sig = packet mp
917 isCreation (SignatureCreationTimePacket {}) = True 919 isCreation (SignatureCreationTimePacket {}) = True
@@ -944,7 +946,8 @@ makeSig doDecrypt top fname subkey_p tag mbsig = do
944 [sig'] ) 946 [sig'] )
945 SHA1 947 SHA1
946 (fingerprint wk) 948 (fingerprint wk)
947 fmap (KikiSuccess . (,[])) $ addOrigin new_sig 949 newsig <- addOrigin new_sig
950 return $ fmap (,[]) newsig
948 951
949 952
950 953