OpenPGP.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42

module OpenPGP 
 ( verify
 , fingerprint
 , pgpSign
 , decryptSecretKey
 ) where

import Data.OpenPGP as OpenPGP
import Data.OpenPGP.CryptoAPI (verify,fingerprint,sign,decryptSecretKey)
import Data.Time.Clock.POSIX
import Control.Applicative ( (<$>) )
import Crypto.Random (newGenIO,SystemRandom)

now = floor <$> Data.Time.Clock.POSIX.getPOSIXTime

stampit timestamp sig = sig { hashed_subpackets = hashed' }
 where
    hashed_stamps   = filter isStamp (hashed_subpackets sig)
    unhashed_stamps = filter isStamp (unhashed_subpackets sig)
    hashed' = case hashed_stamps ++ unhashed_stamps of
                [] -> SignatureCreationTimePacket (fromIntegral timestamp)
                      : hashed_subpackets sig
                _  -> hashed_subpackets sig
    isStamp (SignatureCreationTimePacket {}) = True
    isStamp _                                = False

-- | Make a signature
--
-- In order to set more options on a signature, pass in a signature packet.
pgpSign :: 
    OpenPGP.Message          -- ^ SecretKeys, one of which will be used
    -> OpenPGP.SignatureOver -- ^ Data to sign, and optional signature packet
    -> OpenPGP.HashAlgorithm -- ^ HashAlgorithm to use in signature
    -> String                -- ^ KeyID of key to choose
    -> IO OpenPGP.SignatureOver
pgpSign seckeys dta hash_algo keyid = do
    timestamp <- now
    g <- newGenIO :: IO SystemRandom
    let sigs = map (stampit timestamp) $ signatures_over dta
        dta' = dta { signatures_over = sigs }
    let (r,g') = sign seckeys dta' hash_algo keyid timestamp g
    return r