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
|
-- | PKCS #12 tests.
module PKCS12.Tests (pkcs12Tests) where
import Control.Monad (forM_)
import Data.PEM (pemContent)
import Data.String (fromString)
import Crypto.Store.PKCS12
import Crypto.Store.PKCS8
import Crypto.Store.X509 (readSignedObject)
import Test.Tasty
import Test.Tasty.HUnit
import Test.Tasty.QuickCheck
import Util
import PKCS12.Instances
import X509.Instances
testType :: TestName -> String -> TestTree
testType caseName prefix = testCaseSteps caseName $ \step -> do
let fKey = testFile (prefix ++ "-unencrypted-pkcs8.pem")
fCert = testFile (prefix ++ "-self-signed-cert.pem")
p12 = testFile (prefix ++ "-pkcs12.pem")
step "Reading PKCS #12 files"
pems <- readPEMs p12
length pems @?= length names
step "Reading private key"
[Unprotected key] <- readKeyFile fKey
step "Reading certificate"
certs <- readSignedObject fCert
forM_ (zip names pems) $ \(name, pem) -> do
let r = readP12FileFromMemory (pemContent pem)
assertRight r $ \integrity ->
assertRight (recoverAuthenticated pwd integrity) $ \(ppwd, privacy) ->
assertRight (recover ppwd $ unPKCS12 privacy) $ \scs -> do
step ("Testing " ++ name)
recover ppwd (getAllSafeKeys scs) @?= Right [key]
getAllSafeX509Certs scs @?= certs
where
pwd = fromString "dontchangeme"
nameIntegrity n = "integrity with " ++ n
namePrivacy t n = t ++ " privacy with " ++ n
integrityNames = map nameIntegrity integrityModes
privacyNames t = ("without " ++ t ++ " privacy") :
map (namePrivacy t) privacyModes
names = [ "without integrity" ] ++ integrityNames ++
privacyNames "certificate" ++ privacyNames "private-key"
integrityModes = [ "SHA-1"
, "SHA-256"
, "SHA-384"
]
privacyModes = [ "aes-128-cbc"
, "PBE-SHA1-RC2-128"
, "PBE-SHA1-RC2-40"
]
testEmptyPassword :: TestTree
testEmptyPassword = testCaseSteps "empty password" $ \step -> do
step "Reading PKCS #12 files"
pems <- readPEMs path
length pems @?= length infos
forM_ (zip infos pems) $ \((name, numKeys, numCerts), pem) -> do
let r = readP12FileFromMemory (pemContent pem)
assertRight r $ \integrity ->
assertRight (recoverAuthenticated pwd integrity) $ \(ppwd, privacy) ->
assertRight (recover ppwd $ unPKCS12 privacy) $ \scs -> do
step ("Testing " ++ name)
assertRight (recover ppwd $ getAllSafeKeys scs) $ \keys ->
length keys @?= numKeys
length (getAllSafeX509Certs scs) @?= numCerts
where
pwd = fromString ""
path = testFile "pkcs12-empty-password.pem"
infos = [ ("Windows Certificate Export Wizard", 1, 2)
, ("OpenSSL", 1, 1)
, ("GnuTLS with --empty-password", 1, 1)
, ("GnuTLS with --null-password", 1, 1)
]
propertyTests :: TestTree
propertyTests = localOption (QuickCheckMaxSize 5) $ testGroup "properties"
[ testProperty "marshalling" $ do
pE <- arbitrary
c <- arbitraryPKCS12 pE
let r = readP12FileFromMemory $ writeUnprotectedP12FileToMemory c
unused = fromString "not-used"
return $ Right (Right c) === (fmap snd . recoverAuthenticated unused <$> r)
, testProperty "marshalling with authentication" $ do
params <- arbitraryIntegrityParams
c <- arbitrary >>= arbitraryPKCS12
pI <- arbitrary
let r = readP12FileFromMemory <$> writeP12FileToMemory params pI c
p = fromProtectionPassword pI
return $ Right (Right (Right (pI, c))) === (fmap (recoverAuthenticated p) <$> r)
, localOption (QuickCheckTests 20) $ testProperty "converting credentials" $
\pChain pKey privKey ->
testCredConv privKey toCredential (fromCredential pChain pKey)
, localOption (QuickCheckTests 20) $ testProperty "converting named credentials" $
\pChain pKey privKey -> do
name <- arbitraryAlias
testCredConv privKey
(toNamedCredential name)
(fromNamedCredential name pChain pKey)
]
where
testCredConv privKey to from = do
pwd <- arbitrary
chain <- arbitrary >>= arbitraryCertificateChain
chain' <- shuffleCertificateChain chain
let cred = (chain, privKey)
r = from pwd (chain', privKey) >>= recover pwd . to
return $ Right (Just cred) === r
pkcs12Tests :: TestTree
pkcs12Tests =
testGroup "PKCS12"
[ testType "RSA" "rsa"
, testType "Ed25519" "ed25519"
, testEmptyPassword
, propertyTests
]
|
