| 1 | open Todo |
| 2 | |
| 3 | let contains s sub = |
| 4 | let n = String.length sub in |
| 5 | let rec go i = i + n <= String.length s && (String.sub s i n = sub || go (i + 1)) in |
| 6 | go 0 |
| 7 | |
| 8 | let count s sub = |
| 9 | let n = String.length sub in |
| 10 | let rec go i acc = |
| 11 | if i + n > String.length s then acc |
| 12 | else if String.sub s i n = sub then go (i + n) (acc + 1) |
| 13 | else go (i + 1) acc |
| 14 | in |
| 15 | go 0 0 |
| 16 | |
| 17 | (* --- Form ---------------------------------------------------------------- *) |
| 18 | |
| 19 | let form_decoding () = |
| 20 | Alcotest.(check (list (pair string string))) |
| 21 | "plus, escapes, utf-8, empty, bare key" |
| 22 | [ ("title", "buy milk & eggs"); ("filter", "active"); ("u", "naïve 🚀"); ("e", ""); ("k", "") ] |
| 23 | (Form.parse "title=buy+milk+%26+eggs&filter=active&u=na%C3%AFve%20%F0%9F%9A%80&e=&k"); |
| 24 | Alcotest.(check string) "malformed escapes are kept" "100%" (Form.decode "100%"); |
| 25 | Alcotest.(check string) "bad hex is kept" "%zz" (Form.decode "%zz") |
| 26 | |
| 27 | let trimming () = |
| 28 | Alcotest.(check string) "ascii" "a b" (Form.trim " \t a b \n"); |
| 29 | Alcotest.(check string) "nbsp, ideographic, em space, bom" "naïve 🚀" |
| 30 | (Form.trim "\u{00A0}\u{3000}\u{2003}\u{FEFF}naïve 🚀\u{00A0}\u{202F}"); |
| 31 | Alcotest.(check string) "only nbsp" "" (Form.trim "\u{00A0}\u{00A0}"); |
| 32 | Alcotest.(check string) "inner kept" "a\u{00A0}b" (Form.trim "a\u{00A0}b"); |
| 33 | Alcotest.(check string) "empty" "" (Form.trim "") |
| 34 | |
| 35 | let cookies () = |
| 36 | Alcotest.(check (option string)) "finds by name" (Some "abc") |
| 37 | (Form.cookie "a=1; todomvc_list=abc; b=2" "todomvc_list"); |
| 38 | Alcotest.(check (option string)) "missing" None (Form.cookie "a=1" "todomvc_list"); |
| 39 | Alcotest.(check (option string)) "garbled" None (Form.cookie "%%%" "todomvc_list") |
| 40 | |
| 41 | let escaping () = |
| 42 | Alcotest.(check string) "html" "<img src=x> & "q" '" |
| 43 | (View.escape {|<img src=x> & "q" '|}) |
| 44 | |
| 45 | (* --- App ----------------------------------------------------------------- *) |
| 46 | |
| 47 | let origin = "http://127.0.0.1:8080" |
| 48 | |
| 49 | let fresh () = App.create ~store:(Store.open_ ":memory:") ~origin ~version:"test-version" |
| 50 | |
| 51 | let request ?(meth = "GET") ?(headers = []) ?(body = "") ?cookie target = |
| 52 | let uri = Uri.of_string target in |
| 53 | let headers = match cookie with Some c -> ("cookie", "todomvc_list=" ^ c) :: headers | None -> headers in |
| 54 | { App.meth; path = Uri.path uri; |
| 55 | query = List.map (fun (k, v) -> (k, String.concat "," v)) (Uri.query uri); |
| 56 | header = (fun h -> List.assoc_opt h headers); body } |
| 57 | |
| 58 | let header (r : App.response) name = List.assoc_opt name r.headers |
| 59 | |
| 60 | let set_cookie (r : App.response) = |
| 61 | match header r "set-cookie" with |
| 62 | | Some c -> String.sub c (String.length "todomvc_list=") 32 |
| 63 | | None -> Alcotest.fail "no set-cookie" |
| 64 | |
| 65 | (* A visitor: their cookie, from a first GET. *) |
| 66 | let visit app = set_cookie (App.handle app (request "/")) |
| 67 | |
| 68 | let post app cookie ?headers target body = |
| 69 | App.handle app (request ~meth:"POST" ?headers ~cookie ~body target) |
| 70 | |
| 71 | let page app cookie target = (App.handle app (request ~cookie target)).body |
| 72 | |
| 73 | let first_cookie () = |
| 74 | let app = fresh () in |
| 75 | let r = App.handle app (request "/") in |
| 76 | Alcotest.(check int) "status" 200 r.status; |
| 77 | let c = Option.get (header r "set-cookie") in |
| 78 | Alcotest.(check bool) "attributes" true |
| 79 | (contains c "; Path=/" && contains c "; HttpOnly" && contains c "; SameSite=Lax" |
| 80 | && not (contains c "Secure")); |
| 81 | Alcotest.(check bool) "empty list hides main and footer" false |
| 82 | (contains r.body {|class="main"|} || contains r.body {|class="footer"|}); |
| 83 | let again = App.handle app (request ~cookie:(set_cookie r) "/") in |
| 84 | Alcotest.(check (option string)) "known cookie kept" None (header again "set-cookie") |
| 85 | |
| 86 | let secure_cookie () = |
| 87 | let app = App.create ~store:(Store.open_ ":memory:") ~origin:"https://x.example" ~version:"v" in |
| 88 | let c = Option.get (header (App.handle app (request "/")) "set-cookie") in |
| 89 | Alcotest.(check bool) "Secure over https" true (contains c "; Secure") |
| 90 | |
| 91 | let garbled_cookie () = |
| 92 | let app = fresh () in |
| 93 | List.iter |
| 94 | (fun bad -> |
| 95 | let r = App.handle app (request ~cookie:bad "/") in |
| 96 | Alcotest.(check int) "status" 200 r.status; |
| 97 | Alcotest.(check bool) "fresh cookie" true (header r "set-cookie" <> None)) |
| 98 | [ "%%%"; ""; String.make 32 'a'; "not-a-token" ] |
| 99 | |
| 100 | let add_and_redirect () = |
| 101 | let app = fresh () in |
| 102 | let c = visit app in |
| 103 | let r = post app c "/todos" "title=++buy+milk++&filter=active" in |
| 104 | Alcotest.(check int) "303" 303 r.status; |
| 105 | Alcotest.(check (option string)) "back to filter" (Some "/active") (header r "location"); |
| 106 | let r = post app c "/todos" "title=x&filter=bogus" in |
| 107 | Alcotest.(check (option string)) "unknown filter" (Some "/") (header r "location"); |
| 108 | let r = post app c "/todos" "title=y" in |
| 109 | Alcotest.(check (option string)) "missing filter" (Some "/") (header r "location"); |
| 110 | ignore (post app c "/todos" "title=+++&filter=all"); |
| 111 | ignore (post app c "/todos" "title=%C2%A0%C2%A0&filter=all"); |
| 112 | let body = page app c "/" in |
| 113 | Alcotest.(check int) "three items, blank skipped" 3 (count body "<li data-id="); |
| 114 | Alcotest.(check bool) "trimmed" true (contains body "<label>buy milk</label>"); |
| 115 | Alcotest.(check bool) "counter" true (contains body "<strong>3</strong> items left") |
| 116 | |
| 117 | let escapes_titles () = |
| 118 | let app = fresh () in |
| 119 | let c = visit app in |
| 120 | ignore (post app c "/todos" "title=%3Cimg+src%3Dx+onerror%3Dalert(1)%3E&filter=all"); |
| 121 | let body = page app c "/" in |
| 122 | Alcotest.(check bool) "escaped" true (contains body "<img src=x onerror=alert(1)>"); |
| 123 | Alcotest.(check bool) "no tag" false (contains body "<img") |
| 124 | |
| 125 | let toggle_and_filters () = |
| 126 | let app = fresh () in |
| 127 | let c = visit app in |
| 128 | ignore (post app c "/todos" "title=a"); |
| 129 | ignore (post app c "/todos" "title=b"); |
| 130 | ignore (post app c "/todos/1/toggle" "filter=all"); |
| 131 | let all = page app c "/" in |
| 132 | Alcotest.(check bool) "completed class" true (contains all {|<li data-id="1" class="completed">|}); |
| 133 | Alcotest.(check bool) "singular counter" true (contains all "<strong>1</strong> item left"); |
| 134 | Alcotest.(check bool) "clear completed shown" true (contains all "clear-completed"); |
| 135 | Alcotest.(check bool) "all selected" true (contains all {|<a class="selected" href="/">All</a>|}); |
| 136 | let active = page app c "/active" in |
| 137 | Alcotest.(check bool) "active hides done" false (contains active {|data-id="1"|}); |
| 138 | Alcotest.(check bool) "active selected" true (contains active {|<a class="selected" href="/active">|}); |
| 139 | let completed = page app c "/completed" in |
| 140 | Alcotest.(check bool) "completed only" true |
| 141 | (contains completed {|data-id="1"|} && not (contains completed {|data-id="2"|})) |
| 142 | |
| 143 | let toggle_all_and_clear () = |
| 144 | let app = fresh () in |
| 145 | let c = visit app in |
| 146 | List.iter (fun t -> ignore (post app c "/todos" ("title=" ^ t))) [ "a"; "b"; "c" ]; |
| 147 | ignore (post app c "/todos/2/toggle" ""); |
| 148 | ignore (post app c "/todos/toggle-all" "filter=all"); |
| 149 | let body = page app c "/" in |
| 150 | Alcotest.(check int) "all completed" 3 (count body {|class="completed"|}); |
| 151 | Alcotest.(check bool) "toggle-all checked" true (contains body {|form="toggle-all-form" checked|}); |
| 152 | ignore (post app c "/todos/toggle-all" "filter=all"); |
| 153 | Alcotest.(check int) "all active again" 0 (count (page app c "/") {|class="completed"|}); |
| 154 | ignore (post app c "/todos/1/toggle" ""); |
| 155 | ignore (post app c "/todos/clear-completed" "filter=completed"); |
| 156 | let body = page app c "/" in |
| 157 | Alcotest.(check int) "one cleared" 2 (count body "<li data-id="); |
| 158 | Alcotest.(check bool) "clear hidden" false (contains body "clear-completed") |
| 159 | |
| 160 | let edit_and_destroy () = |
| 161 | let app = fresh () in |
| 162 | let c = visit app in |
| 163 | ignore (post app c "/todos" "title=a"); |
| 164 | ignore (post app c "/todos" "title=b"); |
| 165 | let editing = page app c "/?edit=2" in |
| 166 | Alcotest.(check bool) "editing class" true (contains editing {|<li data-id="2" class="editing">|}); |
| 167 | Alcotest.(check bool) "edit form" true (contains editing {|action="/todos/2/edit"|}); |
| 168 | ignore (post app c "/todos/2/edit" "title=++renamed++&filter=all"); |
| 169 | Alcotest.(check bool) "renamed" true (contains (page app c "/") "<label>renamed</label>"); |
| 170 | ignore (post app c "/todos/2/edit" "title=%C2%A0%E3%80%80&filter=all"); |
| 171 | Alcotest.(check int) "empty edit deletes" 1 (count (page app c "/") "<li data-id="); |
| 172 | ignore (post app c "/todos/1/destroy" "filter=all"); |
| 173 | Alcotest.(check int) "destroyed" 0 (count (page app c "/") "<li data-id=") |
| 174 | |
| 175 | let isolation () = |
| 176 | let app = fresh () in |
| 177 | let mine = visit app and theirs = visit app in |
| 178 | ignore (post app mine "/todos" "title=mine"); |
| 179 | Alcotest.(check int) "not in theirs" 0 (count (page app theirs "/") "<li data-id="); |
| 180 | List.iter |
| 181 | (fun target -> |
| 182 | Alcotest.(check int) target 404 (post app theirs target "title=x&filter=all").status) |
| 183 | [ "/todos/1/toggle"; "/todos/1/edit"; "/todos/1/destroy"; "/todos/99/toggle"; "/todos/x/toggle" ]; |
| 184 | let body = page app mine "/" in |
| 185 | Alcotest.(check bool) "unchanged" true |
| 186 | (contains body "<label>mine</label>" && not (contains body {|class="completed"|})) |
| 187 | |
| 188 | let origins () = |
| 189 | let app = fresh () in |
| 190 | let c = visit app in |
| 191 | let r = post app c ~headers:[ ("origin", "https://evil.example") ] "/todos" "title=evil" in |
| 192 | Alcotest.(check int) "cross-site refused" 403 r.status; |
| 193 | let r = post app c ~headers:[ ("origin", origin) ] "/todos" "title=ok" in |
| 194 | Alcotest.(check int) "own origin" 303 r.status; |
| 195 | Alcotest.(check int) "one item" 1 (count (page app c "/") "<li data-id=") |
| 196 | |
| 197 | let fragments () = |
| 198 | let app = fresh () in |
| 199 | let c = visit app in |
| 200 | let r = post app c ~headers:[ ("x-fragment", "todoapp") ] "/todos" "title=a&filter=all" in |
| 201 | Alcotest.(check int) "200" 200 r.status; |
| 202 | Alcotest.(check bool) "section only" true |
| 203 | (String.starts_with ~prefix:{|<section class="todoapp">|} r.body && not (contains r.body "<html")) |
| 204 | |
| 205 | let platform_routes () = |
| 206 | let app = fresh () in |
| 207 | Alcotest.(check int) "healthz" 200 (App.handle app (request "/healthz")).status; |
| 208 | Alcotest.(check string) "version" "test-version" (App.handle app (request "/api/version")).body; |
| 209 | let read f = In_channel.with_open_bin f In_channel.input_all in |
| 210 | Alcotest.(check bool) "base.css byte for byte" true |
| 211 | ((App.handle app (request "/static/base.css")).body = read "../static/base.css"); |
| 212 | Alcotest.(check bool) "index.css byte for byte" true |
| 213 | ((App.handle app (request "/static/index.css?v=1")).body = read "../static/index.css"); |
| 214 | Alcotest.(check int) "unknown static" 404 (App.handle app (request "/static/nope")).status; |
| 215 | Alcotest.(check int) "unknown page" 404 (App.handle app (request "/nope")).status; |
| 216 | Alcotest.(check int) "GET on an action" 405 (App.handle app (request "/todos")).status |
| 217 | |
| 218 | let () = |
| 219 | Alcotest.run "todo" |
| 220 | [ ("form", [ Alcotest.test_case "decoding" `Quick form_decoding; |
| 221 | Alcotest.test_case "trimming" `Quick trimming; |
| 222 | Alcotest.test_case "cookies" `Quick cookies; |
| 223 | Alcotest.test_case "escaping" `Quick escaping ]); |
| 224 | ("app", [ Alcotest.test_case "first cookie" `Quick first_cookie; |
| 225 | Alcotest.test_case "secure cookie" `Quick secure_cookie; |
| 226 | Alcotest.test_case "garbled cookie" `Quick garbled_cookie; |
| 227 | Alcotest.test_case "add and redirect" `Quick add_and_redirect; |
| 228 | Alcotest.test_case "escapes titles" `Quick escapes_titles; |
| 229 | Alcotest.test_case "toggle and filters" `Quick toggle_and_filters; |
| 230 | Alcotest.test_case "toggle all and clear" `Quick toggle_all_and_clear; |
| 231 | Alcotest.test_case "edit and destroy" `Quick edit_and_destroy; |
| 232 | Alcotest.test_case "isolation" `Quick isolation; |
| 233 | Alcotest.test_case "origins" `Quick origins; |
| 234 | Alcotest.test_case "fragments" `Quick fragments; |
| 235 | Alcotest.test_case "platform routes" `Quick platform_routes ]) ] |
| 236 | |
amadan