#ifndef OA_PLACK_H
#define OA_PLACK_H

/* The PSGI adapter, all in C: $api->to_app(handlers => {...}) returns a PSGI
 * coderef (a magic CV carrying its captures) whose request path is
 * route -> validate -> dispatch -> respond. A handler may return a PSGI
 * triplet, plain data (JSON-encoded as a 200), or - on a non-blocking server
 * (psgi.nonblocking, e.g. Hyperman) - a Future-like object resolving to one
 * of those, which is passed straight through for the server to await. On
 * blocking servers a returned Future is ->get awaited inline. */

/* ---- closures: a CV carrying captured SVs (the rp_closure pattern) -------- */

typedef struct oa_clos { AV *cap; } oa_clos;

static int oa_clos_free(pTHX_ SV *sv, MAGIC *mg) {
    oa_clos *c = (oa_clos *)mg->mg_ptr;
    PERL_UNUSED_ARG(sv);
    if (c) { if (c->cap) SvREFCNT_dec((SV *)c->cap); Safefree(c); }
    return 0;
}
static MGVTBL oa_clos_vtbl = { NULL, NULL, NULL, NULL, oa_clos_free,
                               NULL, NULL, NULL };

static SV *oa_closure(pTHX_ XSUBADDR_t body, AV *cap) {
    CV *cv = (CV *)newXS(NULL, body, __FILE__);
    oa_clos *c;
    Newxz(c, 1, oa_clos);
    c->cap = cap;                                   /* takes ownership */
    sv_magicext((SV *)cv, NULL, PERL_MAGIC_ext, &oa_clos_vtbl, (char *)c, 0);
    return newRV_noinc((SV *)cv);
}
static AV *oa_clos_cap(pTHX_ CV *cv) {
    MAGIC *mg = mg_findext((SV *)cv, PERL_MAGIC_ext, &oa_clos_vtbl);
    return mg ? ((oa_clos *)mg->mg_ptr)->cap : NULL;
}

/* ---- JSON responses -------------------------------------------------------- */

/* Encode a Perl value through the frj ABI. The ABI croaks on an unencodable
 * shape, so the encode runs inside the private _frj_encode trampoline (a
 * direct ABI call), invoked on its cached CV with G_EVAL - a bad handler
 * return degrades instead of escaping the request. Mortal SV on success,
 * NULL on failure. OA_ENC_CV is resolved in BOOT (API.xs). */
static SV *oa_json_encode(pTHX_ SV *val) {
    dSP; int count; SV *ret = NULL;
    ENTER; SAVETMPS; PUSHMARK(SP);
    XPUSHs(val); PUTBACK;
    count = call_sv(OA_ENC_CV, G_SCALAR | G_EVAL);
    SPAGAIN;
    if (!SvTRUE(ERRSV) && count > 0) { SV *r = POPs; if (SvOK(r)) ret = newSVsv(r); }
    else if (count > 0) (void)POPs;
    PUTBACK; FREETMPS; LEAVE;
    return ret ? sv_2mortal(ret) : NULL;
}

/* [ $status, ['Content-Type','application/json'], [$json] ]  (+1) */
static SV *oa_json_response(pTHX_ int status, SV *val) {
    AV *h = newAV(), *b = newAV(), *r = newAV();
    SV *json = oa_json_encode(aTHX_ val);
    av_push(h, newSVpvs("Content-Type"));
    av_push(h, newSVpvs("application/json"));
    av_push(b, json ? newSVsv(json) : newSVpvs("null"));
    av_push(r, newSViv(status));
    av_push(r, newRV_noinc((SV *)h));
    av_push(r, newRV_noinc((SV *)b));
    return newRV_noinc((SV *)r);
}

/* { errors => \@errs } as a JSON response (+1). errs borrowed. */
static SV *oa_error_response(pTHX_ int status, AV *errs) {
    HV *wrap = newHV();
    SV *rv, *w;
    (void)hv_stores(wrap, "errors", newRV_inc((SV *)errs));
    w  = sv_2mortal(newRV_noinc((SV *)wrap));
    rv = oa_json_response(aTHX_ status, w);
    return rv;
}

