-- |
-- Module      : Crypto.Store.PKCS8
-- License     : BSD-style
-- Maintainer  : Olivier Chéron <olivier.cheron@gmail.com>
-- Stability   : experimental
-- Portability : unknown
--
-- Private-Key Information Syntax, aka PKCS #8.
--
-- Presents an API similar to "Data.X509.Memory" and "Data.X509.File" but
-- allows to write private keys and provides support for password-based
-- encryption.  Private keys are now stored along with the corresponding
-- public key in a type 'KeyPair'.  Components of type 'X509.PrivKey' and
--  'X509.PubKey' can be obtained through functions 'keyPairToPrivKey' and
-- 'keyPairToPubKey'.  Function 'keyPairFromPrivKey' can be called to build a
-- 'KeyPair'.
--
-- Functions to read a private key return an object wrapped in the
-- 'OptProtected' data type.
--
-- Functions related to public keys, certificates and CRLs are available from
-- "Crypto.Store.X509".
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE UndecidableInstances #-}
module Crypto.Store.PKCS8
    ( readKeyFile
    , readKeyFileFromMemory
    , pemToKey
    , pemToKeyAccum
    , writeKeyFile
    , writeKeyFileToMemory
    , keyToPEM
    , writeEncryptedKeyFile
    , writeEncryptedKeyFileToMemory
    , encryptKeyToPEM
    -- * Key pairs
    , KeyPair
    , keyPairFromPrivKey
    , keyPairToPrivKey
    , keyPairToPubKey
    -- * Serialization formats
    , PrivateKeyFormat(..)
    , FormattedKey(..)
    -- * Password-based protection
    , ProtectionPassword
    , emptyNotTerminated
    , fromProtectionPassword
    , toProtectionPassword
    , passwordToString
    , OptProtected(..)
    , recover
    , recoverA
    -- * Reading and writing PEM files
    , readPEMs
    , writePEMs
    ) where

import Control.Applicative
import Control.Monad (void, when)

import Data.ASN1.Types
import Data.ASN1.BinaryEncoding
import Data.ASN1.BitArray
import Data.ASN1.Encoding
import Data.ASN1.Prim
import Data.Bifunctor (first)
import Data.ByteArray (ByteArrayAccess, convert)
import Data.Either (rights)
import Data.Maybe
import qualified Data.X509 as X509
import qualified Data.ByteString as B
import           Crypto.Error
import           Crypto.Number.Serialize (i2osp, i2ospOf_, os2ip)
import qualified Crypto.PubKey.Curve25519 as X25519
import qualified Crypto.PubKey.Curve448 as X448
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.Ed25519 as Ed25519
import qualified Crypto.PubKey.Ed448 as Ed448
import qualified Crypto.PubKey.RSA.Types as RSA

import Crypto.Store.ASN1.Generate
import Crypto.Store.ASN1.Parse
import Crypto.Store.CMS.Attribute
import Crypto.Store.CMS.Util
import Crypto.Store.Error
import Crypto.Store.Keys
import Crypto.Store.PEM
import Crypto.Store.PKCS5
import Crypto.Store.PKCS8.EC
import Crypto.Store.Util

-- | Data type for objects that are possibly protected with a password.
data OptProtected a = Unprotected a
                      -- ^ Value is unprotected
                    | Protected (ProtectionPassword -> Either StoreError a)
                      -- ^ Value is protected with a password

instance Functor OptProtected where
    fmap :: forall a b. (a -> b) -> OptProtected a -> OptProtected b
fmap a -> b
f (Unprotected a
x) = b -> OptProtected b
forall a. a -> OptProtected a
Unprotected (a -> b
f a
x)
    fmap a -> b
f (Protected ProtectionPassword -> Either StoreError a
g)   = (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
g)

-- | Try to recover an 'OptProtected' content using the specified password.
recover :: ProtectionPassword -> OptProtected a -> Either StoreError a
recover :: forall a.
ProtectionPassword -> OptProtected a -> Either StoreError a
recover ProtectionPassword
_   (Unprotected a
x) = a -> Either StoreError a
forall a b. b -> Either a b
Right a
x
recover ProtectionPassword
pwd (Protected ProtectionPassword -> Either StoreError a
f)   = ProtectionPassword -> Either StoreError a
f ProtectionPassword
pwd

-- | Try to recover an 'OptProtected' content in an applicative context.  The
-- applicative password is used if necessary.
--
-- > import qualified Data.ByteString as B
-- > import           Crypto.Store.PKCS8
-- >
-- > [encryptedKey] <- readKeyFile "privkey.pem"
-- > let askForPassword = putStr "Please enter password: " >> B.getLine
-- > result <- recoverA (toProtectionPassword <$> askForPassword) encryptedKey
-- > case result of
-- >     Left err  -> putStrLn $ "Unable to recover key: " ++ show err
-- >     Right key -> print key
recoverA :: Applicative f
         => f ProtectionPassword
         -> OptProtected a
         -> f (Either StoreError a)
recoverA :: forall (f :: * -> *) a.
Applicative f =>
f ProtectionPassword -> OptProtected a -> f (Either StoreError a)
recoverA f ProtectionPassword
_   (Unprotected a
x) = Either StoreError a -> f (Either StoreError a)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either StoreError a
forall a b. b -> Either a b
Right a
x)
recoverA f ProtectionPassword
get (Protected ProtectionPassword -> Either StoreError a
f)   = (ProtectionPassword -> Either StoreError a)
-> f ProtectionPassword -> f (Either StoreError a)
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ProtectionPassword -> Either StoreError a
f f ProtectionPassword
get


-- Reading from PEM format

