{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module      : Text.LDAP.Parser
-- Copyright   : 2014-2018 Kei Hibino
-- License     : BSD3
--
-- Maintainer  : ex8k.hibino@gmail.com
-- Stability   : experimental
-- Portability : unknown
--
module Text.LDAP.Parser
       ( LdapParser, runLdapParser

       , dn, component, attribute

       , ldifDN, ldifAttr

       , openLdapEntry, openLdapData
       , openLdapDataBlocks

       , ldifDecodeAttrValue, ldifAttrValue

       , ldifDecodeB64Value
       ) where

import Control.Applicative
  ((<$>), pure, (<*>), (*>), (<*), (<|>), some, many)
import Numeric (readHex)
import Data.Monoid ((<>))
import Data.Word (Word8)
import Data.ByteString (ByteString, pack)
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy.Char8 as LB
import Data.Attoparsec.ByteString.Char8
  (Parser, satisfy, isAlpha_ascii, char, char8, digit)
import qualified Data.Attoparsec.ByteString.Char8 as AP
import qualified Data.Attoparsec.ByteString as APW
import Data.Attoparsec.ByteString.Lazy (parse, eitherResult)
import Data.ByteArray.Encoding (Base (Base64), convertFromBase)

import Text.LDAP.Data
  (AttrType (..), AttrValue (..), Attribute, Component, DN, LdifAttrValue (..),
   ordW8, exact, inBounds, elem', notElem')
import qualified Text.LDAP.Data as Data
import Text.LDAP.InternalParser (satisfyW8, ldifSafeString)
import qualified Text.LDAP.InternalParser as Internal


-- | Parser context type for LDAP data stream
type LdapParser = Internal.LdapParser

-- | Run 'LdapParser' context.
runLdapParser :: Parser a -> LB.ByteString -> Either String a
runLdapParser :: Parser a -> ByteString -> Either String a
runLdapParser Parser a
p = Result a -> Either String a
forall r. Result r -> Either String r
eitherResult (Result a -> Either String a)
-> (ByteString -> Result a) -> ByteString -> Either String a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parser a -> ByteString -> Result a
forall a. Parser a -> ByteString -> Result a
parse (Parser a
p Parser a -> Parser ByteString () -> Parser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
forall t. Chunk t => Parser t ()
AP.endOfInput)


spaces :: LdapParser ()
spaces :: Parser ByteString ()
spaces =  Parser ByteString Char -> Parser ByteString String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser ByteString Char
char Char
' ') Parser ByteString String
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> Parser ByteString ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

alpha :: LdapParser Char
alpha :: Parser ByteString Char
alpha =  (Char -> Bool) -> Parser ByteString Char
satisfy Char -> Bool
isAlpha_ascii

alphaW8 :: LdapParser Word8
alphaW8 :: LdapParser Word8
alphaW8 =  Char -> Word8
ordW8 (Char -> Word8) -> Parser ByteString Char -> LdapParser Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
alpha

digitW8 :: LdapParser Word8
digitW8 :: LdapParser Word8
digitW8 =  Char -> Word8
ordW8 (Char -> Word8) -> Parser ByteString Char -> LdapParser Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
digit

quotation :: LdapParser Word8
quotation :: LdapParser Word8
quotation =  Word8 -> LdapParser Word8
APW.word8 Word8
Data.quotation

digits1' :: LdapParser ByteString
digits1' :: LdapParser ByteString
digits1' =  [Word8] -> ByteString
pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> LdapParser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some LdapParser Word8
digitW8


-- DN
keychar :: LdapParser Word8
keychar :: LdapParser Word8
keychar =  LdapParser Word8
alphaW8 LdapParser Word8 -> LdapParser Word8 -> LdapParser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LdapParser Word8
digitW8 LdapParser Word8 -> LdapParser Word8 -> LdapParser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> LdapParser Word8
char8 Char
'-'

quotechar :: LdapParser Word8
quotechar :: LdapParser Word8
quotechar =  (Word8 -> Bool) -> LdapParser Word8
APW.satisfy (Word8 -> [Word8] -> Bool
forall a. Ord a => a -> [a] -> Bool
`notElem'` [Char -> Word8
ordW8 Char
'\\', Word8
Data.quotation])

