-- |
-- Module      : Data.X509.Memory
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
--
module Data.X509.Memory
    ( readKeyFileFromMemory
    , readSignedObjectFromMemory
    , pemToKey
    ) where

import Data.ASN1.Types
import Data.ASN1.BinaryEncoding
import Data.ASN1.BitArray
import Data.ASN1.Encoding
import Data.ASN1.Stream
import Data.Maybe
import qualified Data.X509 as X509
import           Data.X509.EC as X509
import Data.PEM (pemParseBS, pemContent, pemName, PEM)
import qualified Data.ByteString as B
import           Crypto.Number.Basic (numBytes)
import           Crypto.Number.Serialize (os2ip)
import qualified Crypto.PubKey.DSA as DSA
import qualified Crypto.PubKey.ECC.ECDSA as ECDSA
import qualified Crypto.PubKey.RSA as RSA

readKeyFileFromMemory :: B.ByteString -> [X509.PrivKey]
readKeyFileFromMemory :: ByteString -> [PrivKey]
readKeyFileFromMemory = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) (forall a. [Maybe a] -> [a]
catMaybes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl [Maybe PrivKey] -> PEM -> [Maybe PrivKey]
pemToKey []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String [PEM]
pemParseBS

readSignedObjectFromMemory :: (ASN1Object a, Eq a, Show a)
                           => B.ByteString
                           -> [X509.SignedExact a]
readSignedObjectFromMemory :: forall a.
(ASN1Object a, Eq a, Show a) =>
ByteString -> [SignedExact a]
readSignedObjectFromMemory = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> b -> a
const []) (forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl forall {a}.
(Show a, Eq a, ASN1Object a) =>
[SignedExact a] -> PEM -> [SignedExact a]
pemToSigned []) forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String [PEM]
pemParseBS
  where pemToSigned :: [SignedExact a] -> PEM -> [SignedExact a]
pemToSigned [SignedExact a]
acc PEM
pem =
            case forall a.
(Show a, Eq a, ASN1Object a) =>
ByteString -> Either String (SignedExact a)
X509.decodeSignedObject forall a b. (a -> b) -> a -> b
$ PEM -> ByteString
pemContent PEM
pem of
                Left String
_    -> [SignedExact a]
acc
                Right SignedExact a
obj -> SignedExact a
obj forall a. a -> [a] -> [a]
: [SignedExact a]
acc

pemToKey :: [Maybe X509.PrivKey] -> PEM -> [Maybe X509.PrivKey]
pemToKey :: [Maybe PrivKey] -> PEM -> [Maybe PrivKey]
pemToKey [Maybe PrivKey]
acc PEM
pem =
    case forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER (PEM -> ByteString
pemContent PEM
pem) of
        Left ASN1Error
_     -> [Maybe PrivKey]
acc
        Right [ASN1]
asn1 ->
            case PEM -> String
pemName PEM
pem of
                String
"PRIVATE KEY" ->
                    [ASN1] -> Maybe PrivKey
tryRSA [ASN1]
asn1 forall a. a -> [a] -> [a]
: [ASN1] -> Maybe PrivKey
tryNewcurve [ASN1]
asn1 forall a. a -> [a] -> [a]
: [ASN1] -> Maybe PrivKey
tryECDSA [ASN1]
asn1 forall a. a -> [a] -> [a]
: [ASN1] -> Maybe PrivKey
tryDSA [ASN1]
asn1 forall a. a -> [a] -> [a]
: [Maybe PrivKey]
acc
                String
"RSA PRIVATE KEY" ->
                    [ASN1] -> Maybe PrivKey
tryRSA [ASN1]
asn1 forall a. a -> [a] -> [a]
: [Maybe PrivKey]
acc
                String
"DSA PRIVATE KEY" ->
                    [ASN1] -> Maybe PrivKey
tryDSA [ASN1]
asn1 forall a. a -> [a] -> [a]
: [Maybe PrivKey]
acc
                String
"EC PRIVATE KEY"  ->
                    [ASN1] -> Maybe PrivKey
tryECDSA [ASN1]
asn1 forall a. a -> [a] -> [a]
: [Maybe PrivKey]
acc
                String
"X25519 PRIVATE KEY" ->
                    [ASN1] -> Maybe PrivKey
tryNewcurve [ASN1]
asn1 forall a. a -> [a] -> [a]
: [Maybe PrivKey]
acc
                String
"X448 PRIVATE KEY" ->
                    [ASN1] -> Maybe PrivKey
tryNewcurve [ASN1]
asn1 forall a. a -> [a] -> [a]
: [Maybe PrivKey]
acc
                String
"ED25519 PRIVATE KEY" ->
                    [ASN1] -> Maybe PrivKey
tryNewcurve [ASN1]
asn1 forall a. a -> [a] -> [a]
: [Maybe PrivKey]
acc
                String
