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
|
-- Internal.hs: private utility functions and such
-- Copyright © 2012-2019 Clint Adams
-- This software is released under the terms of the Expat license.
-- (See the LICENSE file).
{-# LANGUAGE OverloadedStrings #-}
module Codec.Encryption.OpenPGP.Internal
( countBits
, PktStreamContext(..)
, issuer
, issuerFP
, emptyPSC
, pubkeyToMPIs
, multiplicativeInverse
, curveoidBSToCurve
, curveToCurveoidBS
, point2BS
, curveoidBSToEdSigningCurve
, edSigningCurveToCurveoidBS
, curve2Curve
, curveFromCurve
) where
import Crypto.Number.Serialize (i2osp, os2ip)
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.ECC.Types as ECCT
import qualified Crypto.PubKey.RSA as RSA
import Data.Bits (testBit)
import qualified Data.ByteString as B
import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString.Lazy as BL
import Data.List (find)
import Data.Word (Word16, Word8)
import Codec.Encryption.OpenPGP.Ontology (isIssuerSSP, isIssuerFPSSP, isSigCreationTime)
import Codec.Encryption.OpenPGP.Types
countBits :: ByteString -> Word16
countBits bs
| BL.null bs = 0
| otherwise =
fromIntegral (BL.length bs * 8) - fromIntegral (go (BL.head bs) 7)
where
go :: Word8 -> Int -> Word8
go _ 0 = 7
go n b =
if testBit n b
then 7 - fromIntegral b
else go n (b - 1)
data PktStreamContext =
PktStreamContext
{ lastLD :: Pkt
, lastUIDorUAt :: Pkt
, lastSig :: Pkt
, lastPrimaryKey :: Pkt
, lastSubkey :: Pkt
}
emptyPSC :: PktStreamContext
emptyPSC =
PktStreamContext
(OtherPacketPkt 0 "lastLD placeholder")
(OtherPacketPkt 0 "lastUIDorUAt placeholder")
(OtherPacketPkt 0 "lastSig placeholder")
(OtherPacketPkt 0 "lastPrimaryKey placeholder")
(OtherPacketPkt 0 "lastSubkey placeholder")
issuer :: Pkt -> Maybe EightOctetKeyId
issuer (SignaturePkt (SigV4 _ _ _ _ usubs _ _)) =
fmap (\(SigSubPacket _ (Issuer i)) -> i) (find isIssuerSSP usubs)
issuer _ = Nothing
issuerFP :: Pkt -> Maybe TwentyOctetFingerprint
issuerFP (SignaturePkt (SigV4 _ _ _ hsubs _ _ _)) =
fmap (\(SigSubPacket _ (IssuerFingerprint _ i)) -> i) (find isIssuerFPSSP hsubs)
issuerFP _ = Nothing
pubkeyToMPIs :: PKey -> [MPI]
pubkeyToMPIs (RSAPubKey (RSA_PublicKey k)) =
[MPI (RSA.public_n k), MPI (RSA.public_e k)]
pubkeyToMPIs (DSAPubKey (DSA_PublicKey k)) =
[ pkParams DSA.params_p
, pkParams DSA.params_q
, pkParams DSA.params_g
, MPI . DSA.public_y $ k
]
where
pkParams f = MPI . f . DSA.public_params $ k
pubkeyToMPIs (ElGamalPubKey p g y) = [MPI p, MPI g, MPI y]
pubkeyToMPIs (ECDHPubKey (ECDSAPubKey (ECDSA_PublicKey (ECDSA.PublicKey _ q))) _ _) =
[MPI (os2ip (point2BS q))]
pubkeyToMPIs (ECDHPubKey (EdDSAPubKey _ (EPoint x)) _ _) = [MPI x]
pubkeyToMPIs (ECDSAPubKey ((ECDSA_PublicKey (ECDSA.PublicKey _ q)))) =
[MPI (os2ip (point2BS q))]
pubkeyToMPIs (EdDSAPubKey _ (EPoint x)) = [MPI x]
multiplicativeInverse :: Integral a => a -> a -> a
multiplicativeInverse _ 1 = 1
multiplicativeInverse q p = (n * q + 1) `div` p
where
n = p - multiplicativeInverse p (q `mod` p)
curveoidBSToCurve :: B.ByteString -> Either String ECCCurve
curveoidBSToCurve oidbs
| B.pack [0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07] == oidbs =
Right $ NISTP256 -- ECCT.getCurveByName ECCT.SEC_p256r1
| B.pack [0x2B, 0x81, 0x04, 0x00, 0x22] == oidbs = Right $ NISTP384 -- ECCT.getCurveByName ECCT.SEC_p384r1
| B.pack [0x2B, 0x81, 0x04, 0x00, 0x23] == oidbs = Right $ NISTP521 -- ECCT.getCurveByName ECCT.SEC_p521r1
| B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0x97, 0x55, 0x01, 0x05, 0x01] == oidbs =
Right Curve25519
| otherwise = Left $ concat ["unknown curve (...", show (B.unpack oidbs), ")"]
curveToCurveoidBS :: ECCCurve -> Either String B.ByteString
curveToCurveoidBS NISTP256 =
Right $ B.pack [0x2A, 0x86, 0x48, 0xCE, 0x3D, 0x03, 0x01, 0x07]
curveToCurveoidBS NISTP384 = Right $ B.pack [0x2B, 0x81, 0x04, 0x00, 0x22]
curveToCurveoidBS NISTP521 = Right $ B.pack [0x2B, 0x81, 0x04, 0x00, 0x23]
curveToCurveoidBS Curve25519 =
Right $ B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0x97, 0x55, 0x01, 0x05, 0x01]
curveToCurveoidBS _ = Left "unknown curve"
point2BS :: ECCT.PublicPoint -> B.ByteString
point2BS (ECCT.Point x y) = B.concat [B.singleton 0x04, i2osp x, i2osp y] -- FIXME: check for length equality?
point2BS ECCT.PointO = error "FIXME: point at infinity"
curveoidBSToEdSigningCurve :: B.ByteString -> Either String EdSigningCurve
curveoidBSToEdSigningCurve oidbs
| B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01] == oidbs =
Right Ed25519
| otherwise =
Left $
concat ["unknown Edwards signing curve (...", show (B.unpack oidbs), ")"]
edSigningCurveToCurveoidBS :: EdSigningCurve -> Either String B.ByteString
edSigningCurveToCurveoidBS Ed25519 =
Right $ B.pack [0x2B, 0x06, 0x01, 0x04, 0x01, 0xDA, 0x47, 0x0F, 0x01]
curve2Curve :: ECCCurve -> ECCT.Curve
curve2Curve NISTP256 = ECCT.getCurveByName ECCT.SEC_p256r1
curve2Curve NISTP384 = ECCT.getCurveByName ECCT.SEC_p384r1
curve2Curve NISTP521 = ECCT.getCurveByName ECCT.SEC_p521r1
curveFromCurve :: ECCT.Curve -> ECCCurve
curveFromCurve c
| c == ECCT.getCurveByName ECCT.SEC_p256r1 = NISTP256
| c == ECCT.getCurveByName ECCT.SEC_p384r1 = NISTP384
| c == ECCT.getCurveByName ECCT.SEC_p521r1 = NISTP521
|
