-- |
-- Module      : Data.X509.Ext
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- extension processing module.
--
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Data.X509.Ext
    ( Extension(..)
    -- * Common extension usually found in x509v3
    , ExtBasicConstraints(..)
    , ExtKeyUsage(..)
    , ExtKeyUsageFlag(..)
    , ExtExtendedKeyUsage(..)
    , ExtKeyUsagePurpose(..)
    , ExtSubjectKeyId(..)
    , ExtSubjectAltName(..)
    , ExtAuthorityKeyId(..)
    , ExtCrlDistributionPoints(..)
    , ExtNetscapeComment(..)
    , AltName(..)
    , DistributionPoint(..)
    , ReasonFlag(..)
    -- * Accessor turning extension into a specific one
    , extensionGet
    , extensionGetE
    , extensionDecode
    , extensionEncode
    ) where

import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import Data.ASN1.Types
import Data.ASN1.Parse
import Data.ASN1.Encoding
import Data.ASN1.BinaryEncoding
import Data.ASN1.BitArray
import Data.Proxy
import Data.List (find)
import Data.X509.ExtensionRaw
import Data.X509.DistinguishedName
import Control.Applicative
import Control.Monad

-- | key usage flag that is found in the key usage extension field.
data ExtKeyUsageFlag =
      KeyUsage_digitalSignature -- (0)
    | KeyUsage_nonRepudiation   -- (1) recent X.509 ver have renamed this bit to contentCommitment
    | KeyUsage_keyEncipherment  -- (2)
    | KeyUsage_dataEncipherment -- (3)
    | KeyUsage_keyAgreement     -- (4)
    | KeyUsage_keyCertSign      -- (5)
    | KeyUsage_cRLSign          -- (6)
    | KeyUsage_encipherOnly     -- (7)
    | KeyUsage_decipherOnly     -- (8)
    deriving (Int -> ExtKeyUsageFlag -> ShowS
[ExtKeyUsageFlag] -> ShowS
ExtKeyUsageFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtKeyUsageFlag] -> ShowS
$cshowList :: [ExtKeyUsageFlag] -> ShowS
show :: ExtKeyUsageFlag -> String
$cshow :: ExtKeyUsageFlag -> String
showsPrec :: Int -> ExtKeyUsageFlag -> ShowS
$cshowsPrec :: Int -> ExtKeyUsageFlag -> ShowS
Show,ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
$c/= :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
== :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
$c== :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
Eq,Eq ExtKeyUsageFlag
ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
ExtKeyUsageFlag -> ExtKeyUsageFlag -> Ordering
ExtKeyUsageFlag -> ExtKeyUsageFlag -> ExtKeyUsageFlag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> ExtKeyUsageFlag
$cmin :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> ExtKeyUsageFlag
max :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> ExtKeyUsageFlag
$cmax :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> ExtKeyUsageFlag
>= :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
$c>= :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
> :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
$c> :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
<= :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
$c<= :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
< :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
$c< :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Bool
compare :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Ordering
$ccompare :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> Ordering
Ord,Int -> ExtKeyUsageFlag
ExtKeyUsageFlag -> Int
ExtKeyUsageFlag -> [ExtKeyUsageFlag]
ExtKeyUsageFlag -> ExtKeyUsageFlag
ExtKeyUsageFlag -> ExtKeyUsageFlag -> [ExtKeyUsageFlag]
ExtKeyUsageFlag
-> ExtKeyUsageFlag -> ExtKeyUsageFlag -> [ExtKeyUsageFlag]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ExtKeyUsageFlag
-> ExtKeyUsageFlag -> ExtKeyUsageFlag -> [ExtKeyUsageFlag]
$cenumFromThenTo :: ExtKeyUsageFlag
-> ExtKeyUsageFlag -> ExtKeyUsageFlag -> [ExtKeyUsageFlag]
enumFromTo :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> [ExtKeyUsageFlag]
$cenumFromTo :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> [ExtKeyUsageFlag]
enumFromThen :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> [ExtKeyUsageFlag]
$cenumFromThen :: ExtKeyUsageFlag -> ExtKeyUsageFlag -> [ExtKeyUsageFlag]
enumFrom :: ExtKeyUsageFlag -> [ExtKeyUsageFlag]
$cenumFrom :: ExtKeyUsageFlag -> [ExtKeyUsageFlag]
fromEnum :: ExtKeyUsageFlag -> Int
$cfromEnum :: ExtKeyUsageFlag -> Int
toEnum :: Int -> ExtKeyUsageFlag
$ctoEnum :: Int -> ExtKeyUsageFlag
pred :: ExtKeyUsageFlag -> ExtKeyUsageFlag
$cpred :: ExtKeyUsageFlag -> ExtKeyUsageFlag
succ :: ExtKeyUsageFlag -> ExtKeyUsageFlag
$csucc :: ExtKeyUsageFlag -> ExtKeyUsageFlag
Enum)

{-
-- RFC 5280
oidDistributionPoints, oidPolicies, oidPoliciesMapping :: OID
oidPolicies           = [2,5,29,32]
oidPoliciesMapping    = [2,5,29,33]
-}

-- | Extension class.
--
-- each extension have a unique OID associated, and a way
-- to encode and decode an ASN1 stream.
--
-- Errata: turns out, the content is not necessarily ASN1,
-- it could be data that is only parsable by the extension
-- e.g. raw ascii string. Add method to parse and encode with
-- ByteString
class Extension a where
    extOID           :: a -> OID
    extHasNestedASN1 :: Proxy a -> Bool
    extEncode        :: a -> [ASN1]
    extDecode        :: [ASN1] -> Either String a

    extDecodeBs :: B.ByteString -> Either String a
    extDecodeBs = (forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ASN1Decoding a =>
a -> ByteString -> Either ASN1Error [ASN1]
decodeASN1' BER
BER) forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a. Extension a => [ASN1] -> Either String a
extDecode

    extEncodeBs :: a -> B.ByteString
    extEncodeBs = forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Extension a => a -> [ASN1]