"ED448 PRIVATE KEY" ->
                    [ASN1] -> Maybe PrivKey
tryNewcurve [ASN1]
asn1 forall a. a -> [a] -> [a]
: [Maybe PrivKey]
acc
                String
_                 -> [Maybe PrivKey]
acc
  where
        tryRSA :: [ASN1] -> Maybe PrivKey
tryRSA [ASN1]
asn1 = case [ASN1] -> Either String (PrivateKey, [ASN1])
rsaFromASN1 [ASN1]
asn1 of
                    Left String
_      -> forall a. Maybe a
Nothing
                    Right (PrivateKey
k,[ASN1]
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PrivateKey -> PrivKey
X509.PrivKeyRSA PrivateKey
k
        tryDSA :: [ASN1] -> Maybe PrivKey
tryDSA [ASN1]
asn1 = case [ASN1] -> Either String (KeyPair, [ASN1])
dsaFromASN1 [ASN1]
asn1 of
                    Left String
_      -> forall a. Maybe a
Nothing
                    Right (KeyPair
k,[ASN1]
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PrivateKey -> PrivKey
X509.PrivKeyDSA forall a b. (a -> b) -> a -> b
$ KeyPair -> PrivateKey
DSA.toPrivateKey KeyPair
k
        tryECDSA :: [ASN1] -> Maybe PrivKey
tryECDSA [ASN1]
asn1 = case [ASN1] -> [ASN1] -> Either String (PrivKeyEC, [ASN1])
ecdsaFromASN1 [] [ASN1]
asn1 of
                    Left String
_      -> forall a. Maybe a
Nothing
                    Right (PrivKeyEC
k,[ASN1]
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ PrivKeyEC -> PrivKey
X509.PrivKeyEC PrivKeyEC
k
        tryNewcurve :: [ASN1] -> Maybe PrivKey
tryNewcurve [ASN1]
asn1 = case forall a. ASN1Object a => [ASN1] -> Either String (a, [ASN1])
fromASN1 [ASN1]
asn1 of
                    Right (k :: PrivKey
k@(X509.PrivKeyX25519  SecretKey
_),[ASN1]
_) -> forall a. a -> Maybe a
Just PrivKey
k
                    Right (k :: PrivKey
k@(X509.PrivKeyX448    SecretKey
_),[ASN1]
_) -> forall a. a -> Maybe a
Just PrivKey
k
                    Right (k :: PrivKey
k@(X509.PrivKeyEd25519 SecretKey
_),[ASN1]
_) -> forall a. a -> Maybe a
Just PrivKey
k
                    Right (k :: PrivKey
k@(X509.PrivKeyEd448   SecretKey
_),[ASN1]
_) -> forall a. a -> Maybe a
Just PrivKey
k
                    Either String (PrivKey, [ASN1])
_ -> forall a. Maybe a
Nothing

dsaFromASN1 :: [ASN1] -> Either String (DSA.KeyPair, [ASN1])
dsaFromASN1 :: [ASN1] -> Either String (KeyPair, [ASN1])
dsaFromASN1 (Start ASN1ConstructionType
Sequence : IntVal Integer
n : [ASN1]
xs)
    | Integer
n forall a. Eq a => a -> a -> Bool
/= Integer
0    = forall a b. a -> Either a b
Left String
"fromASN1: DSA.KeyPair: unknown format"
    | Bool
otherwise =
        case [ASN1]
xs of
            IntVal Integer
p : IntVal Integer
q : IntVal Integer
g : IntVal Integer
pub : IntVal Integer
priv : End ASN1ConstructionType
Sequence : [ASN1]
xs2 ->
                let params :: Params
params = DSA.Params { params_p :: Integer
DSA.params_p = Integer
p, params_g :: Integer
DSA.params_g = Integer
g, params_q :: Integer
DSA.params_q = Integer
q }
                 in forall a b. b -> Either a b
Right (Params -> Integer -> Integer -> KeyPair
DSA.KeyPair Params
params Integer
pub Integer
priv, [ASN1]
xs2)
            (Start ASN1ConstructionType
Sequence
             : OID [Integer
1, Integer
2, Integer
840, Integer
10040, Integer
4, Integer
1]
             : Start ASN1ConstructionType
Sequence
             : IntVal Integer
p
             : IntVal Integer
q
             : IntVal Integer
g
             : End ASN1ConstructionType
Sequence
             : End ASN1ConstructionType
Sequence
             : OctetString ByteString
bs
             : End ASN1ConstructionType
Sequence
             : [ASN1]
xs2) ->
                let params :: Params
params = DSA.Params { params_p :: Integer
DSA.params_p = Integer
p, params_g :: Integer
DSA.params_g = Integer
g, params_q :: Integer
DSA.params_q = Integer
q }
                 in case forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bs of
                        Right [IntVal Integer
priv] ->
                            let pub :: Integer
pub = Params -> Integer -> Integer
DSA.calculatePublic Params
params Integer
priv
                             in forall a b. b -> Either a b
Right (Params -> Integer -> Integer -> KeyPair
DSA.KeyPair Params
params Integer
pub Integer
priv, [ASN1]
xs2)
                        Right [ASN1]
_ -> forall a b. a -> Either a b
Left String
"dsaFromASN1: DSA.PrivateKey: unexpected format"
                        Left  ASN1Error
e -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"dsaFromASN1: DSA.PrivateKey: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASN1Error
e
            [ASN1]
_ ->
                forall a b. a -> Either a b
Left String
"dsaFromASN1: DSA.KeyPair: invalid format (version=0)"
dsaFromASN1 [ASN1]
_ = forall a b. a -> Either a b
Left String
"dsaFromASN1: DSA.KeyPair: unexpected format"

ecdsaFromASN1 :: [ASN1] -> [ASN1] -> Either String (X509.PrivKeyEC, [ASN1])
ecdsaFromASN1 :: [ASN1] -> [ASN1] -> Either String (PrivKeyEC, [ASN1])
ecdsaFromASN1 [ASN1]
curveOid1 (Start ASN1ConstructionType
Sequence
                         : IntVal Integer
1
                         : OctetString ByteString
ds
                         : [ASN1]
xs) = do
    let ([ASN1]
curveOid2, [ASN1]
ys) = ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag ASN1Tag
0 [ASN1]
xs
    PrivKeyEC
privKey <- Integer -> [ASN1] -> Either String PrivKeyEC
getPrivKeyEC (forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
ds) ([ASN1]
curveOid2 forall a. [a] -> [a] -> [a]
++ [ASN1]
curveOid1)
    case ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag ASN1Tag
1 [ASN1]
ys of
        ([ASN1]
_, End ASN1ConstructionType
Sequence : [ASN1]
zs) -> forall (m :: * -> *) a. Monad m => a -> m a
return (PrivKeyEC
privKey, [ASN1]
zs)
        ([ASN1], [ASN1])
_                      -> forall a b. a -> Either a b
Left String
"ecdsaFromASN1: unexpected EC format"
ecdsaFromASN1 [ASN1]
curveOid1 (Start ASN1ConstructionType
Sequence
                         : IntVal Integer
0
                         : Start ASN1ConstructionType
Sequence
                         : OID [Integer
1, Integer
2, Integer
840, Integer
10045, Integer
2, Integer
1]
                         : [ASN1]
xs) =
    let strError :: ASN1Error -> Either String b
strError = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (String
"ecdsaFromASN1: ECDSA.PrivateKey: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
        ([ASN1]
curveOid2, [ASN1]
ys) = ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd ASN1Tag
0 [ASN1]
xs
     in case [ASN1]
ys of
            (OctetString ByteString
bs
             : [ASN1]
zs) -> do
                let curveOids :: [ASN1]
curveOids = [ASN1]
curveOid2 forall a. [a] -> [a] -> [a]
++ [ASN1]
curveOid1
                    inner :: Either String (PrivKeyEC, [ASN1])
inner = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {b}. ASN1Error -> Either String b
strError ([ASN1] -> [ASN1] -> Either String (PrivKeyEC, [ASN1])
ecdsaFromASN1 [ASN1]
curveOids) (forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bs)
                forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (\(PrivKeyEC
k, [ASN1]
_) -> forall a b. b -> Either a b
Right (PrivKeyEC
k, [ASN1]
zs)) Either String (PrivKeyEC, [ASN1])
inner
            [ASN1]
_      -> forall a b. a -> Either a b
Left String
"ecdsaFromASN1: unexpected format"
ecdsaFromASN1 [ASN1]
_ [ASN1]
_ =
    forall a b. a -> Either a b
Left String
"ecdsaFromASN1: unexpected format"

getPrivKeyEC :: ECDSA.PrivateNumber -> [ASN1] -> Either String X509.PrivKeyEC
getPrivKeyEC :: Integer -> [ASN1] -> Either String PrivKeyEC
getPrivKeyEC Integer
_ []                 = forall a b. a -> Either a b
Left String
"ecdsaFromASN1: curve is missing"
getPrivKeyEC Integer
d (OID OID
curveOid : [ASN1]
_) =
    case OID -> Maybe CurveName
X509.lookupCurveNameByOID OID
curveOid of
        Just CurveName
name -> forall a b. b -> Either a b
Right X509.PrivKeyEC_Named { privkeyEC_name :: CurveName
X509.privkeyEC_name = CurveName
name
                                                , privkeyEC_priv :: Integer
X509.privkeyEC_priv = Integer
d
                                                }
        Maybe CurveName
Nothing   -> forall a b. a -> Either a b
Left (String
"ecdsaFromASN1: unknown curve " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show OID
curveOid)
getPrivKeyEC Integer
d (ASN1
Null : [ASN1]
xs)        = Integer -> [ASN1] -> Either String PrivKeyEC
getPrivKeyEC Integer
d [ASN1]
xs
getPrivKeyEC Integer
d (Start ASN1ConstructionType
Sequence
                : IntVal Integer
1
                : Start ASN1ConstructionType
Sequence
                : OID [Integer
1, Integer
2, Integer
840, Integer
10045, Integer
1, Integer
1]
                : IntVal Integer
prime
                : End ASN1ConstructionType
Sequence
                : Start ASN1ConstructionType
Sequence
                : OctetString ByteString
a
                : OctetString ByteString
b
                : BitString BitArray
seed
                : End ASN1ConstructionType
Sequence
                : OctetString ByteString
generator
                : IntVal Integer
order
                : IntVal Integer
cofactor
                : End ASN1ConstructionType
Sequence
                : [ASN1]
_)              =
    forall a b. b -> Either a b
Right X509.PrivKeyEC_Prime
              { privkeyEC_priv :: Integer
X509.privkeyEC_priv      = Integer
d
              , privkeyEC_a :: Integer
X509.privkeyEC_a         = forall ba. ByteArrayAccess ba => ba -> Integer
os2ip ByteString
a
              , privkeyEC_b :: Integer
X509.privkeyEC_b         = 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      = forall ba. ByteArrayAccess ba => ba -> Integer
os2ip forall a b. (a -> b) -> a -> b
$ BitArray -> ByteString
bitArrayGetData BitArray
seed
              }
getPrivKeyEC Integer
_ [ASN1]
_                  = forall a b. a -> Either a b
Left String
"ecdsaFromASN1: unexpected curve format"

containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag :: ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
containerWithTag ASN1Tag
etag (Start (Container ASN1Class
_ ASN1Tag
atag) : [ASN1]
xs)
    | ASN1Tag
etag forall a. Eq a => a -> a -> Bool
== ASN1Tag
atag = ASN1Tag -> [ASN1] -> ([ASN1], [ASN1])
getConstructedEnd ASN1Tag
0 [ASN1]
xs
containerWithTag ASN1Tag
_    [ASN1]
xs = ([], [ASN1]
xs)

rsaFromASN1 :: [ASN1] -> Either String (RSA.PrivateKey, [ASN1])
rsaFromASN1 :: [ASN1] -> Either String (PrivateKey, [ASN1])
rsaFromASN1 (Start ASN1ConstructionType
Sequence
             : IntVal Integer
0
             : IntVal Integer
n
             : IntVal Integer
e
             : IntVal Integer
d
             : IntVal Integer
p1
             : IntVal Integer
p2
             : IntVal Integer
pexp1
             : IntVal Integer
pexp2
             : IntVal Integer
pcoef
             : End ASN1ConstructionType
Sequence
             : [ASN1]
xs) = forall a b. b -> Either a b
Right (PrivateKey
privKey, [ASN1]
xs)
  where
    pubKey :: PublicKey
pubKey  = RSA.PublicKey { public_size :: ASN1Tag
RSA.public_size = Integer -> ASN1Tag
numBytes Integer
n
                            , public_n :: Integer
RSA.public_n    = Integer
n
                            , public_e :: Integer
RSA.public_e    = Integer
e
                            }
    privKey :: PrivateKey
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
                             }

rsaFromASN1 ( Start ASN1ConstructionType
Sequence
             : IntVal Integer
0
             : Start ASN1ConstructionType
Sequence
             : OID [Integer
1, Integer
2, Integer
840, Integer
113549, Integer
1, Integer
1, Integer
1]
             : ASN1
Null
             : End ASN1ConstructionType
Sequence
             : OctetString ByteString
bs
             : [ASN1]
xs) =
    let inner :: Either String (PrivateKey, [ASN1])
inner = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall {b}. ASN1Error -> Either String b
strError [ASN1] -> Either String (PrivateKey, [ASN1])
rsaFromASN1 forall a b. (a -> b) -> a -> b
$ forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER ByteString
bs
        strError :: ASN1Error -> Either String b
strError = forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
.  (String
"rsaFromASN1: RSA.PrivateKey: " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
     in forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (\(PrivateKey
k, [ASN1]
_) -> forall a b. b -> Either a b
Right (PrivateKey
k, [ASN1]
xs)) Either String (PrivateKey, [ASN1])
inner
rsaFromASN1 [ASN1]
_ =
    forall a b. a -> Either a b
Left String
"rsaFromASN1: unexpected format"