/* one-message error response (+1) */
static SV *oa_error_msg(pTHX_ int status, const char *msg) {
    AV *errs = (AV *)sv_2mortal((SV *)newAV());
    HV *e = newHV();
    (void)hv_stores(e, "message", newSVpv(msg, 0));
    av_push(errs, newRV_noinc((SV *)e));
    return oa_error_response(aTHX_ status, errs);
}

/* ---- env access -------------------------------------------------------------- */

static SV *oa_env_get(pTHX_ HV *env, const char *k) {
    SV **e = hv_fetch(env, k, (I32)strlen(k), 0);
    return (e && *e && SvOK(*e)) ? *e : NULL;
}

/* read CONTENT_LENGTH bytes from psgi.input (the rp_read_body pattern) */
static SV *oa_read_body_env(pTHX_ HV *env) {
    SV *cl = oa_env_get(aTHX_ env, "CONTENT_LENGTH");
    SV *in = oa_env_get(aTHX_ env, "psgi.input");
    IV len, off = 0;
    SV *body;
    if (!cl || !in) return NULL;
    len = SvIV(cl);
    if (len <= 0) return NULL;
    body = sv_2mortal(newSVpvs(""));
    while (off < len) {
        dSP; int n; IV got;
        ENTER; SAVETMPS; PUSHMARK(SP);
        EXTEND(SP, 4);
        PUSHs(in);
        PUSHs(body);
        PUSHs(sv_2mortal(newSViv(len - off)));
        PUSHs(sv_2mortal(newSViv(off)));
        PUTBACK;
        n = call_method("read", G_SCALAR | G_EVAL);
        SPAGAIN;
        got = (!SvTRUE(ERRSV) && n > 0) ? POPi : 0;
        PUTBACK; FREETMPS; LEAVE;
        if (got <= 0) break;
        off += got;
    }
    return body;
}

/* Build the minimal lowercased header HV oa_validate_op needs for this op:
 * content-type, cookie, and each declared header parameter (fresh HV). */
static HV *oa_headers_for(pTHX_ oa_op *o, HV *env) {
    HV *out = newHV();
    SV *v;
    int i;
    if ((v = oa_env_get(aTHX_ env, "CONTENT_TYPE")))
        (void)hv_stores(out, "content-type", newSVsv(v));
    if ((v = oa_env_get(aTHX_ env, "HTTP_COOKIE")))
        (void)hv_stores(out, "cookie", newSVsv(v));
    for (i = 0; i < o->nparams[OA_IN_HEADER]; i++) {
        STRLEN nl; const char *np = SvPV_const(o->params[OA_IN_HEADER][i].name, nl);
        char key[160], lc[128];
        STRLEN k;
        if (nl + 5 >= sizeof key || nl >= sizeof lc) continue;
        memcpy(key, "HTTP_", 5);
        for (k = 0; k < nl; k++) {
            char c = np[k];
            key[5 + k] = (c == '-') ? '_' : (char)toUPPER((U8)c);
            lc[k]      = (char)toLOWER((U8)c);
        }
        key[5 + nl] = '\0';
        {
            SV **e = hv_fetch(env, key, (I32)(5 + nl), 0);
            if (e && *e && SvOK(*e))
                (void)hv_store(out, lc, (I32)nl, newSVsv(*e), 0);
        }
    }
    return out;
}

/* ---- handler result mapping ---------------------------------------------------- */

/* a PSGI triplet: [ status, \@headers, ... ] */
static int oa_is_triplet(pTHX_ SV *sv) {
    AV *av;
    SV **s, **h;
    if (!sv || !SvROK(sv) || SvTYPE(SvRV(sv)) != SVt_PVAV) return 0;
    av = (AV *)SvRV(sv);
    if (av_len(av) + 1 != 3) return 0;
    s = av_fetch(av, 0, 0);
    h = av_fetch(av, 1, 0);
    if (!s || !*s || !SvOK(*s) || SvROK(*s)) return 0;
    if (!looks_like_number(*s)) return 0;
    if (!h || !*h || !SvROK(*h) || SvTYPE(SvRV(*h)) != SVt_PVAV) return 0;
    return 1;
}

/* an object with on_ready (a Future the server can await) */
static int oa_is_future(pTHX_ SV *sv) {
    return sv && SvROK(sv) && SvOBJECT(SvRV(sv))
        && gv_fetchmethod_autoload(SvSTASH(SvRV(sv)), "on_ready", 0) != NULL;
}