extEncode


-- | Get a specific extension from a lists of raw extensions
extensionGet :: Extension a => Extensions -> Maybe a
extensionGet :: forall a. Extension a => Extensions -> Maybe a
extensionGet (Extensions Maybe [ExtensionRaw]
Nothing)  = forall a. Maybe a
Nothing
extensionGet (Extensions (Just [ExtensionRaw]
l)) = forall {a}. Extension a => [ExtensionRaw] -> Maybe a
findExt [ExtensionRaw]
l
  where findExt :: [ExtensionRaw] -> Maybe a
findExt []     = forall a. Maybe a
Nothing
        findExt (ExtensionRaw
x:[ExtensionRaw]
xs) = case forall a. Extension a => ExtensionRaw -> Maybe (Either String a)
extensionDecode ExtensionRaw
x of
                            Just (Right a
e) -> forall a. a -> Maybe a
Just a
e
                            Maybe (Either String a)
_              -> [ExtensionRaw] -> Maybe a
findExt [ExtensionRaw]
xs

-- | Get a specific extension from a lists of raw extensions
extensionGetE :: Extension a => Extensions -> Maybe (Either String a)
extensionGetE :: forall a. Extension a => Extensions -> Maybe (Either String a)
extensionGetE (Extensions Maybe [ExtensionRaw]
Nothing)  = forall a. Maybe a
Nothing
extensionGetE (Extensions (Just [ExtensionRaw]
l)) = forall {a}.
Extension a =>
[ExtensionRaw] -> Maybe (Either String a)
findExt [ExtensionRaw]
l
  where findExt :: [ExtensionRaw] -> Maybe (Either String a)
findExt []     = forall a. Maybe a
Nothing
        findExt (ExtensionRaw
x:[ExtensionRaw]
xs) = case forall a. Extension a => ExtensionRaw -> Maybe (Either String a)
extensionDecode ExtensionRaw
x of
                            Just Either String a
r         -> forall a. a -> Maybe a
Just Either String a
r
                            Maybe (Either String a)
_              -> [ExtensionRaw] -> Maybe (Either String a)
findExt [ExtensionRaw]
xs

-- | Try to decode an ExtensionRaw.
--
-- If this function return:
-- * Nothing, the OID doesn't match
-- * Just Left, the OID matched, but the extension couldn't be decoded
-- * Just Right, the OID matched, and the extension has been succesfully decoded
extensionDecode :: forall a . Extension a => ExtensionRaw -> Maybe (Either String a)
extensionDecode :: forall a. Extension a => ExtensionRaw -> Maybe (Either String a)
extensionDecode er :: ExtensionRaw
er@(ExtensionRaw OID
oid Bool
_ ByteString
content)
    | forall a. Extension a => a -> OID
extOID (forall a. HasCallStack => a
undefined :: a) forall a. Eq a => a -> a -> Bool
/= OID
oid      = forall a. Maybe a
Nothing
    | forall a. Extension a => Proxy a -> Bool
extHasNestedASN1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) = forall a. a -> Maybe a
Just (ExtensionRaw -> Either String [ASN1]
tryExtRawASN1 ExtensionRaw
er forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Extension a => [ASN1] -> Either String a
extDecode)
    | Bool
otherwise                           = forall a. a -> Maybe a
Just (forall a. Extension a => ByteString -> Either String a
extDecodeBs ByteString
content)

-- | Encode an Extension to extensionRaw
extensionEncode :: forall a . Extension a => Bool -> a -> ExtensionRaw
extensionEncode :: forall a. Extension a => Bool -> a -> ExtensionRaw
extensionEncode Bool
critical a
ext
    | forall a. Extension a => Proxy a -> Bool
extHasNestedASN1 (forall {k} (t :: k). Proxy t
Proxy :: Proxy a) = OID -> Bool -> ByteString -> ExtensionRaw
ExtensionRaw (forall a. Extension a => a -> OID
extOID a
ext) Bool
critical (forall a. ASN1Encoding a => a -> [ASN1] -> ByteString
encodeASN1' DER
DER forall a b. (a -> b) -> a -> b
$ forall a. Extension a => a -> [ASN1]
extEncode a
ext)
    | Bool
otherwise                           = OID -> Bool -> ByteString -> ExtensionRaw
ExtensionRaw (forall a. Extension a => a -> OID
extOID a
ext) Bool
critical (forall a. Extension a => a -> ByteString
extEncodeBs a
ext)

-- | Basic Constraints
data ExtBasicConstraints = ExtBasicConstraints Bool (Maybe Integer)
    deriving (Int -> ExtBasicConstraints -> ShowS
[ExtBasicConstraints] -> ShowS
ExtBasicConstraints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtBasicConstraints] -> ShowS
$cshowList :: [ExtBasicConstraints] -> ShowS
show :: ExtBasicConstraints -> String
$cshow :: ExtBasicConstraints -> String
showsPrec :: Int -> ExtBasicConstraints -> ShowS
$cshowsPrec :: Int -> ExtBasicConstraints -> ShowS
Show,ExtBasicConstraints -> ExtBasicConstraints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtBasicConstraints -> ExtBasicConstraints -> Bool
$c/= :: ExtBasicConstraints -> ExtBasicConstraints -> Bool
== :: ExtBasicConstraints -> ExtBasicConstraints -> Bool
$c== :: ExtBasicConstraints -> ExtBasicConstraints -> Bool
Eq)

instance Extension ExtBasicConstraints where
    extOID :: ExtBasicConstraints -> OID
extOID = forall a b. a -> b -> a
const [Integer
2,Integer
5,Integer
29,Integer
19]
    extHasNestedASN1 :: Proxy ExtBasicConstraints -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
True
    extEncode :: ExtBasicConstraints -> [ASN1]
