-- |
-- Module      : Crypto.Store.PKCS12
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- Personal Information Exchange Syntax, aka PKCS #12.
--
-- Only password integrity mode and password privacy modes are supported.
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Crypto.Store.PKCS12
    ( IntegrityParams
    , readP12File
    , readP12FileFromMemory
    , writeP12File
    , writeP12FileToMemory
    , writeUnprotectedP12File
    , writeUnprotectedP12FileToMemory
    -- * PKCS #12 privacy
    , PKCS12
    , unPKCS12
    , unPKCS12'
    , unencrypted
    , encrypted
    -- * PKCS #12 contents and bags
    , SafeContents(..)
    , SafeBag
    , Bag(..)
    , SafeInfo(..)
    , CertInfo(..)
    , CRLInfo(..)
    , Attribute(..)
    , getSafeKeys
    , getAllSafeKeys
    , getSafeX509Certs
    , getAllSafeX509Certs
    , getSafeX509CRLs
    , getAllSafeX509CRLs
    -- * PKCS #12 attributes
    , findAttribute
    , setAttribute
    , filterAttributes
    , getFriendlyName
    , setFriendlyName
    , getLocalKeyId
    , setLocalKeyId
    -- * Credentials
    , fromCredential
    , fromNamedCredential
    , toCredential
    , toNamedCredential
    -- * Password-based protection
    , Password
    , 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.Util
import Crypto.Store.Error
import Crypto.Store.PKCS5
import Crypto.Store.PKCS5.PBES1
import Crypto.Store.PKCS8


-- Decoding and parsing

-- | Read a PKCS #12 file from disk.
readP12File :: FilePath -> IO (Either StoreError (OptProtected PKCS12))
readP12File :: FilePath -> IO (Either StoreError (OptProtected PKCS12))
readP12File FilePath
path = ByteString -> Either StoreError (OptProtected PKCS12)
readP12FileFromMemory (ByteString -> Either StoreError (OptProtected PKCS12))
-> IO ByteString -> IO (Either StoreError (OptProtected PKCS12))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
BS.readFile FilePath
path

-- | Read a PKCS #12 file from a bytearray in BER format.
readP12FileFromMemory :: BS.ByteString -> Either StoreError (OptProtected PKCS12)
readP12FileFromMemory :: ByteString -> Either StoreError (OptProtected PKCS12)
readP12FileFromMemory ByteString
ber = ByteString -> Either StoreError PFX
forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode ByteString
ber Either StoreError PFX
-> (PFX -> Either StoreError (OptProtected PKCS12))
-> Either StoreError (OptProtected PKCS12)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PFX -> Either StoreError (OptProtected PKCS12)
forall a.
ParseASN1Object [ASN1Event] a =>
PFX -> Either StoreError (OptProtected a)
integrity
  where
    integrity :: PFX -> Either StoreError (OptProtected 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 -> a -> OptProtected a
forall a. a -> OptProtected a
Unprotected (a -> OptProtected a)
-> Either StoreError a -> Either StoreError (OptProtected a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either StoreError a
forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode ByteString
authSafeData
            Just MacData
md -> OptProtected a -> Either StoreError (OptProtected a)
forall (m :: * -> *) a. Monad m => a -> m a
return (OptProtected a -> Either StoreError (OptProtected a))
-> OptProtected a -> Either StoreError (OptProtected a)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either StoreError a) -> OptProtected a
forall a. (ByteString -> Either StoreError a) -> OptProtected a
Protected (MacData -> ByteString -> ByteString -> Either StoreError a
forall b p.
(ParseASN1Object [ASN1Event] b, ByteArrayAccess p) =>
MacData -> ByteString -> p -> Either StoreError b
verify MacData
md ByteString
authSafeData)

    verify :: MacData -> ByteString -> p -> Either StoreError b
verify MacData{MessageAuthenticationCode
DigestAlgorithm
PBEParameter
macParams :: MacData -> PBEParameter
macValue :: MacData -> MessageAuthenticationCode
digAlg :: MacData -> DigestAlgorithm
macParams :: PBEParameter
macValue :: MessageAuthenticationCode
digAlg :: DigestAlgorithm
..} ByteString
content p
pwdUTF8 =
        case DigestAlgorithm
digAlg of
            DigestAlgorithm DigestProxy hashAlg
d ->
                let fn :: Key -> MACAlgorithm -> ByteString -> Either StoreError b
fn Key
key MACAlgorithm
macAlg ByteString
bs
                        | Bool -> Bool
not (MACAlgorithm -> Bool
forall params. HasStrength params => params -> Bool
securityAcceptable MACAlgorithm
macAlg) =
                            StoreError -> Either StoreError b
forall a b. a -> Either a b
Left (FilePath -> StoreError
InvalidParameter FilePath
"Integrity MAC too weak")
                        | MessageAuthenticationCode
macValue MessageAuthenticationCode -> MessageAuthenticationCode -> Bool
forall a. Eq a => a -> a -> Bool
== MACAlgorithm -> Key -> ByteString -> MessageAuthenticationCode
forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
macAlg Key
key ByteString
bs = ByteString -> Either StoreError b
forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode ByteString
bs
                        | Bool
otherwise = StoreError -> Either StoreError b
forall a b. a -> Either a b
Left StoreError
BadContentMAC
                 in (StoreError -> Either StoreError b)
-> (Key -> MACAlgorithm -> ByteString -> Either StoreError b)
-> DigestProxy hashAlg
-> PBEParameter
-> ByteString
-> p
-> Either StoreError b
forall hash password result.
(HashAlgorithm hash, ByteArrayAccess password) =>
(StoreError -> result)
-> (Key -> MACAlgorithm -> ByteString -> result)
-> DigestProxy hash
-> PBEParameter
-> ByteString
-> password
-> result
pkcs12mac StoreError -> Either StoreError b
forall a b. a -> Either a b
Left Key -> MACAlgorithm -> ByteString -> Either StoreError b
fn DigestProxy hashAlg
d PBEParameter
macParams ByteString
content p
pwdUTF8


-- Generating and encoding

-- | Parameters used for password integrity mode.
type IntegrityParams = (DigestAlgorithm, PBEParameter)

-- | Write a PKCS #12 file to disk.
writeP12File :: FilePath
             -> IntegrityParams -> Password
             -> PKCS12
             -> IO (Either StoreError ())
writeP12File :: FilePath
-> IntegrityParams
-> ByteString
-> PKCS12
-> IO (Either StoreError ())
writeP12File FilePath
path IntegrityParams
intp ByteString
pw PKCS12
aSafe =
    case IntegrityParams
-> ByteString -> PKCS12 -> Either StoreError ByteString
writeP12FileToMemory IntegrityParams
intp ByteString
pw PKCS12
aSafe of
        Left StoreError
e   -> Either StoreError () -> IO (Either StoreError ())
forall (m :: * -> *) a. Monad m => a -> m a
return (StoreError -> Either StoreError ()
forall a b. a -> Either a b
Left StoreError
e)
        Right ByteString
bs -> () -> Either StoreError ()
forall a b. b -> Either a b
Right (() -> Either StoreError ()) -> IO () -> IO (Either StoreError ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> ByteString -> IO ()
BS.writeFile FilePath
path ByteString
bs

-- | Write a PKCS #12 file to a bytearray in DER format.
writeP12FileToMemory :: IntegrityParams -> Password
                     -> PKCS12
                     -> Either StoreError BS.ByteString
writeP12FileToMemory :: IntegrityParams
-> ByteString -> PKCS12 -> Either StoreError ByteString
writeP12FileToMemory (alg :: DigestAlgorithm
alg@(DigestAlgorithm DigestProxy hashAlg
hashAlg), PBEParameter
pbeParam) ByteString
pwdUTF8 PKCS12
aSafe =
    MacData -> ByteString
encode (MacData -> ByteString)
-> Either StoreError MacData -> Either StoreError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError MacData
protect
  where
    content :: ByteString
content   = PKCS12 -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object PKCS12
aSafe
    encode :: MacData -> ByteString
encode MacData
md = PFX -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object PFX :: ByteString -> Maybe MacData -> PFX
PFX { authSafeData :: ByteString
authSafeData = ByteString
content, macData :: Maybe MacData
macData = MacData -> Maybe MacData
forall a. a -> Maybe a
Just MacData
md }

    protect :: Either StoreError MacData
protect = (StoreError -> Either StoreError MacData)
-> (Key -> MACAlgorithm -> ByteString -> Either StoreError MacData)
-> DigestProxy hashAlg
-> PBEParameter
-> ByteString
-> ByteString
-> Either StoreError MacData
forall hash password result.
(HashAlgorithm hash, ByteArrayAccess password) =>
(StoreError -> result)
-> (Key -> MACAlgorithm -> ByteString -> result)
-> DigestProxy hash
-> PBEParameter
-> ByteString
-> password
-> result
pkcs12mac StoreError -> Either StoreError MacData
forall a b. a -> Either a b
Left Key -> MACAlgorithm -> ByteString -> Either StoreError MacData
fn DigestProxy hashAlg
hashAlg PBEParameter
pbeParam ByteString
content ByteString
pwdUTF8
    fn :: Key -> MACAlgorithm -> ByteString -> Either StoreError MacData
fn Key
key MACAlgorithm
macAlg ByteString
bs = MacData -> Either StoreError MacData
forall a b. b -> Either a b
Right MacData :: DigestAlgorithm
-> MessageAuthenticationCode -> PBEParameter -> MacData
MacData { digAlg :: DigestAlgorithm
digAlg    = DigestAlgorithm
alg
                                     , macValue :: MessageAuthenticationCode
macValue  = MACAlgorithm -> Key -> ByteString -> MessageAuthenticationCode
forall key message.
(ByteArrayAccess key, ByteArrayAccess message) =>
MACAlgorithm -> key -> message -> MessageAuthenticationCode
mac MACAlgorithm
macAlg Key
key ByteString
bs
                                     , macParams :: PBEParameter
macParams = PBEParameter
pbeParam
                                     }

-- | Write a PKCS #12 file without integrity protection to disk.
writeUnprotectedP12File :: FilePath -> PKCS12 -> IO ()
writeUnprotectedP12File :: FilePath -> PKCS12 -> IO ()
writeUnprotectedP12File FilePath
path = FilePath -> ByteString -> IO ()
BS.writeFile FilePath
path (ByteString -> IO ()) -> (PKCS12 -> ByteString) -> PKCS12 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKCS12 -> ByteString
writeUnprotectedP12FileToMemory

-- | Write a PKCS #12 file without integrity protection to a bytearray in DER
-- format.
writeUnprotectedP12FileToMemory :: PKCS12 -> BS.ByteString
writeUnprotectedP12FileToMemory :: PKCS12 -> ByteString
writeUnprotectedP12FileToMemory PKCS12
aSafe = PFX -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object PFX
pfx
  where
    content :: ByteString
content = PKCS12 -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object PKCS12
aSafe
    pfx :: PFX
pfx     = PFX :: ByteString -> Maybe MacData -> PFX
PFX { authSafeData :: ByteString
authSafeData = ByteString
content, macData :: Maybe MacData
macData = Maybe MacData
forall a. Maybe a
Nothing }


-- PFX and MacData

data PFX = PFX
    { PFX -> ByteString
authSafeData :: BS.ByteString
    , PFX -> Maybe MacData
macData :: Maybe MacData
    }
    deriving (Int -> PFX -> ShowS
[PFX] -> ShowS
PFX -> FilePath
(Int -> PFX -> ShowS)
-> (PFX -> FilePath) -> ([PFX] -> ShowS) -> Show PFX
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PFX] -> ShowS
$cshowList :: [PFX] -> ShowS
show :: PFX -> FilePath
$cshow :: PFX -> FilePath
showsPrec :: Int -> PFX -> ShowS
$cshowsPrec :: Int -> PFX -> ShowS
Show,PFX -> PFX -> Bool
(PFX -> PFX -> Bool) -> (PFX -> PFX -> Bool) -> Eq PFX
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
..} =
        ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream ASN1P
v ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
a ASN1Stream ASN1P -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream ASN1P
m)
      where
        v :: ASN1Stream ASN1P
v = Integer -> ASN1Stream ASN1P
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
3
        a :: ASN1Stream ASN1P
a = ContentInfo -> ASN1Stream ASN1P
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s (ByteString -> ContentInfo
DataCI ByteString
authSafeData)
        m :: ASN1Stream ASN1P
m = Maybe MacData -> (MacData -> ASN1Stream ASN1P) -> ASN1Stream ASN1P
forall a e. Maybe a -> (a -> ASN1Stream e) -> ASN1Stream e
optASN1S Maybe MacData
macData MacData -> ASN1Stream ASN1P
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s

instance ParseASN1Object [ASN1Event] PFX where
    parse :: ParseASN1 [ASN1Event] PFX
parse = ASN1ConstructionType
-> ParseASN1 [ASN1Event] PFX -> ParseASN1 [ASN1Event] PFX
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 [ASN1Event] PFX -> ParseASN1 [ASN1Event] PFX)
-> ParseASN1 [ASN1Event] PFX -> ParseASN1 [ASN1Event] PFX
forall a b. (a -> b) -> a -> b
$ do
        IntVal Integer
