module Network.PeyoTLS.Codec.Certificate (
CertReq(..), certReq, ClCertType(..), ClKeyEx(..), DigitSigned(..)) where
import Control.Applicative ((<$>), (<*>))
import Data.Word (Word8, Word16)
import Data.Word.Word24 (Word24)
import qualified Data.ByteString as BS
import qualified Data.ASN1.Types as ASN1
import qualified Data.ASN1.Encoding as ASN1
import qualified Data.ASN1.BinaryEncoding as ASN1
import qualified Data.X509 as X509
import qualified Data.X509.CertificateStore as X509
import qualified Codec.Bytable.BigEndian as B
import Network.PeyoTLS.Codec.HSAlg (HashAlg, SignAlg)
modNm :: String
modNm = "Network.PeyoTLS.Codec.Certificate"
instance B.Bytable X509.CertificateChain where
decode = B.evalBytableM B.parse
encode = B.addLen w24 . cmap (B.addLen w24)
. (\(X509.CertificateChainRaw c) -> c) . X509.encodeCertificateChain
. (\(X509.CertificateChain cs) -> X509.CertificateChain cs)
instance B.Parsable X509.CertificateChain where
parse = X509.decodeCertificateChain . X509.CertificateChainRaw <$>
(flip B.list (B.take =<< B.take 3) =<< B.take 3) >>= \ecc ->
case ecc of
Right (X509.CertificateChain cs) ->
return $ X509.CertificateChain cs
Left (n, em) -> fail $ modNm ++ ": " ++
"X509.CertificateChain.parse" ++ show n ++ " " ++ em
data CertReq = CertReq [ClCertType] [(HashAlg, SignAlg)] [X509.DistinguishedName]
deriving Show
certReq :: [ClCertType] -> [(HashAlg, SignAlg)] -> X509.CertificateStore -> CertReq
certReq t a = CertReq t a
. map (X509.certIssuerDN . X509.signedObject . X509.getSigned)
. X509.listCertificates
instance B.Bytable CertReq where
encode (CertReq t a n) = BS.concat [
B.addLen w8 $ cmap B.encode t,
B.addLen w16 $
cmap (\(h, s) -> B.encode h `BS.append` B.encode s) a,
B.addLen w16 . flip cmap n $ B.addLen w16 .
ASN1.encodeASN1' ASN1.DER . flip ASN1.toASN1 [] ]
decode = B.evalBytableM $ CertReq
<$> (flip B.list (B.take 1) =<< B.take 1)
<*> (flip B.list ((,) <$> B.take 1 <*> B.take 1) =<< B.take 2)
<*> ((B.take 2 >>=) . flip B.list $
either (fail . show) (return . fst) . ASN1.fromASN1 =<<
either (fail . show) return . ASN1.decodeASN1' ASN1.DER =<<
B.take =<< B.take 2)
data ClCertType = CTRsaSign | CTEcdsaSign | CertTypeRaw Word8 deriving (Show, Eq)
instance B.Bytable ClCertType where
encode CTRsaSign = "\x01"
encode CTEcdsaSign = "\x40"
encode (CertTypeRaw w) = BS.pack [w]
decode bs = case BS.unpack bs of
[w] -> Right $ case w of
1 -> CTRsaSign; 64 -> CTEcdsaSign; _ -> CertTypeRaw w
_ -> Left $ modNm ++ ": ClCertType.decode"
data ClKeyEx = ClKeyEx BS.ByteString deriving Show
instance B.Bytable ClKeyEx where decode = Right . ClKeyEx; encode (ClKeyEx e) = e
data DigitSigned
= DigitSigned (HashAlg, SignAlg) BS.ByteString
| DigitSignedRaw BS.ByteString
deriving Show
instance B.Bytable DigitSigned where
decode = B.evalBytableM $ DigitSigned
<$> ((,) <$> B.take 1 <*> B.take 1) <*> (B.take =<< B.take 2)
encode (DigitSigned (ha, sa) bs) = BS.concat
[B.encode ha, B.encode sa, B.addLen w16 bs]
encode (DigitSignedRaw bs) = bs
cmap :: (a -> BS.ByteString) -> [a] -> BS.ByteString
cmap = (BS.concat .) . map
w8 :: Word8; w8 = undefined
w16 :: Word16; w16 = undefined
w24 :: Word24; w24 = undefined