extEncode (ExtBasicConstraints Bool
b Maybe Integer
Nothing)  = [ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence,Bool -> ASN1
Boolean Bool
b,ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence]
    extEncode (ExtBasicConstraints Bool
b (Just Integer
i)) = [ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence,Bool -> ASN1
Boolean Bool
b,Integer -> ASN1
IntVal Integer
i,ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence]

    extDecode :: [ASN1] -> Either String ExtBasicConstraints
extDecode [Start ASN1ConstructionType
Sequence,Boolean Bool
b,IntVal Integer
v,End ASN1ConstructionType
Sequence]
        | Integer
v forall a. Ord a => a -> a -> Bool
>= Integer
0    = forall a b. b -> Either a b
Right (Bool -> Maybe Integer -> ExtBasicConstraints
ExtBasicConstraints Bool
b (forall a. a -> Maybe a
Just Integer
v))
        | Bool
otherwise = forall a b. a -> Either a b
Left String
"invalid pathlen"
    extDecode [Start ASN1ConstructionType
Sequence,Boolean Bool
b,End ASN1ConstructionType
Sequence] = forall a b. b -> Either a b
Right (Bool -> Maybe Integer -> ExtBasicConstraints
ExtBasicConstraints Bool
b forall a. Maybe a
Nothing)
    extDecode [Start ASN1ConstructionType
Sequence,End ASN1ConstructionType
Sequence] = forall a b. b -> Either a b
Right (Bool -> Maybe Integer -> ExtBasicConstraints
ExtBasicConstraints Bool
False forall a. Maybe a
Nothing)
    extDecode [ASN1]
_ = forall a b. a -> Either a b
Left String
"unknown sequence"

-- | Describe key usage
data ExtKeyUsage = ExtKeyUsage [ExtKeyUsageFlag]
    deriving (Int -> ExtKeyUsage -> ShowS
[ExtKeyUsage] -> ShowS
ExtKeyUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtKeyUsage] -> ShowS
$cshowList :: [ExtKeyUsage] -> ShowS
show :: ExtKeyUsage -> String
$cshow :: ExtKeyUsage -> String
showsPrec :: Int -> ExtKeyUsage -> ShowS
$cshowsPrec :: Int -> ExtKeyUsage -> ShowS
Show,ExtKeyUsage -> ExtKeyUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtKeyUsage -> ExtKeyUsage -> Bool
$c/= :: ExtKeyUsage -> ExtKeyUsage -> Bool
== :: ExtKeyUsage -> ExtKeyUsage -> Bool
$c== :: ExtKeyUsage -> ExtKeyUsage -> Bool
Eq)

instance Extension ExtKeyUsage where
    extOID :: ExtKeyUsage -> OID
extOID = forall a b. a -> b -> a
const [Integer
2,Integer
5,Integer
29,Integer
15]
    extHasNestedASN1 :: Proxy ExtKeyUsage -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
True
    extEncode :: ExtKeyUsage -> [ASN1]
extEncode (ExtKeyUsage [ExtKeyUsageFlag]
flags) = [BitArray -> ASN1
BitString forall a b. (a -> b) -> a -> b
$ forall a. Enum a => [a] -> BitArray
flagsToBits [ExtKeyUsageFlag]
flags]
    extDecode :: [ASN1] -> Either String ExtKeyUsage
extDecode [BitString BitArray
bits] = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ [ExtKeyUsageFlag] -> ExtKeyUsage
ExtKeyUsage forall a b. (a -> b) -> a -> b
$ forall a. Enum a => BitArray -> [a]
bitsToFlags BitArray
bits
    extDecode [ASN1]
_ = forall a b. a -> Either a b
Left String
"unknown sequence"

-- | Key usage purposes for the ExtendedKeyUsage extension
data ExtKeyUsagePurpose =
      KeyUsagePurpose_ServerAuth
    | KeyUsagePurpose_ClientAuth
    | KeyUsagePurpose_CodeSigning
    | KeyUsagePurpose_EmailProtection
    | KeyUsagePurpose_TimeStamping
    | KeyUsagePurpose_OCSPSigning
    | KeyUsagePurpose_Unknown OID
    deriving (Int -> ExtKeyUsagePurpose -> ShowS
[ExtKeyUsagePurpose] -> ShowS
ExtKeyUsagePurpose -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtKeyUsagePurpose] -> ShowS
$cshowList :: [ExtKeyUsagePurpose] -> ShowS
show :: ExtKeyUsagePurpose -> String
$cshow :: ExtKeyUsagePurpose -> String
showsPrec :: Int -> ExtKeyUsagePurpose -> ShowS
$cshowsPrec :: Int -> ExtKeyUsagePurpose -> ShowS
Show,ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
$c/= :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
== :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
$c== :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
Eq,Eq ExtKeyUsagePurpose
ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Ordering
ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> ExtKeyUsagePurpose
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> ExtKeyUsagePurpose
$cmin :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> ExtKeyUsagePurpose
max :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> ExtKeyUsagePurpose
$cmax :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> ExtKeyUsagePurpose
>= :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
$c>= :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
> :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
$c> :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
<= :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
$c<= :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
< :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
$c< :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Bool
compare :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Ordering
$ccompare :: ExtKeyUsagePurpose -> ExtKeyUsagePurpose -> Ordering
Ord)

