{-# LANGUAGE OverloadedStrings #-}
module Ldap.Asn1.ToAsn1
( ToAsn1(toAsn1)
) where
import Data.ASN1.Types (ASN1, ASN1Class, ASN1Tag, ASN1ConstructionType)
import qualified Data.ASN1.Types as Asn1
import Data.ByteString (ByteString)
import Data.Foldable (fold, foldMap)
import Data.List.NonEmpty (NonEmpty)
import Data.Maybe (maybe)
import Data.Monoid (Endo(Endo), (<>), mempty)
import qualified Data.Text.Encoding as Text
import Prelude (Integer, (.), fromIntegral)
import Ldap.Asn1.Type
class ToAsn1 a where
toAsn1 :: a -> Endo [ASN1]
instance ToAsn1 op => ToAsn1 (LdapMessage op) where
toAsn1 :: LdapMessage op -> Endo [ASN1]
toAsn1 (LdapMessage Id
i op
op Maybe Controls
mc) =
Endo [ASN1] -> Endo [ASN1]
sequence (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 Id
i forall a. Semigroup a => a -> a -> a
<> forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 op
op forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1) Maybe Controls
mc)
instance ToAsn1 Id where
toAsn1 :: Id -> Endo [ASN1]
toAsn1 (Id Int32
i) = forall a. a -> Endo [a]
single (Integer -> ASN1
Asn1.IntVal (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
i))
instance ToAsn1 LdapString where
toAsn1 :: LdapString -> Endo [ASN1]
toAsn1 (LdapString Text
s) = forall a. a -> Endo [a]
single (ByteString -> ASN1
Asn1.OctetString (Text -> ByteString
Text.encodeUtf8 Text
s))
instance ToAsn1 LdapOid where
toAsn1 :: LdapOid -> Endo [ASN1]
toAsn1 (LdapOid Text
s) = forall a. a -> Endo [a]
single (ByteString -> ASN1
Asn1.OctetString (Text -> ByteString
Text.encodeUtf8 Text
s))
instance ToAsn1 LdapDn where
toAsn1 :: LdapDn -> Endo [ASN1]
toAsn1 (LdapDn LdapString
s) = forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapString
s
instance ToAsn1 RelativeLdapDn where
toAsn1 :: RelativeLdapDn -> Endo [ASN1]
toAsn1 (RelativeLdapDn LdapString
s) = forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapString
s
instance ToAsn1 AttributeDescription where
toAsn1 :: AttributeDescription -> Endo [ASN1]
toAsn1 (AttributeDescription LdapString
s) = forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapString
s
instance ToAsn1 AttributeValue where
toAsn1 :: AttributeValue -> Endo [ASN1]
toAsn1 (AttributeValue ByteString
s) = forall a. a -> Endo [a]
single (ByteString -> ASN1
Asn1.OctetString ByteString
s)
instance ToAsn1 AttributeValueAssertion where
toAsn1 :: AttributeValueAssertion -> Endo [ASN1]
toAsn1 (AttributeValueAssertion AttributeDescription
d AssertionValue
v) = forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeDescription
d forall a. Semigroup a => a -> a -> a
<> forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AssertionValue
v
instance ToAsn1 AssertionValue where
toAsn1 :: AssertionValue -> Endo [ASN1]
toAsn1 (AssertionValue ByteString
s) = forall a. a -> Endo [a]
single (ByteString -> ASN1
Asn1.OctetString ByteString
s)
instance ToAsn1 PartialAttribute where
toAsn1 :: PartialAttribute -> Endo [ASN1]
toAsn1 (PartialAttribute AttributeDescription
d [AttributeValue]
xs) = Endo [ASN1] -> Endo [ASN1]
sequence (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeDescription
d forall a. Semigroup a => a -> a -> a
<> Endo [ASN1] -> Endo [ASN1]
set (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 [AttributeValue]
xs))
instance ToAsn1 Attribute where
toAsn1 :: Attribute -> Endo [ASN1]
toAsn1 (Attribute AttributeDescription
d NonEmpty AttributeValue
xs) = Endo [ASN1] -> Endo [ASN1]
sequence (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeDescription
d forall a. Semigroup a => a -> a -> a
<> Endo [ASN1] -> Endo [ASN1]
set (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 NonEmpty AttributeValue
xs))
instance ToAsn1 MatchingRuleId where
toAsn1 :: MatchingRuleId -> Endo [ASN1]
toAsn1 (MatchingRuleId LdapString
s) = forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapString
s
instance ToAsn1 Controls where
toAsn1 :: Controls -> Endo [ASN1]
toAsn1 (Controls [Control]
cs) = Endo [ASN1] -> Endo [ASN1]
sequence (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 [Control]
cs)
instance ToAsn1 Control where
toAsn1 :: Control -> Endo [ASN1]
toAsn1 (Control LdapOid
t Bool
c Maybe ByteString
v) =
Endo [ASN1] -> Endo [ASN1]
sequence (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapOid
t
, forall a. a -> Endo [a]
single (Bool -> ASN1
Asn1.Boolean Bool
c)
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall a. a -> Endo [a]
single forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ASN1
Asn1.OctetString) Maybe ByteString
v
])
instance ToAsn1 ProtocolClientOp where
toAsn1 :: ProtocolClientOp -> Endo [ASN1]
toAsn1 (BindRequest Int8
v LdapDn
n AuthenticationChoice
a) =
ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
application ASN1Tag
0 (forall a. a -> Endo [a]
single (Integer -> ASN1
Asn1.IntVal (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int8
v)) forall a. Semigroup a => a -> a -> a
<> forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapDn
n forall a. Semigroup a => a -> a -> a
<> forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AuthenticationChoice
a)
toAsn1 ProtocolClientOp
UnbindRequest =
ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Application ASN1Tag
2 forall a. Monoid a => a
mempty
toAsn1 (SearchRequest LdapDn
bo Scope
s DerefAliases
da Int32
sl Int32
tl Bool
to Filter
f AttributeSelection
a) =
ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
application ASN1Tag
3 (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapDn
bo
, Integer -> Endo [ASN1]
enum Integer
s'
, Integer -> Endo [ASN1]
enum Integer
da'
, forall a. a -> Endo [a]
single (Integer -> ASN1
Asn1.IntVal (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
sl))
, forall a. a -> Endo [a]
single (Integer -> ASN1
Asn1.IntVal (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
tl))
, forall a. a -> Endo [a]
single (Bool -> ASN1
Asn1.Boolean Bool
to)
, forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 Filter
f
, forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeSelection
a
])
where
s' :: Integer
s' = case Scope
s of
Scope
BaseObject -> Integer
0
Scope
SingleLevel -> Integer
1
Scope
WholeSubtree -> Integer
2
da' :: Integer
da' = case DerefAliases
da of
DerefAliases
NeverDerefAliases -> Integer
0
DerefAliases
DerefInSearching -> Integer
1
DerefAliases
DerefFindingBaseObject -> Integer
2
DerefAliases
DerefAlways -> Integer
3
toAsn1 (ModifyRequest LdapDn
dn [(Operation, PartialAttribute)]
xs) =
ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
application ASN1Tag
6 (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapDn
dn
, Endo [ASN1] -> Endo [ASN1]
sequence (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\(Operation
op, PartialAttribute
pa) -> Endo [ASN1] -> Endo [ASN1]
sequence (Integer -> Endo [ASN1]
enum (case Operation
op of
Operation
Add -> Integer
0
Operation
Delete -> Integer
1
Operation
Replace -> Integer
2) forall a. Semigroup a => a -> a -> a
<> forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 PartialAttribute
pa)) [(Operation, PartialAttribute)]
xs)
])
toAsn1 (AddRequest LdapDn
dn AttributeList
as) =
ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
application ASN1Tag
8 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapDn
dn forall a. Semigroup a => a -> a -> a
<> forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeList
as)
toAsn1 (DeleteRequest (LdapDn (LdapString Text
dn))) =
ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Application ASN1Tag
10 (Text -> ByteString
Text.encodeUtf8 Text
dn)
toAsn1 (ModifyDnRequest LdapDn
dn RelativeLdapDn
rdn Bool
del Maybe LdapDn
new) =
ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
application ASN1Tag
12 (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapDn
dn
, forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 RelativeLdapDn
rdn
, forall a. a -> Endo [a]
single (Bool -> ASN1
Asn1.Boolean Bool
del)
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty
(\(LdapDn (LdapString Text
dn')) -> ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
0 (Text -> ByteString
Text.encodeUtf8 Text
dn'))
Maybe LdapDn
new
])
toAsn1 (CompareRequest LdapDn
dn AttributeValueAssertion
av) =
ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
application ASN1Tag
14 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 LdapDn
dn forall a. Semigroup a => a -> a -> a
<> Endo [ASN1] -> Endo [ASN1]
sequence (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeValueAssertion
av))
toAsn1 (ExtendedRequest (LdapOid Text
oid) Maybe ByteString
mv) =
ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
application ASN1Tag
23 (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
0 (Text -> ByteString
Text.encodeUtf8 Text
oid)
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
1) Maybe ByteString
mv
])
instance ToAsn1 AuthenticationChoice where
toAsn1 :: AuthenticationChoice -> Endo [ASN1]
toAsn1 (Simple ByteString
s) = ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
0 ByteString
s
toAsn1 (Sasl SaslMechanism
External Maybe Text
c) =
ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
3 (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 (Text -> LdapString
LdapString Text
"EXTERNAL")
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> LdapString
LdapString) Maybe Text
c
])
instance ToAsn1 AttributeSelection where
toAsn1 :: AttributeSelection -> Endo [ASN1]
toAsn1 (AttributeSelection [LdapString]
as) = Endo [ASN1] -> Endo [ASN1]
sequence (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 [LdapString]
as)
instance ToAsn1 Filter where
toAsn1 :: Filter -> Endo [ASN1]
toAsn1 Filter
f = case Filter
f of
And NonEmpty Filter
xs -> ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
0 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 NonEmpty Filter
xs)
Or NonEmpty Filter
xs -> ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
1 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 NonEmpty Filter
xs)
Not Filter
x -> ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
2 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 Filter
x)
EqualityMatch AttributeValueAssertion
x -> ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
3 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeValueAssertion
x)
Substrings SubstringFilter
x -> ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
4 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 SubstringFilter
x)
GreaterOrEqual AttributeValueAssertion
x -> ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
5 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeValueAssertion
x)
LessOrEqual AttributeValueAssertion
x -> ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
6 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeValueAssertion
x)
Present (AttributeDescription (LdapString Text
x))
-> ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
7 (Text -> ByteString
Text.encodeUtf8 Text
x)
ApproxMatch AttributeValueAssertion
x -> ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
8 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeValueAssertion
x)
ExtensibleMatch MatchingRuleAssertion
x -> ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context ASN1Tag
9 (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 MatchingRuleAssertion
x)
instance ToAsn1 SubstringFilter where
toAsn1 :: SubstringFilter -> Endo [ASN1]
toAsn1 (SubstringFilter AttributeDescription
ad NonEmpty Substring
ss) =
forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 AttributeDescription
ad forall a. Semigroup a => a -> a -> a
<> Endo [ASN1] -> Endo [ASN1]
sequence (forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\Substring
s -> case Substring
s of
Initial (AssertionValue ByteString
v) -> ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
0 ByteString
v
Any (AssertionValue ByteString
v) -> ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
1 ByteString
v
Final (AssertionValue ByteString
v) -> ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
2 ByteString
v) NonEmpty Substring
ss)
instance ToAsn1 MatchingRuleAssertion where
toAsn1 :: MatchingRuleAssertion -> Endo [ASN1]
toAsn1 (MatchingRuleAssertion Maybe MatchingRuleId
mmr Maybe AttributeDescription
mad (AssertionValue ByteString
av) Bool
_) = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold
[ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty MatchingRuleId -> Endo [ASN1]
f Maybe MatchingRuleId
mmr
, forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty AttributeDescription -> Endo [ASN1]
g Maybe AttributeDescription
mad
, ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
3 ByteString
av
]
where
f :: MatchingRuleId -> Endo [ASN1]
f (MatchingRuleId (LdapString Text
x)) = ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
1 (Text -> ByteString
Text.encodeUtf8 Text
x)
g :: AttributeDescription -> Endo [ASN1]
g (AttributeDescription (LdapString Text
x)) = ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
Asn1.Context ASN1Tag
2 (Text -> ByteString
Text.encodeUtf8 Text
x)
instance ToAsn1 AttributeList where
toAsn1 :: AttributeList -> Endo [ASN1]
toAsn1 (AttributeList [Attribute]
xs) = Endo [ASN1] -> Endo [ASN1]
sequence (forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1 [Attribute]
xs)
instance ToAsn1 a => ToAsn1 [a] where
toAsn1 :: [a] -> Endo [ASN1]
toAsn1 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1
instance ToAsn1 a => ToAsn1 (NonEmpty a) where
toAsn1 :: NonEmpty a -> Endo [ASN1]
toAsn1 = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap forall a. ToAsn1 a => a -> Endo [ASN1]
toAsn1
sequence :: Endo [ASN1] -> Endo [ASN1]
sequence :: Endo [ASN1] -> Endo [ASN1]
sequence = ASN1ConstructionType -> Endo [ASN1] -> Endo [ASN1]
construction ASN1ConstructionType
Asn1.Sequence
set :: Endo [ASN1] -> Endo [ASN1]
set :: Endo [ASN1] -> Endo [ASN1]
set = ASN1ConstructionType -> Endo [ASN1] -> Endo [ASN1]
construction ASN1ConstructionType
Asn1.Set
application :: ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
application :: ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
application = ASN1ConstructionType -> Endo [ASN1] -> Endo [ASN1]
construction forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Class -> ASN1Tag -> ASN1ConstructionType
Asn1.Container ASN1Class
Asn1.Application
context :: ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context :: ASN1Tag -> Endo [ASN1] -> Endo [ASN1]
context = ASN1ConstructionType -> Endo [ASN1] -> Endo [ASN1]
construction forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Class -> ASN1Tag -> ASN1ConstructionType
Asn1.Container ASN1Class
Asn1.Context
construction :: ASN1ConstructionType -> Endo [ASN1] -> Endo [ASN1]
construction :: ASN1ConstructionType -> Endo [ASN1] -> Endo [ASN1]
construction ASN1ConstructionType
t Endo [ASN1]
x = forall a. a -> Endo [a]
single (ASN1ConstructionType -> ASN1
Asn1.Start ASN1ConstructionType
t) forall a. Semigroup a => a -> a -> a
<> Endo [ASN1]
x forall a. Semigroup a => a -> a -> a
<> forall a. a -> Endo [a]
single (ASN1ConstructionType -> ASN1
Asn1.End ASN1ConstructionType
t)
other :: ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other :: ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
other ASN1Class
c ASN1Tag
t = forall a. a -> Endo [a]
single forall b c a. (b -> c) -> (a -> b) -> a -> c
. ASN1Class -> ASN1Tag -> ByteString -> ASN1
Asn1.Other ASN1Class
c ASN1Tag
t
enum :: Integer -> Endo [ASN1]
enum :: Integer -> Endo [ASN1]
enum = forall a. a -> Endo [a]
single forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ASN1
Asn1.Enumerated
single :: a -> Endo [a]
single :: forall a. a -> Endo [a]
single a
x = forall a. (a -> a) -> Endo a
Endo (a
x forall a. a -> [a] -> [a]
:)