-- | Read private keys from a PEM file.
readKeyFile :: FilePath -> IO [OptProtected KeyPair]
readKeyFile :: FilePath -> IO [OptProtected KeyPair]
readKeyFile FilePath
path = [PEM] -> [OptProtected KeyPair]
accumulate ([PEM] -> [OptProtected KeyPair])
-> IO [PEM] -> IO [OptProtected KeyPair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [PEM]
readPEMs FilePath
path

-- | Read private keys from a bytearray in PEM format.
readKeyFileFromMemory :: B.ByteString -> [OptProtected KeyPair]
readKeyFileFromMemory :: ByteString -> [OptProtected KeyPair]
readKeyFileFromMemory = (FilePath -> [OptProtected KeyPair])
-> ([PEM] -> [OptProtected KeyPair])
-> Either FilePath [PEM]
-> [OptProtected KeyPair]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([OptProtected KeyPair] -> FilePath -> [OptProtected KeyPair]
forall a b. a -> b -> a
const []) [PEM] -> [OptProtected KeyPair]
accumulate (Either FilePath [PEM] -> [OptProtected KeyPair])
-> (ByteString -> Either FilePath [PEM])
-> ByteString
-> [OptProtected KeyPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either FilePath [PEM]
pemParseBS

accumulate :: [PEM] -> [OptProtected KeyPair]
accumulate :: [PEM] -> [OptProtected KeyPair]
accumulate = [Either StoreError (OptProtected KeyPair)]
-> [OptProtected KeyPair]
forall a b. [Either a b] -> [b]
rights ([Either StoreError (OptProtected KeyPair)]
 -> [OptProtected KeyPair])
-> ([PEM] -> [Either StoreError (OptProtected KeyPair)])
-> [PEM]
-> [OptProtected KeyPair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PEM -> Either StoreError (OptProtected KeyPair))
-> [PEM] -> [Either StoreError (OptProtected KeyPair)]
forall a b. (a -> b) -> [a] -> [b]
map PEM -> Either StoreError (OptProtected KeyPair)
pemToKey

-- | Read a private key from a t'PEM' element and add it to the accumulator
-- list.
--
-- This API is modelled after the original @pemToKey@ in "Data.X509.Memory".
pemToKeyAccum :: [Maybe (OptProtected KeyPair)] -> PEM -> [Maybe (OptProtected KeyPair)]
pemToKeyAccum :: [Maybe (OptProtected KeyPair)]
-> PEM -> [Maybe (OptProtected KeyPair)]
pemToKeyAccum [Maybe (OptProtected KeyPair)]
acc PEM
pem =
    case PEM -> Either StoreError (OptProtected KeyPair)
pemToKey PEM
pem of
        Left (DecodingError ASN1Error
_) -> [Maybe (OptProtected KeyPair)]
acc
        Left StoreError
_                 -> Maybe (OptProtected KeyPair)
forall a. Maybe a
Nothing Maybe (OptProtected KeyPair)
-> [Maybe (OptProtected KeyPair)] -> [Maybe (OptProtected KeyPair)]
forall a. a -> [a] -> [a]
: [Maybe (OptProtected KeyPair)]
acc
        Right OptProtected KeyPair
key              -> OptProtected KeyPair -> Maybe (OptProtected KeyPair)
forall a. a -> Maybe a
Just OptProtected KeyPair
key Maybe (OptProtected KeyPair)
-> [Maybe (OptProtected KeyPair)] -> [Maybe (OptProtected KeyPair)]
forall a. a -> [a] -> [a]
: [Maybe (OptProtected KeyPair)]
acc

-- | Read a private key from a t'PEM' element.
pemToKey :: PEM -> Either StoreError (OptProtected KeyPair)
pemToKey :: PEM -> Either StoreError (OptProtected KeyPair)
pemToKey PEM
pem = do
    asn1 <- (ASN1Error -> StoreError)
-> Either ASN1Error [ASN1] -> Either StoreError [ASN1]
forall a b c. (a -> b) -> Either a c -> Either b c
mapLeft ASN1Error -> StoreError
DecodingError (Either ASN1Error [ASN1] -> Either StoreError [ASN1])
-> Either ASN1Error [ASN1] -> Either StoreError [ASN1]
forall a b. (a -> b) -> a -> b
$ BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER (PEM -> ByteString
pemContent PEM
pem)
    parser <- getParser (pemName pem)
    mapLeft ParseFailure $ runParseASN1 parser asn1

  where
    allTypes :: ParseASN1 () KeyPair
allTypes  = FormattedKey KeyPair -> KeyPair
forall a. FormattedKey a -> a
unFormat (FormattedKey KeyPair -> KeyPair)
-> ParseASN1 () (FormattedKey KeyPair) -> ParseASN1 () KeyPair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () (FormattedKey KeyPair)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    rsa :: ParseASN1 () KeyPair
rsa       = (PrivateKey -> KeyPair) -> ParseASN1 () KeyPair
forall e a.
ParseASN1Object e (Modern a) =>
(a -> KeyPair) -> ParseASN1 e KeyPair
parseFormattedKeyPair (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (PrivateKey -> PrivKey) -> PrivateKey -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PrivKey
X509.PrivKeyRSA)
    dsa :: ParseASN1 () KeyPair
dsa       = (KeyPair -> KeyPair) -> ParseASN1 () KeyPair
forall e a.
ParseASN1Object e (Modern a) =>
(a -> KeyPair) -> ParseASN1 e KeyPair
parseFormattedKeyPair KeyPair -> KeyPair
KeyPairDSA
    ecdsa :: ParseASN1 () KeyPair
ecdsa     = (PrivKeyEC -> KeyPair) -> ParseASN1 () KeyPair
forall e a.
ParseASN1Object e (Modern a) =>
(a -> KeyPair) -> ParseASN1 e KeyPair
parseFormattedKeyPair (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (PrivKeyEC -> PrivKey) -> PrivKeyEC -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivKeyEC -> PrivKey
X509.PrivKeyEC)
    x25519 :: ParseASN1 () KeyPair
x25519    = (SecretKey -> KeyPair) -> ParseASN1 () KeyPair
forall e a.
ParseASN1Object e (Modern a) =>
(a -> KeyPair) -> ParseASN1 e KeyPair
parseModernKeyPair (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (SecretKey -> PrivKey) -> SecretKey -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PrivKey
X509.PrivKeyX25519)
    x448 :: ParseASN1 () KeyPair
x448      = (SecretKey -> KeyPair) -> ParseASN1 () KeyPair
forall e a.
ParseASN1Object e (Modern a) =>
(a -> KeyPair) -> ParseASN1 e KeyPair
parseModernKeyPair (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (SecretKey -> PrivKey) -> SecretKey -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PrivKey
X509.PrivKeyX448)
    ed25519 :: ParseASN1 () KeyPair
ed25519   = (SecretKey -> KeyPair) -> ParseASN1 () KeyPair
forall e a.
ParseASN1Object e (Modern a) =>
(a -> KeyPair) -> ParseASN1 e KeyPair
parseModernKeyPair (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (SecretKey -> PrivKey) -> SecretKey -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PrivKey
X509.PrivKeyEd25519)
    ed448 :: ParseASN1 () KeyPair
ed448     = (SecretKey -> KeyPair) -> ParseASN1 () KeyPair
forall e a.
ParseASN1Object e (Modern a) =>
(a -> KeyPair) -> ParseASN1 e KeyPair
parseModernKeyPair (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (SecretKey -> PrivKey) -> SecretKey -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PrivKey
X509.PrivKeyEd448)
    encrypted :: ParseASN1 () (ProtectionPassword -> Either StoreError KeyPair)
encrypted = (ProtectionPassword -> Either StoreError ByteString)
-> ProtectionPassword -> Either StoreError KeyPair
forall {t}.
(t -> Either StoreError ByteString)
-> t -> Either StoreError KeyPair
inner ((ProtectionPassword -> Either StoreError ByteString)
 -> ProtectionPassword -> Either StoreError KeyPair)
-> (PKCS5 -> ProtectionPassword -> Either StoreError ByteString)
-> PKCS5
-> ProtectionPassword
-> Either StoreError KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PKCS5 -> ProtectionPassword -> Either StoreError ByteString
decrypt (PKCS5 -> ProtectionPassword -> Either StoreError KeyPair)
-> ParseASN1 () PKCS5
-> ParseASN1 () (ProtectionPassword -> Either StoreError KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () PKCS5
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse

    getParser :: FilePath -> Either StoreError (ParseASN1 () (OptProtected KeyPair))
getParser FilePath
"PRIVATE KEY"           = ParseASN1 () (OptProtected KeyPair)
-> Either StoreError (ParseASN1 () (OptProtected KeyPair))
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> OptProtected KeyPair
forall a. a -> OptProtected a
Unprotected (KeyPair -> OptProtected KeyPair)
-> ParseASN1 () KeyPair -> ParseASN1 () (OptProtected KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () KeyPair
allTypes)
    getParser FilePath
"RSA PRIVATE KEY"       = ParseASN1 () (OptProtected KeyPair)
-> Either StoreError (ParseASN1 () (OptProtected KeyPair))
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> OptProtected KeyPair
forall a. a -> OptProtected a
Unprotected (KeyPair -> OptProtected KeyPair)
-> ParseASN1 () KeyPair -> ParseASN1 () (OptProtected KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () KeyPair
rsa)
    getParser FilePath
"DSA PRIVATE KEY"       = ParseASN1 () (OptProtected KeyPair)
-> Either StoreError (ParseASN1 () (OptProtected KeyPair))
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> OptProtected KeyPair
forall a. a -> OptProtected a
Unprotected (KeyPair -> OptProtected KeyPair)
-> ParseASN1 () KeyPair -> ParseASN1 () (OptProtected KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () KeyPair
dsa)
    getParser FilePath
"EC PRIVATE KEY"        = ParseASN1 () (OptProtected KeyPair)
-> Either StoreError (ParseASN1 () (OptProtected KeyPair))
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> OptProtected KeyPair
forall a. a -> OptProtected a
Unprotected (KeyPair -> OptProtected KeyPair)
-> ParseASN1 () KeyPair -> ParseASN1 () (OptProtected KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () KeyPair
ecdsa)
    getParser FilePath
"X25519 PRIVATE KEY"    = ParseASN1 () (OptProtected KeyPair)
-> Either StoreError (ParseASN1 () (OptProtected KeyPair))
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> OptProtected KeyPair
forall a. a -> OptProtected a
Unprotected (KeyPair -> OptProtected KeyPair)
-> ParseASN1 () KeyPair -> ParseASN1 () (OptProtected KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () KeyPair
x25519)
    getParser FilePath
"X448 PRIVATE KEY"      = ParseASN1 () (OptProtected KeyPair)
-> Either StoreError (ParseASN1 () (OptProtected KeyPair))
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> OptProtected KeyPair
forall a. a -> OptProtected a
Unprotected (KeyPair -> OptProtected KeyPair)
-> ParseASN1 () KeyPair -> ParseASN1 () (OptProtected KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () KeyPair
x448)
    getParser FilePath
"ED25519 PRIVATE KEY"   = ParseASN1 () (OptProtected KeyPair)
-> Either StoreError (ParseASN1 () (OptProtected KeyPair))
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> OptProtected KeyPair
forall a. a -> OptProtected a
Unprotected (KeyPair -> OptProtected KeyPair)
-> ParseASN1 () KeyPair -> ParseASN1 () (OptProtected KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () KeyPair
ed25519)
    getParser FilePath
"ED448 PRIVATE KEY"     = ParseASN1 () (OptProtected KeyPair)
-> Either StoreError (ParseASN1 () (OptProtected KeyPair))
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return (KeyPair -> OptProtected KeyPair
forall a. a -> OptProtected a
Unprotected (KeyPair -> OptProtected KeyPair)
-> ParseASN1 () KeyPair -> ParseASN1 () (OptProtected KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () KeyPair
ed448)
    getParser FilePath
"ENCRYPTED PRIVATE KEY" = ParseASN1 () (OptProtected KeyPair)
-> Either StoreError (ParseASN1 () (OptProtected KeyPair))
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return ((ProtectionPassword -> Either StoreError KeyPair)
-> OptProtected KeyPair
forall a.
(ProtectionPassword -> Either StoreError a) -> OptProtected a
Protected   ((ProtectionPassword -> Either StoreError KeyPair)
 -> OptProtected KeyPair)
-> ParseASN1 () (ProtectionPassword -> Either StoreError KeyPair)
-> ParseASN1 () (OptProtected KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 () (ProtectionPassword -> Either StoreError KeyPair)
encrypted)
    getParser FilePath
_                       = StoreError
-> Either StoreError (ParseASN1 () (OptProtected KeyPair))
forall a b. a -> Either a b
Left StoreError
UnexpectedNameForPEM

    inner :: (t -> Either StoreError ByteString)
-> t -> Either StoreError KeyPair
inner t -> Either StoreError ByteString
decfn t
pwd = do
        decrypted <- t -> Either StoreError ByteString
decfn t
pwd
        asn1 <- mapLeft DecodingError $ decodeASN1' BER decrypted
        case runParseASN1 allTypes asn1 of
            Left FilePath
_   -> StoreError -> Either StoreError KeyPair
forall a b. a -> Either a b
Left (FilePath -> StoreError
ParseFailure FilePath
"No key parsed after decryption")
            Right KeyPair
k  -> KeyPair -> Either StoreError KeyPair
forall a. a -> Either StoreError a
forall (m :: * -> *) a. Monad m => a -> m a
return KeyPair
k


-- Writing to PEM format

-- | Write unencrypted private keys to a PEM file.
writeKeyFile :: PrivateKeyFormat -> FilePath -> [KeyPair] -> IO ()
writeKeyFile :: PrivateKeyFormat -> FilePath -> [KeyPair] -> IO ()
writeKeyFile PrivateKeyFormat
fmt FilePath
path = FilePath -> [PEM] -> IO ()
writePEMs FilePath
path ([PEM] -> IO ()) -> ([KeyPair] -> [PEM]) -> [KeyPair] -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyPair -> PEM) -> [KeyPair] -> [PEM]
forall a b. (a -> b) -> [a] -> [b]
map (PrivateKeyFormat -> KeyPair -> PEM
keyToPEM PrivateKeyFormat
fmt)

-- | Write unencrypted private keys to a bytearray in PEM format.
writeKeyFileToMemory :: PrivateKeyFormat -> [KeyPair] -> B.ByteString
writeKeyFileToMemory :: PrivateKeyFormat -> [KeyPair] -> ByteString
writeKeyFileToMemory PrivateKeyFormat
fmt = [PEM] -> ByteString
pemsWriteBS ([PEM] -> ByteString)
-> ([KeyPair] -> [PEM]) -> [KeyPair] -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyPair -> PEM) -> [KeyPair] -> [PEM]
forall a b. (a -> b) -> [a] -> [b]
map (PrivateKeyFormat -> KeyPair -> PEM
keyToPEM PrivateKeyFormat
fmt)

-- | Write a PKCS #8 encrypted private key to a PEM file.
--
-- If multiple keys need to be stored in the same file, use functions
-- 'encryptKeyToPEM' and 'writePEMs'.
--
-- Fresh 'EncryptionScheme' parameters should be generated for each key to
-- encrypt.
writeEncryptedKeyFile :: FilePath
                      -> EncryptionScheme -> ProtectionPassword -> KeyPair
                      -> IO (Either StoreError ())
writeEncryptedKeyFile :: FilePath
-> EncryptionScheme
-> ProtectionPassword
-> KeyPair
-> IO (Either StoreError ())
writeEncryptedKeyFile FilePath
path EncryptionScheme
alg ProtectionPassword
pwd KeyPair
keyPair =
    let pem :: Either StoreError PEM
pem = EncryptionScheme
-> ProtectionPassword -> KeyPair -> Either StoreError PEM
encryptKeyToPEM EncryptionScheme
alg ProtectionPassword
pwd KeyPair
keyPair
     in (StoreError -> IO (Either StoreError ()))
-> (PEM -> IO (Either StoreError ()))
-> Either StoreError PEM
-> IO (Either StoreError ())
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either StoreError () -> IO (Either StoreError ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either StoreError () -> IO (Either StoreError ()))
-> (StoreError -> Either StoreError ())
-> StoreError
-> IO (Either StoreError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StoreError -> Either StoreError ()
forall a b. a -> Either a b
Left) ((() -> Either StoreError ()) -> IO () -> IO (Either StoreError ())
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap () -> Either StoreError ()
forall a b. b -> Either a b
Right (IO () -> IO (Either StoreError ()))
-> (PEM -> IO ()) -> PEM -> IO (Either StoreError ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [PEM] -> IO ()
writePEMs FilePath
path ([PEM] -> IO ()) -> (PEM -> [PEM]) -> PEM -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PEM -> [PEM] -> [PEM]
forall a. a -> [a] -> [a]
:[])) Either StoreError PEM
pem

-- | Write a PKCS #8 encrypted private key to a bytearray in PEM format.
--
-- If multiple keys need to be stored in the same bytearray, use functions
-- 'encryptKeyToPEM' and 'pemWriteBS' or 'pemWriteLBS'.
--
-- Fresh 'EncryptionScheme' parameters should be generated for each key to
-- encrypt.
writeEncryptedKeyFileToMemory :: EncryptionScheme -> ProtectionPassword
                              -> KeyPair -> Either StoreError B.ByteString
writeEncryptedKeyFileToMemory :: EncryptionScheme
-> ProtectionPassword -> KeyPair -> Either StoreError ByteString
writeEncryptedKeyFileToMemory EncryptionScheme
alg ProtectionPassword
pwd KeyPair
keyPair =
    PEM -> ByteString
pemWriteBS (PEM -> ByteString)
-> Either StoreError PEM -> Either StoreError ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> EncryptionScheme
-> ProtectionPassword -> KeyPair -> Either StoreError PEM
encryptKeyToPEM EncryptionScheme
alg ProtectionPassword
pwd KeyPair
keyPair

-- | Generate an unencrypted PEM for a private key.
keyToPEM :: PrivateKeyFormat -> KeyPair -> PEM
keyToPEM :: PrivateKeyFormat -> KeyPair -> PEM
keyToPEM PrivateKeyFormat
TraditionalFormat = KeyPair -> PEM
keyToTraditionalPEM
keyToPEM PrivateKeyFormat
PKCS8Format       = KeyPair -> PEM
keyToModernPEM

keyToTraditionalPEM :: KeyPair -> PEM
keyToTraditionalPEM :: KeyPair -> PEM
keyToTraditionalPEM KeyPair
keyPair =
    FilePath -> ByteString -> PEM
mkPEM (FilePath
typeTag FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" PRIVATE KEY") (ASN1PS -> ByteString
encodeASN1S ASN1PS
asn1)
  where (FilePath
typeTag, ASN1PS
asn1) = KeyPair -> (FilePath, ASN1PS)
forall e. ASN1Elem e => KeyPair -> (FilePath, ASN1Stream e)
traditionalPrivKeyASN1S KeyPair
keyPair

traditionalPrivKeyASN1S :: ASN1Elem e => KeyPair -> (String, ASN1Stream e)
traditionalPrivKeyASN1S :: forall e. ASN1Elem e => KeyPair -> (FilePath, ASN1Stream e)
traditionalPrivKeyASN1S KeyPair
keyPair =
    case KeyPair
keyPair of
        KeyPairRSA PrivateKey
k PublicKey
_ -> (FilePath
"RSA", PrivateKey -> ASN1Stream e
forall e a.
ProduceASN1Object e (Traditional a) =>
a -> ASN1Stream e
traditional PrivateKey
k)
        KeyPairDSA KeyPair
p   -> (FilePath
"DSA", KeyPair -> ASN1Stream e
forall e a.
ProduceASN1Object e (Traditional a) =>
a -> ASN1Stream e
traditional KeyPair
p)
        KeyPairEC  PrivKeyEC
k PubKeyEC
_ -> (FilePath
"EC",  PrivKeyEC -> ASN1Stream e
forall e a.
ProduceASN1Object e (Traditional a) =>
a -> ASN1Stream e
traditional PrivKeyEC
k)
        KeyPairX25519  SecretKey
k PublicKey
_ -> (FilePath
"X25519",  SecretKey -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
tradModern SecretKey
k)
        KeyPairX448    SecretKey
k PublicKey
_ -> (FilePath
"X448",    SecretKey -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
tradModern SecretKey
k)
        KeyPairEd25519 SecretKey
k PublicKey
_ -> (FilePath
"ED25519", SecretKey -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
tradModern SecretKey
k)
        KeyPairEd448   SecretKey
k PublicKey
_ -> (FilePath
"ED448",   SecretKey -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
tradModern SecretKey
k)
  where
    traditional :: ProduceASN1Object e (Traditional a) => a -> ASN1Stream e
    traditional :: forall e a.
ProduceASN1Object e (Traditional a) =>
a -> ASN1Stream e
traditional a
a = Traditional a -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s (a -> Traditional a
forall a. a -> Traditional a
Traditional a
a)

    tradModern :: ProduceASN1Object e (Modern a) => a -> ASN1Stream e
    tradModern :: forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
tradModern = (a -> PubKey) -> a -> ASN1Stream e
forall e a.
ProduceASN1Object e (Modern a) =>
(a -> PubKey) -> a -> ASN1Stream e
modernASN1S (PubKey -> a -> PubKey
forall a b. a -> b -> a
const (PubKey -> a -> PubKey) -> PubKey -> a -> PubKey
forall a b. (a -> b) -> a -> b
$ KeyPair -> PubKey
keyPairToPubKey KeyPair
keyPair)

keyToModernPEM :: KeyPair -> PEM
keyToModernPEM :: KeyPair -> PEM
keyToModernPEM KeyPair
keyPair = FilePath -> ByteString -> PEM
mkPEM FilePath
"PRIVATE KEY" (ASN1PS -> ByteString
encodeASN1S ASN1PS
asn1)
  where asn1 :: ASN1PS
asn1 = (KeyPair -> PubKey) -> KeyPair -> ASN1PS
forall e a.
ProduceASN1Object e (Modern a) =>
(a -> PubKey) -> a -> ASN1Stream e
modernASN1S KeyPair -> PubKey
keyPairToPubKey KeyPair
keyPair

modernPrivKeyASN1S :: ASN1Elem e
                   => [Attribute] -> Maybe GenericPubKey -> KeyPair -> ASN1Stream e
modernPrivKeyASN1S :: forall e.
ASN1Elem e =>
[Attribute] -> Maybe GenericPubKey -> KeyPair -> ASN1Stream e
modernPrivKeyASN1S [Attribute]
attrs Maybe GenericPubKey
mPub KeyPair
keyPair =
    case KeyPair
keyPair of
        KeyPairRSA PrivateKey
k PublicKey
_ -> PrivateKey -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
modern PrivateKey
k
        KeyPairDSA KeyPair
p   -> KeyPair -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
modern KeyPair
p
        KeyPairEC  PrivKeyEC
k PubKeyEC
_ -> PrivKeyEC -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
modern PrivKeyEC
k
        KeyPairX25519  SecretKey
k PublicKey
_ -> SecretKey -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
modern SecretKey
k
        KeyPairX448    SecretKey
k PublicKey
_ -> SecretKey -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
modern SecretKey
k
        KeyPairEd25519 SecretKey
k PublicKey
_ -> SecretKey -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
modern SecretKey
k
        KeyPairEd448   SecretKey
k PublicKey
_ -> SecretKey -> ASN1Stream e
forall e a. ProduceASN1Object e (Modern a) => a -> ASN1Stream e
modern SecretKey
k
  where
    modern :: a -> ASN1Stream e
modern a
a = Modern a -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s ([Attribute] -> Maybe GenericPubKey -> a -> Modern a
forall a. [Attribute] -> Maybe GenericPubKey -> a -> Modern a
Modern [Attribute]
attrs Maybe GenericPubKey
mPub a
a)

-- | Generate a PKCS #8 encrypted PEM for a private key.
--
-- Fresh 'EncryptionScheme' parameters should be generated for each key to
-- encrypt.
encryptKeyToPEM :: EncryptionScheme -> ProtectionPassword -> KeyPair
                -> Either StoreError PEM
encryptKeyToPEM :: EncryptionScheme
-> ProtectionPassword -> KeyPair -> Either StoreError PEM
encryptKeyToPEM EncryptionScheme
alg ProtectionPassword
pwd KeyPair
keyPair = PKCS5 -> PEM
forall {obj}. ProduceASN1Object ASN1P obj => obj -> PEM
toPEM (PKCS5 -> PEM) -> Either StoreError PKCS5 -> Either StoreError PEM
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 = PEM -> ByteString
pemContent (KeyPair -> PEM
keyToModernPEM KeyPair
keyPair)
        toPEM :: obj -> PEM
toPEM obj
pkcs8 = FilePath -> ByteString -> PEM
mkPEM FilePath
"ENCRYPTED PRIVATE KEY" (obj -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object obj
pkcs8)


-- Private key formats: traditional (SSLeay compatible) and modern (PKCS #8)

-- | Private-key serialization format.
--
-- Encryption in traditional format is not supported currently.
data PrivateKeyFormat = TraditionalFormat -- ^ SSLeay compatible
                      | PKCS8Format       -- ^ PKCS #8
                      deriving (Int -> PrivateKeyFormat -> FilePath -> FilePath
[PrivateKeyFormat] -> FilePath -> FilePath
PrivateKeyFormat -> FilePath
(Int -> PrivateKeyFormat -> FilePath -> FilePath)
-> (PrivateKeyFormat -> FilePath)
-> ([PrivateKeyFormat] -> FilePath -> FilePath)
-> Show PrivateKeyFormat
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> PrivateKeyFormat -> FilePath -> FilePath
showsPrec :: Int -> PrivateKeyFormat -> FilePath -> FilePath
$cshow :: PrivateKeyFormat -> FilePath
show :: PrivateKeyFormat -> FilePath
$cshowList :: [PrivateKeyFormat] -> FilePath -> FilePath
showList :: [PrivateKeyFormat] -> FilePath -> FilePath
Show,PrivateKeyFormat -> PrivateKeyFormat -> Bool
(PrivateKeyFormat -> PrivateKeyFormat -> Bool)
-> (PrivateKeyFormat -> PrivateKeyFormat -> Bool)
-> Eq PrivateKeyFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PrivateKeyFormat -> PrivateKeyFormat -> Bool
== :: PrivateKeyFormat -> PrivateKeyFormat -> Bool
$c/= :: PrivateKeyFormat -> PrivateKeyFormat -> Bool
/= :: PrivateKeyFormat -> PrivateKeyFormat -> Bool
Eq)

newtype Traditional a = Traditional { forall a. Traditional a -> a
unTraditional :: a }

parseTraditional :: ParseASN1Object e (Traditional a) => ParseASN1 e a
parseTraditional :: forall e a. ParseASN1Object e (Traditional a) => ParseASN1 e a
parseTraditional = Traditional a -> a
forall a. Traditional a -> a
unTraditional (Traditional a -> a)
-> ParseASN1 e (Traditional a) -> ParseASN1 e a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Traditional a)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse

data Modern a = Modern [Attribute] (Maybe GenericPubKey) a

instance Functor Modern where
    fmap :: forall a b. (a -> b) -> Modern a -> Modern b
fmap a -> b
f (Modern [Attribute]
attrs Maybe GenericPubKey
mPub a
a) = [Attribute] -> Maybe GenericPubKey -> b -> Modern b
forall a. [Attribute] -> Maybe GenericPubKey -> a -> Modern a
Modern [Attribute]
attrs Maybe GenericPubKey
mPub (a -> b
f a
a)

modernASN1S :: ProduceASN1Object e (Modern a)
            => (a -> X509.PubKey) -> a -> ASN1Stream e
modernASN1S :: forall e a.
ProduceASN1Object e (Modern a) =>
(a -> PubKey) -> a -> ASN1Stream e
modernASN1S a -> PubKey
toPubKey a
a = Modern a -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s ([Attribute] -> Maybe GenericPubKey -> a -> Modern a
forall a. [Attribute] -> Maybe GenericPubKey -> a -> Modern a
Modern [] Maybe GenericPubKey
mPub a
a)
  where
    noPubKey :: Bool
noPubKey = Bool
True  -- we never generate with publicKey but the code exists
    mPub :: Maybe GenericPubKey
mPub | Bool
noPubKey  = Maybe GenericPubKey
forall a. Maybe a
Nothing
         | Bool
otherwise = case (a -> PubKey) -> a -> Either FilePath (GenericPubKey, [ASN1])
forall a.
(a -> PubKey) -> a -> Either FilePath (GenericPubKey, [ASN1])
getGenericPubKey a -> PubKey
toPubKey a
a of
             Right (GenericPubKey
gpk, []) -> GenericPubKey -> Maybe GenericPubKey
forall a. a -> Maybe a
Just GenericPubKey
gpk
             Either FilePath (GenericPubKey, [ASN1])
_ -> Maybe GenericPubKey
forall a. Maybe a
Nothing

parseModernKeyPair :: ParseASN1Object e (Modern a)
                   => (a -> KeyPair) -> ParseASN1 e KeyPair
parseModernKeyPair :: forall e a.
ParseASN1Object e (Modern a) =>
(a -> KeyPair) -> ParseASN1 e KeyPair
parseModernKeyPair = (KeyPair -> PubKey) -> (a -> KeyPair) -> ParseASN1 e KeyPair
forall e b a.
ParseASN1Object e (Modern b) =>
(a -> PubKey) -> (b -> a) -> ParseASN1 e a
parseModern KeyPair -> PubKey
keyPairToPubKey

parseModern :: ParseASN1Object e (Modern b)
            => (a -> X509.PubKey) -> (b -> a) -> ParseASN1 e a
parseModern :: forall e b a.
ParseASN1Object e (Modern b) =>
(a -> PubKey) -> (b -> a) -> ParseASN1 e a
parseModern a -> PubKey
toPubKey b -> a
mapFn = do
    Modern _ mPub b <- ParseASN1 e (Modern b)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
    verifyPubKey toPubKey (mapFn b) mPub

verifyPubKey :: (a -> X509.PubKey) -> a -> Maybe GenericPubKey -> ParseASN1 e a
verifyPubKey :: forall a e.
(a -> PubKey) -> a -> Maybe GenericPubKey -> ParseASN1 e a
verifyPubKey a -> PubKey
_ a
a Maybe GenericPubKey
Nothing = a -> ParseASN1 e a
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
verifyPubKey a -> PubKey
toPubKey a
a (Just GenericPubKey
gpk)
    | (GenericPubKey, [ASN1]) -> Either FilePath (GenericPubKey, [ASN1])
forall a b. b -> Either a b
Right (GenericPubKey
gpk, []) Either FilePath (GenericPubKey, [ASN1])
-> Either FilePath (GenericPubKey, [ASN1]) -> Bool
forall a. Eq a => a -> a -> Bool
== Either FilePath (GenericPubKey, [ASN1])
derived = a -> ParseASN1 e a
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a
    | Bool
otherwise = FilePath -> ParseASN1 e a
forall e a. FilePath -> ParseASN1 e a
throwParseError FilePath
"PKCS8 public key does not match private key"
  where derived :: Either FilePath (GenericPubKey, [ASN1])
derived = (a -> PubKey) -> a -> Either FilePath (GenericPubKey, [ASN1])
forall a.
(a -> PubKey) -> a -> Either FilePath (GenericPubKey, [ASN1])
getGenericPubKey a -> PubKey
toPubKey a
a

getGenericPubKey :: (a -> X509.PubKey) -> a -> Either String (GenericPubKey, [ASN1])
getGenericPubKey :: forall a.
(a -> PubKey) -> a -> Either FilePath (GenericPubKey, [ASN1])
getGenericPubKey a -> PubKey
toPubKey a
a = ParseASN1 () GenericPubKey
-> [ASN1] -> Either FilePath (GenericPubKey, [ASN1])
forall a. ParseASN1 () a -> [ASN1] -> Either FilePath (a, [ASN1])
runParseASN1State ParseASN1 () GenericPubKey
forall e. Monoid e => ParseASN1 e GenericPubKey
parsePubKeyGen [ASN1]
asn1
  where asn1 :: [ASN1]
asn1 = PubKey -> ASN1S
forall a. ASN1Object a => a -> ASN1S
toASN1 (a -> PubKey
toPubKey a
a) []

parsePubKeyGen :: Monoid e => ParseASN1 e GenericPubKey
parsePubKeyGen :: forall e. Monoid e => ParseASN1 e GenericPubKey
parsePubKeyGen = ASN1ConstructionType
-> ParseASN1 e GenericPubKey -> ParseASN1 e GenericPubKey
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e GenericPubKey -> ParseASN1 e GenericPubKey)
-> ParseASN1 e GenericPubKey -> ParseASN1 e GenericPubKey
forall a b. (a -> b) -> a -> b
$ do
    ParseASN1 e [(ASN1, e)] -> ParseASN1 e ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParseASN1 e [(ASN1, e)] -> ParseASN1 e ())
-> ParseASN1 e [(ASN1, e)] -> ParseASN1 e ()
forall a b. (a -> b) -> a -> b
$ ASN1ConstructionType -> ParseASN1 e [(ASN1, e)]
forall e.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e [(ASN1, e)]
getNextContainer ASN1ConstructionType
Sequence  -- ignore algorithm,
    BitString bits <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext         -- we want the bit string only
    return (GenericPubKey $ bitArrayGetData bits)

newtype GenericPubKey = GenericPubKey B.ByteString
    deriving (Int -> GenericPubKey -> FilePath -> FilePath
[GenericPubKey] -> FilePath -> FilePath
GenericPubKey -> FilePath
(Int -> GenericPubKey -> FilePath -> FilePath)
-> (GenericPubKey -> FilePath)
-> ([GenericPubKey] -> FilePath -> FilePath)
-> Show GenericPubKey
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> GenericPubKey -> FilePath -> FilePath
showsPrec :: Int -> GenericPubKey -> FilePath -> FilePath
$cshow :: GenericPubKey -> FilePath
show :: GenericPubKey -> FilePath
$cshowList :: [GenericPubKey] -> FilePath -> FilePath
showList :: [GenericPubKey] -> FilePath -> FilePath
Show,GenericPubKey -> GenericPubKey -> Bool
(GenericPubKey -> GenericPubKey -> Bool)
-> (GenericPubKey -> GenericPubKey -> Bool) -> Eq GenericPubKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GenericPubKey -> GenericPubKey -> Bool
== :: GenericPubKey -> GenericPubKey -> Bool
$c/= :: GenericPubKey -> GenericPubKey -> Bool
/= :: GenericPubKey -> GenericPubKey -> Bool
Eq)

instance ASN1Elem e => ProduceASN1Object e (Maybe GenericPubKey) where
    asn1s :: Maybe GenericPubKey -> ASN1Stream e
asn1s Maybe GenericPubKey
Nothing = ASN1Stream e
forall a. a -> a
id
    asn1s (Just (GenericPubKey ByteString
bits)) = [ASN1] -> ASN1Stream e
forall e. ASN1Elem e => [ASN1] -> ASN1Stream e
gMany [ASN1Class -> Int -> ByteString -> ASN1
Other ASN1Class
Context Int
1 ByteString
bs]
      where bs :: ByteString
bs = BitArray -> ByteString
putBitString (ByteString -> Int -> BitArray
toBitArray ByteString
bits Int
0)

instance Monoid e => ParseASN1Object e (Maybe GenericPubKey) where
    parse :: ParseASN1 e (Maybe GenericPubKey)
parse = GenericPubKey -> Maybe GenericPubKey
forall a. a -> Maybe a
Just (GenericPubKey -> Maybe GenericPubKey)
-> (ByteString -> GenericPubKey)
-> ByteString
-> Maybe GenericPubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> GenericPubKey
GenericPubKey (ByteString -> Maybe GenericPubKey)
-> ParseASN1 e ByteString -> ParseASN1 e (Maybe GenericPubKey)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e ByteString
parseTaggedBitString ParseASN1 e (Maybe GenericPubKey)
-> ParseASN1 e (Maybe GenericPubKey)
-> ParseASN1 e (Maybe GenericPubKey)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe GenericPubKey -> ParseASN1 e (Maybe GenericPubKey)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe GenericPubKey
forall a. Maybe a
Nothing
      where
        parseTaggedBitString :: ParseASN1 e ByteString
parseTaggedBitString = do
            Other _ 1 bs <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            case getBitString bs of
                Right (BitString BitArray
bits) -> ByteString -> ParseASN1 e ByteString
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return (BitArray -> ByteString
bitArrayGetData BitArray
bits)
                Either ASN1Error ASN1
r -> FilePath -> ParseASN1 e ByteString
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath
"GenericPubKey: invalid bit string: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Either ASN1Error ASN1 -> FilePath
forall a. Show a => a -> FilePath
show Either ASN1Error ASN1
r)