special :: LdapParser Word8
special :: LdapParser Word8
special =  (Word8 -> Bool) -> LdapParser Word8
APW.satisfy (Word8 -> [Word8] -> Bool
forall a. Ord a => a -> [a] -> Bool
`elem'` [Word8]
Data.specialChars)

stringchar :: LdapParser Word8
stringchar :: LdapParser Word8
stringchar =  (Word8 -> Bool) -> LdapParser Word8
APW.satisfy (Word8 -> [Word8] -> Bool
forall a. Ord a => a -> [a] -> Bool
`notElem'` (Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
map Char -> Word8
ordW8 [Char
'\r', Char
'\n', Char
'\\'] [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ Word8
Data.quotation Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
Data.specialChars)

hexchar :: LdapParser Char
hexchar :: Parser ByteString Char
hexchar =  Parser ByteString Char
digit Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser ByteString Char
satisfy (Char -> [(Char, Char)] -> Bool
forall a. (Enum a, Ord a) => a -> [(a, a)] -> Bool
`inBounds` [(Char
'a', Char
'f'), (Char
'A', Char
'F')])


hexpair :: LdapParser Word8
hexpair :: LdapParser Word8
hexpair =  (String -> Word8
forall p. (Eq p, Num p) => String -> p
rh (String -> Word8) -> Parser ByteString String -> LdapParser Word8
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parser ByteString String -> LdapParser Word8)
-> Parser ByteString String -> LdapParser Word8
forall a b. (a -> b) -> a -> b
$ (:) (Char -> String -> String)
-> Parser ByteString Char -> Parser ByteString (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
hexchar Parser ByteString (String -> String)
-> Parser ByteString String -> Parser ByteString String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((:) (Char -> String -> String)
-> Parser ByteString Char -> Parser ByteString (String -> String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Char
hexchar Parser ByteString (String -> String)
-> Parser ByteString String -> Parser ByteString String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> String -> Parser ByteString String
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])  where
  rh :: String -> p
rh String
s
    | [(p, String)]
rs [(p, String)] -> [(p, String)] -> Bool
forall a. Eq a => a -> a -> Bool
== []   =  String -> p
forall a. HasCallStack => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
"hexpair: BUG!: fail to read hex: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
s
    | Bool
otherwise  =  (p, String) -> p
forall a b. (a, b) -> a
fst ((p, String) -> p) -> (p, String) -> p
forall a b. (a -> b) -> a -> b
$ [(p, String)] -> (p, String)
forall a. [a] -> a
head [(p, String)]
rs
    where rs :: [(p, String)]
rs = ReadS p
forall a. (Eq a, Num a) => ReadS a
readHex String
s

pair :: LdapParser Word8
pair :: LdapParser Word8
pair =  Char -> Parser ByteString Char
char Char
'\\' Parser ByteString Char -> LdapParser Word8 -> LdapParser Word8
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (
  LdapParser Word8
special       LdapParser Word8 -> LdapParser Word8 -> LdapParser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Char -> LdapParser Word8
char8 Char
'\\'    LdapParser Word8 -> LdapParser Word8 -> LdapParser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  LdapParser Word8
quotation     LdapParser Word8 -> LdapParser Word8 -> LdapParser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  LdapParser Word8
hexpair )


hexstring :: LdapParser ByteString
hexstring :: LdapParser ByteString
hexstring =  [Word8] -> ByteString
pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> LdapParser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some LdapParser Word8
hexpair

string :: LdapParser ByteString
string :: LdapParser ByteString
string =  [Word8] -> ByteString
pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> LdapParser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (LdapParser Word8
stringchar LdapParser Word8 -> LdapParser Word8 -> LdapParser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LdapParser Word8
pair)  LdapParser ByteString
-> LdapParser ByteString -> LdapParser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          Char -> Parser ByteString Char
char Char
'#' Parser ByteString Char
-> LdapParser ByteString -> LdapParser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LdapParser ByteString
hexstring                LdapParser ByteString
-> LdapParser ByteString -> LdapParser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          [Word8] -> ByteString
pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> LdapParser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LdapParser Word8
quotation LdapParser Word8
-> Parser ByteString [Word8] -> Parser ByteString [Word8]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LdapParser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (LdapParser Word8
quotechar LdapParser Word8 -> LdapParser Word8 -> LdapParser Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LdapParser Word8
pair) Parser ByteString [Word8]
-> LdapParser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* LdapParser Word8
quotation) {- Only for v2 -} LdapParser ByteString
-> LdapParser ByteString -> LdapParser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
          ByteString -> LdapParser ByteString
forall (f :: * -> *) a. Applicative f => a -> f a
pure ByteString
""

_testString :: Either String ByteString
_testString :: Either String ByteString
_testString =  LdapParser ByteString -> ByteString -> Either String ByteString
forall a. Parser a -> ByteString -> Either String a
runLdapParser LdapParser ByteString
string ByteString
"\",\""

attrOid :: LdapParser AttrType
attrOid :: LdapParser AttrType
attrOid =  ByteString -> [ByteString] -> AttrType
Data.attrOid (ByteString -> [ByteString] -> AttrType)
-> LdapParser ByteString
-> Parser ByteString ([ByteString] -> AttrType)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser ByteString
digits1' Parser ByteString ([ByteString] -> AttrType)
-> Parser ByteString [ByteString] -> LdapParser AttrType
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LdapParser ByteString -> Parser ByteString [ByteString]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser ByteString Char
char Char
'.' Parser ByteString Char
-> LdapParser ByteString -> LdapParser ByteString
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LdapParser ByteString
digits1')

attrTypeStr :: LdapParser AttrType
attrTypeStr :: LdapParser AttrType
attrTypeStr =  (ByteString -> AttrType
Data.AttrType (ByteString -> AttrType)
-> ([Word8] -> ByteString) -> [Word8] -> AttrType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
pack ([Word8] -> AttrType)
-> Parser ByteString [Word8] -> LdapParser AttrType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) (Parser ByteString [Word8] -> LdapParser AttrType)
-> Parser ByteString [Word8] -> LdapParser AttrType
forall a b. (a -> b) -> a -> b
$ (:) (Word8 -> [Word8] -> [Word8])
-> LdapParser Word8 -> Parser ByteString ([Word8] -> [Word8])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser Word8
alphaW8 Parser ByteString ([Word8] -> [Word8])
-> Parser ByteString [Word8] -> Parser ByteString [Word8]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LdapParser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many LdapParser Word8
keychar

attrType :: LdapParser AttrType
attrType :: LdapParser AttrType
attrType =  LdapParser AttrType
attrTypeStr LdapParser AttrType -> LdapParser AttrType -> LdapParser AttrType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LdapParser AttrType
attrOid

_testAT :: Either String AttrType
_testAT :: Either String AttrType
_testAT =  LdapParser AttrType -> ByteString -> Either String AttrType
forall a. Parser a -> ByteString -> Either String a
runLdapParser LdapParser AttrType
attrType ByteString
"dc"

attrValueString :: LdapParser AttrValue
attrValueString :: LdapParser AttrValue
attrValueString =  ByteString -> AttrValue
AttrValue (ByteString -> AttrValue)
-> LdapParser ByteString -> LdapParser AttrValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser ByteString
string

_testAV :: Either String AttrValue
_testAV :: Either String AttrValue
_testAV =  LdapParser AttrValue -> ByteString -> Either String AttrValue
forall a. Parser a -> ByteString -> Either String a
runLdapParser LdapParser AttrValue
attrValueString ByteString
"com"

-- | Parser of attribute pair string in RDN.
attribute :: LdapParser Attribute
attribute :: LdapParser Attribute
attribute =  (,)
             (AttrType -> AttrValue -> Attribute)
-> LdapParser AttrType
-> Parser ByteString (AttrValue -> Attribute)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LdapParser AttrType
attrType LdapParser AttrType
-> Parser ByteString Char -> LdapParser AttrType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
'=')
             Parser ByteString (AttrValue -> Attribute)
-> LdapParser AttrValue -> LdapParser Attribute
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>  LdapParser AttrValue
attrValueString

_testAttr :: Either String Attribute
_testAttr :: Either String Attribute
_testAttr =  LdapParser Attribute -> ByteString -> Either String Attribute
forall a. Parser a -> ByteString -> Either String a
runLdapParser LdapParser Attribute
attribute ByteString
"dc=com"

-- | Parser of RDN string.
component :: LdapParser Component
component :: LdapParser Component
component =  Attribute -> [Attribute] -> Component
Data.component (Attribute -> [Attribute] -> Component)
-> LdapParser Attribute
-> Parser ByteString ([Attribute] -> Component)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser Attribute
attribute Parser ByteString ([Attribute] -> Component)
-> Parser ByteString [Attribute] -> LdapParser Component
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LdapParser Attribute -> Parser ByteString [Attribute]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Char -> Parser ByteString Char
char Char
'+' Parser ByteString Char
-> LdapParser Attribute -> LdapParser Attribute
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LdapParser Attribute
attribute)