extKeyUsagePurposedOID :: [(OID, ExtKeyUsagePurpose)]
extKeyUsagePurposedOID :: [(OID, ExtKeyUsagePurpose)]
extKeyUsagePurposedOID =
    [(forall {a}. Num a => a -> [a]
keyUsagePurposePrefix Integer
1, ExtKeyUsagePurpose
KeyUsagePurpose_ServerAuth)
    ,(forall {a}. Num a => a -> [a]
keyUsagePurposePrefix Integer
2, ExtKeyUsagePurpose
KeyUsagePurpose_ClientAuth)
    ,(forall {a}. Num a => a -> [a]
keyUsagePurposePrefix Integer
3, ExtKeyUsagePurpose
KeyUsagePurpose_CodeSigning)
    ,(forall {a}. Num a => a -> [a]
keyUsagePurposePrefix Integer
4, ExtKeyUsagePurpose
KeyUsagePurpose_EmailProtection)
    ,(forall {a}. Num a => a -> [a]
keyUsagePurposePrefix Integer
8, ExtKeyUsagePurpose
KeyUsagePurpose_TimeStamping)
    ,(forall {a}. Num a => a -> [a]
keyUsagePurposePrefix Integer
9, ExtKeyUsagePurpose
KeyUsagePurpose_OCSPSigning)]
  where keyUsagePurposePrefix :: a -> [a]
keyUsagePurposePrefix a
r = [a
1,a
3,a
6,a
1,a
5,a
5,a
7,a
3,a
r]

-- | Extended key usage extension
data ExtExtendedKeyUsage = ExtExtendedKeyUsage [ExtKeyUsagePurpose]
    deriving (Int -> ExtExtendedKeyUsage -> ShowS
[ExtExtendedKeyUsage] -> ShowS
ExtExtendedKeyUsage -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtExtendedKeyUsage] -> ShowS
$cshowList :: [ExtExtendedKeyUsage] -> ShowS
show :: ExtExtendedKeyUsage -> String
$cshow :: ExtExtendedKeyUsage -> String
showsPrec :: Int -> ExtExtendedKeyUsage -> ShowS
$cshowsPrec :: Int -> ExtExtendedKeyUsage -> ShowS
Show,ExtExtendedKeyUsage -> ExtExtendedKeyUsage -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtExtendedKeyUsage -> ExtExtendedKeyUsage -> Bool
$c/= :: ExtExtendedKeyUsage -> ExtExtendedKeyUsage -> Bool
== :: ExtExtendedKeyUsage -> ExtExtendedKeyUsage -> Bool
$c== :: ExtExtendedKeyUsage -> ExtExtendedKeyUsage -> Bool
Eq)

instance Extension ExtExtendedKeyUsage where
    extOID :: ExtExtendedKeyUsage -> OID
extOID = forall a b. a -> b -> a
const [Integer
2,Integer
5,Integer
29,Integer
37]
    extHasNestedASN1 :: Proxy ExtExtendedKeyUsage -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
True
    extEncode :: ExtExtendedKeyUsage -> [ASN1]
extEncode (ExtExtendedKeyUsage [ExtKeyUsagePurpose]
purposes) =
        [ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence] forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map (OID -> ASN1
OID forall b c a. (b -> c) -> (a -> b) -> a -> c
. ExtKeyUsagePurpose -> OID
lookupRev) [ExtKeyUsagePurpose]
purposes forall a. [a] -> [a] -> [a]
++ [ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence]
      where lookupRev :: ExtKeyUsagePurpose -> OID
lookupRev (KeyUsagePurpose_Unknown OID
oid) = OID
oid
            lookupRev ExtKeyUsagePurpose
kup = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error String
"unknown key usage purpose") forall a b. (a, b) -> a
fst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (forall a. Eq a => a -> a -> Bool
(==) ExtKeyUsagePurpose
kup forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> b
snd) [(OID, ExtKeyUsagePurpose)]
extKeyUsagePurposedOID
    extDecode :: [ASN1] -> Either String ExtExtendedKeyUsage