v <- ParseASN1 [ASN1Event] ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        Bool -> ParseASN1 [ASN1Event] () -> ParseASN1 [ASN1Event] ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
v Integer -> Integer -> Bool
forall a. Eq a => a -> a -> Bool
/= Integer
3) (ParseASN1 [ASN1Event] () -> ParseASN1 [ASN1Event] ())
-> ParseASN1 [ASN1Event] () -> ParseASN1 [ASN1Event] ()
forall a b. (a -> b) -> a -> b
$
            FilePath -> ParseASN1 [ASN1Event] ()
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath
"PFX: parsed invalid version: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Integer -> FilePath
forall a. Show a => a -> FilePath
show Integer
v)
        ContentInfo
ci <- ParseASN1 [ASN1Event] ContentInfo
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        ByteString
d <- case ContentInfo
ci of
                 DataCI ByteString
bs      -> ByteString -> ParseASN1 [ASN1Event] ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
                 SignedDataCI SignedData (Encap ByteString)
_ -> FilePath -> ParseASN1 [ASN1Event] ByteString
forall e a. FilePath -> ParseASN1 e a
throwParseError FilePath
"PFX: public-key integrity mode is not supported"
                 ContentInfo
_              -> FilePath -> ParseASN1 [ASN1Event] ByteString
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath -> ParseASN1 [ASN1Event] ByteString)
-> FilePath -> ParseASN1 [ASN1Event] ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"PFX: invalid content type: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ContentType -> FilePath
forall a. Show a => a -> FilePath
show (ContentInfo -> ContentType
getContentType ContentInfo
ci)
        Bool
b <- ParseASN1 [ASN1Event] Bool
forall e. ParseASN1 e Bool
hasNext
        Maybe MacData
m <- if Bool
b then MacData -> Maybe MacData
forall a. a -> Maybe a
Just (MacData -> Maybe MacData)
-> ParseASN1 [ASN1Event] MacData
-> ParseASN1 [ASN1Event] (Maybe MacData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 [ASN1Event] MacData
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse else Maybe MacData -> ParseASN1 [ASN1Event] (Maybe MacData)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe MacData
forall a. Maybe a
Nothing
        PFX -> ParseASN1 [ASN1Event] PFX
forall (m :: * -> *) a. Monad m => a -> m a
return PFX :: ByteString -> Maybe MacData -> PFX
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 -> FilePath
(Int -> MacData -> ShowS)
-> (MacData -> FilePath) -> ([MacData] -> ShowS) -> Show MacData
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MacData] -> ShowS
$cshowList :: [MacData] -> ShowS
show :: MacData -> FilePath
$cshow :: MacData -> FilePath
showsPrec :: Int -> MacData -> ShowS
$cshowsPrec :: Int -> MacData -> ShowS
Show,MacData -> MacData -> Bool
(MacData -> MacData -> Bool)
-> (MacData -> MacData -> Bool) -> Eq MacData
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
..} =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
m ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
s ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
i)
      where
        m :: ASN1Stream e
m = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
a ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
v)
        a :: ASN1Stream e
a = ASN1ConstructionType -> DigestAlgorithm -> ASN1Stream e
forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence DigestAlgorithm
digAlg
        v :: ASN1Stream e
v = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (MessageAuthenticationCode -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert MessageAuthenticationCode
macValue)
        s :: ASN1Stream e
s = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (PBEParameter -> ByteString
pbeSalt PBEParameter
macParams)
        i :: ASN1Stream e
i = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ PBEParameter -> Int
pbeIterationCount PBEParameter
macParams)

instance Monoid e => ParseASN1Object e MacData where
    parse :: ParseASN1 e MacData
parse = ASN1ConstructionType -> ParseASN1 e MacData -> ParseASN1 e MacData
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e MacData -> ParseASN1 e MacData)
-> ParseASN1 e MacData -> ParseASN1 e MacData
forall a b. (a -> b) -> a -> b
$ do
        (DigestAlgorithm
a, ByteString
v) <- ASN1ConstructionType
-> ParseASN1 e (DigestAlgorithm, ByteString)
-> ParseASN1 e (DigestAlgorithm, ByteString)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (DigestAlgorithm, ByteString)
 -> ParseASN1 e (DigestAlgorithm, ByteString))
-> ParseASN1 e (DigestAlgorithm, ByteString)
-> ParseASN1 e (DigestAlgorithm, ByteString)
forall a b. (a -> b) -> a -> b
$ do
            DigestAlgorithm
a <- ASN1ConstructionType -> ParseASN1 e DigestAlgorithm
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
            OctetString ByteString
v <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            (DigestAlgorithm, ByteString)
-> ParseASN1 e (DigestAlgorithm, ByteString)
forall (m :: * -> *) a. Monad m => a -> m a
return (DigestAlgorithm
a, ByteString
v)
        OctetString ByteString
s <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        Bool
b <- ParseASN1 e Bool
forall e. ParseASN1 e Bool
hasNext
        IntVal Integer
i <- if Bool
b then ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext else ASN1 -> ParseASN1 e ASN1
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> ASN1
IntVal Integer
1)
        MacData -> ParseASN1 e MacData
forall (m :: * -> *) a. Monad m => a -> m a
return MacData :: DigestAlgorithm
-> MessageAuthenticationCode -> PBEParameter -> MacData
MacData { digAlg :: DigestAlgorithm
digAlg = DigestAlgorithm
a
                       , macValue :: MessageAuthenticationCode
macValue = Bytes -> MessageAuthenticationCode
AuthTag (ByteString -> Bytes
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
B.convert ByteString
v)
                       , macParams :: PBEParameter
macParams = ByteString -> Int -> PBEParameter
PBEParameter ByteString
s (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i)
                       }


-- AuthenticatedSafe

-- | PKCS #12 privacy wrapper, adding optional encryption to 'SafeContents'.
-- ASN.1 equivalent is @AuthenticatedSafe@.
--
-- The semigroup interface allows to combine multiple pieces encrypted
-- separately but they should all derive from the same password to be readable
-- by 'unPKCS12' and most other software.
newtype PKCS12 = PKCS12 [ASElement]
    deriving (Int -> PKCS12 -> ShowS
[PKCS12] -> ShowS
PKCS12 -> FilePath
(Int -> PKCS12 -> ShowS)
-> (PKCS12 -> FilePath) -> ([PKCS12] -> ShowS) -> Show PKCS12
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PKCS12] -> ShowS
$cshowList :: [PKCS12] -> ShowS
show :: PKCS12 -> FilePath
$cshow :: PKCS12 -> FilePath
showsPrec :: Int -> PKCS12 -> ShowS
$cshowsPrec :: Int -> PKCS12 -> ShowS
Show,PKCS12 -> PKCS12 -> Bool
(PKCS12 -> PKCS12 -> Bool)
-> (PKCS12 -> PKCS12 -> Bool) -> Eq PKCS12
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 [ASElement] -> [ASElement] -> [ASElement]
forall a. [a] -> [a] -> [a]
++ [ASElement]
b)

instance ProduceASN1Object ASN1P PKCS12 where
    asn1s :: PKCS12 -> ASN1Stream ASN1P