comma :: LdapParser Char
comma :: Parser ByteString Char
comma =  Parser ByteString ()
spaces Parser ByteString ()
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char -> Parser ByteString Char
char Char
',' Parser ByteString Char
-> Parser ByteString Char -> Parser ByteString Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Parser ByteString Char
char Char
';') Parser ByteString Char
-> Parser ByteString () -> Parser ByteString Char
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ByteString ()
spaces

-- | Parser of DN string.
dn :: LdapParser DN
dn :: LdapParser DN
dn =  Component -> [Component] -> DN
Data.consDN (Component -> [Component] -> DN)
-> LdapParser Component -> Parser ByteString ([Component] -> DN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser Component
component Parser ByteString ([Component] -> DN)
-> Parser ByteString [Component] -> LdapParser DN
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LdapParser Component -> Parser ByteString [Component]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString Char
comma Parser ByteString Char
-> LdapParser Component -> LdapParser Component
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LdapParser Component
component)



-- LDIF
fill :: LdapParser ()
fill :: Parser ByteString ()
fill =  Parser ByteString ()
spaces

base64Bounds :: [(Char, Char)]
base64Bounds :: [(Char, Char)]
base64Bounds =  [(Char
'A', Char
'Z'), (Char
'a', Char
'z'), (Char
'0', Char
'9'), Char -> (Char, Char)
forall a. a -> Bound a
exact Char
'+', Char -> (Char, Char)
forall a. a -> Bound a
exact Char
'/', Char -> (Char, Char)
forall a. a -> Bound a
exact Char
'=']

