Improve the Search operation support

- Test `approximate` matches (even if they are mostly useless)

  - Partially support `Extensible` matching

  - Parse and ignore `SearchResultReference` responses, if any

README.markdown

@@ -1,4 +1,5 @@
-**NOTE: This is work in progress. Don't use it! If you really need LDAP integration, check out [LDAP][LDAP]**
+:warning:
+**This is work in progress. Use [LDAP][LDAP] if you need LDAP integration.**
 
 ldap-client
 ===========
@@ -23,7 +24,7 @@ IntermediateResponse Message | 4.13        | ✘
 StartTLS Operation           | 4.14        | ✔†
 LDAP over TLS                | -           | ✔
 
-\* Approximate and extensible matches are untested, so probably do not work  
+\* The `:dn` thing is unsupported in Extensible matches  
 † Only serves as an example of Extended Operation.  It's useless for all practical purposes as it does not actually enable TLS.  In other words, use LDAP over TLS instead.
 
   [rfc4511]: https://tools.ietf.org/html/rfc4511

src/Ldap/Asn1/FromAsn1.hs

@@ -273,6 +273,11 @@ SearchResultEntry ::= [APPLICATION 4] SEQUENCE {
      attributes      PartialAttributeList }
 @
 
+@
+SearchResultReference ::= [APPLICATION 19] SEQUENCE
+                          SIZE (1..MAX) OF uri URI
+@
+
 @
 SearchResultDone ::= [APPLICATION 5] LDAPResult
 @
@@ -303,6 +308,13 @@ instance FromAsn1 ProtocolServerOp where
     , fmap DeleteResponse (app 11)
     , fmap ModifyDnResponse (app 13)
     , fmap CompareResponse (app 15)
+
+    , do
+      Asn1.Start (Asn1.Container Asn1.Application 19) <- next
+      uris <- some1 fromAsn1
+      Asn1.End (Asn1.Container Asn1.Application 19) <- next
+      return (SearchResultReference uris)
+
     , do
       Asn1.Start (Asn1.Container Asn1.Application 24) <- next
       res <- fromAsn1

src/Ldap/Asn1/ToAsn1.hs

@@ -7,7 +7,7 @@ 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, maybe)
+import           Data.Maybe (maybe)
 import           Data.Monoid (Endo(Endo), (<>), mempty)
 import qualified Data.Text.Encoding as Text
 import           Prelude (Integer, (.), fromIntegral)
@@ -372,12 +372,14 @@ MatchingRuleAssertion ::= SEQUENCE {
 @
 -}
 instance ToAsn1 MatchingRuleAssertion where
-  toAsn1 (MatchingRuleAssertion mmr mad av b) = sequence (fold
+  toAsn1 (MatchingRuleAssertion mmr mad (AssertionValue av) _) = (fold
-    [ context 1 (optional mmr)
+    [ maybe mempty f mmr
-    , context 2 (optional mad)
+    , maybe mempty g mad
-    , context 3 (toAsn1 av)
+    , other Asn1.Context 3 av
-    , context 4 (single (Asn1.Boolean b))
     ])
+   where
+    f (MatchingRuleId (LdapString x)) = other Asn1.Context 1 (Text.encodeUtf8 x)
+    g (AttributeDescription (LdapString x)) = other Asn1.Context 2 (Text.encodeUtf8 x)
 
 {- |
 @
@@ -411,9 +413,6 @@ construction t x = single (Asn1.Start t) <> x <> single (Asn1.End t)
 other :: ASN1Class -> ASN1Tag -> ByteString -> Endo [ASN1]
 other c t = single . Asn1.Other c t
 
-optional :: ToAsn1 a => Maybe a -> Endo [ASN1]
-optional = maybe mempty toAsn1
-
 enum :: Integer -> Endo [ASN1]
 enum = single . Asn1.Enumerated
 

test/Ldap/Client/SearchSpec.hs

@@ -59,7 +59,7 @@ spec = do
       dns res `shouldBe` [pikachu]
     res `shouldBe` Right ()
 
-  it "‘equality match’ filter" $ do
+  it "‘equality’ filter" $ do
     res <- locally $ \l -> do
       res <- go l (Attr "type" := "flying")
       dns res `shouldMatchList`
@@ -147,3 +147,21 @@ spec = do
         , wartortle
         ]
     res `shouldBe` Right ()
+
+  it "‘approximate’ filter (actually, another ‘equality’ filter)" $ do
+    res <- locally $ \l -> do
+      res <- go l (Attr "type" :~= "flying")
+      dns res `shouldMatchList`
+        [ butterfree
+        , charizard
+        ]
+    res `shouldBe` Right ()
+
+  it "‘extensible’ filter" $ do
+    res <- locally $ \l -> do
+      res <- go l ((Just (Attr "type"), Nothing, True) ::= "flying")
+      dns res `shouldMatchList`
+        [ butterfree
+        , charizard
+        ]
+    res `shouldBe` Right ()