-- |
-- 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DistinguishedName] -> ShowS
$cshowList :: [DistinguishedName] -> ShowS
show :: DistinguishedName -> String
$cshow :: DistinguishedName -> String
showsPrec :: Int -> DistinguishedName -> ShowS
$cshowsPrec :: Int -> DistinguishedName -> ShowS
Show,DistinguishedName -> DistinguishedName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistinguishedName -> DistinguishedName -> Bool
$c/= :: DistinguishedName -> DistinguishedName -> Bool
== :: DistinguishedName -> DistinguishedName -> Bool
$c== :: DistinguishedName -> DistinguishedName -> Bool
Eq,Eq 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
min :: DistinguishedName -> DistinguishedName -> DistinguishedName
$cmin :: DistinguishedName -> DistinguishedName -> DistinguishedName
max :: DistinguishedName -> DistinguishedName -> DistinguishedName
$cmax :: DistinguishedName -> DistinguishedName -> DistinguishedName
>= :: DistinguishedName -> DistinguishedName -> Bool
$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
compare :: DistinguishedName -> DistinguishedName -> Ordering
$ccompare :: DistinguishedName -> DistinguishedName -> Ordering
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DnElement] -> ShowS
$cshowList :: [DnElement] -> ShowS
show :: DnElement -> String
$cshow :: DnElement -> String
showsPrec :: Int -> DnElement -> ShowS
$cshowsPrec :: Int -> DnElement -> ShowS
Show,DnElement -> DnElement -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DnElement -> DnElement -> Bool
$c/= :: DnElement -> DnElement -> Bool
== :: DnElement -> DnElement -> Bool
$c== :: 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) = forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DistinguishedNameInner] -> ShowS
$cshowList :: [DistinguishedNameInner] -> ShowS
show :: DistinguishedNameInner -> String
$cshow :: DistinguishedNameInner -> String
showsPrec :: Int -> DistinguishedNameInner -> ShowS
$cshowsPrec :: Int -> DistinguishedNameInner -> ShowS
Show,DistinguishedNameInner -> DistinguishedNameInner -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DistinguishedNameInner -> DistinguishedNameInner -> Bool
$c/= :: DistinguishedNameInner -> DistinguishedNameInner -> Bool
== :: DistinguishedNameInner -> DistinguishedNameInner -> Bool
$c== :: 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)]
l1forall 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 forall a. [a] -> [a] -> [a]
++ [ASN1]
xs
    fromASN1 :: [ASN1] -> Either String (DistinguishedName, [ASN1])
fromASN1  = 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 forall a. [a] -> [a] -> [a]
++ [ASN1]
xs
    fromASN1 :: [ASN1] -> Either String (DistinguishedNameInner, [ASN1])
fromASN1 = forall a. ParseASN1 a -> [ASN1] -> Either String (a, [ASN1])
runParseASN1State (DistinguishedName -> DistinguishedNameInner
DistinguishedNameInner forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(OID, ASN1CharacterString)] -> DistinguishedName
DistinguishedName 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Sequence ParseASN1 [(OID, ASN1CharacterString)]
parseDNInner

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

parseOneDN :: ParseASN1 [(OID, ASN1CharacterString)]
parseOneDN :: ParseASN1 [(OID, ASN1CharacterString)]
parseOneDN = forall a. ASN1ConstructionType -> ParseASN1 a -> ParseASN1 a
onNextContainer ASN1ConstructionType
Set forall a b. (a -> b) -> a -> b
$ forall a. ParseASN1 a -> ParseASN1 [a]
getMany 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] -> forall (m :: * -> *) a. Monad m => a -> m a
return (OID
oid, ASN1CharacterString
cs)
        [ASN1]
_                        -> forall a. String -> ParseASN1 a
throwParseError (String
"expecting [OID,String] got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show [ASN1]
s)

encodeDNinner :: DistinguishedName -> [ASN1]
encodeDNinner :: DistinguishedName -> [ASN1]
encodeDNinner (DistinguishedName [(OID, ASN1CharacterString)]
dn) = 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 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 forall a b. (a -> b) -> a -> b
$ DistinguishedName -> [ASN1]
encodeDNinner DistinguishedName
dn