-- |
-- Module      : Data.X509.DistinguishedName
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : unknown
--
-- X.509 Distinguished names types and functions

{-# LANGUAGE CPP #-}
module Data.X509.DistinguishedName
    ( DistinguishedName(..)
    , DistinguishedNameInner(..)
    , ASN1CharacterString(..)
    -- Distinguished Name Elements
    , DnElement(..)
    , getDnElement
    ) where

import Control.Applicative
#if MIN_VERSION_base(4,9,0)
import           Data.Semigroup
#else
import           Data.Monoid
#endif
import Data.ASN1.Types
import Data.X509.Internal

-- | A list of OID and strings.
newtype DistinguishedName = DistinguishedName { DistinguishedName -> [(OID, ASN1CharacterString)]
getDistinguishedElements :: [(OID, ASN1CharacterString)] }
    deriving (Int -> DistinguishedName -> ShowS
[DistinguishedName] -> ShowS
DistinguishedName -> String
(Int -> DistinguishedName -> ShowS)
-> (DistinguishedName -> String)
-> ([DistinguishedName] -> ShowS)
-> Show DistinguishedName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DistinguishedName -> ShowS
showsPrec :: Int -> DistinguishedName -> ShowS
$cshow :: DistinguishedName -> String
show :: DistinguishedName -> String
$cshowList :: [DistinguishedName] -> ShowS
showList :: [DistinguishedName] -> ShowS
Show,DistinguishedName -> DistinguishedName -> Bool
(DistinguishedName -> DistinguishedName -> Bool)
-> (DistinguishedName -> DistinguishedName -> Bool)
-> Eq DistinguishedName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DistinguishedName -> DistinguishedName -> Bool
== :: DistinguishedName -> DistinguishedName -> Bool
$c/= :: DistinguishedName -> DistinguishedName -> Bool
/= :: DistinguishedName -> DistinguishedName -> Bool
Eq,Eq DistinguishedName
Eq DistinguishedName =>
(DistinguishedName -> DistinguishedName -> Ordering)
-> (DistinguishedName -> DistinguishedName -> Bool)
-> (DistinguishedName -> DistinguishedName -> Bool)
-> (DistinguishedName -> DistinguishedName -> Bool)
-> (DistinguishedName -> DistinguishedName -> Bool)
-> (DistinguishedName -> DistinguishedName -> DistinguishedName)
-> (DistinguishedName -> DistinguishedName -> DistinguishedName)
-> Ord DistinguishedName
DistinguishedName -> DistinguishedName -> Bool
DistinguishedName -> DistinguishedName -> Ordering
DistinguishedName -> DistinguishedName -> DistinguishedName
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
$ccompare :: DistinguishedName -> DistinguishedName -> Ordering
compare :: DistinguishedName -> DistinguishedName -> Ordering
$c< :: DistinguishedName -> DistinguishedName -> Bool
< :: DistinguishedName -> DistinguishedName -> Bool
$c<= :: DistinguishedName -> DistinguishedName -> Bool
<= :: DistinguishedName -> DistinguishedName -> Bool
$c> :: DistinguishedName -> DistinguishedName -> Bool
> :: DistinguishedName -> DistinguishedName -> Bool
$c>= :: DistinguishedName -> DistinguishedName -> Bool
>= :: DistinguishedName -> DistinguishedName -> Bool
$cmax :: DistinguishedName -> DistinguishedName -> DistinguishedName
max :: DistinguishedName -> DistinguishedName -> DistinguishedName
$cmin :: DistinguishedName -> DistinguishedName -> DistinguishedName
min :: DistinguishedName -> DistinguishedName -> DistinguishedName
Ord)

-- | Elements commonly available in a 'DistinguishedName' structure
data DnElement =
      DnCommonName       -- ^ CN
    | DnCountry          -- ^ Country
    | DnOrganization     -- ^ O
    | DnOrganizationUnit -- ^ OU
    | DnEmailAddress     -- ^ Email Address (legacy)
    deriving (Int -> DnElement -> ShowS
[DnElement] -> ShowS
DnElement -> String
(Int -> DnElement -> ShowS)
-> (DnElement -> String)
-> ([DnElement] -> ShowS)
-> Show DnElement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DnElement -> ShowS
showsPrec :: Int -> DnElement -> ShowS
$cshow :: DnElement -> String
show :: DnElement -> String
$cshowList :: [DnElement] -> ShowS
showList :: [DnElement] -> ShowS
Show,DnElement -> DnElement -> Bool
(DnElement -> DnElement -> Bool)
-> (DnElement -> DnElement -> Bool) -> Eq DnElement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DnElement -> DnElement -> Bool
== :: DnElement -> DnElement -> Bool
$c/= :: DnElement -> DnElement -> Bool
/= :: DnElement -> DnElement -> Bool
Eq)

instance OIDable DnElement where
    getObjectID :: DnElement -> OID
getObjectID DnElement
DnCommonName       = [Integer
2,Integer
5,Integer
4,Integer
3]
    getObjectID DnElement
DnCountry          = [Integer
2,Integer
5,Integer
4,Integer
6]
    getObjectID DnElement
DnOrganization     = [Integer
2,Integer
5,Integer
4,Integer
10]
    getObjectID DnElement
DnOrganizationUnit = [Integer
2,Integer
5,Integer
4,Integer
11]
    getObjectID DnElement
DnEmailAddress     = [Integer
1,Integer
2,Integer
840,Integer
113549,Integer
1,Integer
9,Integer
1]

-- | Try to get a specific element in a 'DistinguishedName' structure
getDnElement :: DnElement -> DistinguishedName -> Maybe ASN1CharacterString
getDnElement :: DnElement -> DistinguishedName -> Maybe ASN1CharacterString
getDnElement DnElement
element (DistinguishedName [(OID, ASN1CharacterString)]
els) = OID -> [(OID, ASN1CharacterString)] -> Maybe ASN1CharacterString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (DnElement -> OID
forall a. OIDable a => a -> OID
getObjectID DnElement
element) [(OID, ASN1CharacterString)]
els

-- | Only use to encode a DistinguishedName without including it in a
-- Sequence
newtype DistinguishedNameInner = DistinguishedNameInner DistinguishedName
    deriving (Int -> DistinguishedNameInner -> ShowS
[DistinguishedNameInner] -> ShowS
DistinguishedNameInner -> String
(Int -> DistinguishedNameInner -> ShowS)
-> (DistinguishedNameInner -> String)
-> ([DistinguishedNameInner] -> ShowS)
-> Show DistinguishedNameInner
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DistinguishedNameInner -> ShowS
showsPrec :: Int -> DistinguishedNameInner -> ShowS
$cshow :: DistinguishedNameInner -> String
show :: DistinguishedNameInner -> String
$cshowList :: [DistinguishedNameInner] -> ShowS
showList :: [DistinguishedNameInner] -> ShowS
Show,DistinguishedNameInner -> DistinguishedNameInner -> Bool
(DistinguishedNameInner -> DistinguishedNameInner -> Bool)
-> (DistinguishedNameInner -> DistinguishedNameInner -> Bool)
-> Eq DistinguishedNameInner
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DistinguishedNameInner -> DistinguishedNameInner -> Bool
== :: DistinguishedNameInner -> DistinguishedNameInner -> Bool
$c/= :: DistinguishedNameInner -> DistinguishedNameInner -> Bool
/= :: DistinguishedNameInner -> DistinguishedNameInner -> Bool
Eq)

#if MIN_VERSION_base(4,9,0)
instance Semigroup DistinguishedName where
    DistinguishedName [(OID, ASN1CharacterString)]
l1 <> :: DistinguishedName -> DistinguishedName -> DistinguishedName
<> DistinguishedName [(OID, ASN1CharacterString)]
l2 = [(OID, ASN1CharacterString)] -> DistinguishedName
DistinguishedName ([(OID, ASN1CharacterString)]
l1[(OID, ASN1CharacterString)]
-> [(OID, ASN1CharacterString)] -> [(OID, ASN1CharacterString)]
forall a. [a] -> [a] -> [a]
++[(OID, ASN1CharacterString)]
l2)
#endif

instance Monoid DistinguishedName where
    mempty :: DistinguishedName
mempty  = [(OID, ASN1CharacterString)] -> DistinguishedName
DistinguishedName []
#if !(MIN_VERSION_base(4,11,0))
    mappend (DistinguishedName l1) (DistinguishedName l2) = DistinguishedName (l1++l2)
#endif

instance ASN1Object DistinguishedName where
    toASN1 :: DistinguishedName -> ASN1S
toASN1 DistinguishedName
dn = \[ASN1]
xs -> DistinguishedName -> [ASN1]
encodeDN DistinguishedName
dn [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [ASN1]
xs
    fromASN1 :: [ASN1] -> Either String (DistinguishedName, [ASN1])
fromASN1  = ParseASN1 DistinguishedName
-> [ASN1] -> Either String (DistinguishedName, [ASN1])
forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
runParseASN1State ParseASN1 DistinguishedName
parseDN

-- FIXME parseDNInner in fromASN1 is probably wrong as we don't have a container
-- and thus hasNext should be replaced by a isFinished clause.
instance ASN1Object DistinguishedNameInner where
    toASN1 :: DistinguishedNameInner -> ASN1S
toASN1 (DistinguishedNameInner DistinguishedName
dn) = \[ASN1]
xs -> DistinguishedName -> [ASN1]
encodeDNinner DistinguishedName
dn [ASN1] -> ASN1S
forall a. [a] -> [a] -> [a]
++ [ASN1]
xs
    fromASN1 :: [ASN1] -> Either String (DistinguishedNameInner, [ASN1])
fromASN1 = ParseASN1 DistinguishedNameInner
-> [ASN1] -> Either String (DistinguishedNameInner, [ASN1])
forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
runParseASN1State (DistinguishedName -> DistinguishedNameInner
DistinguishedNameInner (DistinguishedName -> DistinguishedNameInner)
-> ([(OID, ASN1CharacterString)] -> DistinguishedName)
-> [(OID, ASN1CharacterString)]
-> DistinguishedNameInner
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(OID, ASN1CharacterString)] -> DistinguishedName
DistinguishedName ([(OID, ASN1CharacterString)] -> DistinguishedNameInner)
-> ParseASN1 [(OID, ASN1CharacterString)]
-> ParseASN1 DistinguishedNameInner
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParseASN1 [(OID, ASN1CharacterString)]
parseDNInner)

parseDN :: ParseASN1 DistinguishedName
parseDN :: ParseASN1 DistinguishedName
parseDN = [(OID, ASN1CharacterString)] -> DistinguishedName
DistinguishedName ([(OID, ASN1CharacterString)] -> DistinguishedName)
-> ParseASN1 [(OID, ASN1CharacterString)]
-> ParseASN1 DistinguishedName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ASN1ConstructionType
-> ParseASN1 [(OID, ASN1CharacterString)]
-> ParseASN1 [(OID, ASN1CharacterString)]
forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Sequence ParseASN1 [(OID, ASN1CharacterString)]
parseDNInner

parseDNInner :: ParseASN1 [(OID, ASN1CharacterString)]
parseDNInner :: ParseASN1 [(OID, ASN1CharacterString)]
parseDNInner = [[(OID, ASN1CharacterString)]] -> [(OID, ASN1CharacterString)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(OID, ASN1CharacterString)]] -> [(OID, ASN1CharacterString)])
-> ParseASN1 [[(OID, ASN1CharacterString)]]
-> ParseASN1 [(OID, ASN1CharacterString)]
forall a b. (a -> b) -> ParseASN1 a -> ParseASN1 b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParseASN1 [(OID, ASN1CharacterString)]
-> ParseASN1 [[(OID, ASN1CharacterString)]]
forall a. ParseASN1 a -> ParseASN1 [a]
getMany ParseASN1 [(OID, ASN1CharacterString)]
parseOneDN

