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