/* triplet passes through; anything else JSON-encodes as a 200 (+1) */
static SV *oa_map_result(pTHX_ SV *res) {
    if (oa_is_triplet(aTHX_ res)) return newSVsv(res);
    return oa_json_response(aTHX_ 200, res);
}

/* ---- response validation (dev tool, validate_responses => 1) ------------------- */

/* NULL = fine; else a 500 triplet describing the mismatch (+1) */
static SV *oa_check_response(pTHX_ oa_op *o, SV *trip) {
    AV *tv;
    SV **st, **bd;
    SV *handle = NULL, *data;
    char sbuf[8];
    STRLEN sl;
    int i;
    AV *errs;
    if (!o->nresps || !oa_is_triplet(aTHX_ trip)) return NULL;
    tv = (AV *)SvRV(trip);
    st = av_fetch(tv, 0, 0);
    sl = (STRLEN)my_snprintf(sbuf, sizeof sbuf, "%d", (int)SvIV(*st));
    for (i = 0; i < o->nresps; i++) {
        STRLEN rl; const char *rp = SvPV_const(o->resps[i].status, rl);
        if (rl == sl && memEQ(rp, sbuf, sl)) { handle = o->resps[i].handle; break; }
    }
    if (!handle) {
        for (i = 0; i < o->nresps; i++) {
            STRLEN rl; const char *rp = SvPV_const(o->resps[i].status, rl);
            if (rl == 7 && memEQ(rp, "default", 7)) { handle = o->resps[i].handle; break; }
        }
    }
    if (!handle) return NULL;
    bd = av_fetch(tv, 2, 0);
    if (!bd || !*bd || !SvROK(*bd) || SvTYPE(SvRV(*bd)) != SVt_PVAV) return NULL;
    {
        AV *ba = (AV *)SvRV(*bd);
        SV **b0 = av_fetch(ba, 0, 0);
        if (!b0 || !*b0 || !SvOK(*b0) || SvROK(*b0)) return NULL;
        data = oa_body_decode(aTHX_ *b0);
        if (!data) return NULL;
    }
    errs = (AV *)sv_2mortal((SV *)newAV());
    if (JSF->validate(aTHX_ handle, data, errs)) return NULL;
    {
        SSize_t j;
        for (j = 0; j <= av_len(errs); j++) {
            SV **e = av_fetch(errs, j, 0);
            HV *h = (e && *e && SvROK(*e)) ? (HV *)SvRV(*e) : NULL;
            if (h) (void)hv_stores(h, "in", newSVpvs("response"));
        }
    }
    return oa_error_response(aTHX_ 500, errs);
}

/* ---- hooks ------------------------------------------------------------------------ */

/* Resolve a hook/handler spec - a coderef, or a fully qualified sub name -
 * to an RV-to-CV (+1). Croaks (with `what` for context) on anything else. */
static SV *oa_cv_or_name(pTHX_ SV *v, const char *what) {
    if (v && SvROK(v) && SvTYPE(SvRV(v)) == SVt_PVCV)
        return newSVsv(v);
    if (v && SvOK(v) && !SvROK(v)) {
        STRLEN nl; const char *np = SvPV_const(v, nl);
        CV *cv = get_cv(np, 0);
        if (!cv)
            croak("Open::API->to_app: %s names no such sub '%.*s'",
                  what, (int)nl, np);
        return newRV_inc((SV *)cv);
    }
    croak("Open::API->to_app: %s must be a coderef or a fully qualified "
          "sub name", what);
    return NULL;   /* not reached */
}

/* Run the after hook on a finished response: $after->($resp, $env, $opId).
 * The hook may mutate the triplet in place; returning a PSGI triplet
 * replaces the response (other return values are ignored). A die becomes a
 * 500. Replaces *resp in place, consuming the old one. */