parseOneDN :: ParseASN1 [(OID, ASN1CharacterString)]
parseOneDN :: ParseASN1 [(OID, ASN1CharacterString)]
parseOneDN = ASN1ConstructionType
-> ParseASN1 [(OID, ASN1CharacterString)]
-> ParseASN1 [(OID, ASN1CharacterString)]
forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Set (ParseASN1 [(OID, ASN1CharacterString)]
 -> ParseASN1 [(OID, ASN1CharacterString)])
-> ParseASN1 [(OID, ASN1CharacterString)]
-> ParseASN1 [(OID, ASN1CharacterString)]
forall a b. (a -> b) -> a -> b
$ ParseASN1 (OID, ASN1CharacterString)
-> ParseASN1 [(OID, ASN1CharacterString)]
forall a. ParseASN1 a -> ParseASN1 [a]
getMany (ParseASN1 (OID, ASN1CharacterString)
 -> ParseASN1 [(OID, ASN1CharacterString)])
-> ParseASN1 (OID, ASN1CharacterString)
-> ParseASN1 [(OID, ASN1CharacterString)]
forall a b. (a -> b) -> a -> b
$ do
    [ASN1]
s <- ASN1ConstructionType -> ParseASN1 [ASN1]
getNextContainer ASN1ConstructionType
Sequence
    case [ASN1]
