diff options
author | joe <joe@jerkface.net> | 2013-12-13 04:02:20 -0500 |
---|---|---|
committer | joe <joe@jerkface.net> | 2013-12-13 12:54:05 -0500 |
commit | 30953649e78c1d051f8d5bc18ad25a3474baecb1 (patch) | |
tree | 8f06a10c4ccd967c15cba3b64782cc2b5c94e735 | |
parent | e1bda6dbf5430c9bfbf91fc499b01b147db2bd8a (diff) |
OpenPGP module to insulate the code from Data.OpenPGP.CryptoAPI
-rw-r--r-- | OpenPGP.hs | 42 |
1 files changed, 42 insertions, 0 deletions
diff --git a/OpenPGP.hs b/OpenPGP.hs new file mode 100644 index 0000000..7fef0b5 --- /dev/null +++ b/OpenPGP.hs | |||
@@ -0,0 +1,42 @@ | |||
1 | module OpenPGP | ||
2 | ( verify | ||
3 | , fingerprint | ||
4 | , pgpSign | ||
5 | , decryptSecretKey | ||
6 | ) where | ||
7 | |||
8 | import Data.OpenPGP as OpenPGP | ||
9 | import Data.OpenPGP.CryptoAPI (verify,fingerprint,sign,decryptSecretKey) | ||
10 | import Data.Time.Clock.POSIX | ||
11 | import Control.Applicative ( (<$>) ) | ||
12 | import Crypto.Random (newGenIO,SystemRandom) | ||
13 | |||
14 | now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime | ||
15 | |||
16 | stampit timestamp sig = sig { hashed_subpackets = hashed' } | ||
17 | where | ||
18 | hashed_stamps = filter isStamp (hashed_subpackets sig) | ||
19 | unhashed_stamps = filter isStamp (unhashed_subpackets sig) | ||
20 | hashed' = case hashed_stamps ++ unhashed_stamps of | ||
21 | [] -> SignatureCreationTimePacket (fromIntegral timestamp) | ||
22 | : hashed_subpackets sig | ||
23 | _ -> hashed_subpackets sig | ||
24 | isStamp (SignatureCreationTimePacket {}) = True | ||
25 | isStamp _ = False | ||
26 | |||
27 | -- | Make a signature | ||
28 | -- | ||
29 | -- In order to set more options on a signature, pass in a signature packet. | ||
30 | pgpSign :: | ||
31 | OpenPGP.Message -- ^ SecretKeys, one of which will be used | ||
32 | -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet | ||
33 | -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature | ||
34 | -> String -- ^ KeyID of key to choose | ||
35 | -> IO OpenPGP.SignatureOver | ||
36 | pgpSign seckeys dta hash_algo keyid = do | ||
37 | timestamp <- now | ||
38 | g <- newGenIO :: IO SystemRandom | ||
39 | let sigs = map (stampit timestamp) $ signatures_over dta | ||
40 | dta' = dta { signatures_over = sigs } | ||
41 | let (r,g') = sign seckeys dta' hash_algo keyid timestamp g | ||
42 | return r | ||