-- | A key associated with format.  Allows to implement 'ASN1Object' instances.
data FormattedKey a = FormattedKey PrivateKeyFormat a
    deriving (Int -> FormattedKey a -> FilePath -> FilePath
[FormattedKey a] -> FilePath -> FilePath
FormattedKey a -> FilePath
(Int -> FormattedKey a -> FilePath -> FilePath)
-> (FormattedKey a -> FilePath)
-> ([FormattedKey a] -> FilePath -> FilePath)
-> Show (FormattedKey a)
forall a. Show a => Int -> FormattedKey a -> FilePath -> FilePath
forall a. Show a => [FormattedKey a] -> FilePath -> FilePath
forall a. Show a => FormattedKey a -> FilePath
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: forall a. Show a => Int -> FormattedKey a -> FilePath -> FilePath
showsPrec :: Int -> FormattedKey a -> FilePath -> FilePath
$cshow :: forall a. Show a => FormattedKey a -> FilePath
show :: FormattedKey a -> FilePath
$cshowList :: forall a. Show a => [FormattedKey a] -> FilePath -> FilePath
showList :: [FormattedKey a] -> FilePath -> FilePath
Show,FormattedKey a -> FormattedKey a -> Bool
(FormattedKey a -> FormattedKey a -> Bool)
-> (FormattedKey a -> FormattedKey a -> Bool)
-> Eq (FormattedKey a)
forall a. Eq a => FormattedKey a -> FormattedKey a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => FormattedKey a -> FormattedKey a -> Bool
== :: FormattedKey a -> FormattedKey a -> Bool
$c/= :: forall a. Eq a => FormattedKey a -> FormattedKey a -> Bool
/= :: FormattedKey a -> FormattedKey a -> Bool
Eq)