base64String :: LdapParser ByteString
base64String :: LdapParser ByteString
base64String =  [Word8] -> ByteString
pack ([Word8] -> ByteString)
-> Parser ByteString [Word8] -> LdapParser ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser Word8 -> Parser ByteString [Word8]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Char -> Bool) -> LdapParser Word8
satisfyW8 (Char -> [(Char, Char)] -> Bool
forall a. (Enum a, Ord a) => a -> [(a, a)] -> Bool
`inBounds` [(Char, Char)]
base64Bounds))

padDecodeB64 :: ByteString -> Either String ByteString
padDecodeB64 :: ByteString -> Either String ByteString
padDecodeB64 ByteString
s = ByteString -> Either String ByteString
forall bin b.
(IsString bin, IsString b, ByteArray b, Eq bin,
 ByteArrayAccess bin) =>
bin -> Either String b
fromB64 (ByteString
s ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
pad)  where
  pad :: ByteString
pad = Int -> Char -> ByteString
BS8.replicate ((- ByteString -> Int
BS8.length ByteString
s) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4) Char
'='
  fromB64 :: bin -> Either String b
fromB64 bin
"" = b -> Either String b
forall a b. b -> Either a b
Right b
""      -- avoid bug of older than memory-0.14.14
  fromB64 bin
bs  = Base -> bin -> Either String b
forall bin bout.
(ByteArrayAccess bin, ByteArray bout) =>
Base -> bin -> Either String bout
convertFromBase Base
Base64 bin
bs