static void oa_run_after(pTHX_ SV **resp, SV *after, SV *env_rv, SV *opid) {
    dSP; int n; SV *r = NULL;
    if (!after || !SvOK(after)) return;
    ENTER; SAVETMPS; PUSHMARK(SP);
    EXTEND(SP, 3);
    PUSHs(*resp);
    PUSHs(env_rv);
    PUSHs(opid);
    PUTBACK;
    n = call_sv(after, G_SCALAR | G_EVAL);
    SPAGAIN;
    if (SvTRUE(ERRSV)) {
        SV *e = newSVsv(ERRSV);
        if (n > 0) (void)POPs;
        PUTBACK; FREETMPS; LEAVE;
        SvREFCNT_dec(*resp);
        *resp = oa_error_msg(aTHX_ 500, SvPV_nolen(e));
        SvREFCNT_dec(e);
        return;
    }
    if (n > 0) {
        SV *t = POPs;
        if (oa_is_triplet(aTHX_ t) && t != *resp) r = newSVsv(t);
    }
    PUTBACK; FREETMPS; LEAVE;
    if (r) { SvREFCNT_dec(*resp); *resp = r; }
}

/* Run the before hook after routing, before validation:
 * $before->($env, $opId). A REFERENCE return short-circuits the request and
 * becomes the response (a PSGI triplet as-is, other data JSON-encoded);
 * non-reference returns continue. A die becomes a 500. Returns the
 * short-circuit response (+1) or NULL to continue. */
static SV *oa_run_before(pTHX_ SV *before, SV *env_rv, SV *opid) {
    dSP; int n; SV *out = NULL;
    if (!before || !SvOK(before)) return NULL;
    ENTER; SAVETMPS; PUSHMARK(SP);
    EXTEND(SP, 2);
    PUSHs(env_rv);
    PUSHs(opid);
    PUTBACK;
    n = call_sv(before, G_SCALAR | G_EVAL);
    SPAGAIN;
    if (SvTRUE(ERRSV)) {
        SV *e = newSVsv(ERRSV);
        if (n > 0) (void)POPs;
        PUTBACK; FREETMPS; LEAVE;
        out = oa_error_msg(aTHX_ 500, SvPV_nolen(e));
        SvREFCNT_dec(e);
        return out;
    }
    if (n > 0) {
        SV *t = POPs;
        if (SvROK(t)) out = oa_map_result(aTHX_ t);
    }
    PUTBACK; FREETMPS; LEAVE;
    return out;
}

/* ---- Future completion (nonblocking servers) --------------------------------------- *
 * When a handler returns a Future on a nonblocking server AND there is
 * post-processing to do (after hook or validate_responses), the future is
 * chained with ->then(done, fail): done maps the resolved value and applies
 * response validation + the after hook; fail turns a failed future into a
 * 500 (also passed to after). Captures: [0]=api self SV (keeps the op table
 * alive), [1]=env_rv, [2]=opId SV, [3]=after or undef, [4]=vresp IV,
 * [5]=op pointer IV. */

XS_INTERNAL(oa_then_done_cb);
XS_INTERNAL(oa_then_done_cb) {
    dXSARGS;
    AV *cap = oa_clos_cap(aTHX_ cv);
    SV *env_rv, *opid, *after, *resp;
    oa_op *o;
    int vresp;
    if (!cap) XSRETURN_EMPTY;
    env_rv = *av_fetch(cap, 1, 0);
    opid   = *av_fetch(cap, 2, 0);
    after  = *av_fetch(cap, 3, 0);
    vresp  = (int)SvIV(*av_fetch(cap, 4, 0));
    o      = INT2PTR(oa_op *, SvIV(*av_fetch(cap, 5, 0)));
    resp   = oa_map_result(aTHX_ items > 0 ? ST(0) : &PL_sv_undef);
    if (vresp) {
        SV *bad = oa_check_response(aTHX_ o, resp);
        if (bad) { SvREFCNT_dec(resp); resp = bad; }
    }
    oa_run_after(aTHX_ &resp, after, env_rv, opid);
    ST(0) = sv_2mortal(resp);
    XSRETURN(1);
}

XS_INTERNAL(oa_then_fail_cb);
XS_INTERNAL(oa_then_fail_cb) {
    dXSARGS;
    AV *cap = oa_clos_cap(aTHX_ cv);
    SV *env_rv, *opid, *after, *resp;
    if (!cap) XSRETURN_EMPTY;
    env_rv = *av_fetch(cap, 1, 0);
    opid   = *av_fetch(cap, 2, 0);
    after  = *av_fetch(cap, 3, 0);
    resp   = oa_error_msg(aTHX_ 500,
        (items > 0 && SvOK(ST(0))) ? SvPV_nolen(ST(0)) : "handler future failed");
    oa_run_after(aTHX_ &resp, after, env_rv, opid);
    ST(0) = sv_2mortal(resp);
    XSRETURN(1);
}