instance Functor FormattedKey where
    fmap :: forall a b. (a -> b) -> FormattedKey a -> FormattedKey b
fmap a -> b
f (FormattedKey PrivateKeyFormat
fmt a
a) = PrivateKeyFormat -> b -> FormattedKey b
forall a. PrivateKeyFormat -> a -> FormattedKey a
FormattedKey PrivateKeyFormat
fmt (a -> b
f a
a)

instance ASN1Elem e => ProduceASN1Object e (FormattedKey KeyPair) where
    asn1s :: FormattedKey KeyPair -> ASN1Stream e
asn1s = (KeyPair -> PubKey) -> FormattedKey KeyPair -> ASN1Stream e
forall e a.
(ProduceASN1Object e (Traditional a),
 ProduceASN1Object e (Modern a)) =>
(a -> PubKey) -> FormattedKey a -> ASN1Stream e
formattedASN1S KeyPair -> PubKey
keyPairToPubKey

instance Monoid e => ParseASN1Object e (FormattedKey KeyPair) where
    parse :: ParseASN1 e (FormattedKey KeyPair)
parse = (KeyPair -> PubKey) -> ParseASN1 e (FormattedKey KeyPair)
forall e a.
(ParseASN1Object e (Traditional a),
 ParseASN1Object e (Modern a)) =>
(a -> PubKey) -> ParseASN1 e (FormattedKey a)
parseFormatted KeyPair -> PubKey
keyPairToPubKey

formattedASN1S :: (ProduceASN1Object e (Traditional a), ProduceASN1Object e (Modern a))
               => (a -> X509.PubKey) -> FormattedKey a -> ASN1Stream e
formattedASN1S :: forall e a.
(ProduceASN1Object e (Traditional a),
 ProduceASN1Object e (Modern a)) =>
(a -> PubKey) -> FormattedKey a -> ASN1Stream e
formattedASN1S a -> PubKey
_ (FormattedKey PrivateKeyFormat
TraditionalFormat a
k) = Traditional a -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s (a -> Traditional a
forall a. a -> Traditional a
Traditional a
k)
formattedASN1S a -> PubKey
toPubKey (FormattedKey PrivateKeyFormat
PKCS8Format a
k) = (a -> PubKey) -> a -> ASN1Stream e
forall e a.
ProduceASN1Object e (Modern a) =>
(a -> PubKey) -> a -> ASN1Stream e
modernASN1S a -> PubKey
toPubKey a
k

parseFormattedKeyPair :: ParseASN1Object e (Modern a)
                      => (a -> KeyPair) -> ParseASN1 e KeyPair
parseFormattedKeyPair :: forall e a.
ParseASN1Object e (Modern a) =>
(a -> KeyPair) -> ParseASN1 e KeyPair
parseFormattedKeyPair a -> KeyPair
mapFn =
    FormattedKey KeyPair -> KeyPair
forall a. FormattedKey a -> a
unFormat (FormattedKey KeyPair -> KeyPair)
-> ParseASN1 e (FormattedKey KeyPair) -> ParseASN1 e KeyPair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (KeyPair -> PubKey)
-> (a -> KeyPair) -> ParseASN1 e (FormattedKey KeyPair)
forall e a b.
(ParseASN1Object e (Traditional a),
 ParseASN1Object e (Modern b)) =>
(a -> PubKey) -> (b -> a) -> ParseASN1 e (FormattedKey a)
parseFormattedInternal KeyPair -> PubKey
keyPairToPubKey a -> KeyPair
mapFn

parseFormatted :: (ParseASN1Object e (Traditional a), ParseASN1Object e (Modern a))
               => (a -> X509.PubKey) -> ParseASN1 e (FormattedKey a)
parseFormatted :: forall e a.
(ParseASN1Object e (Traditional a),
 ParseASN1Object e (Modern a)) =>
(a -> PubKey) -> ParseASN1 e (FormattedKey a)
parseFormatted a -> PubKey
toPubKey = (a -> PubKey) -> (a -> a) -> ParseASN1 e (FormattedKey a)
forall e a b.
(ParseASN1Object e (Traditional a),
 ParseASN1Object e (Modern b)) =>
(a -> PubKey) -> (b -> a) -> ParseASN1 e (FormattedKey a)
parseFormattedInternal a -> PubKey
toPubKey a -> a
forall a. a -> a
id

parseFormattedInternal :: (ParseASN1Object e (Traditional a), ParseASN1Object e (Modern b))
                       => (a -> X509.PubKey) -> (b -> a) -> ParseASN1 e (FormattedKey a)
parseFormattedInternal :: forall e a b.
(ParseASN1Object e (Traditional a),
 ParseASN1Object e (Modern b)) =>
(a -> PubKey) -> (b -> a) -> ParseASN1 e (FormattedKey a)
parseFormattedInternal a -> PubKey
toPubKey b -> a
mapFn =
    (a -> FormattedKey a
forall {a}. a -> FormattedKey a
modern (a -> FormattedKey a)
-> ParseASN1 e a -> ParseASN1 e (FormattedKey a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> PubKey) -> (b -> a) -> ParseASN1 e a
forall e b a.
ParseASN1Object e (Modern b) =>
(a -> PubKey) -> (b -> a) -> ParseASN1 e a
parseModern a -> PubKey
toPubKey b -> a
mapFn) ParseASN1 e (FormattedKey a)
-> ParseASN1 e (FormattedKey a) -> ParseASN1 e (FormattedKey a)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
    (a -> FormattedKey a
forall {a}. a -> FormattedKey a
traditional (a -> FormattedKey a)
-> ParseASN1 e a -> ParseASN1 e (FormattedKey a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e a
forall e a. ParseASN1Object e (Traditional a) => ParseASN1 e a
parseTraditional)
  where
    traditional :: a -> FormattedKey a
traditional = PrivateKeyFormat -> a -> FormattedKey a
forall a. PrivateKeyFormat -> a -> FormattedKey a
FormattedKey PrivateKeyFormat
TraditionalFormat
    modern :: a -> FormattedKey a
modern      = PrivateKeyFormat -> a -> FormattedKey a
forall a. PrivateKeyFormat -> a -> FormattedKey a
FormattedKey PrivateKeyFormat
PKCS8Format

unFormat :: FormattedKey a -> a
unFormat :: forall a. FormattedKey a -> a
unFormat (FormattedKey PrivateKeyFormat
_ a
a) = a
a


-- Private Keys

instance ASN1Object (FormattedKey X509.PrivKey) where
    toASN1 :: FormattedKey PrivKey -> ASN1S
toASN1 = FormattedKey KeyPair -> ASN1S
forall a. ASN1Object a => a -> ASN1S
toASN1 (FormattedKey KeyPair -> ASN1S)
-> (FormattedKey PrivKey -> FormattedKey KeyPair)
-> FormattedKey PrivKey
-> ASN1S
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PrivKey -> KeyPair)
-> FormattedKey PrivKey -> FormattedKey KeyPair
forall a b. (a -> b) -> FormattedKey a -> FormattedKey b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap PrivKey -> KeyPair
keyPairFromPrivKey
    fromASN1 :: [ASN1] -> Either FilePath (FormattedKey PrivKey, [ASN1])
fromASN1 = ((FormattedKey KeyPair, [ASN1]) -> (FormattedKey PrivKey, [ASN1]))
-> Either FilePath (FormattedKey KeyPair, [ASN1])
-> Either FilePath (FormattedKey PrivKey, [ASN1])
forall a b. (a -> b) -> Either FilePath a -> Either FilePath b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((FormattedKey KeyPair -> FormattedKey PrivKey)
-> (FormattedKey KeyPair, [ASN1]) -> (FormattedKey PrivKey, [ASN1])
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first ((KeyPair -> PrivKey)
-> FormattedKey KeyPair -> FormattedKey PrivKey
forall a b. (a -> b) -> FormattedKey a -> FormattedKey b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap KeyPair -> PrivKey
keyPairToPrivKey)) (Either FilePath (FormattedKey KeyPair, [ASN1])
 -> Either FilePath (FormattedKey PrivKey, [ASN1]))
-> ([ASN1] -> Either FilePath (FormattedKey KeyPair, [ASN1]))
-> [ASN1]
-> Either FilePath (FormattedKey PrivKey, [ASN1])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ASN1] -> Either FilePath (FormattedKey KeyPair, [ASN1])
forall a. ASN1Object a => [ASN1] -> Either FilePath (a, [ASN1])
fromASN1

instance ASN1Object (FormattedKey KeyPair) where
    toASN1 :: FormattedKey KeyPair -> ASN1S
toASN1   = FormattedKey KeyPair -> ASN1S
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s
    fromASN1 :: [ASN1] -> Either FilePath (FormattedKey KeyPair, [ASN1])
fromASN1 = ParseASN1 () (FormattedKey KeyPair)
-> [ASN1] -> Either FilePath (FormattedKey KeyPair, [ASN1])
forall a. ParseASN1 () a -> [ASN1] -> Either FilePath (a, [ASN1])
runParseASN1State ParseASN1 () (FormattedKey KeyPair)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse

instance ASN1Elem e => ProduceASN1Object e (Traditional KeyPair) where
    asn1s :: Traditional KeyPair -> ASN1Stream e
asn1s (Traditional KeyPair
keyPair) = (FilePath, ASN1Stream e) -> ASN1Stream e
forall a b. (a, b) -> b
snd ((FilePath, ASN1Stream e) -> ASN1Stream e)
-> (FilePath, ASN1Stream e) -> ASN1Stream e
forall a b. (a -> b) -> a -> b
$ KeyPair -> (FilePath, ASN1Stream e)
forall e. ASN1Elem e => KeyPair -> (FilePath, ASN1Stream e)
traditionalPrivKeyASN1S KeyPair
keyPair

instance Monoid e => ParseASN1Object e (Traditional KeyPair) where
    parse :: ParseASN1 e (Traditional KeyPair)
parse = ParseASN1 e (Traditional KeyPair)
rsa ParseASN1 e (Traditional KeyPair)
-> ParseASN1 e (Traditional KeyPair)
-> ParseASN1 e (Traditional KeyPair)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e (Traditional KeyPair)
dsa ParseASN1 e (Traditional KeyPair)
-> ParseASN1 e (Traditional KeyPair)
-> ParseASN1 e (Traditional KeyPair)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e (Traditional KeyPair)
ecdsa
      where
        rsa :: ParseASN1 e (Traditional KeyPair)
