{-# LANGUAGE CPP #-}
-- | This module contains convertions from ASN.1 to LDAP types.
module Ldap.Asn1.FromAsn1
  ( parseAsn1
  , FromAsn1
  ) where

import           Control.Applicative (Alternative(..), liftA2, optional)
import           Control.Monad (MonadPlus(..), (>=>), guard)
import           Data.ASN1.Types (ASN1)
import qualified Data.ASN1.Types as Asn1
import           Data.Foldable (asum)
import           Data.List.NonEmpty (some1)
import qualified Data.Text.Encoding as Text

import           Ldap.Asn1.Type

{-# ANN module ("HLint: ignore Use const" :: String) #-}
{-# ANN module ("HLint: ignore Avoid lambda" :: String) #-}


-- | Convert a part of ASN.1 stream to a LDAP type returning the remainder of the stream.
parseAsn1 :: FromAsn1 a => [ASN1] -> Maybe ([ASN1], a)
parseAsn1 :: forall a. FromAsn1 a => [ASN1] -> Maybe ([ASN1], a)
parseAsn1 = forall s a. Parser s a -> s -> Maybe (s, a)
parse forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1

-- | ASN.1 stream parsers.
--
-- When it's relevant, instances include the part of RFC describing the encoding.
class FromAsn1 a where
  fromAsn1 :: Parser [ASN1] a

{- |
@
LDAPMessage ::= SEQUENCE {
     messageID       MessageID,
     protocolOp      CHOICE {
          bindRequest           BindRequest,
          bindResponse          BindResponse,
          unbindRequest         UnbindRequest,
          searchRequest         SearchRequest,
          searchResEntry        SearchResultEntry,
          searchResDone         SearchResultDone,
          searchResRef          SearchResultReference,
          addRequest            AddRequest,
          addResponse           AddResponse,
          ... },
     controls       [0] Controls OPTIONAL }
@
-}
instance FromAsn1 op =>  FromAsn1 (LdapMessage op) where
  fromAsn1 :: Parser [ASN1] (LdapMessage op)
fromAsn1 = do
    Asn1.Start ASN1ConstructionType
Asn1.Sequence <- forall s. Parser [s] s
next
    Id
i  <- forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
    op
op <- forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
    Asn1.End ASN1ConstructionType
Asn1.Sequence <- forall s. Parser [s] s
next
    forall (m :: * -> *) a. Monad m => a -> m a
return (forall op. Id -> op -> Maybe Controls -> LdapMessage op
LdapMessage Id
i op
op forall a. Maybe a
Nothing)

{- |
@
MessageID ::= INTEGER (0 ..  maxInt)
@
-}
instance FromAsn1 Id where
  fromAsn1 :: Parser [ASN1] Id
fromAsn1 = do
    Asn1.IntVal Integer
i <- forall s. Parser [s] s
next
    forall (m :: * -> *) a. Monad m => a -> m a
return (Int32 -> Id
Id (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
i))

{- |
@
LDAPString ::= OCTET STRING -- UTF-8 encoded,
@
-}
instance FromAsn1 LdapString where
  fromAsn1 :: Parser [ASN1] LdapString
fromAsn1 = do
    Asn1.OctetString ByteString
s <- forall s. Parser [s] s
next
    case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
s of
      Right Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> LdapString
LdapString Text
t)
      Left  UnicodeException
_ -> forall (f :: * -> *) a. Alternative f => f a
empty

{- |
@
LDAPOID ::= OCTET STRING -- Constrained to \<numericoid\>
@
-}
instance FromAsn1 LdapOid where
  fromAsn1 :: Parser [ASN1] LdapOid
fromAsn1 = do
    Asn1.OctetString ByteString
s <- forall s. Parser [s] s
next
    case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
s of
      Right Text
t -> forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> LdapOid
LdapOid Text
t)
      Left  UnicodeException
_ -> forall (f :: * -> *) a. Alternative f => f a
empty

{- |
@
LDAPDN ::= LDAPString
@
-}
instance FromAsn1 LdapDn where
  fromAsn1 :: Parser [ASN1] LdapDn
fromAsn1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LdapString -> LdapDn
LdapDn forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1

{- |
@
AttributeDescription ::= LDAPString
@
-}
instance FromAsn1 AttributeDescription where
  fromAsn1 :: Parser [ASN1] AttributeDescription
fromAsn1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LdapString -> AttributeDescription
AttributeDescription forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1

{- |
@
AttributeValue ::= OCTET STRING
@
-}
instance FromAsn1 AttributeValue where
  fromAsn1 :: Parser [ASN1] AttributeValue
fromAsn1 = do
    Asn1.OctetString ByteString
s <- forall s. Parser [s] s
next
    forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> AttributeValue
AttributeValue ByteString
s)

