module Data.Certificate.X509.Ext
( ExtensionRaw
, Extension(..)
, ExtBasicConstraints(..)
, ExtKeyUsage(..)
, ExtKeyUsageFlag(..)
, ExtSubjectKeyId(..)
, ExtSubjectAltName(..)
, ExtAuthorityKeyId(..)
, extensionGet
) where
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import qualified Data.ByteString.Lazy as L
import Data.ASN1.Types
import Data.ASN1.Stream
import Data.ASN1.BitArray
import Data.Certificate.X509.Internal
type ExtensionRaw = (OID, Bool, [ASN1])
data ExtKeyUsageFlag =
KeyUsage_digitalSignature
| KeyUsage_nonRepudiation
| KeyUsage_keyEncipherment
| KeyUsage_dataEncipherment
| KeyUsage_keyAgreement
| KeyUsage_keyCertSign
| KeyUsage_cRLSign
| KeyUsage_encipherOnly
| KeyUsage_decipherOnly
deriving (Show,Eq,Ord,Enum)
class Extension a where
extOID :: a -> OID
extEncode :: a -> [ASN1]
extDecode :: [ASN1] -> Either String a
extensionGet :: Extension a => [ExtensionRaw] -> Maybe a
extensionGet [] = Nothing
extensionGet ((oid,_,asn1):xs) = case extDecode asn1 of
Right b
| oid == extOID b -> Just b
| otherwise -> extensionGet xs
Left _ -> extensionGet xs
data ExtBasicConstraints = ExtBasicConstraints Bool (Maybe Integer)
deriving (Show,Eq)
instance Extension ExtBasicConstraints where
extOID = const [2,5,29,19]
extEncode (ExtBasicConstraints b Nothing) = [Start Sequence,Boolean b,End Sequence]
extEncode (ExtBasicConstraints b (Just i)) = [Start Sequence,Boolean b,IntVal i,End Sequence]
extDecode [Start Sequence,Boolean b,IntVal v,End Sequence]
| v >= 0 = Right (ExtBasicConstraints b (Just v))
| otherwise = Left "invalid pathlen"
extDecode [Start Sequence,Boolean b,End Sequence] = Right (ExtBasicConstraints b Nothing)
extDecode [Start Sequence,End Sequence] = Right (ExtBasicConstraints False Nothing)
extDecode _ = Left "unknown sequence"
data ExtKeyUsage = ExtKeyUsage [ExtKeyUsageFlag]
deriving (Show,Eq)
instance Extension ExtKeyUsage where
extOID = const [2,5,29,15]
extEncode (ExtKeyUsage flags) = [BitString $ flagsToBits flags]
extDecode [BitString bits] = Right $ ExtKeyUsage $ bitsToFlags bits
extDecode _ = Left "unknown sequence"
data ExtSubjectKeyId = ExtSubjectKeyId L.ByteString
deriving (Show,Eq)
instance Extension ExtSubjectKeyId where
extOID = const [2,5,29,14]
extEncode (ExtSubjectKeyId o) = [OctetString o]
extDecode [OctetString o] = Right $ ExtSubjectKeyId o
extDecode _ = Left "unknown sequence"
data ExtSubjectAltName = ExtSubjectAltName [String]
deriving (Show,Eq)
instance Extension ExtSubjectAltName where
extOID = const [2,5,29,17]
extEncode (ExtSubjectAltName names) =
[Start Sequence]
++ map (Other Context 2 . BC.pack) names
++ [End Sequence]
extDecode l = runParseASN1 parse l where
parse = do
c <- getNextContainer Sequence
return $ ExtSubjectAltName $ map toStringy c
toStringy (Other Context 2 b) = BC.unpack b
toStringy b = error ("not coping with anything else " ++ show b)
data ExtAuthorityKeyId = ExtAuthorityKeyId B.ByteString
deriving (Show,Eq)
instance Extension ExtAuthorityKeyId where
extOID _ = [2,5,29,35]
extEncode (ExtAuthorityKeyId keyid) =
[Start Sequence,Other Context 0 keyid,End Sequence]
extDecode [Start Sequence,Other Context 0 keyid,End Sequence] =
Right $ ExtAuthorityKeyId keyid
extDecode _ = Left "unknown sequence"
bitsToFlags :: Enum a => BitArray -> [a]
bitsToFlags bits = concat $ flip map [0..(bitArrayLength bits1)] $ \i -> do
let isSet = bitArrayGetBit bits i
if isSet then [toEnum $ fromIntegral i] else []
flagsToBits :: Enum a => [a] -> BitArray
flagsToBits flags = foldl bitArraySetBit bitArrayEmpty $ map (fromIntegral . fromEnum) flags
where bitArrayEmpty = BitArray 2 (L.pack [0,0])