rsa   = KeyPair -> Traditional KeyPair
forall a. a -> Traditional a
Traditional (KeyPair -> Traditional KeyPair)
-> (Traditional PrivateKey -> KeyPair)
-> Traditional PrivateKey
-> Traditional KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (Traditional PrivateKey -> PrivKey)
-> Traditional PrivateKey
-> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PrivKey
X509.PrivKeyRSA (PrivateKey -> PrivKey)
-> (Traditional PrivateKey -> PrivateKey)
-> Traditional PrivateKey
-> PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traditional PrivateKey -> PrivateKey
forall a. Traditional a -> a
unTraditional (Traditional PrivateKey -> Traditional KeyPair)
-> ParseASN1 e (Traditional PrivateKey)
-> ParseASN1 e (Traditional KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Traditional PrivateKey)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        dsa :: ParseASN1 e (Traditional KeyPair)
dsa   = KeyPair -> Traditional KeyPair
forall a. a -> Traditional a
Traditional (KeyPair -> Traditional KeyPair)
-> (Traditional KeyPair -> KeyPair)
-> Traditional KeyPair
-> Traditional KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (Traditional KeyPair -> PrivKey)
-> Traditional KeyPair
-> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PrivKey
X509.PrivKeyDSA (PrivateKey -> PrivKey)
-> (Traditional KeyPair -> PrivateKey)
-> Traditional KeyPair
-> PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> PrivateKey
DSA.toPrivateKey (KeyPair -> PrivateKey)
-> (Traditional KeyPair -> KeyPair)
-> Traditional KeyPair
-> PrivateKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traditional KeyPair -> KeyPair
forall a. Traditional a -> a
unTraditional (Traditional KeyPair -> Traditional KeyPair)
-> ParseASN1 e (Traditional KeyPair)
-> ParseASN1 e (Traditional KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Traditional KeyPair)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        ecdsa :: ParseASN1 e (Traditional KeyPair)
ecdsa = KeyPair -> Traditional KeyPair
forall a. a -> Traditional a
Traditional (KeyPair -> Traditional KeyPair)
-> (Traditional PrivKeyEC -> KeyPair)
-> Traditional PrivKeyEC
-> Traditional KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (Traditional PrivKeyEC -> PrivKey)
-> Traditional PrivKeyEC
-> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivKeyEC -> PrivKey
X509.PrivKeyEC (PrivKeyEC -> PrivKey)
-> (Traditional PrivKeyEC -> PrivKeyEC)
-> Traditional PrivKeyEC
-> PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traditional PrivKeyEC -> PrivKeyEC
forall a. Traditional a -> a
unTraditional (Traditional PrivKeyEC -> Traditional KeyPair)
-> ParseASN1 e (Traditional PrivKeyEC)
-> ParseASN1 e (Traditional KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Traditional PrivKeyEC)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse

instance ASN1Elem e => ProduceASN1Object e (Modern KeyPair) where
    asn1s :: Modern KeyPair -> ASN1Stream e
asn1s (Modern [Attribute]
attrs Maybe GenericPubKey
mPub KeyPair
keyPair) = [Attribute] -> Maybe GenericPubKey -> KeyPair -> ASN1Stream e
forall e.
ASN1Elem e =>
[Attribute] -> Maybe GenericPubKey -> KeyPair -> ASN1Stream e
modernPrivKeyASN1S [Attribute]
attrs Maybe GenericPubKey
mPub KeyPair
keyPair

instance Monoid e => ParseASN1Object e (Modern KeyPair) where
    parse :: ParseASN1 e (Modern KeyPair)
parse = ParseASN1 e (Modern KeyPair)
rsa ParseASN1 e (Modern KeyPair)
-> ParseASN1 e (Modern KeyPair) -> ParseASN1 e (Modern KeyPair)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e (Modern KeyPair)
dsa ParseASN1 e (Modern KeyPair)
-> ParseASN1 e (Modern KeyPair) -> ParseASN1 e (Modern KeyPair)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e (Modern KeyPair)
ecdsa ParseASN1 e (Modern KeyPair)
-> ParseASN1 e (Modern KeyPair) -> ParseASN1 e (Modern KeyPair)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e (Modern KeyPair)
x25519 ParseASN1 e (Modern KeyPair)
-> ParseASN1 e (Modern KeyPair) -> ParseASN1 e (Modern KeyPair)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e (Modern KeyPair)
x448 ParseASN1 e (Modern KeyPair)
-> ParseASN1 e (Modern KeyPair) -> ParseASN1 e (Modern KeyPair)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e (Modern KeyPair)
ed25519 ParseASN1 e (Modern KeyPair)
-> ParseASN1 e (Modern KeyPair) -> ParseASN1 e (Modern KeyPair)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e (Modern KeyPair)
ed448
      where
        rsa :: ParseASN1 e (Modern KeyPair)
rsa   = (PrivateKey -> KeyPair) -> Modern PrivateKey -> Modern KeyPair
forall a b. (a -> b) -> Modern a -> Modern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (PrivateKey -> PrivKey) -> PrivateKey -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PrivKey
X509.PrivKeyRSA) (Modern PrivateKey -> Modern KeyPair)
-> ParseASN1 e (Modern PrivateKey) -> ParseASN1 e (Modern KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Modern PrivateKey)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        dsa :: ParseASN1 e (Modern KeyPair)
dsa   = (KeyPair -> KeyPair) -> Modern KeyPair -> Modern KeyPair
forall a b. (a -> b) -> Modern a -> Modern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair) -> (KeyPair -> PrivKey) -> KeyPair -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> PrivKey
X509.PrivKeyDSA (PrivateKey -> PrivKey)
-> (KeyPair -> PrivateKey) -> KeyPair -> PrivKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> PrivateKey
DSA.toPrivateKey) (Modern KeyPair -> Modern KeyPair)
-> ParseASN1 e (Modern KeyPair) -> ParseASN1 e (Modern KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Modern KeyPair)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        ecdsa :: ParseASN1 e (Modern KeyPair)
ecdsa = (PrivKeyEC -> KeyPair) -> Modern PrivKeyEC -> Modern KeyPair
forall a b. (a -> b) -> Modern a -> Modern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (PrivKeyEC -> PrivKey) -> PrivKeyEC -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivKeyEC -> PrivKey
X509.PrivKeyEC) (Modern PrivKeyEC -> Modern KeyPair)
-> ParseASN1 e (Modern PrivKeyEC) -> ParseASN1 e (Modern KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Modern PrivKeyEC)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        x25519 :: ParseASN1 e (Modern KeyPair)
x25519  = (SecretKey -> KeyPair) -> Modern SecretKey -> Modern KeyPair
forall a b. (a -> b) -> Modern a -> Modern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (SecretKey -> PrivKey) -> SecretKey -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PrivKey
X509.PrivKeyX25519) (Modern SecretKey -> Modern KeyPair)
-> ParseASN1 e (Modern SecretKey) -> ParseASN1 e (Modern KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Modern SecretKey)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        x448 :: ParseASN1 e (Modern KeyPair)
x448    = (SecretKey -> KeyPair) -> Modern SecretKey -> Modern KeyPair
forall a b. (a -> b) -> Modern a -> Modern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (SecretKey -> PrivKey) -> SecretKey -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PrivKey
X509.PrivKeyX448) (Modern SecretKey -> Modern KeyPair)
-> ParseASN1 e (Modern SecretKey) -> ParseASN1 e (Modern KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Modern SecretKey)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        ed25519 :: ParseASN1 e (Modern KeyPair)
ed25519 = (SecretKey -> KeyPair) -> Modern SecretKey -> Modern KeyPair
forall a b. (a -> b) -> Modern a -> Modern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (SecretKey -> PrivKey) -> SecretKey -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PrivKey
X509.PrivKeyEd25519) (Modern SecretKey -> Modern KeyPair)
-> ParseASN1 e (Modern SecretKey) -> ParseASN1 e (Modern KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Modern SecretKey)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse
        ed448 :: ParseASN1 e (Modern KeyPair)
ed448   = (SecretKey -> KeyPair) -> Modern SecretKey -> Modern KeyPair
forall a b. (a -> b) -> Modern a -> Modern b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (SecretKey -> PrivKey) -> SecretKey -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SecretKey -> PrivKey
X509.PrivKeyEd448) (Modern SecretKey -> Modern KeyPair)
-> ParseASN1 e (Modern SecretKey) -> ParseASN1 e (Modern KeyPair)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 e (Modern SecretKey)
forall e obj. ParseASN1Object e obj => ParseASN1 e obj
parse


-- RSA

toPubKeyRSA :: RSA.PrivateKey -> X509.PubKey
toPubKeyRSA :: PrivateKey -> PubKey
toPubKeyRSA = PublicKey -> PubKey
X509.PubKeyRSA (PublicKey -> PubKey)
-> (PrivateKey -> PublicKey) -> PrivateKey -> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> PublicKey
RSA.toPublicKey (KeyPair -> PublicKey)
-> (PrivateKey -> KeyPair) -> PrivateKey -> PublicKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivateKey -> KeyPair
RSA.KeyPair

instance ASN1Object (FormattedKey RSA.PrivateKey) where
    toASN1 :: FormattedKey PrivateKey -> ASN1S
toASN1   = (PrivateKey -> PubKey) -> FormattedKey PrivateKey -> ASN1S
forall e a.
(ProduceASN1Object e (Traditional a),
 ProduceASN1Object e (Modern a)) =>
(a -> PubKey) -> FormattedKey a -> ASN1Stream e
formattedASN1S PrivateKey -> PubKey
toPubKeyRSA
    fromASN1 :: [ASN1] -> Either FilePath (FormattedKey PrivateKey, [ASN1])
fromASN1 = ParseASN1 () (FormattedKey PrivateKey)
-> [ASN1] -> Either FilePath (FormattedKey PrivateKey, [ASN1])
forall a. ParseASN1 () a -> [ASN1] -> Either FilePath (a, [ASN1])
runParseASN1State ((PrivateKey -> PubKey) -> ParseASN1 () (FormattedKey PrivateKey)
forall e a.
(ParseASN1Object e (Traditional a),
 ParseASN1Object e (Modern a)) =>
(a -> PubKey) -> ParseASN1 e (FormattedKey a)
parseFormatted PrivateKey -> PubKey
toPubKeyRSA)

instance ASN1Elem e => ProduceASN1Object e (Traditional RSA.PrivateKey) where
    asn1s :: Traditional PrivateKey -> ASN1Stream e
asn1s (Traditional PrivateKey
privKey) =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
v ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
n ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
e ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
d ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
p1 ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
p2 ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
pexp1 ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
pexp2 ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
pcoef)
      where
        pubKey :: PublicKey
pubKey = PrivateKey -> PublicKey
RSA.private_pub PrivateKey
privKey

        v :: ASN1Stream e
v     = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
0
        n :: ASN1Stream e
n     = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (PublicKey -> Integer
RSA.public_n PublicKey
pubKey)
        e :: ASN1Stream e
e     = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (PublicKey -> Integer
RSA.public_e PublicKey
pubKey)
        d :: ASN1Stream e
d     = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (PrivateKey -> Integer
RSA.private_d PrivateKey
privKey)
        p1 :: ASN1Stream e
p1    = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (PrivateKey -> Integer
RSA.private_p PrivateKey
privKey)
        p2 :: ASN1Stream e
p2    = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (PrivateKey -> Integer
RSA.private_q PrivateKey
privKey)
        pexp1 :: ASN1Stream e
pexp1 = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (PrivateKey -> Integer
RSA.private_dP PrivateKey
privKey)
        pexp2 :: ASN1Stream e
pexp2 = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (PrivateKey -> Integer
RSA.private_dQ PrivateKey
privKey)
        pcoef :: ASN1Stream e
pcoef = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (PrivateKey -> Integer
RSA.private_qinv PrivateKey
privKey)

instance Monoid e => ParseASN1Object e (Traditional RSA.PrivateKey) where
    parse :: ParseASN1 e (Traditional PrivateKey)
parse = ASN1ConstructionType
-> ParseASN1 e (Traditional PrivateKey)
-> ParseASN1 e (Traditional PrivateKey)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (Traditional PrivateKey)
 -> ParseASN1 e (Traditional PrivateKey))
-> ParseASN1 e (Traditional PrivateKey)
-> ParseASN1 e (Traditional PrivateKey)
forall a b. (a -> b) -> a -> b
$ do
        IntVal 0 <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        IntVal n <- getNext
        IntVal e <- getNext
        IntVal d <- getNext
        IntVal p1 <- getNext
        IntVal p2 <- getNext
        IntVal pexp1 <- getNext
        IntVal pexp2 <- getNext
        IntVal pcoef <- getNext
        let pubKey  = RSA.PublicKey { public_size :: Int
RSA.public_size = Integer -> Int
numBytes Integer
n
                                    , public_n :: Integer
RSA.public_n    = Integer
n
                                    , public_e :: Integer
RSA.public_e    = Integer
e
                                    }
            privKey = RSA.PrivateKey { private_pub :: PublicKey
RSA.private_pub  = PublicKey
pubKey
                                    , private_d :: Integer
RSA.private_d    = Integer
d
                                    , private_p :: Integer
RSA.private_p    = Integer
p1
                                    , private_q :: Integer
RSA.private_q    = Integer
p2
                                    , private_dP :: Integer
RSA.private_dP   = Integer
pexp1
                                    , private_dQ :: Integer
RSA.private_dQ   = Integer
pexp2
                                    , private_qinv :: Integer
RSA.private_qinv = Integer
pcoef
                                    }
        return (Traditional privKey)

