-- |
-- Module      : Data.X509.CertificateChain
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
module Data.X509.CertificateChain
    ( CertificateChain(..)
    , CertificateChainRaw(..)
    -- * marshall between CertificateChain and CertificateChainRaw
    , decodeCertificateChain
    , encodeCertificateChain
    ) where

import Data.X509.Cert (Certificate)
import Data.X509.Signed (SignedExact, decodeSignedObject, encodeSignedObject)
import Data.ByteString (ByteString)

-- | A chain of X.509 certificates in exact form.
newtype CertificateChain = CertificateChain [SignedExact Certificate]
    deriving (Int -> CertificateChain -> ShowS
[CertificateChain] -> ShowS
CertificateChain -> String
(Int -> CertificateChain -> ShowS)
-> (CertificateChain -> String)
-> ([CertificateChain] -> ShowS)
-> Show CertificateChain
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
(CertificateChain -> CertificateChain -> Bool)
-> (CertificateChain -> CertificateChain -> Bool)
-> Eq CertificateChain
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)

-- | Represent a chain of X.509 certificates in bytestring form.
newtype CertificateChainRaw = CertificateChainRaw [ByteString]
    deriving (Int -> CertificateChainRaw -> ShowS
[CertificateChainRaw] -> ShowS
CertificateChainRaw -> String
(Int -> CertificateChainRaw -> ShowS)
-> (CertificateChainRaw -> String)
-> ([CertificateChainRaw] -> ShowS)
-> Show CertificateChainRaw
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
(CertificateChainRaw -> CertificateChainRaw -> Bool)
-> (CertificateChainRaw -> CertificateChainRaw -> Bool)
-> Eq CertificateChainRaw
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)

-- | Decode a CertificateChainRaw into a CertificateChain if every
-- raw certificate are decoded correctly, otherwise return the index of the
-- failed certificate and the error associated.
decodeCertificateChain :: CertificateChainRaw -> Either (Int, String) CertificateChain
decodeCertificateChain :: CertificateChainRaw -> Either (Int, String) CertificateChain
decodeCertificateChain (CertificateChainRaw [ByteString]
l) =
    ((Int, String) -> Either (Int, String) CertificateChain)
-> ([SignedExact Certificate]
    -> Either (Int, String) CertificateChain)
-> Either (Int, String) [SignedExact Certificate]
-> Either (Int, String) CertificateChain
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int, String) -> Either (Int, String) CertificateChain
forall a b. a -> Either a b
Left (CertificateChain -> Either (Int, String) CertificateChain
forall a b. b -> Either a b
Right (CertificateChain -> Either (Int, String) CertificateChain)
-> ([SignedExact Certificate] -> CertificateChain)
-> [SignedExact Certificate]
-> Either (Int, String) CertificateChain
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SignedExact Certificate] -> CertificateChain
CertificateChain) (Either (Int, String) [SignedExact Certificate]
 -> Either (Int, String) CertificateChain)
-> Either (Int, String) [SignedExact Certificate]
-> Either (Int, String) CertificateChain
forall a b. (a -> b) -> a -> b
$ Int
-> [ByteString] -> Either (Int, String) [SignedExact Certificate]
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
_ []     = [SignedExact a] -> Either (t, String) [SignedExact a]
forall a b. b -> Either a b
Right []
        loop t
i (ByteString
r:[ByteString]
rs) = case ByteString -> Either String (SignedExact a)
forall a.
(Show a, Eq a, ASN1Object a) =>
ByteString -> Either String (SignedExact a)
decodeSignedObject ByteString
r of
                         Left String
err -> (t, String) -> Either (t, String) [SignedExact a]
forall a b. a -> Either a b
Left (t
i, String
err)
                         Right SignedExact a
o  -> ((t, String) -> Either (t, String) [SignedExact a])
-> ([SignedExact a] -> Either (t, String) [SignedExact a])
-> Either (t, String) [SignedExact a]
-> Either (t, String) [SignedExact a]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (t, String) -> Either (t, String) [SignedExact a]
forall a b. a -> Either a b
Left ([SignedExact a] -> Either (t, String) [SignedExact a]
forall a b. b -> Either a b
Right ([SignedExact a] -> Either (t, String) [SignedExact a])
-> ([SignedExact a] -> [SignedExact a])
-> [SignedExact a]
-> Either (t, String) [SignedExact a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SignedExact a
o SignedExact a -> [SignedExact a] -> [SignedExact a]
forall a. a -> [a] -> [a]
:)) (Either (t, String) [SignedExact a]
 -> Either (t, String) [SignedExact a])
-> Either (t, String) [SignedExact a]
-> Either (t, String) [SignedExact a]
forall a b. (a -> b) -> a -> b
$ t -> [ByteString] -> Either (t, String) [SignedExact a]
loop (t
it -> t -> t
forall a. Num a => a -> a -> a
+t
1) [ByteString]
rs

-- | Convert a CertificateChain into a CertificateChainRaw
encodeCertificateChain :: CertificateChain -> CertificateChainRaw
encodeCertificateChain :: CertificateChain -> CertificateChainRaw
encodeCertificateChain (CertificateChain [SignedExact Certificate]
chain) =
    [ByteString] -> CertificateChainRaw
CertificateChainRaw ([ByteString] -> CertificateChainRaw)
-> [ByteString] -> CertificateChainRaw
forall a b. (a -> b) -> a -> b
$ (SignedExact Certificate -> ByteString)
-> [SignedExact Certificate] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map SignedExact Certificate -> ByteString
forall a.
(Show a, Eq a, ASN1Object a) =>
SignedExact a -> ByteString
encodeSignedObject [SignedExact Certificate]
chain