s of
        [OID OID
oid, ASN1String ASN1CharacterString
cs] -> (OID, ASN1CharacterString) -> ParseASN1 (OID, ASN1CharacterString)
forall a. a -> ParseASN1 a
forall (m :: * -> *) a. Monad m => a -> m a
return (OID
oid, ASN1CharacterString
cs)
        [ASN1]
_                        -> String -> ParseASN1 (OID, ASN1CharacterString)
forall a. String -> ParseASN1 a
throwParseError (String
"expecting [OID,String] got " String -> ShowS
forall a. [a] -> [a] -> [a]
++ [ASN1] -> String
forall a. Show a => a -> String
show [ASN1]
s)

encodeDNinner :: DistinguishedName -> [ASN1]
encodeDNinner :: DistinguishedName -> [ASN1]
encodeDNinner (DistinguishedName [(OID, ASN1CharacterString)]
dn) = ((OID, ASN1CharacterString) -> [ASN1])
-> [(OID, ASN1CharacterString)] -> [ASN1]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (OID, ASN1CharacterString) -> [ASN1]
dnSet [(OID, ASN1CharacterString)]
dn
  where dnSet :: (OID, ASN1CharacterString) -> [ASN1]
dnSet (OID
oid, ASN1CharacterString
cs) = ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Set ASN1S -> ASN1S
forall a b. (a -> b) -> a -> b
$ ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence [OID -> ASN1
OID OID
oid, ASN1CharacterString -> ASN1
ASN1String ASN1CharacterString
cs]

encodeDN :: DistinguishedName -> [ASN1]
encodeDN :: DistinguishedName -> [ASN1]
encodeDN DistinguishedName
dn = ASN1ConstructionType -> ASN1S
asn1Container ASN1ConstructionType
Sequence ASN1S -> ASN1S
forall a b. (a -> b) -> a -> b
$ DistinguishedName -> [ASN1]
encodeDNinner DistinguishedName
dn