{- |
@
PartialAttribute ::= SEQUENCE {
     type       AttributeDescription,
     vals       SET OF value AttributeValue }
@
-}
instance FromAsn1 PartialAttribute where
  fromAsn1 :: Parser [ASN1] PartialAttribute
fromAsn1 = do
    Asn1.Start ASN1ConstructionType
Asn1.Sequence <- forall s. Parser [s] s
next
    AttributeDescription
d  <- forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
    Asn1.Start ASN1ConstructionType
Asn1.Set <- forall s. Parser [s] s
next
    [AttributeValue]
vs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
    Asn1.End ASN1ConstructionType
Asn1.Set <- forall s. Parser [s] s
next
    Asn1.End ASN1ConstructionType
Asn1.Sequence <- forall s. Parser [s] s
next
    forall (m :: * -> *) a. Monad m => a -> m a
return (AttributeDescription -> [AttributeValue] -> PartialAttribute
PartialAttribute AttributeDescription
d [AttributeValue]
vs)

{- |
@
LDAPResult ::= SEQUENCE {
     resultCode         ENUMERATED {
          success                      (0),
          operationsError              (1),
          protocolError                (2),
          timeLimitExceeded            (3),
          sizeLimitExceeded            (4),
          compareFalse                 (5),
          compareTrue                  (6),
          authMethodNotSupported       (7),
          strongerAuthRequired         (8),
          -- 9 reserved --
          referral                     (10),
          adminLimitExceeded           (11),
          unavailableCriticalExtension (12),
          confidentialityRequired      (13),
          saslBindInProgress           (14),
          noSuchAttribute              (16),
          undefinedAttributeType       (17),
          inappropriateMatching        (18),
          constraintViolation          (19),
          attributeOrValueExists       (20),
          invalidAttributeSyntax       (21),
          -- 22-31 unused --
          noSuchObject                 (32),
          aliasProblem                 (33),
          invalidDNSyntax              (34),
          -- 35 reserved for undefined isLeaf --
          aliasDereferencingProblem    (36),
          -- 37-47 unused --
          inappropriateAuthentication  (48),
          invalidCredentials           (49),
          insufficientAccessRights     (50),
          busy                         (51),
          unavailable                  (52),
          unwillingToPerform           (53),
          loopDetect                   (54),
          -- 55-63 unused --
          namingViolation              (64),
          objectClassViolation         (65),
          notAllowedOnNonLeaf          (66),
          notAllowedOnRDN              (67),
          entryAlreadyExists           (68),
          objectClassModsProhibited    (69),
          -- 70 reserved for CLDAP --
          affectsMultipleDSAs          (71),
          -- 72-79 unused --
          other                        (80),
          ...  },
     matchedDN          LDAPDN,
     diagnosticMessage  LDAPString,
     referral           [3] Referral OPTIONAL }
@
-}
instance FromAsn1 LdapResult where
  fromAsn1 :: Parser [ASN1] LdapResult
fromAsn1 = do
    ResultCode
resultCode <- do
      Asn1.Enumerated Integer
x <- forall s. Parser [s] s
next
      case Integer
x of
        Integer
0  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
Success
        Integer
1  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
OperationError
        Integer
2  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
ProtocolError
        Integer
3  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
TimeLimitExceeded
        Integer
4  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
SizeLimitExceeded
        Integer
5  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
CompareFalse
        Integer
6  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
CompareTrue
        Integer
7  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
AuthMethodNotSupported
        Integer
8  -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
StrongerAuthRequired
        Integer
10 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
Referral
        Integer
11 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
AdminLimitExceeded
        Integer
12 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
UnavailableCriticalExtension
        Integer
13 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
ConfidentialityRequired
        Integer
14 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
SaslBindInProgress
        Integer
16 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
NoSuchAttribute
        Integer
17 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
UndefinedAttributeType
        Integer
18 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
InappropriateMatching
        Integer
19 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
ConstraintViolation
        Integer
20 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
AttributeOrValueExists
        Integer
21 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
InvalidAttributeSyntax
        Integer
32 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
NoSuchObject
        Integer
33 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
AliasProblem
        Integer
34 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
InvalidDNSyntax
        Integer
36 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
AliasDereferencingProblem
        Integer
48 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
InappropriateAuthentication
        Integer
49 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
InvalidCredentials
        Integer