asn1s (PKCS12 [ASElement]
elems) = ASN1ConstructionType -> ASN1Stream ASN1P -> ASN1Stream ASN1P
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence ([ASElement] -> ASN1Stream ASN1P
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 ([ASElement] -> PKCS12)
-> ParseASN1 [ASN1Event] [ASElement]
-> ParseASN1 [ASN1Event] PKCS12
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType
-> ParseASN1 [ASN1Event] [ASElement]
-> ParseASN1 [ASN1Event] [ASElement]
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence ParseASN1 [ASN1Event] [ASElement]
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse

-- | Read the contents of a PKCS #12.  The same privacy password will be used
-- for all content elements.
--
-- This convenience function returns a 'Protected' value as soon as one element
-- at least is encrypted.  This does not mean all elements were actually
-- protected in the input.  If detailed view is required then function
-- 'unPKCS12'' is also available.
unPKCS12 :: PKCS12 -> OptProtected [SafeContents]
unPKCS12 :: PKCS12 -> OptProtected [SafeContents]
unPKCS12 = [OptProtected SafeContents] -> OptProtected [SafeContents]
forall a. [OptProtected a] -> OptProtected [a]
applySamePassword ([OptProtected SafeContents] -> OptProtected [SafeContents])
-> (PKCS12 -> [OptProtected SafeContents])
-> PKCS12
-> OptProtected [SafeContents]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKCS12 -> [OptProtected SafeContents]
unPKCS12'

-- | Read the contents of a PKCS #12.
unPKCS12' :: PKCS12 -> [OptProtected SafeContents]
unPKCS12' :: PKCS12 -> [OptProtected SafeContents]
unPKCS12' (PKCS12 [ASElement]
elems) = (ASElement -> OptProtected SafeContents)
-> [ASElement] -> [OptProtected SafeContents]
forall a b. (a -> b) -> [a] -> [b]
map ASElement -> OptProtected SafeContents
f [ASElement]
elems
  where f :: ASElement -> OptProtected SafeContents
f (Unencrypted SafeContents
sc) = SafeContents -> OptProtected SafeContents
forall a. a -> OptProtected a
Unprotected SafeContents
sc
        f (Encrypted PKCS5
e)    = (ByteString -> Either StoreError SafeContents)
-> OptProtected SafeContents
forall a. (ByteString -> Either StoreError a) -> OptProtected a
Protected (PKCS5 -> ByteString -> Either StoreError ByteString
decrypt PKCS5
e (ByteString -> Either StoreError ByteString)
-> (ByteString -> Either StoreError SafeContents)
-> ByteString
-> Either StoreError SafeContents
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ByteString -> Either StoreError SafeContents
forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode)

-- | Build a PKCS #12 without encryption.  Usage scenario is when private keys
-- are already encrypted with 'PKCS8ShroudedKeyBag'.
unencrypted :: SafeContents -> PKCS12
unencrypted :: SafeContents -> PKCS12
unencrypted = [ASElement] -> PKCS12
PKCS12 ([ASElement] -> PKCS12)
-> (SafeContents -> [ASElement]) -> SafeContents -> PKCS12
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASElement -> [ASElement] -> [ASElement]
forall a. a -> [a] -> [a]
:[]) (ASElement -> [ASElement])
-> (SafeContents -> ASElement) -> SafeContents -> [ASElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeContents -> ASElement
Unencrypted

-- | Build a PKCS #12 encrypted with the specified scheme and password.
encrypted :: EncryptionScheme -> Password -> SafeContents -> Either StoreError PKCS12
encrypted :: EncryptionScheme
-> ByteString -> SafeContents -> Either StoreError PKCS12
encrypted EncryptionScheme
alg ByteString
pwd SafeContents
sc = [ASElement] -> PKCS12
PKCS12 ([ASElement] -> PKCS12)
-> (PKCS5 -> [ASElement]) -> PKCS5 -> PKCS12
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ASElement -> [ASElement] -> [ASElement]
forall a. a -> [a] -> [a]
:[]) (ASElement -> [ASElement])
-> (PKCS5 -> ASElement) -> PKCS5 -> [ASElement]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKCS5 -> ASElement
Encrypted (PKCS5 -> PKCS12)
-> Either StoreError PKCS5 -> Either StoreError PKCS12
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncryptionScheme
-> ByteString -> ByteString -> Either StoreError PKCS5
encrypt EncryptionScheme
alg ByteString
pwd ByteString
bs
  where bs :: ByteString
bs = SafeContents -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object SafeContents
sc

data ASElement = Unencrypted SafeContents
               | Encrypted PKCS5
    deriving (Int -> ASElement -> ShowS
[ASElement] -> ShowS
ASElement -> FilePath
(Int -> ASElement -> ShowS)
-> (ASElement -> FilePath)
-> ([ASElement] -> ShowS)
-> Show ASElement
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ASElement] -> ShowS
$cshowList :: [ASElement] -> ShowS
show :: ASElement -> FilePath
$cshow :: ASElement -> FilePath
showsPrec :: Int -> ASElement -> ShowS
$cshowsPrec :: Int -> ASElement -> ShowS
Show,ASElement -> ASElement -> Bool
(ASElement -> ASElement -> Bool)
-> (ASElement -> ASElement -> Bool) -> Eq ASElement
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) = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
cont)
      where
        oid :: ASN1Stream e
oid = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (ContentType -> OID
forall a. OIDable a => a -> OID
getObjectID ContentType
DataType)
        cont :: ASN1Stream e
cont = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
bs)
        bs :: ByteString
bs = SafeContents -> ByteString
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
..}) = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
cont)
      where
        oid :: ASN1Stream e
oid = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (ContentType -> OID
forall a. OIDable a => a -> OID
getObjectID ContentType
EncryptedDataType)
        cont :: ASN1Stream e
cont = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
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 = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
0 ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
eci)
        eci :: ASN1Stream e
eci = (ContentType, EncryptionScheme, Encap ByteString) -> ASN1Stream e
forall e alg.
(ASN1Elem e, ProduceASN1Object e alg) =>
(ContentType, alg, Encap ByteString) -> ASN1Stream e
encryptedContentInfoASN1S
                  (ContentType
DataType, EncryptionScheme
encryptionAlgorithm, ByteString -> Encap ByteString
forall a. a -> Encap a
Attached ByteString
encryptedData)

instance Monoid e => ParseASN1Object e ASElement where
    parse :: ParseASN1 e ASElement
parse = ASN1ConstructionType
-> ParseASN1 e ASElement -> ParseASN1 e ASElement
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e ASElement -> ParseASN1 e ASElement)
-> ParseASN1 e ASElement -> ParseASN1 e ASElement
forall a b. (a -> b) -> a -> b
$ do
        OID OID
oid <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        FilePath
-> OID
-> (ContentType -> ParseASN1 e ASElement)
-> ParseASN1 e ASElement
forall a e b.
OIDNameable a =>
FilePath -> OID -> (a -> ParseASN1 e b) -> ParseASN1 e b
withObjectID FilePath
"content type" OID
oid ((ContentType -> ParseASN1 e ASElement) -> ParseASN1 e ASElement)
-> (ContentType -> ParseASN1 e ASElement) -> ParseASN1 e ASElement
forall a b. (a -> b) -> a -> b
$ \ContentType
ct ->
            ASN1ConstructionType
-> ParseASN1 e ASElement -> ParseASN1 e ASElement
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 (SafeContents -> ASElement)
-> ParseASN1 e SafeContents -> ParseASN1 e ASElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e SafeContents
parseUnencrypted
        parseInner ContentType
EncryptedDataType = PKCS5 -> ASElement
Encrypted (PKCS5 -> ASElement) -> ParseASN1 e PKCS5 -> ParseASN1 e ASElement
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e PKCS5
parseEncrypted
        parseInner ContentType
EnvelopedDataType = FilePath -> ParseASN1 e ASElement
forall e a. FilePath -> ParseASN1 e a
throwParseError FilePath
"PKCS12: public-key privacy mode is not supported"
        parseInner ContentType
ct                = FilePath -> ParseASN1 e ASElement
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath -> ParseASN1 e ASElement)
-> FilePath -> ParseASN1 e ASElement
forall a b. (a -> b) -> a -> b
$ FilePath
"PKCS12: invalid content type: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ ContentType -> FilePath
forall a. Show a => a -> FilePath
show ContentType
ct

        parseUnencrypted :: ParseASN1 e SafeContents
parseUnencrypted = FilePath -> ParseASN1 e SafeContents
forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
FilePath -> ParseASN1 e obj
parseOctetStringObject FilePath
"PKCS12"
        parseEncrypted :: ParseASN1 e PKCS5
parseEncrypted = ASN1ConstructionType -> ParseASN1 e PKCS5 -> ParseASN1 e PKCS5
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e PKCS5 -> ParseASN1 e PKCS5)
-> ParseASN1 e PKCS5 -> ParseASN1 e PKCS5
forall a b. (a -> b) -> a -> b
$ do
            IntVal Integer
0 <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            (ContentType
DataType, EncryptionScheme
eScheme, Attached ByteString
ed) <- ParseASN1 e (ContentType, EncryptionScheme, Encap ByteString)
forall e alg.
ParseASN1Object e alg =>
ParseASN1 e (ContentType, alg, Encap ByteString)
parseEncryptedContentInfo
            PKCS5 -> ParseASN1 e PKCS5
forall (m :: * -> *) a. Monad m => a -> m a
return PKCS5 :: EncryptionScheme -> ByteString -> PKCS5
PKCS5 { encryptionAlgorithm :: EncryptionScheme
encryptionAlgorithm = EncryptionScheme
eScheme, encryptedData :: ByteString
encryptedData = ByteString
ed }


-- Bags

-- | Polymorphic PKCS #12 bag parameterized by the payload data type.
data Bag info = Bag
    { Bag info -> info
bagInfo :: info              -- ^ bag payload
    , Bag info -> [Attribute]
bagAttributes :: [Attribute] -- ^ attributes providing additional information
    }
    deriving (Int -> Bag info -> ShowS
[Bag info] -> ShowS
Bag info -> FilePath
(Int -> Bag info -> ShowS)
-> (Bag info -> FilePath)
-> ([Bag info] -> ShowS)
-> Show (Bag info)
forall info. Show info => Int -> Bag info -> ShowS
forall info. Show info => [Bag info] -> ShowS
forall info. Show info => Bag info -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Bag info] -> ShowS
$cshowList :: forall info. Show info => [Bag info] -> ShowS
show :: Bag info -> FilePath
$cshow :: forall info. Show info => Bag info -> FilePath
showsPrec :: Int -> Bag info -> ShowS
$cshowsPrec :: forall info. Show info => Int -> Bag info -> ShowS
Show,Bag info -> Bag info -> Bool
(Bag info -> Bag info -> Bool)
-> (Bag info -> Bag info -> Bool) -> Eq (Bag info)
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
..} = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
oid ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
val ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
att)
      where
        typ :: BagType info
