{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Crypto.Store.PKCS12
( IntegrityParams
, readP12File
, readP12FileFromMemory
, writeP12File
, writeP12FileToMemory
, writeUnprotectedP12File
, writeUnprotectedP12FileToMemory
, PKCS12
, unPKCS12
, unPKCS12'
, unencrypted
, encrypted
, SafeContents(..)
, SafeBag
, Bag(..)
, SafeInfo(..)
, CertInfo(..)
, CRLInfo(..)
, Attribute(..)
, getSafeKeys
, getAllSafeKeys
, getSafeX509Certs
, getAllSafeX509Certs
, getSafeX509CRLs
, getAllSafeX509CRLs
, findAttribute
, setAttribute
, filterAttributes
, getFriendlyName
, setFriendlyName
, getLocalKeyId
, setLocalKeyId
, fromCredential
, fromNamedCredential
, toCredential
, toNamedCredential
, Password
, OptAuthenticated(..)
, recoverAuthenticated
, ProtectionPassword
, emptyNotTerminated
, fromProtectionPassword
, toProtectionPassword
, OptProtected(..)
, recover
, recoverA
) where
import Control.Monad
import Data.ASN1.Types
import qualified Data.ByteArray as B
import qualified Data.ByteString as BS
import Data.List (partition)
import Data.Maybe (fromMaybe, mapMaybe)
import Data.Semigroup
import qualified Data.X509 as X509
import qualified Data.X509.Validation as X509
import Crypto.Cipher.Types
import Crypto.Store.ASN1.Generate
import Crypto.Store.ASN1.Parse
import Crypto.Store.CMS
import Crypto.Store.CMS.Algorithms
import Crypto.Store.CMS.Attribute
import Crypto.Store.CMS.Encrypted
import Crypto.Store.CMS.Enveloped
import Crypto.Store.CMS.Util
import Crypto.Store.Error
import Crypto.Store.PKCS5
import Crypto.Store.PKCS5.PBES1
import Crypto.Store.PKCS8
data OptAuthenticated a = Unauthenticated a
| Authenticated (Password -> Either StoreError (ProtectionPassword, a))
instance Functor OptAuthenticated where
fmap :: forall a b. (a -> b) -> OptAuthenticated a -> OptAuthenticated b
fmap a -> b
f (Unauthenticated a
x) = forall a. a -> OptAuthenticated a
Unauthenticated (a -> b
f a
x)
fmap a -> b
f (Authenticated ByteString -> Either StoreError (ProtectionPassword, a)
g) = forall a.
(ByteString -> Either StoreError (ProtectionPassword, a))
-> OptAuthenticated a
Authenticated (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either StoreError (ProtectionPassword, a)
g)
recoverAuthenticated :: Password -> OptAuthenticated a -> Either StoreError (ProtectionPassword, a)
recoverAuthenticated :: forall a.
ByteString
-> OptAuthenticated a -> Either StoreError (ProtectionPassword, a)
recoverAuthenticated ByteString
pwd (Unauthenticated a
x) = forall a b. b -> Either a b
Right (ByteString -> ProtectionPassword
toProtectionPassword ByteString
pwd, a
x)
recoverAuthenticated ByteString
pwd (Authenticated ByteString -> Either StoreError (ProtectionPassword, a)
f) = ByteString -> Either StoreError (ProtectionPassword, a)
f ByteString
pwd
readP12File :: FilePath -> IO (Either StoreError (OptAuthenticated PKCS12))
readP12File :: String -> IO (Either StoreError (OptAuthenticated PKCS12))
readP12File String
path = ByteString -> Either StoreError (OptAuthenticated PKCS12)
readP12FileFromMemory forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
BS.readFile String
path
readP12FileFromMemory :: BS.ByteString -> Either StoreError (OptAuthenticated PKCS12)
readP12FileFromMemory :: ByteString -> Either StoreError (OptAuthenticated PKCS12)
readP12FileFromMemory ByteString
ber = forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode ByteString
ber forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {a}.
ParseASN1Object [ASN1Event] a =>
PFX -> Either StoreError (OptAuthenticated a)
integrity
where
integrity :: PFX -> Either StoreError (OptAuthenticated a)
integrity PFX{Maybe MacData
ByteString
macData :: PFX -> Maybe MacData
authSafeData :: PFX -> ByteString
macData :: Maybe MacData
authSafeData :: ByteString
..} =
case Maybe MacData
macData of
Maybe MacData
Nothing -> forall a. a -> OptAuthenticated a
Unauthenticated forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode ByteString
authSafeData
Just MacData
md -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a.
(ByteString -> Either StoreError (ProtectionPassword, a))
-> OptAuthenticated a
Authenticated (forall {a}.
ParseASN1Object [ASN1Event] a =>
MacData
-> ByteString
-> ByteString
-> Either StoreError (ProtectionPassword, a)
verify MacData
md ByteString
authSafeData)
verify :: MacData
-> ByteString
-> ByteString
-> Either StoreError (ProtectionPassword, a)
verify MacData{MessageAuthenticationCode
DigestAlgorithm
PBEParameter
macParams :: MacData -> PBEParameter
macValue :: MacData -> MessageAuthenticationCode
digAlg :: MacData -> DigestAlgorithm
macParams :: PBEParameter
macValue :: MessageAuthenticationCode
digAlg :: DigestAlgorithm
..} ByteString
content ByteString
pwdUTF8 =
case DigestAlgorithm
digAlg of
DigestAlgorithm DigestProxy hashAlg
d -> [ProtectionPassword] -> Either StoreError (ProtectionPassword, a)
loop (ByteString -> [ProtectionPassword]
toProtectionPasswords ByteString
pwdUTF8)
where
loop :: [ProtectionPassword] -> Either StoreError (ProtectionPassword, a)
loop [] = forall a b. a -> Either a b
Left StoreError
BadContentMAC
loop (ProtectionPassword
pwd:[ProtectionPassword]
others) =
let fn :: Key
-> MACAlgorithm
-> ByteString
-> Either StoreError (ProtectionPassword, a)
fn Key
key MACAlgorithm
macAlg ByteString
bs
| Bool -> Bool
not (forall params. HasStrength params => params -> Bool
securityAcceptable MACAlgorithm
macAlg) =
forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"Integrity MAC too weak")
| MessageAuthenticationCode
macValue forall a. Eq a => a -> a -> Bool
== forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
macAlg Key
key ByteString
bs = (ProtectionPassword
pwd,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode ByteString
bs
| Bool
otherwise = [ProtectionPassword] -> Either StoreError (ProtectionPassword, a)
loop [ProtectionPassword]
others
in forall hash result.
HashAlgorithm hash =>
(StoreError -> result)
-> (Key -> MACAlgorithm -> ByteString -> result)
-> DigestProxy hash
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> result
pkcs12mac forall a b. a -> Either a b
Left Key
-> MACAlgorithm
-> ByteString
-> Either StoreError (ProtectionPassword, a)
fn DigestProxy hashAlg
d PBEParameter
macParams ByteString
content ProtectionPassword
pwd
type IntegrityParams = (DigestAlgorithm, PBEParameter)
writeP12File :: FilePath
-> IntegrityParams -> ProtectionPassword
-> PKCS12
-> IO (Either StoreError ())
writeP12File :: String
-> IntegrityParams
-> ProtectionPassword
-> PKCS12
-> IO (Either StoreError ())
writeP12File String
path IntegrityParams
intp ProtectionPassword
pw PKCS12
aSafe =
case IntegrityParams
-> ProtectionPassword -> PKCS12 -> Either StoreError ByteString
writeP12FileToMemory IntegrityParams
intp ProtectionPassword
pw PKCS12
aSafe of
Left StoreError
e -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left StoreError
e)
Right ByteString
bs -> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> ByteString -> IO ()
BS.writeFile String
path ByteString
bs
writeP12FileToMemory :: IntegrityParams -> ProtectionPassword
-> PKCS12
-> Either StoreError BS.ByteString
writeP12FileToMemory :: IntegrityParams
-> ProtectionPassword -> PKCS12 -> Either StoreError ByteString
writeP12FileToMemory (alg :: DigestAlgorithm
alg@(DigestAlgorithm DigestProxy hashAlg
hashAlg), PBEParameter
pbeParam) ProtectionPassword
pwdUTF8 PKCS12
aSafe =
MacData -> ByteString
encode forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError MacData
protect
where
content :: ByteString
content = forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object PKCS12
aSafe
encode :: MacData -> ByteString
encode MacData
md = forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object PFX { authSafeData :: ByteString
authSafeData = ByteString
content, macData :: Maybe MacData
macData = forall a. a -> Maybe a
Just MacData
md }
protect :: Either StoreError MacData
protect = forall hash result.
HashAlgorithm hash =>
(StoreError -> result)
-> (Key -> MACAlgorithm -> ByteString -> result)
-> DigestProxy hash
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> result
pkcs12mac forall a b. a -> Either a b
Left Key -> MACAlgorithm -> ByteString -> Either StoreError MacData
fn DigestProxy hashAlg
hashAlg PBEParameter
pbeParam ByteString
content ProtectionPassword
pwdUTF8
fn :: Key -> MACAlgorithm -> ByteString -> Either StoreError MacData
fn Key
key MACAlgorithm
macAlg ByteString
bs = forall a b. b -> Either a b
Right MacData { digAlg :: DigestAlgorithm
digAlg = DigestAlgorithm
alg
, macValue :: MessageAuthenticationCode
macValue = forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
macAlg Key
key ByteString
bs
, macParams :: PBEParameter
macParams = PBEParameter
pbeParam
}
writeUnprotectedP12File :: FilePath -> PKCS12 -> IO ()
writeUnprotectedP12File :: String -> PKCS12 -> IO ()
writeUnprotectedP12File String
path = String -> ByteString -> IO ()
BS.writeFile String
path forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKCS12 -> ByteString
writeUnprotectedP12FileToMemory
writeUnprotectedP12FileToMemory :: PKCS12 -> BS.ByteString
writeUnprotectedP12FileToMemory :: PKCS12 -> ByteString
writeUnprotectedP12FileToMemory PKCS12
aSafe = forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object PFX
pfx
where
content :: ByteString
content = forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object PKCS12
aSafe
pfx :: PFX
pfx = PFX { authSafeData :: ByteString
authSafeData = ByteString
content, macData :: Maybe MacData
macData = forall a. Maybe a
Nothing }
data PFX = PFX
{ PFX -> ByteString
authSafeData :: BS.ByteString
, PFX -> Maybe MacData
macData :: Maybe MacData
}
deriving (Int -> PFX -> ShowS
[PFX] -> ShowS
PFX -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PFX] -> ShowS
$cshowList :: [PFX] -> ShowS
show :: PFX -> String
$cshow :: PFX -> String
showsPrec :: Int -> PFX -> ShowS
$cshowsPrec :: Int -> PFX -> ShowS
Show,PFX -> PFX -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PFX -> PFX -> Bool
$c/= :: PFX -> PFX -> Bool
== :: PFX -> PFX -> Bool
$c== :: PFX -> PFX -> Bool
Eq)
instance ProduceASN1Object ASN1P PFX where
asn1s :: PFX -> ASN1Stream ASN1P
asn1s PFX{Maybe MacData
ByteString
macData :: Maybe MacData
authSafeData :: ByteString
macData :: PFX -> Maybe MacData
authSafeData :: PFX -> ByteString
..} =
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream ASN1P
v forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
m)
where
v :: ASN1Stream ASN1P
v = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
3
a :: ASN1Stream ASN1P
a = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s (ByteString -> ContentInfo
DataCI ByteString
authSafeData)
m :: ASN1Stream ASN1P
m = forall a e. Maybe a -> (a -> ASN1Stream e) -> ASN1Stream e
optASN1S Maybe MacData
macData forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s
instance ParseASN1Object [ASN1Event] PFX where
parse :: ParseASN1 [ASN1Event] PFX
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
IntVal Integer
v <- forall e. Monoid e => ParseASN1 e ASN1
getNext
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v forall a. Eq a => a -> a -> Bool
/= Integer
3) forall a b. (a -> b) -> a -> b
$
forall e a. String -> ParseASN1 e a
throwParseError (String
"PFX: parsed invalid version: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
v)
ContentInfo
ci <- forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
ByteString
d <- case ContentInfo
ci of
DataCI ByteString
bs -> forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
SignedDataCI SignedData (Encap ByteString)
_ -> forall e a. String -> ParseASN1 e a
throwParseError String
"PFX: public-key integrity mode is not supported"
ContentInfo
_ -> forall e a. String -> ParseASN1 e a
throwParseError forall a b. (a -> b) -> a -> b
$ String
"PFX: invalid content type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (ContentInfo -> ContentType
getContentType ContentInfo
ci)
Bool
b <- forall e. ParseASN1 e Bool
hasNext
Maybe MacData
m <- if Bool
b then forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing
forall (m :: * -> *) a. Monad m => a -> m a
return PFX { authSafeData :: ByteString
authSafeData = ByteString
d, macData :: Maybe MacData
macData = Maybe MacData
m }
data MacData = MacData
{ MacData -> DigestAlgorithm
digAlg :: DigestAlgorithm
, MacData -> MessageAuthenticationCode
macValue :: MessageAuthenticationCode
, MacData -> PBEParameter
macParams :: PBEParameter
}
deriving (Int -> MacData -> ShowS
[MacData] -> ShowS
MacData -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MacData] -> ShowS
$cshowList :: [MacData] -> ShowS
show :: MacData -> String
$cshow :: MacData -> String
showsPrec :: Int -> MacData -> ShowS
$cshowsPrec :: Int -> MacData -> ShowS
Show,MacData -> MacData -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MacData -> MacData -> Bool
$c/= :: MacData -> MacData -> Bool
== :: MacData -> MacData -> Bool
$c== :: MacData -> MacData -> Bool
Eq)
instance ASN1Elem e => ProduceASN1Object e MacData where
asn1s :: MacData -> ASN1Stream e
asn1s MacData{MessageAuthenticationCode
DigestAlgorithm
PBEParameter
macParams :: PBEParameter
macValue :: MessageAuthenticationCode
digAlg :: DigestAlgorithm
macParams :: MacData -> PBEParameter
macValue :: MacData -> MessageAuthenticationCode
digAlg :: MacData -> DigestAlgorithm
..} =
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
m forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
s forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
i)
where
m :: ASN1Stream e
m = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
a forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
v)
a :: ASN1Stream e
a = forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence DigestAlgorithm
digAlg
v :: ASN1Stream e
v = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert MessageAuthenticationCode
macValue)
s :: ASN1Stream e
s = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (PBEParameter -> ByteString
pbeSalt PBEParameter
macParams)
i :: ASN1Stream e
i = forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ PBEParameter -> Int
pbeIterationCount PBEParameter
macParams)
instance Monoid e => ParseASN1Object e MacData where
parse :: ParseASN1 e MacData
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
(DigestAlgorithm
a, ByteString
v) <- forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
DigestAlgorithm
a <- forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
OctetString ByteString
v <- forall e. Monoid e => ParseASN1 e ASN1
getNext
forall (m :: * -> *) a. Monad m => a -> m a
return (DigestAlgorithm
a, ByteString
v)
OctetString ByteString
s <- forall e. Monoid e => ParseASN1 e ASN1
getNext
Bool
b <- forall e. ParseASN1 e Bool
hasNext
IntVal Integer
i <- if Bool
b then forall e. Monoid e => ParseASN1 e ASN1
getNext else forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> ASN1
IntVal Integer
1)
forall (m :: * -> *) a. Monad m => a -> m a
return MacData { digAlg :: DigestAlgorithm
digAlg = DigestAlgorithm
a
, macValue :: MessageAuthenticationCode
macValue = Bytes -> MessageAuthenticationCode
AuthTag (forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ByteString
v)
, macParams :: PBEParameter
macParams = ByteString -> Int -> PBEParameter
PBEParameter ByteString
s (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
}
newtype PKCS12 = PKCS12 [ASElement]
deriving (Int -> PKCS12 -> ShowS
[PKCS12] -> ShowS
PKCS12 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PKCS12] -> ShowS
$cshowList :: [PKCS12] -> ShowS
show :: PKCS12 -> String
$cshow :: PKCS12 -> String
showsPrec :: Int -> PKCS12 -> ShowS
$cshowsPrec :: Int -> PKCS12 -> ShowS
Show,PKCS12 -> PKCS12 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PKCS12 -> PKCS12 -> Bool
$c/= :: PKCS12 -> PKCS12 -> Bool
== :: PKCS12 -> PKCS12 -> Bool
$c== :: PKCS12 -> PKCS12 -> Bool
Eq)
instance Semigroup PKCS12 where
PKCS12 [ASElement]
a <> :: PKCS12 -> PKCS12 -> PKCS12
<> PKCS12 [ASElement]
b = [ASElement] -> PKCS12
PKCS12 ([ASElement]
a forall a. [a] -> [a] -> [a]
++ [ASElement]
b)
instance ProduceASN1Object ASN1P PKCS12 where
asn1s :: PKCS12 -> ASN1Stream ASN1P
asn1s (PKCS12 [ASElement]
elems) = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s [ASElement]
elems)
instance ParseASN1Object [ASN1Event] PKCS12 where
parse :: ParseASN1 [ASN1Event] PKCS12
parse = [ASElement] -> PKCS12
PKCS12 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
unPKCS12 :: PKCS12 -> OptProtected [SafeContents]
unPKCS12 :: PKCS12 -> OptProtected [SafeContents]
unPKCS12 = forall a. [OptProtected a] -> OptProtected [a]
applySamePassword forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKCS12 -> [OptProtected SafeContents]
unPKCS12'
unPKCS12' :: PKCS12 -> [OptProtected SafeContents]
unPKCS12' :: PKCS12 -> [OptProtected SafeContents]
unPKCS12' (PKCS12 [ASElement]
elems) = forall a b. (a -> b) -> [a] -> [b]
map ASElement -> OptProtected SafeContents
f [ASElement]
elems
where f :: ASElement -> OptProtected SafeContents
f (Unencrypted SafeContents
sc) = forall a. a -> OptProtected a
Unprotected SafeContents
sc
f (Encrypted PKCS5
e) = forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected (PKCS5 -> ProtectionPassword -> Either StoreError ByteString
decrypt PKCS5
e forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode)
unencrypted :: SafeContents -> PKCS12
unencrypted :: SafeContents -> PKCS12
unencrypted = [ASElement] -> PKCS12
PKCS12 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeContents -> ASElement
Unencrypted
encrypted :: EncryptionScheme -> ProtectionPassword -> SafeContents -> Either StoreError PKCS12
encrypted :: EncryptionScheme
-> ProtectionPassword -> SafeContents -> Either StoreError PKCS12
encrypted EncryptionScheme
alg ProtectionPassword
pwd SafeContents
sc = [ASElement] -> PKCS12
PKCS12 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. a -> [a] -> [a]
:[]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKCS5 -> ASElement
Encrypted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncryptionScheme
-> ProtectionPassword -> ByteString -> Either StoreError PKCS5
encrypt EncryptionScheme
alg ProtectionPassword
pwd ByteString
bs
where bs :: ByteString
bs = forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object SafeContents
sc
data ASElement = Unencrypted SafeContents
| Encrypted PKCS5
deriving (Int -> ASElement -> ShowS
[ASElement] -> ShowS
ASElement -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ASElement] -> ShowS
$cshowList :: [ASElement] -> ShowS
show :: ASElement -> String
$cshow :: ASElement -> String
showsPrec :: Int -> ASElement -> ShowS
$cshowsPrec :: Int -> ASElement -> ShowS
Show,ASElement -> ASElement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ASElement -> ASElement -> Bool
$c/= :: ASElement -> ASElement -> Bool
== :: ASElement -> ASElement -> Bool
$c== :: ASElement -> ASElement -> Bool
Eq)
instance ASN1Elem e => ProduceASN1Object e ASElement where
asn1s :: ASElement -> ASN1Stream e
asn1s (Unencrypted SafeContents
sc) = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
cont)
where
oid :: ASN1Stream e
oid = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (forall a. OIDable a => a -> OID
getObjectID ContentType
DataType)
cont :: ASN1Stream e
cont = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
bs)
bs :: ByteString
bs = forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object SafeContents
sc
asn1s (Encrypted PKCS5{ByteString
EncryptionScheme
encryptedData :: PKCS5 -> ByteString
encryptionAlgorithm :: PKCS5 -> EncryptionScheme
encryptedData :: ByteString
encryptionAlgorithm :: EncryptionScheme
..}) = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
cont)
where
oid :: ASN1Stream e
oid = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (forall a. OIDable a => a -> OID
getObjectID ContentType
EncryptedDataType)
cont :: ASN1Stream e
cont = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) ASN1Stream e
inner
inner :: ASN1Stream e
inner = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
eci)
eci :: ASN1Stream e
eci = forall e alg.
(ASN1Elem e, ProduceASN1Object e alg) =>
(ContentType, alg, Encap ByteString) -> ASN1Stream e
encryptedContentInfoASN1S
(ContentType
DataType, EncryptionScheme
encryptionAlgorithm, forall a. a -> Encap a
Attached ByteString
encryptedData)
instance Monoid e => ParseASN1Object e ASElement where
parse :: ParseASN1 e ASElement
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
OID OID
oid <- forall e. Monoid e => ParseASN1 e ASN1
getNext
forall a e b.
OIDNameable a =>
String -> OID -> (a -> ParseASN1 e b) -> ParseASN1 e b
withObjectID String
"content type" OID
oid forall a b. (a -> b) -> a -> b
$ \ContentType
ct ->
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (ContentType -> ParseASN1 e ASElement
parseInner ContentType
ct)
where
parseInner :: ContentType -> ParseASN1 e ASElement
parseInner ContentType
DataType = SafeContents -> ASElement
Unencrypted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e SafeContents
parseUnencrypted
parseInner ContentType
EncryptedDataType = PKCS5 -> ASElement
Encrypted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e PKCS5
parseEncrypted
parseInner ContentType
EnvelopedDataType = forall e a. String -> ParseASN1 e a
throwParseError String
"PKCS12: public-key privacy mode is not supported"
parseInner ContentType
ct = forall e a. String -> ParseASN1 e a
throwParseError forall a b. (a -> b) -> a -> b
$ String
"PKCS12: invalid content type: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ContentType
ct
parseUnencrypted :: ParseASN1 e SafeContents
parseUnencrypted = forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
String -> ParseASN1 e obj
parseOctetStringObject String
"PKCS12"
parseEncrypted :: ParseASN1 e PKCS5
parseEncrypted = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
IntVal Integer
0 <- forall e. Monoid e => ParseASN1 e ASN1
getNext
(ContentType
DataType, EncryptionScheme
eScheme, Attached ByteString
ed) <- forall e alg.
ParseASN1Object e alg =>
ParseASN1 e (ContentType, alg, Encap ByteString)
parseEncryptedContentInfo
forall (m :: * -> *) a. Monad m => a -> m a
return PKCS5 { encryptionAlgorithm :: EncryptionScheme
encryptionAlgorithm = EncryptionScheme
eScheme, encryptedData :: ByteString
encryptedData = ByteString
ed }
data Bag info = Bag
{ forall info. Bag info -> info
bagInfo :: info
, forall info. Bag info -> [Attribute]
bagAttributes :: [Attribute]
}
deriving (Int -> Bag info -> ShowS
forall info. Show info => Int -> Bag info -> ShowS
forall info. Show info => [Bag info] -> ShowS
forall info. Show info => Bag info -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bag info] -> ShowS
$cshowList :: forall info. Show info => [Bag info] -> ShowS
show :: Bag info -> String
$cshow :: forall info. Show info => Bag info -> String
showsPrec :: Int -> Bag info -> ShowS
$cshowsPrec :: forall info. Show info => Int -> Bag info -> ShowS
Show,Bag info -> Bag info -> Bool
forall info. Eq info => Bag info -> Bag info -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bag info -> Bag info -> Bool
$c/= :: forall info. Eq info => Bag info -> Bag info -> Bool
== :: Bag info -> Bag info -> Bool
$c== :: forall info. Eq info => Bag info -> Bag info -> Bool
Eq)
class BagInfo info where
type BagType info
bagName :: info -> String
bagType :: info -> BagType info
valueASN1S :: ASN1Elem e => info -> ASN1Stream e
parseValue :: Monoid e => BagType info -> ParseASN1 e info
instance (ASN1Elem e, BagInfo info, OIDable (BagType info)) => ProduceASN1Object e (Bag info) where
asn1s :: Bag info -> ASN1Stream e
asn1s Bag{info
[Attribute]
bagAttributes :: [Attribute]
bagInfo :: info
bagAttributes :: forall info. Bag info -> [Attribute]
bagInfo :: forall info. Bag info -> info
..} = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
val forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
att)
where
typ :: BagType info
typ = forall info. BagInfo info => info -> BagType info
bagType info
bagInfo
oid :: ASN1Stream e
oid = forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (forall a. OIDable a => a -> OID
getObjectID BagType info
typ)
val :: ASN1Stream e
val = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (forall info e. (BagInfo info, ASN1Elem e) => info -> ASN1Stream e
valueASN1S info
bagInfo)
att :: ASN1Stream e
att | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute]
bagAttributes = forall a. a -> a
id
| Bool
otherwise = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Set (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s [Attribute]
bagAttributes)
instance (Monoid e, BagInfo info, OIDNameable (BagType info)) => ParseASN1Object e (Bag info) where
parse :: ParseASN1 e (Bag info)
parse = forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ do
OID OID
oid <- forall e. Monoid e => ParseASN1 e ASN1
getNext
info
val <- forall a e b.
OIDNameable a =>
String -> OID -> (a -> ParseASN1 e b) -> ParseASN1 e b
withObjectID (info -> String
getName forall a. HasCallStack => a
undefined) OID
oid forall a b. (a -> b) -> a -> b
$
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall info e.
(BagInfo info, Monoid e) =>
BagType info -> ParseASN1 e info
parseValue
[Attribute]
att <- forall a. a -> Maybe a -> a
fromMaybe [] forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe ASN1ConstructionType
Set forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
forall (m :: * -> *) a. Monad m => a -> m a
return Bag { bagInfo :: info
bagInfo = info
val, bagAttributes :: [Attribute]
bagAttributes = [Attribute]
att }
where
getName :: info -> String
getName :: info -> String
getName = forall info. BagInfo info => info -> String
bagName
data CertType = TypeCertX509 deriving (Int -> CertType -> ShowS
[CertType] -> ShowS
CertType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertType] -> ShowS
$cshowList :: [CertType] -> ShowS
show :: CertType -> String
$cshow :: CertType -> String
showsPrec :: Int -> CertType -> ShowS
$cshowsPrec :: Int -> CertType -> ShowS
Show,CertType -> CertType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertType -> CertType -> Bool
$c/= :: CertType -> CertType -> Bool
== :: CertType -> CertType -> Bool
$c== :: CertType -> CertType -> Bool
Eq)
instance Enumerable CertType where
values :: [CertType]
values = [ CertType
TypeCertX509 ]
instance OIDable CertType where
getObjectID :: CertType -> OID
getObjectID CertType
TypeCertX509 = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
22,Integer
1]
instance OIDNameable CertType where
fromObjectID :: OID -> Maybe CertType
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid
newtype CertInfo = CertX509 X509.SignedCertificate deriving (Int -> CertInfo -> ShowS
[CertInfo] -> ShowS
CertInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertInfo] -> ShowS
$cshowList :: [CertInfo] -> ShowS
show :: CertInfo -> String
$cshow :: CertInfo -> String
showsPrec :: Int -> CertInfo -> ShowS
$cshowsPrec :: Int -> CertInfo -> ShowS
Show,CertInfo -> CertInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertInfo -> CertInfo -> Bool
$c/= :: CertInfo -> CertInfo -> Bool
== :: CertInfo -> CertInfo -> Bool
$c== :: CertInfo -> CertInfo -> Bool
Eq)
instance BagInfo CertInfo where
type BagType CertInfo = CertType
bagName :: CertInfo -> String
bagName CertInfo
_ = String
"CertBag"
bagType :: CertInfo -> BagType CertInfo
bagType (CertX509 SignedCertificate
_) = CertType
TypeCertX509
valueASN1S :: forall e. ASN1Elem e => CertInfo -> ASN1Stream e
valueASN1S (CertX509 SignedCertificate
c) = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object SignedCertificate
c)
parseValue :: forall e. Monoid e => BagType CertInfo -> ParseASN1 e CertInfo
parseValue CertType
BagType CertInfo
TypeCertX509 = SignedCertificate -> CertInfo
CertX509 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
String -> ParseASN1 e obj
parseOctetStringObject String
"CertBag"
data CRLType = TypeCRLX509 deriving (Int -> CRLType -> ShowS
[CRLType] -> ShowS
CRLType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CRLType] -> ShowS
$cshowList :: [CRLType] -> ShowS
show :: CRLType -> String
$cshow :: CRLType -> String
showsPrec :: Int -> CRLType -> ShowS
$cshowsPrec :: Int -> CRLType -> ShowS
Show,CRLType -> CRLType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CRLType -> CRLType -> Bool
$c/= :: CRLType -> CRLType -> Bool
== :: CRLType -> CRLType -> Bool
$c== :: CRLType -> CRLType -> Bool
Eq)
instance Enumerable CRLType where
values :: [CRLType]
values = [ CRLType
TypeCRLX509 ]
instance OIDable CRLType where
getObjectID :: CRLType -> OID
getObjectID CRLType
TypeCRLX509 = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
23,Integer
1]
instance OIDNameable CRLType where
fromObjectID :: OID -> Maybe CRLType
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid
newtype CRLInfo = CRLX509 X509.SignedCRL deriving (Int -> CRLInfo -> ShowS
[CRLInfo] -> ShowS
CRLInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CRLInfo] -> ShowS
$cshowList :: [CRLInfo] -> ShowS
show :: CRLInfo -> String
$cshow :: CRLInfo -> String
showsPrec :: Int -> CRLInfo -> ShowS
$cshowsPrec :: Int -> CRLInfo -> ShowS
Show,CRLInfo -> CRLInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CRLInfo -> CRLInfo -> Bool
$c/= :: CRLInfo -> CRLInfo -> Bool
== :: CRLInfo -> CRLInfo -> Bool
$c== :: CRLInfo -> CRLInfo -> Bool
Eq)
instance BagInfo CRLInfo where
type BagType CRLInfo = CRLType
bagName :: CRLInfo -> String
bagName CRLInfo
_ = String
"CRLBag"
bagType :: CRLInfo -> BagType CRLInfo
bagType (CRLX509 SignedCRL
_) = CRLType
TypeCRLX509
valueASN1S :: forall e. ASN1Elem e => CRLInfo -> ASN1Stream e
valueASN1S (CRLX509 SignedCRL
c) = forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object SignedCRL
c)
parseValue :: forall e. Monoid e => BagType CRLInfo -> ParseASN1 e CRLInfo
parseValue CRLType
BagType CRLInfo
TypeCRLX509 = SignedCRL -> CRLInfo
CRLX509 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
String -> ParseASN1 e obj
parseOctetStringObject String
"CRLBag"
data SafeType = TypeKey
| TypePKCS8ShroudedKey
| TypeCert
| TypeCRL
| TypeSecret
| TypeSafeContents
deriving (Int -> SafeType -> ShowS
[SafeType] -> ShowS
SafeType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SafeType] -> ShowS
$cshowList :: [SafeType] -> ShowS
show :: SafeType -> String
$cshow :: SafeType -> String
showsPrec :: Int -> SafeType -> ShowS
$cshowsPrec :: Int -> SafeType -> ShowS
Show,SafeType -> SafeType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SafeType -> SafeType -> Bool
$c/= :: SafeType -> SafeType -> Bool
== :: SafeType -> SafeType -> Bool
$c== :: SafeType -> SafeType -> Bool
Eq)
instance Enumerable SafeType where
values :: [SafeType]
values = [ SafeType
TypeKey
, SafeType
TypePKCS8ShroudedKey
, SafeType
TypeCert
, SafeType
TypeCRL
, SafeType
TypeSecret
, SafeType
TypeSafeContents
]
instance OIDable SafeType where
getObjectID :: SafeType -> OID
getObjectID SafeType
TypeKey = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
12,Integer
10,Integer
1,Integer
1]
getObjectID SafeType
TypePKCS8ShroudedKey = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
12,Integer
10,Integer
1,Integer
2]
getObjectID SafeType
TypeCert = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
12,Integer
10,Integer
1,Integer
3]
getObjectID SafeType
TypeCRL = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
12,Integer
10,Integer
1,Integer
4]
getObjectID SafeType
TypeSecret = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
12,Integer
10,Integer
1,Integer
5]
getObjectID SafeType
TypeSafeContents = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
12,Integer
10,Integer
1,Integer
6]
instance OIDNameable SafeType where
fromObjectID :: OID -> Maybe SafeType
fromObjectID OID
oid = forall a. OIDNameableWrapper a -> a
unOIDNW forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid
data SafeInfo = KeyBag (FormattedKey X509.PrivKey)
| PKCS8ShroudedKeyBag PKCS5
| CertBag (Bag CertInfo)
| CRLBag (Bag CRLInfo)
| SecretBag [ASN1]
| SafeContentsBag SafeContents
deriving (Int -> SafeInfo -> ShowS
[SafeInfo] -> ShowS
SafeInfo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SafeInfo] -> ShowS
$cshowList :: [SafeInfo] -> ShowS
show :: SafeInfo -> String
$cshow :: SafeInfo -> String
showsPrec :: Int -> SafeInfo -> ShowS
$cshowsPrec :: Int -> SafeInfo -> ShowS
Show,SafeInfo -> SafeInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SafeInfo -> SafeInfo -> Bool
$c/= :: SafeInfo -> SafeInfo -> Bool
== :: SafeInfo -> SafeInfo -> Bool
$c== :: SafeInfo -> SafeInfo -> Bool
Eq)
instance BagInfo SafeInfo where
type BagType SafeInfo = SafeType
bagName :: SafeInfo -> String
bagName SafeInfo
_ = String
"SafeBag"
bagType :: SafeInfo -> BagType SafeInfo
bagType (KeyBag FormattedKey PrivKey
_) = SafeType
TypeKey
bagType (PKCS8ShroudedKeyBag PKCS5
_) = SafeType
TypePKCS8ShroudedKey
bagType (CertBag Bag CertInfo
_) = SafeType
TypeCert
bagType (CRLBag Bag CRLInfo
_) = SafeType
TypeCRL
bagType (SecretBag [ASN1]
_) = SafeType
TypeSecret
bagType (SafeContentsBag SafeContents
_) = SafeType
TypeSafeContents
valueASN1S :: forall e. ASN1Elem e => SafeInfo -> ASN1Stream e
valueASN1S (KeyBag FormattedKey PrivKey
k) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s FormattedKey PrivKey
k
valueASN1S (PKCS8ShroudedKeyBag PKCS5
k) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s PKCS5
k
valueASN1S (CertBag Bag CertInfo
c) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s Bag CertInfo
c
valueASN1S (CRLBag Bag CRLInfo
c) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s Bag CRLInfo
c
valueASN1S (SecretBag [ASN1]
s) = forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
gMany [ASN1]
s
valueASN1S (SafeContentsBag SafeContents
sc) = forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s SafeContents
sc
parseValue :: forall e. Monoid e => BagType SafeInfo -> ParseASN1 e SafeInfo
parseValue SafeType
BagType SafeInfo
TypeKey = FormattedKey PrivKey -> SafeInfo
KeyBag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseValue SafeType
BagType SafeInfo
TypePKCS8ShroudedKey = PKCS5 -> SafeInfo
PKCS8ShroudedKeyBag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseValue SafeType
BagType SafeInfo
TypeCert = Bag CertInfo -> SafeInfo
CertBag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseValue SafeType
BagType SafeInfo
TypeCRL = Bag CRLInfo -> SafeInfo
CRLBag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
parseValue SafeType
BagType SafeInfo
TypeSecret = [ASN1] -> SafeInfo
SecretBag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany forall e. Monoid e => ParseASN1 e ASN1
getNext
parseValue SafeType
BagType SafeInfo
TypeSafeContents = SafeContents -> SafeInfo
SafeContentsBag forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
type SafeBag = Bag SafeInfo
newtype SafeContents = SafeContents { SafeContents -> [SafeBag]
unSafeContents :: [SafeBag] }
deriving (Int -> SafeContents -> ShowS
[SafeContents] -> ShowS
SafeContents -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SafeContents] -> ShowS
$cshowList :: [SafeContents] -> ShowS
show :: SafeContents -> String
$cshow :: SafeContents -> String
showsPrec :: Int -> SafeContents -> ShowS
$cshowsPrec :: Int -> SafeContents -> ShowS
Show,SafeContents -> SafeContents -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SafeContents -> SafeContents -> Bool
$c/= :: SafeContents -> SafeContents -> Bool
== :: SafeContents -> SafeContents -> Bool
$c== :: SafeContents -> SafeContents -> Bool
Eq)
instance ASN1Elem e => ProduceASN1Object e SafeContents where
asn1s :: SafeContents -> ASN1Stream e
asn1s (SafeContents [SafeBag]
s) = forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s [SafeBag]
s)
instance Monoid e => ParseASN1Object e SafeContents where
parse :: ParseASN1 e SafeContents
parse = [SafeBag] -> SafeContents
SafeContents forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
filterBags :: ([Attribute] -> Bool) -> SafeContents -> SafeContents
filterBags :: ([Attribute] -> Bool) -> SafeContents -> SafeContents
filterBags [Attribute] -> Bool
p (SafeContents [SafeBag]
scs) = [SafeBag] -> SafeContents
SafeContents (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe SafeBag -> Maybe SafeBag
f [SafeBag]
scs)
where
f :: SafeBag -> Maybe SafeBag
f (Bag (SafeContentsBag SafeContents
inner) [Attribute]
attrs) =
forall a. a -> Maybe a
Just (forall info. info -> [Attribute] -> Bag info
Bag (SafeContents -> SafeInfo
SafeContentsBag forall a b. (a -> b) -> a -> b
$ ([Attribute] -> Bool) -> SafeContents -> SafeContents
filterBags [Attribute] -> Bool
p SafeContents
inner) [Attribute]
attrs)
f SafeBag
bag | [Attribute] -> Bool
p (forall info. Bag info -> [Attribute]
bagAttributes SafeBag
bag) = forall a. a -> Maybe a
Just SafeBag
bag
| Bool
otherwise = forall a. Maybe a
Nothing
filterByFriendlyName :: String -> SafeContents -> SafeContents
filterByFriendlyName :: String -> SafeContents -> SafeContents
filterByFriendlyName String
name = ([Attribute] -> Bool) -> SafeContents -> SafeContents
filterBags ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just String
name) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> Maybe String
getFriendlyName)
filterByLocalKeyId :: BS.ByteString -> SafeContents -> SafeContents
filterByLocalKeyId :: ByteString -> SafeContents -> SafeContents
filterByLocalKeyId ByteString
d = ([Attribute] -> Bool) -> SafeContents -> SafeContents
filterBags ((forall a. Eq a => a -> a -> Bool
== forall a. a -> Maybe a
Just ByteString
d) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> Maybe ByteString
getLocalKeyId)
getSafeKeysId :: SafeContents -> [OptProtected (Id X509.PrivKey)]
getSafeKeysId :: SafeContents -> [OptProtected (Id PrivKey)]
getSafeKeysId (SafeContents [SafeBag]
scs) = [SafeBag] -> [OptProtected (Id PrivKey)]
loop [SafeBag]
scs
where
loop :: [SafeBag] -> [OptProtected (Id PrivKey)]
loop [] = []
loop (SafeBag
bag : [SafeBag]
bags) =
case forall info. Bag info -> info
bagInfo SafeBag
bag of
KeyBag (FormattedKey PrivateKeyFormat
_ PrivKey
k) -> forall a. a -> OptProtected a
Unprotected (forall a info. a -> Bag info -> Id a
mkId PrivKey
k SafeBag
bag) forall a. a -> [a] -> [a]
: [SafeBag] -> [OptProtected (Id PrivKey)]
loop [SafeBag]
bags
PKCS8ShroudedKeyBag PKCS5
k -> forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected (forall {a} {info}.
(ParseASN1Object [ASN1Event] (Traditional a),
ParseASN1Object [ASN1Event] (Modern a)) =>
PKCS5 -> Bag info -> ProtectionPassword -> Either StoreError (Id a)
unshroud PKCS5
k SafeBag
bag) forall a. a -> [a] -> [a]
: [SafeBag] -> [OptProtected (Id PrivKey)]
loop [SafeBag]
bags
SafeContentsBag SafeContents
inner -> SafeContents -> [OptProtected (Id PrivKey)]
getSafeKeysId SafeContents
inner forall a. [a] -> [a] -> [a]
++ [SafeBag] -> [OptProtected (Id PrivKey)]
loop [SafeBag]
bags
SafeInfo
_ -> [SafeBag] -> [OptProtected (Id PrivKey)]
loop [SafeBag]
bags
unshroud :: PKCS5 -> Bag info -> ProtectionPassword -> Either StoreError (Id a)
unshroud PKCS5
shrouded Bag info
bag ProtectionPassword
pwd = do
ByteString
bs <- PKCS5 -> ProtectionPassword -> Either StoreError ByteString
decrypt PKCS5
shrouded ProtectionPassword
pwd
FormattedKey PrivateKeyFormat
_ a
k <- forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode ByteString
bs
forall (m :: * -> *) a. Monad m => a -> m a
return (forall a info. a -> Bag info -> Id a
mkId a
k Bag info
bag)
getSafeKeys :: SafeContents -> [OptProtected X509.PrivKey]
getSafeKeys :: SafeContents -> [OptProtected PrivKey]
getSafeKeys = forall a b. (a -> b) -> [a] -> [b]
map (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Id a -> a
unId) forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeContents -> [OptProtected (Id PrivKey)]
getSafeKeysId
getAllSafeKeysId :: [SafeContents] -> OptProtected [Id X509.PrivKey]
getAllSafeKeysId :: [SafeContents] -> OptProtected [Id PrivKey]
getAllSafeKeysId = forall a. [OptProtected a] -> OptProtected [a]
applySamePassword forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SafeContents -> [OptProtected (Id PrivKey)]
getSafeKeysId
getAllSafeKeys :: [SafeContents] -> OptProtected [X509.PrivKey]
getAllSafeKeys :: [SafeContents] -> OptProtected [PrivKey]
getAllSafeKeys = forall a. [OptProtected a] -> OptProtected [a]
applySamePassword forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SafeContents -> [OptProtected PrivKey]
getSafeKeys
getSafeX509CertsId :: SafeContents -> [Id X509.SignedCertificate]
getSafeX509CertsId :: SafeContents -> [Id SignedCertificate]
getSafeX509CertsId (SafeContents [SafeBag]
scs) = [SafeBag] -> [Id SignedCertificate]
loop [SafeBag]
scs
where
loop :: [SafeBag] -> [Id SignedCertificate]
loop [] = []
loop (SafeBag
bag : [SafeBag]
bags) =
case forall info. Bag info -> info
bagInfo SafeBag
bag of
CertBag (Bag (CertX509 SignedCertificate
c) [Attribute]
_) -> forall a info. a -> Bag info -> Id a
mkId SignedCertificate
c SafeBag
bag forall a. a -> [a] -> [a]
: [SafeBag] -> [Id SignedCertificate]
loop [SafeBag]
bags
SafeContentsBag SafeContents
inner -> SafeContents -> [Id SignedCertificate]
getSafeX509CertsId SafeContents
inner forall a. [a] -> [a] -> [a]
++ [SafeBag] -> [Id SignedCertificate]
loop [SafeBag]
bags
SafeInfo
_ -> [SafeBag] -> [Id SignedCertificate]
loop [SafeBag]
bags
getSafeX509Certs :: SafeContents -> [X509.SignedCertificate]
getSafeX509Certs :: SafeContents -> [SignedCertificate]
getSafeX509Certs = forall a b. (a -> b) -> [a] -> [b]
map forall a. Id a -> a
unId forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeContents -> [Id SignedCertificate]
getSafeX509CertsId
getAllSafeX509Certs :: [SafeContents] -> [X509.SignedCertificate]
getAllSafeX509Certs :: [SafeContents] -> [SignedCertificate]
getAllSafeX509Certs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SafeContents -> [SignedCertificate]
getSafeX509Certs
getSafeX509CRLsId :: SafeContents -> [Id X509.SignedCRL]
getSafeX509CRLsId :: SafeContents -> [Id SignedCRL]
getSafeX509CRLsId (SafeContents [SafeBag]
scs) = [SafeBag] -> [Id SignedCRL]
loop [SafeBag]
scs
where
loop :: [SafeBag] -> [Id SignedCRL]
loop [] = []
loop (SafeBag
bag : [SafeBag]
bags) =
case forall info. Bag info -> info
bagInfo SafeBag
bag of
CRLBag (Bag (CRLX509 SignedCRL
c) [Attribute]
_) -> forall a info. a -> Bag info -> Id a
mkId SignedCRL
c SafeBag
bag forall a. a -> [a] -> [a]
: [SafeBag] -> [Id SignedCRL]
loop [SafeBag]
bags
SafeContentsBag SafeContents
inner -> SafeContents -> [Id SignedCRL]
getSafeX509CRLsId SafeContents
inner forall a. [a] -> [a] -> [a]
++ [SafeBag] -> [Id SignedCRL]
loop [SafeBag]
bags
SafeInfo
_ -> [SafeBag] -> [Id SignedCRL]
loop [SafeBag]
bags
getSafeX509CRLs :: SafeContents -> [X509.SignedCRL]
getSafeX509CRLs :: SafeContents -> [SignedCRL]
getSafeX509CRLs = forall a b. (a -> b) -> [a] -> [b]
map forall a. Id a -> a
unId forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeContents -> [Id SignedCRL]
getSafeX509CRLsId
getAllSafeX509CRLs :: [SafeContents] -> [X509.SignedCRL]
getAllSafeX509CRLs :: [SafeContents] -> [SignedCRL]
getAllSafeX509CRLs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SafeContents -> [SignedCRL]
getSafeX509CRLs
getInnerCredential :: [SafeContents] -> SamePassword (Maybe (X509.CertificateChain, X509.PrivKey))
getInnerCredential :: [SafeContents] -> SamePassword (Maybe (CertificateChain, PrivKey))
getInnerCredential [SafeContents]
l = forall a. OptProtected a -> SamePassword a
SamePassword ([Id PrivKey] -> Maybe (CertificateChain, PrivKey)
fn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SafeContents] -> OptProtected [Id PrivKey]
getAllSafeKeysId [SafeContents]
l)
where
certs :: [SignedCertificate]
certs = [SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
l
fn :: [Id PrivKey] -> Maybe (CertificateChain, PrivKey)
fn [Id PrivKey]
idKeys = do
Id PrivKey
iKey <- forall a. [a] -> Maybe a
single [Id PrivKey]
idKeys
let k :: PrivKey
k = forall a. Id a -> a
unId Id PrivKey
iKey
case forall a. Id a -> Maybe ByteString
idKeyId Id PrivKey
iKey of
Just ByteString
d -> do
let filtered :: [SafeContents]
filtered = forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> SafeContents -> SafeContents
filterByLocalKeyId ByteString
d) [SafeContents]
l
SignedCertificate
leaf <- forall a. [a] -> Maybe a
single ([SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
filtered)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignedCertificate -> [SignedCertificate] -> CertificateChain
buildCertificateChain SignedCertificate
leaf [SignedCertificate]
certs, PrivKey
k)
Maybe ByteString
Nothing ->
case forall a. Id a -> Maybe String
idName Id PrivKey
iKey of
Just String
name -> do
let filtered :: [SafeContents]
filtered = forall a b. (a -> b) -> [a] -> [b]
map (String -> SafeContents -> SafeContents
filterByFriendlyName String
name) [SafeContents]
l
SignedCertificate
leaf <- forall a. [a] -> Maybe a
single ([SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
filtered)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignedCertificate -> [SignedCertificate] -> CertificateChain
buildCertificateChain SignedCertificate
leaf [SignedCertificate]
certs, PrivKey
k)
Maybe String
Nothing -> do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignedCertificate]
certs)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SignedCertificate] -> CertificateChain
X509.CertificateChain [SignedCertificate]
certs, PrivKey
k)
toCredential :: PKCS12 -> OptProtected (Maybe (X509.CertificateChain, X509.PrivKey))
toCredential :: PKCS12 -> OptProtected (Maybe (CertificateChain, PrivKey))
toCredential PKCS12
p12 =
forall a. SamePassword a -> OptProtected a
unSamePassword (forall a. OptProtected a -> SamePassword a
SamePassword (PKCS12 -> OptProtected [SafeContents]
unPKCS12 PKCS12
p12) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SafeContents] -> SamePassword (Maybe (CertificateChain, PrivKey))
getInnerCredential)
getInnerCredentialNamed :: String -> [SafeContents] -> SamePassword (Maybe (X509.CertificateChain, X509.PrivKey))
getInnerCredentialNamed :: String
-> [SafeContents]
-> SamePassword (Maybe (CertificateChain, PrivKey))
getInnerCredentialNamed String
name [SafeContents]
l = forall a. OptProtected a -> SamePassword a
SamePassword ([PrivKey] -> Maybe (CertificateChain, PrivKey)
fn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SafeContents] -> OptProtected [PrivKey]
getAllSafeKeys [SafeContents]
filtered)
where
certs :: [SignedCertificate]
certs = [SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
l
filtered :: [SafeContents]
filtered = forall a b. (a -> b) -> [a] -> [b]
map (String -> SafeContents -> SafeContents
filterByFriendlyName String
name) [SafeContents]
l
fn :: [PrivKey] -> Maybe (CertificateChain, PrivKey)
fn [PrivKey]
keys = do
PrivKey
k <- forall a. [a] -> Maybe a
single [PrivKey]
keys
SignedCertificate
leaf <- forall a. [a] -> Maybe a
single ([SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
filtered)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignedCertificate -> [SignedCertificate] -> CertificateChain
buildCertificateChain SignedCertificate
leaf [SignedCertificate]
certs, PrivKey
k)
toNamedCredential :: String -> PKCS12 -> OptProtected (Maybe (X509.CertificateChain, X509.PrivKey))
toNamedCredential :: String
-> PKCS12 -> OptProtected (Maybe (CertificateChain, PrivKey))
toNamedCredential String
name PKCS12
p12 = forall a. SamePassword a -> OptProtected a
unSamePassword forall a b. (a -> b) -> a -> b
$
forall a. OptProtected a -> SamePassword a
SamePassword (PKCS12 -> OptProtected [SafeContents]
unPKCS12 PKCS12
p12) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> [SafeContents]
-> SamePassword (Maybe (CertificateChain, PrivKey))
getInnerCredentialNamed String
name
fromCredential :: Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (X509.CertificateChain, X509.PrivKey)
-> Either StoreError PKCS12
fromCredential :: Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential = ([Attribute] -> [Attribute])
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential' forall a. a -> a
id
fromNamedCredential :: String
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (X509.CertificateChain, X509.PrivKey)
-> Either StoreError PKCS12
fromNamedCredential :: String
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromNamedCredential String
name = ([Attribute] -> [Attribute])
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential' (String -> [Attribute] -> [Attribute]
setFriendlyName String
name)
fromCredential' :: ([Attribute] -> [Attribute])
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (X509.CertificateChain, X509.PrivKey)
-> Either StoreError PKCS12
fromCredential' :: ([Attribute] -> [Attribute])
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential' [Attribute] -> [Attribute]
trans Maybe EncryptionScheme
algChain EncryptionScheme
algKey ProtectionPassword
pwd (X509.CertificateChain [SignedCertificate]
certs, PrivKey
key)
| forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignedCertificate]
certs = forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"Empty certificate chain")
| Bool
otherwise = forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError PKCS12
pkcs12Chain forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Either StoreError PKCS12
pkcs12Key
where
pkcs12Key :: Either StoreError PKCS12
pkcs12Key = SafeContents -> PKCS12
unencrypted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError SafeContents
scKeyOrError
pkcs12Chain :: Either StoreError PKCS12
pkcs12Chain =
case Maybe EncryptionScheme
algChain of
Just EncryptionScheme
alg -> EncryptionScheme
-> ProtectionPassword -> SafeContents -> Either StoreError PKCS12
encrypted EncryptionScheme
alg ProtectionPassword
pwd SafeContents
scChain
Maybe EncryptionScheme
Nothing -> forall a b. b -> Either a b
Right (SafeContents -> PKCS12
unencrypted SafeContents
scChain)
scChain :: SafeContents
scChain = [SafeBag] -> SafeContents
SafeContents (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Attribute] -> SignedCertificate -> SafeBag
toCertBag [[Attribute]]
certAttrs [SignedCertificate]
certs)
certAttrs :: [[Attribute]]
certAttrs = [Attribute]
attrs forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat []
toCertBag :: [Attribute] -> SignedCertificate -> SafeBag
toCertBag [Attribute]
a SignedCertificate
c = forall info. info -> [Attribute] -> Bag info
Bag (Bag CertInfo -> SafeInfo
CertBag (forall info. info -> [Attribute] -> Bag info
Bag (SignedCertificate -> CertInfo
CertX509 SignedCertificate
c) [])) [Attribute]
a
scKeyOrError :: Either StoreError SafeContents
scKeyOrError = PKCS5 -> SafeContents
wrap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncryptionScheme
-> ProtectionPassword -> ByteString -> Either StoreError PKCS5
encrypt EncryptionScheme
algKey ProtectionPassword
pwd ByteString
encodedKey
wrap :: PKCS5 -> SafeContents
wrap PKCS5
shrouded = [SafeBag] -> SafeContents
SafeContents [forall info. info -> [Attribute] -> Bag info
Bag (PKCS5 -> SafeInfo
PKCS8ShroudedKeyBag PKCS5
shrouded) [Attribute]
attrs]
encodedKey :: ByteString
encodedKey = forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object (forall a. PrivateKeyFormat -> a -> FormattedKey a
FormattedKey PrivateKeyFormat
PKCS8Format PrivKey
key)
X509.Fingerprint ByteString
keyId = forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> HashALG -> Fingerprint
X509.getFingerprint (forall a. [a] -> a
head [SignedCertificate]
certs) HashALG
X509.HashSHA1
attrs :: [Attribute]
attrs = [Attribute] -> [Attribute]
trans (ByteString -> [Attribute] -> [Attribute]
setLocalKeyId ByteString
keyId [])
friendlyName :: OID
friendlyName :: OID
friendlyName = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
20]
getFriendlyName :: [Attribute] -> Maybe String
getFriendlyName :: [Attribute] -> Maybe String
getFriendlyName [Attribute]
attrs = forall a. OID -> [Attribute] -> ParseASN1 () a -> Maybe a
runParseAttribute OID
friendlyName [Attribute]
attrs forall a b. (a -> b) -> a -> b
$ do
ASN1String ASN1CharacterString
str <- forall e. Monoid e => ParseASN1 e ASN1
getNext
case ASN1CharacterString -> Maybe String
asn1CharacterToString ASN1CharacterString
str of
Maybe String
Nothing -> forall e a. String -> ParseASN1 e a
throwParseError String
"Invalid friendlyName value"
Just String
s -> forall (m :: * -> *) a. Monad m => a -> m a
return String
s
setFriendlyName :: String -> [Attribute] -> [Attribute]
setFriendlyName :: String -> [Attribute] -> [Attribute]
setFriendlyName String
name = OID -> ASN1S -> [Attribute] -> [Attribute]
setAttributeASN1S OID
friendlyName (forall e. ASN1Elem e => String -> ASN1Stream e
gBMPString String
name)
localKeyId :: OID
localKeyId :: OID
localKeyId = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
21]
getLocalKeyId :: [Attribute] -> Maybe BS.ByteString
getLocalKeyId :: [Attribute] -> Maybe ByteString
getLocalKeyId [Attribute]
attrs = forall a. OID -> [Attribute] -> ParseASN1 () a -> Maybe a
runParseAttribute OID
localKeyId [Attribute]
attrs forall a b. (a -> b) -> a -> b
$ do
OctetString ByteString
d <- forall e. Monoid e => ParseASN1 e ASN1
getNext
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
d
setLocalKeyId :: BS.ByteString -> [Attribute] -> [Attribute]
setLocalKeyId :: ByteString -> [Attribute] -> [Attribute]
setLocalKeyId ByteString
d = OID -> ASN1S -> [Attribute] -> [Attribute]
setAttributeASN1S OID
localKeyId (forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
d)
newtype SamePassword a = SamePassword { forall a. SamePassword a -> OptProtected a
unSamePassword :: OptProtected a }
instance Functor SamePassword where
fmap :: forall a b. (a -> b) -> SamePassword a -> SamePassword b
fmap a -> b
f (SamePassword OptProtected a
opt) = forall a. OptProtected a -> SamePassword a
SamePassword (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f OptProtected a
opt)
instance Applicative SamePassword where
pure :: forall a. a -> SamePassword a
pure a
a = forall a. OptProtected a -> SamePassword a
SamePassword (forall a. a -> OptProtected a
Unprotected a
a)
SamePassword (Unprotected a -> b
f) <*> :: forall a b.
SamePassword (a -> b) -> SamePassword a -> SamePassword b
<*> SamePassword (Unprotected a
x) =
forall a. OptProtected a -> SamePassword a
SamePassword (forall a. a -> OptProtected a
Unprotected (a -> b
f a
x))
SamePassword (Unprotected a -> b
f) <*> SamePassword (Protected ProtectionPassword -> Either StoreError a
x) =
forall a. OptProtected a -> SamePassword a
SamePassword forall a b. (a -> b) -> a -> b
$ forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtectionPassword -> Either StoreError a
x)
SamePassword (Protected ProtectionPassword -> Either StoreError (a -> b)
f) <*> SamePassword (Unprotected a
x) =
forall a. OptProtected a -> SamePassword a
SamePassword forall a b. (a -> b) -> a -> b
$ forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ a
x) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtectionPassword -> Either StoreError (a -> b)
f)
SamePassword (Protected ProtectionPassword -> Either StoreError (a -> b)
f) <*> SamePassword (Protected ProtectionPassword -> Either StoreError a
x) =
forall a. OptProtected a -> SamePassword a
SamePassword forall a b. (a -> b) -> a -> b
$ forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected (\ProtectionPassword
pwd -> ProtectionPassword -> Either StoreError (a -> b)
f ProtectionPassword
pwd forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtectionPassword -> Either StoreError a
x ProtectionPassword
pwd)
instance Monad SamePassword where
return :: forall a. a -> SamePassword a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
SamePassword (Unprotected a
x) >>= :: forall a b.
SamePassword a -> (a -> SamePassword b) -> SamePassword b
>>= a -> SamePassword b
f = a -> SamePassword b
f a
x
SamePassword (Protected ProtectionPassword -> Either StoreError a
inner) >>= a -> SamePassword b
f =
forall a. OptProtected a -> SamePassword a
SamePassword forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected forall a b. (a -> b) -> a -> b
$ \ProtectionPassword
pwd ->
case ProtectionPassword -> Either StoreError a
inner ProtectionPassword
pwd of
Left StoreError
err -> forall a b. a -> Either a b
Left StoreError
err
Right a
x -> forall a.
ProtectionPassword -> OptProtected a -> Either StoreError a
recover ProtectionPassword
pwd (forall a. SamePassword a -> OptProtected a
unSamePassword forall a b. (a -> b) -> a -> b
$ a -> SamePassword b
f a
x)
applySamePassword :: [OptProtected a] -> OptProtected [a]
applySamePassword :: forall a. [OptProtected a] -> OptProtected [a]
applySamePassword = forall a. SamePassword a -> OptProtected a
unSamePassword forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse forall a. OptProtected a -> SamePassword a
SamePassword
single :: [a] -> Maybe a
single :: forall a. [a] -> Maybe a
single [a
x] = forall a. a -> Maybe a
Just a
x
single [a]
_ = forall a. Maybe a
Nothing
data Id a = Id
{ forall a. Id a -> a
unId :: a
, forall a. Id a -> Maybe ByteString
idKeyId :: Maybe BS.ByteString
, forall a. Id a -> Maybe String
idName :: Maybe String
}
mkId :: a -> Bag info -> Id a
mkId :: forall a info. a -> Bag info -> Id a
mkId a
val Bag info
bag = a
val seq :: forall a b. a -> b -> b
`seq` forall a. a -> Maybe ByteString -> Maybe String -> Id a
Id a
val ([Attribute] -> Maybe ByteString
getLocalKeyId [Attribute]
attrs) ([Attribute] -> Maybe String
getFriendlyName [Attribute]
attrs)
where attrs :: [Attribute]
attrs = forall info. Bag info -> [Attribute]
bagAttributes Bag info
bag
decode :: ParseASN1Object [ASN1Event] obj => BS.ByteString -> Either StoreError obj
decode :: forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode = forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decodeASN1Object
parseOctetStringObject :: (Monoid e, ParseASN1Object [ASN1Event] obj)
=> String -> ParseASN1 e obj
parseOctetStringObject :: forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
String -> ParseASN1 e obj
parseOctetStringObject String
name = do
ByteString
bs <- forall e. Monoid e => ParseASN1 e ByteString
parseOctetString
case forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode ByteString
bs of
Left StoreError
e -> forall e a. String -> ParseASN1 e a
throwParseError (String
name forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show StoreError
e)
Right obj
c -> forall (m :: * -> *) a. Monad m => a -> m a
return obj
c
buildCertificateChain :: X509.SignedCertificate -> [X509.SignedCertificate]
-> X509.CertificateChain
buildCertificateChain :: SignedCertificate -> [SignedCertificate] -> CertificateChain
buildCertificateChain SignedCertificate
leaf [SignedCertificate]
authorities =
[SignedCertificate] -> CertificateChain
X509.CertificateChain (SignedCertificate
leaf forall a. a -> [a] -> [a]
: SignedCertificate -> [SignedCertificate] -> [SignedCertificate]
findAuthorities SignedCertificate
leaf [SignedCertificate]
authorities)
where
findAuthorities :: SignedCertificate -> [SignedCertificate] -> [SignedCertificate]
findAuthorities SignedCertificate
cert [SignedCertificate]
others
| SignedCertificate -> DistinguishedName
subject SignedCertificate
cert forall a. Eq a => a -> a -> Bool
== SignedCertificate -> DistinguishedName
issuer SignedCertificate
cert = []
| Bool
otherwise =
case forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\SignedCertificate
c -> SignedCertificate -> DistinguishedName
subject SignedCertificate
c forall a. Eq a => a -> a -> Bool
== SignedCertificate -> DistinguishedName
issuer SignedCertificate
cert) [SignedCertificate]
others of
([SignedCertificate
c], [SignedCertificate]
others') -> SignedCertificate
c forall a. a -> [a] -> [a]
: SignedCertificate -> [SignedCertificate] -> [SignedCertificate]
findAuthorities SignedCertificate
c [SignedCertificate]
others'
([SignedCertificate], [SignedCertificate])
_ -> []
signedCert :: SignedCertificate -> Certificate
signedCert = forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
X509.signedObject forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (Show a, Eq a, ASN1Object a) => SignedExact a -> Signed a
X509.getSigned
subject :: SignedCertificate -> DistinguishedName
subject SignedCertificate
c = Certificate -> DistinguishedName
X509.certSubjectDN (SignedCertificate -> Certificate
signedCert SignedCertificate
c)
issuer :: SignedCertificate -> DistinguishedName
issuer SignedCertificate
c = Certificate -> DistinguishedName
X509.certIssuerDN (SignedCertificate -> Certificate
signedCert SignedCertificate
c)