http.tri (22584B)
1 !import "prelude" !Local 2 !import "io" !Local 3 !import "patterns" !Local 4 !import "socket" !Local 5 6 -- --------------------------------------------------------------------------- 7 -- Constants 8 -- --------------------------------------------------------------------------- 9 10 maxHeaderBytes = 65536 11 maxBodyBytes = 1048576 12 maxUriBytes = 8192 13 14 crlf = pair 13 (pair 10 t) 15 crlfcrlf = pair 13 (pair 10 (pair 13 (pair 10 t))) 16 17 -- --------------------------------------------------------------------------- 18 -- Small byte/list helpers 19 -- --------------------------------------------------------------------------- 20 21 chomp = (xs : 22 lazyList 23 (_ : t) 24 (h r : 25 lazyBool 26 (_ : reverse r) 27 (_ : xs) 28 (equal? h 13)) 29 (reverse xs)) 30 31 -- --------------------------------------------------------------------------- 32 -- Response construction 33 -- --------------------------------------------------------------------------- 34 35 statusPhrases = 36 [(pair 200 "OK") 37 (pair 201 "Created") 38 (pair 204 "No Content") 39 (pair 400 "Bad Request") 40 (pair 404 "Not Found") 41 (pair 405 "Method Not Allowed") 42 (pair 431 "Request Header Fields Too Large") 43 (pair 501 "Not Implemented") 44 (pair 505 "HTTP Version Not Supported")] 45 46 lookupStatusPhrase_ self code phrases = 47 lazyList 48 (_ : "Internal Server Error") 49 (h r : 50 lazyBool 51 (_ : snd h) 52 (_ : self code r) 53 (equal? code (fst h))) 54 phrases 55 56 statusPhrase = (code : 57 y lookupStatusPhrase_ code statusPhrases) 58 59 statusLine = (code phrase : 60 append "HTTP/1.1 " (append (showNumber code) (append " " (append phrase "\r\n")))) 61 62 headerLine = (key value : 63 append key (append ": " (append value "\r\n"))) 64 65 buildResponse = (status headers body : 66 append 67 (statusLine status (statusPhrase status)) 68 (append 69 (foldl (acc h : append acc (headerLine (fst h) (snd h))) "" headers) 70 (append "\r\n" body))) 71 72 response = (status contentType body : 73 buildResponse status 74 [(pair "Content-Type" contentType) 75 (pair "Content-Length" (showNumber (length body))) 76 (pair "Connection" "close")] 77 body) 78 79 emptyResponse = (status : 80 buildResponse status 81 [(pair "Content-Length" "0") 82 (pair "Connection" "close")] 83 "") 84 85 okResponse = (body : 86 response 200 "text/plain; charset=utf-8" body) 87 88 textResponse = (body : 89 response 200 "text/plain; charset=utf-8" body) 90 91 jsonResponse = (body : 92 response 200 "application/json" body) 93 94 htmlResponse = (body : 95 response 200 "text/html; charset=utf-8" body) 96 97 createdResponse = (body : 98 response 201 "text/plain; charset=utf-8" body) 99 100 notFoundResponse = ( 101 response 404 "text/plain; charset=utf-8" "Not found\n") 102 103 badRequestResponse = (msg : 104 response 400 "text/plain; charset=utf-8" msg) 105 106 errorResponse = (status msg : 107 response status "text/plain; charset=utf-8" msg) 108 109 headerEndState state h = 110 lazyBool 111 (_ : 112 lazyBool 113 (_ : 3) 114 (_ : 1) 115 (equal? state 2)) 116 (_ : 117 lazyBool 118 (_ : 119 lazyBool 120 (_ : 4) 121 (_ : 2) 122 (equal? state 3)) 123 (_ : 0) 124 (boolAnd? 125 (equal? h 10) 126 (boolOr? (equal? state 1) (equal? state 3)))) 127 (equal? h 13) 128 129 headersOnly_ self bs state acc = 130 lazyList 131 (_ : reverse acc) 132 (h r : 133 let nextAcc = pair h acc in 134 let nextState = headerEndState state h in 135 lazyBool 136 (_ : reverse nextAcc) 137 (_ : self r nextState nextAcc) 138 (equal? nextState 4)) 139 bs 140 141 headersOnly = (response : 142 y headersOnly_ response 0 t) 143 144 responseForMethod = (method resp : 145 lazyBool 146 (_ : headersOnly resp) 147 (_ : resp) 148 (equal? method "HEAD")) 149 150 -- --------------------------------------------------------------------------- 151 -- Header receive / framing 152 -- --------------------------------------------------------------------------- 153 154 recvUntilMax_ = (y (self sock pattern maxBytes acc accLen : 155 onResult_ (recv sock 4096) 156 (err : 157 pure (err 400 acc)) 158 (chunk : 159 lazyBool 160 (_ : pure (err 400 acc)) 161 (_ : 162 let chunkLen = length chunk in 163 let nextLen = add accLen chunkLen in 164 let next = append acc chunk in 165 lazyBool 166 (_ : 167 lazyBool 168 (_ : pure (ok next t)) 169 (_ : self sock pattern maxBytes next nextLen) 170 (contains? pattern next)) 171 (_ : pure (err 431 next)) 172 (lte? nextLen maxBytes)) 173 (emptyList? chunk)))) 174 175 recvUntilMax = (sock pattern maxBytes : 176 recvUntilMax_ sock pattern maxBytes t 0) 177 178 recvUntil = (sock pattern : 179 recvUntilMax sock pattern maxHeaderBytes) 180 181 recvHeaders = (sock : 182 recvUntilMax sock crlfcrlf maxHeaderBytes) 183 184 -- --------------------------------------------------------------------------- 185 -- Request line parsing 186 -- --------------------------------------------------------------------------- 187 188 readLineBytes_ = (y (self bs acc : 189 lazyList 190 (_ : pair (reverse acc) t) 191 (h r : 192 lazyBool 193 (_ : pair (reverse acc) r) 194 (_ : 195 lazyBool 196 (_ : self r acc) 197 (_ : self r (pair h acc)) 198 (equal? h 13)) 199 (equal? h 10)) 200 bs)) 201 202 readLineBytes = (bs : 203 ((result : 204 pair (chomp (fst result)) (snd result)) 205 (readLineBytes_ bs t))) 206 207 parseThreeWords_ = (y (self bs phase acc w1 w2 : 208 lazyList 209 (_ : 210 lazyBool 211 (_ : ok (pair w1 (pair w2 (reverse acc))) t) 212 (_ : err 400 "Bad Request\n") 213 (equal? phase 2)) 214 (h r : 215 lazyBool 216 (_ : 217 lazyBool 218 (_ : self r 1 t (reverse acc) w2) 219 (_ : 220 lazyBool 221 (_ : self r 2 t w1 (reverse acc)) 222 (_ : err 400 "Bad Request\n") 223 (equal? phase 1)) 224 (equal? phase 0)) 225 (_ : self r phase (pair h acc) w1 w2) 226 (equal? h 32)) 227 bs)) 228 229 parseThreeWords = (bs : 230 parseThreeWords_ bs 0 t t t) 231 232 parseRequestLine = (bs : 233 ((lineRest : 234 lazyResult 235 (code bad : err 400 "Bad Request\n") 236 (req ignored : ok req (snd lineRest)) 237 (parseThreeWords (fst lineRest))) 238 (readLineBytes bs))) 239 240 -- --------------------------------------------------------------------------- 241 -- Header parsing 242 -- --------------------------------------------------------------------------- 243 244 245 -- ASCII byte helpers below are structural on the Tree Calculus numeral 246 -- spine. Do not replace them with lte?/sub based checks: these names are 247 -- normalized at import time under abstract byte inputs. 248 boolNot? = (b : 249 matchBool false true b) 250 251 boolOr? = (a b : 252 matchBool true b a) 253 254 boolAnd? = (a b : 255 matchBool b false a) 256 257 low5NonZero? = (b0 b1 b2 b3 b4 : 258 boolOr? 259 (bit1? b0) 260 (boolOr? 261 (bit1? b1) 262 (boolOr? 263 (bit1? b2) 264 (boolOr? 265 (bit1? b3) 266 (bit1? b4))))) 267 268 low5TooHighForUpper? = (b0 b1 b2 b3 b4 : 269 boolAnd? 270 (bit1? b4) 271 (boolAnd? 272 (bit1? b3) 273 (boolOr? 274 (bit1? b2) 275 (boolAnd? 276 (bit1? b1) 277 (bit1? b0))))) 278 279 upperLow5? = (b0 b1 b2 b3 b4 : 280 boolAnd? 281 (low5NonZero? b0 b1 b2 b3 b4) 282 (boolNot? 283 (low5TooHighForUpper? b0 b1 b2 b3 b4))) 284 285 lowerAsciiBits = (b0 b1 b2 b3 b4 : 286 pair b0 287 (pair b1 288 (pair b2 289 (pair b3 290 (pair b4 291 (pair true 292 (pair true 0))))))) 293 294 byte7BitsOr default c k = 295 let noStem _ = default in 296 let bit6 b0 b1 b2 b3 b4 b5 b6 r6 = 297 k b0 b1 b2 b3 b4 b5 b6 r6 in 298 let bit5 b0 b1 b2 b3 b4 b5 r5 = 299 triage default noStem (bit6 b0 b1 b2 b3 b4 b5) r5 in 300 let bit4 b0 b1 b2 b3 b4 r4 = 301 triage default noStem (bit5 b0 b1 b2 b3 b4) r4 in 302 let bit3 b0 b1 b2 b3 r3 = 303 triage default noStem (bit4 b0 b1 b2 b3) r3 in 304 let bit2 b0 b1 b2 r2 = 305 triage default noStem (bit3 b0 b1 b2) r2 in 306 let bit1 b0 b1 r1 = 307 triage default noStem (bit2 b0 b1) r1 in 308 let bit0 b0 r0 = 309 triage default noStem (bit1 b0) r0 in 310 triage default noStem bit0 c 311 312 toLowerAsciiByte = (c : 313 byte7BitsOr c c (b0 b1 b2 b3 b4 b5 b6 rest : 314 lazyBool 315 (_ : lowerAsciiBits b0 b1 b2 b3 b4) 316 (_ : c) 317 (boolAnd? 318 (isZero? rest) 319 (boolAnd? 320 (bit1? b6) 321 (boolAnd? 322 (bit0? b5) 323 (upperLow5? b0 b1 b2 b3 b4)))))) 324 325 finishHeaderLine = (self r headers key value seenColon : 326 matchBool 327 (matchBool 328 (err 400 "Bad Request\n") 329 (ok (reverse headers) r) 330 seenColon) 331 (matchBool 332 (self r 333 (pair (pair (reverse key) (reverse value)) headers) 334 t 335 t 336 false 337 true) 338 (err 400 "Bad Request\n") 339 seenColon) 340 (emptyList? key)) 341 342 finishHeaderEOF = (headers key value seenColon : 343 matchBool 344 (ok (reverse headers) t) 345 (matchBool 346 (ok (reverse (pair (pair (reverse key) (reverse value)) headers)) t) 347 (err 400 "Bad Request\n") 348 seenColon) 349 (emptyList? key)) 350 351 parseHeaders_ = (self bs headers key value seenColon trimValue : 352 matchList 353 (finishHeaderEOF headers key value seenColon) 354 (h r : 355 matchBool 356 (finishHeaderLine self r headers key value seenColon) 357 (matchBool 358 (self r headers key value seenColon trimValue) 359 (matchBool 360 (matchBool 361 (self r headers key value true true) 362 (self r headers key (pair h value) true false) 363 (boolAnd? trimValue (equal? h 32))) 364 (matchBool 365 (self r headers key value true true) 366 (self r headers (pair (toLowerAsciiByte h) key) value false true) 367 (equal? h 58)) 368 seenColon) 369 (equal? h 13)) 370 (equal? h 10)) 371 bs) 372 373 parseHeaders = (bs : 374 y parseHeaders_ bs t t t false true) 375 376 -- --------------------------------------------------------------------------- 377 -- Content-Length parsing 378 -- --------------------------------------------------------------------------- 379 380 bit0? = (x : 381 isZero? x) 382 383 bit1? = (x : 384 triage 385 false 386 (a : isZero? a) 387 (_ _ : false) 388 x) 389 390 low3 = (b0 b1 b2 : 391 matchBool 392 (matchBool 393 (matchBool 7 6 (bit1? b0)) 394 (matchBool 5 4 (bit1? b0)) 395 (bit1? b1)) 396 (matchBool 397 (matchBool 3 2 (bit1? b0)) 398 (matchBool 1 0 (bit1? b0)) 399 (bit1? b1)) 400 (bit1? b2)) 401 402 decimalDigit = (c : 403 triage 404 nothing 405 (_ : nothing) 406 (b0 r0 : 407 triage 408 nothing 409 (_ : nothing) 410 (b1 r1 : 411 triage 412 nothing 413 (_ : nothing) 414 (b2 r2 : 415 triage 416 nothing 417 (_ : nothing) 418 (b3 r3 : 419 triage 420 nothing 421 (_ : nothing) 422 (b4 r4 : 423 triage 424 nothing 425 (_ : nothing) 426 (b5 r5 : 427 matchBool 428 (matchBool 429 (matchBool 430 (matchBool 431 (matchBool 432 (just (low3 b0 b1 b2)) 433 (matchBool 434 (matchBool 435 (just (matchBool 9 8 (bit1? b0))) 436 nothing 437 (bit0? b2)) 438 nothing 439 (bit0? b1)) 440 (bit0? b3)) 441 nothing 442 (bit1? b5)) 443 nothing 444 (bit1? b4)) 445 nothing 446 (isZero? r5)) 447 nothing 448 true) 449 r4) 450 r3) 451 r2) 452 r1) 453 r0) 454 c) 455 456 readDecimal_ = (self bytes acc : 457 matchList 458 (just acc) 459 (h r : 460 matchMaybe 461 nothing 462 (d : self r (add (mul acc 10) d)) 463 (decimalDigit h)) 464 bytes) 465 466 readDecimal = (bytes : 467 matchBool 468 nothing 469 (y readDecimal_ bytes 0) 470 (emptyList? bytes)) 471 472 maxBodyBytesDecimal = "1048576" 473 474 byte0? b = equal? b 48 475 digitLtMax? maxDigit digit = lt? digit maxDigit 476 477 stripLeadingZeros_ self raw = 478 lazyList 479 (_ : t) 480 (c r : 481 lazyBool 482 (_ : self r) 483 (_ : raw) 484 (byte0? c)) 485 raw 486 487 decimalLengthLte_ self max raw = 488 lazyList 489 (_ : true) 490 (_ rest : 491 lazyList 492 (_ : false) 493 (_ maxRest : self maxRest rest) 494 max) 495 raw 496 497 decimalSameLength_ self max raw = 498 lazyList 499 (_ : 500 lazyList 501 (_ : true) 502 (_ _ : false) 503 max) 504 (_ rest : 505 lazyList 506 (_ : false) 507 (_ maxRest : self maxRest rest) 508 max) 509 raw 510 511 sameLengthDecimalLte_ self max raw less = 512 lazyList 513 (_ : true) 514 (digit rest : 515 lazyList 516 (_ : false) 517 (maxDigit maxRest : 518 lazyBool 519 (_ : self maxRest rest true) 520 (_ : 521 lazyBool 522 (_ : self maxRest rest true) 523 (_ : 524 lazyBool 525 (_ : self maxRest rest false) 526 (_ : false) 527 (equal? digit maxDigit)) 528 (digitLtMax? maxDigit digit)) 529 less) 530 max) 531 raw 532 533 decimalLengthLte? max raw = y decimalLengthLte_ max raw 534 535 decimalSameLength? max raw = y decimalSameLength_ max raw 536 537 decimalBytesLte? max raw = 538 let trimmed = y stripLeadingZeros_ raw in 539 lazyBool 540 (_ : y sameLengthDecimalLte_ max trimmed false) 541 (_ : decimalLengthLte? max trimmed) 542 (decimalSameLength? max trimmed) 543 544 parseContentLengthValue = (raw : 545 matchMaybe 546 (err 400 "Bad Request\n") 547 (n : 548 lazyBool 549 (_ : ok (just n) t) 550 (_ : err 413 "Request body too large\n") 551 (decimalBytesLte? maxBodyBytesDecimal raw)) 552 (readDecimal raw)) 553 554 contentLength_ = (self headers : 555 matchList 556 (ok nothing t) 557 (h r : 558 matchBool 559 (parseContentLengthValue (snd h)) 560 (self r) 561 (equal? "content-length" (fst h))) 562 headers) 563 564 contentLength = (headers : 565 y contentLength_ headers) 566 567 -- --------------------------------------------------------------------------- 568 -- Body reading 569 -- --------------------------------------------------------------------------- 570 571 bodyReadState = (remaining accRev rest : 572 pair remaining (pair accRev rest)) 573 574 bodyReadRemaining = (state : 575 fst state) 576 577 bodyReadAccRev = (state : 578 fst (snd state)) 579 580 bodyReadRest = (state : 581 snd (snd state)) 582 583 takeBodyBytes_ = (self bytes remaining accRev : 584 lazyBool 585 (_ : bodyReadState 0 accRev bytes) 586 (_ : 587 lazyList 588 (_ : bodyReadState remaining accRev t) 589 (h r : 590 self r (pred remaining) (pair h accRev)) 591 bytes) 592 (isZero? remaining)) 593 594 takeBodyBytes = (bytes remaining accRev : 595 y takeBodyBytes_ bytes remaining accRev) 596 597 shiftRight1 n = triage 0 (_ : 0) (_ rest : rest) n 598 599 shiftRight2 n = shiftRight1 (shiftRight1 n) 600 shiftRight4 n = shiftRight2 (shiftRight2 n) 601 shiftRight8 n = shiftRight4 (shiftRight4 n) 602 shiftRight12 n = shiftRight4 (shiftRight8 n) 603 604 shiftRight6 n = shiftRight2 (shiftRight4 n) 605 606 atLeast16? n = not? (isZero? (shiftRight4 n)) 607 atLeast64? n = not? (isZero? (shiftRight6 n)) 608 atLeast256? n = not? (isZero? (shiftRight8 n)) 609 atLeast1024? n = not? (isZero? (shiftRight2 (shiftRight8 n))) 610 atLeast4096? n = not? (isZero? (shiftRight12 n)) 611 612 recvChunkMax4096 remaining = 613 lazyBool 614 (_ : 4096) 615 (_ : 616 lazyBool 617 (_ : 1024) 618 (_ : 619 lazyBool 620 (_ : 256) 621 (_ : 622 lazyBool 623 (_ : 64) 624 (_ : 625 lazyBool 626 (_ : 16) 627 (_ : 1) 628 (atLeast16? remaining)) 629 (atLeast64? remaining)) 630 (atLeast256? remaining)) 631 (atLeast1024? remaining)) 632 (atLeast4096? remaining) 633 634 readBodyRecv = (self sock remaining accRev recvBytes : 635 onResult_ (recv sock recvBytes) 636 (errMsg : 637 pure 638 (err 639 400 640 (append "recv failed while reading body: " errMsg))) 641 (chunk : 642 let state = takeBodyBytes chunk remaining accRev in 643 let nextRemaining = bodyReadRemaining state in 644 let nextAccRev = bodyReadAccRev state in 645 lazyBool 646 (_ : pure (ok (reverse nextAccRev) (bodyReadRest state))) 647 (_ : self sock nextRemaining nextAccRev) 648 (isZero? nextRemaining))) 649 650 readBodyMore_ = (self sock remaining accRev : 651 lazyBool 652 (_ : pure (ok (reverse accRev) t)) 653 (_ : readBodyRecv self sock remaining accRev (recvChunkMax4096 remaining)) 654 (isZero? remaining)) 655 656 readBodyMore = (sock remaining accRev : 657 y readBodyMore_ sock remaining accRev) 658 659 readBodyExact = (sock expected initialBytes : 660 let state = takeBodyBytes initialBytes expected t in 661 let remaining = bodyReadRemaining state in 662 let accRev = bodyReadAccRev state in 663 lazyBool 664 (_ : pure (ok (reverse accRev) (bodyReadRest state))) 665 (_ : readBodyMore sock remaining accRev) 666 (isZero? remaining)) 667 668 validateBodyLength = (expected body rest : 669 let actual = length body in 670 lazyBool 671 (_ : pure (ok body rest)) 672 (_ : 673 pure 674 (err 675 400 676 (append 677 "body length mismatch expected=" 678 (append 679 (showNumber expected) 680 (append 681 " actual=" 682 (showNumber actual)))))) 683 (equal? actual expected)) 684 685 readBody = (sock headers initialBytes : 686 matchResult 687 (status msg : 688 pure (err status msg)) 689 (maybeLen rest : 690 lazyMaybe 691 (_ : pure (ok t initialBytes)) 692 (n : 693 onOk (readBodyExact sock n initialBytes) 694 (body rest : 695 validateBodyLength n body rest)) 696 maybeLen) 697 (contentLength headers)) 698 699 -- --------------------------------------------------------------------------- 700 -- Request validation 701 -- --------------------------------------------------------------------------- 702 703 validMethod? = (method : 704 lazyBool 705 (_ : true) 706 (_ : 707 lazyBool 708 (_ : true) 709 (_ : 710 lazyBool 711 (_ : true) 712 (_ : false) 713 (equal? method "HEAD")) 714 (equal? method "POST")) 715 (equal? method "GET")) 716 717 validVersion? = (version : 718 lazyBool 719 (_ : true) 720 (_ : equal? version "HTTP/1.0") 721 (equal? version "HTTP/1.1")) 722 723 validTarget? = (target : 724 startsWith? "/" target) 725 726 validateRequest = (method target version headers : 727 lazyBool 728 (_ : 729 lazyBool 730 (_ : 731 lazyBool 732 (_ : ok t t) 733 (_ : err 400 "Bad Request\n") 734 (validTarget? target)) 735 (_ : err 505 "HTTP Version Not Supported\n") 736 (validVersion? version)) 737 (_ : err 400 "Bad Request\n") 738 (validMethod? method)) 739 740 -- --------------------------------------------------------------------------- 741 -- 11. Handler pipeline 742 -- --------------------------------------------------------------------------- 743 744 routerMethod = (method : 745 lazyBool 746 (_ : "GET") 747 (_ : method) 748 (equal? method "HEAD")) 749 750 respondAndClose = (sock resp : 751 onOk_ (finally (send sock resp) (closeSocket_ sock)) (_ : 752 pure (ok t t))) 753 754 handleReadableRequest = (router client method target headers rest3 : 755 onResult (readBody client headers rest3) 756 (status msg : 757 respondAndClose client 758 (responseForMethod method 759 (errorResponse status msg))) 760 (body rest : 761 respondAndClose client 762 (responseForMethod method 763 (router (routerMethod method) target headers body)))) 764 765 handleParsedHeaders = (router client method target version rest2 : 766 matchResult 767 (code bad : 768 respondAndClose client (badRequestResponse "Bad Request\n")) 769 (headers rest3 : 770 matchResult 771 (status msg : 772 respondAndClose client 773 (responseForMethod method (errorResponse status msg))) 774 (ignored rest : 775 handleReadableRequest router client method target headers rest3) 776 (validateRequest method target version headers)) 777 (parseHeaders rest2)) 778 779 handleParsedRequest = (router client req rest2 : 780 ((method : 781 ((target : 782 ((version : 783 handleParsedHeaders router client method target version rest2) 784 (snd (snd req)))) 785 (fst (snd req)))) 786 (fst req))) 787 788 httpHandler = (router client peer : 789 onResult_ (recvHeaders client) 790 (status : 791 respondAndClose client 792 (badRequestResponse "Bad Request\n")) 793 (raw : 794 matchResult 795 (code bad : 796 respondAndClose client (badRequestResponse "Bad Request\n")) 797 (req rest2 : 798 handleParsedRequest router client req rest2) 799 (parseRequestLine raw))) 800 801 -- --------------------------------------------------------------------------- 802 -- 12. IO-aware handler pipeline 803 -- --------------------------------------------------------------------------- 804 805 handleReadableRequestIO = (routerIO client method target headers rest3 : 806 onResult (readBody client headers rest3) 807 (status msg : 808 respondAndClose client 809 (responseForMethod method 810 (errorResponse status msg))) 811 (body rest : 812 bind (routerIO (routerMethod method) target headers body) (resp : 813 respondAndClose client (responseForMethod method resp)))) 814 815 handleParsedHeadersIO = (routerIO client method target version rest2 : 816 matchResult 817 (code bad : 818 respondAndClose client (badRequestResponse "Bad Request\n")) 819 (headers rest3 : 820 matchResult 821 (status msg : 822 respondAndClose client 823 (responseForMethod method (errorResponse status msg))) 824 (ignored rest : 825 handleReadableRequestIO routerIO client method target headers rest3) 826 (validateRequest method target version headers)) 827 (parseHeaders rest2)) 828 829 handleParsedRequestIO = (routerIO client req rest2 : 830 ((method : 831 ((target : 832 ((version : 833 handleParsedHeadersIO routerIO client method target version rest2) 834 (snd (snd req)))) 835 (fst (snd req)))) 836 (fst req))) 837 838 httpHandlerIO = (routerIO client peer : 839 onResult_ (recvHeaders client) 840 (status : 841 respondAndClose client 842 (badRequestResponse "Bad Request\n")) 843 (raw : 844 matchResult 845 (code bad : 846 respondAndClose client (badRequestResponse "Bad Request\n")) 847 (req rest2 : 848 handleParsedRequestIO routerIO client req rest2) 849 (parseRequestLine raw)))