Ergonomic language features and lib cleanup
+ let bindings + where bindings + do notation I explored enough of the alternative language design space and decided that we should commit fully to Lambda style. That means no more highly tacit/concatenative point-free/partial programs as default. We'll keep taking advantage of those capabilities when it makes sense, but the library will continue to see massive overhauls.
This commit is contained in:
417
lib/http.tri
417
lib/http.tri
@@ -31,43 +31,29 @@ chomp = (xs :
|
||||
-- Response construction
|
||||
-- ---------------------------------------------------------------------------
|
||||
|
||||
statusPhrase = (code :
|
||||
lazyBool
|
||||
(_ : "OK")
|
||||
(_ :
|
||||
statusPhrases =
|
||||
[(pair 200 "OK")
|
||||
(pair 201 "Created")
|
||||
(pair 204 "No Content")
|
||||
(pair 400 "Bad Request")
|
||||
(pair 404 "Not Found")
|
||||
(pair 405 "Method Not Allowed")
|
||||
(pair 431 "Request Header Fields Too Large")
|
||||
(pair 501 "Not Implemented")
|
||||
(pair 505 "HTTP Version Not Supported")]
|
||||
|
||||
lookupStatusPhrase_ self code phrases =
|
||||
lazyList
|
||||
(_ : "Internal Server Error")
|
||||
(h r :
|
||||
lazyBool
|
||||
(_ : "Created")
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : "No Content")
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : "Bad Request")
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : "Not Found")
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : "Method Not Allowed")
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : "Request Header Fields Too Large")
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : "Not Implemented")
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : "HTTP Version Not Supported")
|
||||
(_ : "Internal Server Error")
|
||||
(equal? code 505))
|
||||
(equal? code 501))
|
||||
(equal? code 431))
|
||||
(equal? code 405))
|
||||
(equal? code 404))
|
||||
(equal? code 400))
|
||||
(equal? code 204))
|
||||
(equal? code 201))
|
||||
(equal? code 200))
|
||||
(_ : snd h)
|
||||
(_ : self code r)
|
||||
(equal? code (fst h)))
|
||||
phrases
|
||||
|
||||
statusPhrase = (code :
|
||||
y lookupStatusPhrase_ code statusPhrases)
|
||||
|
||||
statusLine = (code phrase :
|
||||
append "HTTP/1.1 " (append (showNumber code) (append " " (append phrase "\r\n"))))
|
||||
@@ -119,34 +105,40 @@ badRequestResponse = (msg :
|
||||
errorResponse = (status msg :
|
||||
response status "text/plain; charset=utf-8" msg)
|
||||
|
||||
headersOnly_ = (y (self bs s1 s2 s3 acc :
|
||||
lazyList
|
||||
(_ : reverse acc)
|
||||
(h r :
|
||||
headerEndState state h =
|
||||
lazyBool
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : 3)
|
||||
(_ : 1)
|
||||
(equal? state 2))
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : reverse (pair 10 (pair 13 (pair 10 (pair 13 acc)))))
|
||||
(_ : self r true false false (pair h acc))
|
||||
(equal? h 10))
|
||||
(_ : self r false false false (pair h acc))
|
||||
s3)
|
||||
(_ : self r false true false (pair h acc))
|
||||
(and? s2 (equal? h 13)))
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : self r false false true (pair h acc))
|
||||
(_ : self r false false false (pair h acc))
|
||||
(and? s1 (equal? h 10)))
|
||||
(equal? h 13))
|
||||
bs))
|
||||
(_ : 4)
|
||||
(_ : 2)
|
||||
(equal? state 3))
|
||||
(_ : 0)
|
||||
(boolAnd?
|
||||
(equal? h 10)
|
||||
(boolOr? (equal? state 1) (equal? state 3))))
|
||||
(equal? h 13)
|
||||
|
||||
headersOnly_ self bs state acc =
|
||||
lazyList
|
||||
(_ : reverse acc)
|
||||
(h r :
|
||||
let nextAcc = pair h acc in
|
||||
let nextState = headerEndState state h in
|
||||
lazyBool
|
||||
(_ : reverse nextAcc)
|
||||
(_ : self r nextState nextAcc)
|
||||
(equal? nextState 4))
|
||||
bs
|
||||
|
||||
headersOnly = (response :
|
||||
headersOnly_ response false false false t)
|
||||
y headersOnly_ response 0 t)
|
||||
|
||||
responseForMethod = (method resp :
|
||||
lazyBool
|
||||
@@ -166,20 +158,17 @@ recvUntilMax_ = (y (self sock pattern maxBytes acc accLen :
|
||||
lazyBool
|
||||
(_ : pure (err 400 acc))
|
||||
(_ :
|
||||
((chunkLen :
|
||||
((nextLen :
|
||||
((next :
|
||||
lazyBool
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : pure (ok next t))
|
||||
(_ : self sock pattern maxBytes next nextLen)
|
||||
(contains? pattern next))
|
||||
(_ : pure (err 431 next))
|
||||
(lte? nextLen maxBytes))
|
||||
(append acc chunk)))
|
||||
(add accLen chunkLen)))
|
||||
(length chunk)))
|
||||
let chunkLen = length chunk in
|
||||
let nextLen = add accLen chunkLen in
|
||||
let next = append acc chunk in
|
||||
lazyBool
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : pure (ok next t))
|
||||
(_ : self sock pattern maxBytes next nextLen)
|
||||
(contains? pattern next))
|
||||
(_ : pure (err 431 next))
|
||||
(lte? nextLen maxBytes))
|
||||
(emptyList? chunk))))
|
||||
|
||||
recvUntilMax = (sock pattern maxBytes :
|
||||
@@ -301,52 +290,36 @@ lowerAsciiBits = (b0 b1 b2 b3 b4 :
|
||||
(pair true
|
||||
(pair true 0)))))))
|
||||
|
||||
byte7BitsOr default c k =
|
||||
let noStem _ = default in
|
||||
let bit6 b0 b1 b2 b3 b4 b5 b6 r6 =
|
||||
k b0 b1 b2 b3 b4 b5 b6 r6 in
|
||||
let bit5 b0 b1 b2 b3 b4 b5 r5 =
|
||||
triage default noStem (bit6 b0 b1 b2 b3 b4 b5) r5 in
|
||||
let bit4 b0 b1 b2 b3 b4 r4 =
|
||||
triage default noStem (bit5 b0 b1 b2 b3 b4) r4 in
|
||||
let bit3 b0 b1 b2 b3 r3 =
|
||||
triage default noStem (bit4 b0 b1 b2 b3) r3 in
|
||||
let bit2 b0 b1 b2 r2 =
|
||||
triage default noStem (bit3 b0 b1 b2) r2 in
|
||||
let bit1 b0 b1 r1 =
|
||||
triage default noStem (bit2 b0 b1) r1 in
|
||||
let bit0 b0 r0 =
|
||||
triage default noStem (bit1 b0) r0 in
|
||||
triage default noStem bit0 c
|
||||
|
||||
toLowerAsciiByte = (c :
|
||||
triage
|
||||
c
|
||||
(_ : c)
|
||||
(b0 r0 :
|
||||
triage
|
||||
c
|
||||
(_ : c)
|
||||
(b1 r1 :
|
||||
triage
|
||||
c
|
||||
(_ : c)
|
||||
(b2 r2 :
|
||||
triage
|
||||
c
|
||||
(_ : c)
|
||||
(b3 r3 :
|
||||
triage
|
||||
c
|
||||
(_ : c)
|
||||
(b4 r4 :
|
||||
triage
|
||||
c
|
||||
(_ : c)
|
||||
(b5 r5 :
|
||||
triage
|
||||
c
|
||||
(_ : c)
|
||||
(b6 r6 :
|
||||
matchBool
|
||||
(lowerAsciiBits b0 b1 b2 b3 b4)
|
||||
c
|
||||
(boolAnd?
|
||||
(isZero? r6)
|
||||
(boolAnd?
|
||||
(bit1? b6)
|
||||
(boolAnd?
|
||||
(bit0? b5)
|
||||
(upperLow5? b0 b1 b2 b3 b4)))))
|
||||
r5)
|
||||
r4)
|
||||
r3)
|
||||
r2)
|
||||
r1)
|
||||
r0)
|
||||
c)
|
||||
byte7BitsOr c c (b0 b1 b2 b3 b4 b5 b6 rest :
|
||||
lazyBool
|
||||
(_ : lowerAsciiBits b0 b1 b2 b3 b4)
|
||||
(_ : c)
|
||||
(boolAnd?
|
||||
(isZero? rest)
|
||||
(boolAnd?
|
||||
(bit1? b6)
|
||||
(boolAnd?
|
||||
(bit0? b5)
|
||||
(upperLow5? b0 b1 b2 b3 b4))))))
|
||||
|
||||
finishHeaderLine = (self r headers key value seenColon :
|
||||
matchBool
|
||||
@@ -495,10 +468,86 @@ readDecimal = (bytes :
|
||||
(y readDecimal_ bytes 0)
|
||||
(emptyList? bytes))
|
||||
|
||||
maxBodyBytesDecimal = "1048576"
|
||||
|
||||
byte0? b = equal? b 48
|
||||
digitLtMax? maxDigit digit = lt? digit maxDigit
|
||||
|
||||
stripLeadingZeros_ self raw =
|
||||
lazyList
|
||||
(_ : t)
|
||||
(c r :
|
||||
lazyBool
|
||||
(_ : self r)
|
||||
(_ : raw)
|
||||
(byte0? c))
|
||||
raw
|
||||
|
||||
decimalLengthLte_ self max raw =
|
||||
lazyList
|
||||
(_ : true)
|
||||
(_ rest :
|
||||
lazyList
|
||||
(_ : false)
|
||||
(_ maxRest : self maxRest rest)
|
||||
max)
|
||||
raw
|
||||
|
||||
decimalSameLength_ self max raw =
|
||||
lazyList
|
||||
(_ :
|
||||
lazyList
|
||||
(_ : true)
|
||||
(_ _ : false)
|
||||
max)
|
||||
(_ rest :
|
||||
lazyList
|
||||
(_ : false)
|
||||
(_ maxRest : self maxRest rest)
|
||||
max)
|
||||
raw
|
||||
|
||||
sameLengthDecimalLte_ self max raw less =
|
||||
lazyList
|
||||
(_ : true)
|
||||
(digit rest :
|
||||
lazyList
|
||||
(_ : false)
|
||||
(maxDigit maxRest :
|
||||
lazyBool
|
||||
(_ : self maxRest rest true)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : self maxRest rest true)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : self maxRest rest false)
|
||||
(_ : false)
|
||||
(equal? digit maxDigit))
|
||||
(digitLtMax? maxDigit digit))
|
||||
less)
|
||||
max)
|
||||
raw
|
||||
|
||||
decimalLengthLte? max raw = y decimalLengthLte_ max raw
|
||||
|
||||
decimalSameLength? max raw = y decimalSameLength_ max raw
|
||||
|
||||
decimalBytesLte? max raw =
|
||||
let trimmed = y stripLeadingZeros_ raw in
|
||||
lazyBool
|
||||
(_ : y sameLengthDecimalLte_ max trimmed false)
|
||||
(_ : decimalLengthLte? max trimmed)
|
||||
(decimalSameLength? max trimmed)
|
||||
|
||||
parseContentLengthValue = (raw :
|
||||
matchMaybe
|
||||
(err 400 "Bad Request\n")
|
||||
(n : ok (just n) t)
|
||||
(n :
|
||||
lazyBool
|
||||
(_ : ok (just n) t)
|
||||
(_ : err 413 "Request body too large\n")
|
||||
(decimalBytesLte? maxBodyBytesDecimal raw))
|
||||
(readDecimal raw))
|
||||
|
||||
contentLength_ = (self headers :
|
||||
@@ -544,6 +593,43 @@ takeBodyBytes_ = (self bytes remaining accRev :
|
||||
takeBodyBytes = (bytes remaining accRev :
|
||||
y takeBodyBytes_ bytes remaining accRev)
|
||||
|
||||
shiftRight1 n = triage 0 (_ : 0) (_ rest : rest) n
|
||||
|
||||
shiftRight2 n = shiftRight1 (shiftRight1 n)
|
||||
shiftRight4 n = shiftRight2 (shiftRight2 n)
|
||||
shiftRight8 n = shiftRight4 (shiftRight4 n)
|
||||
shiftRight12 n = shiftRight4 (shiftRight8 n)
|
||||
|
||||
shiftRight6 n = shiftRight2 (shiftRight4 n)
|
||||
|
||||
atLeast16? n = not? (isZero? (shiftRight4 n))
|
||||
atLeast64? n = not? (isZero? (shiftRight6 n))
|
||||
atLeast256? n = not? (isZero? (shiftRight8 n))
|
||||
atLeast1024? n = not? (isZero? (shiftRight2 (shiftRight8 n)))
|
||||
atLeast4096? n = not? (isZero? (shiftRight12 n))
|
||||
|
||||
recvChunkMax4096 remaining =
|
||||
lazyBool
|
||||
(_ : 4096)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : 1024)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : 256)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : 64)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : 16)
|
||||
(_ : 1)
|
||||
(atLeast16? remaining))
|
||||
(atLeast64? remaining))
|
||||
(atLeast256? remaining))
|
||||
(atLeast1024? remaining))
|
||||
(atLeast4096? remaining)
|
||||
|
||||
readBodyRecv = (self sock remaining accRev recvBytes :
|
||||
onResult_ (recv sock recvBytes)
|
||||
(errMsg :
|
||||
@@ -552,75 +638,48 @@ readBodyRecv = (self sock remaining accRev recvBytes :
|
||||
400
|
||||
(append "recv failed while reading body: " errMsg)))
|
||||
(chunk :
|
||||
((state :
|
||||
((nextRemaining :
|
||||
((nextAccRev :
|
||||
lazyBool
|
||||
(_ : pure (ok (reverse nextAccRev) (bodyReadRest state)))
|
||||
(_ : self sock nextRemaining nextAccRev)
|
||||
(isZero? nextRemaining))
|
||||
(bodyReadAccRev state)))
|
||||
(bodyReadRemaining state)))
|
||||
(takeBodyBytes chunk remaining accRev))))
|
||||
let state = takeBodyBytes chunk remaining accRev in
|
||||
let nextRemaining = bodyReadRemaining state in
|
||||
let nextAccRev = bodyReadAccRev state in
|
||||
lazyBool
|
||||
(_ : pure (ok (reverse nextAccRev) (bodyReadRest state)))
|
||||
(_ : self sock nextRemaining nextAccRev)
|
||||
(isZero? nextRemaining)))
|
||||
|
||||
readBodyMore_ = (self sock remaining accRev :
|
||||
lazyBool
|
||||
(_ : pure (ok (reverse accRev) t))
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : readBodyRecv self sock remaining accRev 4096)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : readBodyRecv self sock remaining accRev 1024)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : readBodyRecv self sock remaining accRev 256)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : readBodyRecv self sock remaining accRev 64)
|
||||
(_ :
|
||||
lazyBool
|
||||
(_ : readBodyRecv self sock remaining accRev 16)
|
||||
(_ : readBodyRecv self sock remaining accRev 1)
|
||||
(lte? 16 remaining))
|
||||
(lte? 64 remaining))
|
||||
(lte? 256 remaining))
|
||||
(lte? 1024 remaining))
|
||||
(lte? 4096 remaining))
|
||||
(_ : readBodyRecv self sock remaining accRev (recvChunkMax4096 remaining))
|
||||
(isZero? remaining))
|
||||
|
||||
readBodyMore = (sock remaining accRev :
|
||||
y readBodyMore_ sock remaining accRev)
|
||||
|
||||
readBodyExact = (sock expected initialBytes :
|
||||
((state :
|
||||
((remaining :
|
||||
((accRev :
|
||||
lazyBool
|
||||
(_ : pure (ok (reverse accRev) (bodyReadRest state)))
|
||||
(_ : readBodyMore sock remaining accRev)
|
||||
(isZero? remaining))
|
||||
(bodyReadAccRev state)))
|
||||
(bodyReadRemaining state)))
|
||||
(takeBodyBytes initialBytes expected t)))
|
||||
let state = takeBodyBytes initialBytes expected t in
|
||||
let remaining = bodyReadRemaining state in
|
||||
let accRev = bodyReadAccRev state in
|
||||
lazyBool
|
||||
(_ : pure (ok (reverse accRev) (bodyReadRest state)))
|
||||
(_ : readBodyMore sock remaining accRev)
|
||||
(isZero? remaining))
|
||||
|
||||
validateBodyLength = (expected body rest :
|
||||
((actual :
|
||||
lazyBool
|
||||
(_ : pure (ok body rest))
|
||||
(_ :
|
||||
pure
|
||||
(err
|
||||
400
|
||||
let actual = length body in
|
||||
lazyBool
|
||||
(_ : pure (ok body rest))
|
||||
(_ :
|
||||
pure
|
||||
(err
|
||||
400
|
||||
(append
|
||||
"body length mismatch expected="
|
||||
(append
|
||||
"body length mismatch expected="
|
||||
(showNumber expected)
|
||||
(append
|
||||
(showNumber expected)
|
||||
(append
|
||||
" actual="
|
||||
(showNumber actual))))))
|
||||
(equal? actual expected))
|
||||
(length body)))
|
||||
" actual="
|
||||
(showNumber actual))))))
|
||||
(equal? actual expected))
|
||||
|
||||
readBody = (sock headers initialBytes :
|
||||
matchResult
|
||||
@@ -630,13 +689,9 @@ readBody = (sock headers initialBytes :
|
||||
lazyMaybe
|
||||
(_ : pure (ok t initialBytes))
|
||||
(n :
|
||||
lazyBool
|
||||
(_ :
|
||||
onOk (readBodyExact sock n initialBytes)
|
||||
(body rest :
|
||||
validateBodyLength n body rest))
|
||||
(_ : pure (err 400 "Request body too large\n"))
|
||||
(lte? n maxBodyBytes))
|
||||
onOk (readBodyExact sock n initialBytes)
|
||||
(body rest :
|
||||
validateBodyLength n body rest))
|
||||
maybeLen)
|
||||
(contentLength headers))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user