(define-syntax (define-ldap stx)
  (define-splicing-syntax-class type
    (pattern (~seq #:asn1-type type:id))
    (pattern (~seq) #:with type #'ANY))

  (define-splicing-syntax-class num
    (pattern (~seq #:n num:id))
    (pattern (~seq #:n num:expr))
    (pattern (~seq) #:with num #'ANY))

  (define-splicing-syntax-class app
    (pattern (~seq #:app app:expr))
    (pattern (~seq) #:with app #'ANY))
  
  (define-splicing-syntax-class req-expr
    (pattern (~seq t:type n:num a:app))
    #;(pattern (~seq t:type a:app)))

  (syntax-parse stx
    [(_ (name:id ld attr ...)
        [request req:req-expr]
        [response resp-expr])
     (with-syntax
       ([fn-id (format-id stx "ldap-~a" #'name)]
        [req #`(begin
                 (write-asn1 #,(syntax-parse #'req.t
                                 [(k:keyword type) #'type])
                             (hasheq 'n #,(syntax-parse #'req.n
                                            [(k:keyword n) #'n])
                                     'app #,(syntax-parse #'req.a
                                              [(k:keyword app) #'app]))
                             (ldap-to ld)
                             #:rules 'DER)
                 (flush-output (ldap-to ld)))]
        [resp (cond [(symbol? (syntax->datum #'resp-expr))
                     #'(hash-ref (BER-decode resp-expr
                                             (read-asn1 ANY
                                                        (ldap-from ld)
                                                        #:rules 'DER)
                                             #:der? #t)
                                 'app)]
                    [(list? (syntax->datum #'resp-expr))
                     #'resp-expr])])
       #'(define (fn-id ld attr ...) req resp))]))
;; -----
(define-ldap (bind ld [rdn ""] [p ""])
  [request #:asn1-type BindRequest
           #:n (match (list rdn p)
                 [`("" "") 1]
                 [`(,_ ,_) 0])
           #:app (hasheq 'version 3
                         'name rdn
                         'authentication (list 'simple p))]
  [response BindResponse])

(define-ldap (search ld dn scope ldap-filter)
  [request #:asn1-type SearchRequest
           #:n 2
           #:app (hasheq 'baseObject dn
                         'scope scope
                         'derefAliases 0
                         'sizeLimit 0
                         'timeLimit 0
                         'typesOnly #f
                         'filter (parse-ldap-filter ldap-filter)
                         'attributes '())]
  [response (let loop ([response (read-asn1/DER ANY (ldap-from ld))])
              (match (BER-frame-content response)
                [(list _ (BER-frame 'application 5 _))
                 (list (der-decode SearchResultDone response))]
                [(list _ (BER-frame 'application 4 _))
                 (cons (der-decode SearchResultEntry response)
                       (loop (read-asn1/DER ANY (ldap-from ld))))]))])