typ = info -> BagType info
forall info. BagInfo info => info -> BagType info
bagType info
bagInfo
        oid :: ASN1Stream e
oid = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (BagType info -> OID
forall a. OIDable a => a -> OID
getObjectID BagType info
typ)
        val :: ASN1Stream e
val = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (info -> ASN1Stream e
forall info e. (BagInfo info, ASN1Elem e) => info -> ASN1Stream e
valueASN1S info
bagInfo)

        att :: ASN1Stream e
att | [Attribute] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Attribute]
bagAttributes = ASN1Stream e
forall a. a -> a
id
            | Bool
otherwise          = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Set ([Attribute] -> ASN1Stream e
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 = ASN1ConstructionType
-> ParseASN1 e (Bag info) -> ParseASN1 e (Bag info)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (Bag info) -> ParseASN1 e (Bag info))
-> ParseASN1 e (Bag info) -> ParseASN1 e (Bag info)
forall a b. (a -> b) -> a -> b
$ do
        OID OID
oid <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        info
val <- FilePath
-> OID -> (BagType info -> ParseASN1 e info) -> ParseASN1 e info
forall a e b.
OIDNameable a =>
FilePath -> OID -> (a -> ParseASN1 e b) -> ParseASN1 e b
withObjectID (info -> FilePath
getName info
forall a. HasCallStack => a
undefined) OID
oid ((BagType info -> ParseASN1 e info) -> ParseASN1 e info)
-> (BagType info -> ParseASN1 e info) -> ParseASN1 e info
forall a b. (a -> b) -> a -> b
$
                   ASN1ConstructionType -> ParseASN1 e info -> ParseASN1 e info
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (ParseASN1 e info -> ParseASN1 e info)
-> (BagType info -> ParseASN1 e info)
-> BagType info
-> ParseASN1 e info
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BagType info -> ParseASN1 e info
forall info e.
(BagInfo info, Monoid e) =>
BagType info -> ParseASN1 e info
parseValue
        [Attribute]
att <- [Attribute] -> Maybe [Attribute] -> [Attribute]
forall a. a -> Maybe a -> a
fromMaybe [] (Maybe [Attribute] -> [Attribute])
-> ParseASN1 e (Maybe [Attribute]) -> ParseASN1 e [Attribute]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType
-> ParseASN1 e [Attribute] -> ParseASN1 e (Maybe [Attribute])
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e (Maybe a)
onNextContainerMaybe ASN1ConstructionType
Set ParseASN1 e [Attribute]
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        Bag info -> ParseASN1 e (Bag info)
forall (m :: * -> *) a. Monad m => a -> m a
return Bag :: forall info. info -> [Attribute] -> Bag info
Bag { bagInfo :: info
bagInfo = info
val, bagAttributes :: [Attribute]
bagAttributes = [Attribute]
att }
      where
        getName :: info -> String
        getName :: info -> FilePath
getName = info -> FilePath
forall info. BagInfo info => info -> FilePath
bagName

data CertType = TypeCertX509 deriving (Int -> CertType -> ShowS
[CertType] -> ShowS
CertType -> FilePath
(Int -> CertType -> ShowS)
-> (CertType -> FilePath) -> ([CertType] -> ShowS) -> Show CertType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CertType] -> ShowS
$cshowList :: [CertType] -> ShowS
show :: CertType -> FilePath
$cshow :: CertType -> FilePath
showsPrec :: Int -> CertType -> ShowS
$cshowsPrec :: Int -> CertType -> ShowS
Show,CertType -> CertType -> Bool
(CertType -> CertType -> Bool)
-> (CertType -> CertType -> Bool) -> Eq CertType
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 = OIDNameableWrapper CertType -> CertType
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper CertType -> CertType)
-> Maybe (OIDNameableWrapper CertType) -> Maybe CertType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper CertType)
forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | Certificate bags.  Only X.509 certificates are supported.
newtype CertInfo = CertX509 X509.SignedCertificate deriving (Int -> CertInfo -> ShowS
[CertInfo] -> ShowS
CertInfo -> FilePath
(Int -> CertInfo -> ShowS)
-> (CertInfo -> FilePath) -> ([CertInfo] -> ShowS) -> Show CertInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CertInfo] -> ShowS
$cshowList :: [CertInfo] -> ShowS
show :: CertInfo -> FilePath
$cshow :: CertInfo -> FilePath
showsPrec :: Int -> CertInfo -> ShowS
$cshowsPrec :: Int -> CertInfo -> ShowS
Show,CertInfo -> CertInfo -> Bool
(CertInfo -> CertInfo -> Bool)
-> (CertInfo -> CertInfo -> Bool) -> Eq CertInfo
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 -> FilePath
bagName CertInfo
_ = FilePath
"CertBag"
    bagType :: CertInfo -> BagType CertInfo
bagType (CertX509 SignedCertificate
_) = CertType
BagType CertInfo
TypeCertX509
    valueASN1S :: CertInfo -> ASN1Stream e
valueASN1S (CertX509 SignedCertificate
c) = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (SignedCertificate -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object SignedCertificate
c)
    parseValue :: BagType CertInfo -> ParseASN1 e CertInfo
parseValue BagType CertInfo
TypeCertX509 = SignedCertificate -> CertInfo
CertX509 (SignedCertificate -> CertInfo)
-> ParseASN1 e SignedCertificate -> ParseASN1 e CertInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> ParseASN1 e SignedCertificate
forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
FilePath -> ParseASN1 e obj
parseOctetStringObject FilePath
"CertBag"

data CRLType = TypeCRLX509 deriving (Int -> CRLType -> ShowS
[CRLType] -> ShowS
CRLType -> FilePath
(Int -> CRLType -> ShowS)
-> (CRLType -> FilePath) -> ([CRLType] -> ShowS) -> Show CRLType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CRLType] -> ShowS
$cshowList :: [CRLType] -> ShowS
show :: CRLType -> FilePath
$cshow :: CRLType -> FilePath
showsPrec :: Int -> CRLType -> ShowS
$cshowsPrec :: Int -> CRLType -> ShowS
Show,CRLType -> CRLType -> Bool
(CRLType -> CRLType -> Bool)
-> (CRLType -> CRLType -> Bool) -> Eq CRLType
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 = OIDNameableWrapper CRLType -> CRLType
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper CRLType -> CRLType)
-> Maybe (OIDNameableWrapper CRLType) -> Maybe CRLType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper CRLType)
forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | CRL bags.  Only X.509 CRLs are supported.
newtype CRLInfo = CRLX509 X509.SignedCRL deriving (Int -> CRLInfo -> ShowS
[CRLInfo] -> ShowS
CRLInfo -> FilePath
(Int -> CRLInfo -> ShowS)
-> (CRLInfo -> FilePath) -> ([CRLInfo] -> ShowS) -> Show CRLInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [CRLInfo] -> ShowS
$cshowList :: [CRLInfo] -> ShowS
show :: CRLInfo -> FilePath
$cshow :: CRLInfo -> FilePath
showsPrec :: Int -> CRLInfo -> ShowS
$cshowsPrec :: Int -> CRLInfo -> ShowS
Show,CRLInfo -> CRLInfo -> Bool
(CRLInfo -> CRLInfo -> Bool)
-> (CRLInfo -> CRLInfo -> Bool) -> Eq CRLInfo
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 -> FilePath
bagName CRLInfo
_ = FilePath
"CRLBag"
    bagType :: CRLInfo -> BagType CRLInfo
bagType (CRLX509 SignedCRL
_) = CRLType
BagType CRLInfo
TypeCRLX509
    valueASN1S :: CRLInfo -> ASN1Stream e
valueASN1S (CRLX509 SignedCRL
c) = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (SignedCRL -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object SignedCRL
c)
    parseValue :: BagType CRLInfo -> ParseASN1 e CRLInfo
parseValue BagType CRLInfo
TypeCRLX509 = SignedCRL -> CRLInfo
CRLX509 (SignedCRL -> CRLInfo)
-> ParseASN1 e SignedCRL -> ParseASN1 e CRLInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> ParseASN1 e SignedCRL
forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
FilePath -> ParseASN1 e obj
parseOctetStringObject FilePath
"CRLBag"

data SafeType = TypeKey
              | TypePKCS8ShroudedKey
              | TypeCert
              | TypeCRL
              | TypeSecret
              | TypeSafeContents
    deriving (Int -> SafeType -> ShowS
[SafeType] -> ShowS
SafeType -> FilePath
(Int -> SafeType -> ShowS)
-> (SafeType -> FilePath) -> ([SafeType] -> ShowS) -> Show SafeType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SafeType] -> ShowS
$cshowList :: [SafeType] -> ShowS
show :: SafeType -> FilePath
$cshow :: SafeType -> FilePath
showsPrec :: Int -> SafeType -> ShowS
$cshowsPrec :: Int -> SafeType -> ShowS
Show,SafeType -> SafeType -> Bool
(SafeType -> SafeType -> Bool)
-> (SafeType -> SafeType -> Bool) -> Eq SafeType
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 = OIDNameableWrapper SafeType -> SafeType
forall a. OIDNameableWrapper a -> a
unOIDNW (OIDNameableWrapper SafeType -> SafeType)
-> Maybe (OIDNameableWrapper SafeType) -> Maybe SafeType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OID -> Maybe (OIDNameableWrapper SafeType)
forall a. OIDNameable a => OID -> Maybe a
fromObjectID OID
oid

-- | Main bag payload in PKCS #12 contents.
data SafeInfo = KeyBag (FormattedKey X509.PrivKey) -- ^ unencrypted private key
              | PKCS8ShroudedKeyBag PKCS5          -- ^ encrypted private key
              | CertBag (Bag CertInfo)             -- ^ certificate
              | CRLBag (Bag CRLInfo)               -- ^ CRL
              | SecretBag [ASN1]                   -- ^ arbitrary secret
              | SafeContentsBag SafeContents       -- ^ safe contents embeded recursively
    deriving (Int -> SafeInfo -> ShowS
[SafeInfo] -> ShowS
SafeInfo -> FilePath
(Int -> SafeInfo -> ShowS)
-> (SafeInfo -> FilePath) -> ([SafeInfo] -> ShowS) -> Show SafeInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SafeInfo] -> ShowS
$cshowList :: [SafeInfo] -> ShowS
show :: SafeInfo -> FilePath
$cshow :: SafeInfo -> FilePath
showsPrec :: Int -> SafeInfo -> ShowS
$cshowsPrec :: Int -> SafeInfo -> ShowS
Show,SafeInfo -> SafeInfo -> Bool
(SafeInfo -> SafeInfo -> Bool)
-> (SafeInfo -> SafeInfo -> Bool) -> Eq SafeInfo
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 -> FilePath
bagName SafeInfo
_ = FilePath
"SafeBag"

    bagType :: SafeInfo -> BagType SafeInfo
bagType (KeyBag FormattedKey PrivKey
_)              = SafeType
BagType SafeInfo
TypeKey
    bagType (PKCS8ShroudedKeyBag PKCS5
_) = SafeType
BagType SafeInfo
TypePKCS8ShroudedKey
    bagType (CertBag Bag CertInfo
_)             = SafeType
BagType SafeInfo
TypeCert
    bagType (CRLBag Bag CRLInfo
_)              = SafeType
BagType SafeInfo
TypeCRL
    bagType (SecretBag [ASN1]
_)           = SafeType
BagType SafeInfo
TypeSecret
    bagType (SafeContentsBag SafeContents
_)     = SafeType
BagType SafeInfo
TypeSafeContents

    valueASN1S :: SafeInfo -> ASN1Stream e
valueASN1S (KeyBag FormattedKey PrivKey
k)              = FormattedKey PrivKey -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s FormattedKey PrivKey
k
    valueASN1S (PKCS8ShroudedKeyBag PKCS5
k) = PKCS5 -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s PKCS5
k
    valueASN1S (CertBag Bag CertInfo
c)             = Bag CertInfo -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s Bag CertInfo
c
    valueASN1S (CRLBag Bag CRLInfo
c)              = Bag CRLInfo -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s Bag CRLInfo
c
    valueASN1S (SecretBag [ASN1]
s)           = [ASN1] -> ASN1Stream e
forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
gMany [ASN1]
s
    valueASN1S (SafeContentsBag SafeContents
sc)    = SafeContents -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s SafeContents
sc

    parseValue :: BagType SafeInfo -> ParseASN1 e SafeInfo
parseValue BagType SafeInfo
TypeKey              = FormattedKey PrivKey -> SafeInfo
KeyBag (FormattedKey PrivKey -> SafeInfo)
-> ParseASN1 e (FormattedKey PrivKey) -> ParseASN1 e SafeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (FormattedKey PrivKey)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    parseValue BagType SafeInfo
TypePKCS8ShroudedKey = PKCS5 -> SafeInfo
PKCS8ShroudedKeyBag (PKCS5 -> SafeInfo) -> ParseASN1 e PKCS5 -> ParseASN1 e SafeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e PKCS5
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    parseValue BagType SafeInfo
TypeCert             = Bag CertInfo -> SafeInfo
CertBag (Bag CertInfo -> SafeInfo)
-> ParseASN1 e (Bag CertInfo) -> ParseASN1 e SafeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Bag CertInfo)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    parseValue BagType SafeInfo
TypeCRL              = Bag CRLInfo -> SafeInfo
CRLBag (Bag CRLInfo -> SafeInfo)
-> ParseASN1 e (Bag CRLInfo) -> ParseASN1 e SafeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Bag CRLInfo)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    parseValue BagType SafeInfo
TypeSecret           = [ASN1] -> SafeInfo
SecretBag ([ASN1] -> SafeInfo) -> ParseASN1 e [ASN1] -> ParseASN1 e SafeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e ASN1 -> ParseASN1 e [ASN1]
forall e a. ParseASN1 e a -> ParseASN1 e [a]
getMany ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    parseValue BagType SafeInfo
TypeSafeContents     = SafeContents -> SafeInfo
SafeContentsBag (SafeContents -> SafeInfo)
-> ParseASN1 e SafeContents -> ParseASN1 e SafeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e SafeContents
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse

