summaryrefslogtreecommitdiff
path: root/Data/OpenPGP/Util/Sign.hs
blob: a074dcb7331f5bea1c47edd738d1dd80d3012805 (plain)
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
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE PatternGuards       #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.OpenPGP.Util.Sign where

import qualified Data.OpenPGP as OpenPGP
import Data.Maybe
import Data.Binary (encode)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LZ
import Data.Bits ( (.|.), shiftL )
import Control.Applicative ( (<$>) )
#if defined(VERSION_cryptonite)
import Data.Hourglass
import System.Hourglass
#else
import Data.Time.Clock.POSIX
#endif
import Control.Exception as Exception (IOException(..),catch)

import qualified Crypto.Random as Vincent
import qualified Crypto.PubKey.DSA as Vincent.DSA
import qualified Crypto.PubKey.RSA as Vincent.RSA
import qualified Crypto.PubKey.RSA.PKCS15 as Vincent.RSA
import qualified Crypto.PubKey.ECC.ECDSA as Vincent.ECDSA
import qualified Crypto.PubKey.Curve25519 as Cv25519

import qualified Data.ByteArray as BA
import Crypto.XEd25519 as Xed25519
import Data.OpenPGP.Util.Ed25519
import Data.OpenPGP.Util.Cv25519
import Data.OpenPGP.Util.Fingerprint (fingerprint)
import Data.OpenPGP.Util.Gen
import Data.OpenPGP.Util.Base
import Data.OpenPGP.Internal


privateECDSAkey :: OpenPGP.Packet -> Vincent.ECDSA.PrivateKey
privateECDSAkey k = Vincent.ECDSA.PrivateKey curve d
 where
    d = keyParam 'd' k
    curve = curveFromOID (keyParam 'c' k)

privateDSAkey :: OpenPGP.Packet -> Vincent.DSA.PrivateKey
privateDSAkey k = Vincent.DSA.PrivateKey
    (Vincent.DSA.Params (keyParam 'p' k) (keyParam 'g' k) (keyParam 'q' k))
    (keyParam 'x' k)
privateRSAkey :: OpenPGP.Packet -> Vincent.RSA.PrivateKey
privateRSAkey k =
    -- Invert p and q because u is pinv not qinv
    Vincent.RSA.PrivateKey pubkey d q p
        (d `mod` (q-1))
        (d `mod` (p-1))
        (keyParam 'u' k)
    where
    d = keyParam 'd' k
    p = keyParam 'p' k
    q = keyParam 'q' k
    pubkey = rsaKey k

xed25519Sign :: Vincent.MonadRandom m =>
                Cv25519.SecretKey
                -> OpenPGP.HashAlgorithm
                -> BS.ByteString
                -> m [Integer]
xed25519Sign cv25519key hsh dta = do
    let hashbs = hashBySymbol hsh $ LZ.fromChunks [dta]
        (sec,pub) = Xed25519.toSigningKeyPair cv25519key
    nonce <- Vincent.getRandomBytes 32
    let sig = Xed25519.sign hashbs nonce sec pub
        (rbs,sbs) = BS.splitAt 32 $ BA.convert sig
    return [ getBigNum rbs, getBigNum sbs ]

-- | Make a signature
--
-- In order to set more options on a signature, pass in a signature packet.
-- Operation is unsafe in that it silently re-uses "random" bytes when
-- entropy runs out.  Use pgpSign for a safer interface.
unsafeSign :: (RG g) => -- CryptoRandomGen g) =>
    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
    -> Integer               -- ^ Timestamp for signature (unless sig supplied)
    -> g                     -- ^ Random number generator
    -> (OpenPGP.SignatureOver, g)