instance ASN1Elem e => ProduceASN1Object e (Modern RSA.PrivateKey) where
    asn1s :: Modern PrivateKey -> ASN1Stream e
asn1s (Modern [Attribute]
attrs Maybe GenericPubKey
mPub PrivateKey
privKey) =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
v ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
alg ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
bs ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
att)
      where
        v :: ASN1Stream e
v     = Maybe GenericPubKey -> ASN1Stream e
forall e. ASN1Elem e => Maybe GenericPubKey -> ASN1Stream e
versionASN1S Maybe GenericPubKey
mPub
        alg :: ASN1Stream e
alg   = 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
forall e. ASN1Elem e => ASN1Stream e
gNull)
        oid :: ASN1Stream e
oid   = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
1,Integer
1]
        bs :: ASN1Stream e
bs    = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (Traditional PrivateKey -> ByteString
forall obj. ProduceASN1Object ASN1P obj => obj -> ByteString
encodeASN1Object (Traditional PrivateKey -> ByteString)
-> Traditional PrivateKey -> ByteString
forall a b. (a -> b) -> a -> b
$ PrivateKey -> Traditional PrivateKey
forall a. a -> Traditional a
Traditional PrivateKey
privKey)
        att :: ASN1Stream e
att   = [Attribute] -> Maybe GenericPubKey -> ASN1Stream e
forall e.
ASN1Elem e =>
[Attribute] -> Maybe GenericPubKey -> ASN1Stream e
attrKeysASN1S [Attribute]
attrs Maybe GenericPubKey
mPub

instance Monoid e => ParseASN1Object e (Modern RSA.PrivateKey) where
    parse :: ParseASN1 e (Modern PrivateKey)
parse = ASN1ConstructionType
-> ParseASN1 e (Modern PrivateKey)
-> ParseASN1 e (Modern PrivateKey)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (Modern PrivateKey)
 -> ParseASN1 e (Modern PrivateKey))
-> ParseASN1 e (Modern PrivateKey)
-> ParseASN1 e (Modern PrivateKey)
forall a b. (a -> b) -> a -> b
$ do
        v2 <- ParseASN1 e Bool
forall e. Monoid e => ParseASN1 e Bool
parseVersion
        Null <- onNextContainer Sequence $ do
                    OID [1,2,840,113549,1,1,1] <- getNext
                    getNext
        (attrs, bs, mPub) <- parseAttrKeys v2
        let inner = BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bs
            strError = FilePath -> Either FilePath b
forall a b. a -> Either a b
Left (FilePath -> Either FilePath b)
-> (ASN1Error -> FilePath) -> ASN1Error -> Either FilePath b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (FilePath
"PKCS8: error decoding inner RSA: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (ASN1Error -> FilePath) -> ASN1Error -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Error -> FilePath
forall a. Show a => a -> FilePath
show
        case either strError (runParseASN1 parseTraditional) inner of
             Left FilePath
err -> FilePath -> ParseASN1 e (Modern PrivateKey)
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath
"PKCS8: error parsing inner RSA: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err)
             Right PrivateKey
privKey -> Modern PrivateKey -> ParseASN1 e (Modern PrivateKey)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Attribute]
-> Maybe GenericPubKey -> PrivateKey -> Modern PrivateKey
forall a. [Attribute] -> Maybe GenericPubKey -> a -> Modern a
Modern [Attribute]
attrs Maybe GenericPubKey
mPub PrivateKey
privKey)


-- DSA

toPubKeyDSA :: DSA.KeyPair -> X509.PubKey
toPubKeyDSA :: KeyPair -> PubKey
toPubKeyDSA = PublicKey -> PubKey
X509.PubKeyDSA (PublicKey -> PubKey)
-> (KeyPair -> PublicKey) -> KeyPair -> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyPair -> PublicKey
DSA.toPublicKey

instance ASN1Object (FormattedKey DSA.KeyPair) where
    toASN1 :: FormattedKey KeyPair -> ASN1S
toASN1   = (KeyPair -> PubKey) -> FormattedKey KeyPair -> ASN1S
forall e a.
(ProduceASN1Object e (Traditional a),
 ProduceASN1Object e (Modern a)) =>
(a -> PubKey) -> FormattedKey a -> ASN1Stream e
formattedASN1S KeyPair -> PubKey
toPubKeyDSA
    fromASN1 :: [ASN1] -> Either FilePath (FormattedKey KeyPair, [ASN1])
fromASN1 = ParseASN1 () (FormattedKey KeyPair)
-> [ASN1] -> Either FilePath (FormattedKey KeyPair, [ASN1])
forall a. ParseASN1 () a -> [ASN1] -> Either FilePath (a, [ASN1])
runParseASN1State ((KeyPair -> PubKey) -> ParseASN1 () (FormattedKey KeyPair)
forall e a.
(ParseASN1Object e (Traditional a),
 ParseASN1Object e (Modern a)) =>
(a -> PubKey) -> ParseASN1 e (FormattedKey a)
parseFormatted KeyPair -> PubKey
toPubKeyDSA)

instance ASN1Elem e => ProduceASN1Object e (Traditional DSA.KeyPair) where
    asn1s :: Traditional KeyPair -> ASN1Stream e
asn1s (Traditional (DSA.KeyPair Params
params Integer
pub Integer
priv)) =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
v ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Params -> ASN1Stream e
forall e. ASN1Elem e => Params -> ASN1Stream e
pqgASN1S Params
params ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
pub' ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
priv')
      where
        v :: ASN1Stream e
v     = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
0
        pub' :: ASN1Stream e
pub'  = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
pub
        priv' :: ASN1Stream e
priv' = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
priv

instance Monoid e => ParseASN1Object e (Traditional DSA.KeyPair) where
    parse :: ParseASN1 e (Traditional KeyPair)
parse = ASN1ConstructionType
-> ParseASN1 e (Traditional KeyPair)
-> ParseASN1 e (Traditional KeyPair)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (Traditional KeyPair)
 -> ParseASN1 e (Traditional KeyPair))
-> ParseASN1 e (Traditional KeyPair)
-> ParseASN1 e (Traditional KeyPair)
forall a b. (a -> b) -> a -> b
$ do
        IntVal 0 <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        params <- parsePQG
        IntVal pub <- getNext
        IntVal priv <- getNext
        return (Traditional $ DSA.KeyPair params pub priv)

instance ASN1Elem e => ProduceASN1Object e (Modern DSA.KeyPair) where
    asn1s :: Modern KeyPair -> ASN1Stream e
asn1s (Modern [Attribute]
attrs Maybe GenericPubKey
mPub (DSA.KeyPair Params
params Integer
_ Integer
priv)) =
        ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
v ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
alg ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
bs ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
att)
      where
        v :: ASN1Stream e
v     = Maybe GenericPubKey -> ASN1Stream e
forall e. ASN1Elem e => Maybe GenericPubKey -> ASN1Stream e
versionASN1S Maybe GenericPubKey
mPub
        alg :: ASN1Stream e
alg   = 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
pr)
        oid :: ASN1Stream e
oid   = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID [Integer
1,Integer
2,Integer
840,Integer
10040,Integer
4,Integer
1]
        pr :: ASN1Stream e
pr    = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (Params -> ASN1Stream e
forall e. ASN1Elem e => Params -> ASN1Stream e
pqgASN1S Params
params)
        bs :: ASN1Stream e
bs    = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (ASN1PS -> ByteString
encodeASN1S (ASN1PS -> ByteString) -> ASN1PS -> ByteString
forall a b. (a -> b) -> a -> b
$ Integer -> ASN1PS
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
priv)
        att :: ASN1Stream e
att   = [Attribute] -> Maybe GenericPubKey -> ASN1Stream e
forall e.
ASN1Elem e =>
[Attribute] -> Maybe GenericPubKey -> ASN1Stream e
attrKeysASN1S [Attribute]
attrs Maybe GenericPubKey
mPub

instance Monoid e => ParseASN1Object e (Modern DSA.KeyPair) where
    parse :: ParseASN1 e (Modern KeyPair)
parse = ASN1ConstructionType
-> ParseASN1 e (Modern KeyPair) -> ParseASN1 e (Modern KeyPair)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (Modern KeyPair) -> ParseASN1 e (Modern KeyPair))
-> ParseASN1 e (Modern KeyPair) -> ParseASN1 e (Modern KeyPair)
forall a b. (a -> b) -> a -> b
$ do
        v2 <- ParseASN1 e Bool
forall e. Monoid e => ParseASN1 e Bool
parseVersion
        params <- onNextContainer Sequence $ do
                      OID [1,2,840,10040,4,1] <- getNext
                      onNextContainer Sequence parsePQG
        (attrs, bs, mPub) <- parseAttrKeys v2
        case decodeASN1' BER bs of
            Right [IntVal Integer
priv] ->
                let pub :: Integer
pub = Params -> Integer -> Integer
DSA.calculatePublic Params
params Integer
priv
                 in Modern KeyPair -> ParseASN1 e (Modern KeyPair)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Attribute] -> Maybe GenericPubKey -> KeyPair -> Modern KeyPair
forall a. [Attribute] -> Maybe GenericPubKey -> a -> Modern a
Modern [Attribute]
attrs Maybe GenericPubKey
mPub (KeyPair -> Modern KeyPair) -> KeyPair -> Modern KeyPair
forall a b. (a -> b) -> a -> b
$ Params -> Integer -> Integer -> KeyPair
DSA.KeyPair Params
params Integer
pub Integer
priv)
            Right [ASN1]
_ -> FilePath -> ParseASN1 e (Modern KeyPair)
forall e a. FilePath -> ParseASN1 e a
throwParseError FilePath
"PKCS8: invalid format when parsing inner DSA"
            Left  ASN1Error
e -> FilePath -> ParseASN1 e (Modern KeyPair)
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath
"PKCS8: error parsing inner DSA: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ASN1Error -> FilePath
forall a. Show a => a -> FilePath
show ASN1Error
e)

pqgASN1S :: ASN1Elem e => DSA.Params -> ASN1Stream e
pqgASN1S :: forall e. ASN1Elem e => Params -> ASN1Stream e
pqgASN1S Params
params = ASN1Stream e
p ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
q ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
g
  where p :: ASN1Stream e
p = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Params -> Integer
DSA.params_p Params
params)
        q :: ASN1Stream e
q = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Params -> Integer
DSA.params_q Params
params)
        g :: ASN1Stream e
g = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (Params -> Integer
DSA.params_g Params
params)

parsePQG :: Monoid e => ParseASN1 e DSA.Params
parsePQG :: forall e. Monoid e => ParseASN1 e Params
parsePQG = do
    IntVal p <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    IntVal q <- getNext
    IntVal g <- getNext
    return DSA.Params { DSA.params_p = p
                      , DSA.params_q = q
                      , DSA.params_g = g
                      }


-- ECDSA

toPubKeyEC :: X509.PrivKeyEC -> X509.PubKey
toPubKeyEC :: PrivKeyEC -> PubKey
toPubKeyEC = KeyPair -> PubKey
keyPairToPubKey (KeyPair -> PubKey)
-> (PrivKeyEC -> KeyPair) -> PrivKeyEC -> PubKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivKey -> KeyPair
keyPairFromPrivKey (PrivKey -> KeyPair)
-> (PrivKeyEC -> PrivKey) -> PrivKeyEC -> KeyPair
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PrivKeyEC -> PrivKey
X509.PrivKeyEC

instance ASN1Object (FormattedKey X509.PrivKeyEC) where
    toASN1 :: FormattedKey PrivKeyEC -> ASN1S
toASN1   = (PrivKeyEC -> PubKey) -> FormattedKey PrivKeyEC -> ASN1S
forall e a.
(ProduceASN1Object e (Traditional a),
 ProduceASN1Object e (Modern a)) =>
(a -> PubKey) -> FormattedKey a -> ASN1Stream e
formattedASN1S PrivKeyEC -> PubKey
toPubKeyEC
    fromASN1 :: [ASN1] -> Either FilePath (FormattedKey PrivKeyEC, [ASN1])
fromASN1 = ParseASN1 () (FormattedKey PrivKeyEC)
-> [ASN1] -> Either FilePath (FormattedKey PrivKeyEC, [ASN1])
forall a. ParseASN1 () a -> [ASN1] -> Either FilePath (a, [ASN1])
runParseASN1State ((PrivKeyEC -> PubKey) -> ParseASN1 () (FormattedKey PrivKeyEC)
forall e a.
(ParseASN1Object e (Traditional a),
 ParseASN1Object e (Modern a)) =>
(a -> PubKey) -> ParseASN1 e (FormattedKey a)
parseFormatted PrivKeyEC -> PubKey
toPubKeyEC)

instance ASN1Elem e => ProduceASN1Object e (Traditional X509.PrivKeyEC) where
    asn1s :: Traditional PrivKeyEC -> ASN1Stream e
asn1s = Bool -> PrivKeyEC -> ASN1Stream e
forall e. ASN1Elem e => Bool -> PrivKeyEC -> ASN1Stream e
innerEcdsaASN1S Bool
True (PrivKeyEC -> ASN1Stream e)
-> (Traditional PrivKeyEC -> PrivKeyEC)
-> Traditional PrivKeyEC
-> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Traditional PrivKeyEC -> PrivKeyEC
forall a. Traditional a -> a
unTraditional

instance Monoid e => ParseASN1Object e (Traditional X509.PrivKeyEC) where
    parse :: ParseASN1 e (Traditional PrivKeyEC)