eitherParser :: String -> Either String a -> LdapParser a
eitherParser :: String -> Either String a -> LdapParser a
eitherParser String
s = (String -> LdapParser a)
-> (a -> LdapParser a) -> Either String a -> LdapParser a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> LdapParser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> LdapParser a)
-> (String -> String) -> String -> LdapParser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": ") String -> String -> String
forall a. [a] -> [a] -> [a]
++)) a -> LdapParser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

decodeBase64 :: ByteString -> LdapParser ByteString
decodeBase64 :: ByteString -> LdapParser ByteString
decodeBase64 =  String -> Either String ByteString -> LdapParser ByteString
forall a. String -> Either String a -> LdapParser a
eitherParser String
"internal decodeBase64" (Either String ByteString -> LdapParser ByteString)
-> (ByteString -> Either String ByteString)
-> ByteString
-> LdapParser ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either String ByteString
padDecodeB64

parseDN :: ByteString -> LdapParser DN
parseDN :: ByteString -> LdapParser DN
parseDN ByteString
s =
  String -> Either String DN -> LdapParser DN
forall a. String -> Either String a -> LdapParser a
eitherParser String
"internal parseDN"
    (Either String DN -> LdapParser DN)
-> (ByteString -> Either String DN) -> ByteString -> LdapParser DN
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LdapParser DN -> ByteString -> Either String DN
forall a. Parser a -> ByteString -> Either String a
runLdapParser LdapParser DN
dn (ByteString -> LdapParser DN) -> ByteString -> LdapParser DN
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
LB.fromChunks [ByteString
s]

-- | Parser of LDIF DN line.
ldifDN :: LdapParser DN
ldifDN :: LdapParser DN
ldifDN =  ByteString -> LdapParser ByteString
AP.string ByteString
"dn:" LdapParser ByteString -> LdapParser DN -> LdapParser DN
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (
  Parser ByteString ()
fill Parser ByteString () -> LdapParser DN -> LdapParser DN
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LdapParser DN
dn                                              LdapParser DN -> LdapParser DN -> LdapParser DN
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Char -> Parser ByteString Char
char Char
':' Parser ByteString Char
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
fill Parser ByteString () -> LdapParser DN -> LdapParser DN
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> LdapParser DN
parseDN (ByteString -> LdapParser DN)
-> LdapParser ByteString -> LdapParser DN
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ByteString -> LdapParser ByteString
decodeBase64 (ByteString -> LdapParser ByteString)
-> LdapParser ByteString -> LdapParser ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< LdapParser ByteString
base64String)
  )

-- | Parser of LDIF attribute value which may be base64 encoded.
--   Available combinator parser to pass 'ldifAttr' or 'openLdapEntry', etc ...
ldifAttrValue :: Parser LdifAttrValue
ldifAttrValue :: Parser LdifAttrValue
ldifAttrValue =
  Parser ByteString ()
fill             Parser ByteString ()
-> Parser LdifAttrValue -> Parser LdifAttrValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> LdifAttrValue
LAttrValRaw    (ByteString -> LdifAttrValue)
-> LdapParser ByteString -> Parser LdifAttrValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser ByteString
ldifSafeString)  Parser LdifAttrValue
-> Parser LdifAttrValue -> Parser LdifAttrValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Char -> Parser ByteString Char
char Char
':' Parser ByteString Char
-> Parser ByteString () -> Parser ByteString ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
fill Parser ByteString ()
-> Parser LdifAttrValue -> Parser LdifAttrValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> LdifAttrValue
LAttrValBase64 (ByteString -> LdifAttrValue)
-> LdapParser ByteString -> Parser LdifAttrValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LdapParser ByteString
base64String)    Parser LdifAttrValue
-> Parser LdifAttrValue -> Parser LdifAttrValue
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>
  Parser ByteString ()
fill             Parser ByteString ()
-> Parser LdifAttrValue -> Parser LdifAttrValue
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> LdifAttrValue -> Parser LdifAttrValue
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> LdifAttrValue
LAttrValRaw ByteString
"")