unsafeSign keys over hsh keyid timestamp g = (over {OpenPGP.signatures_over = [sig]}, g')
    where
    (final, g') = case OpenPGP.key_algorithm sig of
        OpenPGP.DSA -> ([dsaR, dsaS], dsaG)
        OpenPGP.ECDSA -> ([ecdsaR,ecdsaS],ecdsaG)
        OpenPGP.Ed25519 -> (ed25519Sign k hsh dta, g)
        OpenPGP.ECC | oid_cv25519 == keyParam 'c' k
                    , Just cvk <- privateCv25519Key k
                        -> Vincent.withDRG g $ xed25519Sign cvk hsh dta
        kalgo | kalgo `elem` [OpenPGP.RSA,OpenPGP.RSA_S] -> ([toNum rsaFinal], g)
              | otherwise ->
            error ("Unsupported key algorithm " ++ show kalgo ++ " in sign")
#if defined(VERSION_cryptonite)
    (Vincent.DSA.Signature dsaR dsaS,dsaG) = let k' = privateDSAkey k in
        case desc of
            HashDescr h -> Vincent.withDRG g $ Vincent.DSA.sign k' h dta -- XXX: What happend to dsaTruncate ?
    (Vincent.ECDSA.Signature ecdsaR ecdsaS,ecdsaG) = let k' = privateECDSAkey k in
        case desc of
            HashDescr h -> Vincent.withDRG g $ Vincent.ECDSA.sign k' h dta
    (Right rsaFinal,_) = case desc of
                          HashDescr h -> Vincent.withDRG g $ Vincent.RSA.signSafer (Just h) (privateRSAkey k) dta
#else
    (Vincent.DSA.Signature dsaR dsaS,dsaG) = let k' = privateDSAkey k in
        Vincent.DSA.sign g k' (dsaTruncate k' . bhash) dta
    (Vincent.ECDSA.Signature ecdsaR ecdsaS,ecdsaG) = let k' = privateECDSAkey k in
        Vincent.ECDSA.sign g k' bhash dta
    (Right rsaFinal,_) = Vincent.RSA.signSafer g desc (privateRSAkey k) dta
#endif
    dsaTruncate (Vincent.DSA.PrivateKey (Vincent.DSA.Params _ _ q) _) = BS.take (integerBytesize q)
    dta     = LZ.toStrict $ encode over `LZ.append` OpenPGP.trailer sig
    sig     = findSigOrDefault (listToMaybe $ OpenPGP.signatures_over over)
    -- padding = emsa_pkcs1_v1_5_hash_padding hsh
    desc = hashAlgoDesc hsh
    bhash   = hashBySymbol hsh . toLazyBS
    toNum   = BS.foldl (\a b -> a `shiftL` 8 .|. fromIntegral b) 0
    Just k  = find_key keys keyid

    -- Either a SignaturePacket was found, or we need to make one
    findSigOrDefault (Just s) = OpenPGP.signaturePacket
        (OpenPGP.version s)
        (OpenPGP.signature_type s)
        (OpenPGP.key_algorithm k) -- force to algo of key
        hsh -- force hash algorithm
        (OpenPGP.hashed_subpackets s)
        (OpenPGP.unhashed_subpackets s)
        (OpenPGP.hash_head s)
        (map OpenPGP.MPI final)
    findSigOrDefault Nothing  = OpenPGP.signaturePacket
        4
        defaultStype
        (OpenPGP.key_algorithm k) -- force to algo of key
        hsh
        ([
            -- Do we really need to pass in timestamp just for the default?
            OpenPGP.SignatureCreationTimePacket $ fromIntegral timestamp,
            OpenPGP.IssuerPacket $ show $ fingerprint k
        ] ++ (case over of
            OpenPGP.KeySignature  {} -> [OpenPGP.KeyFlagsPacket {
                    OpenPGP.certify_keys = True,
                    OpenPGP.sign_data = True,
                    OpenPGP.encrypt_communication = False,
                    OpenPGP.encrypt_storage = False,
                    OpenPGP.split_key = False,
                    OpenPGP.authentication = False,
                    OpenPGP.group_key = False
                }]
            _ -> []
        ))
        []
        0 -- TODO
        (map OpenPGP.MPI final)

    defaultStype = case over of
        OpenPGP.DataSignature ld _
            | OpenPGP.format ld == 'b'     -> 0x00
            | otherwise                    -> 0x01
        OpenPGP.KeySignature {}           -> 0x1F
        OpenPGP.SubkeySignature {}        -> 0x18
        OpenPGP.CertificationSignature {} -> 0x13



stampit timestamp sig = sig { OpenPGP.hashed_subpackets = hashed' }
 where
    hashed_stamps   = filter isStamp (OpenPGP.hashed_subpackets sig)
    unhashed_stamps = filter isStamp (OpenPGP.unhashed_subpackets sig)
    hashed' = case hashed_stamps ++ unhashed_stamps of
                [] -> OpenPGP.SignatureCreationTimePacket (fromIntegral timestamp)
                      : OpenPGP.hashed_subpackets sig
                _  -> OpenPGP.hashed_subpackets sig
    isStamp (OpenPGP.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 (Maybe OpenPGP.SignatureOver)
pgpSign seckeys dta hash_algo keyid =
    handleIO_ (return Nothing) $ do
    timestamp <- currentTime
    -- g <- Thomas.newGenIO :: IO Thomas.SystemRandom
    -- g <- fmap Vincent.cprgCreate $ Vincent.createEntropyPool
    g <- makeGen Nothing
    let _ = g :: RNG
    let sigs = map (stampit timestamp) $ OpenPGP.signatures_over dta
        dta' = dta { OpenPGP.signatures_over = sigs }
    let (r,g') = unsafeSign seckeys dta' hash_algo keyid timestamp g
    return (Just r)

catchIO_ :: IO a -> IO a -> IO a
catchIO_ a h = Exception.catch a (\(_ :: IOException) -> h)

catchIO :: IO a -> (IOException -> IO a)  -> IO a
catchIO body handler = Exception.catch body handler

handleIO_ = flip catchIO_
handleIO = flip catchIO