extDecode [ASN1]
l = [ExtKeyUsagePurpose] -> ExtExtendedKeyUsage
ExtExtendedKeyUsage forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` (forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. ParseASN1 a -> [ASN1] -> Either String a
runParseASN1 [ASN1]
l forall a b. (a -> b) -> a -> b
$ forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ forall a. ParseASN1 a -> ParseASN1 [a]
getMany forall a b. (a -> b) -> a -> b
$ do
        ASN1
n <- ParseASN1 ASN1
getNext
        case ASN1
n of
            OID OID
o -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe (OID -> ExtKeyUsagePurpose
KeyUsagePurpose_Unknown OID
o) forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup OID
o [(OID, ExtKeyUsagePurpose)]
extKeyUsagePurposedOID
            ASN1
_     -> forall a. HasCallStack => String -> a
error String
"invalid content in extended key usage")

-- | Provide a way to identify a public key by a short hash.
data ExtSubjectKeyId = ExtSubjectKeyId B.ByteString
    deriving (Int -> ExtSubjectKeyId -> ShowS
[ExtSubjectKeyId] -> ShowS
ExtSubjectKeyId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtSubjectKeyId] -> ShowS
$cshowList :: [ExtSubjectKeyId] -> ShowS
show :: ExtSubjectKeyId -> String
$cshow :: ExtSubjectKeyId -> String
showsPrec :: Int -> ExtSubjectKeyId -> ShowS
$cshowsPrec :: Int -> ExtSubjectKeyId -> ShowS
Show,ExtSubjectKeyId -> ExtSubjectKeyId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtSubjectKeyId -> ExtSubjectKeyId -> Bool
$c/= :: ExtSubjectKeyId -> ExtSubjectKeyId -> Bool
== :: ExtSubjectKeyId -> ExtSubjectKeyId -> Bool
$c== :: ExtSubjectKeyId -> ExtSubjectKeyId -> Bool
Eq)

instance Extension ExtSubjectKeyId where
    extOID :: ExtSubjectKeyId -> OID
extOID = forall a b. a -> b -> a
const [Integer
2,Integer
5,Integer
29,Integer
14]
    extHasNestedASN1 :: Proxy ExtSubjectKeyId -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
True
    extEncode :: ExtSubjectKeyId -> [ASN1]
extEncode (ExtSubjectKeyId ByteString
o) = [ByteString -> ASN1
OctetString ByteString
o]
    extDecode :: [ASN1] -> Either String ExtSubjectKeyId
extDecode [OctetString ByteString
o] = forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ByteString -> ExtSubjectKeyId
ExtSubjectKeyId ByteString
o
    extDecode [ASN1]
_ = forall a b. a -> Either a b
Left String
"unknown sequence"

-- | Different naming scheme use by the extension.
--
-- Not all name types are available, missing:
-- otherName
-- x400Address
-- directoryName
-- ediPartyName
-- registeredID
--
data AltName =
      AltNameRFC822 String
    | AltNameDNS String
    | AltNameURI String
    | AltNameIP  B.ByteString
    | AltNameXMPP String
    | AltNameDNSSRV String
    deriving (Int -> AltName -> ShowS
[AltName] -> ShowS
AltName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AltName] -> ShowS
$cshowList :: [AltName] -> ShowS
show :: AltName -> String
$cshow :: AltName -> String
showsPrec :: Int -> AltName -> ShowS
$cshowsPrec :: Int -> AltName -> ShowS
Show,AltName -> AltName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AltName -> AltName -> Bool
$c/= :: AltName -> AltName -> Bool
== :: AltName -> AltName -> Bool
$c== :: AltName -> AltName -> Bool
Eq,Eq AltName
AltName -> AltName -> Bool
AltName -> AltName -> Ordering
AltName -> AltName -> AltName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: AltName -> AltName -> AltName
$cmin :: AltName -> AltName -> AltName
max :: AltName -> AltName -> AltName
$cmax :: AltName -> AltName -> AltName
>= :: AltName -> AltName -> Bool
$c>= :: AltName -> AltName -> Bool
> :: AltName -> AltName -> Bool
$c> :: AltName -> AltName -> Bool
<= :: AltName -> AltName -> Bool
$c<= :: AltName -> AltName -> Bool
< :: AltName -> AltName -> Bool
$c< :: AltName -> AltName -> Bool
compare :: AltName -> AltName -> Ordering
$ccompare :: AltName -> AltName -> Ordering
Ord)

-- | Provide a way to supply alternate name that can be
-- used for matching host name.
data ExtSubjectAltName = ExtSubjectAltName [AltName]
    deriving (Int -> ExtSubjectAltName -> ShowS
[ExtSubjectAltName] -> ShowS
ExtSubjectAltName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtSubjectAltName] -> ShowS
$cshowList :: [ExtSubjectAltName] -> ShowS
show :: ExtSubjectAltName -> String
$cshow :: ExtSubjectAltName -> String
showsPrec :: Int -> ExtSubjectAltName -> ShowS
$cshowsPrec :: Int -> ExtSubjectAltName -> ShowS
Show,ExtSubjectAltName -> ExtSubjectAltName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
$c/= :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
== :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
$c== :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
Eq,Eq ExtSubjectAltName
ExtSubjectAltName -> ExtSubjectAltName -> Bool
ExtSubjectAltName -> ExtSubjectAltName -> Ordering
ExtSubjectAltName -> ExtSubjectAltName -> ExtSubjectAltName
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExtSubjectAltName -> ExtSubjectAltName -> ExtSubjectAltName
$cmin :: ExtSubjectAltName -> ExtSubjectAltName -> ExtSubjectAltName
max :: ExtSubjectAltName -> ExtSubjectAltName -> ExtSubjectAltName
$cmax :: ExtSubjectAltName -> ExtSubjectAltName -> ExtSubjectAltName
>= :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
$c>= :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
> :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
$c> :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
<= :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
$c<= :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
< :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
$c< :: ExtSubjectAltName -> ExtSubjectAltName -> Bool
compare :: ExtSubjectAltName -> ExtSubjectAltName -> Ordering
$ccompare :: ExtSubjectAltName -> ExtSubjectAltName -> Ordering
Ord)

instance Extension ExtSubjectAltName where
    extOID :: ExtSubjectAltName -> OID
extOID = forall a b. a -> b -> a
const [Integer
2,Integer
5,Integer
29,Integer
17]
    extHasNestedASN1 :: Proxy ExtSubjectAltName -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
True
    extEncode :: ExtSubjectAltName -> [ASN1]
extEncode (ExtSubjectAltName [AltName]
names) = [AltName] -> [ASN1]
encodeGeneralNames [AltName]
names
    extDecode :: [ASN1] -> Either String ExtSubjectAltName
extDecode [ASN1]
l = forall a. ParseASN1 a -> [ASN1] -> Either String a
runParseASN1 ([AltName] -> ExtSubjectAltName
ExtSubjectAltName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 [AltName]
parseGeneralNames) [ASN1]
l

-- | Provide a mean to identify the public key corresponding to the private key
-- used to signed a certificate.
data ExtAuthorityKeyId = ExtAuthorityKeyId B.ByteString
    deriving (Int -> ExtAuthorityKeyId -> ShowS
[ExtAuthorityKeyId] -> ShowS
ExtAuthorityKeyId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtAuthorityKeyId] -> ShowS
$cshowList :: [ExtAuthorityKeyId] -> ShowS
show :: ExtAuthorityKeyId -> String
$cshow :: ExtAuthorityKeyId -> String
showsPrec :: Int -> ExtAuthorityKeyId -> ShowS
$cshowsPrec :: Int -> ExtAuthorityKeyId -> ShowS
Show,ExtAuthorityKeyId -> ExtAuthorityKeyId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtAuthorityKeyId -> ExtAuthorityKeyId -> Bool
$c/= :: ExtAuthorityKeyId -> ExtAuthorityKeyId -> Bool
== :: ExtAuthorityKeyId -> ExtAuthorityKeyId -> Bool
$c== :: ExtAuthorityKeyId -> ExtAuthorityKeyId -> Bool
Eq)

instance Extension ExtAuthorityKeyId where
    extOID :: ExtAuthorityKeyId -> OID
extOID ExtAuthorityKeyId
_ = [Integer
2,Integer
5,Integer
29,Integer
35]
    extHasNestedASN1 :: Proxy ExtAuthorityKeyId -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
True
    extEncode :: ExtAuthorityKeyId -> [ASN1]
extEncode (ExtAuthorityKeyId ByteString
keyid) =
        [ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence,ASN1Class -> Int -> ByteString -> ASN1
Other ASN1Class
Context Int
0 ByteString
keyid,ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence]
    extDecode :: [ASN1] -> Either String ExtAuthorityKeyId
extDecode [Start ASN1ConstructionType
Sequence,Other ASN1Class
Context Int
0 ByteString
keyid,End ASN1ConstructionType
Sequence] =
        forall a b. b -> Either a b
Right forall a b. (a -> b) -> a -> b
$ ByteString -> ExtAuthorityKeyId
ExtAuthorityKeyId ByteString
keyid
    extDecode [ASN1]
_ = forall a b. a -> Either a b
Left String
"unknown sequence"

-- | Identify how CRL information is obtained
data ExtCrlDistributionPoints = ExtCrlDistributionPoints [DistributionPoint]
    deriving (Int -> ExtCrlDistributionPoints -> ShowS
[ExtCrlDistributionPoints] -> ShowS
ExtCrlDistributionPoints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtCrlDistributionPoints] -> ShowS
$cshowList :: [ExtCrlDistributionPoints] -> ShowS
show :: ExtCrlDistributionPoints -> String
$cshow :: ExtCrlDistributionPoints -> String
showsPrec :: Int -> ExtCrlDistributionPoints -> ShowS
$cshowsPrec :: Int -> ExtCrlDistributionPoints -> ShowS
Show,ExtCrlDistributionPoints -> ExtCrlDistributionPoints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtCrlDistributionPoints -> ExtCrlDistributionPoints -> Bool
$c/= :: ExtCrlDistributionPoints -> ExtCrlDistributionPoints -> Bool
== :: ExtCrlDistributionPoints -> ExtCrlDistributionPoints -> Bool
$c== :: ExtCrlDistributionPoints -> ExtCrlDistributionPoints -> Bool
Eq)

-- | Reason flag for the CRL
data ReasonFlag =
      Reason_Unused
    | Reason_KeyCompromise
    | Reason_CACompromise
    | Reason_AffiliationChanged
    | Reason_Superseded
    | Reason_CessationOfOperation
    | Reason_CertificateHold
    | Reason_PrivilegeWithdrawn
    | Reason_AACompromise
    deriving (Int -> ReasonFlag -> ShowS
[ReasonFlag] -> ShowS
ReasonFlag -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReasonFlag] -> ShowS
$cshowList :: [ReasonFlag] -> ShowS
show :: ReasonFlag -> String
$cshow :: ReasonFlag -> String
showsPrec :: Int -> ReasonFlag -> ShowS
$cshowsPrec :: Int -> ReasonFlag -> ShowS
Show,ReasonFlag -> ReasonFlag -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReasonFlag -> ReasonFlag -> Bool
$c/= :: ReasonFlag -> ReasonFlag -> Bool
== :: ReasonFlag -> ReasonFlag -> Bool
$c== :: ReasonFlag -> ReasonFlag -> Bool
Eq,Eq ReasonFlag
ReasonFlag -> ReasonFlag -> Bool
ReasonFlag -> ReasonFlag -> Ordering
ReasonFlag -> ReasonFlag -> ReasonFlag
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ReasonFlag -> ReasonFlag -> ReasonFlag
$cmin :: ReasonFlag -> ReasonFlag -> ReasonFlag
max :: ReasonFlag -> ReasonFlag -> ReasonFlag
$cmax :: ReasonFlag -> ReasonFlag -> ReasonFlag
>= :: ReasonFlag -> ReasonFlag -> Bool
$c>= :: ReasonFlag -> ReasonFlag -> Bool
> :: ReasonFlag -> ReasonFlag -> Bool
$c> :: ReasonFlag -> ReasonFlag -> Bool
<= :: ReasonFlag -> ReasonFlag -> Bool
$c<= :: ReasonFlag -> ReasonFlag -> Bool
< :: ReasonFlag -> ReasonFlag -> Bool
$c< :: ReasonFlag -> ReasonFlag -> Bool
compare :: ReasonFlag -> ReasonFlag -> Ordering
$ccompare :: ReasonFlag -> ReasonFlag -> Ordering
Ord,Int -> ReasonFlag
ReasonFlag -> Int
ReasonFlag -> [ReasonFlag]
ReasonFlag -> ReasonFlag
ReasonFlag -> ReasonFlag -> [ReasonFlag]
ReasonFlag -> ReasonFlag -> ReasonFlag -> [ReasonFlag]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: ReasonFlag -> ReasonFlag -> ReasonFlag -> [ReasonFlag]
$cenumFromThenTo :: ReasonFlag -> ReasonFlag -> ReasonFlag -> [ReasonFlag]
enumFromTo :: ReasonFlag -> ReasonFlag -> [ReasonFlag]
$cenumFromTo :: ReasonFlag -> ReasonFlag -> [ReasonFlag]
enumFromThen :: ReasonFlag -> ReasonFlag -> [ReasonFlag]
$cenumFromThen :: ReasonFlag -> ReasonFlag -> [ReasonFlag]
enumFrom :: ReasonFlag -> [ReasonFlag]
$cenumFrom :: ReasonFlag -> [ReasonFlag]
fromEnum :: ReasonFlag -> Int
$cfromEnum :: ReasonFlag -> Int
toEnum :: Int -> ReasonFlag
$ctoEnum :: Int -> ReasonFlag
pred :: ReasonFlag -> ReasonFlag
$cpred :: ReasonFlag -> ReasonFlag
succ :: ReasonFlag -> ReasonFlag
$csucc :: ReasonFlag -> ReasonFlag
Enum)

-- | Distribution point as either some GeneralNames or a DN
data DistributionPoint =
      DistributionPointFullName [AltName]
    | DistributionNameRelative DistinguishedName
    deriving (Int -> DistributionPoint -> ShowS
[DistributionPoint] -> ShowS
DistributionPoint -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DistributionPoint] -> ShowS
$cshowList :: [DistributionPoint] -> ShowS
show :: DistributionPoint -> String
$cshow :: DistributionPoint -> String
showsPrec :: Int -> DistributionPoint -> ShowS
$cshowsPrec :: Int -> DistributionPoint -> ShowS
Show,DistributionPoint -> DistributionPoint -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistributionPoint -> DistributionPoint -> Bool
$c/= :: DistributionPoint -> DistributionPoint -> Bool
== :: DistributionPoint -> DistributionPoint -> Bool
$c== :: DistributionPoint -> DistributionPoint -> Bool
Eq)

instance Extension ExtCrlDistributionPoints where
    extOID :: ExtCrlDistributionPoints -> OID
extOID ExtCrlDistributionPoints
_ = [Integer
2,Integer
5,Integer
29,Integer
31]
    extHasNestedASN1 :: Proxy ExtCrlDistributionPoints -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
True
    extEncode :: ExtCrlDistributionPoints -> [ASN1]
extEncode = forall a. HasCallStack => String -> a
error String
"extEncode ExtCrlDistributionPoints unimplemented"
    extDecode :: [ASN1] -> Either String ExtCrlDistributionPoints
extDecode = forall a. HasCallStack => String -> a
error String
"extDecode ExtCrlDistributionPoints unimplemented"
    --extEncode (ExtCrlDistributionPoints )

parseGeneralNames :: ParseASN1 [AltName]
parseGeneralNames :: ParseASN1 [AltName]
parseGeneralNames = forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Sequence forall a b. (a -> b) -> a -> b
$ forall a. ParseASN1 a -> ParseASN1 [a]
getMany ParseASN1 AltName
getAddr
  where
        getAddr :: ParseASN1 AltName
getAddr = do
            Maybe AltName
m <- forall a.
ASN1ConstructionType -> ParseASN1 a -> ParseASN1 (Maybe a)
onNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0) ParseASN1 AltName
getComposedAddr
            case Maybe AltName
m of
                Maybe AltName
Nothing -> ParseASN1 AltName
getSimpleAddr
                Just AltName
r  -> forall (m :: * -> *) a. Monad m => a -> m a
return AltName
r
        getComposedAddr :: ParseASN1 AltName
getComposedAddr = do
            ASN1
n <- ParseASN1 ASN1
getNext
            case ASN1
n of
                OID [Integer
1,Integer
3,Integer
6,Integer
1,Integer
5,Integer
5,Integer
7,Integer
8,Integer
5] -> do -- xmpp addr
                    Maybe [ASN1]
c <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
                    case Maybe [ASN1]
c of
                        Just [ASN1String ASN1CharacterString
cs] ->
                            case ASN1CharacterString -> Maybe String
asn1CharacterToString ASN1CharacterString
cs of
                                Maybe String
Nothing -> forall a. String -> ParseASN1 a
throwParseError (String
"GeneralNames: invalid string for XMPP Addr")
                                Just String
s  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> AltName
AltNameXMPP String
s
                        Maybe [ASN1]
_ -> forall a. String -> ParseASN1 a
throwParseError (String
"GeneralNames: expecting string for XMPP Addr got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe [ASN1]
c)
                OID [Integer
1,Integer
3,Integer
6,Integer
1,Integer
5,Integer
5,Integer
7,Integer
8,Integer
7] -> do -- DNSSRV addr
                    Maybe [ASN1]
c <- ASN1ConstructionType -> ParseASN1 (Maybe [ASN1])
getNextContainerMaybe (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
                    case Maybe [ASN1]
c of
                        Just [ASN1String ASN1CharacterString
cs] ->
                            case ASN1CharacterString -> Maybe String
asn1CharacterToString ASN1CharacterString
cs of
                                Maybe String
Nothing -> forall a. String -> ParseASN1 a
throwParseError (String
"GeneralNames: invalid string for DNSSrv Addr")
                                Just String
s  -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> AltName
AltNameDNSSRV String
s
                        Maybe [ASN1]
_ -> forall a. String -> ParseASN1 a
throwParseError (String
"GeneralNames: expecting string for DNSSRV Addr got: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Maybe [ASN1]
c)
                OID OID
unknown -> forall a. String -> ParseASN1 a
throwParseError (String
"GeneralNames: unknown OID " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show OID
unknown)
                ASN1
_           -> forall a. String -> ParseASN1 a
throwParseError (String
"GeneralNames: expecting OID but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASN1
n)

        getSimpleAddr :: ParseASN1 AltName
getSimpleAddr = do
            ASN1
n <- ParseASN1 ASN1
getNext
            case ASN1
n of
                (Other ASN1Class
Context Int
1 ByteString
b) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> AltName
AltNameRFC822 forall a b. (a -> b) -> a -> b
$ ByteString -> String
BC.unpack ByteString
b
                (Other ASN1Class
Context Int
2 ByteString
b) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> AltName
AltNameDNS forall a b. (a -> b) -> a -> b
$ ByteString -> String
BC.unpack ByteString
b
                (Other ASN1Class
Context Int
6 ByteString
b) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> AltName
AltNameURI forall a b. (a -> b) -> a -> b
$ ByteString -> String
BC.unpack ByteString
b
                (Other ASN1Class
Context Int
7 ByteString
b) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> AltName
AltNameIP  ByteString
b
                ASN1
_                   -> forall a. String -> ParseASN1 a
throwParseError (String
"GeneralNames: not coping with unknown stream " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show ASN1
n)

encodeGeneralNames :: [AltName] -> [ASN1]
encodeGeneralNames :: [AltName] -> [ASN1]
encodeGeneralNames [AltName]
names =
    [ASN1ConstructionType -> ASN1
Start ASN1ConstructionType
Sequence]
    forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap AltName -> [ASN1]
encodeAltName [AltName]
names
    forall a. [a] -> [a] -> [a]
++ [ASN1ConstructionType -> ASN1
End ASN1ConstructionType
Sequence]
  where encodeAltName :: AltName -> [ASN1]
encodeAltName (AltNameRFC822 String
n) = [ASN1Class -> Int -> ByteString -> ASN1
Other ASN1Class
Context Int
1 forall a b. (a -> b) -> a -> b
$ String -> ByteString
BC.pack String
n]
        encodeAltName (AltNameDNS String
n)    = [ASN1Class -> Int -> ByteString -> ASN1
Other ASN1Class
Context Int
2 forall a b. (a -> b) -> a -> b
$ String -> ByteString
BC.pack String
n]
        encodeAltName (AltNameURI String
n)    = [ASN1Class -> Int -> ByteString -> ASN1
Other ASN1Class
Context Int
6 forall a b. (a -> b) -> a -> b
$ String -> ByteString
BC.pack String
n]
        encodeAltName (AltNameIP ByteString
n)     = [ASN1Class -> Int -> ByteString -> ASN1
Other ASN1Class
Context Int
7 forall a b. (a -> b) -> a -> b
$ ByteString
n]
        encodeAltName (AltNameXMPP String
n)   = [ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0),OID -> ASN1
OID[Integer
1,Integer
3,Integer
6,Integer
1,Integer
5,Integer
5,Integer
7,Integer
8,Integer
5]
                                          ,ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0), ASN1CharacterString -> ASN1
ASN1String forall a b. (a -> b) -> a -> b
$ ASN1StringEncoding -> String -> ASN1CharacterString
asn1CharacterString ASN1StringEncoding
UTF8 String
n, ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
                                          ,ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)]
        encodeAltName (AltNameDNSSRV String
n) = [ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0),OID -> ASN1
OID[Integer
1,Integer
3,Integer
6,Integer
1,Integer
5,Integer
5,Integer
7,Integer
8,Integer
5]
                                          ,ASN1ConstructionType -> ASN1
Start (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0), ASN1CharacterString -> ASN1
ASN1String forall a b. (a -> b) -> a -> b
$ ASN1StringEncoding -> String -> ASN1CharacterString
asn1CharacterString ASN1StringEncoding
UTF8 String
n, ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)
                                          ,ASN1ConstructionType -> ASN1
End (ASN1Class -> Int -> ASN1ConstructionType
Container ASN1Class
Context Int
0)]

bitsToFlags :: Enum a => BitArray -> [a]
bitsToFlags :: forall a. Enum a => BitArray -> [a]
bitsToFlags BitArray
bits = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a b. (a -> b) -> [a] -> [b]
map [Word64
0..(BitArray -> Word64
bitArrayLength BitArray
bitsforall a. Num a => a -> a -> a
-Word64
1)] forall a b. (a -> b) -> a -> b
$ \Word64
i -> do
        let isSet :: Bool
isSet = BitArray -> Word64 -> Bool
bitArrayGetBit BitArray
bits Word64
i
        if Bool
isSet then [forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
i] else []

flagsToBits :: Enum a => [a] -> BitArray
flagsToBits :: forall a. Enum a => [a] -> BitArray
flagsToBits [a]
flags = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl BitArray -> Word64 -> BitArray
bitArraySetBit BitArray
bitArrayEmpty forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Enum a => a -> Int
fromEnum) [a]
flags
  where bitArrayEmpty :: BitArray
bitArrayEmpty = ByteString -> Int -> BitArray
toBitArray ([Word8] -> ByteString
B.pack [Word8
0,Word8
0]) Int
7

data ExtNetscapeComment = ExtNetscapeComment B.ByteString
    deriving (Int -> ExtNetscapeComment -> ShowS
[ExtNetscapeComment] -> ShowS
ExtNetscapeComment -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExtNetscapeComment] -> ShowS
$cshowList :: [ExtNetscapeComment] -> ShowS
show :: ExtNetscapeComment -> String
$cshow :: ExtNetscapeComment -> String
showsPrec :: Int -> ExtNetscapeComment -> ShowS
$cshowsPrec :: Int -> ExtNetscapeComment -> ShowS
Show,ExtNetscapeComment -> ExtNetscapeComment -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExtNetscapeComment -> ExtNetscapeComment -> Bool
$c/= :: ExtNetscapeComment -> ExtNetscapeComment -> Bool
== :: ExtNetscapeComment -> ExtNetscapeComment -> Bool
$c== :: ExtNetscapeComment -> ExtNetscapeComment -> Bool
Eq)

instance Extension ExtNetscapeComment where
    extOID :: ExtNetscapeComment -> OID
extOID ExtNetscapeComment
_ = [Integer
2,Integer
16,Integer
840,Integer
1,Integer
113730,Integer
1,Integer
13]
    extHasNestedASN1 :: Proxy ExtNetscapeComment -> Bool
extHasNestedASN1 = forall a b. a -> b -> a
const Bool
False
    extEncode :: ExtNetscapeComment -> [ASN1]
extEncode = forall a. HasCallStack => String -> a
error String
"Extension: Netscape Comment do not contain nested ASN1"
    extDecode :: [ASN1] -> Either String ExtNetscapeComment
extDecode = forall a. HasCallStack => String -> a
error String
"Extension: Netscape Comment do not contain nested ASN1"
    extEncodeBs :: ExtNetscapeComment -> ByteString
extEncodeBs (ExtNetscapeComment ByteString
b) = ByteString
b
    extDecodeBs :: ByteString -> Either String ExtNetscapeComment
extDecodeBs = forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ExtNetscapeComment
ExtNetscapeComment