-- | Main bag type in a PKCS #12.
type SafeBag = Bag SafeInfo

-- | Content objects stored in a PKCS #12.
newtype SafeContents = SafeContents { SafeContents -> [SafeBag]
unSafeContents :: [SafeBag] }
    deriving (Int -> SafeContents -> ShowS
[SafeContents] -> ShowS
SafeContents -> FilePath
(Int -> SafeContents -> ShowS)
-> (SafeContents -> FilePath)
-> ([SafeContents] -> ShowS)
-> Show SafeContents
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [SafeContents] -> ShowS
$cshowList :: [SafeContents] -> ShowS
show :: SafeContents -> FilePath
$cshow :: SafeContents -> FilePath
showsPrec :: Int -> SafeContents -> ShowS
$cshowsPrec :: Int -> SafeContents -> ShowS
Show,SafeContents -> SafeContents -> Bool
(SafeContents -> SafeContents -> Bool)
-> (SafeContents -> SafeContents -> Bool) -> Eq SafeContents
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) = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence ([SafeBag] -> ASN1Stream e
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 ([SafeBag] -> SafeContents)
-> ParseASN1 e [SafeBag] -> ParseASN1 e SafeContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType
-> ParseASN1 e [SafeBag] -> ParseASN1 e [SafeBag]
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence ParseASN1 e [SafeBag]
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 ((SafeBag -> Maybe SafeBag) -> [SafeBag] -> [SafeBag]
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) =
        SafeBag -> Maybe SafeBag
forall a. a -> Maybe a
Just (SafeInfo -> [Attribute] -> SafeBag
forall info. info -> [Attribute] -> Bag info
Bag (SafeContents -> SafeInfo
SafeContentsBag (SafeContents -> SafeInfo) -> SafeContents -> SafeInfo
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 (SafeBag -> [Attribute]
forall info. Bag info -> [Attribute]
bagAttributes SafeBag
bag)         = SafeBag -> Maybe SafeBag
forall a. a -> Maybe a
Just SafeBag
bag
          | Bool
otherwise                     = Maybe SafeBag
forall a. Maybe a
Nothing

filterByFriendlyName :: String -> SafeContents -> SafeContents
filterByFriendlyName :: FilePath -> SafeContents -> SafeContents
filterByFriendlyName FilePath
name = ([Attribute] -> Bool) -> SafeContents -> SafeContents
filterBags ((Maybe FilePath -> Maybe FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
name) (Maybe FilePath -> Bool)
-> ([Attribute] -> Maybe FilePath) -> [Attribute] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> Maybe FilePath
getFriendlyName)

filterByLocalKeyId :: BS.ByteString -> SafeContents -> SafeContents
filterByLocalKeyId :: ByteString -> SafeContents -> SafeContents
filterByLocalKeyId ByteString
d = ([Attribute] -> Bool) -> SafeContents -> SafeContents
filterBags ((Maybe ByteString -> Maybe ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
d) (Maybe ByteString -> Bool)
-> ([Attribute] -> Maybe ByteString) -> [Attribute] -> Bool
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 SafeBag -> SafeInfo
forall info. Bag info -> info
bagInfo SafeBag
bag of
            KeyBag (FormattedKey PrivateKeyFormat
_ PrivKey
k) -> Id PrivKey -> OptProtected (Id PrivKey)
forall a. a -> OptProtected a
Unprotected (PrivKey -> SafeBag -> Id PrivKey
forall a info. a -> Bag info -> Id a
mkId PrivKey
k SafeBag
bag) OptProtected (Id PrivKey)
-> [OptProtected (Id PrivKey)] -> [OptProtected (Id PrivKey)]
forall a. a -> [a] -> [a]
: [SafeBag] -> [OptProtected (Id PrivKey)]
loop [SafeBag]
bags
            PKCS8ShroudedKeyBag PKCS5
k     -> (ByteString -> Either StoreError (Id PrivKey))
-> OptProtected (Id PrivKey)
forall a. (ByteString -> Either StoreError a) -> OptProtected a
Protected (PKCS5 -> SafeBag -> ByteString -> Either StoreError (Id PrivKey)
forall a info.
(ParseASN1Object [ASN1Event] (Traditional a),
 ParseASN1Object [ASN1Event] (Modern a)) =>
PKCS5 -> Bag info -> ByteString -> Either StoreError (Id a)
unshroud PKCS5
k SafeBag
bag) OptProtected (Id PrivKey)
-> [OptProtected (Id PrivKey)] -> [OptProtected (Id PrivKey)]
forall a. a -> [a] -> [a]
: [SafeBag] -> [OptProtected (Id PrivKey)]
loop [SafeBag]
bags
            SafeContentsBag SafeContents
inner     -> SafeContents -> [OptProtected (Id PrivKey)]
getSafeKeysId SafeContents
inner [OptProtected (Id PrivKey)]
-> [OptProtected (Id PrivKey)] -> [OptProtected (Id PrivKey)]
forall a. [a] -> [a] -> [a]
++ [SafeBag] -> [OptProtected (Id PrivKey)]
loop [SafeBag]
bags
            SafeInfo
_                         -> [SafeBag] -> [OptProtected (Id PrivKey)]
loop [SafeBag]
bags

    unshroud :: PKCS5 -> Bag info -> ByteString -> Either StoreError (Id a)
unshroud PKCS5
shrouded Bag info
bag ByteString
pwd = do
        ByteString
bs <- PKCS5 -> ByteString -> Either StoreError ByteString
decrypt PKCS5
shrouded ByteString
pwd
        FormattedKey PrivateKeyFormat
_ a
k <- ByteString -> Either StoreError (FormattedKey a)
forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode ByteString
bs
        Id a -> Either StoreError (Id a)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> Bag info -> Id a
forall a info. a -> Bag info -> Id a
mkId a
k Bag info
bag)

-- | Return all private keys contained in the safe contents.
getSafeKeys :: SafeContents -> [OptProtected X509.PrivKey]
getSafeKeys :: SafeContents -> [OptProtected PrivKey]
getSafeKeys = (OptProtected (Id PrivKey) -> OptProtected PrivKey)
-> [OptProtected (Id PrivKey)] -> [OptProtected PrivKey]
forall a b. (a -> b) -> [a] -> [b]
map ((Id PrivKey -> PrivKey)
-> OptProtected (Id PrivKey) -> OptProtected PrivKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id PrivKey -> PrivKey
forall a. Id a -> a
unId) ([OptProtected (Id PrivKey)] -> [OptProtected PrivKey])
-> (SafeContents -> [OptProtected (Id PrivKey)])
-> SafeContents
-> [OptProtected PrivKey]
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 = [OptProtected (Id PrivKey)] -> OptProtected [Id PrivKey]
forall a. [OptProtected a] -> OptProtected [a]
applySamePassword ([OptProtected (Id PrivKey)] -> OptProtected [Id PrivKey])
-> ([SafeContents] -> [OptProtected (Id PrivKey)])
-> [SafeContents]
-> OptProtected [Id PrivKey]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SafeContents -> [OptProtected (Id PrivKey)])
-> [SafeContents] -> [OptProtected (Id PrivKey)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SafeContents -> [OptProtected (Id PrivKey)]
getSafeKeysId

-- | Return all private keys contained in the safe content list.  All shrouded
-- private keys must derive from the same password.
--
-- This convenience function returns a 'Protected' value as soon as one key at
-- least is encrypted.  This does not mean all keys were actually protected in
-- the input.  If detailed view is required then function 'getSafeKeys' is
-- available.
getAllSafeKeys :: [SafeContents] -> OptProtected [X509.PrivKey]
getAllSafeKeys :: [SafeContents] -> OptProtected [PrivKey]
getAllSafeKeys = [OptProtected PrivKey] -> OptProtected [PrivKey]
forall a. [OptProtected a] -> OptProtected [a]
applySamePassword ([OptProtected PrivKey] -> OptProtected [PrivKey])
-> ([SafeContents] -> [OptProtected PrivKey])
-> [SafeContents]
-> OptProtected [PrivKey]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SafeContents -> [OptProtected PrivKey])
-> [SafeContents] -> [OptProtected PrivKey]
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 SafeBag -> SafeInfo
forall info. Bag info -> info
bagInfo SafeBag
bag of
            CertBag (Bag (CertX509 SignedCertificate
c) [Attribute]
_) -> SignedCertificate -> SafeBag -> Id SignedCertificate
forall a info. a -> Bag info -> Id a
mkId SignedCertificate
c SafeBag
bag Id SignedCertificate
-> [Id SignedCertificate] -> [Id SignedCertificate]
forall a. a -> [a] -> [a]
: [SafeBag] -> [Id SignedCertificate]
loop [SafeBag]
bags
            SafeContentsBag SafeContents
inner        -> SafeContents -> [Id SignedCertificate]
getSafeX509CertsId SafeContents
inner [Id SignedCertificate]
-> [Id SignedCertificate] -> [Id SignedCertificate]
forall a. [a] -> [a] -> [a]
++ [SafeBag] -> [Id SignedCertificate]
loop [SafeBag]
bags
            SafeInfo
_                            -> [SafeBag] -> [Id SignedCertificate]
loop [SafeBag]
bags

-- | Return all X.509 certificates contained in the safe contents.
getSafeX509Certs :: SafeContents -> [X509.SignedCertificate]
getSafeX509Certs :: SafeContents -> [SignedCertificate]
getSafeX509Certs = (Id SignedCertificate -> SignedCertificate)
-> [Id SignedCertificate] -> [SignedCertificate]
forall a b. (a -> b) -> [a] -> [b]
map Id SignedCertificate -> SignedCertificate
forall a. Id a -> a
unId ([Id SignedCertificate] -> [SignedCertificate])
-> (SafeContents -> [Id SignedCertificate])
-> SafeContents
-> [SignedCertificate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeContents -> [Id SignedCertificate]
getSafeX509CertsId

-- | Return all X.509 certificates contained in the safe content list.
getAllSafeX509Certs :: [SafeContents] -> [X509.SignedCertificate]
getAllSafeX509Certs :: [SafeContents] -> [SignedCertificate]
getAllSafeX509Certs = (SafeContents -> [SignedCertificate])
-> [SafeContents] -> [SignedCertificate]
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 SafeBag -> SafeInfo
forall info. Bag info -> info
bagInfo SafeBag
bag of
            CRLBag (Bag (CRLX509 SignedCRL
c) [Attribute]
_) -> SignedCRL -> SafeBag -> Id SignedCRL
forall a info. a -> Bag info -> Id a
mkId SignedCRL
c SafeBag
bag Id SignedCRL -> [Id SignedCRL] -> [Id SignedCRL]
forall a. a -> [a] -> [a]
: [SafeBag] -> [Id SignedCRL]
loop [SafeBag]
bags
            SafeContentsBag SafeContents
inner      -> SafeContents -> [Id SignedCRL]
getSafeX509CRLsId SafeContents
inner [Id SignedCRL] -> [Id SignedCRL] -> [Id SignedCRL]
forall a. [a] -> [a] -> [a]
++ [SafeBag] -> [Id SignedCRL]
loop [SafeBag]
bags
            SafeInfo
_                          -> [SafeBag] -> [Id SignedCRL]
loop [SafeBag]
bags

-- | Return all X.509 CRLs contained in the safe contents.
getSafeX509CRLs :: SafeContents -> [X509.SignedCRL]
getSafeX509CRLs :: SafeContents -> [SignedCRL]
getSafeX509CRLs = (Id SignedCRL -> SignedCRL) -> [Id SignedCRL] -> [SignedCRL]
forall a b. (a -> b) -> [a] -> [b]
map Id SignedCRL -> SignedCRL
forall a. Id a -> a
unId ([Id SignedCRL] -> [SignedCRL])
-> (SafeContents -> [Id SignedCRL]) -> SafeContents -> [SignedCRL]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeContents -> [Id SignedCRL]
getSafeX509CRLsId

-- | Return all X.509 CRLs contained in the safe content list.
getAllSafeX509CRLs :: [SafeContents] -> [X509.SignedCRL]
getAllSafeX509CRLs :: [SafeContents] -> [SignedCRL]
getAllSafeX509CRLs = (SafeContents -> [SignedCRL]) -> [SafeContents] -> [SignedCRL]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SafeContents -> [SignedCRL]
getSafeX509CRLs


-- Conversion to/from credentials

getInnerCredential :: [SafeContents] -> SamePassword (Maybe (X509.CertificateChain, X509.PrivKey))
getInnerCredential :: [SafeContents] -> SamePassword (Maybe (CertificateChain, PrivKey))
getInnerCredential [SafeContents]
l = OptProtected (Maybe (CertificateChain, PrivKey))
-> SamePassword (Maybe (CertificateChain, PrivKey))
forall a. OptProtected a -> SamePassword a
SamePassword ([Id PrivKey] -> Maybe (CertificateChain, PrivKey)
fn ([Id PrivKey] -> Maybe (CertificateChain, PrivKey))
-> OptProtected [Id PrivKey]
-> OptProtected (Maybe (CertificateChain, PrivKey))
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 <- [Id PrivKey] -> Maybe (Id PrivKey)
forall a. [a] -> Maybe a
single [Id PrivKey]
idKeys
        let k :: PrivKey
k = Id PrivKey -> PrivKey
forall a. Id a -> a
unId Id PrivKey
iKey
        case Id PrivKey -> Maybe ByteString
forall a. Id a -> Maybe ByteString
idKeyId Id PrivKey
iKey of
            Just ByteString
d  -> do
                -- locate a single certificate with same ID as private key
                -- and follow the issuers to get all certificates in the chain
                let filtered :: [SafeContents]
filtered = (SafeContents -> SafeContents) -> [SafeContents] -> [SafeContents]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> SafeContents -> SafeContents
filterByLocalKeyId ByteString
d) [SafeContents]
l
                SignedCertificate
leaf <- [SignedCertificate] -> Maybe SignedCertificate
forall a. [a] -> Maybe a
single ([SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
filtered)
                (CertificateChain, PrivKey) -> Maybe (CertificateChain, PrivKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignedCertificate -> [SignedCertificate] -> CertificateChain
buildCertificateChain SignedCertificate
leaf [SignedCertificate]
certs, PrivKey
k)
            Maybe ByteString
Nothing ->
                case Id PrivKey -> Maybe FilePath
forall a. Id a -> Maybe FilePath
idName Id PrivKey
iKey of
                    Just FilePath
name -> do
                        -- same but using friendly name of private key
                        let filtered :: [SafeContents]
filtered = (SafeContents -> SafeContents) -> [SafeContents] -> [SafeContents]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SafeContents -> SafeContents
filterByFriendlyName FilePath
name) [SafeContents]
l
                        SignedCertificate
leaf <- [SignedCertificate] -> Maybe SignedCertificate
forall a. [a] -> Maybe a
single ([SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
filtered)
                        (CertificateChain, PrivKey) -> Maybe (CertificateChain, PrivKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignedCertificate -> [SignedCertificate] -> CertificateChain
buildCertificateChain SignedCertificate
leaf [SignedCertificate]
certs, PrivKey
k)
                    Maybe FilePath
Nothing   -> do
                        -- no identifier available, so we simply return all
                        -- certificates with input order
                        Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [SignedCertificate] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignedCertificate]
certs)
                        (CertificateChain, PrivKey) -> Maybe (CertificateChain, PrivKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([SignedCertificate] -> CertificateChain
X509.CertificateChain [SignedCertificate]
certs, PrivKey
k)

-- | Extract the private key and certificate chain from a 'PKCS12' value.  A
-- credential is returned when the structure contains exactly one private key
-- and at least one X.509 certificate.
toCredential :: PKCS12 -> OptProtected (Maybe (X509.CertificateChain, X509.PrivKey))
toCredential :: PKCS12 -> OptProtected (Maybe (CertificateChain, PrivKey))
toCredential PKCS12
p12 =
    SamePassword (Maybe (CertificateChain, PrivKey))
-> OptProtected (Maybe (CertificateChain, PrivKey))
forall a. SamePassword a -> OptProtected a
unSamePassword (OptProtected [SafeContents] -> SamePassword [SafeContents]
forall a. OptProtected a -> SamePassword a
SamePassword (PKCS12 -> OptProtected [SafeContents]
unPKCS12 PKCS12
p12) SamePassword [SafeContents]
-> ([SafeContents]
    -> SamePassword (Maybe (CertificateChain, PrivKey)))
-> SamePassword (Maybe (CertificateChain, PrivKey))
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 :: FilePath
-> [SafeContents]
-> SamePassword (Maybe (CertificateChain, PrivKey))
getInnerCredentialNamed FilePath
name [SafeContents]
l = OptProtected (Maybe (CertificateChain, PrivKey))
-> SamePassword (Maybe (CertificateChain, PrivKey))
forall a. OptProtected a -> SamePassword a
SamePassword ([PrivKey] -> Maybe (CertificateChain, PrivKey)
fn ([PrivKey] -> Maybe (CertificateChain, PrivKey))
-> OptProtected [PrivKey]
-> OptProtected (Maybe (CertificateChain, PrivKey))
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 = (SafeContents -> SafeContents) -> [SafeContents] -> [SafeContents]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> SafeContents -> SafeContents
filterByFriendlyName FilePath
name) [SafeContents]
l
    fn :: [PrivKey] -> Maybe (CertificateChain, PrivKey)
fn [PrivKey]
keys  = do
        PrivKey
k <- [PrivKey] -> Maybe PrivKey
forall a. [a] -> Maybe a
single [PrivKey]
keys
        SignedCertificate
leaf <- [SignedCertificate] -> Maybe SignedCertificate
forall a. [a] -> Maybe a
single ([SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
filtered)
        (CertificateChain, PrivKey) -> Maybe (CertificateChain, PrivKey)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SignedCertificate -> [SignedCertificate] -> CertificateChain
buildCertificateChain SignedCertificate
leaf [SignedCertificate]
certs, PrivKey
k)

-- | Extract a private key and certificate chain with the specified friendly
-- name from a 'PKCS12' value.  A credential is returned when the structure
-- contains exactly one private key and one X.509 certificate with the name.
toNamedCredential :: String -> PKCS12 -> OptProtected (Maybe (X509.CertificateChain, X509.PrivKey))
toNamedCredential :: FilePath
-> PKCS12 -> OptProtected (Maybe (CertificateChain, PrivKey))
toNamedCredential FilePath
name PKCS12
p12 = SamePassword (Maybe (CertificateChain, PrivKey))
-> OptProtected (Maybe (CertificateChain, PrivKey))
forall a. SamePassword a -> OptProtected a
unSamePassword (SamePassword (Maybe (CertificateChain, PrivKey))
 -> OptProtected (Maybe (CertificateChain, PrivKey)))
-> SamePassword (Maybe (CertificateChain, PrivKey))
-> OptProtected (Maybe (CertificateChain, PrivKey))
forall a b. (a -> b) -> a -> b
$
    OptProtected [SafeContents] -> SamePassword [SafeContents]
forall a. OptProtected a -> SamePassword a
SamePassword (PKCS12 -> OptProtected [SafeContents]
unPKCS12 PKCS12
p12) SamePassword [SafeContents]
-> ([SafeContents]
    -> SamePassword (Maybe (CertificateChain, PrivKey)))
-> SamePassword (Maybe (CertificateChain, PrivKey))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= FilePath
-> [SafeContents]
-> SamePassword (Maybe (CertificateChain, PrivKey))
getInnerCredentialNamed FilePath
name

-- | Build a 'PKCS12' value containing a private key and certificate chain.
-- Distinct encryption is applied for both.  Encrypting the certificate chain is
-- optional.
--
-- Note: advice is to always generate fresh and independent 'EncryptionScheme'
-- values so that the salt is not reused twice in the encryption process.
fromCredential :: Maybe EncryptionScheme -- for certificates
               -> EncryptionScheme       -- for private key
               -> Password
               -> (X509.CertificateChain, X509.PrivKey)
               -> Either StoreError PKCS12
fromCredential :: Maybe EncryptionScheme
-> EncryptionScheme
-> ByteString
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential = ([Attribute] -> [Attribute])
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ByteString
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential' [Attribute] -> [Attribute]
forall a. a -> a
id

-- | Build a 'PKCS12' value containing a private key and certificate chain
-- identified with the specified friendly name.  Distinct encryption is applied
-- for private key and certificates.  Encrypting the certificate chain is
-- optional.
--
-- Note: advice is to always generate fresh and independent 'EncryptionScheme'
-- values so that the salt is not reused twice in the encryption process.
fromNamedCredential :: String
                    -> Maybe EncryptionScheme -- for certificates
                    -> EncryptionScheme       -- for private key
                    -> Password
                    -> (X509.CertificateChain, X509.PrivKey)
                    -> Either StoreError PKCS12
fromNamedCredential :: FilePath
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ByteString
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromNamedCredential FilePath
name = ([Attribute] -> [Attribute])
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ByteString
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential' (FilePath -> [Attribute] -> [Attribute]
setFriendlyName FilePath
name)

fromCredential' :: ([Attribute] -> [Attribute])
                -> Maybe EncryptionScheme -- for certificates
                -> EncryptionScheme       -- for private key
                -> Password
                -> (X509.CertificateChain, X509.PrivKey)
                -> Either StoreError PKCS12
fromCredential' :: ([Attribute] -> [Attribute])
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ByteString
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential' [Attribute] -> [Attribute]
trans Maybe EncryptionScheme
algChain EncryptionScheme
algKey ByteString
pwd (X509.CertificateChain [SignedCertificate]
certs, PrivKey
key)
    | [SignedCertificate] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SignedCertificate]
certs = StoreError -> Either StoreError PKCS12
forall a b. a -> Either a b
Left (FilePath -> StoreError
InvalidInput FilePath
"Empty certificate chain")
    | Bool
otherwise  = PKCS12 -> PKCS12 -> PKCS12
forall a. Semigroup a => a -> a -> a
(<>) (PKCS12 -> PKCS12 -> PKCS12)
-> Either StoreError PKCS12 -> Either StoreError (PKCS12 -> PKCS12)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Either StoreError PKCS12
pkcs12Chain Either StoreError (PKCS12 -> PKCS12)
-> Either StoreError PKCS12 -> Either StoreError PKCS12
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 (SafeContents -> PKCS12)
-> Either StoreError SafeContents -> Either StoreError PKCS12
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
-> ByteString -> SafeContents -> Either StoreError PKCS12
encrypted EncryptionScheme
alg ByteString
pwd SafeContents
scChain
            Maybe EncryptionScheme
Nothing  -> PKCS12 -> Either StoreError PKCS12
forall a b. b -> Either a b
Right (SafeContents -> PKCS12
unencrypted SafeContents
scChain)

    scChain :: SafeContents
scChain       = [SafeBag] -> SafeContents
SafeContents (([Attribute] -> SignedCertificate -> SafeBag)
-> [[Attribute]] -> [SignedCertificate] -> [SafeBag]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Attribute] -> SignedCertificate -> SafeBag
toCertBag [[Attribute]]
certAttrs [SignedCertificate]
certs)
    certAttrs :: [[Attribute]]
certAttrs     = [Attribute]
attrs [Attribute] -> [[Attribute]] -> [[Attribute]]
forall a. a -> [a] -> [a]
: [Attribute] -> [[Attribute]]
forall a. a -> [a]
repeat []
    toCertBag :: [Attribute] -> SignedCertificate -> SafeBag
toCertBag [Attribute]
a SignedCertificate
c = SafeInfo -> [Attribute] -> SafeBag
forall info. info -> [Attribute] -> Bag info
Bag (Bag CertInfo -> SafeInfo
CertBag (CertInfo -> [Attribute] -> Bag CertInfo
forall info. info -> [Attribute] -> Bag info
Bag (SignedCertificate -> CertInfo
CertX509 SignedCertificate
c) [])) [Attribute]
a

    scKeyOrError :: Either StoreError SafeContents
scKeyOrError = PKCS5 -> SafeContents
wrap (PKCS5 -> SafeContents)
-> Either StoreError PKCS5 -> Either StoreError SafeContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncryptionScheme
-> ByteString -> ByteString -> Either StoreError PKCS5
encrypt EncryptionScheme
algKey ByteString
pwd ByteString
encodedKey

    wrap :: PKCS5 -> SafeContents
wrap PKCS5
shrouded = [SafeBag] -> SafeContents
SafeContents [SafeInfo -> [Attribute] -> SafeBag
forall info. info -> [Attribute] -> Bag info
Bag (PKCS5 -> SafeInfo
PKCS8ShroudedKeyBag PKCS5
shrouded) [Attribute]
attrs]
    encodedKey :: ByteString
encodedKey    = FormattedKey PrivKey -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object (PrivateKeyFormat -> PrivKey -> FormattedKey PrivKey
forall a. PrivateKeyFormat -> a -> FormattedKey a
FormattedKey PrivateKeyFormat
PKCS8Format PrivKey
key)

    X509.Fingerprint ByteString
keyId = SignedCertificate -> HashALG -> Fingerprint
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> HashALG -> Fingerprint
X509.getFingerprint ([SignedCertificate] -> SignedCertificate
forall a. [a] -> a
head [SignedCertificate]
certs) HashALG
X509.HashSHA1
    attrs :: [Attribute]
attrs = [Attribute] -> [Attribute]
trans (ByteString -> [Attribute] -> [Attribute]
setLocalKeyId ByteString
keyId [])

-- Standard attributes

friendlyName :: OID
friendlyName :: OID
friendlyName = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
20]