-- | Decode value string of attribute pair after stream parsing.
ldifDecodeB64Value :: LdifAttrValue -> Either String AttrValue
ldifDecodeB64Value :: LdifAttrValue -> Either String AttrValue
ldifDecodeB64Value LdifAttrValue
a = case LdifAttrValue
a of
  LAttrValRaw    ByteString
s -> AttrValue -> Either String AttrValue
forall a b. b -> Either a b
Right (AttrValue -> Either String AttrValue)
-> AttrValue -> Either String AttrValue
forall a b. (a -> b) -> a -> b
$ ByteString -> AttrValue
AttrValue ByteString
s
  LAttrValBase64 ByteString
b -> ByteString -> AttrValue
AttrValue (ByteString -> AttrValue)
-> Either String ByteString -> Either String AttrValue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either String ByteString
padDecodeB64 ByteString
b

-- | Parser of LDIF attribute value. This parser decodes base64 string.
--   Available combinator parser to pass 'ldifAttr' or 'openLdapEntry', etc ...
ldifDecodeAttrValue :: LdapParser AttrValue
ldifDecodeAttrValue :: LdapParser AttrValue
ldifDecodeAttrValue =
  Parser LdifAttrValue
ldifAttrValue Parser LdifAttrValue
-> (LdifAttrValue -> LdapParser AttrValue) -> LdapParser AttrValue
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
  String -> Either String AttrValue -> LdapParser AttrValue
forall a. String -> Either String a -> LdapParser a
eitherParser String
"internal ldifDecodeAttrValue" (Either String AttrValue -> LdapParser AttrValue)
-> (LdifAttrValue -> Either String AttrValue)
-> LdifAttrValue
-> LdapParser AttrValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LdifAttrValue -> Either String AttrValue
ldifDecodeB64Value

-- | Parser of LDIF attribute pair line.
--   Use with 'ldifDecodeAttrValue' or 'ldifAttrValue' parser, like @ldifAttr ldifDecodeAttrValue@.
ldifAttr :: LdapParser a -> LdapParser (AttrType, a)
ldifAttr :: LdapParser a -> LdapParser (AttrType, a)
ldifAttr LdapParser a
vp =
  (,)
  (AttrType -> a -> (AttrType, a))
-> LdapParser AttrType -> Parser ByteString (a -> (AttrType, a))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LdapParser AttrType
attrType LdapParser AttrType
-> Parser ByteString Char -> LdapParser AttrType
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser ByteString Char
char Char
':')
  Parser ByteString (a -> (AttrType, a))