50 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
InsufficientAccessRights
        Integer
51 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
Busy
        Integer
52 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
Unavailable
        Integer
53 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
UnwillingToPerform
        Integer
54 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
LoopDetect
        Integer
64 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
NamingViolation
        Integer
65 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
ObjectClassViolation
        Integer
66 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
NotAllowedOnNonLeaf
        Integer
67 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
NotAllowedOnRDN
        Integer
68 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
EntryAlreadyExists
        Integer
69 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
ObjectClassModsProhibited
        Integer
71 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
AffectsMultipleDSAs
        Integer
80 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ResultCode
Other
        Integer
_  -> forall (f :: * -> *) a. Alternative f => f a
empty
    LdapDn
matchedDn  <- forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
    LdapString
diagnosticMessage
               <- forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
    Maybe ReferralUris
referral   <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
      Asn1.Start (Asn1.Container ASN1Class
Asn1.Context ASN1Tag
0) <- forall s. Parser [s] s
next
      ReferralUris
x <- forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
      Asn1.End (Asn1.Container ASN1Class
Asn1.Context ASN1Tag
0) <- forall s. Parser [s] s
next
      forall (m :: * -> *) a. Monad m => a -> m a
return ReferralUris
x
    forall (m :: * -> *) a. Monad m => a -> m a
return (ResultCode
-> LdapDn -> LdapString -> Maybe ReferralUris -> LdapResult
LdapResult ResultCode
resultCode LdapDn
matchedDn LdapString
diagnosticMessage Maybe ReferralUris
referral)

{- |
@
Referral ::= SEQUENCE SIZE (1..MAX) OF uri URI
@
-}
instance FromAsn1 ReferralUris where
  fromAsn1 :: Parser [ASN1] ReferralUris
fromAsn1 = do
    Asn1.Start ASN1ConstructionType
Asn1.Sequence <- forall s. Parser [s] s
next
    NonEmpty Uri
xs <- forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
some1 forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
    Asn1.End ASN1ConstructionType
Asn1.Sequence <- forall s. Parser [s] s
next
    forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty Uri -> ReferralUris
ReferralUris NonEmpty Uri
xs)

{- |
@
URI ::= LDAPString
@
-}
instance FromAsn1 Uri where
  fromAsn1 :: Parser [ASN1] Uri
fromAsn1 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LdapString -> Uri
Uri forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1

{- |
@
BindResponse ::= [APPLICATION 1] SEQUENCE {
     COMPONENTS OF LDAPResult,
     serverSaslCreds    [7] OCTET STRING OPTIONAL }
@

@
SearchResultEntry ::= [APPLICATION 4] SEQUENCE {
     objectName      LDAPDN,
     attributes      PartialAttributeList }
@

@
SearchResultReference ::= [APPLICATION 19] SEQUENCE
                          SIZE (1..MAX) OF uri URI
@

@
SearchResultDone ::= [APPLICATION 5] LDAPResult
@

@
ModifyResponse ::= [APPLICATION 7] LDAPResult
@

@
AddResponse ::= [APPLICATION 9] LDAPResult
@

@
DelResponse ::= [APPLICATION 11] LDAPResult
@

@
ModifyDNResponse ::= [APPLICATION 13] LDAPResult
@

@
CompareResponse ::= [APPLICATION 15] LDAPResult
@

@
ExtendedResponse ::= [APPLICATION 24] SEQUENCE {
     COMPONENTS OF LDAPResult,
     responseName     [10] LDAPOID OPTIONAL,
     responseValue    [11] OCTET STRING OPTIONAL }
@

@
IntermediateResponse ::= [APPLICATION 25] SEQUENCE {
     responseName     [0] LDAPOID OPTIONAL,
     responseValue    [1] OCTET STRING OPTIONAL }
@
-}
instance FromAsn1 ProtocolServerOp where
  fromAsn1 :: Parser [ASN1] ProtocolServerOp
fromAsn1 = forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\LdapResult
res -> LdapResult -> Maybe ByteString -> ProtocolServerOp
BindResponse LdapResult
res forall a. Maybe a
Nothing) (forall {b}. FromAsn1 b => ASN1Tag -> Parser [ASN1] b
app ASN1Tag
1)
    , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry LdapDn -> PartialAttributeList -> ProtocolServerOp
SearchResultEntry) (forall {b}. FromAsn1 b => ASN1Tag -> Parser [ASN1] b
app ASN1Tag
4)
    , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LdapResult -> ProtocolServerOp