/* one capture AV for the then callbacks (each closure needs its own) */
static AV *oa_then_cap(pTHX_ SV *self_sv, SV *env_rv, oa_op *o, SV *after,
                       int vresp) {
    AV *cap = newAV();
    av_push(cap, SvREFCNT_inc(self_sv));
    av_push(cap, SvREFCNT_inc(env_rv));
    av_push(cap, newSVsv(o->op_id));
    av_push(cap, after && SvOK(after) ? SvREFCNT_inc(after) : newSV(0));
    av_push(cap, newSViv(vresp));
    av_push(cap, newSViv(PTR2IV(o)));
    return cap;
}

/* ---- the request path ------------------------------------------------------------ */

/* Serve one PSGI request. Returns a PSGI triplet SV, or a Future SV on a
 * non-blocking server (chained with the post-processing when an after hook
 * or response validation is active). (+1 owned by caller) */
static SV *oa_serve_psgi(pTHX_ SV *self_sv, HV *handlers, SV *env_rv,
                         int vresp, SV *before, SV *after) {
    oa_api *a = (oa_api *)INT2PTR(void *, SvIV(SvRV(self_sv)));
    HV *env = (HV *)SvRV(env_rv);
    SV *msv = oa_env_get(aTHX_ env, "REQUEST_METHOD");
    SV *psv = oa_env_get(aTHX_ env, "PATH_INFO");
    SV *qsv = oa_env_get(aTHX_ env, "QUERY_STRING");
    HV *caps  = (HV *)sv_2mortal((SV *)newHV());
    AV *allow = (AV *)sv_2mortal((SV *)newAV());
    oa_op *o;
    HV *headers;
    SV *body, *handler;
    HV *params = NULL;
    AV *errs;

    {
        STRLEN ml, pl;
        const char *mp = msv ? SvPV_const(msv, ml) : (ml = 3, "GET");
        const char *pp = psv ? SvPV_const(psv, pl) : (pl = 1, "/");
        o = oa_route(aTHX_ a, mp, ml, pp, pl, caps, allow);
    }
    if (!o) {
        if (av_len(allow) >= 0) {   /* 405 + Allow */
            SV *resp = oa_error_msg(aTHX_ 405, "method not allowed");
            AV *tv = (AV *)SvRV(resp);
            SV **hh = av_fetch(tv, 1, 0);
            AV *ha = (AV *)SvRV(*hh);
            SV *joined = newSVpvs("");
            SSize_t i;
            for (i = 0; i <= av_len(allow); i++) {
                SV **m = av_fetch(allow, i, 0);
                if (i) sv_catpvs(joined, ", ");
                sv_catsv(joined, *m);
            }
            av_push(ha, newSVpvs("Allow"));
            av_push(ha, joined);
            return resp;
        }
        return oa_error_msg(aTHX_ 404, "not found");
    }

    /* before hook: post-route, pre-validation - a reference return
     * short-circuits (the auth case: return [401, ...]) */
    if (before && SvOK(before)) {
        SV *early = oa_run_before(aTHX_ before, env_rv, o->op_id);
        if (early) {
            oa_run_after(aTHX_ &early, after, env_rv, o->op_id);
            return early;
        }
    }

    headers = (HV *)sv_2mortal((SV *)oa_headers_for(aTHX_ o, env));
    body    = o->nbodies ? oa_read_body_env(aTHX_ env) : NULL;
    errs    = (AV *)sv_2mortal((SV *)newAV());

    if (!oa_validate_op(aTHX_ a, o, caps,
                        qsv ? qsv : &PL_sv_no, headers, body,
                        &params, errs)) {
        SV *resp = oa_error_response(aTHX_ 400, errs);
        oa_run_after(aTHX_ &resp, after, env_rv, o->op_id);
        return resp;
    }

    {
        STRLEN il; const char *ip = SvPV_const(o->op_id, il);
        SV **h = hv_fetch(handlers, ip, (I32)il, 0);
        if (!h || !*h || !SvROK(*h) || SvTYPE(SvRV(*h)) != SVt_PVCV) {
            SV *resp;
            SvREFCNT_dec((SV *)params);
            resp = oa_error_msg(aTHX_ 501, "no handler for this operation");
            oa_run_after(aTHX_ &resp, after, env_rv, o->op_id);
            return resp;
        }
        handler = *h;
    }

    {   /* call the handler: ($params, $env) */
        dSP; int n; SV *res = NULL;
        ENTER; SAVETMPS; PUSHMARK(SP);
        EXTEND(SP, 2);
        mPUSHs(newRV_noinc((SV *)params));
        PUSHs(env_rv);
        PUTBACK;
        n = call_sv(handler, G_SCALAR | G_EVAL);
        SPAGAIN;
        if (SvTRUE(ERRSV)) {
            SV *e = newSVsv(ERRSV);          /* keep past FREETMPS */
            SV *resp;
            if (n > 0) (void)POPs;
            PUTBACK; FREETMPS; LEAVE;
            resp = oa_error_msg(aTHX_ 500, SvPV_nolen(e));
            SvREFCNT_dec(e);
            oa_run_after(aTHX_ &resp, after, env_rv, o->op_id);
            return resp;
        }
        res = n > 0 ? SvREFCNT_inc(POPs) : &PL_sv_undef;
        PUTBACK; FREETMPS; LEAVE;

        if (oa_is_future(aTHX_ res)) {
            SV *nb = oa_env_get(aTHX_ env, "psgi.nonblocking");
            if (nb && SvTRUE(nb)) {
                int want_after = after && SvOK(after);
                if (!want_after && !vresp)
                    return res;              /* nothing to add: hand it over */
                {   /* chain ->then(done, fail) so mapping + response
                     * validation + the after hook run on resolution */
                    dSP; int n2; SV *derived = NULL;
                    SV *done = oa_closure(aTHX_ oa_then_done_cb,
                        oa_then_cap(aTHX_ self_sv, env_rv, o, after, vresp));
                    SV *fail = oa_closure(aTHX_ oa_then_fail_cb,
                        oa_then_cap(aTHX_ self_sv, env_rv, o, after, 0));
                    ENTER; SAVETMPS; PUSHMARK(SP);
                    EXTEND(SP, 3);
                    PUSHs(sv_2mortal(res));
                    PUSHs(sv_2mortal(done));
                    PUSHs(sv_2mortal(fail));
                    PUTBACK;
                    n2 = call_method("then", G_SCALAR | G_EVAL);
                    SPAGAIN;
                    if (!SvTRUE(ERRSV) && n2 > 0) derived = SvREFCNT_inc(POPs);
                    else if (n2 > 0) (void)POPs;
                    PUTBACK; FREETMPS; LEAVE;
                    if (derived) return derived;
                    return oa_error_msg(aTHX_ 500, "could not chain future");
                }
            }
            {                                    /* blocking: await inline */
                dSP; int n2; SV *val = NULL;
                ENTER; SAVETMPS; PUSHMARK(SP);
                EXTEND(SP, 1); PUSHs(sv_2mortal(res));
                PUTBACK;
                n2 = call_method("get", G_SCALAR | G_EVAL);
                SPAGAIN;
                if (SvTRUE(ERRSV)) {
                    SV *e = newSVsv(ERRSV);  /* keep past FREETMPS */
                    SV *resp;
                    if (n2 > 0) (void)POPs;
                    PUTBACK; FREETMPS; LEAVE;
                    resp = oa_error_msg(aTHX_ 500, SvPV_nolen(e));
                    SvREFCNT_dec(e);
                    oa_run_after(aTHX_ &resp, after, env_rv, o->op_id);
                    return resp;
                }
                val = n2 > 0 ? SvREFCNT_inc(POPs) : &PL_sv_undef;
                PUTBACK; FREETMPS; LEAVE;
                res = val;
            }
        }
        {
            SV *resp = oa_map_result(aTHX_ res);
            SvREFCNT_dec(res);
            if (vresp) {
                SV *bad = oa_check_response(aTHX_ o, resp);
                if (bad) { SvREFCNT_dec(resp); resp = bad; }
            }
            oa_run_after(aTHX_ &resp, after, env_rv, o->op_id);
            return resp;
        }
    }
}

#endif /* OA_PLACK_H */