-> LdapParser a -> LdapParser (AttrType, a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LdapParser a
vp

newline :: LdapParser ByteString
newline :: LdapParser ByteString
newline =  ByteString -> LdapParser ByteString
AP.string ByteString
"\n" LdapParser ByteString
-> LdapParser ByteString -> LdapParser ByteString
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByteString -> LdapParser ByteString
AP.string ByteString
"\r\n"

-- | OpenLDAP data-stream block parser.
--   Use with 'ldifDecodeAttrValue' or 'ldifAttrValue' parser, like @openLdapEntry ldifDecodeAttrValue@.
openLdapEntry :: LdapParser a
              -> LdapParser (DN, [(AttrType, a)])
openLdapEntry :: LdapParser a -> LdapParser (DN, [(AttrType, a)])
openLdapEntry LdapParser a
dp =
  (,)
  (DN -> [(AttrType, a)] -> (DN, [(AttrType, a)]))
-> LdapParser DN
-> Parser ByteString ([(AttrType, a)] -> (DN, [(AttrType, a)]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (LdapParser DN
ldifDN LdapParser DN -> LdapParser ByteString -> LdapParser DN
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* LdapParser ByteString
newline)
  Parser ByteString ([(AttrType, a)] -> (DN, [(AttrType, a)]))
-> Parser ByteString [(AttrType, a)]
-> LdapParser (DN, [(AttrType, a)])
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString (AttrType, a)
-> Parser ByteString [(AttrType, a)]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (LdapParser a -> Parser ByteString (AttrType, a)
forall a. LdapParser a -> LdapParser (AttrType, a)
ldifAttr LdapParser a
dp Parser ByteString (AttrType, a)
-> LdapParser ByteString -> Parser ByteString (AttrType, a)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* LdapParser ByteString
newline)

-- | OpenLDAP data-stream block list parser.
--   Use with 'ldifDecodeAttrValue' or 'ldifAttrValue' parser, like @openLdapData ldifDecodeAttrValue@.
openLdapData :: LdapParser a
             -> LdapParser [(DN, [(AttrType, a)])]
openLdapData :: LdapParser a -> LdapParser [(DN, [(AttrType, a)])]
openLdapData LdapParser a
dp =  Parser ByteString (DN, [(AttrType, a)])
-> LdapParser [(DN, [(AttrType, a)])]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (LdapParser a -> Parser ByteString (DN, [(AttrType, a)])
forall a. LdapParser a -> LdapParser (DN, [(AttrType, a)])
openLdapEntry LdapParser a
dp Parser ByteString (DN, [(AttrType, a)])
-> LdapParser ByteString -> Parser ByteString (DN, [(AttrType, a)])
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* LdapParser ByteString
newline)

contLines :: [LB.ByteString] -> [LB.ByteString]
contLines :: [ByteString] -> [ByteString]
contLines =  [ByteString] -> [ByteString]
d  where
  d :: [ByteString] -> [ByteString]
d  []    = []
  d (ByteString
x:[ByteString]
xs) = ByteString -> [ByteString] -> [ByteString]
rec' ByteString
x [ByteString]
xs  where
    rec' :: ByteString -> [ByteString] -> [ByteString]
rec' ByteString
a []     = [ByteString
a]
    rec' ByteString
a (ByteString
y:[ByteString]
ys)
      | ByteString
hd ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
" "  =  ByteString -> [ByteString] -> [ByteString]
rec' (ByteString
a ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
tl) [ByteString]
ys
      | Bool
otherwise  =  ByteString
a ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: ByteString -> [ByteString] -> [ByteString]
rec' ByteString
y [ByteString]
ys
      where (ByteString
hd, ByteString
tl) = Int64 -> ByteString -> (ByteString, ByteString)
LB.splitAt Int64
1 ByteString
y

blocks :: [LB.ByteString] -> [[LB.ByteString]]
blocks :: [ByteString] -> [[ByteString]]
blocks =  [ByteString] -> [[ByteString]]
d  where
  d :: [ByteString] -> [[ByteString]]
d     []     =  []
  d ls :: [ByteString]
ls@(ByteString
_:[ByteString]
_)   =  [ByteString]
hd [ByteString] -> [[ByteString]] -> [[ByteString]]
forall a. a -> [a] -> [a]
: [ByteString] -> [[ByteString]]
blocks (Int -> [ByteString] -> [ByteString]
forall a. Int -> [a] -> [a]
drop Int
1 [ByteString]
tl)
    where  ([ByteString]
hd,[ByteString]
tl) = (ByteString -> Bool)
-> [ByteString] -> ([ByteString], [ByteString])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
"") [ByteString]
ls

-- | Chunking lines of OpenLDAP data stream.
openLdapDataBlocks :: [LB.ByteString] -> [[LB.ByteString]]
openLdapDataBlocks :: [ByteString] -> [[ByteString]]
openLdapDataBlocks =  ([ByteString] -> [ByteString]) -> [[ByteString]] -> [[ByteString]]
forall a b. (a -> b) -> [a] -> [b]
map [ByteString] -> [ByteString]
contLines ([[ByteString]] -> [[ByteString]])
-> ([ByteString] -> [[ByteString]])
-> [ByteString]
-> [[ByteString]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ByteString] -> [[ByteString]]
blocks

_test0 :: Either String DN
_test0 :: Either String DN
_test0 =  LdapParser DN -> ByteString -> Either String DN
forall a. Parser a -> ByteString -> Either String a
runLdapParser LdapParser DN
ldifDN ByteString
"dn: cn=Slash\\\\The Post\\,ma\\=ster\\+\\<\\>\\#\\;,dc=example.sk,dc=com"