SearchResultDone (forall {b}. FromAsn1 b => ASN1Tag -> Parser [ASN1] b
app ASN1Tag
5)
    , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LdapResult -> ProtocolServerOp
ModifyResponse (forall {b}. FromAsn1 b => ASN1Tag -> Parser [ASN1] b
app ASN1Tag
7)
    , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LdapResult -> ProtocolServerOp
AddResponse (forall {b}. FromAsn1 b => ASN1Tag -> Parser [ASN1] b
app ASN1Tag
9)
    , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LdapResult -> ProtocolServerOp
DeleteResponse (forall {b}. FromAsn1 b => ASN1Tag -> Parser [ASN1] b
app ASN1Tag
11)
    , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LdapResult -> ProtocolServerOp
ModifyDnResponse (forall {b}. FromAsn1 b => ASN1Tag -> Parser [ASN1] b
app ASN1Tag
13)
    , forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap LdapResult -> ProtocolServerOp
CompareResponse (forall {b}. FromAsn1 b => ASN1Tag -> Parser [ASN1] b
app ASN1Tag
15)

    , do
      Asn1.Start (Asn1.Container ASN1Class
Asn1.Application ASN1Tag
19) <- forall s. Parser [s] s
next
      NonEmpty Uri
uris <- forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
some1 forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
      Asn1.End (Asn1.Container ASN1Class
Asn1.Application ASN1Tag
19) <- forall s. Parser [s] s
next
      forall (m :: * -> *) a. Monad m => a -> m a
return (NonEmpty Uri -> ProtocolServerOp
SearchResultReference NonEmpty Uri
uris)

    , do
      Asn1.Start (Asn1.Container ASN1Class
Asn1.Application ASN1Tag
24) <- forall s. Parser [s] s
next
      LdapResult
res <- forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
      Maybe ByteString
utf8Name <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
        Asn1.Other ASN1Class
Asn1.Context ASN1Tag
10 ByteString
s <- forall s. Parser [s] s
next
        forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
      Maybe Text
name <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (\ByteString
n -> case ByteString -> Either UnicodeException Text
Text.decodeUtf8' ByteString
n of
        Left  UnicodeException
_    -> forall (f :: * -> *) a. Alternative f => f a
empty
        Right Text
name -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Text
name)) Maybe ByteString
utf8Name
      Maybe ByteString
value <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
        Asn1.Other ASN1Class
Asn1.Context ASN1Tag
11 ByteString
s <- forall s. Parser [s] s
next
        forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
      Asn1.End (Asn1.Container ASN1Class
Asn1.Application ASN1Tag
24) <- forall s. Parser [s] s
next
      forall (m :: * -> *) a. Monad m => a -> m a
return (LdapResult -> Maybe LdapOid -> Maybe ByteString -> ProtocolServerOp
ExtendedResponse LdapResult
res (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> LdapOid
LdapOid Maybe Text
name) Maybe ByteString
value)

    , do
      Asn1.Start (Asn1.Container ASN1Class
Asn1.Application ASN1Tag
25) <- forall s. Parser [s] s
next
      Maybe LdapOid
name  <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
      Maybe ByteString
value <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
        Asn1.OctetString ByteString
s <- forall s. Parser [s] s
next
        forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
s
      Asn1.End (Asn1.Container ASN1Class
Asn1.Application ASN1Tag
25) <- forall s. Parser [s] s
next
      forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe LdapOid -> Maybe ByteString -> ProtocolServerOp
IntermediateResponse Maybe LdapOid
name Maybe ByteString
value)
    ]
   where
    app :: ASN1Tag -> Parser [ASN1] b
app ASN1Tag
l = do
      Asn1.Start (Asn1.Container ASN1Class
Asn1.Application ASN1Tag
x) <- forall s. Parser [s] s
next
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ASN1Tag
x forall a. Eq a => a -> a -> Bool
== ASN1Tag
l)
      b
res <- forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
      Asn1.End (Asn1.Container ASN1Class
Asn1.Application ASN1Tag
y) <- forall s. Parser [s] s
next
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard (ASN1Tag
y forall a. Eq a => a -> a -> Bool
== ASN1Tag
l)
      forall (m :: * -> *) a. Monad m => a -> m a
return b
res

{- |
@
PartialAttributeList ::= SEQUENCE OF partialAttribute PartialAttribute
@
-}
instance FromAsn1 PartialAttributeList where
  fromAsn1 :: Parser [ASN1] PartialAttributeList
fromAsn1 = do
    Asn1.Start ASN1ConstructionType
Asn1.Sequence <- forall s. Parser [s] s
next
    [PartialAttribute]