-- | Return the value of the @friendlyName@ attribute.
getFriendlyName :: [Attribute] -> Maybe String
getFriendlyName :: [Attribute] -> Maybe FilePath
getFriendlyName [Attribute]
attrs = OID -> [Attribute] -> ParseASN1 () FilePath -> Maybe FilePath
forall a. OID -> [Attribute] -> ParseASN1 () a -> Maybe a
runParseAttribute OID
friendlyName [Attribute]
attrs (ParseASN1 () FilePath -> Maybe FilePath)
-> ParseASN1 () FilePath -> Maybe FilePath
forall a b. (a -> b) -> a -> b
$ do
    ASN1String ASN1CharacterString
str <- ParseASN1 () ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    case ASN1CharacterString -> Maybe FilePath
asn1CharacterToString ASN1CharacterString
str of
        Maybe FilePath
Nothing -> FilePath -> ParseASN1 () FilePath
forall e a. FilePath -> ParseASN1 e a
throwParseError FilePath
"Invalid friendlyName value"
        Just FilePath
s  -> FilePath -> ParseASN1 () FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return FilePath
s

-- | Add or replace the @friendlyName@ attribute in a list of attributes.
setFriendlyName :: String -> [Attribute] -> [Attribute]
setFriendlyName :: FilePath -> [Attribute] -> [Attribute]
setFriendlyName FilePath
name = OID -> ASN1S -> [Attribute] -> [Attribute]
setAttributeASN1S OID
friendlyName (FilePath -> ASN1S
forall e. ASN1Elem e => FilePath -> ASN1Stream e
gBMPString FilePath
name)

