-- |
-- 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 CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}
module Crypto.Store.PKCS12
    ( IntegrityParams(..)
    , readP12File
    , readP12FileFromMemory
    , writeP12File
    , writeP12FileToMemory
    , writeUnprotectedP12File
    , writeUnprotectedP12FileToMemory
    -- * 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
    , OptAuthenticated(..)
    , recoverAuthenticated
    , ProtectionPassword
    , emptyNotTerminated
    , fromProtectionPassword
    , toProtectionPassword
    , OptProtected(..)
    , recover
    , recoverA
    ) where

import Control.Applicative
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 (isJust, fromMaybe, mapMaybe)
#if !(MIN_VERSION_base(4,11,0))
import           Data.Semigroup
#endif
import           Data.String (fromString)
import qualified Data.X509 as X509
import qualified Data.X509.Validation as X509

import Crypto.Cipher.Types

import Crypto.Store.ASN1.Generate
import Crypto.Store.ASN1.Parse
import Crypto.Store.CMS
import Crypto.Store.CMS.Algorithms
import Crypto.Store.CMS.Attribute
import Crypto.Store.CMS.Encrypted
import Crypto.Store.CMS.Enveloped
import Crypto.Store.CMS.Util
import Crypto.Store.Error
import Crypto.Store.Keys
import Crypto.Store.PKCS5
import Crypto.Store.PKCS5.PBES1
import Crypto.Store.PKCS8


-- Password-based integrity

