module Data.X509.CertificateChain
( CertificateChain(..)
, CertificateChainRaw(..)
, decodeCertificateChain
, encodeCertificateChain
) where
import Data.X509.Cert (Certificate)
import Data.X509.Signed (SignedExact, decodeSignedObject, encodeSignedObject)
import Data.ByteString (ByteString)
newtype CertificateChain = CertificateChain [SignedExact Certificate]
deriving (Int -> CertificateChain -> ShowS
[CertificateChain] -> ShowS
CertificateChain -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertificateChain] -> ShowS
$cshowList :: [CertificateChain] -> ShowS
show :: CertificateChain -> String
$cshow :: CertificateChain -> String
showsPrec :: Int -> CertificateChain -> ShowS
$cshowsPrec :: Int -> CertificateChain -> ShowS
Show,CertificateChain -> CertificateChain -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertificateChain -> CertificateChain -> Bool
$c/= :: CertificateChain -> CertificateChain -> Bool
== :: CertificateChain -> CertificateChain -> Bool
$c== :: CertificateChain -> CertificateChain -> Bool
Eq)
newtype CertificateChainRaw = CertificateChainRaw [ByteString]
deriving (Int -> CertificateChainRaw -> ShowS
[CertificateChainRaw] -> ShowS
CertificateChainRaw -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CertificateChainRaw] -> ShowS
$cshowList :: [CertificateChainRaw] -> ShowS
show :: CertificateChainRaw -> String
$cshow :: CertificateChainRaw -> String
showsPrec :: Int -> CertificateChainRaw -> ShowS
$cshowsPrec :: Int -> CertificateChainRaw -> ShowS
Show,CertificateChainRaw -> CertificateChainRaw -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CertificateChainRaw -> CertificateChainRaw -> Bool
$c/= :: CertificateChainRaw -> CertificateChainRaw -> Bool
== :: CertificateChainRaw -> CertificateChainRaw -> Bool
$c== :: CertificateChainRaw -> CertificateChainRaw -> Bool
Eq)
decodeCertificateChain :: CertificateChainRaw -> Either (Int, String) CertificateChain
decodeCertificateChain :: CertificateChainRaw -> Either (Int, String) CertificateChain
decodeCertificateChain (CertificateChainRaw [ByteString]
l) =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SignedExact Certificate] -> CertificateChain
CertificateChain) forall a b. (a -> b) -> a -> b
$ forall {a} {t}.
(Show a, Eq a, ASN1Object a, Num t) =>
t -> [ByteString] -> Either (t, String) [SignedExact a]
loop Int
0 [ByteString]
l
where loop :: t -> [ByteString] -> Either (t, String) [SignedExact a]
loop t
_ [] = forall a b. b -> Either a b
Right []
loop t
i (ByteString
r:[ByteString]
rs) = case forall a.
(Show a, Eq a, ASN1Object a) =>
ByteString -> Either String (SignedExact a)
decodeSignedObject ByteString
r of
Left String
err -> forall a b. a -> Either a b
Left (t
i, String
err)
Right SignedExact a
o -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a b. a -> Either a b
Left (forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignedExact a
o forall a. a -> [a] -> [a]
:)) forall a b. (a -> b) -> a -> b
$ t -> [ByteString] -> Either (t, String) [SignedExact a]
loop (t
iforall a. Num a => a -> a -> a
+t
1) [ByteString]
rs
encodeCertificateChain :: CertificateChain -> CertificateChainRaw
encodeCertificateChain :: CertificateChain -> CertificateChainRaw
encodeCertificateChain (CertificateChain [SignedExact Certificate]
chain) =
[ByteString] -> CertificateChainRaw
CertificateChainRaw forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
encodeSignedObject [SignedExact Certificate]
chain