1-- | 2-- Module : Data.X509.Signed 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- Exposes helpers for X509 certificate and revocation list, signed structures. 9-- 10-- Signed structures are of the form: 11-- Sequence { 12-- object a 13-- signatureAlgorithm AlgorithmIdentifier 14-- signatureValue BitString 15-- } 16-- 17-- Unfortunately as lots of signed objects published have been signed on an 18-- arbitrary BER ASN1 encoding (instead of using the unique DER encoding) or in 19-- a non-valid DER implementation, we need to keep the raw data being signed, 20-- as we can't recompute the bytestring used to sign for non compliant cases. 21-- 22-- Signed represent the pure data type for compliant cases, and SignedExact 23-- the real world situation of having to deal with compliant and non-compliant cases. 24-- 25module Data.X509.Signed 26 ( 27 -- * Types 28 Signed(..) 29 , SignedExact 30 -- * SignedExact to Signed 31 , getSigned 32 , getSignedData 33 -- * Marshalling function 34 , encodeSignedObject 35 , decodeSignedObject 36 -- * Object to Signed and SignedExact 37 , objectToSignedExact 38 , objectToSignedExactF 39 , objectToSigned 40 , signedToExact 41 ) where 42 43import Control.Arrow (first) 44import Data.ByteString (ByteString) 45import qualified Data.ByteString as B 46import Data.X509.AlgorithmIdentifier 47import Data.ASN1.Types 48import Data.ASN1.Encoding 49import Data.ASN1.BinaryEncoding 50import Data.ASN1.Stream 51import Data.ASN1.BitArray 52import qualified Data.ASN1.BinaryEncoding.Raw as Raw (toByteString) 53 54-- | Represent a signed object using a traditional X509 structure. 55-- 56-- When dealing with external certificate, use the SignedExact structure 57-- not this one. 58data (Show a, Eq a, ASN1Object a) => Signed a = Signed 59 { signedObject :: a -- ^ Object to sign 60 , signedAlg :: SignatureALG -- ^ Signature Algorithm used 61 , signedSignature :: B.ByteString -- ^ Signature as bytes 62 } deriving (Show, Eq) 63 64-- | Represent the signed object plus the raw data that we need to 65-- keep around for non compliant case to be able to verify signature. 66data (Show a, Eq a, ASN1Object a) => SignedExact a = SignedExact 67 { getSigned :: Signed a -- ^ get the decoded Signed data 68 , exactObjectRaw :: B.ByteString -- ^ The raw representation of the object a 69 -- TODO: in later version, replace with offset in exactRaw 70 , encodeSignedObject :: B.ByteString -- ^ The raw representation of the whole signed structure 71 } deriving (Show, Eq) 72 73-- | Get the signed data for the signature 74getSignedData :: (Show a, Eq a, ASN1Object a) 75 => SignedExact a 76 -> B.ByteString 77getSignedData = exactObjectRaw 78 79-- | make a 'SignedExact' copy of a 'Signed' object 80-- 81-- As the signature is already generated, expect the 82-- encoded object to have been made on a compliant DER ASN1 implementation. 83-- 84-- It's better to use 'objectToSignedExact' instead of this. 85signedToExact :: (Show a, Eq a, ASN1Object a) 86 => Signed a 87 -> SignedExact a 88signedToExact signed = sExact 89 where (sExact, ()) = objectToSignedExact fakeSigFunction (signedObject signed) 90 fakeSigFunction _ = (signedSignature signed, signedAlg signed, ()) 91 92-- | Transform an object into a 'SignedExact' object 93objectToSignedExact :: (Show a, Eq a, ASN1Object a) 94 => (ByteString -> (ByteString, SignatureALG, r)) -- ^ signature function 95 -> a -- ^ object to sign 96 -> (SignedExact a, r) 97objectToSignedExact signatureFunction object = (signedExact, val) 98 where 99 (val, signedExact) = objectToSignedExactF (wrap . signatureFunction) object 100 wrap (b, s, r) = (r, (b, s)) 101 102-- | A generalization of 'objectToSignedExact' where the signature function 103-- runs in an arbitrary functor. This allows for example to sign using an 104-- algorithm needing random values. 105objectToSignedExactF :: (Functor f, Show a, Eq a, ASN1Object a) 106 => (ByteString -> f (ByteString, SignatureALG)) -- ^ signature function 107 -> a -- ^ object to sign 108 -> f (SignedExact a) 109objectToSignedExactF signatureFunction object = fmap buildSignedExact (signatureFunction objRaw) 110 where buildSignedExact (sigBits,sigAlg) = 111 let signed = Signed { signedObject = object 112 , signedAlg = sigAlg 113 , signedSignature = sigBits 114 } 115 signedRaw = encodeASN1' DER signedASN1 116 signedASN1 = Start Sequence 117 : objASN1 118 (toASN1 sigAlg 119 (BitString (toBitArray sigBits 0) 120 : End Sequence 121 : [])) 122 in SignedExact signed objRaw signedRaw 123 objASN1 = \xs -> Start Sequence : toASN1 object (End Sequence : xs) 124 objRaw = encodeASN1' DER (objASN1 []) 125 126-- | Transform an object into a 'Signed' object. 127-- 128-- It's recommended to use the SignedExact object instead of Signed. 129objectToSigned :: (Show a, Eq a, ASN1Object a) 130 => (ByteString 131 -> (ByteString, SignatureALG, r)) 132 -> a 133 -> (Signed a, r) 134objectToSigned signatureFunction object = first getSigned $ objectToSignedExact signatureFunction object 135 136-- | Try to parse a bytestring that use the typical X509 signed structure format 137decodeSignedObject :: (Show a, Eq a, ASN1Object a) 138 => ByteString 139 -> Either String (SignedExact a) 140decodeSignedObject b = either (Left . show) parseSigned $ decodeASN1Repr' BER b 141 where -- the following implementation is very inefficient. 142 -- uses reverse and containing, move to a better solution eventually 143 parseSigned l = onContainer (fst $ getConstructedEndRepr l) $ \l2 -> 144 let (objRepr,rem1) = getConstructedEndRepr l2 145 (sigAlgSeq,rem2) = getConstructedEndRepr rem1 146 (sigSeq,_) = getConstructedEndRepr rem2 147 obj = onContainer objRepr (either Left Right . fromASN1 . map fst) 148 in case (obj, map fst sigSeq) of 149 (Right (o,[]), [BitString signature]) -> 150 let rawObj = Raw.toByteString $ concatMap snd objRepr 151 in case fromASN1 $ map fst sigAlgSeq of 152 Left s -> Left ("signed object error sigalg: " ++ s) 153 Right (sigAlg,_) -> 154 let signed = Signed 155 { signedObject = o 156 , signedAlg = sigAlg 157 , signedSignature = bitArrayGetData signature 158 } 159 in Right $ SignedExact 160 { getSigned = signed 161 , exactObjectRaw = rawObj 162 , encodeSignedObject = b 163 } 164 (Right (_,remObj), _) -> 165 Left $ ("signed object error: remaining stream in object: " ++ show remObj) 166 (Left err, _) -> Left $ ("signed object error: " ++ show err) 167 onContainer ((Start _, _) : l) f = 168 case reverse l of 169 ((End _, _) : l2) -> f $ reverse l2 170 _ -> f [] 171 onContainer _ f = f [] 172