parse = PrivKeyEC -> Traditional PrivKeyEC
forall a. a -> Traditional a
Traditional (PrivKeyEC -> Traditional PrivKeyEC)
-> ParseASN1 e PrivKeyEC -> ParseASN1 e (Traditional PrivKeyEC)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Integer -> PrivKeyEC) -> ParseASN1 e PrivKeyEC
forall e.
Monoid e =>
Maybe (Integer -> PrivKeyEC) -> ParseASN1 e PrivKeyEC
parseInnerEcdsa Maybe (Integer -> PrivKeyEC)
forall a. Maybe a
Nothing

instance ASN1Elem e => ProduceASN1Object e (Modern X509.PrivKeyEC) where
    asn1s :: Modern PrivKeyEC -> ASN1Stream e
asn1s (Modern [Attribute]
attrs Maybe GenericPubKey
mPub PrivKeyEC
privKey) = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
v ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
f ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
bs ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
att)
      where
        v :: ASN1Stream e
v     = Maybe GenericPubKey -> ASN1Stream e
forall e. ASN1Elem e => Maybe GenericPubKey -> ASN1Stream e
versionASN1S Maybe GenericPubKey
mPub
        f :: ASN1Stream e
f     = 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
. PrivKeyEC -> ASN1Stream e
forall e. ASN1Elem e => PrivKeyEC -> ASN1Stream e
curveFnASN1S PrivKeyEC
privKey)
        oid :: ASN1Stream e
oid   = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID [Integer
1,Integer
2,Integer
840,Integer
10045,Integer
2,Integer
1]
        bs :: ASN1Stream e
bs    = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (ASN1PS -> ByteString
encodeASN1S ASN1PS
inner)
        inner :: ASN1PS
inner = Bool -> PrivKeyEC -> ASN1PS
forall e. ASN1Elem e => Bool -> PrivKeyEC -> ASN1Stream e
innerEcdsaASN1S Bool
False PrivKeyEC
privKey
        att :: ASN1Stream e
att   = [Attribute] -> Maybe GenericPubKey -> ASN1Stream e
forall e.
ASN1Elem e =>
[Attribute] -> Maybe GenericPubKey -> ASN1Stream e
attrKeysASN1S [Attribute]
attrs Maybe GenericPubKey
mPub

instance Monoid e => ParseASN1Object e (Modern X509.PrivKeyEC) where
    parse :: ParseASN1 e (Modern PrivKeyEC)
parse = ASN1ConstructionType
-> ParseASN1 e (Modern PrivKeyEC) -> ParseASN1 e (Modern PrivKeyEC)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (Modern PrivKeyEC) -> ParseASN1 e (Modern PrivKeyEC))
-> ParseASN1 e (Modern PrivKeyEC) -> ParseASN1 e (Modern PrivKeyEC)
forall a b. (a -> b) -> a -> b
$ do
        v2 <- ParseASN1 e Bool
forall e. Monoid e => ParseASN1 e Bool
parseVersion
        f <- onNextContainer Sequence $ do
            OID [1,2,840,10045,2,1] <- getNext
            parseCurveFn
        (attrs, bs, mPub) <- parseAttrKeys v2
        let inner = BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bs
            strError = FilePath -> Either FilePath b
forall a b. a -> Either a b
Left (FilePath -> Either FilePath b)
-> (ASN1Error -> FilePath) -> ASN1Error -> Either FilePath b
forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (FilePath
"PKCS8: error decoding inner EC: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (ASN1Error -> FilePath) -> ASN1Error -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Error -> FilePath
forall a. Show a => a -> FilePath
show
        case either strError (runParseASN1 $ parseInnerEcdsa $ Just f) inner of
            Left FilePath
err -> FilePath -> ParseASN1 e (Modern PrivKeyEC)
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath
"PKCS8: error parsing inner EC: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err)
            Right PrivKeyEC
privKey -> Modern PrivKeyEC -> ParseASN1 e (Modern PrivKeyEC)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Attribute] -> Maybe GenericPubKey -> PrivKeyEC -> Modern PrivKeyEC
forall a. [Attribute] -> Maybe GenericPubKey -> a -> Modern a
Modern [Attribute]
attrs Maybe GenericPubKey
mPub PrivKeyEC
privKey)

innerEcdsaASN1S :: ASN1Elem e => Bool -> X509.PrivKeyEC -> ASN1Stream e
innerEcdsaASN1S :: forall e. ASN1Elem e => Bool -> PrivKeyEC -> ASN1Stream e
innerEcdsaASN1S Bool
addC PrivKeyEC
k
    | Bool
addC      = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
v ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ds ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
c0 ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
c1)
    | Bool
otherwise = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
v ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
ds ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
c1)
  where
    curve :: Curve
curve = Curve -> Maybe Curve -> Curve
forall a. a -> Maybe a -> a
fromMaybe (FilePath -> Curve
forall a. HasCallStack => FilePath -> a
error FilePath
"PKCS8: invalid EC parameters") (PrivKeyEC -> Maybe Curve
ecPrivKeyCurve PrivKeyEC
k)
    bytes :: Int
bytes = Curve -> Int
curveOrderBytes Curve
curve

    v :: ASN1Stream e
v  = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
1
    ds :: ASN1Stream e
ds = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
bytes (PrivKeyEC -> Integer
X509.privkeyEC_priv PrivKeyEC
k))
    c0 :: ASN1Stream e
c0 = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) (PrivKeyEC -> ASN1Stream e
forall e. ASN1Elem e => PrivKeyEC -> ASN1Stream e
curveFnASN1S PrivKeyEC
k)
    c1 :: ASN1Stream e
c1 = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
1) ASN1Stream e
pub

    pub :: ASN1Stream e
pub = BitArray -> ASN1Stream e
forall e. ASN1Elem e => BitArray -> ASN1Stream e
gBitString (ByteString -> Int -> BitArray
toBitArray ByteString
sp Int
0)
    X509.SerializedPoint ByteString
sp = Curve -> Integer -> SerializedPoint
getSerializedPoint Curve
curve (PrivKeyEC -> Integer
X509.privkeyEC_priv PrivKeyEC
k)

parseInnerEcdsa :: Monoid e
                => Maybe (ECDSA.PrivateNumber -> X509.PrivKeyEC)
                -> ParseASN1 e X509.PrivKeyEC
parseInnerEcdsa :: forall e.
Monoid e =>
Maybe (Integer -> PrivKeyEC) -> ParseASN1 e PrivKeyEC
parseInnerEcdsa Maybe (Integer -> PrivKeyEC)
fn = ASN1ConstructionType
-> ParseASN1 e PrivKeyEC -> ParseASN1 e PrivKeyEC
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e PrivKeyEC -> ParseASN1 e PrivKeyEC)
-> ParseASN1 e PrivKeyEC -> ParseASN1 e PrivKeyEC
forall a b. (a -> b) -> a -> b
$ do
    IntVal 1 <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    OctetString ds <- getNext
    let d = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
ds
    m <- onNextContainerMaybe (Container Context 0) parseCurveFn
    _ <- onNextContainerMaybe (Container Context 1) parsePK
    case fn <|> m of
        Maybe (Integer -> PrivKeyEC)
Nothing     -> FilePath -> ParseASN1 e PrivKeyEC
forall e a. FilePath -> ParseASN1 e a
throwParseError FilePath
"PKCS8: no curve found in EC private key"
        Just Integer -> PrivKeyEC
getKey -> PrivKeyEC -> ParseASN1 e PrivKeyEC
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> PrivKeyEC
getKey Integer
d)
  where
    parsePK :: ParseASN1 e BitArray
parsePK = do { BitString bs <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext; return bs }

curveFnASN1S :: ASN1Elem e => X509.PrivKeyEC -> ASN1Stream e
curveFnASN1S :: forall e. ASN1Elem e => PrivKeyEC -> ASN1Stream e
curveFnASN1S X509.PrivKeyEC_Named{Integer
CurveName
privkeyEC_priv :: PrivKeyEC -> Integer
privkeyEC_name :: CurveName
privkeyEC_priv :: Integer
privkeyEC_name :: PrivKeyEC -> CurveName
..} = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID (CurveName -> OID
curveNameOID CurveName
privkeyEC_name)
curveFnASN1S X509.PrivKeyEC_Prime{Integer
SerializedPoint
privkeyEC_priv :: PrivKeyEC -> Integer
privkeyEC_priv :: Integer
privkeyEC_a :: Integer
privkeyEC_b :: Integer
privkeyEC_prime :: Integer
privkeyEC_generator :: SerializedPoint
privkeyEC_order :: Integer
privkeyEC_cofactor :: Integer
privkeyEC_seed :: Integer
privkeyEC_seed :: PrivKeyEC -> Integer
privkeyEC_cofactor :: PrivKeyEC -> Integer
privkeyEC_order :: PrivKeyEC -> Integer
privkeyEC_generator :: PrivKeyEC -> SerializedPoint
privkeyEC_prime :: PrivKeyEC -> Integer
privkeyEC_b :: PrivKeyEC -> Integer
privkeyEC_a :: PrivKeyEC -> Integer
..} =
    ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
v ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
prime ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
abSeed ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
gen ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
o ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
c)
  where
    X509.SerializedPoint ByteString
generator = SerializedPoint
privkeyEC_generator
    bytes :: Int
bytes  = Integer -> Int
numBytes Integer
privkeyEC_prime

    v :: ASN1Stream e
v      = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
1

    prime :: ASN1Stream e
prime  = 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
p)
    oid :: ASN1Stream e
oid    = OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID [Integer
1,Integer
2,Integer
840,Integer
10045,Integer
1,Integer
1]
    p :: ASN1Stream e
p      = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
privkeyEC_prime

    abSeed :: ASN1Stream e
abSeed = 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
b ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
seed)
    a :: ASN1Stream e
a      = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
bytes Integer
privkeyEC_a)
    b :: ASN1Stream e
b      = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (Int -> Integer -> ByteString
forall ba. ByteArray ba => Int -> Integer -> ba
i2ospOf_ Int
bytes Integer
privkeyEC_b)
    seed :: ASN1Stream e
seed   = if Integer
privkeyEC_seed Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
0
                 then BitArray -> ASN1Stream e
forall e. ASN1Elem e => BitArray -> ASN1Stream e
gBitString (ByteString -> Int -> BitArray
toBitArray (Integer -> ByteString
forall ba. ByteArray ba => Integer -> ba
i2osp Integer
privkeyEC_seed) Int
0)
                 else ASN1Stream e
forall a. a -> a
id

    gen :: ASN1Stream e
gen    = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString ByteString
generator
    o :: ASN1Stream e
o      = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
privkeyEC_order
    c :: ASN1Stream e
c      = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal Integer
privkeyEC_cofactor

parseCurveFn :: Monoid e => ParseASN1 e (ECDSA.PrivateNumber -> X509.PrivKeyEC)
parseCurveFn :: forall e. Monoid e => ParseASN1 e (Integer -> PrivKeyEC)
parseCurveFn = ParseASN1 e (Integer -> PrivKeyEC)
parseNamedCurve ParseASN1 e (Integer -> PrivKeyEC)
-> ParseASN1 e (Integer -> PrivKeyEC)
-> ParseASN1 e (Integer -> PrivKeyEC)
forall a. ParseASN1 e a -> ParseASN1 e a -> ParseASN1 e a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParseASN1 e (Integer -> PrivKeyEC)
parsePrimeCurve
  where
    parseNamedCurve :: ParseASN1 e (Integer -> PrivKeyEC)
parseNamedCurve = do
        OID oid <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        case lookupCurveNameByOID oid of
            Just CurveName
name -> (Integer -> PrivKeyEC) -> ParseASN1 e (Integer -> PrivKeyEC)
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return ((Integer -> PrivKeyEC) -> ParseASN1 e (Integer -> PrivKeyEC))
-> (Integer -> PrivKeyEC) -> ParseASN1 e (Integer -> PrivKeyEC)
forall a b. (a -> b) -> a -> b
$ \Integer
d ->
                            X509.PrivKeyEC_Named
                                { privkeyEC_name :: CurveName
X509.privkeyEC_name = CurveName
name
                                , privkeyEC_priv :: Integer
X509.privkeyEC_priv = Integer
d
                                }
            Maybe CurveName
Nothing -> FilePath -> ParseASN1 e (Integer -> PrivKeyEC)
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath
"PKCS8: unknown EC curve with OID " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ OID -> FilePath
forall a. Show a => a -> FilePath
show OID
oid)

    parsePrimeCurve :: ParseASN1 e (Integer -> PrivKeyEC)
parsePrimeCurve =
        ASN1ConstructionType
-> ParseASN1 e (Integer -> PrivKeyEC)
-> ParseASN1 e (Integer -> PrivKeyEC)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (Integer -> PrivKeyEC)
 -> ParseASN1 e (Integer -> PrivKeyEC))
-> ParseASN1 e (Integer -> PrivKeyEC)
-> ParseASN1 e (Integer -> PrivKeyEC)
forall a b. (a -> b) -> a -> b
$ do
            IntVal 1 <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
            prime <- onNextContainer Sequence $ do
                OID [1,2,840,10045,1,1] <- getNext
                IntVal prime <- getNext
                return prime
            (a, b, seed) <- onNextContainer Sequence $ do
                OctetString a <- getNext
                OctetString b <- getNext
                seed <- parseOptionalSeed
                return (a, b, seed)
            OctetString generator <- getNext
            IntVal order <- getNext
            IntVal cofactor <- getNext
            return $ \Integer