localKeyId :: OID
localKeyId :: OID
localKeyId = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
21]

-- | Return the value of the @localKeyId@ attribute.
getLocalKeyId :: [Attribute] -> Maybe BS.ByteString
getLocalKeyId :: [Attribute] -> Maybe ByteString
getLocalKeyId [Attribute]
attrs = OID -> [Attribute] -> ParseASN1 () ByteString -> Maybe ByteString
forall a. OID -> [Attribute] -> ParseASN1 () a -> Maybe a
runParseAttribute OID
localKeyId [Attribute]
attrs (ParseASN1 () ByteString -> Maybe ByteString)
-> ParseASN1 () ByteString -> Maybe ByteString
forall a b. (a -> b) -> a -> b
$ do
    OctetString ByteString
d <- ParseASN1 () ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    ByteString -> ParseASN1 () ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
d

-- | Add or replace the @localKeyId@ attribute in a list of attributes.
setLocalKeyId :: BS.ByteString -> [Attribute] -> [Attribute]
setLocalKeyId :: ByteString -> [Attribute] -> [Attribute]
setLocalKeyId ByteString
d = OID -> ASN1S -> [Attribute] -> [Attribute]
setAttributeASN1S OID
localKeyId (ByteString -> ASN1S
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
d)


-- Utilities