-- | Data type for objects that are possibly authenticated with a password.
--
-- Content is verified and retrieved by providing a 'Password' value.  When
-- verification is successful, a value of type 'ProtectionPassword' is also
-- returned and this value can be fed to an inner decryption layer that needs
-- the same password (usual case for PKCS #12).
data OptAuthenticated a = Unauthenticated a
                          -- ^ Value is not authenticated
                        | Authenticated (Password -> Either StoreError (ProtectionPassword, a))
                          -- ^ Value is authenticated with a password

instance Functor OptAuthenticated where
    fmap :: forall a b. (a -> b) -> OptAuthenticated a -> OptAuthenticated b
fmap a -> b
f (Unauthenticated a
x) = b -> OptAuthenticated b
forall a. a -> OptAuthenticated a
Unauthenticated (a -> b
f a
x)
    fmap a -> b
f (Authenticated ByteString -> Either StoreError (ProtectionPassword, a)
g)   = (ByteString -> Either StoreError (ProtectionPassword, b))
-> OptAuthenticated b
forall a.
(ByteString -> Either StoreError (ProtectionPassword, a))
-> OptAuthenticated a
Authenticated (((ProtectionPassword, a) -> (ProtectionPassword, b))
-> Either StoreError (ProtectionPassword, a)
-> Either StoreError (ProtectionPassword, b)
forall a b. (a -> b) -> Either StoreError a -> Either StoreError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (ProtectionPassword, a) -> (ProtectionPassword, b)
forall a b.
(a -> b) -> (ProtectionPassword, a) -> (ProtectionPassword, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (Either StoreError (ProtectionPassword, a)
 -> Either StoreError (ProtectionPassword, b))
-> (ByteString -> Either StoreError (ProtectionPassword, a))
-> ByteString
-> Either StoreError (ProtectionPassword, b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either StoreError (ProtectionPassword, a)
g)

-- | Try to recover an 'OptAuthenticated' content using the specified password.
--
-- When successful, the content is returned, as well as the password converted
-- to type 'ProtectionPassword'.  This password value can then be fed to the
-- inner decryption layer when both passwords are known to be same (usual case
-- for PKCS #12).
recoverAuthenticated :: Password -> OptAuthenticated a -> Either StoreError (ProtectionPassword, a)
recoverAuthenticated :: forall a.
ByteString
-> OptAuthenticated a -> Either StoreError (ProtectionPassword, a)
recoverAuthenticated ByteString
pwd (Unauthenticated a
x) = (ProtectionPassword, a)
-> Either StoreError (ProtectionPassword, a)
forall a b. b -> Either a b
Right (ByteString -> ProtectionPassword
toProtectionPassword ByteString
pwd, a
x)
recoverAuthenticated ByteString
pwd (Authenticated ByteString -> Either StoreError (ProtectionPassword, a)
f)   = ByteString -> Either StoreError (ProtectionPassword, a)
f ByteString
pwd


-- Decoding and parsing

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

-- | Read a PKCS #12 file from a bytearray in BER format.
readP12FileFromMemory :: BS.ByteString -> Either StoreError (OptAuthenticated PKCS12)
readP12FileFromMemory :: ByteString -> Either StoreError (OptAuthenticated 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 (OptAuthenticated PKCS12))
-> Either StoreError (OptAuthenticated PKCS12)
forall a b.
Either StoreError a
-> (a -> Either StoreError b) -> Either StoreError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= PFX -> Either StoreError (OptAuthenticated PKCS12)
forall {a}.
ParseASN1Object [ASN1Event] a =>
PFX -> Either StoreError (OptAuthenticated a)
integrity
  where
    integrity :: PFX -> Either StoreError (OptAuthenticated a)
integrity PFX{Maybe MacData
ByteString
authSafeData :: ByteString
macData :: Maybe MacData
macData :: PFX -> Maybe MacData
authSafeData :: PFX -> ByteString
..} =
        case Maybe MacData
macData of
            Maybe MacData
Nothing -> a -> OptAuthenticated a
forall a. a -> OptAuthenticated a
Unauthenticated (a -> OptAuthenticated a)
-> Either StoreError a -> Either StoreError (OptAuthenticated 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 -> OptAuthenticated a -> Either StoreError (OptAuthenticated a)
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return (OptAuthenticated a -> Either StoreError (OptAuthenticated a))
-> OptAuthenticated a -> Either StoreError (OptAuthenticated a)
forall a b. (a -> b) -> a -> b
$ (ByteString -> Either StoreError (ProtectionPassword, a))
-> OptAuthenticated a
forall a.
(ByteString -> Either StoreError (ProtectionPassword, a))
-> OptAuthenticated a
Authenticated (MacData
-> ByteString
-> ByteString
-> Either StoreError (ProtectionPassword, a)
forall {a}.
ParseASN1Object [ASN1Event] a =>
MacData
-> ByteString
-> ByteString
-> Either StoreError (ProtectionPassword, a)
verify MacData
md ByteString
authSafeData)

    verify :: MacData
-> ByteString
-> ByteString
-> Either StoreError (ProtectionPassword, a)
verify MacData{MessageAuthenticationCode
PBEParameter
MacAlg
macAlg :: MacAlg
macValue :: MessageAuthenticationCode
macParams :: PBEParameter
macParams :: MacData -> PBEParameter
macValue :: MacData -> MessageAuthenticationCode
macAlg :: MacData -> MacAlg
..} ByteString
content ByteString
pwdUTF8 =
        case MacAlg
macAlg of
            MacTraditional (DigestAlgorithm DigestProxy hashAlg
d) -> [ProtectionPassword] -> Either StoreError (ProtectionPassword, a)
loop (ByteString -> [ProtectionPassword]
toProtectionPasswords ByteString
pwdUTF8)
              where
                -- iterate over all possible representations of a password
                -- until a successful match is found
                loop :: [ProtectionPassword] -> Either StoreError (ProtectionPassword, a)
loop []           = StoreError -> Either StoreError (ProtectionPassword, a)
forall a b. a -> Either a b
Left StoreError
BadContentMAC
                loop (ProtectionPassword
pwd:[ProtectionPassword]
others) =
                    let fn :: Key
-> MACAlgorithm
-> ByteString
-> Either StoreError (ProtectionPassword, a)
fn Key
key MACAlgorithm
digAlg ByteString
bs
                            | Bool -> Bool
not (MACAlgorithm -> Bool
forall params. HasStrength params => params -> Bool
securityAcceptable MACAlgorithm
digAlg) =
                                StoreError -> Either StoreError (ProtectionPassword, a)
forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"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
digAlg Key
key ByteString
bs = (ProtectionPassword
pwd,) (a -> (ProtectionPassword, a))
-> Either StoreError a -> Either StoreError (ProtectionPassword, 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
bs
                            | Bool
otherwise = [ProtectionPassword] -> Either StoreError (ProtectionPassword, a)
loop [ProtectionPassword]
others
                     in (StoreError -> Either StoreError (ProtectionPassword, a))
-> (Key
    -> MACAlgorithm
    -> ByteString
    -> Either StoreError (ProtectionPassword, a))
-> DigestProxy hashAlg
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> Either StoreError (ProtectionPassword, a)
forall hash result.
HashAlgorithm hash =>
(StoreError -> result)
-> (Key -> MACAlgorithm -> ByteString -> result)
-> DigestProxy hash
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> result
pkcs12mac StoreError -> Either StoreError (ProtectionPassword, a)
forall a b. a -> Either a b
Left Key
-> MACAlgorithm
-> ByteString
-> Either StoreError (ProtectionPassword, a)
fn DigestProxy hashAlg
d PBEParameter
macParams ByteString
content ProtectionPassword
pwd

            -- for RFC 9579 the primary representation is always used, this is
            -- fine because we assume the encryption layer also uses that
            -- representation
            MacAuthScheme AuthenticationScheme
authScheme
                | Bool -> Bool
not (AuthenticationScheme -> Bool
hasExplicitKeyLength AuthenticationScheme
authScheme) ->
                    StoreError -> Either StoreError (ProtectionPassword, a)
forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"KDF key length must be explicit")
                | Bool -> Bool
not (AuthenticationScheme -> Bool
forall params. HasStrength params => params -> Bool
securityAcceptable AuthenticationScheme
authScheme) ->
                    StoreError -> Either StoreError (ProtectionPassword, a)
forall a b. a -> Either a b
Left (String -> StoreError
InvalidParameter String
"Integrity MAC too weak")
                | MessageAuthenticationCode
macValue MessageAuthenticationCode -> MessageAuthenticationCode -> Bool
forall a. Eq a => a -> a -> Bool
== AuthenticationScheme
-> ByteString -> ProtectionPassword -> MessageAuthenticationCode
pbMac AuthenticationScheme
authScheme ByteString
content ProtectionPassword
pwd -> (ProtectionPassword
pwd,) (a -> (ProtectionPassword, a))
-> Either StoreError a -> Either StoreError (ProtectionPassword, 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
content
                | Bool
otherwise -> StoreError -> Either StoreError (ProtectionPassword, a)
forall a b. a -> Either a b
Left StoreError
BadContentMAC
              where pwd :: ProtectionPassword
pwd = ByteString -> ProtectionPassword
toProtectionPassword ByteString
pwdUTF8

    hasExplicitKeyLength :: AuthenticationScheme -> Bool
hasExplicitKeyLength (PBMAC1 PBMAC1Parameter
p) = Maybe Int -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Int -> Bool) -> Maybe Int -> Bool
forall a b. (a -> b) -> a -> b
$ KeyDerivationFunc -> Maybe Int
kdfKeyLength (PBMAC1Parameter -> KeyDerivationFunc
pbmac1KDF PBMAC1Parameter
p)


-- Generating and encoding

-- | Parameters used for password integrity mode.
data IntegrityParams
    = TraditionalIntegrity DigestAlgorithm PBEParameter
      -- ^ Traditional PKCS #12 integrity, with a digest algoritm
    | AuthSchemeIntegrity AuthenticationScheme
      -- ^ Integrity with an authentication scheme such as PBMAC1
    deriving (Int -> IntegrityParams -> ShowS
[IntegrityParams] -> ShowS
IntegrityParams -> String
(Int -> IntegrityParams -> ShowS)
-> (IntegrityParams -> String)
-> ([IntegrityParams] -> ShowS)
-> Show IntegrityParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IntegrityParams -> ShowS
showsPrec :: Int -> IntegrityParams -> ShowS
$cshow :: IntegrityParams -> String
show :: IntegrityParams -> String
$cshowList :: [IntegrityParams] -> ShowS
showList :: [IntegrityParams] -> ShowS
Show,IntegrityParams -> IntegrityParams -> Bool
(IntegrityParams -> IntegrityParams -> Bool)
-> (IntegrityParams -> IntegrityParams -> Bool)
-> Eq IntegrityParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: IntegrityParams -> IntegrityParams -> Bool
== :: IntegrityParams -> IntegrityParams -> Bool
$c/= :: IntegrityParams -> IntegrityParams -> Bool
/= :: IntegrityParams -> IntegrityParams -> Bool
Eq)

-- | Write a PKCS #12 file to disk.
writeP12File :: FilePath
             -> IntegrityParams -> ProtectionPassword
             -> PKCS12
             -> IO (Either StoreError ())
writeP12File :: String
-> IntegrityParams
-> ProtectionPassword
-> PKCS12
-> IO (Either StoreError ())
writeP12File String
path IntegrityParams
intp ProtectionPassword
pw PKCS12
aSafe =
    case IntegrityParams
-> ProtectionPassword -> PKCS12 -> Either StoreError ByteString
writeP12FileToMemory IntegrityParams
intp ProtectionPassword
pw PKCS12
aSafe of
        Left StoreError
e   -> Either StoreError () -> IO (Either StoreError ())
forall a. a -> IO a
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
<$> String -> ByteString -> IO ()
BS.writeFile String
path ByteString
bs

-- | Write a PKCS #12 file to a bytearray in DER format.
writeP12FileToMemory :: IntegrityParams -> ProtectionPassword
                     -> PKCS12
                     -> Either StoreError BS.ByteString
writeP12FileToMemory :: IntegrityParams
-> ProtectionPassword -> PKCS12 -> Either StoreError ByteString
writeP12FileToMemory IntegrityParams
intp ProtectionPassword
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 { 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 = case IntegrityParams
intp of
        TraditionalIntegrity alg :: DigestAlgorithm
alg@(DigestAlgorithm DigestProxy hashAlg
hashAlg) PBEParameter
pbeParam ->
            let 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 { macAlg :: MacAlg
macAlg    = DigestAlgorithm -> MacAlg
MacTraditional 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
                                                 }
             in (StoreError -> Either StoreError MacData)
-> (Key -> MACAlgorithm -> ByteString -> Either StoreError MacData)
-> DigestProxy hashAlg
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> Either StoreError MacData
forall hash result.
HashAlgorithm hash =>
(StoreError -> result)
-> (Key -> MACAlgorithm -> ByteString -> result)
-> DigestProxy hash
-> PBEParameter
-> ByteString
-> ProtectionPassword
-> 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 ProtectionPassword
pwdUTF8
        AuthSchemeIntegrity AuthenticationScheme
authScheme
            | ProtectionPassword
pwdUTF8 ProtectionPassword -> ProtectionPassword -> Bool
forall a. Eq a => a -> a -> Bool
== ProtectionPassword
emptyNotTerminated ->
                StoreError -> Either StoreError MacData
forall a b. a -> Either a b
Left (String -> StoreError
InvalidPassword String
"Authentication scheme requires terminated password")
            | Bool
otherwise ->
                MacData -> Either StoreError MacData
forall a b. b -> Either a b
Right MacData { macAlg :: MacAlg
macAlg    = AuthenticationScheme -> MacAlg
MacAuthScheme (AuthenticationScheme -> AuthenticationScheme
transform AuthenticationScheme
authScheme)
                              , macValue :: MessageAuthenticationCode
macValue  = AuthenticationScheme
-> ByteString -> ProtectionPassword -> MessageAuthenticationCode
pbMac AuthenticationScheme
authScheme ByteString
content ProtectionPassword
pwdUTF8
                              , macParams :: PBEParameter
macParams = PBEParameter
unused
                              }
    unused :: PBEParameter
unused = ByteString -> Int -> PBEParameter
PBEParameter (String -> ByteString
forall a. IsString a => String -> a
fromString String
"NOT USED") Int
1

    transform :: AuthenticationScheme -> AuthenticationScheme
transform (PBMAC1 PBMAC1Parameter
p) = PBMAC1Parameter -> AuthenticationScheme
PBMAC1 (PBMAC1Parameter -> PBMAC1Parameter
ensureExplicitKeyLength PBMAC1Parameter
p)
    ensureExplicitKeyLength :: PBMAC1Parameter -> PBMAC1Parameter
ensureExplicitKeyLength PBMAC1Parameter
p = PBMAC1Parameter
p { pbmac1KDF = kdfKeyLengthModify fn (pbmac1KDF p) }
      where fn :: Maybe Int -> Maybe Int
fn = Int -> Maybe Int
forall a. a -> Maybe a
Just (Int -> Maybe Int) -> (Maybe Int -> Int) -> Maybe Int -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (MACAlgorithm -> Int
forall params. HasKeySize params => params -> Int
getMaximumKeySize (MACAlgorithm -> Int) -> MACAlgorithm -> Int
forall a b. (a -> b) -> a -> b
$ PBMAC1Parameter -> MACAlgorithm
pbmac1AScheme PBMAC1Parameter
p)

-- | Write a PKCS #12 file without integrity protection to disk.
writeUnprotectedP12File :: FilePath -> PKCS12 -> IO ()
writeUnprotectedP12File :: String -> PKCS12 -> IO ()
writeUnprotectedP12File String
path = String -> ByteString -> IO ()
BS.writeFile String
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 { 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 -> String
(Int -> PFX -> ShowS)
-> (PFX -> String) -> ([PFX] -> ShowS) -> Show PFX
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PFX -> ShowS
showsPrec :: Int -> PFX -> ShowS
$cshow :: PFX -> String
show :: PFX -> String
$cshowList :: [PFX] -> ShowS
showList :: [PFX] -> ShowS
Show,PFX -> PFX -> Bool
(PFX -> PFX -> Bool) -> (PFX -> PFX -> Bool) -> Eq PFX
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PFX -> PFX -> Bool
== :: PFX -> PFX -> Bool
$c/= :: PFX -> PFX -> Bool
/= :: PFX -> PFX -> Bool
Eq)

instance ProduceASN1Object ASN1P PFX where
    asn1s :: PFX -> ASN1Stream ASN1P
asn1s PFX{Maybe MacData
ByteString
macData :: PFX -> Maybe MacData
authSafeData :: PFX -> ByteString
authSafeData :: ByteString
macData :: Maybe MacData
..} =
        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 v <- ParseASN1 [ASN1Event] ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        when (v /= 3) $
            throwParseError ("PFX: parsed invalid version: " ++ show v)
        ci <- parse
        d <- case ci of
                 DataCI ByteString
bs      -> ByteString -> ParseASN1 [ASN1Event] ByteString
forall a. a -> ParseASN1 [ASN1Event] a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs
                 SignedDataCI SignedData (Encap ByteString)
_ -> String -> ParseASN1 [ASN1Event] ByteString
forall e a. String -> ParseASN1 e a
throwParseError String
"PFX: public-key integrity mode is not supported"
                 ContentInfo
_              -> String -> ParseASN1 [ASN1Event] ByteString
forall e a. String -> ParseASN1 e a
throwParseError (String -> ParseASN1 [ASN1Event] ByteString)
-> String -> ParseASN1 [ASN1Event] ByteString
forall a b. (a -> b) -> a -> b
$ String
"PFX: invalid content type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ContentType -> String
forall a. Show a => a -> String
show (ContentInfo -> ContentType
getContentType ContentInfo
ci)
        b <- hasNext
        m <- if b then Just <$> parse else pure Nothing
        return PFX { authSafeData = d, macData = m }

data MacAlg = MacTraditional DigestAlgorithm
            | MacAuthScheme AuthenticationScheme
            deriving (Int -> MacAlg -> ShowS
[MacAlg] -> ShowS
MacAlg -> String
(Int -> MacAlg -> ShowS)
-> (MacAlg -> String) -> ([MacAlg] -> ShowS) -> Show MacAlg
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MacAlg -> ShowS
showsPrec :: Int -> MacAlg -> ShowS
$cshow :: MacAlg -> String
show :: MacAlg -> String
$cshowList :: [MacAlg] -> ShowS
showList :: [MacAlg] -> ShowS
Show,MacAlg -> MacAlg -> Bool
(MacAlg -> MacAlg -> Bool)
-> (MacAlg -> MacAlg -> Bool) -> Eq MacAlg
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MacAlg -> MacAlg -> Bool
== :: MacAlg -> MacAlg -> Bool
$c/= :: MacAlg -> MacAlg -> Bool
/= :: MacAlg -> MacAlg -> Bool
Eq)

data MacData = MacData
    { MacData -> MacAlg
macAlg :: MacAlg
    , MacData -> MessageAuthenticationCode
macValue :: MessageAuthenticationCode
    , MacData -> PBEParameter
macParams :: PBEParameter
    }
    deriving (Int -> MacData -> ShowS
[MacData] -> ShowS
MacData -> String
(Int -> MacData -> ShowS)
-> (MacData -> String) -> ([MacData] -> ShowS) -> Show MacData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MacData -> ShowS
showsPrec :: Int -> MacData -> ShowS
$cshow :: MacData -> String
show :: MacData -> String
$cshowList :: [MacData] -> ShowS
showList :: [MacData] -> ShowS
Show,MacData -> MacData -> Bool
(MacData -> MacData -> Bool)
-> (MacData -> MacData -> Bool) -> Eq MacData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: MacData -> MacData -> Bool
== :: MacData -> MacData -> Bool
$c/= :: MacData -> MacData -> Bool
/= :: MacData -> MacData -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e MacData where
    asn1s :: MacData -> ASN1Stream e
asn1s MacData{MessageAuthenticationCode
PBEParameter
MacAlg
macParams :: MacData -> PBEParameter
macValue :: MacData -> MessageAuthenticationCode
macAlg :: MacData -> MacAlg
macAlg :: MacAlg
macValue :: MessageAuthenticationCode
macParams :: PBEParameter
..} =
        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 = MacAlg -> ASN1Stream e
forall {e}. ASN1Elem e => MacAlg -> ASN1Stream e
gMacAlg MacAlg
macAlg
        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)

        gMacAlg :: MacAlg -> ASN1Stream e
gMacAlg (MacTraditional DigestAlgorithm
alg) = ASN1ConstructionType -> DigestAlgorithm -> ASN1Stream e
forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence DigestAlgorithm
alg
        gMacAlg (MacAuthScheme AuthenticationScheme
authScheme) = ASN1ConstructionType -> AuthenticationScheme -> ASN1Stream e
forall e param.
(ASN1Elem e, AlgorithmId param, OIDable (AlgorithmType param)) =>
ASN1ConstructionType -> param -> ASN1Stream e
algorithmASN1S ASN1ConstructionType
Sequence AuthenticationScheme
authScheme

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
        (a, v) <- ASN1ConstructionType
-> ParseASN1 e (MacAlg, ByteString)
-> ParseASN1 e (MacAlg, ByteString)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (MacAlg, ByteString)
 -> ParseASN1 e (MacAlg, ByteString))
-> ParseASN1 e (MacAlg, ByteString)
-> ParseASN1 e (MacAlg, ByteString)
forall a b. (a -> b) -> a -> b
$ do
            a <- ParseASN1 e MacAlg
parseTraditional ParseASN1 e MacAlg -> ParseASN1 e MacAlg -> ParseASN1 e MacAlg
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e MacAlg
parseAuthScheme
            OctetString v <- getNext
            return (a, v)
        OctetString s <- getNext
        b <- hasNext
        IntVal i <- if b then getNext else pure (IntVal 1)
        return MacData { macAlg = a
                       , macValue = AuthTag (B.convert v)
                       , macParams = PBEParameter s (fromIntegral i)
                       }
      where
        parseTraditional :: ParseASN1 e MacAlg
parseTraditional = DigestAlgorithm -> MacAlg
MacTraditional (DigestAlgorithm -> MacAlg)
-> ParseASN1 e DigestAlgorithm -> ParseASN1 e MacAlg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType -> ParseASN1 e DigestAlgorithm
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence
        parseAuthScheme :: ParseASN1 e MacAlg
parseAuthScheme = AuthenticationScheme -> MacAlg
MacAuthScheme (AuthenticationScheme -> MacAlg)
-> ParseASN1 e AuthenticationScheme -> ParseASN1 e MacAlg
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType -> ParseASN1 e AuthenticationScheme
forall e param.
(Monoid e, AlgorithmId param, OIDNameable (AlgorithmType param)) =>
ASN1ConstructionType -> ParseASN1 e param
parseAlgorithm ASN1ConstructionType
Sequence

-- 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 -> String
(Int -> PKCS12 -> ShowS)
-> (PKCS12 -> String) -> ([PKCS12] -> ShowS) -> Show PKCS12
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PKCS12 -> ShowS
showsPrec :: Int -> PKCS12 -> ShowS
$cshow :: PKCS12 -> String
show :: PKCS12 -> String
$cshowList :: [PKCS12] -> ShowS
showList :: [PKCS12] -> ShowS
Show,PKCS12 -> PKCS12 -> Bool
(PKCS12 -> PKCS12 -> Bool)
-> (PKCS12 -> PKCS12 -> Bool) -> Eq PKCS12
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PKCS12 -> PKCS12 -> Bool
== :: PKCS12 -> PKCS12 -> Bool
$c/= :: PKCS12 -> PKCS12 -> Bool
/= :: 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)    = (ProtectionPassword -> Either StoreError SafeContents)
-> OptProtected SafeContents
forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected (PKCS5 -> ProtectionPassword -> Either StoreError ByteString
decrypt PKCS5
e (ProtectionPassword -> Either StoreError ByteString)
-> (ByteString -> Either StoreError SafeContents)
-> ProtectionPassword
-> 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 -> ProtectionPassword -> SafeContents -> Either StoreError PKCS12
encrypted :: EncryptionScheme
-> ProtectionPassword -> SafeContents -> Either StoreError PKCS12
encrypted EncryptionScheme
alg ProtectionPassword
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
-> ProtectionPassword -> ByteString -> Either StoreError PKCS5
encrypt EncryptionScheme
alg ProtectionPassword
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 -> String
(Int -> ASElement -> ShowS)
-> (ASElement -> String)
-> ([ASElement] -> ShowS)
-> Show ASElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ASElement -> ShowS
showsPrec :: Int -> ASElement -> ShowS
$cshow :: ASElement -> String
show :: ASElement -> String
$cshowList :: [ASElement] -> ShowS
showList :: [ASElement] -> ShowS
Show,ASElement -> ASElement -> Bool
(ASElement -> ASElement -> Bool)
-> (ASElement -> ASElement -> Bool) -> Eq ASElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ASElement -> ASElement -> Bool
== :: ASElement -> ASElement -> Bool
$c/= :: ASElement -> ASElement -> Bool
/= :: 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
encryptionAlgorithm :: EncryptionScheme
encryptedData :: ByteString
encryptedData :: PKCS5 -> ByteString
encryptionAlgorithm :: PKCS5 -> 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 <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        withObjectID "content type" oid $ \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 = String -> ParseASN1 e ASElement
forall e a. String -> ParseASN1 e a
throwParseError String
"PKCS12: public-key privacy mode is not supported"
        parseInner ContentType
ct                = String -> ParseASN1 e ASElement
forall e a. String -> ParseASN1 e a
throwParseError (String -> ParseASN1 e ASElement)
-> String -> ParseASN1 e ASElement
forall a b. (a -> b) -> a -> b
$ String
"PKCS12: invalid content type: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ContentType -> String
forall a. Show a => a -> String
show ContentType
ct

        parseUnencrypted :: ParseASN1 e SafeContents
parseUnencrypted = String -> ParseASN1 e SafeContents
forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
String -> ParseASN1 e obj
parseOctetStringObject String
"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 0 <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            (DataType, eScheme, Attached ed) <- parseEncryptedContentInfo
            return PKCS5 { encryptionAlgorithm = eScheme, encryptedData = ed }


-- Bags

-- | Polymorphic PKCS #12 bag parameterized by the payload data type.
data Bag info = Bag
    { forall info. Bag info -> info
bagInfo :: info              -- ^ bag payload
    , forall info. Bag info -> [Attribute]
bagAttributes :: [Attribute] -- ^ attributes providing additional information
    }
    deriving (Int -> Bag info -> ShowS
[Bag info] -> ShowS
Bag info -> String
(Int -> Bag info -> ShowS)
-> (Bag info -> String) -> ([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 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall info. Show info => Int -> Bag info -> ShowS
showsPrec :: Int -> Bag info -> ShowS
$cshow :: forall info. Show info => Bag info -> String
show :: Bag info -> String
$cshowList :: forall info. Show info => [Bag info] -> ShowS
showList :: [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
$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
/= :: 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]
bagInfo :: forall info. Bag info -> info
bagAttributes :: forall info. Bag info -> [Attribute]
bagInfo :: info
bagAttributes :: [Attribute]
..} = 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 e. ASN1Elem e => info -> ASN1Stream e
forall info e. (BagInfo info, ASN1Elem e) => info -> ASN1Stream e
valueASN1S info
bagInfo)

        att :: ASN1Stream e
att | [Attribute] -> Bool
forall a. [a] -> 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 <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        val <- withObjectID (getName undefined) oid $
                   onNextContainer (Container Context 0) . parseValue
        att <- fromMaybe [] <$> onNextContainerMaybe Set parse
        return Bag { bagInfo = val, bagAttributes = att }
      where
        getName :: info -> String
        getName :: info -> String
getName = info -> String
forall info. BagInfo info => info -> String
bagName

data CertType = TypeCertX509 deriving (Int -> CertType -> ShowS
[CertType] -> ShowS
CertType -> String
(Int -> CertType -> ShowS)
-> (CertType -> String) -> ([CertType] -> ShowS) -> Show CertType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertType -> ShowS
showsPrec :: Int -> CertType -> ShowS
$cshow :: CertType -> String
show :: CertType -> String
$cshowList :: [CertType] -> ShowS
showList :: [CertType] -> ShowS
Show,CertType -> CertType -> Bool
(CertType -> CertType -> Bool)
-> (CertType -> CertType -> Bool) -> Eq CertType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertType -> CertType -> Bool
== :: CertType -> CertType -> Bool
$c/= :: CertType -> CertType -> Bool
/= :: 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 -> String
(Int -> CertInfo -> ShowS)
-> (CertInfo -> String) -> ([CertInfo] -> ShowS) -> Show CertInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CertInfo -> ShowS
showsPrec :: Int -> CertInfo -> ShowS
$cshow :: CertInfo -> String
show :: CertInfo -> String
$cshowList :: [CertInfo] -> ShowS
showList :: [CertInfo] -> ShowS
Show,CertInfo -> CertInfo -> Bool
(CertInfo -> CertInfo -> Bool)
-> (CertInfo -> CertInfo -> Bool) -> Eq CertInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CertInfo -> CertInfo -> Bool
== :: CertInfo -> CertInfo -> Bool
$c/= :: CertInfo -> CertInfo -> Bool
/= :: CertInfo -> CertInfo -> Bool
Eq)

instance BagInfo CertInfo where
    type BagType CertInfo = CertType
    bagName :: CertInfo -> String
bagName CertInfo
_ = String
"CertBag"
    bagType :: CertInfo -> BagType CertInfo
bagType (CertX509 SignedCertificate
_) = CertType
BagType CertInfo
TypeCertX509
    valueASN1S :: forall e. ASN1Elem e => 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 :: forall e. Monoid e => BagType CertInfo -> ParseASN1 e CertInfo
parseValue CertType
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
<$> String -> ParseASN1 e SignedCertificate
forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
String -> ParseASN1 e obj
parseOctetStringObject String
"CertBag"

data CRLType = TypeCRLX509 deriving (Int -> CRLType -> ShowS
[CRLType] -> ShowS
CRLType -> String
(Int -> CRLType -> ShowS)
-> (CRLType -> String) -> ([CRLType] -> ShowS) -> Show CRLType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CRLType -> ShowS
showsPrec :: Int -> CRLType -> ShowS
$cshow :: CRLType -> String
show :: CRLType -> String
$cshowList :: [CRLType] -> ShowS
showList :: [CRLType] -> ShowS
Show,CRLType -> CRLType -> Bool
(CRLType -> CRLType -> Bool)
-> (CRLType -> CRLType -> Bool) -> Eq CRLType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CRLType -> CRLType -> Bool
== :: CRLType -> CRLType -> Bool
$c/= :: CRLType -> CRLType -> Bool
/= :: 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 -> String
(Int -> CRLInfo -> ShowS)
-> (CRLInfo -> String) -> ([CRLInfo] -> ShowS) -> Show CRLInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CRLInfo -> ShowS
showsPrec :: Int -> CRLInfo -> ShowS
$cshow :: CRLInfo -> String
show :: CRLInfo -> String
$cshowList :: [CRLInfo] -> ShowS
showList :: [CRLInfo] -> ShowS
Show,CRLInfo -> CRLInfo -> Bool
(CRLInfo -> CRLInfo -> Bool)
-> (CRLInfo -> CRLInfo -> Bool) -> Eq CRLInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CRLInfo -> CRLInfo -> Bool
== :: CRLInfo -> CRLInfo -> Bool
$c/= :: CRLInfo -> CRLInfo -> Bool
/= :: CRLInfo -> CRLInfo -> Bool
Eq)

instance BagInfo CRLInfo where
    type BagType CRLInfo = CRLType
    bagName :: CRLInfo -> String
bagName CRLInfo
_ = String
"CRLBag"
    bagType :: CRLInfo -> BagType CRLInfo
bagType (CRLX509 SignedCRL
_) = CRLType
BagType CRLInfo
TypeCRLX509
    valueASN1S :: forall e. ASN1Elem e => 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 :: forall e. Monoid e => BagType CRLInfo -> ParseASN1 e CRLInfo
parseValue CRLType
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
<$> String -> ParseASN1 e SignedCRL
forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
String -> ParseASN1 e obj
parseOctetStringObject String
"CRLBag"

data SafeType = TypeKey
              | TypePKCS8ShroudedKey
              | TypeCert
              | TypeCRL
              | TypeSecret
              | TypeSafeContents
    deriving (Int -> SafeType -> ShowS
[SafeType] -> ShowS
SafeType -> String
(Int -> SafeType -> ShowS)
-> (SafeType -> String) -> ([SafeType] -> ShowS) -> Show SafeType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SafeType -> ShowS
showsPrec :: Int -> SafeType -> ShowS
$cshow :: SafeType -> String
show :: SafeType -> String
$cshowList :: [SafeType] -> ShowS
showList :: [SafeType] -> ShowS
Show,SafeType -> SafeType -> Bool
(SafeType -> SafeType -> Bool)
-> (SafeType -> SafeType -> Bool) -> Eq SafeType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SafeType -> SafeType -> Bool
== :: SafeType -> SafeType -> Bool
$c/= :: SafeType -> SafeType -> Bool
/= :: 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 KeyPair)      -- ^ 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 -> String
(Int -> SafeInfo -> ShowS)
-> (SafeInfo -> String) -> ([SafeInfo] -> ShowS) -> Show SafeInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SafeInfo -> ShowS
showsPrec :: Int -> SafeInfo -> ShowS
$cshow :: SafeInfo -> String
show :: SafeInfo -> String
$cshowList :: [SafeInfo] -> ShowS
showList :: [SafeInfo] -> ShowS
Show,SafeInfo -> SafeInfo -> Bool
(SafeInfo -> SafeInfo -> Bool)
-> (SafeInfo -> SafeInfo -> Bool) -> Eq SafeInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SafeInfo -> SafeInfo -> Bool
== :: SafeInfo -> SafeInfo -> Bool
$c/= :: SafeInfo -> SafeInfo -> Bool
/= :: SafeInfo -> SafeInfo -> Bool
Eq)

instance BagInfo SafeInfo where
    type BagType SafeInfo = SafeType
    bagName :: SafeInfo -> String
bagName SafeInfo
_ = String
"SafeBag"

    bagType :: SafeInfo -> BagType SafeInfo
bagType (KeyBag FormattedKey KeyPair
_)              = 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 :: forall e. ASN1Elem e => SafeInfo -> ASN1Stream e
valueASN1S (KeyBag FormattedKey KeyPair
k)              = FormattedKey KeyPair -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s FormattedKey KeyPair
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 :: forall e. Monoid e => BagType SafeInfo -> ParseASN1 e SafeInfo
parseValue SafeType
BagType SafeInfo
TypeKey              = FormattedKey KeyPair -> SafeInfo
KeyBag (FormattedKey KeyPair -> SafeInfo)
-> ParseASN1 e (FormattedKey KeyPair) -> ParseASN1 e SafeInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (FormattedKey KeyPair)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    parseValue SafeType
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 SafeType
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 SafeType
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 SafeType
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 SafeType
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 -> String
(Int -> SafeContents -> ShowS)
-> (SafeContents -> String)
-> ([SafeContents] -> ShowS)
-> Show SafeContents
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SafeContents -> ShowS
showsPrec :: Int -> SafeContents -> ShowS
$cshow :: SafeContents -> String
show :: SafeContents -> String
$cshowList :: [SafeContents] -> ShowS
showList :: [SafeContents] -> ShowS
Show,SafeContents -> SafeContents -> Bool
(SafeContents -> SafeContents -> Bool)
-> (SafeContents -> SafeContents -> Bool) -> Eq SafeContents
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SafeContents -> SafeContents -> Bool
== :: SafeContents -> SafeContents -> Bool
$c/= :: SafeContents -> SafeContents -> Bool
/= :: 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 :: String -> SafeContents -> SafeContents
filterByFriendlyName String
name = ([Attribute] -> Bool) -> SafeContents -> SafeContents
filterBags ((Maybe String -> Maybe String -> Bool
forall a. Eq a => a -> a -> Bool
== String -> Maybe String
forall a. a -> Maybe a
Just String
name) (Maybe String -> Bool)
-> ([Attribute] -> Maybe String) -> [Attribute] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Attribute] -> Maybe String
getFriendlyName)

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

    unshroud :: PKCS5 -> Bag info -> ProtectionPassword -> Either StoreError (Id a)
unshroud PKCS5
shrouded Bag info
bag ProtectionPassword
pwd = do
        bs <- PKCS5 -> ProtectionPassword -> Either StoreError ByteString
decrypt PKCS5
shrouded ProtectionPassword
pwd
        FormattedKey _ k <- decode bs
        return (mkId k bag)

-- | Return all private keys contained in the safe contents.
getSafeKeys :: SafeContents -> [OptProtected KeyPair]
getSafeKeys :: SafeContents -> [OptProtected KeyPair]
getSafeKeys = (OptProtected (Id KeyPair) -> OptProtected KeyPair)
-> [OptProtected (Id KeyPair)] -> [OptProtected KeyPair]
forall a b. (a -> b) -> [a] -> [b]
map ((Id KeyPair -> KeyPair)
-> OptProtected (Id KeyPair) -> OptProtected KeyPair
forall a b. (a -> b) -> OptProtected a -> OptProtected b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Id KeyPair -> KeyPair
forall a. Id a -> a
unId) ([OptProtected (Id KeyPair)] -> [OptProtected KeyPair])
-> (SafeContents -> [OptProtected (Id KeyPair)])
-> SafeContents
-> [OptProtected KeyPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SafeContents -> [OptProtected (Id KeyPair)]
getSafeKeysId

getAllSafeKeysId :: [SafeContents] -> OptProtected [Id KeyPair]
getAllSafeKeysId :: [SafeContents] -> OptProtected [Id KeyPair]
getAllSafeKeysId = [OptProtected (Id KeyPair)] -> OptProtected [Id KeyPair]
forall a. [OptProtected a] -> OptProtected [a]
applySamePassword ([OptProtected (Id KeyPair)] -> OptProtected [Id KeyPair])
-> ([SafeContents] -> [OptProtected (Id KeyPair)])
-> [SafeContents]
-> OptProtected [Id KeyPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SafeContents -> [OptProtected (Id KeyPair)])
-> [SafeContents] -> [OptProtected (Id KeyPair)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SafeContents -> [OptProtected (Id KeyPair)]
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 [KeyPair]
getAllSafeKeys :: [SafeContents] -> OptProtected [KeyPair]
getAllSafeKeys = [OptProtected KeyPair] -> OptProtected [KeyPair]
forall a. [OptProtected a] -> OptProtected [a]
applySamePassword ([OptProtected KeyPair] -> OptProtected [KeyPair])
-> ([SafeContents] -> [OptProtected KeyPair])
-> [SafeContents]
-> OptProtected [KeyPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SafeContents -> [OptProtected KeyPair])
-> [SafeContents] -> [OptProtected KeyPair]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap SafeContents -> [OptProtected KeyPair]
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 KeyPair] -> Maybe (CertificateChain, PrivKey)
fn ([Id KeyPair] -> Maybe (CertificateChain, PrivKey))
-> OptProtected [Id KeyPair]
-> OptProtected (Maybe (CertificateChain, PrivKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SafeContents] -> OptProtected [Id KeyPair]
getAllSafeKeysId [SafeContents]
l)
  where
    certs :: [SignedCertificate]
certs     = [SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
l
    fn :: [Id KeyPair] -> Maybe (CertificateChain, PrivKey)
fn [Id KeyPair]
idKeys = do
        iKey <- [Id KeyPair] -> Maybe (Id KeyPair)
forall a. [a] -> Maybe a
single [Id KeyPair]
idKeys
        let k = Id KeyPair -> KeyPair
forall a. Id a -> a
unId Id KeyPair
iKey
        case idKeyId 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
                leaf <- [SignedCertificate] -> Maybe SignedCertificate
forall a. [a] -> Maybe a
single ([SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
filtered)
                guard (keyPairMatchesCert k leaf)
                pure (buildCertificateChain leaf certs, keyPairToPrivKey k)
            Maybe ByteString
Nothing ->
                case Id KeyPair -> Maybe String
forall a. Id a -> Maybe String
idName Id KeyPair
iKey of
                    Just String
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 (String -> SafeContents -> SafeContents
filterByFriendlyName String
name) [SafeContents]
l
                        leaf <- [SignedCertificate] -> Maybe SignedCertificate
forall a. [a] -> Maybe a
single ([SafeContents] -> [SignedCertificate]
getAllSafeX509Certs [SafeContents]
filtered)
                        guard (keyPairMatchesCert k leaf)
                        pure (buildCertificateChain leaf certs, keyPairToPrivKey k)
                    Maybe String
Nothing   -> do
                        -- no identifier available, so we have to search all
                        -- certificates for the one consistent with the private
                        -- key
                        leaf <- [SignedCertificate] -> Maybe SignedCertificate
forall a. [a] -> Maybe a
single (KeyPair -> [SignedCertificate] -> [SignedCertificate]
filterWithPrivKey KeyPair
k [SignedCertificate]
certs)
                        pure (buildCertificateChain leaf certs, keyPairToPrivKey k)
    filterWithPrivKey :: KeyPair -> [SignedCertificate] -> [SignedCertificate]
filterWithPrivKey = (SignedCertificate -> Bool)
-> [SignedCertificate] -> [SignedCertificate]
forall a. (a -> Bool) -> [a] -> [a]
filter ((SignedCertificate -> Bool)
 -> [SignedCertificate] -> [SignedCertificate])
-> (KeyPair -> SignedCertificate -> Bool)
-> KeyPair
-> [SignedCertificate]
-> [SignedCertificate]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> SignedCertificate -> Bool
keyPairMatchesCert

-- | 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 a b.
SamePassword a -> (a -> SamePassword b) -> SamePassword b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [SafeContents] -> SamePassword (Maybe (CertificateChain, PrivKey))
getInnerCredential)

getInnerCredentialNamed :: String -> [SafeContents] -> SamePassword (Maybe (X509.CertificateChain, X509.PrivKey))
getInnerCredentialNamed :: String
-> [SafeContents]
-> SamePassword (Maybe (CertificateChain, PrivKey))
getInnerCredentialNamed String
name [SafeContents]
l = OptProtected (Maybe (CertificateChain, PrivKey))
-> SamePassword (Maybe (CertificateChain, PrivKey))
forall a. OptProtected a -> SamePassword a
SamePassword ([KeyPair] -> Maybe (CertificateChain, PrivKey)
fn ([KeyPair] -> Maybe (CertificateChain, PrivKey))
-> OptProtected [KeyPair]
-> OptProtected (Maybe (CertificateChain, PrivKey))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SafeContents] -> OptProtected [KeyPair]
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 (String -> SafeContents -> SafeContents
filterByFriendlyName String
name) [SafeContents]
l
    fn :: [KeyPair] -> Maybe (CertificateChain, PrivKey)
fn [KeyPair]
keys  = do
        k <- [KeyPair] -> Maybe KeyPair
forall a. [a] -> Maybe a
single [KeyPair]
keys
        leaf <- single (getAllSafeX509Certs filtered)
        guard (keyPairMatchesCert k leaf)
        pure (buildCertificateChain leaf certs, keyPairToPrivKey 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 :: String
-> PKCS12 -> OptProtected (Maybe (CertificateChain, PrivKey))
toNamedCredential String
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 a b.
SamePassword a -> (a -> SamePassword b) -> SamePassword b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String
-> [SafeContents]
-> SamePassword (Maybe (CertificateChain, PrivKey))
getInnerCredentialNamed String
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
               -> ProtectionPassword
               -> (X509.CertificateChain, X509.PrivKey)
               -> Either StoreError PKCS12
fromCredential :: Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential = ([Attribute] -> [Attribute])
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential' [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
                    -> ProtectionPassword
                    -> (X509.CertificateChain, X509.PrivKey)
                    -> Either StoreError PKCS12
fromNamedCredential :: String
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromNamedCredential String
name = ([Attribute] -> [Attribute])
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential' (String -> [Attribute] -> [Attribute]
setFriendlyName String
name)

fromCredential' :: ([Attribute] -> [Attribute])
                -> Maybe EncryptionScheme -- for certificates
                -> EncryptionScheme       -- for private key
                -> ProtectionPassword
                -> (X509.CertificateChain, X509.PrivKey)
                -> Either StoreError PKCS12
fromCredential' :: ([Attribute] -> [Attribute])
-> Maybe EncryptionScheme
-> EncryptionScheme
-> ProtectionPassword
-> (CertificateChain, PrivKey)
-> Either StoreError PKCS12
fromCredential' [Attribute] -> [Attribute]
_ Maybe EncryptionScheme
_ EncryptionScheme
_ ProtectionPassword
_ (X509.CertificateChain [], PrivKey
_) =
    StoreError -> Either StoreError PKCS12
forall a b. a -> Either a b
Left (String -> StoreError
InvalidInput String
"Empty certificate chain")
fromCredential' [Attribute] -> [Attribute]
trans Maybe EncryptionScheme
algChain EncryptionScheme
algKey ProtectionPassword
pwd (X509.CertificateChain certs :: [SignedCertificate]
certs@(SignedCertificate
leaf:[SignedCertificate]
_), PrivKey
key) =
    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 a b.
Either StoreError (a -> b)
-> Either StoreError a -> Either StoreError b
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
-> ProtectionPassword -> SafeContents -> Either StoreError PKCS12
encrypted EncryptionScheme
alg ProtectionPassword
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
        | KeyPair -> SignedCertificate -> Bool
keyPairMatchesCert KeyPair
pair SignedCertificate
leaf =
            PKCS5 -> SafeContents
wrap (PKCS5 -> SafeContents)
-> Either StoreError PKCS5 -> Either StoreError SafeContents
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncryptionScheme
-> ProtectionPassword -> ByteString -> Either StoreError PKCS5
encrypt EncryptionScheme
algKey ProtectionPassword
pwd ByteString
encodedKey
        | Bool
otherwise = StoreError -> Either StoreError SafeContents
forall a b. a -> Either a b
Left StoreError
PublicPrivateKeyMismatch

    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 KeyPair -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object (PrivateKeyFormat -> KeyPair -> FormattedKey KeyPair
forall a. PrivateKeyFormat -> a -> FormattedKey a
FormattedKey PrivateKeyFormat
PKCS8Format KeyPair
pair)
    pair :: KeyPair
pair          = PrivKey -> KeyPair
keyPairFromPrivKey PrivKey
key

    X509.Fingerprint ByteString
keyId = SignedCertificate -> HashALG -> Fingerprint
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> HashALG -> Fingerprint
X509.getFingerprint SignedCertificate
leaf 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 String
getFriendlyName [Attribute]
attrs = OID -> [Attribute] -> ParseASN1 () String -> Maybe String
forall a. OID -> [Attribute] -> ParseASN1 () a -> Maybe a
runParseAttribute OID
friendlyName [Attribute]
attrs (ParseASN1 () String -> Maybe String)
-> ParseASN1 () String -> Maybe String
forall a b. (a -> b) -> a -> b
$ do
    ASN1String str <- ParseASN1 () ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    case asn1CharacterToString str of
        Maybe String
Nothing -> String -> ParseASN1 () String
forall e a. String -> ParseASN1 e a
throwParseError String
"Invalid friendlyName value"
        Just String
s  -> String -> ParseASN1 () String
forall a. a -> ParseASN1 () a
forall (m :: * -> *) a. Monad m => a -> m a
return String
s

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

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

-- | 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 d <- ParseASN1 () ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    return 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 { forall a. SamePassword a -> OptProtected a
unSamePassword :: OptProtected a }

instance Functor SamePassword where
    fmap :: forall a b. (a -> b) -> SamePassword a -> SamePassword b
fmap a -> b
f (SamePassword OptProtected a
opt) = OptProtected b -> SamePassword b
forall a. OptProtected a -> SamePassword a
SamePassword ((a -> b) -> OptProtected a -> OptProtected b
forall a b. (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 :: forall a. 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) <*> :: forall a b.
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 ProtectionPassword -> 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
$ (ProtectionPassword -> Either StoreError b) -> OptProtected b
forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected ((a -> b) -> Either StoreError a -> Either StoreError b
forall a b. (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)
-> (ProtectionPassword -> Either StoreError a)
-> ProtectionPassword
-> Either StoreError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtectionPassword -> Either StoreError a
x)

    SamePassword (Protected ProtectionPassword -> Either StoreError (a -> b)
f) <*> SamePassword (Unprotected a
x) =
        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
$ (ProtectionPassword -> Either StoreError b) -> OptProtected b
forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected (((a -> b) -> b)
-> Either StoreError (a -> b) -> Either StoreError b
forall a b. (a -> b) -> Either StoreError a -> 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)
-> (ProtectionPassword -> Either StoreError (a -> b))
-> ProtectionPassword
-> Either StoreError b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProtectionPassword -> Either StoreError (a -> b)
f)

    SamePassword (Protected ProtectionPassword -> Either StoreError (a -> b)
f) <*> SamePassword (Protected ProtectionPassword -> Either StoreError a
x) =
        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
$ (ProtectionPassword -> Either StoreError b) -> OptProtected b
forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected (\ProtectionPassword
pwd -> ProtectionPassword -> Either StoreError (a -> b)
f ProtectionPassword
pwd Either StoreError (a -> b)
-> Either StoreError a -> Either StoreError b
forall a b.
Either StoreError (a -> b)
-> Either StoreError a -> Either StoreError b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ProtectionPassword -> Either StoreError a
x ProtectionPassword
pwd)

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

    SamePassword (Unprotected a
x)   >>= :: forall a b.
SamePassword a -> (a -> SamePassword b) -> SamePassword b
>>= a -> SamePassword b
f = a -> SamePassword b
f a
x
    SamePassword (Protected ProtectionPassword -> Either StoreError a
inner) >>= a -> SamePassword b
f =
        OptProtected b -> SamePassword b
forall a. OptProtected a -> SamePassword a
SamePassword (OptProtected b -> SamePassword b)
-> ((ProtectionPassword -> Either StoreError b) -> OptProtected b)
-> (ProtectionPassword -> Either StoreError b)
-> SamePassword b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ProtectionPassword -> Either StoreError b) -> OptProtected b
forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected ((ProtectionPassword -> Either StoreError b) -> SamePassword b)
-> (ProtectionPassword -> Either StoreError b) -> SamePassword b
forall a b. (a -> b) -> a -> b
$ \ProtectionPassword
pwd ->
            case ProtectionPassword -> Either StoreError a
inner ProtectionPassword
pwd of
                Left StoreError
err -> StoreError -> Either StoreError b
forall a b. a -> Either a b
Left StoreError
err
                Right a
x  -> ProtectionPassword -> OptProtected b -> Either StoreError b
forall a.
ProtectionPassword -> OptProtected a -> Either StoreError a
recover ProtectionPassword
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 :: forall a. [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)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse OptProtected a -> SamePassword a
forall a. OptProtected a -> SamePassword a
SamePassword

single :: [a] -> Maybe a
single :: forall a. [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
    { forall a. Id a -> a
unId    :: a
    , forall a. Id a -> Maybe ByteString
idKeyId :: Maybe BS.ByteString
    , forall a. Id a -> Maybe String
idName  :: Maybe String
    }

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

decode :: ParseASN1Object [ASN1Event] obj => BS.ByteString -> Either StoreError obj
decode :: forall obj.
ParseASN1Object [ASN1Event] obj =>
ByteString -> Either StoreError obj
decode = 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 :: forall e obj.
(Monoid e, ParseASN1Object [ASN1Event] obj) =>
String -> ParseASN1 e obj
parseOctetStringObject String
name = do
    bs <- ParseASN1 e ByteString
forall e. Monoid e => ParseASN1 e ByteString
parseOctetString
    case decode bs of
        Left StoreError
e  -> String -> ParseASN1 e obj
forall e a. String -> ParseASN1 e a
throwParseError (String
name String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ StoreError -> String
forall a. Show a => a -> String
show StoreError
e)
        Right obj
c -> obj -> ParseASN1 e obj
forall a. a -> ParseASN1 e a
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)