d ->
                X509.PrivKeyEC_Prime
                    { privkeyEC_priv :: Integer
X509.privkeyEC_priv      = Integer
d
                    , privkeyEC_a :: Integer
X509.privkeyEC_a         = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
a
                    , privkeyEC_b :: Integer
X509.privkeyEC_b         = ByteString -> Integer
forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
b
                    , privkeyEC_prime :: Integer
X509.privkeyEC_prime     = Integer
prime
                    , privkeyEC_generator :: SerializedPoint
X509.privkeyEC_generator = ByteString -> SerializedPoint
X509.SerializedPoint ByteString
generator
                    , privkeyEC_order :: Integer
X509.privkeyEC_order     = Integer
order
                    , privkeyEC_cofactor :: Integer
X509.privkeyEC_cofactor  = Integer
cofactor
                    , privkeyEC_seed :: Integer
X509.privkeyEC_seed      = Integer
seed
                    }

    parseOptionalSeed :: ParseASN1 e Integer
parseOptionalSeed = do
        seedAvail <- ParseASN1 e Bool
forall e. ParseASN1 e Bool
hasNext
        if seedAvail
            then do BitString seed <- getNext
                    return (os2ip $ bitArrayGetData seed)
            else return 0


-- X25519, X448, Ed25519, Ed448

instance ASN1Elem e => ProduceASN1Object e (Modern X25519.SecretKey) where
    asn1s :: Modern SecretKey -> ASN1Stream e
asn1s = OID -> Modern SecretKey -> ASN1Stream e
forall e key.
(ASN1Elem e, ByteArrayAccess key) =>
OID -> Modern key -> ASN1Stream e
produceModernEddsa [Integer
1,Integer
3,Integer
101,Integer
110]

instance Monoid e => ParseASN1Object e (Modern X25519.SecretKey) where
    parse :: ParseASN1 e (Modern SecretKey)
parse = FilePath
-> OID
-> (ByteString -> CryptoFailable SecretKey)
-> ParseASN1 e (Modern SecretKey)
forall e a.
Monoid e =>
FilePath
-> OID
-> (ByteString -> CryptoFailable a)
-> ParseASN1 e (Modern a)
parseModernEddsa FilePath
"X25519" [Integer
1,Integer
3,Integer
101,Integer
110] ByteString -> CryptoFailable SecretKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
X25519.secretKey

instance ASN1Elem e => ProduceASN1Object e (Modern X448.SecretKey) where
    asn1s :: Modern SecretKey -> ASN1Stream e
asn1s = OID -> Modern SecretKey -> ASN1Stream e
forall e key.
(ASN1Elem e, ByteArrayAccess key) =>
OID -> Modern key -> ASN1Stream e
produceModernEddsa [Integer
1,Integer
3,Integer
101,Integer
111]

instance Monoid e => ParseASN1Object e (Modern X448.SecretKey) where
    parse :: ParseASN1 e (Modern SecretKey)
parse = FilePath
-> OID
-> (ByteString -> CryptoFailable SecretKey)
-> ParseASN1 e (Modern SecretKey)
forall e a.
Monoid e =>
FilePath
-> OID
-> (ByteString -> CryptoFailable a)
-> ParseASN1 e (Modern a)
parseModernEddsa FilePath
"X448" [Integer
1,Integer
3,Integer
101,Integer
111] ByteString -> CryptoFailable SecretKey
forall bs. ByteArrayAccess bs => bs -> CryptoFailable SecretKey
X448.secretKey

instance ASN1Elem e => ProduceASN1Object e (Modern Ed25519.SecretKey) where
    asn1s :: Modern SecretKey -> ASN1Stream e
asn1s = OID -> Modern SecretKey -> ASN1Stream e
forall e key.
(ASN1Elem e, ByteArrayAccess key) =>
OID -> Modern key -> ASN1Stream e
produceModernEddsa [Integer
1,Integer
3,Integer
101,Integer
112]

instance Monoid e => ParseASN1Object e (Modern Ed25519.SecretKey) where
    parse :: ParseASN1 e (Modern SecretKey)
parse = FilePath
-> OID
-> (ByteString -> CryptoFailable SecretKey)
-> ParseASN1 e (Modern SecretKey)
forall e a.
Monoid e =>
FilePath
-> OID
-> (ByteString -> CryptoFailable a)
-> ParseASN1 e (Modern a)
parseModernEddsa FilePath
"Ed25519" [Integer
1,Integer
3,Integer
101,Integer
112] ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed25519.secretKey

instance ASN1Elem e => ProduceASN1Object e (Modern Ed448.SecretKey) where
    asn1s :: Modern SecretKey -> ASN1Stream e
asn1s = OID -> Modern SecretKey -> ASN1Stream e
forall e key.
(ASN1Elem e, ByteArrayAccess key) =>
OID -> Modern key -> ASN1Stream e
produceModernEddsa [Integer
1,Integer
3,Integer
101,Integer
113]

instance Monoid e => ParseASN1Object e (Modern Ed448.SecretKey) where
    parse :: ParseASN1 e (Modern SecretKey)
parse = FilePath
-> OID
-> (ByteString -> CryptoFailable SecretKey)
-> ParseASN1 e (Modern SecretKey)
forall e a.
Monoid e =>
FilePath
-> OID
-> (ByteString -> CryptoFailable a)
-> ParseASN1 e (Modern a)
parseModernEddsa FilePath
"Ed448" [Integer
1,Integer
3,Integer
101,Integer
113] ByteString -> CryptoFailable SecretKey
forall ba. ByteArrayAccess ba => ba -> CryptoFailable SecretKey
Ed448.secretKey

-- * Producer helpers

produceModernEddsa :: (ASN1Elem e, ByteArrayAccess key) => OID -> Modern key -> ASN1Stream e
produceModernEddsa :: forall e key.
(ASN1Elem e, ByteArrayAccess key) =>
OID -> Modern key -> ASN1Stream e
produceModernEddsa OID
oid (Modern [Attribute]
attrs Maybe GenericPubKey
mPub key
privKey) = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (ASN1Stream e
v ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
alg ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
bs ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Stream e
att)
  where
    v :: ASN1Stream e
v     = Maybe GenericPubKey -> ASN1Stream e
forall e. ASN1Elem e => Maybe GenericPubKey -> ASN1Stream e
versionASN1S Maybe GenericPubKey
mPub
    alg :: ASN1Stream e
alg   = ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> ASN1Stream e -> ASN1Stream e
asn1Container ASN1ConstructionType
Sequence (OID -> ASN1Stream e
forall e. ASN1Elem e => OID -> ASN1Stream e
gOID OID
oid)
    bs :: ASN1Stream e
bs    = key -> ASN1Stream e
forall e key.
(ASN1Elem e, ByteArrayAccess key) =>
key -> ASN1Stream e
innerEddsaASN1S key
privKey
    att :: ASN1Stream e
att   = [Attribute] -> Maybe GenericPubKey -> ASN1Stream e
forall e.
ASN1Elem e =>
[Attribute] -> Maybe GenericPubKey -> ASN1Stream e
attrKeysASN1S [Attribute]
attrs Maybe GenericPubKey
mPub

innerEddsaASN1S :: (ASN1Elem e, ByteArrayAccess key) => key -> ASN1Stream e
innerEddsaASN1S :: forall e key.
(ASN1Elem e, ByteArrayAccess key) =>
key -> ASN1Stream e
innerEddsaASN1S key
key = ByteString -> ASN1Stream e
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (ASN1PS -> ByteString
encodeASN1S ASN1PS
inner)
  where inner :: ASN1PS
inner = ByteString -> ASN1PS
forall e. ASN1Elem e => ByteString -> ASN1Stream e
gOctetString (key -> ByteString
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
bin -> bout
convert key
key)

-- * Parser helpers

parseModernEddsa :: Monoid e => String -> OID -> (B.ByteString -> CryptoFailable a) -> ParseASN1 e (Modern a)
parseModernEddsa :: forall e a.
Monoid e =>
FilePath
-> OID
-> (ByteString -> CryptoFailable a)
-> ParseASN1 e (Modern a)
parseModernEddsa FilePath
name OID
expectedOid ByteString -> CryptoFailable a
buildKey = ASN1ConstructionType
-> ParseASN1 e (Modern a) -> ParseASN1 e (Modern a)
forall e a.
Monoid e =>
ASN1ConstructionType -> ParseASN1 e a -> ParseASN1 e a
onNextContainer ASN1ConstructionType
Sequence (ParseASN1 e (Modern a) -> ParseASN1 e (Modern a))
-> ParseASN1 e (Modern a) -> ParseASN1 e (Modern a)
forall a b. (a -> b) -> a -> b
$ do
  v2 <- ParseASN1 e Bool
forall e. Monoid e => ParseASN1 e Bool
parseVersion
  onNextContainer Sequence $ do
    OID oid <- getNext
    when (oid /= expectedOid) $
      throwParseError ("PKCS8: while parsing " ++ name ++ " expected OID " ++ show expectedOid ++ " while got " ++ show oid)
  (attrs, bs, mPub) <- parseAttrKeys v2
  Modern attrs mPub <$> parseInnerEddsa name buildKey bs

parseInnerEddsa :: Monoid e
                => String
                -> (B.ByteString -> CryptoFailable key)
                -> B.ByteString
                -> ParseASN1 e key
parseInnerEddsa :: forall e key.
Monoid e =>
FilePath
-> (ByteString -> CryptoFailable key)
-> ByteString
-> ParseASN1 e key
parseInnerEddsa FilePath
name ByteString -> CryptoFailable key
buildKey ByteString
input =
    case (ASN1Error -> Either FilePath key)
-> ([ASN1] -> Either FilePath key)
-> Either ASN1Error [ASN1]
-> Either FilePath key
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ASN1Error -> Either FilePath key
forall {b}. ASN1Error -> Either FilePath b
strError (ParseASN1 () key -> [ASN1] -> Either FilePath key
forall a. ParseASN1 () a -> [ASN1] -> Either FilePath a
runParseASN1 ParseASN1 () key
parser) (BER -> ByteString -> Either ASN1Error [ASN1]
forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
input) of
        Left FilePath
err -> FilePath -> ParseASN1 e key
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath
"PKCS8: error parsing inner " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err)
        Right key
privKey -> key -> ParseASN1 e key
forall a. a -> ParseASN1 e a
forall (m :: * -> *) a. Monad m => a -> m a
return key
privKey
  where
    innerMsg :: FilePath
innerMsg = FilePath
"PKCS8: error decoding inner " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": "
    strError :: ASN1Error -> Either FilePath b
strError = FilePath -> Either FilePath b
forall a b. a -> Either a b
Left (FilePath -> Either FilePath b)
-> (ASN1Error -> FilePath) -> ASN1Error -> Either FilePath b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
innerMsg FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) (FilePath -> FilePath)
-> (ASN1Error -> FilePath) -> ASN1Error -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Error -> FilePath
forall a. Show a => a -> FilePath
show
    parser :: ParseASN1 () key
parser   = do
        OctetString bs <- ParseASN1 () ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
        case buildKey bs of
            CryptoPassed key
privKey -> key -> ParseASN1 () key
forall a. a -> ParseASN1 () a
forall (m :: * -> *) a. Monad m => a -> m a
return key
privKey
            CryptoFailed CryptoError
_       ->
                FilePath -> ParseASN1 () key
forall e a. FilePath -> ParseASN1 e a
throwParseError (FilePath
"PKCS8: parsed invalid " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
name FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" secret key")

versionASN1S :: ASN1Elem e => Maybe GenericPubKey -> ASN1Stream e
versionASN1S :: forall e. ASN1Elem e => Maybe GenericPubKey -> ASN1Stream e
versionASN1S Maybe GenericPubKey
mPub = Integer -> ASN1Stream e
forall e. ASN1Elem e => Integer -> ASN1Stream e
gIntVal (if Maybe GenericPubKey -> Bool
forall a. Maybe a -> Bool
isJust Maybe GenericPubKey
mPub then Integer
1 else Integer
0)

parseVersion :: Monoid e => ParseASN1 e Bool
parseVersion :: forall e. Monoid e => ParseASN1 e Bool
parseVersion = do
    IntVal v <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    when (v /= 0 && v /= 1) $
        throwParseError ("PKCS8: parsed invalid version: " ++ show v)
    return (v /= 0)

attrKeysASN1S :: ASN1Elem e => [Attribute] -> Maybe GenericPubKey -> ASN1Stream e
attrKeysASN1S :: forall e.
ASN1Elem e =>
[Attribute] -> Maybe GenericPubKey -> ASN1Stream e
attrKeysASN1S [Attribute]
attrs Maybe GenericPubKey
mPub = ASN1Stream e
att ASN1Stream e -> ASN1Stream e -> ASN1Stream e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe GenericPubKey -> ASN1Stream e
forall e obj. ProduceASN1Object e obj => obj -> ASN1Stream e
asn1s Maybe GenericPubKey
mPub
  where att :: ASN1Stream e
att = ASN1ConstructionType -> [Attribute] -> ASN1Stream e
forall e.
ASN1Elem e =>
ASN1ConstructionType -> [Attribute] -> ASN1Stream e
attributesASN1S (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) [Attribute]
attrs

parseAttrKeys :: Monoid e
              => Bool
              -> ParseASN1 e ([Attribute], B.ByteString, Maybe GenericPubKey)
parseAttrKeys :: forall e.
Monoid e =>
Bool -> ParseASN1 e ([Attribute], ByteString, Maybe GenericPubKey)
parseAttrKeys Bool
v2 = do
    OctetString bs <- ParseASN1 e ASN1
forall e. Monoid e => ParseASN1 e ASN1
getNext
    attrs <- parseAttributes (Container Context 0)
    mPub <- parse
    when (isJust mPub && not v2) $
        throwParseError "PKCS8: public key allowed only for version 2"
    return (attrs, bs, mPub)