-- Internal wrapper of OptProtected providing Applicative and Monad instances.
--
-- This adds the following constraint: all values composed must derive from the
-- same encryption password.  Semantically, 'Protected' actually means
-- "requiring a password".  Otherwise composition of 'Protected' and
-- 'Unprotected' values is unsound.
newtype SamePassword a = SamePassword { SamePassword a -> OptProtected a
unSamePassword :: OptProtected a }

instance Functor SamePassword where
    fmap :: (a -> b) -> SamePassword a -> SamePassword b
fmap a -> b
f (SamePassword OptProtected a
opt) = OptProtected b -> SamePassword b
forall a. OptProtected a -> SamePassword a
SamePassword ((a -> b) -> OptProtected a -> OptProtected b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f OptProtected a
opt)

instance Applicative SamePassword where
    pure :: a -> SamePassword a
pure a
a = OptProtected a -> SamePassword a
forall a. OptProtected a -> SamePassword a
SamePassword (a -> OptProtected a
forall a. a -> OptProtected a
Unprotected a
a)

    SamePassword (Unprotected a -> b
f) <*> :: SamePassword (a -> b) -> SamePassword a -> SamePassword b
<*> SamePassword (Unprotected a
x) =
        OptProtected b -> SamePassword b
forall a. OptProtected a -> SamePassword a
SamePassword (b -> OptProtected b
forall a. a -> OptProtected a
Unprotected (a -> b
f a
x))

    SamePassword (Unprotected a -> b
f) <*> SamePassword (Protected ByteString -> Either StoreError a
x) =
        OptProtected b -> SamePassword b
forall a. OptProtected a -> SamePassword a
SamePassword (OptProtected b -> SamePassword b)
-> OptProtected b -> SamePassword b
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either StoreError b) -> OptProtected b
forall a. (ByteString -> Either StoreError a) -> OptProtected a
Protected ((a -> b) -> Either StoreError a -> Either StoreError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (Either StoreError a -> Either StoreError b)
-> (ByteString -> Either StoreError a)
-> ByteString
-> Either StoreError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either StoreError a
x)

    SamePassword (Protected ByteString -> Either StoreError (a -> b)
f) <*> SamePassword (Unprotected a
x) =
        OptProtected b -> SamePassword b
forall a. OptProtected a -> SamePassword a
SamePassword (OptProtected b -> SamePassword b)
-> OptProtected b -> SamePassword b
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either StoreError b) -> OptProtected b
forall a. (ByteString -> Either StoreError a) -> OptProtected a
Protected (((a -> b) -> b)
-> Either StoreError (a -> b) -> Either StoreError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ a
x) (Either StoreError (a -> b) -> Either StoreError b)
-> (ByteString -> Either StoreError (a -> b))
-> ByteString
-> Either StoreError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either StoreError (a -> b)
f)

    SamePassword (Protected ByteString -> Either StoreError (a -> b)
f) <*> SamePassword (Protected ByteString -> Either StoreError a
x) =
        OptProtected b -> SamePassword b
forall a. OptProtected a -> SamePassword a
SamePassword (OptProtected b -> SamePassword b)
-> OptProtected b -> SamePassword b
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either StoreError b) -> OptProtected b
forall a. (ByteString -> Either StoreError a) -> OptProtected a
Protected (\ByteString
pwd -> ByteString -> Either StoreError (a -> b)
f ByteString
pwd Either StoreError (a -> b)
-> Either StoreError a -> Either StoreError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ByteString -> Either StoreError a
x ByteString
pwd)

instance Monad SamePassword where
    return :: a -> SamePassword a
return = a -> SamePassword a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

    SamePassword (Unprotected a
x)   >>= :: SamePassword a -> (a -> SamePassword b) -> SamePassword b
>>= a -> SamePassword b
f = a -> SamePassword b
f a
x
    SamePassword (Protected ByteString -> Either StoreError a
inner) >>= a -> SamePassword b
f =
        OptProtected b -> SamePassword b
forall a. OptProtected a -> SamePassword a
SamePassword (OptProtected b -> SamePassword b)
-> ((ByteString -> Either StoreError b) -> OptProtected b)
-> (ByteString -> Either StoreError b)
-> SamePassword b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> Either StoreError b) -> OptProtected b
forall a. (ByteString -> Either StoreError a) -> OptProtected a
Protected ((ByteString -> Either StoreError b) -> SamePassword b)
-> (ByteString -> Either StoreError b) -> SamePassword b
forall a b. (a -> b) -> a -> b
$ \ByteString
pwd ->
            case ByteString -> Either StoreError a
inner ByteString
pwd of
                Left StoreError
err -> StoreError -> Either StoreError b
forall a b. a -> Either a b
Left StoreError
err
                Right a
x  -> ByteString -> OptProtected b -> Either StoreError b
forall a. ByteString -> OptProtected a -> Either StoreError a
recover ByteString
pwd (SamePassword b -> OptProtected b
forall a. SamePassword a -> OptProtected a
unSamePassword (SamePassword b -> OptProtected b)
-> SamePassword b -> OptProtected b
forall a b. (a -> b) -> a -> b
$ a -> SamePassword b
f a
x)

applySamePassword :: [OptProtected a] -> OptProtected [a]
applySamePassword :: [OptProtected a] -> OptProtected [a]
applySamePassword = SamePassword [a] -> OptProtected [a]
forall a. SamePassword a -> OptProtected a
unSamePassword (SamePassword [a] -> OptProtected [a])
-> ([OptProtected a] -> SamePassword [a])
-> [OptProtected a]
-> OptProtected [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (OptProtected a -> SamePassword a)
-> [OptProtected a] -> SamePassword [a]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse OptProtected a -> SamePassword a
forall a. OptProtected a -> SamePassword a
SamePassword

single :: [a] -> Maybe a
single :: [a] -> Maybe a
single [a
x] = a -> Maybe a
forall a. a -> Maybe a
Just a
x
single [a]
_   = Maybe a
forall a. Maybe a
Nothing

data Id a = Id
    { Id a -> a
unId    :: a
    , Id a -> Maybe ByteString
idKeyId :: Maybe BS.ByteString
    , Id a -> Maybe FilePath
idName  :: Maybe String
    }

mkId :: a -> Bag info -> Id a
mkId :: a -> Bag info -> Id a
mkId a
val Bag info
bag = a
val a -> Id a -> Id a
`seq` a -> Maybe ByteString -> Maybe FilePath -> Id a
forall a. a -> Maybe ByteString -> Maybe FilePath -> Id a
Id a
val ([Attribute] -> Maybe ByteString
getLocalKeyId [Attribute]
attrs) ([Attribute] -> Maybe FilePath
getFriendlyName [Attribute]
attrs)
  where attrs :: [Attribute]
attrs = Bag info -> [Attribute]
forall info. Bag info -> [Attribute]
bagAttributes Bag info
bag

decode :: ParseASN1Object [ASN1Event] obj => BS.ByteString -> Either StoreError obj
decode :: ByteString -> Either StoreError obj
decode = ByteString -> Either StoreError obj
forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decodeASN1Object

parseOctetStringObject :: (Monoid e, ParseASN1Object [ASN1Event] obj)
                       => String -> ParseASN1 e obj
parseOctetStringObject :: FilePath -> ParseASN1 e obj
parseOctetStringObject FilePath
name = do
    OctetString ByteString
bs <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    case ByteString -> Either StoreError obj
forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode ByteString
bs of
        Left StoreError
e  -> FilePath -> ParseASN1 e obj
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath
name FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ StoreError -> FilePath
forall a. Show a => a -> FilePath
show StoreError
e)
        Right obj
c -> obj -> ParseASN1 e obj
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 SignedCertificate -> [SignedCertificate] -> [SignedCertificate]
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 DistinguishedName -> DistinguishedName -> Bool
forall a. Eq a => a -> a -> Bool
== SignedCertificate -> DistinguishedName
issuer SignedCertificate
cert = []
        | Bool
otherwise                   =
            case (SignedCertificate -> Bool)
-> [SignedCertificate]
-> ([SignedCertificate], [SignedCertificate])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition (\SignedCertificate
c -> SignedCertificate -> DistinguishedName
subject SignedCertificate
c DistinguishedName -> DistinguishedName -> Bool
forall a. Eq a => a -> a -> Bool
== SignedCertificate -> DistinguishedName
issuer SignedCertificate
cert) [SignedCertificate]
others of
                ([SignedCertificate
c], [SignedCertificate]
others') -> SignedCertificate
c SignedCertificate -> [SignedCertificate] -> [SignedCertificate]
forall a. a -> [a] -> [a]
: SignedCertificate -> [SignedCertificate] -> [SignedCertificate]
findAuthorities SignedCertificate
c [SignedCertificate]
others'
                ([SignedCertificate], [SignedCertificate])
_              -> []

    signedCert :: SignedCertificate -> Certificate
signedCert = Signed Certificate -> Certificate
forall a. (Show a, Eq a, ASN1Object a) => Signed a -> a
X509.signedObject (Signed Certificate -> Certificate)
-> (SignedCertificate -> Signed Certificate)
-> SignedCertificate
-> Certificate
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SignedCertificate -> Signed Certificate
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)