xs <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1
    Asn1.End ASN1ConstructionType
Asn1.Sequence <- forall s. Parser [s] s
next
    forall (m :: * -> *) a. Monad m => a -> m a
return ([PartialAttribute] -> PartialAttributeList
PartialAttributeList [PartialAttribute]
xs)

instance (FromAsn1 a, FromAsn1 b) => FromAsn1 (a, b) where
  fromAsn1 :: Parser [ASN1] (a, b)
fromAsn1 = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1 forall a. FromAsn1 a => Parser [ASN1] a
fromAsn1


newtype Parser s a = Parser { forall s a. Parser s a -> s -> Maybe (s, a)
unParser :: s -> Maybe (s, a) }

instance Functor (Parser s) where
  fmap :: forall a b. (a -> b) -> Parser s a -> Parser s b
fmap a -> b
f (Parser s -> Maybe (s, a)
g) = forall s a. (s -> Maybe (s, a)) -> Parser s a
Parser (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. s -> Maybe (s, a)
g)

instance Applicative (Parser s) where
  pure :: forall a. a -> Parser s a
pure a
x = forall s a. (s -> Maybe (s, a)) -> Parser s a
Parser (\s
s -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s, a
x))
  Parser s -> Maybe (s, a -> b)
mf <*> :: forall a b. Parser s (a -> b) -> Parser s a -> Parser s b
<*> Parser s -> Maybe (s, a)
mx = forall s a. (s -> Maybe (s, a)) -> Parser s a
Parser forall a b. (a -> b) -> a -> b
$ \s
s -> do
    (s
s', a -> b
f)  <- s -> Maybe (s, a -> b)
mf s
s
    (s
s'', a
x) <- s -> Maybe (s, a)
mx s
s'
    forall (f :: * -> *) a. Applicative f => a -> f a
pure (s
s'', a -> b
f a
x)

instance Alternative (Parser s) where
  empty :: forall a. Parser s a
empty = forall s a. (s -> Maybe (s, a)) -> Parser s a
Parser (\s
_ -> forall (f :: * -> *) a. Alternative f => f a
empty)
  Parser s -> Maybe (s, a)
ma <|> :: forall a. Parser s a -> Parser s a -> Parser s a
<|> Parser s -> Maybe (s, a)
mb =
    forall s a. (s -> Maybe (s, a)) -> Parser s a
Parser (\s
s -> s -> Maybe (s, a)
ma s
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> s -> Maybe (s, a)
mb s
s)

instance Monad (Parser s) where
  return :: forall a. a -> Parser s a
return a
x = forall s a. (s -> Maybe (s, a)) -> Parser s a
Parser (\s
s -> forall (m :: * -> *) a. Monad m => a -> m a
return (s
s, a
x))
  Parser s -> Maybe (s, a)
mx >>= :: forall a b. Parser s a -> (a -> Parser s b) -> Parser s b
>>= a -> Parser s b
k =
    forall s a. (s -> Maybe (s, a)) -> Parser s a
Parser (s -> Maybe (s, a)
mx forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \(s
s', a
x) -> forall s a. Parser s a -> s -> Maybe (s, a)
unParser (a -> Parser s b
k a
x) s
s')

instance MonadFail (Parser s) where
  fail :: forall a. String -> Parser s a
fail String
_ = forall (f :: * -> *) a. Alternative f => f a
empty

instance MonadPlus (Parser s) where
  mzero :: forall a. Parser s a
mzero = forall s a. (s -> Maybe (s, a)) -> Parser s a
Parser (\s
_ -> forall (m :: * -> *) a. MonadPlus m => m a
mzero)
  Parser s -> Maybe (s, a)
ma mplus :: forall a. Parser s a -> Parser s a -> Parser s a
`mplus` Parser s -> Maybe (s, a)
mb =
    forall s a. (s -> Maybe (s, a)) -> Parser s a
Parser (\s
s -> s -> Maybe (s, a)
ma s
s forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
`mplus` s -> Maybe (s, a)
mb s
s)

parse :: Parser s a -> s -> Maybe (s, a)
parse :: forall s a. Parser s a -> s -> Maybe (s, a)
parse = forall s a. Parser s a -> s -> Maybe (s, a)
unParser

next :: Parser [s] s
next :: forall s. Parser [s] s
next = forall s a. (s -> Maybe (s, a)) -> Parser s a
Parser (\[s]
s -> case [s]
s of [] -> forall a. Maybe a
Nothing; s
x : [s]
xs -> forall a. a -> Maybe a
Just ([s]
xs, s
x))