diff --git a/.github/workflows/bar.yml b/.github/workflows/bar.yml new file mode 100644 index 0000000..32457ed --- /dev/null +++ b/.github/workflows/bar.yml @@ -0,0 +1,21 @@ +name: verified bar + +on: + push: + pull_request: + # Rerun when the spec reviewer approves, or an approval is dismissed. + pull_request_review: + types: [submitted, dismissed] + +jobs: + bar: + # pull-requests: read lets the check confirm the spec approval on GitHub. + permissions: + contents: read + pull-requests: read + # Both lines pin the same commit of Proven-Commons/mission: bar v2, as + # proposed in its pull request #2. Move both to a release tag once + # mission publishes one. + uses: Proven-Commons/mission/.github/workflows/verified-bar.yml@6ba85c27abaaf07905c9316aa96dc29f7b5847a2 + with: + bar-ref: 6ba85c27abaaf07905c9316aa96dc29f7b5847a2 diff --git a/.gitignore b/.gitignore index 01f8cdb..9a366ff 100644 --- a/.gitignore +++ b/.gitignore @@ -1 +1,4 @@ .lake/ +venv/ +scratch/ +__pycache__/ diff --git a/Main.lean b/Main.lean new file mode 100644 index 0000000..2cce051 --- /dev/null +++ b/Main.lean @@ -0,0 +1,90 @@ +/- + Command line front end for the MQTT packet codec. + + One request per line, in the shape `op numbers`, where the op + and the numbers are parted by one space, and the numbers are + decimal numbers parted by commas, with no spaces inside the + number list. A line holds a number in plain decimal: no sign, + no leading zeros (the number 0 itself is written `0`), and at + most twenty digits. An empty line is passed over with no + answer. A request that breaks the line shape prints `error`. + + The one operation: + + - `parse` takes comma parted byte numbers and prints `ok:` and + the bytes of the packet printed back when the bytes are + exactly one packet this slice reads, and `none` when they + are not. The reprint is the packet read and written again, + byte for byte when the packet arrived in its printed form. + The full rules are in SPEC.md. +-/ + +import Mqtt + +open Mqtt + +/-- Read one number token: plain decimal digits, no sign, no + leading zeros but for the number 0 itself, at most twenty + digits. -/ +def parseNat (s : String) : Option Nat := + let cs := s.toList + if cs.isEmpty ∨ 20 < cs.length then none + else if 1 < cs.length ∧ cs.head! = '0' then none + else if cs.all Char.isDigit then + some (cs.foldl (fun n c => n * 10 + (c.toNat - 48)) 0) + else none + +/-- Read the number list of a payload. The empty payload is the + empty list. -/ +def numsOf (payload : String) : Option (List Nat) := + if payload.isEmpty then some [] + else (payload.splitOn ",").mapM parseNat + +/-- Read the byte list of a payload: every number at most 255. -/ +def bytesOf (payload : String) : Option (List UInt8) := + (numsOf payload).bind fun ns => + if ns.all (· ≤ 255) then some (ns.map Nat.toUInt8) else none + +/-- Print a number list as comma parted decimal numbers. -/ +def joinNums (ns : List Nat) : String := + ns.foldl (fun acc n => if acc.isEmpty then toString n else acc ++ "," ++ toString n) "" + +/-- Run one operation on one payload. The answer is `error` for a + malformed request, and `none` for well formed bytes that this + slice rejects. -/ +def run (op payload : String) : String := + match op with + | "parse" => + match bytesOf payload with + | none => "error" + | some bs => + match parse bs with + | some v => "ok:" ++ joinNums ((print v).map UInt8.toNat) + | none => "none" + | _ => "error" + +/-- Answer one request line. An empty line gets no answer. -/ +def processLine (line : String) : Option String := + if line.isEmpty then none + else + match line.splitOn " " with + | [op] => some (run op "") + | [op, payload] => some (run op payload) + | _ => some "error" + +/-- The line without its line ending: LF, or CR LF. -/ +def chomp (line : String) : String := + let cs := line.toList + if cs.getLast? = some '\n' then + let cs := cs.dropLast + String.ofList (if cs.getLast? = some '\r' then cs.dropLast else cs) + else line + +def main : IO Unit := do + let stdin ← IO.getStdin + repeat + let line ← stdin.getLine + if line.isEmpty then break + match processLine (chomp line) with + | some out => IO.println out + | none => pure () diff --git a/Mqtt.lean b/Mqtt.lean new file mode 100644 index 0000000..b802af6 --- /dev/null +++ b/Mqtt.lean @@ -0,0 +1,2 @@ +import Mqtt.Value +import Mqtt.Parse diff --git a/Mqtt/Parse.lean b/Mqtt/Parse.lean new file mode 100644 index 0000000..bc0acb4 --- /dev/null +++ b/Mqtt/Parse.lean @@ -0,0 +1,410 @@ +/- + The MQTT 5.0 packet reader. + + The reader works on a byte list and reads one packet from its + front, returning the packet and the bytes after it, so a + caller can walk a stream of packets arriving over TCP. It + never reads past the end of its input: every length in the + packet (the remaining length, a property length, a string or + binary length) is checked against the bytes that actually + remain before any of them are taken. + + Rules the reader follows, beyond the layout in SPEC.md: + + - A variable byte integer stops at four bytes: a continuation + bit on the fourth byte is rejected, and a value cut off by + the end of the input is rejected. An encoding that uses more + bytes than the value needs is rejected too: its last byte + is 0 after a continuation byte (section 1.5.5). + - A packet type outside the seven this slice covers is + rejected, and so is a fixed header flags nibble other than + the one the specification fixes for the type; PUBLISH is + the only type whose flags carry meaning, and its reserved + QoS value 3 is rejected, as is the DUP flag at QoS 0 + (section 3.3.1.1, [MQTT-3.3.1-2]). + - The body of a packet is cut out by its remaining length + first, and the type's reader must consume the cut exactly: + bytes left over inside the cut are rejected, and a field + that runs past the cut is rejected. + - Properties are checked against the specification's table: + an identifier with no table entry, an identifier not + allowed on the packet kind at hand, and a repeat of a single + use property are all rejected. So is a value that breaks a + value rule (`propValOK`), and Authentication Data without + an Authentication Method (`authOK`). +-/ + +import Mqtt.Value + +namespace Mqtt + +/-! ## Byte readers -/ + +/-- Read a big endian number of exactly `k` bytes from the + front of a byte list. Returns the number and the bytes + after it, or `none` when fewer than `k` bytes stand there. -/ +def readNat : Nat → List UInt8 → Option (Nat × List UInt8) + | 0, bs => some (0, bs) + | _ + 1, [] => none + | k + 1, b :: bs => + (readNat k bs).map fun (u, r) => (b.toNat * 256 ^ k + u, r) + +/-- The unfolding rule for `readNat` at a successor width on a + list with a head byte. -/ +theorem readNat_succ_cons (k : Nat) (b : UInt8) (bs : List UInt8) : + readNat (k + 1) (b :: bs) = + (readNat k bs).map fun (u, r) => (b.toNat * 256 ^ k + u, r) := by + rw [readNat] + +/-- Take `n` bytes off the front of a byte list, or `none` when + fewer than `n` bytes stand there. Returns the bytes taken + and the bytes after them. -/ +def readBytes (n : Nat) (bs : List UInt8) : Option (List UInt8 × List UInt8) := + if bs.length ≥ n then some (bs.take n, bs.drop n) else none + +/-- Read one byte as a number. -/ +def readByte : List UInt8 → Option (Nat × List UInt8) + | [] => none + | b :: bs => some (b.toNat, bs) + +/-! ## The variable byte integer reader -/ + +/-- Read a variable byte integer with at most `k` bytes left to + spend. A byte below 128 ends the number. A byte of 128 or + more carries the low seven bits of the value and a + continuation mark: the bytes after it carry the rest of the + value, which counts 128 times. That rest must not be 0: a + writing whose last byte is 0 after a continuation byte uses + more bytes than the value needs, which section 1.5.5 + forbids. A continuation byte with no byte left to spend is + rejected, and so is the end of the input while a + continuation bit stands. -/ +def decVBIGo : Nat → List UInt8 → Option (Nat × List UInt8) + | 0, _ => none + | _ + 1, [] => none + | k + 1, b :: bs => + if b.toNat < 128 then some (b.toNat, bs) + else match decVBIGo k bs with + | none => none + | some (v, r) => if v = 0 then none else some (b.toNat - 128 + 128 * v, r) + +/-- Read a variable byte integer (sections 1.5.5 and 2.1.4): at + most four bytes, in the fewest bytes the value needs. + Returns the value and the bytes after it. -/ +def decVBI (bs : List UInt8) : Option (Nat × List UInt8) := + decVBIGo 4 bs + +/-! ## String and binary readers -/ + +/-- Check a decoded string field's characters: the strict + decoder has already settled well formedness; the null + character must also be absent (section 1.5.4). -/ +def checkChars (s : List Char) : Option (List Char) := + if hasNul s then none else some s + +/-- Read a string field: the two byte length, that many bytes, + read as strict UTF-8 with no null character. -/ +def readStr (bs : List UInt8) : Option (List Char × List UInt8) := do + let (len, r1) ← readNat 2 bs + let (chunk, r2) ← readBytes len r1 + let s ← (Utf8.decode chunk).bind checkChars + pure (s, r2) + +/-- Read a binary data field: the two byte length, then that + many bytes. -/ +def readBin (bs : List UInt8) : Option (List UInt8 × List UInt8) := do + let (len, r1) ← readNat 2 bs + readBytes len r1 + +/-! ## Property readers -/ + +/-- Read a property value of the given type. -/ +def readPropVal (t : PropType) : List UInt8 → Option (PropVal × List UInt8) + | bs => + match t with + | .byte => (readNat 1 bs).map fun (n, r) => (.byte n, r) + | .twoByte => (readNat 2 bs).map fun (n, r) => (.twoByte n, r) + | .fourByte => (readNat 4 bs).map fun (n, r) => (.fourByte n, r) + | .varByte => (decVBI bs).map fun (n, r) => (.varByte n, r) + | .utf8 => (readStr bs).map fun (s, r) => (.utf8 s, r) + | .utf8Pair => do + let (k, r1) ← readStr bs + let (v, r2) ← readStr r1 + pure (.utf8Pair k v, r2) + | .binary => (readBin bs).map fun (chunk, r) => (.binary chunk, r) + +/-- Read one property: the identifier as a variable byte + integer, checked against the table and the block's allowed + list, then the value in the shape of the table's type for + the identifier, which must keep the value rules of + `propValOK`. A repeat of a single use property whose + identifier already stands in `seen` is rejected. -/ +def readEntry (s : PropSet) (seen : List Nat) (bs : List UInt8) : + Option (Property × List UInt8) := do + let (id, r1) ← decVBI bs + if (allowedOf s).contains id && (repeatableIn s id || !seen.contains id) then + match propTypeOf id with + | none => none + | some t => (readPropVal t r1).bind fun (v, r2) => + if propValOK id v then some (⟨id, v⟩, r2) else none + else none + +/-- Read properties until the input runs out, or `none` when + one fails to read. The fuel is a bound on the number of + properties: each property takes at least two bytes (an + identifier and one value byte at the least), so the input + length is always fuel enough. The `seen` list carries the + identifiers already read in this block. -/ +def readEntriesGo : Nat → PropSet → List Nat → List UInt8 → + Option (List Property × List UInt8) + | 0, _, _, bs => if bs.isEmpty then some ([], bs) else none + | fuel + 1, s, seen, bs => + if bs.isEmpty then some ([], bs) + else match readEntry s seen bs with + | none => none + | some (p, r1) => + match readEntriesGo fuel s (p.id :: seen) r1 with + | none => none + | some (ps, r2) => some (p :: ps, r2) + +/-- Read a whole property block's insides: exactly the given + bytes, all consumed, keeping the block rule of `authOK`. -/ +def readEntries (s : PropSet) (seg : List UInt8) : Option (List Property) := + match readEntriesGo seg.length s [] seg with + | some (ps, []) => if authOK ps then some ps else none + | _ => none + +/-- Read a property block: the property length as a variable + byte integer, then exactly that many bytes of properties. + Bytes left over inside the block, or a block that runs past + the bytes at hand, are rejected. -/ +def readProps (s : PropSet) (bs : List UInt8) : + Option (List Property × List UInt8) := do + let (len, r1) ← decVBI bs + let (seg, r2) ← readBytes len r1 + let ps ← readEntries s seg + pure (ps, r2) + +/-! ## SUBSCRIBE filter readers -/ + +/-- Read a subscription options byte. The reserved bits 6 and + 7 must be clear, and neither the QoS field nor the retain + handling field may hold the reserved value 3. -/ +def readOptsByte (b : Nat) : Option SubOpts := + if b < 64 ∧ b % 4 ≠ 3 ∧ (b / 16) % 4 ≠ 3 then + some ⟨b % 4, (b / 4) % 2 = 1, (b / 8) % 2 = 1, (b / 16) % 4⟩ + else none + +/-- Read topic filters until the input runs out, or `none` + when one fails to read. Each filter, with its options, must + keep the filter rules of `filterOK`. The fuel is a bound on + the number of filters: each filter takes at least three + bytes (a two byte length and an options byte), so the input + length is always fuel enough. -/ +def readFiltersGo : Nat → List UInt8 → + Option (List (List Char × SubOpts) × List UInt8) + | 0, bs => if bs.isEmpty then some ([], bs) else none + | fuel + 1, bs => + if bs.isEmpty then some ([], bs) + else match readStr bs with + | none => none + | some (f, ob :: r2) => + match readOptsByte ob.toNat with + | none => none + | some o => + if filterOK f o then + match readFiltersGo fuel r2 with + | none => none + | some (fs, r3) => some ((f, o) :: fs, r3) + else none + | some (_, []) => none + +/-! ## Body readers -/ + +/-- The `k`th bit of a number, as a boolean: bit 0 is the least + significant. -/ +def flagBit (n k : Nat) : Bool := (n / 2 ^ k) % 2 = 1 + +/-- A topic name check for a read string: not empty, and + neither wildcard character stands in it. The will topic + takes this check. -/ +def checkTopic (s : List Char) : Option (List Char) := + if s.isEmpty || s.any (fun c => decide (c = '+')) || s.any (fun c => decide (c = '#')) then + none + else some s + +/-- The wildcard half of the topic name check, for a PUBLISH + topic name, which may be empty when a Topic Alias stands + for it: neither wildcard character stands in the text + (section 3.3.2.1, [MQTT-3.3.2-2]). -/ +def checkNoWildcards (s : List Char) : Option (List Char) := + if s.any (fun c => decide (c = '+')) || s.any (fun c => decide (c = '#')) then + none + else some s + +/-- Read the will step of a CONNECT body: the will + properties, will topic and will payload when the will + flag is set, nothing when it is clear. The will QoS and + will retain come from the connect flags byte. -/ +def readWillPart (flags : Nat) (r6 : List UInt8) : + Option (Option Will × List UInt8) := + if flagBit flags 2 then + (readProps .will r6).bind fun (wprops, s1) => + (readStr s1).bind fun (wtopic, s2) => + (checkTopic wtopic).bind fun wtopic => + (readBin s2).bind fun (wpay, s3) => + some (some ⟨(flags / 8) % 4, flagBit flags 5, wprops, wtopic, wpay⟩, s3) + else some (none, r6) + +/-- Read an optional string field of a CONNECT payload, + present exactly when its connect flag bit is set. -/ +def readOptStrField (cond : Bool) (r : List UInt8) : + Option (Option (List Char) × List UInt8) := + if cond then (readStr r).map fun (u, r') => (some u, r') + else some (none, r) + +/-- Read an optional binary field of a CONNECT payload, + present exactly when its connect flag bit is set. -/ +def readOptBinField (cond : Bool) (r : List UInt8) : + Option (Option (List UInt8) × List UInt8) := + if cond then (readBin r).map fun (p, r') => (some p, r') + else some (none, r) + +/-- Read a CONNECT body: the whole body cut, nothing left + over. The protocol name must be "MQTT" and the level 5. The + reserved connect flag bit must be clear and the will QoS + must not be the reserved value 3. When the will flag is + clear, the will QoS and will retain bits must be clear too + (sections 3.1.2.6 [MQTT-3.1.2-11] and 3.1.2.7 + [MQTT-3.1.2-13]). The payload fields stand exactly when the + connect flags say they stand. -/ +def readConnectBody (seg : List UInt8) : Option Connect := + (readStr seg).bind fun (proto, r1) => + if proto = ['M', 'Q', 'T', 'T'] then + (readByte r1).bind fun (level, r2) => + if level = 5 then + (readByte r2).bind fun (flags, r3) => + if flags % 2 = 0 then + if (flags / 8) % 4 ≠ 3 then + if flagBit flags 2 || (flags / 8) % 8 = 0 then + (readNat 2 r3).bind fun (ka, r4) => + (readProps .connect r4).bind fun (props, r5) => + (readStr r5).bind fun (cid, r6) => + (readWillPart flags r6).bind fun (will, r7) => + (readOptStrField (flagBit flags 7) r7).bind fun (username, r8) => + (readOptBinField (flagBit flags 6) r8).bind fun (password, r9) => + if r9.isEmpty then + some ⟨flagBit flags 1, ka, props, cid, will, username, password⟩ + else none + else none + else none + else none + else none + else none + +/-- Read the packet identifier step of a PUBLISH body: no + identifier at QoS 0, a two byte nonzero identifier at + QoS 1 and 2. -/ +def readPacketId (flags : Nat) (r1 : List UInt8) : + Option (Option Nat × List UInt8) := + if (flags / 2) % 4 = 0 then some (none, r1) + else (readNat 2 r1).bind fun (id, r) => + if id ≠ 0 then some (some id, r) else none + +/-- Read a PUBLISH body: topic name, the packet identifier + when the QoS is 1 or 2 (and never 0), the properties, and + the payload, which is all the bytes that remain in the cut. + The QoS comes from the fixed header flags; the reserved + value 3 has already been turned away by the caller. The + topic name holds no wildcard, and it may be empty only when + the properties carry a Topic Alias (section 3.3.2.1: "It is + a Protocol Error if the Topic Name is zero length and there + is no Topic Alias"). -/ +def readPublishBody (flags : Nat) (seg : List UInt8) : Option Publish := + (readStr seg).bind fun (topic, r1) => + (checkNoWildcards topic).bind fun topic => + (readPacketId flags r1).bind fun (pid, r2) => + (readProps .publish r2).bind fun (props, payload) => + if topic.isEmpty && !hasTopicAlias props then none + else some ⟨flagBit flags 3, (flags / 2) % 4, flagBit flags 0, topic, pid, + props, payload⟩ + +/-- Read a SUBSCRIBE body: a nonzero packet identifier, the + properties, and a nonempty list of topic filters that + fills the rest of the cut exactly. -/ +def readSubscribeBody (seg : List UInt8) : Option Packet := do + let (id, r1) ← readNat 2 seg + if id ≠ 0 then pure () else none + let (props, r2) ← readProps .subscribe r1 + let (fs, r3) ← readFiltersGo r2.length r2 + if r3.isEmpty && !fs.isEmpty then pure (.subscribe id props fs) else none + +/-- Read a SUBACK body: a nonzero packet identifier, the + properties, and a nonempty list of reason codes filling + the rest of the cut. -/ +def readSubackBody (seg : List UInt8) : Option Packet := do + let (id, r1) ← readNat 2 seg + if id ≠ 0 then pure () else none + let (props, r2) ← readProps .suback r1 + if !r2.isEmpty then pure (.suback id props (r2.map UInt8.toNat)) else none + +/-- Read a DISCONNECT body: an empty cut is a normal + disconnection with no body. A cut of one byte is a reason + code on its own, with no property block: the specification + omits the property length when the remaining length is 1 + (section 3.14.2.2.1). A longer cut is a reason code and a + property block that fills the rest of the cut. The value + keeps which form arrived, so the printer writes it back the + same way. -/ +def readDisconnectBody (seg : List UInt8) : Option Packet := + match seg with + | [] => some (.disconnect none) + | rc :: r1 => + if r1.isEmpty then some (.disconnect (some (rc.toNat, none))) + else do + let (props, r2) ← readProps .disconnect r1 + if r2.isEmpty then pure (.disconnect (some (rc.toNat, some props))) else none + +/-- Read a packet body of the given type, with the given fixed + header flags, from a body cut out by the remaining length. + The reader must consume the cut exactly. Packet types + outside the seven this slice covers are rejected, and so + is a flags nibble other than the one the specification + fixes for the type, and a PUBLISH flags nibble with QoS 3, + or with DUP set at QoS 0. -/ +def parseBody (typ flags : Nat) (seg : List UInt8) : Option Packet := + match typ with + | 1 => if flags = 0 then (readConnectBody seg).map Packet.connect else none + | 3 => + if (flags / 2) % 4 = 3 then none + else if (flags / 2) % 4 = 0 ∧ flagBit flags 3 = true then none + else (readPublishBody flags seg).map Packet.publish + | 8 => if flags = 2 then readSubscribeBody seg else none + | 9 => if flags = 0 then readSubackBody seg else none + | 12 => if flags = 0 && seg.isEmpty then some .pingreq else none + | 13 => if flags = 0 && seg.isEmpty then some .pingresp else none + | 14 => if flags = 0 then readDisconnectBody seg else none + | _ => none + +/-! ## The packet reader -/ + +/-- Read one packet from the front of a byte list: the fixed + header byte, the remaining length, and exactly that many + body bytes. Returns the packet and the bytes after it. -/ +def parsePacket (bs : List UInt8) : Option (Packet × List UInt8) := + match bs with + | [] => none + | b :: r0 => do + let (len, r1) ← decVBI r0 + let (seg, r2) ← readBytes len r1 + let p ← parseBody (b.toNat / 16) (b.toNat % 16) seg + pure (p, r2) + +/-- Read one whole packet: exactly one packet, with nothing + after it. -/ +def parse (bs : List UInt8) : Option Packet := + match parsePacket bs with + | some (p, []) => some p + | _ => none + +end Mqtt diff --git a/Mqtt/Utf8.lean b/Mqtt/Utf8.lean new file mode 100644 index 0000000..1da5306 --- /dev/null +++ b/Mqtt/Utf8.lean @@ -0,0 +1,86 @@ +/- + UTF-8, by hand: MQTT strings travel on the wire as bytes, and + the string fields in this slice are held as lists of + characters, so the packet code needs both directions between + characters and bytes. + + The encoder writes the standard one to four bytes per + character. The decoder is strict. It turns away stray + continuation bytes, overlong forms (a character written with + more bytes than it needs, including any lead byte below C2), + lead bytes above F4, encodings of the surrogate values D800 to + DFFF, values above 10FFFF, and truncated sequences. + + This file is copied from Jws/Utf8.lean in Proven-Commons/jws#2, + a draft pull request that is not merged (jws main has no such + file), with the namespace renamed. The repos in this programme + do not share a library, so the code travels. Its proof is + included here, in Proofs/Utf8.lean. +-/ + +namespace Mqtt.Utf8 + +/-- The bytes of one character. -/ +def encodeChar (c : Char) : List UInt8 := + let n := c.toNat + if n < 0x80 then [n.toUInt8] + else if n < 0x800 then + [(0xC0 + n / 64).toUInt8, (0x80 + n % 64).toUInt8] + else if n < 0x10000 then + [(0xE0 + n / 4096).toUInt8, (0x80 + (n / 64) % 64).toUInt8, (0x80 + n % 64).toUInt8] + else + [(0xF0 + n / 262144).toUInt8, (0x80 + (n / 4096) % 64).toUInt8, + (0x80 + (n / 64) % 64).toUInt8, (0x80 + n % 64).toUInt8] + +/-- The bytes of a text. -/ +def encode (cs : List Char) : List UInt8 := + cs.flatMap encodeChar + +/-- The payload bits of a continuation byte (80 to BF). -/ +def contVal (b : UInt8) : Option Nat := + if 0x80 ≤ b.toNat ∧ b.toNat < 0xC0 then some (b.toNat - 0x80) else none + +/-- Strict decoding. The side conditions on the three and four + byte forms are the overlong, surrogate, and range rules: + after E0 the first continuation value is at least 32, after + ED it is below 32, after F0 it is at least 16, after F4 it + is below 16. -/ +def decode : List UInt8 → Option (List Char) + | [] => some [] + | b :: rest => + if b.toNat < 0x80 then + (decode rest).map fun cs => Char.ofNat b.toNat :: cs + else if b.toNat < 0xC2 then none + else if b.toNat < 0xE0 then + match rest with + | b1 :: rest1 => + match contVal b1 with + | some v1 => (decode rest1).map fun cs => + Char.ofNat ((b.toNat - 0xC0) * 64 + v1) :: cs + | none => none + | [] => none + else if b.toNat < 0xF0 then + match rest with + | b1 :: b2 :: rest1 => + match contVal b1, contVal b2 with + | some v1, some v2 => + if (b.toNat = 0xE0 → 0x20 ≤ v1) ∧ (b.toNat = 0xED → v1 < 0x20) then + (decode rest1).map fun cs => + Char.ofNat ((b.toNat - 0xE0) * 4096 + v1 * 64 + v2) :: cs + else none + | _, _ => none + | _ => none + else if b.toNat < 0xF5 then + match rest with + | b1 :: b2 :: b3 :: rest1 => + match contVal b1, contVal b2, contVal b3 with + | some v1, some v2, some v3 => + if (b.toNat = 0xF0 → 0x10 ≤ v1) ∧ (b.toNat = 0xF4 → v1 < 0x10) then + (decode rest1).map fun cs => + Char.ofNat ((b.toNat - 0xF0) * 262144 + v1 * 4096 + v2 * 64 + v3) :: cs + else none + | _, _, _ => none + | _ => none + else none + +end Mqtt.Utf8 diff --git a/Mqtt/Value.lean b/Mqtt/Value.lean new file mode 100644 index 0000000..0828fb0 --- /dev/null +++ b/Mqtt/Value.lean @@ -0,0 +1,634 @@ +/- + MQTT 5.0 packet values and the printer. + + A packet is one of the seven control packet types this slice + covers: CONNECT, PUBLISH, SUBSCRIBE, SUBACK, PINGREQ, + PINGRESP, and DISCONNECT. The printer writes a packet as the + fixed header byte, the remaining length as a variable byte + integer, and the body: the variable header and payload for the + packet's type. + + Properties are held as an identifier and a typed value. The + value type of an identifier is fixed by the specification's + property table (section 2.2.2, Table 2-4), which also says + which packets a property may appear on. Will properties, the + property block inside a CONNECT packet's will, count as their + own packet kind for that table, as the specification's table + lists them on their own line. + + Strings are held as lists of characters. What a string means + as bytes is settled by the strict UTF-8 codec in Mqtt/Utf8. +-/ + +import Mqtt.Utf8 + +namespace Mqtt + +/-! ## Big endian byte strings -/ + +/-- Write a number in exactly `k` bytes, most significant byte + first. Bytes past the number's own width are zero, and a + number too wide for `k` bytes loses its top bytes: the + printer only calls this with a width the number fits. -/ +def writeBE : Nat → Nat → List UInt8 + | 0, _ => [] + | k + 1, n => ((n / 256 ^ k) % 256).toUInt8 :: writeBE k (n % 256 ^ k) + +/-- The unfolding rule for `writeBE` at a successor width. -/ +theorem writeBE_succ (k n : Nat) : + writeBE (k + 1) n = ((n / 256 ^ k) % 256).toUInt8 :: writeBE k (n % 256 ^ k) := by + rw [writeBE] + +/-- A big endian writing is exactly as long as its width. -/ +theorem writeBE_length : ∀ (k n : Nat), (writeBE k n).length = k + | 0, _ => rfl + | k + 1, n => by rw [writeBE_succ]; simp [writeBE_length k] + +/-! ## The variable byte integer -/ + +/-- Write a number as a variable byte integer (section 2.1.4): + seven bits per byte, low groups first, the top bit of each + byte but the last set as a continuation mark. The format + carries at most four bytes, so numbers below 2^28 are the + ones it can carry. This function has no cap: a number of + 2^28 or more gets a writing of five or more bytes, which + the reader refuses. The well formedness rules below keep + every written number under the bound. -/ +def printVBI (n : Nat) : List UInt8 := + if n < 128 then [n.toUInt8] + else (128 + n % 128).toUInt8 :: printVBI (n / 128) +termination_by n +decreasing_by + exact Nat.div_lt_self (by omega) (by decide) + +/-- The unfolding rule for `printVBI`. -/ +theorem printVBI_def (n : Nat) : + printVBI n = if n < 128 then [n.toUInt8] + else (128 + n % 128).toUInt8 :: printVBI (n / 128) := by + rw [printVBI] + +/-! ## Properties: the table -/ + +/-- The value type of a property, as the specification's + property table gives it. -/ +inductive PropType where + | byte : PropType + | twoByte : PropType + | fourByte : PropType + | varByte : PropType + | utf8 : PropType + | utf8Pair : PropType + | binary : PropType + deriving DecidableEq, Repr + +/-- A property value, in the shape of its type. Strings are + lists of characters; binary data is a list of bytes. -/ +inductive PropVal where + | byte (n : Nat) : PropVal + | twoByte (n : Nat) : PropVal + | fourByte (n : Nat) : PropVal + | varByte (n : Nat) : PropVal + | utf8 (s : List Char) : PropVal + | utf8Pair (k v : List Char) : PropVal + | binary (bs : List UInt8) : PropVal + deriving DecidableEq, Repr + +/-- The type of a property value. -/ +def valType : PropVal → PropType + | .byte _ => .byte + | .twoByte _ => .twoByte + | .fourByte _ => .fourByte + | .varByte _ => .varByte + | .utf8 _ => .utf8 + | .utf8Pair _ _ => .utf8Pair + | .binary _ => .binary + +/-- One property: an identifier and a value. -/ +structure Property where + id : Nat + val : PropVal + deriving DecidableEq, Repr + +/-- The specification's property table (section 2.2.2, + Table 2-4): the value type of each identifier the + specification defines. An identifier the table does not + list has no type here, and the reader rejects it. -/ +def propTypeOf : Nat → Option PropType + | 0x01 => some .byte + | 0x02 => some .fourByte + | 0x03 => some .utf8 + | 0x08 => some .utf8 + | 0x09 => some .binary + | 0x0B => some .varByte + | 0x11 => some .fourByte + | 0x12 => some .utf8 + | 0x13 => some .twoByte + | 0x15 => some .utf8 + | 0x16 => some .binary + | 0x17 => some .byte + | 0x18 => some .fourByte + | 0x19 => some .byte + | 0x1A => some .utf8 + | 0x1C => some .utf8 + | 0x1F => some .utf8 + | 0x21 => some .twoByte + | 0x22 => some .twoByte + | 0x23 => some .twoByte + | 0x24 => some .byte + | 0x25 => some .byte + | 0x26 => some .utf8Pair + | 0x27 => some .fourByte + | 0x28 => some .byte + | 0x29 => some .byte + | 0x2A => some .byte + | _ => none + +/-- The places a property block can stand, for the table's + packet column: the CONNECT packet's own block, the will + block inside CONNECT, and one block each for PUBLISH, + SUBSCRIBE, SUBACK, and DISCONNECT. -/ +inductive PropSet where + | connect : PropSet + | will : PropSet + | publish : PropSet + | subscribe : PropSet + | suback : PropSet + | disconnect : PropSet + deriving DecidableEq, Repr + +/-- The identifiers the specification's table allows on each + property block, by the table's packet column. -/ +def allowedOf : PropSet → List Nat + | .connect => [0x11, 0x15, 0x16, 0x17, 0x19, 0x21, 0x22, 0x26, 0x27] + | .will => [0x01, 0x02, 0x03, 0x08, 0x09, 0x18, 0x26] + | .publish => [0x01, 0x02, 0x03, 0x08, 0x09, 0x0B, 0x23, 0x26] + | .subscribe => [0x0B, 0x26] + | .suback => [0x1F, 0x26] + | .disconnect => [0x11, 0x1C, 0x1F, 0x26] + +/-- May this property appear more than once in one block? The + user property (0x26) may, wherever it is allowed. The + subscription identifier (0x0B) may repeat on PUBLISH: a + server sending one message for several matching + subscriptions carries one identifier per subscription, and + the identifiers may be equal (section 3.3.4). Every other + property is single use: a second copy in one block is + rejected. -/ +def repeatableIn (s : PropSet) (id : Nat) : Bool := + id = 0x26 || (id = 0x0B && s = .publish) + +/-- The value rules the standard sets on single property + values, beyond their type. A value that breaks one is a + Protocol Error: + + - Response Topic (0x08) is used as a Topic Name, so it is + not empty and holds neither wildcard character (sections + 3.3.2.3.5 [MQTT-3.3.2-14], 4.7.0 [MQTT-4.7.0-1] and + 4.7.3 [MQTT-4.7.3-1]). + - Subscription Identifier (0x0B) is not 0 (sections + 3.3.2.3.8 and 3.8.2.1.2). + - Request Problem Information (0x17) and Request Response + Information (0x19) are 0 or 1 (sections 3.1.2.11.7 and + 3.1.2.11.6). + - Receive Maximum (0x21) is not 0 (section 3.1.2.11.3). + - Topic Alias (0x23) is not 0 (section 3.3.2.3.4, + [MQTT-3.3.2-8]). + - Maximum Packet Size (0x27) is not 0 (section + 3.1.2.11.4). + + Every other value of the right type passes. -/ +def propValOK : Nat → PropVal → Bool + | 0x08, .utf8 s => !s.isEmpty && !s.contains '+' && !s.contains '#' + | 0x0B, .varByte n => n != 0 + | 0x17, .byte n => n ≤ 1 + | 0x19, .byte n => n ≤ 1 + | 0x21, .twoByte n => n != 0 + | 0x23, .twoByte n => n != 0 + | 0x27, .fourByte n => n != 0 + | _, _ => true + +/-- The one rule the standard sets across a property block: + Authentication Data (0x16) may stand only together with an + Authentication Method (0x15) (section 3.1.2.11.10). -/ +def authOK (ps : List Property) : Bool := + !(ps.any fun p => p.id == 0x16) || ps.any fun p => p.id == 0x15 + +/-! ## String checks + + The specification's string rules (section 1.5.4): a string is + well formed UTF-8 and must not contain the null character + U+0000. The byte length of a string field must also fit the + two byte length prefix. -/ + +/-- Does this text contain the null character? -/ +def hasNul (s : List Char) : Bool := + s.any fun c => decide (c = '\u0000') + +/-- A string fit to print: no null character, and its UTF-8 + byte length fits the two byte length prefix. -/ +def StrWF (s : List Char) : Prop := + '\u0000' ∉ s ∧ (Utf8.encode s).length ≤ 65535 + +/-- Binary data fit to print: its length fits the two byte + length prefix. -/ +def BinWF (bs : List UInt8) : Prop := + bs.length ≤ 65535 + +/-- A topic name fit to print (section 4.7.1): a string, not + empty, holding neither wildcard character. -/ +def TopicWF (s : List Char) : Prop := + StrWF s ∧ s ≠ [] ∧ '+' ∉ s ∧ '#' ∉ s + +/-- Does a property list carry a Topic Alias (0x23)? -/ +def hasTopicAlias (ps : List Property) : Bool := + ps.any fun p => p.id == 0x23 + +/-- A PUBLISH topic name fit to print, beside the packet's + properties: a string holding neither wildcard character, + which may be empty only when the properties carry a Topic + Alias that stands for the topic (sections 3.3.2.1 and + 3.3.2.3.4). -/ +def PubTopicWF (s : List Char) (props : List Property) : Prop := + StrWF s ∧ '+' ∉ s ∧ '#' ∉ s ∧ (s = [] → hasTopicAlias props = true) + +/-! ## Field printers -/ + +/-- Print a string field: the two byte length of its UTF-8 + bytes, then the bytes (section 1.5.4). -/ +def printStr (s : List Char) : List UInt8 := + writeBE 2 (Utf8.encode s).length ++ Utf8.encode s + +/-- Print a binary data field: the two byte length, then the + bytes (section 1.5.3). -/ +def printBin (bs : List UInt8) : List UInt8 := + writeBE 2 bs.length ++ bs + +/-- Print a property value, in the shape of its type. -/ +def printPropVal : PropVal → List UInt8 + | .byte n => [n.toUInt8] + | .twoByte n => writeBE 2 n + | .fourByte n => writeBE 4 n + | .varByte n => printVBI n + | .utf8 s => printStr s + | .utf8Pair k v => printStr k ++ printStr v + | .binary bs => printBin bs + +/-- Print one property: the identifier as a variable byte + integer, then the value. -/ +def printProperty (p : Property) : List UInt8 := + printVBI p.id ++ printPropVal p.val + +/-- Print a list of properties, one after the other. -/ +def printPropsList : List Property → List UInt8 + | [] => [] + | p :: ps => printProperty p ++ printPropsList ps + +/-- Print a property block: the property length as a variable + byte integer, then the properties themselves (section + 2.2.2). -/ +def printProps (ps : List Property) : List UInt8 := + printVBI (printPropsList ps).length ++ printPropsList ps + +/-! ## The packet values -/ + +/-- The subscription options of one topic filter in a SUBSCRIBE + packet (section 3.8.3): a maximum QoS, the no local and + retain as published flags, and a retain handling choice. -/ +structure SubOpts where + qos : Nat + noLocal : Bool + retainAsPublished : Bool + retainHandling : Nat + deriving DecidableEq, Repr + +/-- The options byte of a filter: QoS in bits 0 and 1, no local + at bit 2, retain as published at bit 3, retain handling in + bits 4 and 5, and the reserved bits 6 and 7 clear. -/ +def printOptsByte (o : SubOpts) : UInt8 := + (o.qos + (if o.noLocal then 4 else 0) + (if o.retainAsPublished then 8 else 0) + + o.retainHandling * 16).toUInt8 + +/-- A will, the part of a CONNECT packet that stands when its + will flag is set (section 3.1.3): will properties, a will + topic, and a will payload, with the QoS and retain flag the + connect flags byte carries. -/ +structure Will where + qos : Nat + retain : Bool + props : List Property + topic : List Char + payload : List UInt8 + deriving DecidableEq, Repr + +/-- A CONNECT packet's fields (section 3.1). The protocol name + and level are not fields: this slice reads and writes MQTT + 5.0 only, so they are fixed at "MQTT" and 5. The connect + flags byte is computed from the fields that drive it: the + username and password options, the will option with its QoS + and retain flag, and the clean start flag. -/ +structure Connect where + cleanStart : Bool + keepAlive : Nat + props : List Property + clientId : List Char + will : Option Will + username : Option (List Char) + password : Option (List UInt8) + deriving DecidableEq, Repr + +/-- A PUBLISH packet's fields (section 3.3). The packet + identifier stands exactly when the QoS is 1 or 2, so it is + an option beside the QoS. -/ +structure Publish where + dup : Bool + qos : Nat + retain : Bool + topic : List Char + packetId : Option Nat + props : List Property + payload : List UInt8 + deriving DecidableEq, Repr + +/-- A control packet of one of the seven types this slice + covers. A DISCONNECT body is one of the three forms section + 3.14 allows: none at all (`none`), a reason code alone + (`some (rc, none)`), or a reason code and a property block + (`some (rc, some ps)`). -/ +inductive Packet where + | connect (c : Connect) : Packet + | publish (p : Publish) : Packet + | subscribe (packetId : Nat) (props : List Property) + (filters : List (List Char × SubOpts)) : Packet + | suback (packetId : Nat) (props : List Property) + (reasons : List Nat) : Packet + | pingreq : Packet + | pingresp : Packet + | disconnect (body : Option (Nat × Option (List Property))) : Packet + deriving DecidableEq, Repr + +/-! ## Body printers -/ + +/-- The connect flags byte (section 3.1.2): username flag at + bit 7, password flag at bit 6, will retain at bit 5, will + QoS at bits 4 and 3, will flag at bit 2, clean start at + bit 1, and the reserved bit 0 clear. -/ +def connectFlags (c : Connect) : Nat := + (if c.username.isSome then 128 else 0) + + (if c.password.isSome then 64 else 0) + + (match c.will with + | some w => (if w.retain then 32 else 0) + w.qos * 8 + 4 + | none => 0) + + (if c.cleanStart then 2 else 0) + +/-- Print the will part of a CONNECT payload, or nothing when + there is no will. -/ +def printWillPart : Option Will → List UInt8 + | none => [] + | some w => printProps w.props ++ (printStr w.topic ++ printBin w.payload) + +/-- Print an optional string field, or nothing. -/ +def printOptStr : Option (List Char) → List UInt8 + | none => [] + | some s => printStr s + +/-- Print an optional binary field, or nothing. -/ +def printOptBin : Option (List UInt8) → List UInt8 + | none => [] + | some bs => printBin bs + +/-- The body of a CONNECT packet: the protocol name, protocol + level, connect flags, and keep alive, then the properties, + then the payload: client identifier, the will fields when + the will flag is set, the username when its flag is set, + and the password when its flag is set. -/ +def printConnectBody (c : Connect) : List UInt8 := + printStr ['M', 'Q', 'T', 'T'] ++ ([5, (connectFlags c).toUInt8] + ++ (writeBE 2 c.keepAlive ++ (printProps c.props ++ (printStr c.clientId + ++ (printWillPart c.will ++ (printOptStr c.username + ++ printOptBin c.password)))))) + +/-- The fixed header byte of a PUBLISH packet: the type 3, the + DUP flag at bit 3, the QoS at bits 2 and 1, and RETAIN at + bit 0. -/ +def publishHeader (p : Publish) : Nat := + 0x30 + (if p.dup then 8 else 0) + p.qos * 2 + (if p.retain then 1 else 0) + +/-- Print a packet identifier when one stands, or nothing. -/ +def printIdOpt : Option Nat → List UInt8 + | none => [] + | some id => writeBE 2 id + +/-- The body of a PUBLISH packet: topic name, the packet + identifier when the QoS carries one, the properties, then + the payload, which is all the bytes that remain. -/ +def printPublishBody (p : Publish) : List UInt8 := + printStr p.topic ++ (printIdOpt p.packetId ++ (printProps p.props ++ p.payload)) + +/-- Print one topic filter of a SUBSCRIBE payload: the filter + string, then its options byte. -/ +def printFilter (f : List Char × SubOpts) : List UInt8 := + printStr f.1 ++ [printOptsByte f.2] + +/-- Print a list of topic filters, one after the other. -/ +def printFilters : List (List Char × SubOpts) → List UInt8 + | [] => [] + | f :: fs => printFilter f ++ printFilters fs + +/-- The body of a SUBSCRIBE packet: packet identifier, + properties, then the topic filters. -/ +def printSubscribeBody (id : Nat) (ps : List Property) + (fs : List (List Char × SubOpts)) : List UInt8 := + writeBE 2 id ++ (printProps ps ++ printFilters fs) + +/-- The body of a SUBACK packet: packet identifier, properties, + then one reason code byte per granted subscription. -/ +def printSubackBody (id : Nat) (ps : List Property) (rs : List Nat) : List UInt8 := + writeBE 2 id ++ (printProps ps ++ rs.map Nat.toUInt8) + +/-- The body of a packet: everything after the fixed header + byte and the remaining length. -/ +def bodyOf : Packet → List UInt8 + | .connect c => printConnectBody c + | .publish p => printPublishBody p + | .subscribe id ps fs => printSubscribeBody id ps fs + | .suback id ps rs => printSubackBody id ps rs + | .pingreq => [] + | .pingresp => [] + | .disconnect none => [] + | .disconnect (some (rc, none)) => [rc.toUInt8] + | .disconnect (some (rc, some ps)) => [rc.toUInt8] ++ printProps ps + +/-- The fixed header byte of a packet: the type in the high + nibble, and the flags the specification fixes in the low + nibble (section 2.1.2). SUBSCRIBE carries 0010; PUBLISH + carries its own DUP, QoS, and RETAIN bits; the rest carry + 0000. -/ +def headerOf : Packet → UInt8 + | .connect _ => 0x10 + | .publish p => (publishHeader p).toUInt8 + | .subscribe _ _ _ => 0x82 + | .suback _ _ _ => 0x90 + | .pingreq => 0xC0 + | .pingresp => 0xD0 + | .disconnect _ => 0xE0 + +/-- Print a packet: the fixed header byte, the remaining length + as a variable byte integer, and the body. -/ +def print (p : Packet) : List UInt8 := + headerOf p :: printVBI (bodyOf p).length ++ bodyOf p + +/-! ## Well formed values + + The round trip claim in `Proofs` holds for well formed + packets: the fields the printer can write exactly. Numbers + fit the widths that carry them, strings obey the string + rules, properties match the table in type and place and do + not repeat a single use property, and the whole body fits + the remaining length's four byte variable byte integer. -/ + +/-- A property value in the shape the printer writes exactly. -/ +def ValWF : PropVal → Prop + | .byte n => n < 256 + | .twoByte n => n < 65536 + | .fourByte n => n < 4294967296 + | .varByte n => n < 268435456 + | .utf8 s => StrWF s + | .utf8Pair k v => StrWF k ∧ StrWF v + | .binary bs => BinWF bs + +/-- A property list in the shape of one block: every property + is allowed on the block's packet kind, its value matches + the table's type for its identifier, is itself well formed + and keeps the value rules of `propValOK`, and no single use + property repeats. The `seen` list carries the identifiers + already standing in the block; calls start it empty. -/ +def PropsWF (s : PropSet) : List Nat → List Property → Prop + | _, [] => True + | seen, p :: ps => + p.id ∈ allowedOf s ∧ propTypeOf p.id = some (valType p.val) ∧ ValWF p.val + ∧ propValOK p.id p.val = true + ∧ (repeatableIn s p.id = true ∨ p.id ∉ seen) + ∧ PropsWF s (p.id :: seen) ps + +/-- A property block fit to print: the list is well formed, its + printed length fits a variable byte integer, and it keeps + the block rule of `authOK`. -/ +def PropsBlockWF (s : PropSet) (ps : List Property) : Prop := + PropsWF s [] ps ∧ (printPropsList ps).length < 268435456 ∧ authOK ps = true + +/-- A will fit to print. -/ +def WillWF (w : Will) : Prop := + w.qos ≤ 2 ∧ PropsBlockWF .will w.props ∧ TopicWF w.topic ∧ BinWF w.payload + +/-- A CONNECT packet fit to print. -/ +def ConnectWF (c : Connect) : Prop := + c.keepAlive < 65536 ∧ PropsBlockWF .connect c.props ∧ StrWF c.clientId + ∧ (∀ w, c.will = some w → WillWF w) + ∧ (∀ u, c.username = some u → StrWF u) + ∧ (∀ p, c.password = some p → BinWF p) + +/-- A PUBLISH packet fit to print. The packet identifier + stands exactly when the QoS is 1 or 2, and is never 0. The + DUP flag is clear at QoS 0 (section 3.3.1.1, + [MQTT-3.3.1-2]). -/ +def PublishWF (p : Publish) : Prop := + p.qos ≤ 2 ∧ PubTopicWF p.topic p.props + ∧ (∀ id, p.packetId = some id → 1 ≤ id ∧ id < 65536 ∧ (p.qos = 1 ∨ p.qos = 2)) + ∧ (p.packetId = none → p.qos = 0) + ∧ PropsBlockWF .publish p.props + ∧ (p.qos = 0 → p.dup = false) + +/-- Subscription options fit to print: the QoS and the retain + handling choice are at most 2 (3 is reserved in both). -/ +def OptsWF (o : SubOpts) : Prop := + o.qos ≤ 2 ∧ o.retainHandling ≤ 2 + +/-! ## Topic filters -/ + +/-- Split a text at each `/` into its topic levels (section + 4.7.1.1). A text with no `/` is one level, and the empty + text is one empty level. -/ +def splitLevels : List Char → List (List Char) + | [] => [[]] + | c :: cs => + if c = '/' then [] :: splitLevels cs + else match splitLevels cs with + | [] => [[c]] + | l :: ls => (c :: l) :: ls + +/-- A level of a topic filter other than the last: either `+` + alone, which must occupy an entire level [MQTT-4.7.1-2], or + a level holding neither wildcard character. -/ +def levelOK (l : List Char) : Bool := + l == ['+'] || (!l.contains '#' && !l.contains '+') + +/-- The wildcard rules over the levels of a topic filter + (section 4.7.1): `+` stands alone in its level + [MQTT-4.7.1-2], and `#` stands alone in the last level + [MQTT-4.7.1-1]. -/ +def levelsOK : List (List Char) → Bool + | [] => true + | [l] => l == ['#'] || levelOK l + | l :: ls => levelOK l && levelsOK ls + +/-- A topic filter that is not a shared subscription: at least + one character long [MQTT-4.7.3-1], and its levels keep the + wildcard rules. -/ +def plainFilterOK (f : List Char) : Bool := + !f.isEmpty && levelsOK (splitLevels f) + +/-- Split the text after `$share/` at its first `/`: the + ShareName before it, and the filter after it when a `/` + stands. -/ +def shareSplit : List Char → List Char × Option (List Char) + | [] => ([], none) + | c :: cs => + if c = '/' then ([], some cs) + else match shareSplit cs with + | (n, r) => (c :: n, r) + +/-- A topic filter and its options, fit for a SUBSCRIBE. A filter + that starts with `$share/` is a shared subscription (section + 4.8.2): a ShareName at least one character long holding no + `+` or `#` [MQTT-4.8.2-1], then a `/` and a topic filter + [MQTT-4.8.2-2], and the No Local option clear + [MQTT-3.8.3-4]. Any other filter keeps the plain rules. -/ +def filterOK (f : List Char) (o : SubOpts) : Bool := + match f with + | '$' :: 's' :: 'h' :: 'a' :: 'r' :: 'e' :: '/' :: r => + match shareSplit r with + | (name, some flt) => + !name.isEmpty && !name.contains '+' && !name.contains '#' + && plainFilterOK flt && !o.noLocal + | (_, none) => false + | _ => plainFilterOK f + +/-- A topic filter list fit to print, member by member: each + filter is a string, its options are well formed, and the + pair keeps the filter rules of `filterOK`. -/ +def FiltersWF : List (List Char × SubOpts) → Prop + | [] => True + | (f, o) :: fs => StrWF f ∧ OptsWF o ∧ filterOK f o = true ∧ FiltersWF fs + +/-- The per type half of well formedness for a packet. -/ +def PacketFieldsWF : Packet → Prop + | .connect c => ConnectWF c + | .publish p => PublishWF p + | .subscribe id ps fs => + 1 ≤ id ∧ id < 65536 ∧ PropsBlockWF .subscribe ps ∧ fs ≠ [] ∧ FiltersWF fs + | .suback id ps rs => + 1 ≤ id ∧ id < 65536 ∧ PropsBlockWF .suback ps ∧ rs ≠ [] + ∧ (∀ r ∈ rs, r < 256) + | .pingreq => True + | .pingresp => True + | .disconnect none => True + | .disconnect (some (rc, none)) => rc < 256 + | .disconnect (some (rc, some ps)) => rc < 256 ∧ PropsBlockWF .disconnect ps + +/-- A packet fit to print: its fields are well formed and its + body fits the remaining length, a variable byte integer of + at most four bytes. -/ +def PacketWF (p : Packet) : Prop := + PacketFieldsWF p ∧ (bodyOf p).length < 268435456 + +end Mqtt diff --git a/Mqtt/Verify.lean b/Mqtt/Verify.lean new file mode 100644 index 0000000..feae13b --- /dev/null +++ b/Mqtt/Verify.lean @@ -0,0 +1,34 @@ +/- + Axiom check for the claims this package makes. Run with: + + lake env lean Mqtt/Verify.lean + + Every claim should list only the standard axioms (propext, + Classical.choice, Quot.sound). A line naming sorryAx would mean + a proof rests on an admitted gap, and the claim is not proved. +-/ + +import Proofs +import Proofs.Examples + +open Mqtt.Proofs Mqtt.Examples + +#print axioms parse_print +#print axioms parsePacket_print +#print axioms decVBI_printVBI +#print axioms parse_inv +#print axioms parsePacket_inv +#print axioms decVBI_canonical +#print axioms parse_connect +#print axioms parse_publish_qos1 +#print axioms vbi_max +#print axioms vbi_five_bytes +#print axioms printVBI_length +#print axioms decVBI_length +#print axioms parse_iff +#print axioms header_rule +#print axioms connect_rule +#print axioms publish_rule +#print axioms subscribe_rule +#print axioms property_rule +#print axioms empty_body_rule diff --git a/Proofs.lean b/Proofs.lean new file mode 100644 index 0000000..4486e2a --- /dev/null +++ b/Proofs.lean @@ -0,0 +1,7 @@ +import Proofs.Utf8 +import Proofs.RoundTrip +import Proofs.Utf8Inv +import Proofs.Sound +import Proofs.Rules +import Proofs.Examples +import Proofs.SpecProofs diff --git a/Proofs/Examples.lean b/Proofs/Examples.lean new file mode 100644 index 0000000..a97b7fd --- /dev/null +++ b/Proofs/Examples.lean @@ -0,0 +1,118 @@ +/- + Worked examples, proved. The variable byte integer examples + are the MQTT 5.0 specification's own table (section 2.1.4). + The packet examples are hand built from the specification + text, one for each packet type in this slice, plus the + rejections this slice promises. The same packets run + through the command line tool in the test harness, where + they are checked byte by byte a second time. + + The examples are stated on the reading side. The round trip + and soundness theorems cover the printer in general, and + `Spec.disconnect_short_form` evaluates it on two packets. +-/ + +import Mqtt + +namespace Mqtt.Examples + +open Mqtt + +/-! ## The variable byte integer table (spec section 2.1.4) -/ + +theorem vbi_zero : decVBI [0] = some (0, []) := by decide + +theorem vbi_127 : decVBI [127] = some (127, []) := by decide + +theorem vbi_128 : decVBI [128, 1] = some (128, []) := by decide + +theorem vbi_16383 : decVBI [255, 127] = some (16383, []) := by decide + +theorem vbi_16384 : decVBI [128, 128, 1] = some (16384, []) := by decide + +theorem vbi_2097151 : decVBI [255, 255, 127] = some (2097151, []) := by + decide + +theorem vbi_2097152 : decVBI [128, 128, 128, 1] = some (2097152, []) := by + decide + +theorem vbi_max : decVBI [255, 255, 255, 127] = some (268435455, []) := by + decide + +/-- A continuation bit on the fourth byte rejects: the value + would need a fifth byte. -/ +theorem vbi_five_bytes : decVBI [255, 255, 255, 255] = none := by decide + +/-- A writing longer than the value needs rejects (section + 1.5.5): here 0 carried in two bytes, and 128 carried in + three. -/ +theorem vbi_non_minimal : decVBI [128, 0] = none := by decide + +theorem vbi_non_minimal_three : decVBI [128, 129, 0] = none := by decide + +/-- The decoder returns the rest of the stream untouched. -/ +theorem vbi_rest : decVBI [128, 1, 99] = some (128, [99]) := by decide + +/-! ## One packet of each type -/ + +theorem parse_pingreq : parse [192, 0] = some .pingreq := by decide + +theorem parse_pingresp : parse [208, 0] = some .pingresp := by decide + +/-- A DISCONNECT with no body is a normal disconnection. -/ +theorem parse_disconnect_empty : + parse [224, 0] = some (.disconnect none) := by decide + +/-- A DISCONNECT body of one byte is a reason code with no + property block. It is legal, and the value keeps the form. -/ +theorem parse_disconnect_reason : + parse [224, 1, 0] = some (.disconnect (some (0, none))) := by decide + +/-- A DISCONNECT body of a reason code and an empty property + block is the other form. -/ +theorem parse_disconnect_reason_props : + parse [224, 2, 0, 0] = some (.disconnect (some (0, some []))) := by decide + +theorem parse_publish_qos0 : + parse [48, 6, 0, 1, 97, 0, 1, 2] + = some (.publish ⟨false, 0, false, ['a'], none, [], [1, 2]⟩) := by + decide + +theorem parse_publish_qos1 : + parse [50, 6, 0, 1, 97, 0, 1, 0] + = some (.publish ⟨false, 1, false, ['a'], some 1, [], []⟩) := by + decide + +theorem parse_subscribe : + parse [130, 7, 0, 1, 0, 0, 1, 97, 0] + = some (.subscribe 1 [] [(['a'], ⟨0, false, false, 0⟩)]) := by + decide + +theorem parse_suback : + parse [144, 4, 0, 1, 0, 0] = some (.suback 1 [] [0]) := by decide + +theorem parse_connect : + parse [16, 14, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 0, 0, 1, 120] + = some (.connect ⟨true, 0, [], ['x'], none, none, none⟩) := by + decide + +/-! ## Rejections -/ + +/-- A PINGREQ with a body rejects: its remaining length must + be 0. -/ +theorem parse_pingreq_body : parse [192, 1, 0] = none := by decide + +/-- An empty PUBLISH topic with no Topic Alias rejects. -/ +theorem parse_publish_empty_topic : parse [48, 3, 0, 0, 0] = none := by + decide + +/-- An empty PUBLISH topic with a Topic Alias is accepted. -/ +theorem parse_publish_empty_topic_alias : + parse [48, 6, 0, 0, 3, 35, 0, 1] + = some (.publish ⟨false, 0, false, [], none, [⟨35, .twoByte 1⟩], []⟩) := by + decide + +/-- A packet type outside this slice rejects, here type 2. -/ +theorem parse_wrong_type : parse [32, 0] = none := by decide + +end Mqtt.Examples diff --git a/Proofs/RoundTrip.lean b/Proofs/RoundTrip.lean new file mode 100644 index 0000000..0f78e09 --- /dev/null +++ b/Proofs/RoundTrip.lean @@ -0,0 +1,1473 @@ +/- + The round trip proofs for the MQTT packet codec: reading what + the printer wrote gives the packet back. + + The main claim is `Mqtt.Proofs.parse_print`: for a well + formed packet `p`, `parse (print p) = some p`. It is built + from one lemma per field reader, each in the shape "reading + the printed field, with any bytes after it left in place, + gives the field and leaves the bytes after it". Property + blocks and filter lists read to the end of their bytes, so + their lemmas are stated on the printed bytes exactly. +-/ + +import Mqtt +import Proofs.Utf8 + +namespace Mqtt.Proofs + +open Mqtt + +/-- A number below 256 written as a byte reads back as itself. -/ +theorem toNat_toUInt8 {k : Nat} (h : k < 256) : k.toUInt8.toNat = k := + Mqtt.Utf8.Proofs.toNat_toUInt8 h + +/-! ## The byte readers on writings -/ + +/-- A big endian writing reads back: at every width, the number + written is the number read, and the bytes after the writing + are left alone. -/ +theorem readNat_writeBE : ∀ (k n : Nat) (rest : List UInt8), + n < 256 ^ k → readNat k (writeBE k n ++ rest) = some (n, rest) := by + intro k + induction k with + | zero => + intro n rest hn + rw [Nat.pow_zero] at hn + have hn0 : n = 0 := by omega + rw [hn0] + rfl + | succ k ih => + intro n rest hn + have hP : 0 < 256 ^ k := Nat.pow_pos (by decide) + have hlt : n / 256 ^ k < 256 := by + rw [Nat.pow_succ] at hn + exact Nat.div_lt_of_lt_mul hn + have hd : ((n / 256 ^ k) % 256).toUInt8.toNat = n / 256 ^ k := by + have h1 : ((n / 256 ^ k) % 256).toUInt8.toNat = (n / 256 ^ k) % 256 := + UInt8.toNat_ofNat_of_lt (Nat.mod_lt _ (by decide : 0 < 256)) + rw [h1, Nat.mod_eq_of_lt hlt] + rw [writeBE_succ, List.cons_append, readNat_succ_cons, + ih (n % 256 ^ k) rest (Nat.mod_lt _ hP), hd] + simp only [Option.map_some, Option.some.injEq, Prod.mk.injEq] + constructor + · rw [Nat.mul_comm]; exact Nat.div_add_mod _ _ + · trivial + +/-- A byte run reads back whole: taking the front of a list that + starts with the run gives the run, and leaves the rest. -/ +theorem readBytes_append : ∀ (n : Nat) (bs rest : List UInt8), + bs.length = n → readBytes n (bs ++ rest) = some (bs, rest) := by + intro n bs rest h + unfold readBytes + rw [ite_eq_left (by simp [List.length_append, h] : (bs ++ rest).length ≥ n), + ← h, List.take_left, List.drop_left] + +/-! ## The variable byte integer -/ + +/-- A variable byte integer writing is never empty. -/ +theorem printVBI_pos : ∀ (n : Nat), 0 < (printVBI n).length := by + intro n + rw [printVBI_def] + by_cases h : n < 128 + · rw [ite_eq_left h]; simp + · rw [ite_eq_right h]; simp + +/-- Reading a printed variable byte integer, with the counting + form of the reader: with at most `k + 1` bytes to spend and + a value that fits in `k + 1` groups, the reader returns the + value and leaves the bytes after the writing. Induction on + `k`: a value below 128 is one byte, and a larger value is + its low group, marked as continued, in front of the writing + of the rest of the value, which is not 0. -/ +theorem decVBIGo_printVBI : ∀ (k : Nat) (n : Nat) (rest : List UInt8), + n < 128 ^ (k + 1) → + decVBIGo (k + 1) (printVBI n ++ rest) = some (n, rest) := by + intro k + induction k with + | zero => + intro n rest hn + rw [Nat.pow_one] at hn + rw [printVBI_def, ite_eq_left hn] + show decVBIGo 1 (n.toUInt8 :: rest) = some (n, rest) + rw [decVBIGo, toNat_toUInt8 (by omega : n < 256), ite_eq_left hn] + | succ k ih => + intro n rest hn + by_cases h1 : n < 128 + · rw [printVBI_def, ite_eq_left h1] + show decVBIGo (k + 2) (n.toUInt8 :: rest) = some (n, rest) + rw [decVBIGo, toNat_toUInt8 (by omega : n < 256), ite_eq_left h1] + · rw [printVBI_def, ite_eq_right h1] + show decVBIGo (k + 2) ((128 + n % 128).toUInt8 :: (printVBI (n / 128) ++ rest)) + = some (n, rest) + have hdiv : n / 128 < 128 ^ (k + 1) := by + rw [Nat.pow_succ] at hn + omega + rw [decVBIGo, toNat_toUInt8 (by omega : 128 + n % 128 < 256), + ite_eq_right (by omega : ¬ (128 + n % 128 < 128)), ih (n / 128) rest hdiv] + simp only [] + rw [ite_eq_right (by omega : ¬ (n / 128 = 0))] + have key : 128 + n % 128 - 128 + 128 * (n / 128) = n := by omega + rw [key] + +/-- Reading a printed variable byte integer gives the number + back: any number below 2^28, the most four bytes carry. -/ +theorem decVBI_printVBI (n : Nat) (rest : List UInt8) (hn : n < 268435456) : + decVBI (printVBI n ++ rest) = some (n, rest) := + decVBIGo_printVBI 3 n rest (by + have e : (128 : Nat) ^ (3 + 1) = 268435456 := by decide + rw [e]; exact hn) + +/-- A byte read as a number and written back is the same + byte. -/ +theorem byte_eq_toUInt8 (b : UInt8) : b.toNat.toUInt8 = b := UInt8.ofNat_toNat + +/-- What the counting reader accepts is a printed writing: with + `k` bytes to spend, an accepted value fits in `k` groups, + and the bytes it read are exactly the printer's writing of + that value, with the returned bytes after them. Induction + on `k`: one byte below 128 is the writing of its value; a + continuation byte in front of the writing of a nonzero rest + is the writing of the whole value. -/ +theorem decVBIGo_canonical : ∀ (k : Nat) (bs : List UInt8) (n : Nat) (r : List UInt8), + decVBIGo k bs = some (n, r) → n < 128 ^ k ∧ bs = printVBI n ++ r := by + intro k + induction k with + | zero => + intro bs n r h + rw [decVBIGo] at h + exact absurd h (by simp) + | succ k ih => + intro bs n r h + cases bs with + | nil => + rw [decVBIGo] at h + exact absurd h (by simp) + | cons b bs => + have hb256 : b.toNat < 256 := UInt8.toNat_lt b + have hpow : 1 ≤ 128 ^ k := Nat.pow_pos (by decide) + rw [decVBIGo] at h + by_cases hb : b.toNat < 128 + · rw [ite_eq_left hb] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hn, hr⟩ := h + subst hn + subst hr + refine ⟨?_, ?_⟩ + · rw [Nat.pow_succ]; omega + · rw [printVBI_def, ite_eq_left hb, byte_eq_toUInt8] + rfl + · rw [ite_eq_right hb] at h + cases hk : decVBIGo k bs with + | none => + rw [hk] at h + exact absurd h (by simp) + | some vr => + obtain ⟨v, r'⟩ := vr + rw [hk] at h + simp only [] at h + by_cases hv : v = 0 + · rw [ite_eq_left hv] at h + exact absurd h (by simp) + · rw [ite_eq_right hv] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hn, hr⟩ := h + subst hn + subst hr + obtain ⟨hvb, hbs⟩ := ih bs v r' hk + refine ⟨?_, ?_⟩ + · rw [Nat.pow_succ] + have : 128 * v ≤ 128 * (128 ^ k - 1) := Nat.mul_le_mul_left _ (by omega) + have e2 : 128 * (128 ^ k - 1) = 128 ^ k * 128 - 128 := by + rw [Nat.mul_sub, Nat.mul_comm] + omega + · rw [hbs, printVBI_def (b.toNat - 128 + 128 * v), + ite_eq_right (by omega : ¬ (b.toNat - 128 + 128 * v < 128))] + have e1 : (b.toNat - 128 + 128 * v) % 128 = b.toNat - 128 := by omega + have e2 : (b.toNat - 128 + 128 * v) / 128 = v := by omega + rw [e1, e2, show 128 + (b.toNat - 128) = b.toNat by omega, byte_eq_toUInt8] + rfl + +/-- What the variable byte integer reader accepts is the + printer's writing of the value it returns, the shortest + one, with the returned bytes after it; and the value is + below 2^28. So no longer writing of a value is accepted. -/ +theorem decVBI_canonical (bs : List UInt8) (n : Nat) (r : List UInt8) + (h : decVBI bs = some (n, r)) : n < 268435456 ∧ bs = printVBI n ++ r := by + have e : (128 : Nat) ^ 4 = 268435456 := by decide + rw [← e] + exact decVBIGo_canonical 4 bs n r h + +/-- The four byte cap: a variable byte integer whose first four + bytes all carry a continuation mark is refused, whatever + follows. The value would need a fifth byte, and the + standard allows four (section 1.5.5). A reader with a + higher cap, or none, fails this statement on + `[128, 128, 128, 128, 1]`. -/ +theorem decVBI_four_byte_cap (b0 b1 b2 b3 : UInt8) (rest : List UInt8) + (h0 : 128 ≤ b0.toNat) (h1 : 128 ≤ b1.toNat) (h2 : 128 ≤ b2.toNat) + (h3 : 128 ≤ b3.toNat) : + decVBI (b0 :: b1 :: b2 :: b3 :: rest) = none := by + unfold decVBI + rw [decVBIGo, ite_eq_right (by omega), decVBIGo, ite_eq_right (by omega), + decVBIGo, ite_eq_right (by omega), decVBIGo, ite_eq_right (by omega), decVBIGo] + +/-- The four byte cap on the remaining length: a packet whose + remaining length has a continuation mark on each of its + first four bytes is refused, by the stream reader and by + the whole input reader, whatever the header byte and + whatever follows. -/ +theorem parsePacket_four_byte_cap (h b0 b1 b2 b3 : UInt8) (rest : List UInt8) + (h0 : 128 ≤ b0.toNat) (h1 : 128 ≤ b1.toNat) (h2 : 128 ≤ b2.toNat) + (h3 : 128 ≤ b3.toNat) : + parsePacket (h :: b0 :: b1 :: b2 :: b3 :: rest) = none + ∧ parse (h :: b0 :: b1 :: b2 :: b3 :: rest) = none := by + have e : parsePacket (h :: b0 :: b1 :: b2 :: b3 :: rest) = none := by + show (decVBI (b0 :: b1 :: b2 :: b3 :: rest)).bind _ = none + rw [decVBI_four_byte_cap b0 b1 b2 b3 rest h0 h1 h2 h3] + rfl + refine ⟨e, ?_⟩ + unfold parse + rw [e] + +/-- What the byte cut takes is exactly `n` bytes from the front, + and the returned bytes are the ones after them. -/ +theorem readBytes_inv (n : Nat) (bs seg r : List UInt8) + (h : readBytes n bs = some (seg, r)) : seg.length = n ∧ bs = seg ++ r := by + unfold readBytes at h + by_cases hl : bs.length ≥ n + · rw [ite_eq_left hl] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨h1, h2⟩ := h + subst h1 + subst h2 + refine ⟨?_, (List.take_append_drop n bs).symm⟩ + rw [List.length_take] + omega + · rw [ite_eq_right hl] at h + exact absurd h (by simp) + +/-- The frame of an accepted packet: every packet the stream + reader takes is a header byte, the shortest writing of the + body's length, and that many body bytes, all standing in + the input; the bytes it returns are exactly the ones after + them. So the reader never takes a byte the input does not + hold, and refuses a remaining length written in more bytes + than it needs. -/ +theorem parsePacket_frame (bs : List UInt8) (p : Packet) (r : List UInt8) + (h : parsePacket bs = some (p, r)) : + ∃ (b : UInt8) (body : List UInt8), body.length < 268435456 + ∧ bs = b :: (printVBI body.length ++ body) ++ r := by + cases bs with + | nil => exact absurd h (by simp [parsePacket]) + | cons b r0 => + cases hd : decVBI r0 with + | none => + have : parsePacket (b :: r0) = none := by + show (decVBI r0).bind _ = none + rw [hd]; rfl + rw [this] at h + exact absurd h (by simp) + | some lr => + obtain ⟨len, r1⟩ := lr + obtain ⟨hlen, hr0⟩ := decVBI_canonical r0 len r1 hd + cases hb : readBytes len r1 with + | none => + have : parsePacket (b :: r0) = none := by + show (decVBI r0).bind _ = none + rw [hd] + show (readBytes len r1).bind _ = none + rw [hb]; rfl + rw [this] at h + exact absurd h (by simp) + | some sr => + obtain ⟨seg, r2⟩ := sr + obtain ⟨hsl, hr1⟩ := readBytes_inv len r1 seg r2 hb + have hr : r2 = r := by + have e : parsePacket (b :: r0) + = (parseBody (b.toNat / 16) (b.toNat % 16) seg).bind + (fun q => some (q, r2)) := by + show (decVBI r0).bind _ = _ + rw [hd] + show (readBytes len r1).bind _ = _ + rw [hb] + rfl + rw [e] at h + cases hp : parseBody (b.toNat / 16) (b.toNat % 16) seg with + | none => rw [hp] at h; exact absurd h (by simp) + | some q => + rw [hp] at h + simp only [Option.bind_some, Option.some.injEq, Prod.mk.injEq] at h + exact h.2 + subst hr + refine ⟨b, seg, by omega, ?_⟩ + rw [hr0, hr1, hsl] + simp + +/-! ## Step lemmas + + The readers written with `do` notation are unfolded one step + at a time through these equations, each proved by `rfl`, so + the proofs below can rewrite one field at a time. -/ + +/-- One step of the string reader, stated for rewriting. -/ +theorem readStr_step (bs : List UInt8) : + readStr bs = (readNat 2 bs).bind fun (len, r1) => + (readBytes len r1).bind fun (chunk, r2) => + ((Utf8.decode chunk).bind checkChars).bind fun s => some (s, r2) := rfl + +/-- One step of the binary reader, stated for rewriting. -/ +theorem readBin_step (bs : List UInt8) : + readBin bs = (readNat 2 bs).bind fun (len, r1) => readBytes len r1 := rfl + +/-- One step of the string pair value reader, stated for + rewriting. -/ +theorem readPropVal_pair_step (bs : List UInt8) : + readPropVal .utf8Pair bs = (readStr bs).bind fun (k, r1) => + (readStr r1).bind fun (v, r2) => some (.utf8Pair k v, r2) := rfl + +/-- One step of the property reader, stated for rewriting. -/ +theorem readEntry_step (s : PropSet) (seen : List Nat) (bs : List UInt8) : + readEntry s seen bs = (decVBI bs).bind fun (id, r1) => + if (allowedOf s).contains id && (repeatableIn s id || !seen.contains id) then + match propTypeOf id with + | none => none + | some t => (readPropVal t r1).bind fun (v, r2) => + if propValOK id v then some (⟨id, v⟩, r2) else none + else none := rfl + +/-- One step of the property block reader, stated for + rewriting. -/ +theorem readProps_step (s : PropSet) (bs : List UInt8) : + readProps s bs = (decVBI bs).bind fun (len, r1) => + (readBytes len r1).bind fun (seg, r2) => + (readEntries s seg).bind fun ps => some (ps, r2) := rfl + +/-! ## Strings and binary data -/ + +/-- The null character check passes on a well formed string. -/ +theorem hasNul_false {s : List Char} (h : '\u0000' ∉ s) : hasNul s = false := by + simp only [hasNul, List.any_eq_false] + intro c hc hcc + have hceq : c = '\u0000' := of_decide_eq_true hcc + subst hceq + exact h hc + +/-- The character check passes on a well formed string. -/ +theorem checkChars_of_wf {s : List Char} (h : StrWF s) : checkChars s = some s := by + simp [checkChars, hasNul_false h.1] + +/-- A printed string field reads back: the string, with the + bytes after the field left in place. -/ +theorem readStr_printStr (s : List Char) (rest : List UInt8) (h : StrWF s) : + readStr (printStr s ++ rest) = some (s, rest) := by + have hlen : (Utf8.encode s).length < 256 ^ 2 := by + have h2 := h.2 + have e : (256 : Nat) ^ 2 = 65536 := by decide + rw [e] + omega + rw [readStr_step, printStr, List.append_assoc, readNat_writeBE 2 _ _ hlen] + simp only [Option.bind_some] + rw [readBytes_append _ _ _ rfl] + simp only [Option.bind_some] + rw [Mqtt.Utf8.Proofs.decode_encode] + simp only [Option.bind_some] + rw [checkChars_of_wf h] + simp only [Option.bind_some] + +/-- A printed binary field reads back: the bytes, with the + bytes after the field left in place. -/ +theorem readBin_printBin (bs : List UInt8) (rest : List UInt8) (h : BinWF bs) : + readBin (printBin bs ++ rest) = some (bs, rest) := by + have hlen : bs.length < 256 ^ 2 := by + have h2 : bs.length ≤ 65535 := h + have e : (256 : Nat) ^ 2 = 65536 := by decide + rw [e] + omega + rw [readBin_step, printBin, List.append_assoc, readNat_writeBE 2 _ _ hlen] + simp only [Option.bind_some] + rw [readBytes_append _ _ _ rfl] + +/-! ## Properties -/ + +/-- An identifier with a table entry is below 2^28. -/ +theorem propTypeOf_id_lt {id : Nat} {t : PropType} + (h : propTypeOf id = some t) : id < 268435456 := by + unfold propTypeOf at h + split at h <;> simp_all <;> omega + +/-- A printed property value reads back, at the type the table + gives it. -/ +theorem readPropVal_printPropVal (v : PropVal) (rest : List UInt8) (h : ValWF v) : + readPropVal (valType v) (printPropVal v ++ rest) = some (v, rest) := by + cases v with + | byte n => + have hn : n < 256 := h + simp only [valType, printPropVal, readPropVal] + rw [List.cons_append, List.nil_append, readNat_succ_cons, + show readNat 0 rest = some (0, rest) from rfl, Option.map_some, + Option.map_some, toNat_toUInt8 hn] + simp + | twoByte n => + simp only [valType, printPropVal, readPropVal] + rw [readNat_writeBE 2 n rest (by + have e : (256 : Nat) ^ 2 = 65536 := by decide + rw [e]; exact h)] + rfl + | fourByte n => + simp only [valType, printPropVal, readPropVal] + rw [readNat_writeBE 4 n rest (by + have e : (256 : Nat) ^ 4 = 4294967296 := by decide + rw [e]; exact h)] + rfl + | varByte n => + simp only [valType, printPropVal, readPropVal] + rw [decVBI_printVBI n rest h] + rfl + | utf8 s => + simp only [valType, printPropVal, readPropVal] + rw [readStr_printStr s rest h] + rfl + | utf8Pair k v => + obtain ⟨hk, hv⟩ := h + show readPropVal .utf8Pair ((printStr k ++ printStr v) ++ rest) + = some (.utf8Pair k v, rest) + rw [readPropVal_pair_step, List.append_assoc, readStr_printStr k _ hk] + simp only [Option.bind_some] + rw [readStr_printStr v rest hv] + simp only [Option.bind_some] + | binary bs => + simp only [valType, printPropVal, readPropVal] + rw [readBin_printBin bs rest h] + rfl + +/-- A printed property reads back, when the property stands in + the block it is read for: its identifier is allowed there, + its value matches the table's type, the value is well + formed, and the block's repeat rule is respected. -/ +theorem readEntry_printProperty (s : PropSet) (seen : List Nat) (p : Property) + (rest : List UInt8) + (hid : p.id ∈ allowedOf s) (hty : propTypeOf p.id = some (valType p.val)) + (hval : ValWF p.val) (hok : propValOK p.id p.val = true) + (hrep : repeatableIn s p.id = true ∨ p.id ∉ seen) : + readEntry s seen (printProperty p ++ rest) = some (p, rest) := by + have hc : (allowedOf s).contains p.id = true := List.contains_iff_mem.mpr hid + have hr : (repeatableIn s p.id || !seen.contains p.id) = true := by + cases hrep with + | inl h => rw [h]; rfl + | inr h => + have h2 : seen.contains p.id = false := by + cases hseen : seen.contains p.id with + | false => rfl + | true => exact absurd (List.contains_iff_mem.mp hseen) h + rw [h2] + cases repeatableIn s p.id <;> rfl + rw [readEntry_step, printProperty, List.append_assoc, + decVBI_printVBI p.id _ (propTypeOf_id_lt hty)] + simp only [Option.bind_some] + rw [ite_eq_left (by rw [hc, hr]; rfl), hty] + simp only [] + rw [readPropVal_printPropVal p.val rest hval] + simp only [Option.bind_some] + rw [ite_eq_left hok] + +/-- A printed property list reads back whole, when the list is + well formed for its block: the reader spends one fuel per + property and each property takes at least a byte, so the + list's own length is fuel enough. -/ +theorem readEntriesGo_printPropsList : ∀ (fuel : Nat) (s : PropSet) + (seen : List Nat) (ps : List Property), + ps.length ≤ fuel → PropsWF s seen ps → + readEntriesGo fuel s seen (printPropsList ps) = some (ps, []) := by + intro fuel + induction fuel with + | zero => + intro s seen ps hlen _ + have hps : ps = [] := by + cases ps with + | nil => rfl + | cons p ps' => simp at hlen + rw [hps] + rfl + | succ fuel ih => + intro s seen ps hlen hwf + cases ps with + | nil => rfl + | cons p ps' => + have hne : ¬ (printProperty p ++ printPropsList ps').isEmpty := by + have h1 : 0 < (printVBI p.id).length := printVBI_pos p.id + intro hcon + rw [List.isEmpty_iff] at hcon + have h3 : printProperty p = [] := (List.append_eq_nil_iff.mp hcon).1 + rw [printProperty] at h3 + have h4 : printVBI p.id = [] := (List.append_eq_nil_iff.mp h3).1 + rw [h4] at h1 + exact absurd h1 (by decide) + obtain ⟨hid, hty, hval, hok, hrep, htail⟩ := hwf + rw [List.length_cons] at hlen + show readEntriesGo (fuel + 1) s seen (printPropsList (p :: ps')) = _ + rw [printPropsList, readEntriesGo, ite_eq_right hne, + readEntry_printProperty s seen p (printPropsList ps') hid hty hval hok hrep] + simp only [] + rw [ih s (p.id :: seen) ps' (by omega) htail] + +/-- A property list is never longer than its printing: each + property takes at least the byte of its identifier. -/ +theorem propsList_length_le (ps : List Property) : + ps.length ≤ (printPropsList ps).length := by + induction ps with + | nil => simp [printPropsList] + | cons p ps' ih => + have h1 : 0 < (printVBI p.id).length := printVBI_pos p.id + simp only [printPropsList, printProperty, List.length_cons, + List.length_append] + omega + +/-- A whole printed property block's insides read back. -/ +theorem readEntries_printPropsList (s : PropSet) (ps : List Property) + (h : PropsWF s [] ps) (hauth : authOK ps = true) : + readEntries s (printPropsList ps) = some ps := by + unfold readEntries + rw [readEntriesGo_printPropsList (printPropsList ps).length s [] ps + (propsList_length_le ps) h] + simp only [] + rw [ite_eq_left hauth] + +/-- A printed property block reads back: the properties, with + the bytes after the block left in place. -/ +theorem readProps_printProps (s : PropSet) (ps : List Property) + (rest : List UInt8) (h : PropsBlockWF s ps) : + readProps s (printProps ps ++ rest) = some (ps, rest) := by + obtain ⟨hwf, hlen, hauth⟩ := h + rw [readProps_step, printProps, List.append_assoc, decVBI_printVBI _ _ hlen] + simp only [Option.bind_some] + rw [readBytes_append _ _ _ rfl] + simp only [Option.bind_some] + rw [readEntries_printPropsList s ps hwf hauth] + simp only [Option.bind_some] + +/-! ## Topic names and flag bits -/ + +/-- An `any` test for one character fails when the character + does not stand in the text. -/ +theorem any_eq_false_of_not_mem {s : List Char} {c : Char} (h : c ∉ s) : + s.any (fun x => decide (x = c)) = false := by + simp only [List.any_eq_false] + intro x hx hxc + have hxcq : x = c := of_decide_eq_true hxc + subst hxcq + exact h hx + +/-- The topic name check passes on a well formed topic name. -/ +theorem checkTopic_of_wf {s : List Char} (h : TopicWF s) : checkTopic s = some s := by + obtain ⟨hstr, hne, hp, hh⟩ := h + have e1 : s.isEmpty = false := by + cases s with + | nil => exact absurd rfl hne + | cons a t => rfl + have e2 : s.any (fun c => decide (c = '+')) = false := + any_eq_false_of_not_mem hp + have e3 : s.any (fun c => decide (c = '#')) = false := + any_eq_false_of_not_mem hh + unfold checkTopic + rw [e1, e2, e3] + exact ite_eq_right (by decide) + +/-- The wildcard check passes on a PUBLISH topic name fit to + print. -/ +theorem checkNoWildcards_of_wf {s : List Char} (hp : '+' ∉ s) (hh : '#' ∉ s) : + checkNoWildcards s = some s := by + unfold checkNoWildcards + rw [any_eq_false_of_not_mem hp, any_eq_false_of_not_mem hh] + exact ite_eq_right (by decide) + +/-- The empty topic check passes on a PUBLISH topic name fit to + print: an empty topic comes with a Topic Alias. -/ +theorem pubTopic_alias_ok {s : List Char} {props : List Property} + (h : s = [] → hasTopicAlias props = true) : + ¬ ((s.isEmpty && !hasTopicAlias props) = true) := by + cases s with + | nil => rw [h rfl]; decide + | cons c t => simp + +/-- An `if` on a boolean, in the flags builders' shape, is the + bit as a number times the place value. -/ +theorem if_bool_mul (b : Bool) (x : Nat) : + (if b then x else 0) = (if b then 1 else 0) * x := by + cases b <;> simp + +/-- The bits of a number built as `q + a * 4 + b * 8 + rh * 16`, + with `a` and `b` bits and `q` and `rh` at most 2: the fields + an options byte carries. Pure arithmetic. -/ +theorem optsByte_fields (q rh a b : Nat) (hq : q ≤ 2) (hr : rh ≤ 2) + (ha : a ≤ 1) (hb : b ≤ 1) : + readOptsByte (q + a * 4 + b * 8 + rh * 16) = some ⟨q, a = 1, b = 1, rh⟩ := by + unfold readOptsByte + rw [ite_eq_left ⟨by omega, by omega, by omega⟩] + simp only [Option.some.injEq, SubOpts.mk.injEq] + refine ⟨by omega, ?_, ?_, by omega⟩ + · rw [show (q + a * 4 + b * 8 + rh * 16) / 4 % 2 = a by omega] + · rw [show (q + a * 4 + b * 8 + rh * 16) / 8 % 2 = b by omega] + +/-- A printed options byte reads back as the options. -/ +theorem readOptsByte_printOptsByte (o : SubOpts) (h : OptsWF o) : + readOptsByte (printOptsByte o).toNat = some o := by + obtain ⟨q, nl, rap, rh⟩ := o + have hq : q ≤ 2 := h.1 + have hr : rh ≤ 2 := h.2 + have ha : (if nl then (1 : Nat) else 0) ≤ 1 := by cases nl <;> decide + have hb : (if rap then (1 : Nat) else 0) ≤ 1 := by cases rap <;> decide + have hbound : q + (if nl then 1 else 0) * 4 + (if rap then 1 else 0) * 8 + + rh * 16 < 256 := by omega + have hsum : (printOptsByte ⟨q, nl, rap, rh⟩).toNat + = q + (if nl then 1 else 0) * 4 + (if rap then 1 else 0) * 8 + rh * 16 := by + show ((q + (if nl then 4 else 0) + (if rap then 8 else 0) + rh * 16).toUInt8).toNat = _ + rw [if_bool_mul nl 4, if_bool_mul rap 8, toNat_toUInt8 hbound] + rw [hsum, optsByte_fields q rh _ _ hq hr ha hb] + cases nl <;> cases rap <;> rfl + +/-! ## SUBSCRIBE filters -/ + +/-- A printed filter list is at least as long as the list: each + filter takes at least the byte of its options. -/ +theorem printFilters_length_ge : ∀ (fs : List (List Char × SubOpts)), + fs.length ≤ (printFilters fs).length := by + intro fs + induction fs with + | nil => simp [printFilters] + | cons f fs' ih => + have h1 : 0 < (printFilter f).length := by + simp only [printFilter, List.length_append, List.length_cons, + List.length_nil] + omega + simp only [printFilters, List.length_cons, List.length_append] + omega + +/-- A printed filter list reads back whole, when its members + are well formed: the reader spends one fuel per filter and + each filter takes at least a byte, so the list's own length + is fuel enough. -/ +theorem readFiltersGo_printFilters : ∀ (fuel : Nat) + (fs : List (List Char × SubOpts)), + fs.length ≤ fuel → FiltersWF fs → + readFiltersGo fuel (printFilters fs) = some (fs, []) := by + intro fuel + induction fuel with + | zero => + intro fs hlen _ + have hfs : fs = [] := by + cases fs with + | nil => rfl + | cons f fs' => simp at hlen + rw [hfs] + rfl + | succ fuel ih => + intro fs hlen hwf + cases fs with + | nil => rfl + | cons fr fs' => + obtain ⟨f, o⟩ := fr + obtain ⟨hf, ho, hok, htail⟩ := hwf + have hne : ¬ (printFilter (f, o) ++ printFilters fs').isEmpty := by + have h1 : 0 < (printFilter (f, o)).length := by + simp only [printFilter, List.length_append, List.length_cons, + List.length_nil] + omega + intro hcon + rw [List.isEmpty_iff] at hcon + have h3 : printFilter (f, o) = [] := (List.append_eq_nil_iff.mp hcon).1 + rw [h3] at h1 + exact absurd h1 (by decide) + rw [List.length_cons] at hlen + show readFiltersGo (fuel + 1) (printFilters ((f, o) :: fs')) = _ + rw [printFilters, readFiltersGo, ite_eq_right hne, printFilter, + List.append_assoc, readStr_printStr f _ hf] + rw [List.cons_append, List.nil_append] + simp only [] + rw [readOptsByte_printOptsByte o ho] + simp only [] + rw [ite_eq_left hok, ih fs' (by omega) htail] + +/-! ## Packet bodies -/ + +/-- One step of the single byte reader, stated for rewriting. -/ +theorem readByte_cons (b : UInt8) (bs : List UInt8) : + readByte (b :: bs) = some (b.toNat, bs) := rfl + +/-- The bits of a PUBLISH flags nibble built from a packet's + fields: the QoS sits at bits 2 and 1, DUP at bit 3, RETAIN + at bit 0. -/ +theorem publish_bits (dup retain : Bool) (qos : Nat) (hq : qos ≤ 2) : + ((if dup then 8 else 0) + qos * 2 + (if retain then 1 else 0)) / 2 % 4 = qos + ∧ flagBit ((if dup then 8 else 0) + qos * 2 + (if retain then 1 else 0)) 3 = dup + ∧ flagBit ((if dup then 8 else 0) + qos * 2 + (if retain then 1 else 0)) 0 + = retain := by + have e1 : (if dup then (8 : Nat) else 0) = (if dup then 1 else 0) * 8 := + if_bool_mul dup 8 + have e2 : (if retain then (1 : Nat) else 0) = (if retain then 1 else 0) * 1 := + if_bool_mul retain 1 + have ha : (if dup then (1 : Nat) else 0) ≤ 1 := by cases dup <;> decide + have hb : (if retain then (1 : Nat) else 0) ≤ 1 := by cases retain <;> decide + rw [e1, e2] + refine ⟨by omega, ?_, ?_⟩ + · unfold flagBit + rw [show (2 : Nat) ^ 3 = 8 by decide, + show ((if dup then 1 else 0) * 8 + qos * 2 + (if retain then 1 else 0) * 1) + / 8 % 2 = (if dup then 1 else 0) by omega] + cases dup <;> rfl + · unfold flagBit + rw [show (2 : Nat) ^ 0 = 1 by decide, + show ((if dup then 1 else 0) * 8 + qos * 2 + (if retain then 1 else 0) * 1) + / 1 % 2 = (if retain then 1 else 0) by omega] + cases retain <;> rfl + +/-- The properties reader on exactly the printed bytes. -/ +theorem readProps_printProps_exact (s : PropSet) (ps : List Property) + (h : PropsBlockWF s ps) : readProps s (printProps ps) = some (ps, []) := by + have h2 := readProps_printProps s ps [] h + rwa [List.append_nil] at h2 + +/-- The SUBSCRIBE body reader as one bind chain; the form the + round trip proof rewrites through. -/ +theorem readSubscribeBody_step (seg : List UInt8) : + readSubscribeBody seg = + (readNat 2 seg).bind fun (id, r1) => + if id ≠ 0 then + (readProps .subscribe r1).bind fun (props, r2) => + (readFiltersGo r2.length r2).bind fun (fs, r3) => + if r3.isEmpty && !fs.isEmpty then some (.subscribe id props fs) + else none + else none := rfl + +/-- A printed SUBSCRIBE body reads back as the packet. -/ +theorem readSubscribeBody_printSubscribeBody (id : Nat) (ps : List Property) + (fs : List (List Char × SubOpts)) (hid : 1 ≤ id ∧ id < 65536) + (hps : PropsBlockWF .subscribe ps) (hfs : fs ≠ [] ∧ FiltersWF fs) : + readSubscribeBody (printSubscribeBody id ps fs) = some (.subscribe id ps fs) := by + rw [readSubscribeBody_step, + show printSubscribeBody id ps fs + = writeBE 2 id ++ (printProps ps ++ printFilters fs) from rfl, + readNat_writeBE 2 id _ (by omega)] + simp only [Option.bind_some] + rw [ite_eq_left (by omega : id ≠ 0), readProps_printProps .subscribe ps _ hps] + simp only [Option.bind_some] + rw [readFiltersGo_printFilters (printFilters fs).length fs + (printFilters_length_ge fs) hfs.2] + simp only [Option.bind_some] + have h2 : fs.isEmpty = false := by + cases fs with + | nil => exact absurd rfl hfs.1 + | cons a t => rfl + rw [ite_eq_left (by rw [h2]; rfl : ([].isEmpty && !fs.isEmpty) = true)] + +/-- Reason codes written as bytes read back as themselves. -/ +theorem map_toUInt8_toNat (rs : List Nat) (h : ∀ r ∈ rs, r < 256) : + (rs.map Nat.toUInt8).map UInt8.toNat = rs := by + induction rs with + | nil => rfl + | cons r rs' ih => + simp only [List.map_cons] + rw [toNat_toUInt8 (h r (by simp)), ih (fun x hx => h x (by simp [hx]))] + +/-- The SUBACK body reader as one bind chain. -/ +theorem readSubackBody_step (seg : List UInt8) : + readSubackBody seg = + (readNat 2 seg).bind fun (id, r1) => + if id ≠ 0 then + (readProps .suback r1).bind fun (props, r2) => + if !r2.isEmpty then some (.suback id props (r2.map UInt8.toNat)) + else none + else none := rfl + +/-- A printed SUBACK body reads back as the packet. -/ +theorem readSubackBody_printSubackBody (id : Nat) (ps : List Property) + (rs : List Nat) (hid : 1 ≤ id ∧ id < 65536) + (hps : PropsBlockWF .suback ps) (hrs : rs ≠ [] ∧ ∀ r ∈ rs, r < 256) : + readSubackBody (printSubackBody id ps rs) = some (.suback id ps rs) := by + rw [readSubackBody_step, + show printSubackBody id ps rs + = writeBE 2 id ++ (printProps ps ++ rs.map Nat.toUInt8) from rfl, + readNat_writeBE 2 id _ (by omega)] + simp only [Option.bind_some] + rw [ite_eq_left (by omega : id ≠ 0), readProps_printProps .suback ps _ hps] + simp only [Option.bind_some] + have h2 : (rs.map Nat.toUInt8).isEmpty = false := by + cases rs with + | nil => exact absurd rfl hrs.1 + | cons a t => rfl + rw [ite_eq_left (by rw [h2]; rfl : (!(rs.map Nat.toUInt8).isEmpty) = true), + map_toUInt8_toNat rs hrs.2] + +/-- A printed DISCONNECT body reads back as the packet, in each + of its three forms. -/ +theorem readDisconnectBody_print (x : Option (Nat × Option (List Property))) + (h : match x with + | none => True + | some (rc, none) => rc < 256 + | some (rc, some ps) => rc < 256 ∧ PropsBlockWF PropSet.disconnect ps) : + readDisconnectBody (bodyOf (Packet.disconnect x)) + = some (Packet.disconnect x) := by + cases x with + | none => rfl + | some rp => + obtain ⟨rc, ops⟩ := rp + cases ops with + | none => + have hrc : rc < 256 := h + show readDisconnectBody [rc.toUInt8] + = some (Packet.disconnect (some (rc, none))) + show (if ([] : List UInt8).isEmpty + then some (Packet.disconnect (some ((rc.toUInt8).toNat, none))) + else (readProps PropSet.disconnect []).bind + fun (props, r2) => + if r2.isEmpty + then some (Packet.disconnect (some ((rc.toUInt8).toNat, some props))) + else none) = some (Packet.disconnect (some (rc, none))) + rw [ite_eq_left (by decide : List.isEmpty ([] : List UInt8) = true), + toNat_toUInt8 hrc] + | some ps => + obtain ⟨hrc, hps⟩ := h + show readDisconnectBody ([rc.toUInt8] ++ printProps ps) + = some (Packet.disconnect (some (rc, some ps))) + rw [show [rc.toUInt8] ++ printProps ps = rc.toUInt8 :: printProps ps from rfl] + have hpos : 0 < (printProps ps).length := by + show 0 < (printVBI (printPropsList ps).length + ++ printPropsList ps).length + rw [List.length_append] + have h1 := printVBI_pos (printPropsList ps).length + omega + have hne : ¬ ((printProps ps).isEmpty = true) := by + intro hcon + rw [List.isEmpty_iff] at hcon + have hz : (printProps ps).length = 0 := congrArg List.length hcon + omega + show (if (printProps ps).isEmpty + then some (Packet.disconnect (some ((rc.toUInt8).toNat, none))) + else (readProps PropSet.disconnect (printProps ps)).bind + fun (props, r2) => + if r2.isEmpty + then some (Packet.disconnect (some ((rc.toUInt8).toNat, some props))) + else none) = some (Packet.disconnect (some (rc, some ps))) + rw [ite_eq_right hne] + simp only [readProps_printProps_exact PropSet.disconnect ps hps, + Option.bind_some] + rw [ite_eq_left (by decide : List.isEmpty ([] : List UInt8) = true), + toNat_toUInt8 hrc] + +/-- The facts about a well formed connect flags byte: it + fits in a byte, the reserved bit is clear, and every field + the reader recovers from the byte (the will QoS, the will + retain, the will flag, the username and password flags, + the clean start) is the field that was written. -/ +theorem connectFlags_facts (c : Connect) (h : ConnectWF c) : + (connectFlags c).toUInt8.toNat = connectFlags c + ∧ connectFlags c % 2 = 0 + ∧ (connectFlags c / 8) % 4 + = (match c.will with | some w => w.qos | none => 0) + ∧ flagBit (connectFlags c) 7 = c.username.isSome + ∧ flagBit (connectFlags c) 6 = c.password.isSome + ∧ flagBit (connectFlags c) 5 + = (match c.will with | some w => w.retain | none => false) + ∧ flagBit (connectFlags c) 2 = c.will.isSome + ∧ flagBit (connectFlags c) 1 = c.cleanStart + ∧ (c.will = none → (connectFlags c / 8) % 8 = 0) := by + have e1 : (if c.username.isSome then (128 : Nat) else 0) + = (if c.username.isSome then 1 else 0) * 128 := if_bool_mul _ _ + have e2 : (if c.password.isSome then (64 : Nat) else 0) + = (if c.password.isSome then 1 else 0) * 64 := if_bool_mul _ _ + have e3 : (if c.cleanStart then (2 : Nat) else 0) + = (if c.cleanStart then 1 else 0) * 2 := if_bool_mul _ _ + have hub : (if c.username.isSome then (1 : Nat) else 0) ≤ 1 := by + cases h : c.username.isSome <;> decide + have hpb : (if c.password.isSome then (1 : Nat) else 0) ≤ 1 := by + cases h : c.password.isSome <;> decide + have hcs : (if c.cleanStart then (1 : Nat) else 0) ≤ 1 := by + cases h : c.cleanStart <;> decide + cases hw : c.will with + | none => + have hf : connectFlags c + = (if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + (if c.cleanStart then 1 else 0) * 2 := by + unfold connectFlags + rw [e1, e2, e3, hw] + dsimp only + omega + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [hf] + exact toNat_toUInt8 (by omega) + · rw [hf]; omega + · show (connectFlags c / 8) % 4 = 0 + rw [hf]; omega + · rw [hf] + unfold flagBit + rw [show (2 : Nat) ^ 7 = 128 by decide, + show ((if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + (if c.cleanStart then 1 else 0) * 2) / 128 % 2 + = (if c.username.isSome then 1 else 0) by omega] + cases h : c.username.isSome <;> rfl + · rw [hf] + unfold flagBit + rw [show (2 : Nat) ^ 6 = 64 by decide, + show ((if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + (if c.cleanStart then 1 else 0) * 2) / 64 % 2 + = (if c.password.isSome then 1 else 0) by omega] + cases h : c.password.isSome <;> rfl + · show flagBit (connectFlags c) 5 = false + rw [hf] + unfold flagBit + rw [show (2 : Nat) ^ 5 = 32 by decide, + show ((if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + (if c.cleanStart then 1 else 0) * 2) / 32 % 2 = 0 by omega] + rfl + · show flagBit (connectFlags c) 2 = false + rw [hf] + unfold flagBit + rw [show (2 : Nat) ^ 2 = 4 by decide, + show ((if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + (if c.cleanStart then 1 else 0) * 2) / 4 % 2 = 0 by omega] + rfl + · rw [hf] + unfold flagBit + rw [show (2 : Nat) ^ 1 = 2 by decide, + show ((if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + (if c.cleanStart then 1 else 0) * 2) / 2 % 2 + = (if c.cleanStart then 1 else 0) by omega] + cases h : c.cleanStart <;> rfl + · intro _ + rw [hf]; omega + | some w => + have hwf : WillWF w := h.2.2.2.1 w hw + have hwq : w.qos ≤ 2 := hwf.1 + have hrb : (if w.retain then (1 : Nat) else 0) ≤ 1 := by + cases w.retain <;> decide + have e4 : (if w.retain then (32 : Nat) else 0) + = (if w.retain then 1 else 0) * 32 := if_bool_mul _ _ + have hf : connectFlags c + = (if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + ((if w.retain then 1 else 0) * 32 + w.qos * 8 + 4) + + (if c.cleanStart then 1 else 0) * 2 := by + unfold connectFlags + rw [e1, e2, e3, hw] + dsimp only + rw [e4] + refine ⟨?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_, ?_⟩ + · rw [hf] + exact toNat_toUInt8 (by omega) + · rw [hf]; omega + · show (connectFlags c / 8) % 4 = w.qos + rw [hf]; omega + · rw [hf] + unfold flagBit + rw [show (2 : Nat) ^ 7 = 128 by decide, + show ((if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + ((if w.retain then 1 else 0) * 32 + w.qos * 8 + 4) + + (if c.cleanStart then 1 else 0) * 2) / 128 % 2 + = (if c.username.isSome then 1 else 0) by omega] + cases h : c.username.isSome <;> rfl + · rw [hf] + unfold flagBit + rw [show (2 : Nat) ^ 6 = 64 by decide, + show ((if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + ((if w.retain then 1 else 0) * 32 + w.qos * 8 + 4) + + (if c.cleanStart then 1 else 0) * 2) / 64 % 2 + = (if c.password.isSome then 1 else 0) by omega] + cases h : c.password.isSome <;> rfl + · show flagBit (connectFlags c) 5 = w.retain + rw [hf] + unfold flagBit + rw [show (2 : Nat) ^ 5 = 32 by decide, + show ((if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + ((if w.retain then 1 else 0) * 32 + w.qos * 8 + 4) + + (if c.cleanStart then 1 else 0) * 2) / 32 % 2 + = (if w.retain then 1 else 0) by omega] + cases w.retain <;> rfl + · show flagBit (connectFlags c) 2 = true + rw [hf] + unfold flagBit + rw [show (2 : Nat) ^ 2 = 4 by decide, + show ((if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + ((if w.retain then 1 else 0) * 32 + w.qos * 8 + 4) + + (if c.cleanStart then 1 else 0) * 2) / 4 % 2 = 1 by omega] + rfl + · rw [hf] + unfold flagBit + rw [show (2 : Nat) ^ 1 = 2 by decide, + show ((if c.username.isSome then 1 else 0) * 128 + + (if c.password.isSome then 1 else 0) * 64 + + ((if w.retain then 1 else 0) * 32 + w.qos * 8 + 4) + + (if c.cleanStart then 1 else 0) * 2) / 2 % 2 + = (if c.cleanStart then 1 else 0) by omega] + cases h : c.cleanStart <;> rfl + · intro hn + cases hn + +/-- The CONNECT tail: the optional username and password + fields read back as themselves, and nothing is left + over, so the assembled packet is the one that was + printed. The three flag values are the reader's own + recoveries from the flags byte; the hypotheses tie them + to the fields. -/ +theorem readOptFields (u : Option (List Char)) (p : Option (List UInt8)) + (hu : ∀ s, u = some s → StrWF s) (hp : ∀ b, p = some b → BinWF b) + (cs : Bool) (ka : Nat) (props : List Property) (cid : List Char) + (will : Option Will) (f7 f6 f1 : Bool) + (h7 : f7 = u.isSome) (h6 : f6 = p.isSome) (h1 : f1 = cs) : + ((readOptStrField f7 (printOptStr u ++ printOptBin p)).bind + fun (u', r8) => + (readOptBinField f6 r8).bind fun (p', r9) => + (if r9.isEmpty + then some (⟨f1, ka, props, cid, will, u', p'⟩ : Connect) else none) + : Option Connect) + = some (⟨cs, ka, props, cid, will, u, p⟩ : Connect) := by + subst h7 + subst h6 + subst h1 + cases u with + | none => + rw [show printOptStr none = [] from rfl, List.nil_append] + unfold readOptStrField + rw [ite_eq_right (by decide : ¬ (Option.isSome none = true))] + simp only [Option.bind_some] + cases p with + | none => + rw [show printOptBin none = [] from rfl] + unfold readOptBinField + rw [ite_eq_right (by decide : ¬ (Option.isSome none = true))] + simp only [Option.bind_some] + rw [ite_eq_left (by decide : List.isEmpty [] = true)] + | some b => + rw [show printOptBin (some b) = printBin b from rfl] + unfold readOptBinField + rw [ite_eq_left (by rfl : Option.isSome (some b) = true), + ← List.append_nil (printBin b), readBin_printBin b [] (hp b rfl)] + simp only [Option.map_some, Option.bind_some] + rw [ite_eq_left (by decide : List.isEmpty [] = true)] + | some s => + rw [show printOptStr (some s) = printStr s from rfl] + unfold readOptStrField + rw [ite_eq_left (by rfl : Option.isSome (some s) = true), + readStr_printStr s _ (hu s rfl)] + simp only [Option.map_some, Option.bind_some] + cases p with + | none => + rw [show printOptBin none = [] from rfl] + unfold readOptBinField + rw [ite_eq_right (by decide : ¬ (Option.isSome none = true))] + simp only [Option.bind_some] + rw [ite_eq_left (by decide : List.isEmpty [] = true)] + | some b => + rw [show printOptBin (some b) = printBin b from rfl] + unfold readOptBinField + rw [ite_eq_left (by rfl : Option.isSome (some b) = true), + ← List.append_nil (printBin b), readBin_printBin b [] (hp b rfl)] + simp only [Option.map_some, Option.bind_some] + rw [ite_eq_left (by decide : List.isEmpty [] = true)] + +/-- A printed CONNECT body reads back as the packet. -/ +theorem readConnectBody_printConnectBody (c : Connect) (h : ConnectWF c) : + readConnectBody (printConnectBody c) = some c := by + obtain ⟨hka, hprops, hcid, hwill, huser, hpass⟩ := h + obtain ⟨hf1, hf2, hf3, hf4, hf5, hf6, hf7, hf8, hf9⟩ := connectFlags_facts c + ⟨hka, hprops, hcid, hwill, huser, hpass⟩ + have hfin : ∀ (w : Option Will), w = c.will → + (⟨c.cleanStart, c.keepAlive, c.props, c.clientId, w, c.username, + c.password⟩ : Connect) = c := by + intro w hw + subst hw + rfl + have hproto : StrWF ['M', 'Q', 'T', 'T'] := by + constructor + · decide + · decide + unfold readConnectBody + rw [show printConnectBody c + = printStr ['M', 'Q', 'T', 'T'] ++ ([5, (connectFlags c).toUInt8] + ++ (writeBE 2 c.keepAlive ++ (printProps c.props + ++ (printStr c.clientId ++ (printWillPart c.will + ++ (printOptStr c.username ++ printOptBin c.password)))))) + from rfl, + readStr_printStr _ _ hproto] + simp only [Option.bind_some] + rw [ite_eq_left trivial] + simp only [List.cons_append, List.nil_append] + rw [readByte_cons] + simp only [Option.bind_some] + rw [ite_eq_left (by decide : (5 : UInt8).toNat = 5), readByte_cons] + simp only [Option.bind_some] + rw [hf1, ite_eq_left hf2] + by_cases hwn : c.will = none + · have hf3' : (connectFlags c / 8) % 4 = 0 := by rw [hf3, hwn] + have hf7' : flagBit (connectFlags c) 2 = false := by simp [hf7, hwn] + rw [ite_eq_left (by rw [hf3']; omega : (connectFlags c / 8) % 4 ≠ 3), + ite_eq_left (by rw [hf9 hwn]; simp : + (flagBit (connectFlags c) 2 || decide ((connectFlags c / 8) % 8 = 0)) = true), + readNat_writeBE 2 c.keepAlive _ (by omega)] + simp only [Option.bind_some] + rw [readProps_printProps .connect c.props _ hprops] + simp only [Option.bind_some] + rw [readStr_printStr c.clientId _ hcid] + simp only [Option.bind_some] + rw [hwn, show printWillPart none = [] from rfl, List.nil_append] + unfold readWillPart + rw [ite_eq_right (by rw [hf7']; decide : ¬ (flagBit (connectFlags c) 2 = true))] + simp only [Option.bind_some] + rw [readOptFields c.username c.password huser hpass c.cleanStart + c.keepAlive c.props c.clientId none (flagBit (connectFlags c) 7) + (flagBit (connectFlags c) 6) (flagBit (connectFlags c) 1) hf4 hf5 hf8] + exact congrArg Option.some (hfin none hwn.symm) + · obtain ⟨w, hw⟩ : ∃ w, c.will = some w := by + cases hw2 : c.will with + | none => exact absurd hw2 hwn + | some w => exact ⟨w, rfl⟩ + obtain ⟨wq, wr, wps, wt, wpay⟩ := w + have hwf : WillWF ⟨wq, wr, wps, wt, wpay⟩ := hwill _ hw + have hwq : wq ≤ 2 := hwf.1 + have hwprops : PropsBlockWF .will wps := hwf.2.1 + have hwtopic : TopicWF wt := hwf.2.2.1 + have hwpay : BinWF wpay := hwf.2.2.2 + have hf3' : (connectFlags c / 8) % 4 = wq := by rw [hf3, hw] + have hf6' : flagBit (connectFlags c) 5 = wr := by rw [hf6, hw] + have hf7' : flagBit (connectFlags c) 2 = true := by simp [hf7, hw] + rw [ite_eq_left (by rw [hf3']; omega : (connectFlags c / 8) % 4 ≠ 3), + ite_eq_left (by rw [hf7']; rfl : + (flagBit (connectFlags c) 2 || decide ((connectFlags c / 8) % 8 = 0)) = true), + readNat_writeBE 2 c.keepAlive _ (by omega)] + simp only [Option.bind_some] + rw [readProps_printProps .connect c.props _ hprops] + simp only [Option.bind_some] + rw [readStr_printStr c.clientId _ hcid] + simp only [Option.bind_some] + rw [hw, show printWillPart (some ⟨wq, wr, wps, wt, wpay⟩) + = printProps wps ++ (printStr wt ++ printBin wpay) from rfl] + unfold readWillPart + rw [ite_eq_left hf7', List.append_assoc, readProps_printProps .will wps _ hwprops] + simp only [Option.bind_some] + rw [List.append_assoc, readStr_printStr wt _ hwtopic.1] + simp only [Option.bind_some] + rw [checkTopic_of_wf hwtopic] + simp only [Option.bind_some] + rw [readBin_printBin wpay _ hwpay] + simp only [Option.bind_some] + rw [readOptFields c.username c.password huser hpass c.cleanStart + c.keepAlive c.props c.clientId + (some ⟨(connectFlags c / 8) % 4, flagBit (connectFlags c) 5, wps, wt, + wpay⟩) + (flagBit (connectFlags c) 7) (flagBit (connectFlags c) 6) + (flagBit (connectFlags c) 1) hf4 hf5 hf8] + rw [hf3', hf6'] + exact congrArg Option.some (hfin _ hw.symm) + +/-- The packet identifier step at QoS 0 reads nothing. -/ +theorem readPacketId_qos0 (flags : Nat) (r : List UInt8) + (h : (flags / 2) % 4 = 0) : + readPacketId flags r = some (none, r) := by + unfold readPacketId + rw [ite_eq_left h] + +/-- The packet identifier step at QoS 1 and 2 reads a printed + nonzero identifier. -/ +theorem readPacketId_print (flags : Nat) (i : Nat) (rest : List UInt8) + (h : (flags / 2) % 4 ≠ 0) (hi : 1 ≤ i ∧ i < 65536) : + readPacketId flags (printIdOpt (some i) ++ rest) = some (some i, rest) := by + unfold readPacketId + rw [ite_eq_right h, show printIdOpt (some i) = writeBE 2 i from rfl, + readNat_writeBE 2 i _ (by omega)] + simp only [Option.bind_some] + rw [ite_eq_left (by omega : i ≠ 0)] + +/-- A printed PUBLISH body reads back as the packet, when the + flags word carries the packet's own QoS, DUP and RETAIN. -/ +theorem readPublishBody_printPublishBody (flags : Nat) (pub : Publish) + (hq : (flags / 2) % 4 = pub.qos) (h3 : flagBit flags 3 = pub.dup) + (h0 : flagBit flags 0 = pub.retain) (h : PublishWF pub) : + readPublishBody flags (printPublishBody pub) = some pub := by + obtain ⟨dup, qos, retain, topic, pid, props, payload⟩ := pub + obtain ⟨hqos, htopic, hidf, hnone, hprops, _⟩ := h + have htopic' : PubTopicWF topic props := htopic + have hcond := pubTopic_alias_ok htopic'.2.2.2 + have hidf' : ∀ id, pid = some id → + 1 ≤ id ∧ id < 65536 ∧ (qos = 1 ∨ qos = 2) := hidf + have hnone' : pid = none → qos = 0 := hnone + have hprops' : PropsBlockWF .publish props := hprops + have hq' : (flags / 2) % 4 = qos := hq + have h3' : flagBit flags 3 = dup := h3 + have h0' : flagBit flags 0 = retain := h0 + unfold readPublishBody + rw [show printPublishBody ⟨dup, qos, retain, topic, pid, props, payload⟩ + = printStr topic ++ (printIdOpt pid ++ (printProps props ++ payload)) + from rfl, + readStr_printStr topic _ htopic'.1] + simp only [Option.bind_some] + rw [checkNoWildcards_of_wf htopic'.2.1 htopic'.2.2.1] + simp only [Option.bind_some] + by_cases hq0 : qos = 0 + · have hpid : pid = none := by + cases hp : pid with + | none => rfl + | some i => + have h2 := hidf' i hp + omega + rw [hpid, show printIdOpt none = [] from rfl, List.nil_append, + readPacketId_qos0 flags _ (by omega)] + simp only [Option.bind_some] + rw [readProps_printProps .publish props payload hprops'] + simp only [Option.bind_some] + rw [ite_eq_right hcond, h3', h0', hq'] + · have hpid : ∃ i, pid = some i ∧ 1 ≤ i ∧ i < 65536 := by + cases hp : pid with + | none => exact absurd (hnone' hp) hq0 + | some i => + have h2 := hidf' i hp + exact ⟨i, rfl, h2.1, h2.2.1⟩ + obtain ⟨i, hi, hi1, hi2⟩ := hpid + rw [hi, readPacketId_print flags i _ (by omega) ⟨hi1, hi2⟩] + simp only [Option.bind_some] + rw [readProps_printProps .publish props payload hprops'] + simp only [Option.bind_some] + rw [ite_eq_right hcond, h3', h0', hq'] + +/-! ## Whole packets -/ + +/-- A well formed PUBLISH header byte value fits in a + byte: the fixed part is 0x30 and the flags part is at + most 8 + 4 + 1. -/ +theorem publishHeader_bound (pub : Publish) (h : PublishWF pub) : + publishHeader pub < 256 := by + have hA : (if pub.dup then (8 : Nat) else 0) ≤ 8 := by + cases pub.dup <;> decide + have hB : (if pub.retain then (1 : Nat) else 0) ≤ 1 := by + cases pub.retain <;> decide + have hqos : pub.qos ≤ 2 := h.1 + unfold publishHeader + omega + +/-- The body dispatcher on a printed CONNECT body. -/ +theorem parseBody_connect (c : Connect) (h : ConnectWF c) : + parseBody 1 0 (printConnectBody c) = some (.connect c) := by + show (readConnectBody (printConnectBody c)).map Packet.connect + = some (.connect c) + rw [readConnectBody_printConnectBody c h] + simp only [Option.map_some] + +/-- The body dispatcher on a printed PUBLISH body. -/ +theorem parseBody_publish (pub : Publish) (h : PublishWF pub) : + parseBody 3 (publishHeader pub % 16) (printPublishBody pub) + = some (.publish pub) := by + have hqos : pub.qos ≤ 2 := h.1 + have hA : (if pub.dup then (8 : Nat) else 0) ≤ 8 := by + cases pub.dup <;> decide + have hB : (if pub.retain then (1 : Nat) else 0) ≤ 1 := by + cases pub.retain <;> decide + have hE : (if pub.dup then 8 else 0) + pub.qos * 2 + + (if pub.retain then 1 else 0) ≤ 15 := by omega + have hphv : publishHeader pub + = 48 + ((if pub.dup then 8 else 0) + pub.qos * 2 + + (if pub.retain then 1 else 0)) := by + unfold publishHeader + omega + have hmod : publishHeader pub % 16 + = (if pub.dup then 8 else 0) + pub.qos * 2 + + (if pub.retain then 1 else 0) := by omega + have hb := publish_bits pub.dup pub.retain pub.qos hqos + have hdupwf : pub.qos = 0 → pub.dup = false := h.2.2.2.2.2 + have hdup : ¬ (((if pub.dup then 8 else 0) + pub.qos * 2 + + (if pub.retain then 1 else 0)) / 2 % 4 = 0 + ∧ flagBit ((if pub.dup then 8 else 0) + pub.qos * 2 + + (if pub.retain then 1 else 0)) 3 = true) := by + rw [hb.1, hb.2.1] + intro hc + rw [hdupwf hc.1] at hc + cases hc.2 + show (if (publishHeader pub % 16 / 2) % 4 = 3 then none + else if (publishHeader pub % 16 / 2) % 4 = 0 + ∧ flagBit (publishHeader pub % 16) 3 = true then none + else (readPublishBody (publishHeader pub % 16) (printPublishBody pub)).map + Packet.publish) = some (.publish pub) + rw [hmod, ite_eq_right (by rw [hb.1]; omega : + ¬ ((if pub.dup then 8 else 0) + pub.qos * 2 + + (if pub.retain then 1 else 0)) / 2 % 4 = 3), + ite_eq_right hdup, + readPublishBody_printPublishBody _ pub hb.1 hb.2.1 hb.2.2 h] + simp only [Option.map_some] + +/-- The body dispatcher on a printed SUBSCRIBE body. -/ +theorem parseBody_subscribe (id : Nat) (ps : List Property) + (fs : List (List Char × SubOpts)) (hid : 1 ≤ id ∧ id < 65536) + (hps : PropsBlockWF .subscribe ps) (hfs : fs ≠ [] ∧ FiltersWF fs) : + parseBody 8 2 (printSubscribeBody id ps fs) + = some (.subscribe id ps fs) := by + show (if (2 : Nat) = 2 then readSubscribeBody (printSubscribeBody id ps fs) + else none) = some (.subscribe id ps fs) + rw [ite_eq_left rfl, readSubscribeBody_printSubscribeBody id ps fs hid hps hfs] + +/-- The body dispatcher on a printed SUBACK body. -/ +theorem parseBody_suback (id : Nat) (ps : List Property) (rs : List Nat) + (hid : 1 ≤ id ∧ id < 65536) (hps : PropsBlockWF .suback ps) + (hrs : rs ≠ [] ∧ ∀ r ∈ rs, r < 256) : + parseBody 9 0 (printSubackBody id ps rs) = some (.suback id ps rs) := by + show (if (0 : Nat) = 0 then readSubackBody (printSubackBody id ps rs) + else none) = some (.suback id ps rs) + rw [ite_eq_left rfl, readSubackBody_printSubackBody id ps rs hid hps hrs] + +/-- The body dispatcher on an empty PINGREQ body: a closed + computation. -/ +theorem parseBody_pingreq : parseBody 12 0 [] = some .pingreq := by decide + +/-- The body dispatcher on an empty PINGRESP body. -/ +theorem parseBody_pingresp : parseBody 13 0 [] = some .pingresp := by decide + +/-- The body dispatcher on an empty DISCONNECT body. -/ +theorem parseBody_disconnect_none : + parseBody 14 0 (bodyOf (.disconnect none)) = some (.disconnect none) := by + show (if (0 : Nat) = 0 then readDisconnectBody (bodyOf (.disconnect none)) + else none) = some (.disconnect none) + rw [ite_eq_left rfl, readDisconnectBody_print none trivial] + +/-- The body dispatcher on a printed DISCONNECT body with a + reason code alone. -/ +theorem parseBody_disconnect_short (rc : Nat) (h : rc < 256) : + parseBody 14 0 (bodyOf (.disconnect (some (rc, none)))) + = some (.disconnect (some (rc, none))) := by + show (if (0 : Nat) = 0 + then readDisconnectBody (bodyOf (.disconnect (some (rc, none)))) + else none) = some (.disconnect (some (rc, none))) + rw [ite_eq_left rfl, readDisconnectBody_print (some (rc, none)) h] + +/-- The body dispatcher on a printed DISCONNECT body with a + reason code and properties. -/ +theorem parseBody_disconnect_some (rc : Nat) (ps : List Property) + (h : rc < 256 ∧ PropsBlockWF PropSet.disconnect ps) : + parseBody 14 0 (bodyOf (.disconnect (some (rc, some ps)))) + = some (.disconnect (some (rc, some ps))) := by + show (if (0 : Nat) = 0 + then readDisconnectBody (bodyOf (.disconnect (some (rc, some ps)))) + else none) = some (.disconnect (some (rc, some ps))) + rw [ite_eq_left rfl, readDisconnectBody_print (some (rc, some ps)) h] + +/-- One packet at the head of a stream: a printed packet + followed by any bytes parses to the packet and leaves + the rest of the stream untouched. -/ +theorem parsePacket_print (p : Packet) (rest : List UInt8) (h : PacketWF p) : + parsePacket (print p ++ rest) = some (p, rest) := by + obtain ⟨hfields, hlen⟩ := h + have hnorm : print p ++ rest + = headerOf p :: (printVBI (bodyOf p).length ++ (bodyOf p ++ rest)) := by + show (headerOf p :: (printVBI (bodyOf p).length ++ bodyOf p)) ++ rest + = headerOf p :: (printVBI (bodyOf p).length ++ (bodyOf p ++ rest)) + rw [List.cons_append, List.append_assoc] + rw [hnorm] + show ((decVBI (printVBI (bodyOf p).length ++ (bodyOf p ++ rest))).bind + fun (len, r1) => + (readBytes len r1).bind fun (seg, r2) => + (parseBody ((headerOf p).toNat / 16) ((headerOf p).toNat % 16) seg).bind + fun q => some (q, r2)) = some (p, rest) + rw [decVBI_printVBI _ _ hlen] + simp only [Option.bind_some] + rw [readBytes_append _ _ _ rfl] + simp only [Option.bind_some] + cases p with + | connect c => + have hfc : ConnectWF c := hfields + have e1 : (headerOf (.connect c)).toNat / 16 = 1 := by + rw [show headerOf (.connect c) = (0x10 : UInt8) from rfl]; decide + have e2 : (headerOf (.connect c)).toNat % 16 = 0 := by + rw [show headerOf (.connect c) = (0x10 : UInt8) from rfl]; decide + have e3 : bodyOf (.connect c) = printConnectBody c := rfl + rw [e1, e2, e3] + simp only [parseBody_connect c hfc, Option.bind_some] + | publish pub => + have hfp : PublishWF pub := hfields + have hph : (publishHeader pub).toUInt8.toNat = publishHeader pub := + toNat_toUInt8 (publishHeader_bound pub hfp) + have hqos : pub.qos ≤ 2 := hfp.1 + have hA : (if pub.dup then (8 : Nat) else 0) ≤ 8 := by + cases pub.dup <;> decide + have hB : (if pub.retain then (1 : Nat) else 0) ≤ 1 := by + cases pub.retain <;> decide + have hphv : publishHeader pub + = 48 + ((if pub.dup then 8 else 0) + pub.qos * 2 + + (if pub.retain then 1 else 0)) := by + unfold publishHeader + omega + have hE : (if pub.dup then 8 else 0) + pub.qos * 2 + + (if pub.retain then 1 else 0) ≤ 15 := by omega + have hdiv : publishHeader pub / 16 = 3 := by omega + have e3 : bodyOf (.publish pub) = printPublishBody pub := rfl + have e0 : headerOf (.publish pub) = (publishHeader pub).toUInt8 := rfl + rw [e3, e0, hph, hdiv] + simp only [parseBody_publish pub hfp, Option.bind_some] + | subscribe id ps fs => + have hid : 1 ≤ id ∧ id < 65536 := ⟨hfields.1, hfields.2.1⟩ + have hps : PropsBlockWF .subscribe ps := hfields.2.2.1 + have hfs : fs ≠ [] ∧ FiltersWF fs := ⟨hfields.2.2.2.1, hfields.2.2.2.2⟩ + have e1 : (headerOf (.subscribe id ps fs)).toNat / 16 = 8 := by + rw [show headerOf (.subscribe id ps fs) = (0x82 : UInt8) from rfl]; decide + have e2 : (headerOf (.subscribe id ps fs)).toNat % 16 = 2 := by + rw [show headerOf (.subscribe id ps fs) = (0x82 : UInt8) from rfl]; decide + have e3 : bodyOf (.subscribe id ps fs) = printSubscribeBody id ps fs := rfl + rw [e1, e2, e3] + simp only [parseBody_subscribe id ps fs hid hps hfs, Option.bind_some] + | suback id ps rs => + have hid : 1 ≤ id ∧ id < 65536 := ⟨hfields.1, hfields.2.1⟩ + have hps : PropsBlockWF .suback ps := hfields.2.2.1 + have hrs : rs ≠ [] ∧ ∀ r ∈ rs, r < 256 := + ⟨hfields.2.2.2.1, hfields.2.2.2.2⟩ + have e1 : (headerOf (.suback id ps rs)).toNat / 16 = 9 := by + rw [show headerOf (.suback id ps rs) = (0x90 : UInt8) from rfl]; decide + have e2 : (headerOf (.suback id ps rs)).toNat % 16 = 0 := by + rw [show headerOf (.suback id ps rs) = (0x90 : UInt8) from rfl]; decide + have e3 : bodyOf (.suback id ps rs) = printSubackBody id ps rs := rfl + rw [e1, e2, e3] + simp only [parseBody_suback id ps rs hid hps hrs, Option.bind_some] + | pingreq => + have e1 : (headerOf .pingreq).toNat / 16 = 12 := by decide + have e2 : (headerOf .pingreq).toNat % 16 = 0 := by decide + have e3 : bodyOf .pingreq = [] := rfl + rw [e1, e2, e3] + simp only [parseBody_pingreq, Option.bind_some] + | pingresp => + have e1 : (headerOf .pingresp).toNat / 16 = 13 := by decide + have e2 : (headerOf .pingresp).toNat % 16 = 0 := by decide + have e3 : bodyOf .pingresp = [] := rfl + rw [e1, e2, e3] + simp only [parseBody_pingresp, Option.bind_some] + | disconnect x => + have e1 : (headerOf (.disconnect x)).toNat / 16 = 14 := by + rw [show headerOf (.disconnect x) = (0xE0 : UInt8) from rfl]; decide + have e2 : (headerOf (.disconnect x)).toNat % 16 = 0 := by + rw [show headerOf (.disconnect x) = (0xE0 : UInt8) from rfl]; decide + rw [e1, e2] + cases x with + | none => + simp only [parseBody_disconnect_none, Option.bind_some] + | some rp => + obtain ⟨rc, ops⟩ := rp + cases ops with + | none => + have h2 : rc < 256 := hfields + simp only [parseBody_disconnect_short rc h2, Option.bind_some] + | some ps => + have h2 : rc < 256 ∧ PropsBlockWF PropSet.disconnect ps := hfields + simp only [parseBody_disconnect_some rc ps h2, Option.bind_some] + +/-- The main round trip claim: a well formed packet, + printed and parsed back on its own, is the same + packet. -/ +theorem parse_print (p : Packet) (h : PacketWF p) : parse (print p) = some p := by + unfold parse + have h2 := parsePacket_print p [] h + rw [List.append_nil] at h2 + simp only [h2] + +end Mqtt.Proofs diff --git a/Proofs/Rules.lean b/Proofs/Rules.lean new file mode 100644 index 0000000..ce5bc19 --- /dev/null +++ b/Proofs/Rules.lean @@ -0,0 +1,447 @@ +/- + Proofs of the statements in `Spec.lean` whose rule text stands + in `Spec/Defs.lean`, part of the specification. + + Each proof starts from what the reader is already proved to + accept (`parsePacket_inv` in `Proofs/Sound.lean`, and + `decVBI_canonical` in `Proofs/RoundTrip.lean`) and shows that the + rule written in the specification holds for it. +-/ + +import Mqtt +import Spec.Defs +import Proofs.Sound + +namespace Mqtt.Proofs + +open Mqtt + +/-! ## The byte count of a variable byte integer -/ + +/-- The printer writes a value below 2^28 in `Spec.vbiSize` + bytes. -/ +theorem printVBI_length (n : Nat) (hn : n < 268435456) : + (printVBI n).length = Spec.vbiSize n := by + unfold Spec.vbiSize + rw [printVBI_def] + by_cases h1 : n < 128 + · simp [h1] + rw [ite_eq_right h1, ite_eq_right h1, List.length_cons, printVBI_def] + by_cases h2 : n < 16384 + · rw [ite_eq_left (by omega : n / 128 < 128), ite_eq_left h2]; rfl + rw [ite_eq_right (by omega : ¬ n / 128 < 128), ite_eq_right h2, List.length_cons, + printVBI_def] + by_cases h3 : n < 2097152 + · rw [ite_eq_left (by omega : n / 128 / 128 < 128), ite_eq_left h3]; rfl + rw [ite_eq_right (by omega : ¬ n / 128 / 128 < 128), ite_eq_right h3, + List.length_cons, printVBI_def, ite_eq_left (by omega : n / 128 / 128 / 128 < 128)] + rfl + +/-- What the variable byte integer reader accepts takes exactly + `Spec.vbiSize` bytes of its value: it is the printer's + writing (`decVBI_canonical`), whose length is that count. -/ +theorem decVBI_length (bs : List UInt8) (n : Nat) (r : List UInt8) + (h : decVBI bs = some (n, r)) : bs.length = r.length + Spec.vbiSize n := by + obtain ⟨hn, he⟩ := decVBI_canonical bs n r h + rw [he, List.length_append, printVBI_length n hn, Nat.add_comm] + +/-! ## parse and parsePacket -/ + +/-- `parse` accepts exactly what `parsePacket` takes whole. -/ +theorem parse_iff (bs : List UInt8) (p : Packet) : + parse bs = some p ↔ parsePacket bs = some (p, []) := by + unfold parse + constructor + · intro h + split at h + · rename_i q heq + cases h; exact heq + · cases h + · intro h + rw [h] + +/-! ## Header bytes -/ + +/-- A PUBLISH header byte with QoS at most 2 and DUP clear at + QoS 0 is on the list. -/ +theorem pubHeader_mem (dup retain : Bool) (qos : Nat) (hq : qos ≤ 2) + (hd : qos = 0 → dup = false) : + (0x30 + (if dup then 8 else 0) + qos * 2 + (if retain then 1 else 0)).toUInt8 + ∈ Spec.headerBytes := by + have : qos = 0 ∨ qos = 1 ∨ qos = 2 := by omega + rcases this with rfl | rfl | rfl + · rw [hd rfl]; cases retain <;> decide + · cases dup <;> cases retain <;> decide + · cases dup <;> cases retain <;> decide + +/-- The printer's header byte of a well formed packet is on the + list `Spec.headerBytes`. -/ +theorem header_mem (p : Packet) (h : PacketWF p) : headerOf p ∈ Spec.headerBytes := by + cases p with + | publish m => + obtain ⟨hq, -, -, -, -, hd⟩ := (h.1 : PublishWF m) + exact pubHeader_mem m.dup m.retain m.qos hq hd + | connect c => show (0x10 : UInt8) ∈ Spec.headerBytes; decide + | subscribe => show (0x82 : UInt8) ∈ Spec.headerBytes; decide + | suback => show (0x90 : UInt8) ∈ Spec.headerBytes; decide + | pingreq => decide + | pingresp => decide + | disconnect => show (0xE0 : UInt8) ∈ Spec.headerBytes; decide + +/-- What the stream reader takes starts with a header byte on + the list: it is a printing (`parsePacket_inv`). -/ +theorem header_rule (bs : List UInt8) (p : Packet) (r : List UInt8) + (h : parsePacket bs = some (p, r)) : + ∃ b tl, bs = b :: tl ∧ b ∈ Spec.headerBytes := by + obtain ⟨hwf, he⟩ := parsePacket_inv bs p r h + refine ⟨headerOf p, (printVBI (bodyOf p).length ++ bodyOf p) ++ r, ?_, header_mem p hwf⟩ + rw [he]; rfl + +/-! ## Empty bodies -/ + +/-- A PINGREQ or PINGRESP the stream reader takes is its + two byte printing. -/ +theorem empty_body_rule (bs r : List UInt8) : + (parsePacket bs = some (.pingreq, r) → bs = [192, 0] ++ r) + ∧ (parsePacket bs = some (.pingresp, r) → bs = [208, 0] ++ r) := by + constructor + · intro h + rw [(parsePacket_inv bs _ r h).2, (by decide +kernel : print .pingreq = [192, 0])] + · intro h + rw [(parsePacket_inv bs _ r h).2, (by decide +kernel : print .pingresp = [208, 0])] + +/-! ## CONNECT -/ + +/-- A CONNECT the stream reader takes is its printing, whose + body starts with the protocol name, the level and the flags + byte `connectFlags_facts` describes. -/ +theorem connect_rule (bs r : List UInt8) (c : Connect) + (h : parsePacket bs = some (.connect c, r)) : + (∃ (f : UInt8) (tail : List UInt8), + bs = 16 :: (printVBI (8 + tail.length) ++ ([0, 4, 77, 81, 84, 84, 5, f] ++ tail)) ++ r + ∧ Spec.ConnectFlagsRule f.toNat) + ∧ ∀ w, c.will = some w → w.topic ≠ [] ∧ Spec.TopicNameRule w.topic := by + obtain ⟨hwf, he⟩ := parsePacket_inv bs _ r h + have hc : ConnectWF c := hwf.1 + obtain ⟨f1, f2, f3, -, -, -, f7, -, f9⟩ := connectFlags_facts c hc + refine ⟨⟨(connectFlags c).toUInt8, writeBE 2 c.keepAlive ++ (printProps c.props + ++ (printStr c.clientId ++ (printWillPart c.will ++ (printOptStr c.username + ++ printOptBin c.password)))), ?_, ?_⟩, ?_⟩ + · rw [he] + show (16 : UInt8) :: (printVBI (printConnectBody c).length ++ printConnectBody c) ++ r = _ + have hb : printConnectBody c = [0, 4, 77, 81, 84, 84, 5, (connectFlags c).toUInt8] + ++ (writeBE 2 c.keepAlive ++ (printProps c.props + ++ (printStr c.clientId ++ (printWillPart c.will ++ (printOptStr c.username + ++ printOptBin c.password))))) := by + unfold printConnectBody + rfl + rw [hb] + simp only [List.length_append, List.length_cons, List.length_nil] + · rw [f1] + refine ⟨f2, ?_, ?_⟩ + · rw [f3] + cases hw : c.will with + | none => simp + | some w => + have := (hc.2.2.2.1 w hw).1 + simp only [] + omega + · intro hb + apply f9 + have : flagBit (connectFlags c) 2 = false := by + unfold flagBit; simp; omega + rw [f7] at this + cases hw : c.will with + | none => rfl + | some w => rw [hw] at this; cases this + · intro w hw + have := (hc.2.2.2.1 w hw).2.2.1 + exact ⟨this.2.1, this.2.2.1, this.2.2.2⟩ + +/-! ## PUBLISH -/ + +/-- `hasTopicAlias` finds a property with identifier 0x23. -/ +theorem hasTopicAlias_true {ps : List Property} (h : hasTopicAlias ps = true) : + ∃ q ∈ ps, q.id = 0x23 := by + unfold hasTopicAlias at h + obtain ⟨q, hq, he⟩ := List.any_eq_true.mp h + exact ⟨q, hq, by simpa using he⟩ + +/-- A PUBLISH the stream reader takes is well formed, and + `PublishWF` gives the topic and identifier rules. -/ +theorem publish_rule (bs r : List UInt8) (m : Publish) + (h : parsePacket bs = some (.publish m, r)) : + Spec.TopicNameRule m.topic ∧ (m.topic = [] → ∃ q ∈ m.props, q.id = 0x23) + ∧ (m.packetId = none ↔ m.qos = 0) ∧ (∀ i, m.packetId = some i → i ≠ 0) := by + obtain ⟨hwf, -⟩ := parsePacket_inv bs _ r h + obtain ⟨hq, ht, hid, hnone, -, -⟩ := (hwf.1 : PublishWF m) + obtain ⟨-, hp, hh, ha⟩ := ht + refine ⟨⟨hp, hh⟩, fun e => hasTopicAlias_true (ha e), ⟨hnone, ?_⟩, ?_⟩ + · intro h0 + cases hpid : m.packetId with + | none => rfl + | some i => + have := (hid i hpid).2.2 + omega + · intro i hi + have := (hid i hi).1 + omega + +/-! ## Property blocks -/ + +/-- Every property of a well formed list is allowed on its block, + has its table type, and keeps `propValOK`. -/ +theorem propsWF_mem : ∀ (s : PropSet) (seen : List Nat) (ps : List Property), + PropsWF s seen ps → ∀ q ∈ ps, q.id ∈ allowedOf s + ∧ propTypeOf q.id = some (valType q.val) ∧ propValOK q.id q.val = true + | _, _, [], _, q, hq => by cases hq + | s, seen, p :: ps, h, q, hq => by + rw [PropsWF] at h + obtain ⟨h1, h2, -, h4, -, h6⟩ := h + rcases List.mem_cons.mp hq with rfl | hq + · exact ⟨h1, h2, h4⟩ + · exact propsWF_mem s _ ps h6 q hq + +/-- In a well formed list, a single use identifier already seen + does not stand again, and stands at most once. -/ +theorem propsWF_count : ∀ (s : PropSet) (seen : List Nat) (ps : List Property), + PropsWF s seen ps → ∀ i, repeatableIn s i = false → + (i ∈ seen → i ∉ ps.map Property.id) ∧ (ps.map Property.id).count i ≤ 1 + | _, _, [], _, i, _ => by simp + | s, seen, p :: ps, h, i, hi => by + rw [PropsWF] at h + obtain ⟨-, -, -, -, h5, h6⟩ := h + obtain ⟨ih1, ih2⟩ := propsWF_count s (p.id :: seen) ps h6 i hi + by_cases he : p.id = i + · subst he + have hns : p.id ∉ seen := by + rcases h5 with h5 | h5 + · rw [hi] at h5; cases h5 + · exact h5 + refine ⟨fun hm => absurd hm hns, ?_⟩ + have h0 : (ps.map Property.id).count p.id = 0 := + List.count_eq_zero.mpr (ih1 (List.mem_cons_self ..)) + simp [h0] + · refine ⟨fun hm => ?_, ?_⟩ + · simp only [List.map_cons, List.mem_cons, not_or] + exact ⟨fun e => he e.symm, ih1 (List.mem_cons_of_mem _ hm)⟩ + · simp only [List.map_cons, List.count_cons] + have : (p.id == i) = false := by simpa using he + simp [this, ih2] + +/-- The table type and `propValOK` of an allowed identifier give + `Spec.ValueRule`, by cases on the identifier. -/ +theorem valueRule_of (s : PropSet) (q : Property) (h1 : q.id ∈ allowedOf s) + (h2 : propTypeOf q.id = some (valType q.val)) (h3 : propValOK q.id q.val = true) : + Spec.ValueRule q.id q.val := by + obtain ⟨i, v⟩ := q + dsimp only at h1 h2 h3 ⊢ + have hi : i = 0x01 ∨ i = 0x02 ∨ i = 0x03 ∨ i = 0x08 ∨ i = 0x09 ∨ i = 0x0B ∨ i = 0x11 + ∨ i = 0x15 ∨ i = 0x16 ∨ i = 0x17 ∨ i = 0x18 ∨ i = 0x19 ∨ i = 0x1C ∨ i = 0x1F + ∨ i = 0x21 ∨ i = 0x22 ∨ i = 0x23 ∨ i = 0x26 ∨ i = 0x27 := by + cases s <;> simp [allowedOf] at h1 <;> omega + rcases hi with rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl | rfl + | rfl | rfl | rfl | rfl | rfl | rfl | rfl + all_goals + cases v <;> simp_all [propTypeOf, valType, propValOK, Spec.ValueRule, Spec.TopicNameRule] + +/-- A well formed property block keeps `Spec.BlockRule`. -/ +theorem blockRule_of_wf (s : PropSet) (ps : List Property) (h : PropsBlockWF s ps) : + Spec.BlockRule s ps := by + obtain ⟨hw, -, ha⟩ := h + refine ⟨?_, ?_, ?_⟩ + · intro q hq + obtain ⟨h1, h2, h3⟩ := propsWF_mem s [] ps hw q hq + refine ⟨?_, valueRule_of s q h1 h2 h3⟩ + cases s <;> exact h1 + · intro i hi + have : repeatableIn s i = false := by + unfold Spec.MayRepeat at hi + unfold repeatableIn + cases s <;> simp_all + exact (propsWF_count s [] ps hw i this).2 + · rintro ⟨q, hq, he⟩ + unfold authOK at ha + have h16 : ps.any (fun p => p.id == 0x16) = true := + List.any_eq_true.mpr ⟨q, hq, by simp [he]⟩ + rw [h16] at ha + simp only [Bool.not_true, Bool.false_or] at ha + obtain ⟨q', hq', he'⟩ := List.any_eq_true.mp ha + exact ⟨q', hq', by simpa using he'⟩ + +/-- Every block of a packet the stream reader takes is well + formed, so it keeps `Spec.BlockRule`. -/ +theorem property_rule (bs r : List UInt8) (p : Packet) + (h : parsePacket bs = some (p, r)) : + ∀ b ∈ Spec.blocks p, Spec.BlockRule b.1 b.2 := by + obtain ⟨hwf, -⟩ := parsePacket_inv bs p r h + intro b hb + cases p with + | connect c => + have hc : ConnectWF c := hwf.1 + simp only [Spec.blocks] at hb + rcases List.mem_cons.mp hb with rfl | hb + · exact blockRule_of_wf _ _ hc.2.1 + · cases hw : c.will with + | none => rw [hw] at hb; cases hb + | some w => + rw [hw] at hb + rcases List.mem_singleton.mp hb with rfl + exact blockRule_of_wf _ _ (hc.2.2.2.1 w hw).2.1 + | publish m => + rcases List.mem_singleton.mp hb with rfl + exact blockRule_of_wf _ _ (hwf.1 : PublishWF m).2.2.2.2.1 + | subscribe id ps fs => + rcases List.mem_singleton.mp hb with rfl + exact blockRule_of_wf _ _ hwf.1.2.2.1 + | suback id ps rs => + rcases List.mem_singleton.mp hb with rfl + exact blockRule_of_wf _ _ hwf.1.2.2.1 + | pingreq => cases hb + | pingresp => cases hb + | disconnect x => + rcases x with _ | ⟨rc, _ | ps⟩ + · cases hb + · cases hb + · rcases List.mem_singleton.mp hb with rfl + exact blockRule_of_wf _ _ hwf.1.2 + +/-! ## Topic filters -/ + +/-- The code's level splitter is the standard library's + `List.splitOn '/'`. -/ +theorem splitLevels_eq : ∀ f : List Char, splitLevels f = f.splitOn '/' + | [] => by simp [splitLevels] + | c :: cs => by + rw [List.splitOn_cons_eq_ite_modifyHead, splitLevels, ← splitLevels_eq cs] + by_cases h : c = '/' + · simp [h] + · have hne : splitLevels cs ≠ [] := by + rw [splitLevels_eq cs]; exact List.splitOn_ne_nil _ _ + rw [ite_eq_right h] + have hb : (c == '/') = false := by simpa using h + rw [hb] + simp only [Bool.false_eq_true, ↓reduceIte] + cases hs : splitLevels cs with + | nil => exact absurd hs hne + | cons l ls => rfl + +/-- A level other than the last that passes `levelOK` is `+` + alone or holds no wildcard. -/ +theorem levelOK_facts {l : List Char} (h : levelOK l = true) : + ('+' ∈ l → l = ['+']) ∧ '#' ∉ l := by + unfold levelOK at h + simp only [Bool.or_eq_true, beq_iff_eq, Bool.and_eq_true, Bool.not_eq_true', + List.contains_eq_mem, decide_eq_false_iff_not] at h + rcases h with rfl | ⟨h1, h2⟩ + · exact ⟨fun _ => rfl, by simp⟩ + · exact ⟨fun hm => absurd hm h2, h1⟩ + +/-- Levels that pass `levelsOK` keep `Spec.WildcardRule`. -/ +theorem wildcardRule_of : ∀ ls : List (List Char), levelsOK ls = true → Spec.WildcardRule ls + | [], _ => fun i hi => absurd hi (by simp) + | [l], h => by + intro i hi + have hi0 : i = 0 := by simp at hi; omega + subst hi0 + simp only [List.getElem_cons_zero, List.length_cons, List.length_nil] + simp only [levelsOK, Bool.or_eq_true, beq_iff_eq] at h + rcases h with rfl | h + · exact ⟨fun hm => by simp at hm, fun _ => by simp⟩ + · obtain ⟨h1, h2⟩ := levelOK_facts h + exact ⟨h1, fun hm => absurd hm h2⟩ + | l :: l2 :: ls, h => by + simp only [levelsOK, Bool.and_eq_true] at h + obtain ⟨hl, hrest⟩ := h + have ih := wildcardRule_of (l2 :: ls) hrest + intro i hi + cases i with + | zero => + obtain ⟨h1, h2⟩ := levelOK_facts hl + exact ⟨h1, fun hm => absurd hm h2⟩ + | succ i => + have hi' : i < (l2 :: ls).length := by simp at hi ⊢; omega + obtain ⟨h1, h2⟩ := ih i hi' + simp only [List.getElem_cons_succ, List.length_cons] at h1 h2 ⊢ + exact ⟨h1, fun hm => ⟨(h2 hm).1, by have := (h2 hm).2; omega⟩⟩ + +/-- A filter that passes `plainFilterOK` keeps + `Spec.PlainFilterRule`. -/ +theorem plainRule_of (f : List Char) (h : plainFilterOK f = true) : Spec.PlainFilterRule f := by + unfold plainFilterOK at h + simp only [Bool.and_eq_true, Bool.not_eq_true', List.isEmpty_eq_false_iff] at h + exact ⟨h.1, by rw [← splitLevels_eq]; exact wildcardRule_of _ h.2⟩ + +/-- When `shareSplit` finds a `/`, the text is the ShareName, the + `/` and the rest, and the ShareName holds no `/`. -/ +theorem shareSplit_some : ∀ (r name flt : List Char), + shareSplit r = (name, some flt) → r = name ++ '/' :: flt ∧ '/' ∉ name + | [], name, flt, h => by simp [shareSplit] at h + | c :: cs, name, flt, h => by + unfold shareSplit at h + by_cases hc : c = '/' + · rw [ite_eq_left hc] at h + cases h + subst hc + exact ⟨rfl, by simp⟩ + · rw [ite_eq_right hc] at h + cases hs : shareSplit cs with + | mk n r => + rw [hs] at h + simp only [Prod.mk.injEq] at h + obtain ⟨rfl, rfl⟩ := h + obtain ⟨h1, h2⟩ := shareSplit_some cs n flt hs + refine ⟨by rw [h1]; rfl, ?_⟩ + simp only [List.mem_cons, not_or] + exact ⟨fun e => hc e.symm, h2⟩ + +/-- A filter that passes `filterOK` keeps `Spec.FilterRule`. -/ +theorem filterRule_of (f : List Char) (o : SubOpts) (h : filterOK f o = true) : + Spec.FilterRule f o := by + by_cases hp : Spec.sharePrefix <+: f + · obtain ⟨r, rfl⟩ := hp + refine ⟨fun _ => ?_, fun hn => absurd (List.prefix_append _ _) hn⟩ + have h' : (match shareSplit r with + | (name, some flt) => + !name.isEmpty && !name.contains '+' && !name.contains '#' + && plainFilterOK flt && !o.noLocal + | (_, none) => false) = true := h + cases hs : shareSplit r with + | mk name rest => + cases rest with + | none => rw [hs] at h'; cases h' + | some flt => + rw [hs] at h' + simp only [Bool.and_eq_true, Bool.not_eq_true', List.isEmpty_eq_false_iff, + List.contains_eq_mem, decide_eq_false_iff_not] at h' + obtain ⟨⟨⟨⟨hn, hplus⟩, hhash⟩, hplain⟩, hnl⟩ := h' + obtain ⟨hr, hslash⟩ := shareSplit_some r name flt hs + exact ⟨name, flt, by rw [hr, List.append_assoc], hn, hslash, hplus, hhash, + plainRule_of flt hplain, hnl⟩ + · refine ⟨fun hp' => absurd hp' hp, fun _ => ?_⟩ + unfold filterOK at h + split at h + · exact absurd ⟨_, rfl⟩ hp + · exact plainRule_of f h + +/-- Every filter of a well formed filter list keeps + `Spec.FilterRule`. -/ +theorem filtersWF_rule : ∀ (fs : List (List Char × SubOpts)), FiltersWF fs → + ∀ fo ∈ fs, Spec.FilterRule fo.1 fo.2 + | [], _, fo, hfo => by cases hfo + | (f, o) :: gs, h, fo, hfo => by + obtain ⟨-, -, hok, hrest⟩ := h + rcases List.mem_cons.mp hfo with rfl | hfo + · exact filterRule_of f o hok + · exact filtersWF_rule gs hrest fo hfo + +/-- A SUBSCRIBE the stream reader takes is well formed, so its + identifier, filter list and filters keep the rules. -/ +theorem subscribe_rule (bs r : List UInt8) (i : Nat) (ps : List Property) + (fs : List (List Char × SubOpts)) (h : parsePacket bs = some (.subscribe i ps fs, r)) : + i ≠ 0 ∧ fs ≠ [] ∧ ∀ fo ∈ fs, Spec.FilterRule fo.1 fo.2 := by + obtain ⟨hwf, -⟩ := parsePacket_inv bs _ r h + obtain ⟨h1, -, -, h4, h5⟩ := hwf.1 + exact ⟨by omega, h4, filtersWF_rule fs h5⟩ + +end Mqtt.Proofs diff --git a/Proofs/Sound.lean b/Proofs/Sound.lean new file mode 100644 index 0000000..afff421 --- /dev/null +++ b/Proofs/Sound.lean @@ -0,0 +1,1054 @@ +/- + Soundness of the packet reader: what it accepts is exactly the + printed form of a well formed packet. The main claims are + `Mqtt.Proofs.parse_inv`, for the whole input reader, and + `Mqtt.Proofs.parsePacket_inv`, for the stream reader. + + Together with the round trip in `Proofs/RoundTrip.lean`, this + makes the reader and the printer exact inverses between well + formed packets and the byte lists the reader accepts: a byte + list is accepted if and only if it is the printing of a well + formed packet, and the packet read is that packet. Each lemma + below is the inverse of one field reader, in the shape "what + the reader accepts is the printed field, followed by the bytes + it returns, and the field is well formed". +-/ + +import Proofs.RoundTrip +import Proofs.Utf8Inv + +namespace Mqtt.Proofs + +open Mqtt + +/-- What the big endian reader accepts is the writing of the + number it returns, at its width, with the returned bytes + after it. -/ +theorem readNat_inv : ∀ (k : Nat) (bs : List UInt8) (n : Nat) (r : List UInt8), + readNat k bs = some (n, r) → n < 256 ^ k ∧ bs = writeBE k n ++ r := by + intro k + induction k with + | zero => + intro bs n r h + rw [readNat] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨h1, h2⟩ := h + subst h1 + subst h2 + exact ⟨by decide, rfl⟩ + | succ k ih => + intro bs n r h + cases bs with + | nil => rw [readNat] at h; cases h + | cons b bs => + rw [readNat_succ_cons] at h + obtain ⟨⟨u, r'⟩, h1, h2⟩ := Option.map_eq_some_iff.mp h + simp only [Prod.mk.injEq] at h2 + obtain ⟨hn, hr⟩ := h2 + subst hn + subst hr + obtain ⟨hu, hbs⟩ := ih bs u r' h1 + have hP : 0 < 256 ^ k := Nat.pow_pos (by decide) + have hb : b.toNat < 256 := UInt8.toNat_lt b + refine ⟨?_, ?_⟩ + · have e1 : b.toNat * 256 ^ k + u < (b.toNat + 1) * 256 ^ k := by + rw [Nat.succ_mul]; omega + have e2 : (b.toNat + 1) * 256 ^ k ≤ 256 * 256 ^ k := + Nat.mul_le_mul_right _ (by omega) + rw [Nat.pow_succ, Nat.mul_comm (256 ^ k) 256] + omega + · rw [writeBE_succ, hbs] + have hdiv : (b.toNat * 256 ^ k + u) / 256 ^ k = b.toNat := by + rw [Nat.mul_comm, Nat.mul_add_div hP, Nat.div_eq_of_lt hu] + omega + have hmod : (b.toNat * 256 ^ k + u) % 256 ^ k = u := by + rw [Nat.mul_comm, Nat.mul_add_mod, Nat.mod_eq_of_lt hu] + rw [hdiv, hmod, Nat.mod_eq_of_lt hb, byte_eq_toUInt8] + rfl + +/-- A one byte writing of a number below 256 is that byte. -/ +theorem writeBE_one (n : Nat) (h : n < 256) : writeBE 1 n = [n.toUInt8] := by + rw [writeBE_succ] + simp only [Nat.pow_zero, Nat.div_one, Nat.mod_one, Nat.mod_eq_of_lt h] + rfl + +/-- What the single byte reader accepts is one byte. -/ +theorem readByte_inv (bs : List UInt8) (n : Nat) (r : List UInt8) + (h : readByte bs = some (n, r)) : n < 256 ∧ bs = n.toUInt8 :: r := by + cases bs with + | nil => cases h + | cons b bs => + rw [readByte_cons] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨h1, h2⟩ := h + subst h1 + subst h2 + exact ⟨UInt8.toNat_lt b, by rw [byte_eq_toUInt8]⟩ + +/-- The null character check passes only on a text without the + null character. -/ +theorem checkChars_inv {cs s : List Char} (h : checkChars cs = some s) : + s = cs ∧ '\u0000' ∉ cs := by + unfold checkChars at h + by_cases hn : hasNul cs = true + · rw [ite_eq_left hn] at h; cases h + · rw [ite_eq_right hn] at h + simp only [Option.some.injEq] at h + refine ⟨h.symm, ?_⟩ + intro hm + apply hn + simp only [hasNul, List.any_eq_true] + exact ⟨_, hm, by simp⟩ + +/-- What the string reader accepts is the printed form of a well + formed string, with the returned bytes after it. -/ +theorem readStr_inv (bs : List UInt8) (s : List Char) (r : List UInt8) + (h : readStr bs = some (s, r)) : StrWF s ∧ bs = printStr s ++ r := by + rw [readStr_step] at h + obtain ⟨⟨len, r1⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨chunk, r2⟩, h2, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨s', h3, h⟩ := Option.bind_eq_some_iff.mp h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hs, hr⟩ := h + subst hs + subst hr + obtain ⟨cs, h4, h5⟩ := Option.bind_eq_some_iff.mp h3 + obtain ⟨hsc, hnul⟩ := checkChars_inv h5 + subst hsc + obtain ⟨hlen, hbs⟩ := readNat_inv 2 bs len r1 h1 + obtain ⟨hcl, hr1⟩ := readBytes_inv len r1 chunk r2 h2 + have henc := Mqtt.Utf8.Proofs.decode_inv chunk s' h4 + refine ⟨⟨hnul, ?_⟩, ?_⟩ + · rw [henc, hcl] + have : (256 : Nat) ^ 2 = 65536 := by decide + omega + · rw [hbs, hr1, printStr, henc, hcl, List.append_assoc] + +/-- What the binary reader accepts is the printed form of binary + data that fits its prefix, with the returned bytes after it. -/ +theorem readBin_inv (bs : List UInt8) (d : List UInt8) (r : List UInt8) + (h : readBin bs = some (d, r)) : BinWF d ∧ bs = printBin d ++ r := by + rw [readBin_step] at h + obtain ⟨⟨len, r1⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨hlen, hbs⟩ := readNat_inv 2 bs len r1 h1 + obtain ⟨hcl, hr1⟩ := readBytes_inv len r1 d r h + refine ⟨?_, ?_⟩ + · show d.length ≤ 65535 + have : (256 : Nat) ^ 2 = 65536 := by decide + omega + · rw [hbs, hr1, printBin, hcl, List.append_assoc] + + +/-- What the property value reader accepts is the printed form + of a well formed value of the type asked for. -/ +theorem readPropVal_inv (t : PropType) (bs : List UInt8) (v : PropVal) (r : List UInt8) + (h : readPropVal t bs = some (v, r)) : + valType v = t ∧ ValWF v ∧ bs = printPropVal v ++ r := by + cases t with + | byte => + simp only [readPropVal] at h + obtain ⟨⟨n, r'⟩, h1, h2⟩ := Option.map_eq_some_iff.mp h + simp only [Prod.mk.injEq] at h2 + obtain ⟨hv, hr⟩ := h2 + subst hv + subst hr + obtain ⟨hn, hbs⟩ := readNat_inv 1 bs n r' h1 + have hn' : n < 256 := by simpa using hn + exact ⟨rfl, hn', by rw [hbs, writeBE_one n hn']; rfl⟩ + | twoByte => + simp only [readPropVal] at h + obtain ⟨⟨n, r'⟩, h1, h2⟩ := Option.map_eq_some_iff.mp h + simp only [Prod.mk.injEq] at h2 + obtain ⟨hv, hr⟩ := h2 + subst hv + subst hr + obtain ⟨hn, hbs⟩ := readNat_inv 2 bs n r' h1 + exact ⟨rfl, show n < 65536 by simpa using hn, hbs⟩ + | fourByte => + simp only [readPropVal] at h + obtain ⟨⟨n, r'⟩, h1, h2⟩ := Option.map_eq_some_iff.mp h + simp only [Prod.mk.injEq] at h2 + obtain ⟨hv, hr⟩ := h2 + subst hv + subst hr + obtain ⟨hn, hbs⟩ := readNat_inv 4 bs n r' h1 + exact ⟨rfl, show n < 4294967296 by simpa using hn, hbs⟩ + | varByte => + simp only [readPropVal] at h + obtain ⟨⟨n, r'⟩, h1, h2⟩ := Option.map_eq_some_iff.mp h + simp only [Prod.mk.injEq] at h2 + obtain ⟨hv, hr⟩ := h2 + subst hv + subst hr + obtain ⟨hn, hbs⟩ := decVBI_canonical bs n r' h1 + exact ⟨rfl, hn, hbs⟩ + | utf8 => + simp only [readPropVal] at h + obtain ⟨⟨s, r'⟩, h1, h2⟩ := Option.map_eq_some_iff.mp h + simp only [Prod.mk.injEq] at h2 + obtain ⟨hv, hr⟩ := h2 + subst hv + subst hr + obtain ⟨hs, hbs⟩ := readStr_inv bs s r' h1 + exact ⟨rfl, hs, hbs⟩ + | utf8Pair => + rw [readPropVal_pair_step] at h + obtain ⟨⟨k, r1⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨w, r2⟩, h2, h⟩ := Option.bind_eq_some_iff.mp h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hv, hr⟩ := h + subst hv + subst hr + obtain ⟨hk, hb1⟩ := readStr_inv bs k r1 h1 + obtain ⟨hw, hb2⟩ := readStr_inv r1 w r2 h2 + refine ⟨rfl, ⟨hk, hw⟩, ?_⟩ + rw [hb1, hb2] + show _ = (printStr k ++ printStr w) ++ _ + rw [List.append_assoc] + | binary => + simp only [readPropVal] at h + obtain ⟨⟨d, r'⟩, h1, h2⟩ := Option.map_eq_some_iff.mp h + simp only [Prod.mk.injEq] at h2 + obtain ⟨hv, hr⟩ := h2 + subst hv + subst hr + obtain ⟨hd, hbs⟩ := readBin_inv bs d r' h1 + exact ⟨rfl, hd, hbs⟩ + +/-- What the property reader accepts is the printed form of a + property that stands where it was read: allowed on the + block, of the table's type, well formed, keeping the value + rules, and not a repeat of a single use property. -/ +theorem readEntry_inv (s : PropSet) (seen : List Nat) (bs : List UInt8) + (p : Property) (r : List UInt8) (h : readEntry s seen bs = some (p, r)) : + p.id ∈ allowedOf s ∧ propTypeOf p.id = some (valType p.val) ∧ ValWF p.val + ∧ propValOK p.id p.val = true ∧ (repeatableIn s p.id = true ∨ p.id ∉ seen) + ∧ bs = printProperty p ++ r := by + rw [readEntry_step] at h + obtain ⟨⟨id, r1⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨_, hbs⟩ := decVBI_canonical bs id r1 h1 + simp only at h + by_cases hc : ((allowedOf s).contains id && (repeatableIn s id || !seen.contains id)) = true + · rw [ite_eq_left hc] at h + cases ht : propTypeOf id with + | none => rw [ht] at h; cases h + | some t => + rw [ht] at h + simp only at h + obtain ⟨⟨v, r2⟩, h2, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases hok : propValOK id v = true + · rw [ite_eq_left hok] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hp, hr⟩ := h + subst hp + subst hr + obtain ⟨hty, hval, hr1⟩ := readPropVal_inv t r1 v r2 h2 + simp only [Bool.and_eq_true, Bool.or_eq_true, Bool.not_eq_true'] at hc + refine ⟨List.contains_iff_mem.mp hc.1, by rw [ht, hty], hval, hok, ?_, ?_⟩ + · cases hc.2 with + | inl h => exact Or.inl h + | inr h => + exact Or.inr (fun hm => by rw [List.contains_iff_mem.mpr hm] at h; cases h) + · rw [hbs, hr1, printProperty, List.append_assoc] + · rw [ite_eq_right hok] at h + cases h + · rw [ite_eq_right hc] at h + cases h + +/-- What the property list reader accepts is the printed form of + a well formed list, and it reads to the end. -/ +theorem readEntriesGo_inv : ∀ (fuel : Nat) (s : PropSet) (seen : List Nat) + (bs : List UInt8) (ps : List Property) (r : List UInt8), + readEntriesGo fuel s seen bs = some (ps, r) → + r = [] ∧ PropsWF s seen ps ∧ bs = printPropsList ps := by + intro fuel + induction fuel with + | zero => + intro s seen bs ps r h + rw [readEntriesGo] at h + by_cases he : bs.isEmpty = true + · rw [ite_eq_left he] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨h1, h2⟩ := h + subst h1 + subst h2 + have : bs = [] := List.isEmpty_iff.mp he + subst this + exact ⟨rfl, trivial, rfl⟩ + · rw [ite_eq_right he] at h + cases h + | succ fuel ih => + intro s seen bs ps r h + rw [readEntriesGo] at h + by_cases he : bs.isEmpty = true + · rw [ite_eq_left he] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨h1, h2⟩ := h + subst h1 + subst h2 + have : bs = [] := List.isEmpty_iff.mp he + subst this + exact ⟨rfl, trivial, rfl⟩ + · rw [ite_eq_right he] at h + cases h1 : readEntry s seen bs with + | none => rw [h1] at h; cases h + | some pr => + obtain ⟨p, r1⟩ := pr + rw [h1] at h + simp only at h + cases h2 : readEntriesGo fuel s (p.id :: seen) r1 with + | none => rw [h2] at h; cases h + | some qr => + obtain ⟨ps', r2⟩ := qr + rw [h2] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hps, hr⟩ := h + subst hps + subst hr + obtain ⟨hid, hty, hval, hok, hrep, hbs⟩ := readEntry_inv s seen bs p r1 h1 + obtain ⟨hr2, hwf, hr1⟩ := ih s (p.id :: seen) r1 ps' r2 h2 + exact ⟨hr2, ⟨hid, hty, hval, hok, hrep, hwf⟩, by rw [hbs, hr1]; rfl⟩ + +/-- What the block insides reader accepts is the printed form of + a well formed list that keeps the block rule. -/ +theorem readEntries_inv (s : PropSet) (seg : List UInt8) (ps : List Property) + (h : readEntries s seg = some ps) : + PropsWF s [] ps ∧ authOK ps = true ∧ seg = printPropsList ps := by + unfold readEntries at h + cases h1 : readEntriesGo seg.length s [] seg with + | none => rw [h1] at h; cases h + | some pr => + obtain ⟨ps', r⟩ := pr + obtain ⟨hr, hwf, hseg⟩ := readEntriesGo_inv _ _ _ _ _ _ h1 + subst hr + rw [h1] at h + simp only at h + by_cases ha : authOK ps' = true + · rw [ite_eq_left ha] at h + simp only [Option.some.injEq] at h + subst h + exact ⟨hwf, ha, hseg⟩ + · rw [ite_eq_right ha] at h + cases h + +/-- What the property block reader accepts is the printed form + of a block fit to print, with the returned bytes after it. -/ +theorem readProps_inv (s : PropSet) (bs : List UInt8) (ps : List Property) + (r : List UInt8) (h : readProps s bs = some (ps, r)) : + PropsBlockWF s ps ∧ bs = printProps ps ++ r := by + rw [readProps_step] at h + obtain ⟨⟨len, r1⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨seg, r2⟩, h2, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨ps', h3, h⟩ := Option.bind_eq_some_iff.mp h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hp, hr⟩ := h + subst hp + subst hr + obtain ⟨hlen, hbs⟩ := decVBI_canonical bs len r1 h1 + obtain ⟨hsl, hr1⟩ := readBytes_inv len r1 seg r2 h2 + obtain ⟨hwf, hauth, hseg⟩ := readEntries_inv s seg ps' h3 + refine ⟨⟨hwf, by rw [← hseg, hsl]; exact hlen, hauth⟩, ?_⟩ + rw [hbs, hr1, printProps, ← hseg, hsl, List.append_assoc] + + +/-- What the options byte reader accepts is the printed form of + well formed options. -/ +theorem readOptsByte_inv (b : Nat) (o : SubOpts) (h : readOptsByte b = some o) : + OptsWF o ∧ (printOptsByte o).toNat = b := by + unfold readOptsByte at h + by_cases hc : b < 64 ∧ b % 4 ≠ 3 ∧ (b / 16) % 4 ≠ 3 + · rw [ite_eq_left hc] at h + simp only [Option.some.injEq] at h + subst h + refine ⟨⟨by dsimp only; omega, by dsimp only; omega⟩, ?_⟩ + unfold printOptsByte + dsimp only + by_cases h4 : (b / 4) % 2 = 1 <;> by_cases h8 : (b / 8) % 2 = 1 <;> + simp only [h4, h8, decide_true, decide_false, Bool.false_eq_true, ↓reduceIte] <;> + rw [toNat_toUInt8 (by omega)] <;> omega + · rw [ite_eq_right hc] at h + cases h + +/-- A flag bit as a number. -/ +theorem if_bit (n k m : Nat) : (if flagBit n k then m else 0) = m * (n / 2 ^ k % 2) := by + unfold flagBit + by_cases h : n / 2 ^ k % 2 = 1 + · simp [h] + · have h0 : n / 2 ^ k % 2 = 0 := by omega + simp [h0] + +/-- A clear flag bit. -/ +theorem bit_false {n k : Nat} (h : flagBit n k = false) : n / 2 ^ k % 2 = 0 := by + unfold flagBit at h + have := of_decide_eq_false h + omega + +/-- A set flag bit. -/ +theorem bit_true {n k : Nat} (h : flagBit n k = true) : n / 2 ^ k % 2 = 1 := by + unfold flagBit at h + exact of_decide_eq_true h + +/-- The connect flags byte the printer writes for a CONNECT is the + flags byte it was read from, when the fields carry the flags' + bits and the bits the printer always clears are clear. -/ +theorem flags_eq (flags : Nat) (c : Connect) (hf : flags < 256) (h0 : flags % 2 = 0) + (hu : c.username.isSome = flagBit flags 7) (hp : c.password.isSome = flagBit flags 6) + (hcs : c.cleanStart = flagBit flags 1) + (hw : c.will.isSome = flagBit flags 2) + (hws : ∀ w, c.will = some w → w.qos = (flags / 8) % 4 ∧ w.retain = flagBit flags 5) + (hwn : c.will = none → (flags / 8) % 8 = 0) : + connectFlags c = flags := by + unfold connectFlags + rw [hu, hp, hcs, if_bit flags 7 128, if_bit flags 6 64, if_bit flags 1 2] + cases hwc : c.will with + | none => + rw [hwc] at hw + have h8 := hwn hwc + have h2 := bit_false hw.symm + dsimp only + simp only [Nat.reducePow] at h2 ⊢ + omega + | some w => + rw [hwc] at hw + obtain ⟨hq, hr⟩ := hws w hwc + have h2 := bit_true hw.symm + dsimp only + rw [hq, hr, if_bit flags 5 32] + simp only [Nat.reducePow] at h2 ⊢ + omega + +/-- What the filter list reader accepts is the printed form of a + well formed filter list, and it reads to the end. -/ +theorem readFiltersGo_inv : ∀ (fuel : Nat) (bs : List UInt8) + (fs : List (List Char × SubOpts)) (r : List UInt8), + readFiltersGo fuel bs = some (fs, r) → r = [] ∧ FiltersWF fs ∧ bs = printFilters fs := by + intro fuel + induction fuel with + | zero => + intro bs fs r h + rw [readFiltersGo] at h + by_cases he : bs.isEmpty = true + · rw [ite_eq_left he] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨h1, h2⟩ := h + subst h1 + subst h2 + have : bs = [] := List.isEmpty_iff.mp he + subst this + exact ⟨rfl, trivial, rfl⟩ + · rw [ite_eq_right he] at h + cases h + | succ fuel ih => + intro bs fs r h + rw [readFiltersGo] at h + by_cases he : bs.isEmpty = true + · rw [ite_eq_left he] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨h1, h2⟩ := h + subst h1 + subst h2 + have : bs = [] := List.isEmpty_iff.mp he + subst this + exact ⟨rfl, trivial, rfl⟩ + · rw [ite_eq_right he] at h + cases h1 : readStr bs with + | none => rw [h1] at h; cases h + | some fr => + obtain ⟨f, rest⟩ := fr + cases rest with + | nil => rw [h1] at h; cases h + | cons ob r2 => + rw [h1] at h + simp only at h + cases h2 : readOptsByte ob.toNat with + | none => rw [h2] at h; cases h + | some o => + rw [h2] at h + simp only at h + by_cases hok : filterOK f o = true + · rw [ite_eq_left hok] at h + cases h3 : readFiltersGo fuel r2 with + | none => rw [h3] at h; cases h + | some qr => + obtain ⟨fs', r3⟩ := qr + rw [h3] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hfs, hr⟩ := h + subst hfs + subst hr + obtain ⟨hf, hbs⟩ := readStr_inv bs f (ob :: r2) h1 + obtain ⟨ho, hob⟩ := readOptsByte_inv ob.toNat o h2 + obtain ⟨hr3, hwf, hr2⟩ := ih r2 fs' r3 h3 + refine ⟨hr3, ⟨hf, ho, hok, hwf⟩, ?_⟩ + have hobe : printOptsByte o = ob := UInt8.toNat_inj.mp hob + rw [hbs, hr2, ← hobe] + simp [printFilters, printFilter] + · rw [ite_eq_right hok] at h + cases h + +/-- The topic name check passes only a topic name it would print. -/ +theorem checkTopic_inv {s t : List Char} (h : checkTopic s = some t) : + t = s ∧ s ≠ [] ∧ '+' ∉ s ∧ '#' ∉ s := by + unfold checkTopic at h + by_cases hc : (s.isEmpty || s.any (fun c => decide (c = '+')) + || s.any (fun c => decide (c = '#'))) = true + · rw [ite_eq_left hc] at h + cases h + · rw [ite_eq_right hc] at h + simp only [Option.some.injEq] at h + simp only [Bool.or_eq_true, not_or, Bool.not_eq_true, List.isEmpty_eq_false_iff, + List.any_eq_false, decide_eq_true_eq] at hc + obtain ⟨⟨hne, hp⟩, hh⟩ := hc + exact ⟨h.symm, hne, fun hm => hp _ hm rfl, fun hm => hh _ hm rfl⟩ + +/-- The wildcard check passes only a text with no wildcard. -/ +theorem checkNoWildcards_inv {s t : List Char} (h : checkNoWildcards s = some t) : + t = s ∧ '+' ∉ s ∧ '#' ∉ s := by + unfold checkNoWildcards at h + by_cases hc : (s.any (fun c => decide (c = '+')) + || s.any (fun c => decide (c = '#'))) = true + · rw [ite_eq_left hc] at h + cases h + · rw [ite_eq_right hc] at h + simp only [Option.some.injEq] at h + simp only [Bool.or_eq_true, not_or, Bool.not_eq_true, + List.any_eq_false, decide_eq_true_eq] at hc + obtain ⟨hp, hh⟩ := hc + exact ⟨h.symm, fun hm => hp _ hm rfl, fun hm => hh _ hm rfl⟩ + +/-- What the will step accepts: a will exactly when the will flag + is set, with the flags' QoS and retain, well formed parts, + and its printed form in front of the returned bytes. -/ +theorem readWillPart_inv (flags : Nat) (r6 : List UInt8) (will : Option Will) + (r7 : List UInt8) (h : readWillPart flags r6 = some (will, r7)) : + will.isSome = flagBit flags 2 ∧ r6 = printWillPart will ++ r7 + ∧ (∀ w, will = some w → w.qos = (flags / 8) % 4 ∧ w.retain = flagBit flags 5 + ∧ PropsBlockWF .will w.props ∧ TopicWF w.topic ∧ BinWF w.payload) := by + unfold readWillPart at h + by_cases hw : flagBit flags 2 = true + · rw [ite_eq_left hw] at h + obtain ⟨⟨wprops, s1⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨wtopic, s2⟩, h2, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨wtopic', h3, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨wpay, s3⟩, h4, h⟩ := Option.bind_eq_some_iff.mp h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hwill, hr⟩ := h + subst hwill + subst hr + obtain ⟨hps, hb1⟩ := readProps_inv .will r6 wprops s1 h1 + obtain ⟨hts, hb2⟩ := readStr_inv s1 wtopic s2 h2 + obtain ⟨ht, hne, hp, hh⟩ := checkTopic_inv h3 + subst ht + obtain ⟨hpay, hb3⟩ := readBin_inv s2 wpay s3 h4 + refine ⟨by rw [hw]; rfl, ?_, ?_⟩ + · rw [hb1, hb2, hb3] + show _ = (printProps wprops ++ (printStr wtopic' ++ printBin wpay)) ++ s3 + simp only [List.append_assoc] + · intro w hw' + simp only [Option.some.injEq] at hw' + subst hw' + exact ⟨rfl, rfl, hps, ⟨hts, hne, hp, hh⟩, hpay⟩ + · rw [ite_eq_right hw] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hwill, hr⟩ := h + subst hwill + subst hr + refine ⟨?_, rfl, fun w hw' => by cases hw'⟩ + cases hb : flagBit flags 2 + · rfl + · exact absurd hb hw + +/-- What an optional string field step accepts. -/ +theorem readOptStrField_inv (cond : Bool) (r : List UInt8) (u : Option (List Char)) + (r' : List UInt8) (h : readOptStrField cond r = some (u, r')) : + u.isSome = cond ∧ (∀ s, u = some s → StrWF s) ∧ r = printOptStr u ++ r' := by + unfold readOptStrField at h + cases cond with + | true => + rw [ite_eq_left rfl] at h + obtain ⟨⟨s, r2⟩, h1, h2⟩ := Option.map_eq_some_iff.mp h + simp only [Prod.mk.injEq] at h2 + obtain ⟨hu, hr⟩ := h2 + subst hu + subst hr + obtain ⟨hs, hbs⟩ := readStr_inv r s r2 h1 + exact ⟨rfl, fun s' hs' => by simp only [Option.some.injEq] at hs'; subst hs'; exact hs, hbs⟩ + | false => + rw [ite_eq_right (by decide)] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hu, hr⟩ := h + subst hu + subst hr + exact ⟨rfl, fun s hs => (by cases hs), rfl⟩ + +/-- What an optional binary field step accepts. -/ +theorem readOptBinField_inv (cond : Bool) (r : List UInt8) (u : Option (List UInt8)) + (r' : List UInt8) (h : readOptBinField cond r = some (u, r')) : + u.isSome = cond ∧ (∀ d, u = some d → BinWF d) ∧ r = printOptBin u ++ r' := by + unfold readOptBinField at h + cases cond with + | true => + rw [ite_eq_left rfl] at h + obtain ⟨⟨d, r2⟩, h1, h2⟩ := Option.map_eq_some_iff.mp h + simp only [Prod.mk.injEq] at h2 + obtain ⟨hu, hr⟩ := h2 + subst hu + subst hr + obtain ⟨hd, hbs⟩ := readBin_inv r d r2 h1 + exact ⟨rfl, fun d' hd' => by simp only [Option.some.injEq] at hd'; subst hd'; exact hd, hbs⟩ + | false => + rw [ite_eq_right (by decide)] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hu, hr⟩ := h + subst hu + subst hr + exact ⟨rfl, fun d hd => (by cases hd), rfl⟩ + +/-- What the CONNECT body reader accepts is the printed body of a + well formed CONNECT. -/ +theorem readConnectBody_inv (seg : List UInt8) (c : Connect) + (h : readConnectBody seg = some c) : ConnectWF c ∧ seg = printConnectBody c := by + unfold readConnectBody at h + obtain ⟨⟨proto, r1⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases hp : proto = ['M', 'Q', 'T', 'T'] + rotate_left + · rw [ite_eq_right hp] at h; cases h + rw [ite_eq_left hp] at h + obtain ⟨⟨level, r2⟩, h2, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases hl : level = 5 + rotate_left + · rw [ite_eq_right hl] at h; cases h + rw [ite_eq_left hl] at h + obtain ⟨⟨flags, r3⟩, h3, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases hf0 : flags % 2 = 0 + rotate_left + · rw [ite_eq_right hf0] at h; cases h + rw [ite_eq_left hf0] at h + by_cases hq3 : (flags / 8) % 4 ≠ 3 + rotate_left + · rw [ite_eq_right hq3] at h; cases h + rw [ite_eq_left hq3] at h + by_cases hwb : (flagBit flags 2 || decide ((flags / 8) % 8 = 0)) = true + rotate_left + · rw [ite_eq_right hwb] at h; cases h + rw [ite_eq_left hwb] at h + obtain ⟨⟨ka, r4⟩, h4, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨props, r5⟩, h5, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨cid, r6⟩, h6, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨will, r7⟩, h7, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨username, r8⟩, h8, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨password, r9⟩, h9, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases he : r9.isEmpty = true + rotate_left + · rw [ite_eq_right he] at h; cases h + rw [ite_eq_left he] at h + simp only [Option.some.injEq] at h + subst h + obtain ⟨_, hb1⟩ := readStr_inv seg proto r1 h1 + obtain ⟨_, hb2⟩ := readByte_inv r1 level r2 h2 + obtain ⟨hfl, hb3⟩ := readByte_inv r2 flags r3 h3 + obtain ⟨hka, hb4⟩ := readNat_inv 2 r3 ka r4 h4 + obtain ⟨hps, hb5⟩ := readProps_inv .connect r4 props r5 h5 + obtain ⟨hcid, hb6⟩ := readStr_inv r5 cid r6 h6 + obtain ⟨hws, hb7, hwf⟩ := readWillPart_inv flags r6 will r7 h7 + obtain ⟨hus, huwf, hb8⟩ := readOptStrField_inv _ r7 username r8 h8 + obtain ⟨hpw, hpwf, hb9⟩ := readOptBinField_inv _ r8 password r9 h9 + have hr9 : r9 = [] := List.isEmpty_iff.mp he + have hflags : connectFlags + ⟨flagBit flags 1, ka, props, cid, will, username, password⟩ = flags := by + refine flags_eq flags _ hfl hf0 hus hpw rfl hws + (fun w hw => ⟨(hwf w hw).1, (hwf w hw).2.1⟩) ?_ + intro hn + have hn' : will = none := hn + have h2f : flagBit flags 2 = false := by + rw [← hws, hn']; rfl + rw [h2f] at hwb + simpa using hwb + refine ⟨⟨by simpa using hka, hps, hcid, ?_, huwf, hpwf⟩, ?_⟩ + · intro w hw + obtain ⟨hq, _, hwp, hwt, hwpay⟩ := hwf w hw + exact ⟨by rw [hq]; omega, hwp, hwt, hwpay⟩ + · subst hr9 + subst hb9 + subst hb8 + subst hb7 + subst hb6 + subst hb5 + subst hb4 + subst hb3 + subst hb2 + subst hb1 + subst hp + subst hl + show _ = printStr ['M', 'Q', 'T', 'T'] ++ ([5, (connectFlags + ⟨flagBit flags 1, ka, props, cid, will, username, password⟩).toUInt8] + ++ (writeBE 2 ka ++ (printProps props ++ (printStr cid ++ (printWillPart will + ++ (printOptStr username ++ printOptBin password)))))) + rw [hflags] + simp only [List.cons_append, List.nil_append, List.append_nil] + rfl + + +/-- What the packet identifier step accepts: nothing at QoS 0, a + printed nonzero identifier at QoS 1 and 2. -/ +theorem readPacketId_inv (flags : Nat) (r1 : List UInt8) (pid : Option Nat) + (r2 : List UInt8) (h : readPacketId flags r1 = some (pid, r2)) : + r1 = printIdOpt pid ++ r2 + ∧ ((flags / 2) % 4 = 0 → pid = none) + ∧ ((flags / 2) % 4 ≠ 0 → ∃ id, pid = some id ∧ 1 ≤ id ∧ id < 65536) := by + unfold readPacketId at h + by_cases hq : (flags / 2) % 4 = 0 + · rw [ite_eq_left hq] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨h1, h2⟩ := h + subst h1 + subst h2 + exact ⟨rfl, fun _ => rfl, fun hn => absurd hq hn⟩ + · rw [ite_eq_right hq] at h + obtain ⟨⟨id, r⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases hid : id ≠ 0 + · rw [ite_eq_left hid] at h + simp only [Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨h2, h3⟩ := h + subst h2 + subst h3 + obtain ⟨hlt, hbs⟩ := readNat_inv 2 r1 id r h1 + exact ⟨hbs, fun hz => absurd hz hq, + fun _ => ⟨id, rfl, by omega, by simpa using hlt⟩⟩ + · rw [ite_eq_right hid] at h + cases h + +/-- What the PUBLISH body reader accepts, under flags the + dispatcher lets through, is the printed body of a well formed + PUBLISH whose header is the flags' header byte. -/ +theorem readPublishBody_inv (flags : Nat) (seg : List UInt8) (p : Publish) + (hf : flags < 16) (hq3 : ¬ (flags / 2) % 4 = 3) + (hdup : ¬ ((flags / 2) % 4 = 0 ∧ flagBit flags 3 = true)) + (h : readPublishBody flags seg = some p) : + PublishWF p ∧ seg = printPublishBody p ∧ publishHeader p = 48 + flags := by + unfold readPublishBody at h + obtain ⟨⟨topic, r1⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨topic', h2, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨pid, r2⟩, h3, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨props, payload⟩, h4, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases hc : (topic'.isEmpty && !hasTopicAlias props) = true + · rw [ite_eq_left hc] at h + cases h + rw [ite_eq_right hc] at h + simp only [Option.some.injEq] at h + subst h + obtain ⟨hstr, hb1⟩ := readStr_inv seg topic r1 h1 + obtain ⟨ht, hp, hh⟩ := checkNoWildcards_inv h2 + subst ht + obtain ⟨hb2, hq0, hqn⟩ := readPacketId_inv flags r1 pid r2 h3 + obtain ⟨hps, hb3⟩ := readProps_inv .publish r2 props payload h4 + refine ⟨⟨by dsimp only; omega, ⟨hstr, hp, hh, ?_⟩, ?_, ?_, hps, ?_⟩, ?_, ?_⟩ + · intro hnil + subst hnil + cases ha : hasTopicAlias props + · rw [ha] at hc; exact absurd rfl hc + · rfl + · intro id hid + dsimp only at hid ⊢ + by_cases hz : (flags / 2) % 4 = 0 + · rw [hq0 hz] at hid; cases hid + · obtain ⟨id', hid', h1', h2'⟩ := hqn hz + rw [hid'] at hid + simp only [Option.some.injEq] at hid + subst hid + exact ⟨h1', h2', by omega⟩ + · intro hn + dsimp only at hn ⊢ + by_cases hz : (flags / 2) % 4 = 0 + · exact hz + · obtain ⟨id', hid', _, _⟩ := hqn hz + rw [hid'] at hn; cases hn + · intro hz + dsimp only at hz ⊢ + cases hb : flagBit flags 3 + · rfl + · exact absurd ⟨hz, hb⟩ hdup + · rw [hb1, hb2, hb3] + rfl + · unfold publishHeader + dsimp only + rw [if_bit flags 3 8, if_bit flags 0 1] + simp only [Nat.reducePow] + omega + +/-- What the SUBSCRIBE body reader accepts is the printed body of + a well formed SUBSCRIBE. -/ +theorem readSubscribeBody_inv (seg : List UInt8) (p : Packet) + (h : readSubscribeBody seg = some p) : + (∃ id ps fs, p = .subscribe id ps fs) ∧ PacketFieldsWF p ∧ seg = bodyOf p := by + rw [readSubscribeBody_step] at h + obtain ⟨⟨id, r1⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases hid : id ≠ 0 + · rw [ite_eq_left hid] at h + obtain ⟨⟨props, r2⟩, h2, h⟩ := Option.bind_eq_some_iff.mp h + obtain ⟨⟨fs, r3⟩, h3, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases hc : (r3.isEmpty && !fs.isEmpty) = true + · rw [ite_eq_left hc] at h + simp only [Option.some.injEq] at h + subst h + obtain ⟨hlt, hb1⟩ := readNat_inv 2 seg id r1 h1 + obtain ⟨hps, hb2⟩ := readProps_inv .subscribe r1 props r2 h2 + obtain ⟨hr3, hfs, hb3⟩ := readFiltersGo_inv _ r2 fs r3 h3 + simp only [Bool.and_eq_true, Bool.not_eq_true'] at hc + refine ⟨⟨id, props, fs, rfl⟩, ⟨by omega, by simpa using hlt, hps, ?_, hfs⟩, ?_⟩ + · intro hn + rw [hn] at hc + exact absurd hc.2 (by decide) + · rw [hb1, hb2, hb3] + rfl + · rw [ite_eq_right hc] at h + cases h + · rw [ite_eq_right hid] at h + cases h + +/-- Reason codes read as numbers, written back, are the bytes. -/ +theorem map_toNat_toUInt8 (bs : List UInt8) : + (bs.map UInt8.toNat).map Nat.toUInt8 = bs := by + induction bs with + | nil => rfl + | cons b bs ih => + simp only [List.map_cons] + rw [byte_eq_toUInt8] + exact congrArg _ ih + +/-- What the SUBACK body reader accepts is the printed body of a + well formed SUBACK. -/ +theorem readSubackBody_inv (seg : List UInt8) (p : Packet) + (h : readSubackBody seg = some p) : + (∃ id ps rs, p = .suback id ps rs) ∧ PacketFieldsWF p ∧ seg = bodyOf p := by + rw [readSubackBody_step] at h + obtain ⟨⟨id, r1⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases hid : id ≠ 0 + · rw [ite_eq_left hid] at h + obtain ⟨⟨props, r2⟩, h2, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases hc : (!r2.isEmpty) = true + · rw [ite_eq_left hc] at h + simp only [Option.some.injEq] at h + subst h + obtain ⟨hlt, hb1⟩ := readNat_inv 2 seg id r1 h1 + obtain ⟨hps, hb2⟩ := readProps_inv .suback r1 props r2 h2 + refine ⟨⟨id, props, _, rfl⟩, ⟨by omega, by simpa using hlt, hps, ?_, ?_⟩, ?_⟩ + · intro hn + cases r2 with + | nil => exact absurd hc (by decide) + | cons a t => cases hn + · intro r hr + obtain ⟨b, _, hb⟩ := List.mem_map.mp hr + rw [← hb] + exact UInt8.toNat_lt b + · rw [hb1, hb2] + show _ = writeBE 2 id ++ (printProps props ++ (r2.map UInt8.toNat).map Nat.toUInt8) + rw [map_toNat_toUInt8] + · rw [ite_eq_right hc] at h + cases h + · rw [ite_eq_right hid] at h + cases h + +/-- What the DISCONNECT body reader accepts is the printed body of + a well formed DISCONNECT, in the form it came. -/ +theorem readDisconnectBody_inv (seg : List UInt8) (p : Packet) + (h : readDisconnectBody seg = some p) : + (∃ x, p = .disconnect x) ∧ PacketFieldsWF p ∧ seg = bodyOf p := by + cases seg with + | nil => + simp only [readDisconnectBody, Option.some.injEq] at h + subst h + exact ⟨⟨_, rfl⟩, trivial, rfl⟩ + | cons rc r1 => + unfold readDisconnectBody at h + dsimp only at h + by_cases he : r1.isEmpty = true + · rw [ite_eq_left he] at h + simp only [Option.some.injEq] at h + subst h + have : r1 = [] := List.isEmpty_iff.mp he + subst this + refine ⟨⟨_, rfl⟩, UInt8.toNat_lt rc, ?_⟩ + show _ = [rc.toNat.toUInt8] + rw [byte_eq_toUInt8] + · rw [ite_eq_right he] at h + obtain ⟨⟨props, r2⟩, h1, h⟩ := Option.bind_eq_some_iff.mp h + simp only at h + by_cases he2 : r2.isEmpty = true + · rw [ite_eq_left he2] at h + cases h + have : r2 = [] := List.isEmpty_iff.mp he2 + subst this + obtain ⟨hps, hb⟩ := readProps_inv .disconnect r1 props [] h1 + refine ⟨⟨_, rfl⟩, ⟨UInt8.toNat_lt rc, hps⟩, ?_⟩ + show _ = [rc.toNat.toUInt8] ++ printProps props + rw [byte_eq_toUInt8, hb, List.append_nil] + rfl + · rw [ite_eq_right he2] at h + cases h + + +/-- A header byte equal in value to a number is that number's + byte. -/ +theorem byte_eq_of_toNat {a b : UInt8} (h : a.toNat = b.toNat) : a = b := + UInt8.toNat_inj.mp h + +/-- What the body dispatcher accepts, under a header byte, is the + printed body of a well formed packet whose header is that + byte. -/ +theorem parseBody_inv (b : UInt8) (seg : List UInt8) (p : Packet) + (h : parseBody (b.toNat / 16) (b.toNat % 16) seg = some p) : + PacketFieldsWF p ∧ seg = bodyOf p ∧ headerOf p = b := by + have hb := UInt8.toNat_lt b + have hf : b.toNat % 16 < 16 := Nat.mod_lt _ (by decide) + generalize htyp : b.toNat / 16 = typ at h + generalize hfl : b.toNat % 16 = flags at h hf + have hbv : b.toNat = 16 * typ + flags := by omega + unfold parseBody at h + split at h + · by_cases h0 : flags = 0 + · rw [ite_eq_left h0] at h + obtain ⟨c, h1, h2⟩ := Option.map_eq_some_iff.mp h + subst h2 + obtain ⟨hwf, hseg⟩ := readConnectBody_inv seg c h1 + exact ⟨hwf, hseg, byte_eq_of_toNat (by rw [hbv, h0]; rfl)⟩ + · rw [ite_eq_right h0] at h + cases h + · by_cases hq3 : (flags / 2) % 4 = 3 + · rw [ite_eq_left hq3] at h + cases h + rw [ite_eq_right hq3] at h + by_cases hd : (flags / 2) % 4 = 0 ∧ flagBit flags 3 = true + · rw [ite_eq_left hd] at h + cases h + rw [ite_eq_right hd] at h + obtain ⟨q, h1, h2⟩ := Option.map_eq_some_iff.mp h + subst h2 + obtain ⟨hwf, hseg, hhead⟩ := readPublishBody_inv flags seg q hf hq3 hd h1 + refine ⟨hwf, hseg, byte_eq_of_toNat ?_⟩ + show (publishHeader q).toUInt8.toNat = b.toNat + rw [hhead, toNat_toUInt8 (by omega)] + omega + · by_cases h2 : flags = 2 + · rw [ite_eq_left h2] at h + obtain ⟨⟨id, ps, fs, hp⟩, hwf, hseg⟩ := readSubscribeBody_inv seg p h + subst hp + exact ⟨hwf, hseg, byte_eq_of_toNat (by rw [hbv, h2]; rfl)⟩ + · rw [ite_eq_right h2] at h + cases h + · by_cases h0 : flags = 0 + · rw [ite_eq_left h0] at h + obtain ⟨⟨id, ps, rs, hp⟩, hwf, hseg⟩ := readSubackBody_inv seg p h + subst hp + exact ⟨hwf, hseg, byte_eq_of_toNat (by rw [hbv, h0]; rfl)⟩ + · rw [ite_eq_right h0] at h + cases h + · by_cases hc : (decide (flags = 0) && seg.isEmpty) = true + · rw [ite_eq_left hc] at h + simp only [Option.some.injEq] at h + subst h + simp only [Bool.and_eq_true, decide_eq_true_eq] at hc + obtain ⟨h0, he⟩ := hc + exact ⟨trivial, List.isEmpty_iff.mp he, byte_eq_of_toNat (by rw [hbv, h0]; rfl)⟩ + · rw [ite_eq_right hc] at h + cases h + · by_cases hc : (decide (flags = 0) && seg.isEmpty) = true + · rw [ite_eq_left hc] at h + simp only [Option.some.injEq] at h + subst h + simp only [Bool.and_eq_true, decide_eq_true_eq] at hc + obtain ⟨h0, he⟩ := hc + exact ⟨trivial, List.isEmpty_iff.mp he, byte_eq_of_toNat (by rw [hbv, h0]; rfl)⟩ + · rw [ite_eq_right hc] at h + cases h + · by_cases h0 : flags = 0 + · rw [ite_eq_left h0] at h + obtain ⟨⟨x, hp⟩, hwf, hseg⟩ := readDisconnectBody_inv seg p h + subst hp + exact ⟨hwf, hseg, byte_eq_of_toNat (by rw [hbv, h0]; rfl)⟩ + · rw [ite_eq_right h0] at h + cases h + · cases h + +/-- What the stream reader accepts is the printed form of a well + formed packet, followed by the bytes it returns. -/ +theorem parsePacket_inv (bs : List UInt8) (p : Packet) (r : List UInt8) + (h : parsePacket bs = some (p, r)) : PacketWF p ∧ bs = print p ++ r := by + cases bs with + | nil => exact absurd h (by simp [parsePacket]) + | cons b r0 => + cases hd : decVBI r0 with + | none => + have : parsePacket (b :: r0) = none := by + show (decVBI r0).bind _ = none + rw [hd]; rfl + rw [this] at h + exact absurd h (by simp) + | some lr => + obtain ⟨len, r1⟩ := lr + obtain ⟨hlen, hr0⟩ := decVBI_canonical r0 len r1 hd + cases hb : readBytes len r1 with + | none => + have : parsePacket (b :: r0) = none := by + show (decVBI r0).bind _ = none + rw [hd] + show (readBytes len r1).bind _ = none + rw [hb]; rfl + rw [this] at h + exact absurd h (by simp) + | some sr => + obtain ⟨seg, r2⟩ := sr + obtain ⟨hsl, hr1⟩ := readBytes_inv len r1 seg r2 hb + have e : parsePacket (b :: r0) + = (parseBody (b.toNat / 16) (b.toNat % 16) seg).bind + (fun q => some (q, r2)) := by + show (decVBI r0).bind _ = _ + rw [hd] + show (readBytes len r1).bind _ = _ + rw [hb] + rfl + rw [e] at h + cases hp : parseBody (b.toNat / 16) (b.toNat % 16) seg with + | none => rw [hp] at h; exact absurd h (by simp) + | some q => + rw [hp] at h + simp only [Option.bind_some, Option.some.injEq, Prod.mk.injEq] at h + obtain ⟨hq, hr⟩ := h + subst hq + subst hr + obtain ⟨hwf, hseg, hhead⟩ := parseBody_inv b seg q hp + refine ⟨⟨hwf, by rw [← hseg, hsl]; exact hlen⟩, ?_⟩ + rw [hr0, hr1, ← hsl, hseg, ← hhead] + show _ = (headerOf q :: (printVBI (bodyOf q).length ++ bodyOf q)) ++ r2 + simp only [List.cons_append, List.append_assoc] + +/-- What the whole input reader accepts is exactly the printed + form of a well formed packet. -/ +theorem parse_inv (bs : List UInt8) (p : Packet) (h : parse bs = some p) : + PacketWF p ∧ print p = bs := by + unfold parse at h + cases hp : parsePacket bs with + | none => rw [hp] at h; cases h + | some pr => + obtain ⟨q, r⟩ := pr + rw [hp] at h + cases r with + | nil => + simp only [Option.some.injEq] at h + subst h + obtain ⟨hwf, hbs⟩ := parsePacket_inv bs q [] hp + exact ⟨hwf, by rw [hbs, List.append_nil]⟩ + | cons x xs => cases h + +end Mqtt.Proofs diff --git a/Proofs/SpecProofs.lean b/Proofs/SpecProofs.lean new file mode 100644 index 0000000..69afa04 --- /dev/null +++ b/Proofs/SpecProofs.lean @@ -0,0 +1,304 @@ +/- + Proofs of the statements in `Spec.lean`, under the same names. + + The round trips are the theorems proved in + `Proofs/RoundTrip.lean`, the soundness of the reader the + ones proved in `Proofs/Sound.lean`, and the statements whose + rules stand in `Spec/Defs.lean` the ones proved in + `Proofs/Rules.lean`. The example refusals are single inputs, + checked in the kernel with `decide +kernel`: no native + evaluation, which the bar forbids. +-/ + +import Mqtt +import Spec.Defs +import Proofs.RoundTrip +import Proofs.Sound +import Proofs.Rules + +open Mqtt + +theorem Spec.parsePacket_print (p : Packet) (rest : List UInt8) + (h : PacketWF p) : + parsePacket (print p ++ rest) = some (p, rest) := + Mqtt.Proofs.parsePacket_print p rest h + +theorem Spec.parse_print (p : Packet) (h : PacketWF p) : + parse (print p) = some p := + Mqtt.Proofs.parse_print p h + +theorem Spec.parse_sound (bs : List UInt8) (p : Packet) + (h : parse bs = some p) : PacketWF p ∧ print p = bs := + Mqtt.Proofs.parse_inv bs p h + +theorem Spec.parsePacket_sound (bs : List UInt8) (p : Packet) + (r : List UInt8) (h : parsePacket bs = some (p, r)) : + PacketWF p ∧ bs = print p ++ r := + Mqtt.Proofs.parsePacket_inv bs p r h + +theorem Spec.decVBI_printVBI (n : Nat) (rest : List UInt8) + (hn : n < 268435456) : + decVBI (printVBI n ++ rest) = some (n, rest) := + Mqtt.Proofs.decVBI_printVBI n rest hn + + +theorem Spec.decVBI_canonical (bs : List UInt8) (n : Nat) (r : List UInt8) + (h : decVBI bs = some (n, r)) : + n < 268435456 ∧ bs = printVBI n ++ r := + Mqtt.Proofs.decVBI_canonical bs n r h + +theorem Spec.printVBI_length (n : Nat) (hn : n < 268435456) : + (printVBI n).length = Spec.vbiSize n := + Mqtt.Proofs.printVBI_length n hn + +theorem Spec.decVBI_length (bs : List UInt8) (n : Nat) (r : List UInt8) + (h : decVBI bs = some (n, r)) : + bs.length = r.length + Spec.vbiSize n := + Mqtt.Proofs.decVBI_length bs n r h + +theorem Spec.parsePacket_frame (bs : List UInt8) (p : Packet) + (r : List UInt8) (h : parsePacket bs = some (p, r)) : + ∃ (b : UInt8) (body : List UInt8), body.length < 268435456 + ∧ bs = b :: (printVBI body.length ++ body) ++ r := + Mqtt.Proofs.parsePacket_frame bs p r h + +theorem Spec.rejects_non_minimal_remaining_length : + (parse ([192, 128, 0] : List UInt8)).isSome = false + ∧ parse ([192, 0] : List UInt8) = some .pingreq := by + decide +kernel + +/-- A writing longer than its value needs is refused in each other + place a variable byte integer stands in a packet, one example + input each, while the same packet with the shortest writing is + accepted: the property length 0 of a PUBLISH written `[128, 0]`, + the property identifier 1 (Payload Format Indicator) written + `[129, 0]`, and the Subscription Identifier value 1 of a + SUBSCRIBE written `[129, 128, 0]`. These are single inputs: no + statement here covers every input in these places. -/ +theorem Spec.rejects_non_minimal_property_vbis : + (parse ([48, 5, 0, 1, 97, 128, 0] : List UInt8)).isSome = false + ∧ (parse ([48, 4, 0, 1, 97, 0] : List UInt8)).isSome = true + ∧ (parse ([48, 7, 0, 1, 97, 3, 129, 0, 1] : List UInt8)).isSome = false + ∧ (parse ([48, 6, 0, 1, 97, 2, 1, 1] : List UInt8)).isSome = true + ∧ (parse ([130, 11, 0, 1, 3, 11, 129, 128, 0, 0, 1, 97, 0] + : List UInt8)).isSome = false + ∧ (parse ([130, 9, 0, 1, 2, 11, 1, 0, 1, 97, 0] + : List UInt8)).isSome = true := by + decide +kernel + +/-- The standard's worked table of variable byte integers + (section 1.5.5): the printer writes each boundary value as the + bytes the table gives, and the reader reads those bytes as that + value. These are single inputs; for other values the bytes are + pinned by the byte count (`Spec.printVBI_length`) and the round + trip (`Spec.decVBI_printVBI`), not by a statement of their + contents. -/ +theorem Spec.vbi_worked_table : + printVBI 0 = [0] ∧ printVBI 127 = [127] + ∧ printVBI 128 = [128, 1] ∧ printVBI 16383 = [255, 127] + ∧ printVBI 16384 = [128, 128, 1] + ∧ printVBI 2097151 = [255, 255, 127] + ∧ printVBI 2097152 = [128, 128, 128, 1] + ∧ printVBI 268435455 = [255, 255, 255, 127] + ∧ decVBI [0] = some (0, []) ∧ decVBI [127] = some (127, []) + ∧ decVBI [128, 1] = some (128, []) + ∧ decVBI [255, 127] = some (16383, []) + ∧ decVBI [128, 128, 1] = some (16384, []) + ∧ decVBI [255, 255, 127] = some (2097151, []) + ∧ decVBI [128, 128, 128, 1] = some (2097152, []) + ∧ decVBI [255, 255, 255, 127] = some (268435455, []) := by + decide +kernel + +theorem Spec.decVBI_four_byte_cap (b0 b1 b2 b3 : UInt8) (rest : List UInt8) + (h0 : 128 ≤ b0.toNat) (h1 : 128 ≤ b1.toNat) (h2 : 128 ≤ b2.toNat) + (h3 : 128 ≤ b3.toNat) : + decVBI (b0 :: b1 :: b2 :: b3 :: rest) = none := + Mqtt.Proofs.decVBI_four_byte_cap b0 b1 b2 b3 rest h0 h1 h2 h3 + +theorem Spec.parsePacket_four_byte_cap (h b0 b1 b2 b3 : UInt8) + (rest : List UInt8) + (h0 : 128 ≤ b0.toNat) (h1 : 128 ≤ b1.toNat) (h2 : 128 ≤ b2.toNat) + (h3 : 128 ≤ b3.toNat) : + parsePacket (h :: b0 :: b1 :: b2 :: b3 :: rest) = none + ∧ parse (h :: b0 :: b1 :: b2 :: b3 :: rest) = none := + Mqtt.Proofs.parsePacket_four_byte_cap h b0 b1 b2 b3 rest h0 h1 h2 h3 + +theorem Spec.parse_whole (bs : List UInt8) (p : Packet) : + parse bs = some p ↔ parsePacket bs = some (p, []) := + Mqtt.Proofs.parse_iff bs p + +theorem Spec.header_rule (bs : List UInt8) (p : Packet) (r : List UInt8) + (h : parsePacket bs = some (p, r)) : + ∃ (b : UInt8) (tl : List UInt8), bs = b :: tl ∧ b ∈ Spec.headerBytes := + Mqtt.Proofs.header_rule bs p r h + +theorem Spec.connect_rule (bs r : List UInt8) (c : Connect) + (h : parsePacket bs = some (.connect c, r)) : + (∃ (f : UInt8) (tail : List UInt8), + bs = 16 :: (printVBI (8 + tail.length) ++ ([0, 4, 77, 81, 84, 84, 5, f] ++ tail)) ++ r + ∧ Spec.ConnectFlagsRule f.toNat) + ∧ ∀ w, c.will = some w → w.topic ≠ [] ∧ Spec.TopicNameRule w.topic := + Mqtt.Proofs.connect_rule bs r c h + +theorem Spec.publish_rule (bs r : List UInt8) (m : Publish) + (h : parsePacket bs = some (.publish m, r)) : + Spec.TopicNameRule m.topic ∧ (m.topic = [] → ∃ q ∈ m.props, q.id = 0x23) + ∧ (m.packetId = none ↔ m.qos = 0) ∧ (∀ i, m.packetId = some i → i ≠ 0) := + Mqtt.Proofs.publish_rule bs r m h + +theorem Spec.subscribe_rule (bs r : List UInt8) (i : Nat) (ps : List Property) + (fs : List (List Char × SubOpts)) + (h : parsePacket bs = some (.subscribe i ps fs, r)) : + i ≠ 0 ∧ fs ≠ [] ∧ ∀ fo ∈ fs, Spec.FilterRule fo.1 fo.2 := + Mqtt.Proofs.subscribe_rule bs r i ps fs h + +theorem Spec.property_rule (bs : List UInt8) (p : Packet) (r : List UInt8) + (h : parsePacket bs = some (p, r)) : + ∀ b ∈ Spec.blocks p, Spec.BlockRule b.1 b.2 := + Mqtt.Proofs.property_rule bs r p h + +theorem Spec.empty_body_rule (bs r : List UInt8) : + (parsePacket bs = some (.pingreq, r) → bs = [192, 0] ++ r) + ∧ (parsePacket bs = some (.pingresp, r) → bs = [208, 0] ++ r) := + Mqtt.Proofs.empty_body_rule bs r + +theorem Spec.rejects_subscribe_flags : + (parse ([128, 7, 0, 1, 0, 0, 1, 97, 0] : List UInt8)).isSome + = false := by + decide +kernel + + +theorem Spec.rejects_publish_qos3 : + (parse ([54, 7, 0, 1, 97, 0, 1, 0, 120] : List UInt8)).isSome + = false := by + decide +kernel + + +theorem Spec.rejects_dup_at_qos0 : + (parse ([56, 4, 0, 1, 97, 0] : List UInt8)).isSome = false + ∧ parse ([48, 4, 0, 1, 97, 0] : List UInt8) + = some (.publish ⟨false, 0, false, ['a'], none, [], []⟩) := by + decide +kernel + + +theorem Spec.empty_topic_needs_alias : + parse ([48, 6, 0, 0, 3, 35, 0, 1] : List UInt8) + = some (.publish ⟨false, 0, false, [], none, [⟨35, .twoByte 1⟩], []⟩) + ∧ (parse ([48, 3, 0, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_wildcard_topic : + (parse ([48, 7, 0, 3, 97, 47, 35, 0, 120] : List UInt8)).isSome + = false := by + decide +kernel + + +theorem Spec.rejects_wrong_protocol_name : + (parse ([16, 14, 0, 4, 77, 81, 84, 85, 5, 2, 0, 0, 0, 0, 1, 120] + : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_reserved_connect_flag : + (parse ([16, 14, 0, 4, 77, 81, 84, 84, 5, 3, 0, 0, 0, 0, 1, 120] + : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_will_bits_without_will : + (parse ([16, 14, 0, 4, 77, 81, 84, 84, 5, 10, 0, 0, 0, 0, 1, 120] + : List UInt8)).isSome = false + ∧ (parse ([16, 14, 0, 4, 77, 81, 84, 84, 5, 34, 0, 0, 0, 0, 1, 120] + : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_property_wrong_type : + (parse ([16, 16, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 2, 11, 5, 0, + 1, 120] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_repeated_property : + (parse ([50, 12, 0, 1, 97, 0, 3, 6, 35, 0, 1, 35, 0, 2] + : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_bad_topic_filters : + -- `a/#/b`: `#` not in the last level + (parse ([130, 11, 0, 1, 0, 0, 5, 97, 47, 35, 47, 98, 0] + : List UInt8)).isSome = false + -- `a+`: `+` not alone in its level + ∧ (parse ([130, 8, 0, 1, 0, 0, 2, 97, 43, 0] : List UInt8)).isSome = false + -- the empty filter + ∧ (parse ([130, 6, 0, 1, 0, 0, 0, 0] : List UInt8)).isSome = false + -- `$share/g/t` with No Local set + ∧ (parse ([130, 16, 0, 1, 0, 0, 10, 36, 115, 104, 97, 114, 101, 47, 103, + 47, 116, 4] : List UInt8)).isSome = false + -- `$share/g`: no `/` and filter after the ShareName + ∧ (parse ([130, 14, 0, 1, 0, 0, 8, 36, 115, 104, 97, 114, 101, 47, 103, 0] + : List UInt8)).isSome = false + -- `a/+/#` is accepted + ∧ parse ([130, 11, 0, 1, 0, 0, 5, 97, 47, 43, 47, 35, 0] : List UInt8) + = some (.subscribe 1 [] [(['a', '/', '+', '/', '#'], ⟨0, false, false, 0⟩)]) + -- `$share/g/t` with No Local clear is accepted + ∧ parse ([130, 16, 0, 1, 0, 0, 10, 36, 115, 104, 97, 114, 101, 47, 103, 47, + 116, 0] : List UInt8) + = some (.subscribe 1 [] + [(['$', 's', 'h', 'a', 'r', 'e', '/', 'g', '/', 't'], + ⟨0, false, false, 0⟩)]) := by + decide +kernel + + +theorem Spec.rejects_subscribe_id_zero : + (parse ([130, 7, 0, 0, 0, 0, 1, 97, 0] : List UInt8)).isSome + = false := by + decide +kernel + + +theorem Spec.rejects_property_value_rules : + -- Subscription Identifier 0, on a SUBSCRIBE + (parse ([130, 9, 0, 1, 2, 11, 0, 0, 1, 97, 0] : List UInt8)).isSome = false + -- Topic Alias 0, on a PUBLISH + ∧ (parse ([48, 7, 0, 1, 97, 3, 35, 0, 0] : List UInt8)).isSome = false + -- Receive Maximum 0, on a CONNECT + ∧ (parse ([16, 17, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 3, 33, 0, 0, 0, 1, + 120] : List UInt8)).isSome = false + -- Maximum Packet Size 0, on a CONNECT + ∧ (parse ([16, 19, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 5, 39, 0, 0, 0, 0, 0, + 1, 120] : List UInt8)).isSome = false + -- Request Problem Information 2, on a CONNECT + ∧ (parse ([16, 16, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 2, 23, 2, 0, 1, 120] + : List UInt8)).isSome = false + -- Request Response Information 2, on a CONNECT + ∧ (parse ([16, 16, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 2, 25, 2, 0, 1, 120] + : List UInt8)).isSome = false + -- Authentication Data with no Authentication Method, on a CONNECT + ∧ (parse ([16, 17, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 3, 22, 0, 0, 0, 1, + 120] : List UInt8)).isSome = false + -- Response Topic `#`, on a PUBLISH + ∧ (parse ([48, 8, 0, 1, 97, 4, 8, 0, 1, 35] : List UInt8)).isSome = false + -- an empty Response Topic, on a PUBLISH + ∧ (parse ([48, 7, 0, 1, 97, 3, 8, 0, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.disconnect_short_form : + parse ([224, 1, 0] : List UInt8) = some (.disconnect (some (0, none))) + ∧ print (.disconnect (some (0, none))) = [224, 1, 0] + ∧ parse ([224, 2, 0, 0] : List UInt8) + = some (.disconnect (some (0, some []))) + ∧ print (.disconnect (some (0, some []))) = [224, 2, 0, 0] := by + decide +kernel + + +theorem Spec.rejects_pingreq_body : + (parse ([192, 1, 0] : List UInt8)).isSome = false := by + decide +kernel + + +theorem Spec.rejects_unknown_type : + (parse ([32, 0] : List UInt8)).isSome = false := by + decide +kernel diff --git a/Proofs/Utf8.lean b/Proofs/Utf8.lean new file mode 100644 index 0000000..f52f72b --- /dev/null +++ b/Proofs/Utf8.lean @@ -0,0 +1,149 @@ +/- + Proofs for the strict UTF-8 codec in Mqtt/Utf8.lean: the one + claim the packet round trip needs is that decoding the + encoding of any text gives the text back. + + Copied with the codec from Proven-Commons/jws#2, a draft pull + request that is not merged, and adapted here: the namespace is + renamed, and a local `toNat_toUInt8` lemma stands in for the + jws Base64 import. The proof is checked in this repo. +-/ + +import Mqtt.Utf8 + +namespace Mqtt.Utf8.Proofs + +open Mqtt.Utf8 + +/-- A number below 256 written as a byte reads back as itself. -/ +theorem toNat_toUInt8 {k : Nat} (h : k < 256) : k.toUInt8.toNat = k := by + simp; omega + +/-- A character value is below 110000, and no character value + lies in the surrogate gap D800 to DFFF: the Unicode scalar + range every `Char` lives in. -/ +theorem char_bounds (c : Char) : + c.toNat < 0x110000 ∧ ¬ (0xD800 ≤ c.toNat ∧ c.toNat < 0xE000) := by + have h := c.valid + show c.val.toNat < 0x110000 ∧ ¬ (0xD800 ≤ c.val.toNat ∧ c.val.toNat < 0xE000) + rcases h with h | ⟨h1, h2⟩ + · exact ⟨by omega, by omega⟩ + · exact ⟨by omega, by omega⟩ + +/-- A byte whose value is known to be a continuation byte reads + back as its payload value. -/ +theorem contVal_of_toNat {b : UInt8} {k : Nat} (h : b.toNat = 0x80 + k) (hk : k < 64) : + contVal b = some k := by + unfold contVal + rw [h, ite_eq_left ⟨by omega, by omega⟩, Nat.add_sub_cancel_left] + +/-- One step of the decoder on a plain byte. -/ +theorem decode_one (b : UInt8) (bs : List UInt8) (hb : b.toNat < 0x80) : + decode (b :: bs) = (decode bs).map (Char.ofNat b.toNat :: ·) := by + cases bs with + | nil => rw [decode.eq_3, ite_eq_left hb] + | cons b1 bs' => rw [decode.eq_2, ite_eq_left hb] + +/-- One step of the decoder on a two byte form. -/ +theorem decode_two (b b1 : UInt8) (bs : List UInt8) (v : Nat) + (hb : 0xC2 ≤ b.toNat ∧ b.toNat < 0xE0) (hv : contVal b1 = some v) : + decode (b :: b1 :: bs) = + (decode bs).map (Char.ofNat ((b.toNat - 0xC0) * 64 + v) :: ·) := by + rw [decode.eq_2, ite_eq_right (by omega : ¬ b.toNat < 0x80), + ite_eq_right (by omega : ¬ b.toNat < 0xC2), ite_eq_left (by omega : b.toNat < 0xE0), hv] + +/-- One step of the decoder on a three byte form. -/ +theorem decode_three (b b1 b2 : UInt8) (bs : List UInt8) (v1 v2 : Nat) + (hb : 0xE0 ≤ b.toNat ∧ b.toNat < 0xF0) + (hside : (b.toNat = 0xE0 → 0x20 ≤ v1) ∧ (b.toNat = 0xED → v1 < 0x20)) + (hv1 : contVal b1 = some v1) (hv2 : contVal b2 = some v2) : + decode (b :: b1 :: b2 :: bs) = + (decode bs).map (Char.ofNat ((b.toNat - 0xE0) * 4096 + v1 * 64 + v2) :: ·) := by + rw [decode.eq_2, ite_eq_right (by omega : ¬ b.toNat < 0x80), + ite_eq_right (by omega : ¬ b.toNat < 0xC2), ite_eq_right (by omega : ¬ b.toNat < 0xE0), + ite_eq_left (by omega : b.toNat < 0xF0)] + dsimp only + rw [hv1, hv2] + dsimp only + rw [ite_eq_left hside] + +/-- One step of the decoder on a four byte form. -/ +theorem decode_four (b b1 b2 b3 : UInt8) (bs : List UInt8) (v1 v2 v3 : Nat) + (hb : 0xF0 ≤ b.toNat ∧ b.toNat < 0xF5) + (hside : (b.toNat = 0xF0 → 0x10 ≤ v1) ∧ (b.toNat = 0xF4 → v1 < 0x10)) + (hv1 : contVal b1 = some v1) (hv2 : contVal b2 = some v2) + (hv3 : contVal b3 = some v3) : + decode (b :: b1 :: b2 :: b3 :: bs) = + (decode bs).map + (Char.ofNat ((b.toNat - 0xF0) * 262144 + v1 * 4096 + v2 * 64 + v3) :: ·) := by + rw [decode.eq_2, ite_eq_right (by omega : ¬ b.toNat < 0x80), + ite_eq_right (by omega : ¬ b.toNat < 0xC2), ite_eq_right (by omega : ¬ b.toNat < 0xE0), + ite_eq_right (by omega : ¬ b.toNat < 0xF0), ite_eq_left (by omega : b.toNat < 0xF5)] + dsimp only + rw [hv1, hv2, hv3] + dsimp only + rw [ite_eq_left hside] + +/-- Decoding one encoded character in front of any bytes decodes + the character and then the bytes. The four cases are the + four lengths; each one applies the step lemma for its + length, checks the side conditions with arithmetic, and + rebuilds the character value. -/ +theorem decode_append_char (c : Char) (bs : List UInt8) : + decode (encodeChar c ++ bs) = (decode bs).map (c :: ·) := by + obtain ⟨hmax, hnsur⟩ := char_bounds c + by_cases h1 : c.toNat < 0x80 + · rw [encodeChar, ite_eq_left h1, List.cons_append, List.nil_append, + decode_one _ _ (by rw [toNat_toUInt8 (by omega)]; exact h1), + toNat_toUInt8 (by omega), Char.ofNat_toNat] + · rw [encodeChar, ite_eq_right h1] + by_cases h2 : c.toNat < 0x800 + · have hlead : (0xC0 + c.toNat / 64).toUInt8.toNat = 0xC0 + c.toNat / 64 := + toNat_toUInt8 (by omega) + rw [ite_eq_left h2, List.cons_append, List.cons_append, List.nil_append, + decode_two _ _ _ _ ⟨by omega, by omega⟩ + (contVal_of_toNat (toNat_toUInt8 (by omega)) (Nat.mod_lt _ (by decide))), + hlead, + show (0xC0 + c.toNat / 64 - 0xC0) * 64 + c.toNat % 64 = c.toNat by omega, + Char.ofNat_toNat] + · rw [ite_eq_right h2] + by_cases h3 : c.toNat < 0x10000 + · have hlead : (0xE0 + c.toNat / 4096).toUInt8.toNat = 0xE0 + c.toNat / 4096 := + toNat_toUInt8 (by omega) + rw [ite_eq_left h3, List.cons_append, List.cons_append, List.cons_append, + List.nil_append, + decode_three _ _ _ _ _ _ ⟨by omega, by omega⟩ + ⟨fun hb => by rw [hlead] at hb; omega, + fun hb => by rw [hlead] at hb; omega⟩ + (contVal_of_toNat (toNat_toUInt8 (by omega)) (Nat.mod_lt _ (by decide))) + (contVal_of_toNat (toNat_toUInt8 (by omega)) (Nat.mod_lt _ (by decide))), + hlead, + show (0xE0 + c.toNat / 4096 - 0xE0) * 4096 + (c.toNat / 64) % 64 * 64 + + c.toNat % 64 = c.toNat by omega, + Char.ofNat_toNat] + · have hlead : (0xF0 + c.toNat / 262144).toUInt8.toNat = 0xF0 + c.toNat / 262144 := + toNat_toUInt8 (by omega) + rw [ite_eq_right h3, List.cons_append, List.cons_append, List.cons_append, + List.cons_append, List.nil_append, + decode_four _ _ _ _ _ _ _ _ ⟨by omega, by omega⟩ + ⟨fun hb => by rw [hlead] at hb; omega, + fun hb => by rw [hlead] at hb; omega⟩ + (contVal_of_toNat (toNat_toUInt8 (by omega)) (Nat.mod_lt _ (by decide))) + (contVal_of_toNat (toNat_toUInt8 (by omega)) (Nat.mod_lt _ (by decide))) + (contVal_of_toNat (toNat_toUInt8 (by omega)) (Nat.mod_lt _ (by decide))), + hlead, + show (0xF0 + c.toNat / 262144 - 0xF0) * 262144 + (c.toNat / 4096) % 64 * 4096 + + (c.toNat / 64) % 64 * 64 + c.toNat % 64 = c.toNat by omega, + Char.ofNat_toNat] + +/-- Decoding the encoding of any text gives the text back. -/ +theorem decode_encode : ∀ cs : List Char, decode (encode cs) = some cs := by + intro cs + induction cs with + | nil => rfl + | cons c cs ih => + show decode (encodeChar c ++ encode cs) = some (c :: cs) + rw [decode_append_char, ih] + rfl + +end Mqtt.Utf8.Proofs diff --git a/Proofs/Utf8Inv.lean b/Proofs/Utf8Inv.lean new file mode 100644 index 0000000..f31c29f --- /dev/null +++ b/Proofs/Utf8Inv.lean @@ -0,0 +1,164 @@ +/- + The other direction of the strict UTF-8 codec: what the decoder + accepts is the encoding of the text it returns. Together with + `Mqtt.Utf8.Proofs.decode_encode` in `Proofs/Utf8.lean`, the + decoder is exactly the inverse of the encoder. The packet + reader's soundness (`Proofs/Sound.lean`) rests on it for every + string field. +-/ + +import Proofs.Utf8 + +namespace Mqtt.Utf8.Proofs + +open Mqtt.Utf8 + +/-- A number in the Unicode scalar range, outside the surrogate + gap, is the value of the character it names. -/ +theorem char_ofNat_toNat (n : Nat) (h : n < 0xD800 ∨ (0xDFFF < n ∧ n < 0x110000)) : + (Char.ofNat n).toNat = n := by + unfold Char.ofNat + rw [dite_eq_left h] + simp [Char.ofNatAux, Char.toNat, UInt32.toNat_ofNatLT] + +/-- What a continuation byte's payload says about the byte. -/ +theorem contVal_inv {b : UInt8} {v : Nat} (h : contVal b = some v) : + b.toNat = 0x80 + v ∧ v < 64 := by + unfold contVal at h + by_cases hc : 0x80 ≤ b.toNat ∧ b.toNat < 0xC0 + · rw [ite_eq_left hc] at h + simp only [Option.some.injEq] at h + omega + · rw [ite_eq_right hc] at h + cases h + +/-- A number equal to a byte's value, written as a byte, is that + byte. -/ +theorem byte_of_toNat {b : UInt8} {n : Nat} (h : b.toNat = n) : n.toUInt8 = b := by + rw [← h]; exact UInt8.ofNat_toNat + +/-- The encoding of a text with a first character. -/ +theorem encode_cons (c : Char) (cs : List Char) : + encode (c :: cs) = encodeChar c ++ encode cs := by + simp [encode, List.flatMap_cons] + +/-- What the strict decoder accepts is the encoding of the text + it returns. -/ +theorem decode_inv (bs : List UInt8) : ∀ (cs : List Char), + decode bs = some cs → encode cs = bs := by + induction bs using decode.induct with + | case1 => + intro cs h + rw [decode.eq_1] at h + simp only [Option.some.injEq] at h + subst h; rfl + | case2 b rest hb ih => + intro cs h + rw [decode_one b rest hb] at h + obtain ⟨cs', h1, h2⟩ := Option.map_eq_some_iff.mp h + subst h2 + rw [encode_cons, ih cs' h1] + have hn := char_ofNat_toNat b.toNat (Or.inl (by omega)) + unfold encodeChar + simp only [hn] + rw [ite_eq_left hb, byte_of_toNat rfl] + rfl + | case4 b h1 h2 h3 b1 rest1 v1 hv1 ih => + intro cs h + obtain ⟨hb1, hv⟩ := contVal_inv hv1 + rw [decode_two b b1 rest1 v1 ⟨by omega, h3⟩ hv1] at h + obtain ⟨cs', h1', h2'⟩ := Option.map_eq_some_iff.mp h + subst h2' + rw [encode_cons, ih cs' h1'] + have hn := char_ofNat_toNat ((b.toNat - 0xC0) * 64 + v1) (Or.inl (by omega)) + unfold encodeChar + simp only [hn] + rw [ite_eq_right (by omega), ite_eq_left (by omega), + byte_of_toNat (by omega : b.toNat = 0xC0 + ((b.toNat - 0xC0) * 64 + v1) / 64), + byte_of_toNat (by omega : b1.toNat = 0x80 + ((b.toNat - 0xC0) * 64 + v1) % 64)] + rfl + | case7 b h1 h2 h3 h4 b1 b2 rest1 v1 v2 hv2 hv1 hside ih => + intro cs h + obtain ⟨hb1, hv1'⟩ := contVal_inv hv1 + obtain ⟨hb2, hv2'⟩ := contVal_inv hv2 + rw [decode_three b b1 b2 rest1 v1 v2 ⟨by omega, h4⟩ hside hv1 hv2] at h + obtain ⟨cs', h1', h2'⟩ := Option.map_eq_some_iff.mp h + subst h2' + rw [encode_cons, ih cs' h1'] + obtain ⟨hs1, hs2⟩ := hside + have hn := char_ofNat_toNat ((b.toNat - 0xE0) * 4096 + v1 * 64 + v2) (by + by_cases he : b.toNat = 0xE0 + · have := hs1 he; omega + · by_cases hd : b.toNat = 0xED + · have := hs2 hd; omega + · by_cases hl : b.toNat < 0xED + · omega + · omega) + have hlow : 0x800 ≤ (b.toNat - 0xE0) * 4096 + v1 * 64 + v2 := by + by_cases he : b.toNat = 0xE0 + · have := hs1 he; omega + · omega + unfold encodeChar + simp only [hn] + rw [ite_eq_right (by omega), ite_eq_right (by omega), ite_eq_left (by omega), + byte_of_toNat (by omega : + b.toNat = 0xE0 + ((b.toNat - 0xE0) * 4096 + v1 * 64 + v2) / 4096), + byte_of_toNat (by omega : + b1.toNat = 0x80 + ((b.toNat - 0xE0) * 4096 + v1 * 64 + v2) / 64 % 64), + byte_of_toNat (by omega : + b2.toNat = 0x80 + ((b.toNat - 0xE0) * 4096 + v1 * 64 + v2) % 64)] + rfl + | case11 b h1 h2 h3 h4 h5 b1 b2 b3 rest1 v1 v2 v3 hv3 hv2 hv1 hside ih => + intro cs h + obtain ⟨hb1, hv1'⟩ := contVal_inv hv1 + obtain ⟨hb2, hv2'⟩ := contVal_inv hv2 + obtain ⟨hb3, hv3'⟩ := contVal_inv hv3 + rw [decode_four b b1 b2 b3 rest1 v1 v2 v3 ⟨by omega, h5⟩ hside hv1 hv2 hv3] at h + obtain ⟨cs', h1', h2'⟩ := Option.map_eq_some_iff.mp h + subst h2' + rw [encode_cons, ih cs' h1'] + obtain ⟨hs1, hs2⟩ := hside + have hlow : 0x10000 ≤ (b.toNat - 0xF0) * 262144 + v1 * 4096 + v2 * 64 + v3 := by + by_cases he : b.toNat = 0xF0 + · have := hs1 he; omega + · omega + have hhigh : (b.toNat - 0xF0) * 262144 + v1 * 4096 + v2 * 64 + v3 < 0x110000 := by + by_cases he : b.toNat = 0xF4 + · have := hs2 he; omega + · omega + have hn := char_ofNat_toNat ((b.toNat - 0xF0) * 262144 + v1 * 4096 + v2 * 64 + v3) + (Or.inr ⟨by omega, hhigh⟩) + unfold encodeChar + simp only [hn] + rw [ite_eq_right (by omega), ite_eq_right (by omega), ite_eq_right (by omega), + byte_of_toNat (by omega : + b.toNat = 0xF0 + ((b.toNat - 0xF0) * 262144 + v1 * 4096 + v2 * 64 + v3) / 262144), + byte_of_toNat (by omega : + b1.toNat = 0x80 + ((b.toNat - 0xF0) * 262144 + v1 * 4096 + v2 * 64 + v3) / 4096 % 64), + byte_of_toNat (by omega : + b2.toNat = 0x80 + ((b.toNat - 0xF0) * 262144 + v1 * 4096 + v2 * 64 + v3) / 64 % 64), + byte_of_toNat (by omega : + b3.toNat = 0x80 + ((b.toNat - 0xF0) * 262144 + v1 * 4096 + v2 * 64 + v3) % 64)] + rfl + | case8 b h1 h2 h3 h4 b1 b2 rest1 v1 v2 hv2 hv1 hside => + intro cs h + rw [decode.eq_def] at h + simp only [hv1, hv2] at h + rw [ite_eq_right h1, ite_eq_right h2, ite_eq_right h3, ite_eq_left h4, + ite_eq_right hside] at h + cases h + | case12 b h1 h2 h3 h4 h5 b1 b2 b3 rest1 v1 v2 v3 hv3 hv2 hv1 hside => + intro cs h + rw [decode.eq_def] at h + simp only [hv1, hv2, hv3] at h + rw [ite_eq_right h1, ite_eq_right h2, ite_eq_right h3, ite_eq_right h4, + ite_eq_left h5, ite_eq_right hside] at h + cases h + | _ => + intro cs h + rw [decode.eq_def] at h + simp only at h + repeat' (split at h) + all_goals (first | (simp_all; done) | (simp_all; omega) | omega | (exfalso; simp_all)) + +end Mqtt.Utf8.Proofs diff --git a/README.md b/README.md index 6d3fa52..4a0062f 100644 --- a/README.md +++ b/README.md @@ -1,35 +1,327 @@ -# mqtt +# mqtt: an MQTT 5.0 packet reader and printer, with a proved round trip -A Lean parser for MQTT 5.0 packet framing. This is a Proven Commons project: it rebuilds a widely used format in Lean and proves the new code follows its written specification. +Status: in progress -Status: not verified. No code has landed yet. Plan issue 1 holds the first slice, and it is unclaimed. The specification has not been approved by a reviewer, so do not call this verified. +An MQTT 5.0 control packet reader and printer in Lean, +covering the seven packet types CONNECT, PUBLISH, SUBSCRIBE, +SUBACK, PINGREQ, PINGRESP, and DISCONNECT, with their +property blocks. The reader reads one packet from the front +of a byte list and returns the rest of the input, so a +caller can walk a stream of packets. The definitions are in +`Mqtt/Value.lean` (the packet types, the property table, +the printer, and the well-formedness rules), `Mqtt/Parse.lean` +(the reader), and `Mqtt/Utf8.lean` (a strict UTF-8 codec, +copied from Proven-Commons/jws#2, a draft pull request not +yet merged, with its namespace renamed; its proof is +included here as `Proofs/Utf8.lean`). The +rules are written out in `SPEC.md`. This slice is framing +only: no broker, no client, and no session behaviour. -## First slice +The statements a reviewer approves are in `Spec.lean`, +with their proofs in `Proofs/SpecProofs.lean`. No reviewer +has approved them yet, so this project is not called +verified. -MQTT 5.0 packets over TCP. Fixed header, remaining length as a variable byte integer capped at four bytes, and packet types CONNECT, PUBLISH, SUBSCRIBE, SUBACK, PINGREQ, PINGRESP, and DISCONNECT first. Properties are parsed per packet type. A property on a packet type that does not allow it is rejected. +## How to run it -This is distinct from the websocket repo. MQTT can run over websockets as a transport, but this slice is MQTT packets over TCP, not websocket frames. +`lake build` builds the library, the proofs, and the +command line tool. The tool reads one request per line: +the word `parse`, a space, and the packet as +comma-separated decimal byte codes. It answers `ok:` and +the byte codes of the canonical reprint when the bytes are +one packet, `none` when they are rejected, and `error` when +the request itself is malformed. -## Main claim +``` +lake build +echo "parse 192,0" | .lake/build/bin/mqtt +``` -Decoding an encoding gives the same packet back. The decoder returns an error instead of reading past the end of its input. A variable byte integer longer than four bytes is rejected. +That request is a PINGREQ, and the answer is `ok:192,0`: the +packet read back and reprinted. A PINGREQ carrying a body +(`parse 192,1,0`) answers `none`. See `SPEC.md` for the full +protocol. -## Test oracles +`python3 tests/run_tests.py` rebuilds the tool, runs the +fixed cases, the differential run against the harness +oracle, the Paho cross-check when the library is +importable, the mutation and rejection cases, and random +packets of each forbidden class drawn from the seed, and +writes the outcome to `tests/TEST-RESULTS.md`: the +oracle, the seed, the input count and the failures. -- Eclipse Paho clients. -- The Mosquitto broker test suite. -- MQTT 5.0 specification test material. +`python3 tests/plant_bugs.py` plants small bugs in the +reader and its rules, one at a time in a scratch copy of +the repo: a five byte cap, longer writings of a variable +byte integer accepted, short input padded with zeros, +partial weakenings of the filter and value rules, and +more. For each it names the approved statement the plant +makes false, checks that the test harness reports a +failure and that the proofs no longer build, and writes +the outcome to `tests/PLANTED-BUGS.md`. -## Score +## What is proved -16 out of 18, first pass score in mission issue 19, the round 4 sheet. Created at the org owner's direction on that sheet, on the judgement that the slice, claim, and oracles are sound and that it duplicates no existing repo. +Each claim below names the theorem behind it. The +theorems are stated in `Spec.lean` (the challenge file, +where they end in `sorry`) and proved in +`Proofs/SpecProofs.lean`, under the same names. +`comparator.json` lists all of them. A claim that names +its input, or says "one example input", is a theorem +about that input alone, which a reader can check by +evaluation; the rule it illustrates is stated for every +input by the theorem it names after "every input". The +rules those theorems state are written in +`Spec/Defs.lean`, one of the spec files an approval +covers. -## What is not in this slice +| Claim | Theorem | +|-------|---------| +| Parsing the printed form of a well formed packet, with more stream bytes after it, gives the packet and those bytes back. | `Spec.parsePacket_print` | +| Parsing the printed form of a well formed packet on its own gives the packet back. | `Spec.parse_print` | +| Every packet the whole input reader `parse` accepts is well formed, and printing it gives back exactly the bytes it read. With the row above, `parse` accepts a byte list exactly when it is the printing of a well formed packet, and refuses every other byte list. | `Spec.parse_sound` | +| Every packet the stream reader `parsePacket` takes from the front of a byte list is well formed, and the bytes it took are exactly its printing, followed by the bytes it returns: it never takes a byte the input does not hold. | `Spec.parsePacket_sound` | +| Reading a printed variable byte integer gives the number back, for every value below 2^28. | `Spec.decVBI_printVBI` | +| What the variable byte integer reader `decVBI` accepts is exactly the printer's writing of the value it returns, followed by the bytes it returns; the value is below 2^28. So each value has one writing the reader accepts. | `Spec.decVBI_canonical` | +| The printer writes every value below 2^28 in `Spec.vbiSize` bytes, the fewest that carry it: one byte below 2^7, two below 2^14, three below 2^21, four below 2^28 (`Spec.vbiSize` is written in `Spec/Defs.lean`). | `Spec.printVBI_length` | +| For every input, what `decVBI` accepts uses exactly `Spec.vbiSize` bytes for the value it returns. So a writing longer than the value needs, such as 128, 0 for 0 or 128, 129, 0 for 128, is refused (section 1.5.5, MQTT-1.5.5-1). | `Spec.decVBI_length` | +| Every packet the stream reader `parsePacket` takes is a header byte, the printer's writing of the body length (the shortest, by the row above), and that many body bytes, all standing in the input; the bytes it returns are exactly the ones after them. | `Spec.parsePacket_frame` | +| The packet 192, 128, 0 (a PINGREQ whose remaining length 0 is written in two bytes) is refused, while 192, 0 is the PINGREQ (every input: `Spec.decVBI_length` with `Spec.parsePacket_frame`). | `Spec.rejects_non_minimal_remaining_length` | +| A writing longer than the value needs is refused in the other places a variable byte integer stands, one example input each: the PUBLISH 48, 5, 0, 1, 97, 128, 0 (property length 0 written 128, 0), the PUBLISH 48, 7, 0, 1, 97, 3, 129, 0, 1 (property identifier 1 written 129, 0), and the SUBSCRIBE 130, 11, 0, 1, 3, 11, 129, 128, 0, 0, 1, 97, 0 (Subscription Identifier 1 written 129, 128, 0); the same packets with the shortest writing are accepted. No statement covers every input in these places (see What is not proved). | `Spec.rejects_non_minimal_property_vbis` | +| The printer writes each value of the standard's worked table in section 1.5.5 as the bytes the table gives: 0 as 0, 127 as 127, 128 as 128, 1, 16383 as 255, 127, 16384 as 128, 128, 1, 2097151 as 255, 255, 127, 2097152 as 128, 128, 128, 1, and 268435455 as 255, 255, 255, 127; and `decVBI` reads each of those writings as its value. These rows only. | `Spec.vbi_worked_table` | +| The variable byte integer reader `decVBI` refuses every input whose first four bytes all carry a continuation mark, whatever follows: the value would need a fifth byte, and four is the limit. | `Spec.decVBI_four_byte_cap` | +| A packet whose remaining length has a continuation mark on each of its first four bytes is refused, by the stream reader `parsePacket` and by the whole input reader `parse`, whatever the header byte and whatever follows. | `Spec.parsePacket_four_byte_cap` | +| The whole input reader `parse` accepts a byte list, and returns a packet, exactly when the stream reader `parsePacket` takes that packet from it and leaves no byte after it. So each rule below, stated for `parsePacket`, holds for `parse` too. | `Spec.parse_whole` | +| For every input, each packet `parsePacket` takes starts with one of the sixteen header bytes of `Spec.headerBytes`: 0x10, 0x30 to 0x35, 0x3A to 0x3D, 0x82, 0x90, 0xC0, 0xD0 and 0xE0. So a SUBSCRIBE whose flags are not 0010, another type whose flags are not 0000, a PUBLISH with QoS 3 or with DUP set at QoS 0, and every packet type outside the seven of this slice are refused. | `Spec.header_rule` | +| For every input, each CONNECT `parsePacket` takes is the byte 0x10, the body length, and a body that starts with the protocol name `MQTT` (0, 4, 77, 81, 84, 84), the level 5, and a connect flags byte that keeps `Spec.ConnectFlagsRule`: the reserved bit 0 clear, a will QoS other than 3, and, when the will flag is clear, the will QoS and will retain bits clear. A will topic is not empty and holds no `+` or `#`. | `Spec.connect_rule` | +| For every input, each PUBLISH `parsePacket` takes has a topic name with no `+` or `#`, which is empty only when its properties carry a Topic Alias; its packet identifier stands exactly when the QoS is not 0, and is never 0. | `Spec.publish_rule` | +| For every input, each SUBSCRIBE `parsePacket` takes has a packet identifier other than 0 and at least one topic filter, and each filter keeps `Spec.FilterRule`. A filter is not empty; split at each `/`, a level that holds `+` is `+` alone, and a level that holds `#` is `#` alone and the last level. A filter that starts with `$share/` has a ShareName of at least one character with no `/`, `+` or `#`, then a `/` and a filter that keeps those rules, and its No Local option is clear. | `Spec.subscribe_rule` | +| For every input, every property block of every packet `parsePacket` takes keeps `Spec.BlockRule`. Each property is allowed on its block (Table 2-4) and has its identifier's value type. Each value keeps the value rules: no Subscription Identifier, Topic Alias, Receive Maximum or Maximum Packet Size of 0, a Request Problem Information and Request Response Information of 0 or 1, and a Response Topic that is not empty and holds no `+` or `#`. No single use property repeats in a block, and Authentication Data stands only with an Authentication Method. | `Spec.property_rule` | +| For every input, each PINGREQ `parsePacket` takes is the two bytes 192, 0, and each PINGRESP the two bytes 208, 0. | `Spec.empty_body_rule` | +| The SUBSCRIBE 128, 7, 0, 1, 0, 0, 1, 97, 0, whose flags are 0000 rather than the 0010 the standard fixes, is refused (one example input; every input: `Spec.header_rule`). | `Spec.rejects_subscribe_flags` | +| A PUBLISH with the reserved QoS value 3 is refused (one example input, header 0x36; every input: `Spec.header_rule`). | `Spec.rejects_publish_qos3` | +| A PUBLISH with the DUP flag set at QoS 0 is refused: here the packet 56, 4, 0, 1, 97, 0 (header 0x38). The same packet with header 0x30 is accepted (every input: `Spec.header_rule`). | `Spec.rejects_dup_at_qos0` | +| A PUBLISH with an empty topic name and a Topic Alias (here 48, 6, 0, 0, 3, 35, 0, 1, alias 1) is accepted, and the same packet with no Topic Alias (48, 3, 0, 0, 0) is refused (every input: `Spec.publish_rule`). | `Spec.empty_topic_needs_alias` | +| A PUBLISH whose topic name is `a/#` is refused (one example input; every input: `Spec.publish_rule`). | `Spec.rejects_wildcard_topic` | +| A CONNECT whose protocol name is `MQTU`, not `MQTT`, is refused (one example input; every input: `Spec.connect_rule`). | `Spec.rejects_wrong_protocol_name` | +| A CONNECT whose connect flags byte is 0x03, with the reserved bit 0 set, is refused (one example input; every input: `Spec.connect_rule`). | `Spec.rejects_reserved_connect_flag` | +| A CONNECT whose will flag is clear but whose will QoS or will retain bit is set is refused: here the connect flags 0x0A and 0x22 on an otherwise valid CONNECT (every input: `Spec.connect_rule`). | `Spec.rejects_will_bits_without_will` | +| A CONNECT carrying a Subscription Identifier, which its property block does not allow, is refused (one example input; every input: `Spec.property_rule`). | `Spec.rejects_property_wrong_type` | +| A PUBLISH carrying the single use Topic Alias twice is refused (one example input; every input: `Spec.property_rule`). | `Spec.rejects_repeated_property` | +| SUBSCRIBE topic filters that break the standard's filter rules are refused, one example input each: `a/#/b` (`#` not last), `a+` (`+` not alone in its level), the empty filter, `$share/g/t` with No Local set, and `$share/g` (no filter after the ShareName). The filters `a/+/#` and `$share/g/t` with No Local clear are accepted (every input: `Spec.subscribe_rule`). | `Spec.rejects_bad_topic_filters` | +| A SUBSCRIBE with packet identifier 0 is refused (one example input; every input: `Spec.subscribe_rule`). | `Spec.rejects_subscribe_id_zero` | +| Property values the standard calls a Protocol Error are refused, one example input each: a Subscription Identifier of 0 on a SUBSCRIBE, a Topic Alias of 0 on a PUBLISH, a Receive Maximum of 0, a Maximum Packet Size of 0, a Request Problem Information of 2, a Request Response Information of 2, and Authentication Data with no Authentication Method on a CONNECT, and a Response Topic `#` and an empty Response Topic on a PUBLISH (every input: `Spec.property_rule`). | `Spec.rejects_property_value_rules` | +| The DISCONNECT 224, 1, 0 (a reason code with no property block) reads as that form and prints back as the same three bytes, and the DISCONNECT 224, 2, 0, 0 (a reason code and an empty property block) reads as that form and prints back as the same four bytes. | `Spec.disconnect_short_form` | +| The PINGREQ 192, 1, 0, which carries a one byte body, is refused (one example input; every input: `Spec.empty_body_rule`). | `Spec.rejects_pingreq_body` | +| The packet 32, 0, of type 2, outside the seven in this slice, is refused (one example input; every input: `Spec.header_rule`). | `Spec.rejects_unknown_type` | -- A broker. -- Session state. -- Delivery guarantees. +A packet is well formed when its numbers fit the widths +that carry them, its strings obey the string rules and fit +the two byte length prefix, its properties match the +property table in type and place, keep the value rules +the standard sets (no Subscription Identifier, Topic +Alias, Receive Maximum or Maximum Packet Size of 0, and +so on, as `SPEC.md` lists), and repeat no single use +property, its packet identifiers stand where the +type requires them and are never 0 there, a PUBLISH at +QoS 0 has DUP clear, a PUBLISH topic name holds no +wildcard and is empty only beside a Topic Alias, its +SUBSCRIBE topic filters keep the filter rules, and its +whole body is shorter than 2^28, the largest remaining +length a variable byte integer can carry. The full list is in +`SPEC.md`. Well formedness is `Mqtt.PacketWF` in +`Mqtt/Value.lean`, which is code under proof: an approval +pins the statements that use it, not its text. So each +rule a claim above depends on is also written in +`Spec/Defs.lean`, part of the specification, and proved +for every input from there (`Spec.header_rule` through +`Spec.empty_body_rule`). The well formedness rules with +no such statement are listed under What is not proved. -## Layout, when the first slice lands +The round trip theorems rest on the proofs in +`Proofs/RoundTrip.lean`, where they are +`Mqtt.Proofs.parsePacket_print`, `Mqtt.Proofs.parse_print`, +and `Mqtt.Proofs.decVBI_printVBI`. The soundness theorems +rest on `Proofs/Sound.lean`, where they are +`Mqtt.Proofs.parse_inv` and `Mqtt.Proofs.parsePacket_inv`, +built from one inverse lemma per field reader, and on the +inverse of the strict UTF-8 decoder, +`Mqtt.Utf8.Proofs.decode_inv` in `Proofs/Utf8Inv.lean`. +The rule theorems, and the byte count of a variable byte +integer, rest on `Proofs/Rules.lean`, which derives each +rule in `Spec/Defs.lean` from what the soundness theorems +say the reader accepts. +All of them check against the standard axioms only +(`propext`, `Classical.choice`, `Quot.sound`), which a +reader can confirm with `#print axioms`, or by running +`lake env lean Mqtt/Verify.lean`. The theorems about +single inputs are checked in the kernel with +`decide +kernel`. +Under the round trips, the field and body steps are proved +one by one in the same file: big endian numbers, byte cuts, +string and binary fields, typed property values, single +properties, property lists and whole property blocks, the +subscription options byte, topic filter lists, and the body +of each of the seven packet types. The UTF-8 round trip, +`Mqtt.Utf8.Proofs.decode_encode`, is proved in +`Proofs/Utf8.lean`, and worked examples from the standard +are proved in `Proofs/Examples.lean`. -The layout follows the Proven Commons template in the mission repo, under bar/template. Spec.lean holds the statements a reviewer approves. Proofs.lean holds the proofs under the same names. Main.lean holds the command line tool used by the tests. The bar check runs in CI on every change. +The command line tool in `Main.lean` calls `Mqtt.parse` +and `Mqtt.print` directly, the same functions the theorems +are about. + +## What is not proved + +- That well formedness and the printer match the MQTT 5.0 + standard. The proofs show that the reader accepts exactly + the printings of well formed packets (`Spec.parse_print` + with `Spec.parse_sound`). That this set is the set of byte + strings the standard allows for these seven packet types + is a reading of the standard: `SPEC.md` states it, a + reviewer checks it against the standard, and the oracle + differential and the mutation tests in `tests/` probe it, + with the outcome in the results file. It is not proved. +- Where each field sits in the bytes. The rules in + `Spec/Defs.lean` are stated on the header byte, on the + start of a CONNECT body, and on the fields of the packet + the reader returns. The round trip and soundness theorems + tie those fields to the bytes through the printer, + `Mqtt.print`, whose text is code under proof; beyond the + example inputs, no statement fixes the layout byte by + byte. +- The well formedness rules that `Spec/Defs.lean` does not + restate. The reader keeps them on every input + (`Spec.parse_sound`), but they are written only in + `Mqtt/Value.lean` and `Mqtt/Parse.lean`, code under proof + whose text an approval does not pin. They are: the string + rules (strict UTF-8, no U+0000, at most 65535 bytes) and + the binary length limit; the subscription options byte + (bits 6 and 7 clear, QoS and Retain Handling not 3); a + SUBACK with a packet identifier other than 0 and at least + one reason code; and the three DISCONNECT body forms. The tests in + `tests/` check them, and the example theorems in + `Proofs/Examples.lean` check some on single inputs. +- The shortest writing of a variable byte integer inside a + property block, for every input. `Spec.decVBI_length` + states it for the variable byte integer reader, and + `Spec.parsePacket_frame` with it for the remaining length + of every packet. For the property length, property + identifiers and variable byte integer property values, the + packet reader calls the same reader, but no statement says + so for every input: `Spec.rejects_non_minimal_property_vbis` + covers one example input in each place, and the tests in + `tests/run_tests.py` check the cases named "vbi non-minimal + ... as property length", "... as property identifier" and + "... as subscription identifier". +- The bytes of a variable byte integer for values outside the + standard's worked table. The statements pin how many bytes + the printer writes (`Spec.printVBI_length`) and that the + reader reads them back (`Spec.decVBI_printVBI`, + `Spec.decVBI_canonical`), and `Spec.vbi_worked_table` pins + the bytes of the table's eight rows; that every other value + is written seven bits per byte, low groups first, rests on + the text of `Mqtt.printVBI` and on the tests: the tool + reads and prints back Paho's writing of 120 random values + below 2^28 as Subscription Identifiers, and the writings of + the oracle encoder, written from the standard, in the + generated packets. +- Any reading of what a property means. A property is an + identifier and a typed value; that a Receive Maximum of + 10 asks the peer to hold back after ten packets is broker + and session behaviour, and none of it is in this slice. +- Anything about packets outside the seven types, or + property identifiers outside the table in `SPEC.md`, + beyond their refusal (`Spec.header_rule` and + `Spec.property_rule`). +- Broker or session behaviour of any kind: connections, + subscriptions as state, retained messages, keep alive + timing, and what any peer does with a packet. +- Worked examples on the printing side, beyond the two + DISCONNECT packets of `Spec.disconnect_short_form`. The + examples in `Proofs/Examples.lean` are stated on the + reading side. The round trip and soundness theorems + cover the printer in general. +- Reading requests and printing answers in `Main.lean`: + splitting lines, and the decimal number reader. The tests + cover them, malformed requests included. +- Speed. The code works on lists of bytes, which suits + proofs, not large packets. + +## What you must trust + +- The Lean kernel (Lean 4.35.0, pinned in + `lean-toolchain`), which checks every proof. +- The Lean compiler, with the C compiler and linker + shipped with it, which turns the proved definitions into + the program that runs. +- The Lean runtime, which runs that program. +- The hardware the program runs on. +- Every dependency in `lake-manifest.json`: the manifest + lists no packages, so there are no library dependencies + to trust beyond the Lean toolchain itself. +- Lean's core library, including the compiled code it puts + in place of some definitions the proofs reason about. +- The operating system the program runs on. +- That `SPEC.md` states the reading of the MQTT 5.0 + standard you intend. The proofs are about the reader and + printer in this repo following each other exactly; the + fidelity of the spec to the standard is a reading, pinned + in `SPEC.md` where the standard leaves a choice open. +- The strict oracle in `tests/run_tests.py`, written from + the standard and `SPEC.md` beside the reader, and Paho's + Python library in the parts of the differential it + covers. The oracle shares the reader's reading of the + standard, though some of its checks are written another + way (it checks the shortest variable byte integer by + writing the value again, and topic filters by splitting + at `/`). Both are evidence, not proof. The results file + names the versions used, and states plainly which + oracles were and were not available. In the Paho + cross-check, Paho judges answers of the Lean tool: its + encoder's writings of variable byte integers, and + property blocks of all six kinds, accepted and refused, + judged by `Properties.unpack`. It does not judge whole + packets. Paho departs from the standard in places, and + the run checks those apart as named differences rather + than take Paho's answer there: its decoder accepts + variable byte integers longer than the value needs + (section 1.5.5 forbids them), it refuses a Payload + Format Indicator above 1 and a Maximum Packet Size above + 268435455 (the standard does not), and it accepts a + Response Topic with a wildcard or empty, Authentication + Data without a Method, and a repeated Subscription + Identifier on SUBSCRIBE (the standard calls each a + Protocol Error). +- The line handling in `Main.lean` (splitting a request + line, reading decimal codes). The tests drive it, and no + proof covers it. +- There are no exceptions to item 4 of the bar: the + project uses none of the features it forbids. + +## Re-check it + +1. `lake comparator --paranoid`: builds the challenge + file `Spec.lean` and the proofs in a sandbox and + checks that each theorem named in `comparator.json` + proves exactly the statement in the challenge file, + uses no axiom but the three standard ones, and is + accepted by Lean's kernel and every other kernel + shipped with Lean. +2. `python3 tests/run_tests.py`: the fixed cases, the + differential against the strict oracle, the Paho + cross-check when the library is importable, and the + mutation and rejection cases, and the forbidden classes + drawn from the seed, with counts and any + failures written to `tests/TEST-RESULTS.md`. The Paho + cross-check runs when the interpreter can import + `paho-mqtt` (for example from a virtual environment), + and the results file says when it could not. Its inputs + are counted apart, so the recorded input count is the + same either way. +3. `lake build`: the library, the proofs, and the tool + build clean, and `lake env lean Mqtt/Verify.lean` + prints the axiom list for the round trip and + soundness theorems. +4. Read `SPEC.md` against the MQTT 5.0 standard and check + the pinned readings are the ones you want. diff --git a/SPEC.md b/SPEC.md new file mode 100644 index 0000000..cab620a --- /dev/null +++ b/SPEC.md @@ -0,0 +1,530 @@ +# MQTT packet codec: specification + +This is the specification of the first slice for the `mqtt` +package: MQTT 5.0 control packet framing at the level of bytes, +in Lean, with the round trip proved. The format itself is +defined by the OASIS MQTT Version 5.0 standard; section numbers +below are that standard's. This file states what the slice does +with it, including the points where the standard leaves a +reading open and this slice pins one. + +What the slice is: a reader and a printer for one control +packet of seven types, and a reader that can walk a stream of +packets one at a time. What it is not: a broker, a client, or +any session behaviour. Nothing here opens a connection, keeps +state between packets, acts on a packet's meaning, or checks a +packet against a subscription or a session. + +## The packet on the wire + +A packet is three parts, in order: + +1. One fixed header byte: the packet type in the high four + bits, and type specific flags in the low four bits. +2. The remaining length: a variable byte integer (below) that + counts the bytes of the third part. +3. The body: the variable header and the payload for the type, + exactly as many bytes as the remaining length says. + +The packet types in this slice are CONNECT (1), PUBLISH (3), +SUBSCRIBE (8), SUBACK (9), PINGREQ (12), PINGRESP (13), and +DISCONNECT (14). A fixed header byte whose type nibble is any +other value is rejected in this slice. + +## The variable byte integer + +A variable byte integer (section 2.1.4) carries seven bits per +byte, low groups first. The top bit of a byte is a continuation +mark: it is set on every byte but the last. At most four bytes +are used, so the largest value is 268435455 (2^28 - 1). The +standard's worked table: + +| Value | Bytes | +| --- | --- | +| 0 | 0 | +| 127 | 127 | +| 128 | 128, 1 | +| 16383 | 255, 127 | +| 16384 | 128, 128, 1 | +| 2097151 | 255, 255, 127 | +| 2097152 | 128, 128, 128, 1 | +| 268435455 | 255, 255, 255, 127 | + +The reader rejects a value whose fourth byte still carries a +continuation mark (a fifth byte would be needed), whatever +follows, and rejects a value cut off by the end of the input. +The first rule is proved for every input, for the variable +byte integer reader and for the remaining length of a packet. + +Shortest writing (section 1.5.5): "The encoded value MUST use +the minimum number of bytes necessary to represent the value +[MQTT-1.5.5-1]". The reader rejects a writing that uses more +bytes than its value needs, which is one whose last byte is 0 +after a continuation byte. So 0 written as 128, 0 is rejected, +and so is 128 written as 128, 129, 0. The packet reader reads +every variable byte integer in a packet with this reader: the +remaining length, property lengths, property identifiers, and +variable byte integer property values. + +What is proved for every input covers the variable byte integer +reader itself and the remaining length. What the reader accepts +is exactly the printer's writing of the value it returns +(`Spec.decVBI_canonical`), and that writing uses the fewest +bytes that carry the value, one byte below 2^7, two below 2^14, +three below 2^21 and four below 2^28 (`Spec.printVBI_length` +and `Spec.decVBI_length`, with the count `Spec.vbiSize` written +in `Spec/Defs.lean`). The packet reader takes exactly a header +byte, that writing of the body length, and the body +(`Spec.parsePacket_frame`), so a longer writing of the +remaining length is refused for every input. + +For the property length, property identifiers and variable byte +integer property values, no statement covers every input. One +example input each is proved refused, beside the same packet +with the shortest writing accepted +(`Spec.rejects_non_minimal_property_vbis`), and the tests check +the same cases. The README lists this under What is not proved. + +The bytes the printer writes for each value of the worked table +above, and the values the reader reads from them, are proved for +those rows (`Spec.vbi_worked_table`). For other values, the +statements pin the byte count and the round trip, not the +contents of each byte (seven bits per byte, low groups first); +the tests check those against the standard's rule. + +Paho's Python library (paho-mqtt 2.1.0) accepts the longer +writings, for example 128, 0 as 0. The test harness records +this as a named difference from that library. + +## Fixed header flags + +For every type in this slice except PUBLISH, the flags nibble +must be exactly the value the standard fixes (section 2.1.3, +Table 2-2): 0010 for SUBSCRIBE, and 0000 for CONNECT, SUBACK, +PINGREQ, PINGRESP, and DISCONNECT. Any other nibble is +rejected. + +PUBLISH flags carry meaning and are part of the packet value: +the DUP flag at bit 3, the QoS level at bits 2 and 1, and the +RETAIN flag at bit 0. The QoS value 3 is reserved and is +rejected. The DUP flag set at QoS 0 is rejected: "The DUP flag +MUST be set to 0 for all QoS 0 messages [MQTT-3.3.1-2]" +(section 3.3.1.1). + +So a packet starts with one of sixteen header bytes: 0x10, +0x30 to 0x35, 0x3A to 0x3D, 0x82, 0x90, 0xC0, 0xD0 and 0xE0. +This list is `Spec.headerBytes` in `Spec/Defs.lean`, and +`Spec.header_rule` proves it for every input. + +## Strings and binary data + +A UTF-8 string field (section 1.5.4) is a two byte length, +counting bytes, then that many bytes of UTF-8 text. The reader +decodes the bytes with a strict UTF-8 decoder: it rejects +stray continuation bytes, overlong forms, lead bytes above +F4, encodings of the surrogate values D800 to DFFF, values +above 10FFFF, and truncated sequences. It also rejects the +null character U+0000, which the standard forbids in strings. +Nothing else about the text is checked. + +A binary data field (section 1.5.3) is a two byte length, then +that many bytes, with no check on the bytes. + +## Properties + +Most packet types carry a property block (section 2.2.2): a +property length as a variable byte integer, then that many +bytes of properties. Each property is an identifier, written +as a variable byte integer, and a value whose shape is fixed +by the identifier's row in the standard's property table +(Table 2-4). The block must be filled exactly: a property that +runs past the end of the block, and bytes left over inside the +block after the last whole property, are both rejected. + +The table as implemented in this slice: + +| Id | Name | Value type | Blocks it may stand on | +| --- | --- | --- | --- | +| 0x01 | Payload Format Indicator | byte | will, PUBLISH | +| 0x02 | Message Expiry Interval | four byte integer | will, PUBLISH | +| 0x03 | Content Type | UTF-8 string | will, PUBLISH | +| 0x08 | Response Topic | UTF-8 string | will, PUBLISH | +| 0x09 | Correlation Data | binary data | will, PUBLISH | +| 0x0B | Subscription Identifier | variable byte integer | PUBLISH, SUBSCRIBE | +| 0x11 | Session Expiry Interval | four byte integer | CONNECT, DISCONNECT | +| 0x12 | Assigned Client Identifier | UTF-8 string | none in this slice | +| 0x13 | Server Keep Alive | two byte integer | none in this slice | +| 0x15 | Authentication Method | UTF-8 string | CONNECT | +| 0x16 | Authentication Data | binary data | CONNECT | +| 0x17 | Request Problem Information | byte | CONNECT | +| 0x18 | Will Delay Interval | four byte integer | will | +| 0x19 | Request Response Information | byte | CONNECT | +| 0x1A | Response Information | UTF-8 string | none in this slice | +| 0x1C | Server Reference | UTF-8 string | DISCONNECT | +| 0x1F | Reason String | UTF-8 string | SUBACK, DISCONNECT | +| 0x21 | Receive Maximum | two byte integer | CONNECT | +| 0x22 | Topic Alias Maximum | two byte integer | CONNECT | +| 0x23 | Topic Alias | two byte integer | PUBLISH | +| 0x24 | Maximum QoS | byte | none in this slice | +| 0x25 | Retain Available | byte | none in this slice | +| 0x26 | User Property | UTF-8 string pair | CONNECT, will, PUBLISH, SUBSCRIBE, SUBACK, DISCONNECT | +| 0x27 | Maximum Packet Size | four byte integer | CONNECT | +| 0x28 | Wildcard Subscription Available | byte | none in this slice | +| 0x29 | Subscription Identifier Available | byte | none in this slice | +| 0x2A | Shared Subscription Available | byte | none in this slice | + +Rows marked "none in this slice" name properties the standard +assigns to packet types this slice does not read (chiefly +CONNACK). The identifier has a known value type, but it is on +no allowed list here, so the reader rejects it everywhere in +this slice. + +These property checks reject a packet: + +- An identifier with no row in the table is rejected. +- A property standing on a block whose allowed list does not + include it is rejected. For example, a Subscription + Identifier on a CONNECT packet is rejected. +- A repeated single use property is rejected. Two properties + may repeat: the User Property (0x26) may repeat on any block + that allows it, and the Subscription Identifier (0x0B) may + repeat on PUBLISH, where one message can match several + subscriptions (section 3.3.4). Every other allowed property + may stand at most once in one block. +- A value the standard calls a Protocol Error is rejected + (`propValOK` in `Mqtt/Value.lean`): + - a Response Topic (0x08) that is empty or holds `+` or `#`: + it is used as a Topic Name (sections 3.3.2.3.5 + [MQTT-3.3.2-14], 4.7.0 [MQTT-4.7.0-1], 4.7.3 + [MQTT-4.7.3-1]), on PUBLISH and in the will alike; + - a Subscription Identifier (0x0B) of 0 (sections 3.3.2.3.8 + and 3.8.2.1.2); + - a Request Problem Information (0x17) or Request Response + Information (0x19) other than 0 or 1 (sections 3.1.2.11.7 + and 3.1.2.11.6); + - a Receive Maximum (0x21) of 0 (section 3.1.2.11.3); + - a Topic Alias (0x23) of 0 (section 3.3.2.3.4, + [MQTT-3.3.2-8]); + - a Maximum Packet Size (0x27) of 0 (section 3.1.2.11.4). +- Authentication Data (0x16) in a block with no Authentication + Method (0x15) is rejected (section 3.1.2.11.10; `authOK`). + +Other values of the right type are accepted. In particular a +Payload Format Indicator (0x01) other than 0 or 1 is accepted: +section 3.3.2.3.2 names the two values but, unlike the rules +above, does not call another value a Protocol Error. Rules +that depend on the session, such as a Topic Alias above the +peer's Topic Alias Maximum, are outside this slice. + +## The seven packet types + +### CONNECT (section 3.1) + +The body is: the protocol name as a string field, which must +be exactly the text "MQTT"; one protocol level byte, which +must be 5; one connect flags byte; the keep alive as two +bytes; the CONNECT property block; then the payload. + +The connect flags byte is: username flag at bit 7, password +flag at bit 6, will retain at bit 5, will QoS at bits 4 and 3, +will flag at bit 2, clean start at bit 1, and a reserved bit +at bit 0. The reader rejects a packet whose reserved bit is +set, and rejects a will QoS field of 3. The will QoS and will +retain bits are part of the packet value only when the will +flag is set. When it is clear, both must be 0 (sections +3.1.2.6 [MQTT-3.1.2-11] and 3.1.2.7 [MQTT-3.1.2-13]): the +reader rejects a packet with the will flag clear and any of +bits 3, 4 or 5 set, and the printer writes them as 0. + +The payload is: the client identifier as a string field +(always present, and it may be empty); then, when the will +flag is set, the will property block, the will topic as a +string field, and the will payload as a binary data field; +then the username as a string field when the username flag is +set; then the password as a binary data field when the +password flag is set. The fields stand exactly when the flags +say they stand, and the body must be consumed exactly: bytes +left over, or a field the flags demand but the bytes do not +hold, are rejected. The will topic must pass the topic name +check below, like a PUBLISH topic. + +### PUBLISH (section 3.3) + +The body is: the topic name as a string field; the packet +identifier as two bytes, present exactly when the QoS is 1 or +2 and never present at QoS 0; the PUBLISH property block; +then the payload, which is all the bytes that remain in the +body, and may be empty. + +The topic name must contain neither wildcard character, `+` +or `#` (section 3.3.2.1, [MQTT-3.3.2-2]). It may be empty only +when the PUBLISH property block carries a Topic Alias (0x23): +"It is a Protocol Error if the Topic Name is zero length and +there is no Topic Alias" (section 3.3.2.1). The topic the +alias stands for is session state, which this slice does not +keep, so an empty topic with an alias is accepted whatever the +alias value (other than 0, which the value rules above +reject). A packet identifier, where one stands, must not be +0. + +### SUBSCRIBE (section 3.8) + +The body is: the packet identifier as two bytes, which must +not be 0; the SUBSCRIBE property block; then a list of topic +filters that fills the rest of the body exactly. The list +must be nonempty. Each filter is a filter string as a string +field, then one subscription options byte. A filter string +follows the string rules above, and the filter rules of the +standard (`filterOK` in `Mqtt/Value.lean`): + +- It is at least one character long [MQTT-4.7.3-1]. +- Split at each `/` into levels, a `+` must be a whole level + [MQTT-4.7.1-2], and a `#` must be a whole level and the last + one [MQTT-4.7.1-1]. So `a/+/#`, `#`, `+` and `/` are filters, + and `a/#/b`, `a#` and `a+` are not. +- A filter that starts with `$share/` is a shared subscription + (section 4.8.2): after `$share/` comes a ShareName at least + one character long with no `+` or `#` [MQTT-4.8.2-1], then a + `/` and a filter that keeps the two rules above + [MQTT-4.8.2-2]. Its No Local option must be clear + [MQTT-3.8.3-4]. A filter that starts `$share` with no `/` + after it is an ordinary filter. + +A filter that breaks a rule is rejected, and so is the whole +packet. + +The subscription options byte is: the maximum QoS at bits 0 +and 1, the no local flag at bit 2, the retain as published +flag at bit 3, and the retain handling choice at bits 4 and +5. The reader rejects a byte of 64 or more (the reserved bits +6 and 7 must be clear), a QoS field of 3, and a retain +handling field of 3. + +### SUBACK (section 3.9) + +The body is: the packet identifier as two bytes, which must +not be 0; the SUBACK property block; then the list of reason +codes, one byte each, filling the rest of the body. The list +must be nonempty. Reason code values are not checked beyond +being bytes. + +### PINGREQ (section 3.12) and PINGRESP (section 3.13) + +Both packets have an empty body: the remaining length must be +0, and any body byte is rejected. + +### DISCONNECT (section 3.14) + +Three body forms are legal: + +- A remaining length of 0: a normal disconnection with no + body. +- A remaining length of 1: one reason code byte and no + property block. "If the Remaining Length is less than 2, a + value of 0 is used" for the property length (section + 3.14.2.2.1), so this form is accepted. +- A remaining length of 2 or more: one reason code byte, then + a DISCONNECT property block that fills the rest of the body + exactly. + +The packet value keeps which form arrived: no body, a reason +code alone, or a reason code and a property block. The +printer writes each form back as it came, so the one byte +form with reason code 0 prints as remaining length 1, reason +0, and the form with an empty property block prints as +remaining length 2, reason 0, property length 0. Reason code +values are not checked beyond being bytes. + +## The reader + +The reader reads one packet from the front of a byte list and +returns the packet together with the rest of the input, so a +caller can walk a stream of packets: trailing bytes are not +an error at that level. The whole input form of the reader +adds the check that nothing follows the packet. + +Safety: the reader never reads past the end of its input. It +first cuts the body out by the remaining length, and each +field reader checks its length against the bytes that +actually remain before taking any of them. Any shortfall, at +any point, is a rejection, not a partial read. Each type's +reader must consume its body cut exactly. + +Soundness, proved for every input: what the reader accepts is +exactly the printed form of a well formed packet. The whole +input reader accepts a byte list only when it is the printing +of a well formed packet, and returns that packet; the stream +reader takes from the front of its input exactly the printing +of the well formed packet it returns, and returns the rest +untouched. With the round trip, the reader and the printer +are inverse to each other: the byte lists the reader accepts +are exactly the printings of well formed packets. So the +reader enforces every rule of well formedness below, as +`Mqtt.PacketWF` in `Mqtt/Value.lean` states it, on every +input. + +That definition is code under proof: an approval pins the +statements that use it, not its text, so a change to it +would not void the approval. The rules the claims depend on +are therefore also written in `Spec/Defs.lean`, part of this +specification, and proved for every input from there: + +- the header byte, `Spec.headerBytes` (`Spec.header_rule`); +- the start of a CONNECT body and its flags byte, + `Spec.ConnectFlagsRule`, and the will topic + (`Spec.connect_rule`); +- the PUBLISH topic name and packet identifier + (`Spec.publish_rule`); +- the SUBSCRIBE packet identifier, filter list and filters, + `Spec.FilterRule` (`Spec.subscribe_rule`); +- every property block, `Spec.BlockRule`, with the allowed + identifiers, value types and value rules, the repeat rule + and the authentication rule (`Spec.property_rule`); +- the empty PINGREQ and PINGRESP bodies + (`Spec.empty_body_rule`); +- the byte count of every variable byte integer the + variable byte integer reader accepts, `Spec.vbiSize` + (`Spec.printVBI_length`, `Spec.decVBI_length`), and of the + remaining length of every packet (with + `Spec.parsePacket_frame`). + +These are stated for the stream reader; `Spec.parse_whole` +carries them to the whole input reader. The rules of well +formedness with no such statement are the string rules, the +binary length limit, the subscription options byte, the +SUBACK fields, and the DISCONNECT body forms. +The reader keeps them, but their text is only in the code; +the page lists them under What is not proved. + +## Well formed values + +The round trip claim holds for well formed packets: the +fields the printer can write exactly. Every packet the reader +accepts is well formed. In outline: + +- Every number fits the width that carries it: keep alive and + packet identifiers and two byte property values below + 65536, four byte property values below 2^32, variable byte + integer values and any single property block's printed + length below 2^28, and the whole body below 2^28, the + largest remaining length four bytes can carry. +- Strings obey the string rules and their UTF-8 byte length + fits the two byte length prefix; binary data fields fit the + same prefix. +- Properties match the table in type and in place, keep the + value rules above, and no single use property repeats in one + block; Authentication Data stands only with an + Authentication Method. +- CONNECT: the will, when one stands, has QoS at most 2, a + well formed will property block, a topic that passes the + topic name check, and a payload that fits its prefix. +- PUBLISH: QoS at most 2; DUP clear at QoS 0; a topic with no + wildcard, empty only when a Topic Alias stands in the + properties; a packet identifier standing exactly when the + QoS is 1 or 2, and never 0. +- SUBSCRIBE: a nonzero packet identifier, a nonempty filter + list, options with QoS and retain handling at most 2, and + each filter keeping the filter rules above. +- SUBACK: a nonzero packet identifier and a nonempty reason + list of byte values. +- DISCONNECT with a body: a reason code below 256, and a well + formed property block when one stands. + +## The printer + +The printer writes a packet as the fixed header byte, the +remaining length as a minimal variable byte integer, and the +body in the layouts above. Property blocks are written with a +minimal property length, and property identifiers and +variable byte integer values in their minimal form. The +variable byte integer reader accepts only that form +(`Spec.printVBI_length` and `Spec.decVBI_length`); for the +packet reader this is proved for every input on the remaining +length, and on one example input each for the property +positions (`Spec.rejects_non_minimal_property_vbis`). Every packet the reader +accepts reprints byte for byte: the printer's form is the +only form the reader accepts. + +## The line protocol + +The command line tool reads one request per line: the +operation and a payload, parted by one space. The payload is +decimal byte numbers parted by commas, with no spaces. A +number is plain decimal: no sign, no leading zeros (the +number 0 itself is written `0`), at most twenty digits. An +empty line gets no answer. A request that breaks these rules +prints `error`, as does an unknown operation. + +The one operation is `parse`. It parses the bytes as exactly +one whole packet and prints `ok:` followed by the bytes of +the canonical reprint, comma parted, when the bytes are one +packet this slice reads. It prints `none` when the bytes are +well formed as a request but are not one packet this slice +reads. The empty payload is the empty byte list and answers +`none`. + +Example: the request `parse 192,0` is a PINGREQ. The answer +is `ok:192,0`. The request `parse 224,1,0` is the one byte +body form of DISCONNECT with reason code 0. The answer is +`ok:224,1,0`: the same packet, reprinted in the form it came +in. + +The tool prints only the re-encoded bytes. It does not print +a rendering of the packet, so test harnesses check the parsed +structure through the re-encoding together with their own +oracle. + +## Properties and their theorems + +Each property a reader can check in the page (`README.md`) +names its theorem. The theorems are stated in `Spec.lean` and +proved in `Proofs/SpecProofs.lean`. The round trip, soundness, +variable byte integer (but for the worked table), frame, four +byte cap and rule theorems hold for every input; the rule theorems hold the reader to +the rules written in `Spec/Defs.lean`. A row marked "one +example input", or one that names its inputs, is a theorem +about those inputs alone; the test harness has a named case +for each such rule. The row names, after "every input", the +theorem that states the rule it illustrates for every input. +The tests in `tests/` also check each rule on many more +inputs. + +| Property | Theorem | +|----------|---------| +| Parsing the printed form of a well formed packet, with more stream bytes after it, gives the packet and those bytes back | `Spec.parsePacket_print` | +| Parsing the printed form of a well formed packet on its own gives the packet back | `Spec.parse_print` | +| Every packet the whole input reader accepts is well formed, and printing it gives back exactly the bytes it read; so the reader refuses every byte list that is not the printing of a well formed packet | `Spec.parse_sound` | +| Every packet the stream reader takes is well formed, and the bytes it took are exactly its printing, followed by the bytes it returns | `Spec.parsePacket_sound` | +| Reading a printed variable byte integer gives the number back, below 2^28 | `Spec.decVBI_printVBI` | +| What the variable byte integer reader accepts is the printer's writing of the value it returns, followed by the bytes it returns; the value is below 2^28 | `Spec.decVBI_canonical` | +| The printer writes every value below 2^28 in `Spec.vbiSize` bytes, the fewest that carry it | `Spec.printVBI_length` | +| For every input, what the variable byte integer reader accepts uses exactly `Spec.vbiSize` bytes for its value, so a longer writing is refused | `Spec.decVBI_length` | +| Every packet the stream reader takes is a header byte, the printer's writing of the body length (the shortest, by `Spec.printVBI_length`), and that many body bytes, all in the input; the bytes it returns are the ones after them | `Spec.parsePacket_frame` | +| The remaining length 128, 0 (a two byte writing of 0) is refused, while 0 gives the PINGREQ (every input: `Spec.decVBI_length` with `Spec.parsePacket_frame`) | `Spec.rejects_non_minimal_remaining_length` | +| A longer writing than the value needs is refused, one example input each, as a property length (128, 0 for 0), a property identifier (129, 0 for 1) and a Subscription Identifier value (129, 128, 0 for 1), while the same packets with the shortest writing are accepted. No statement covers every input in these places | `Spec.rejects_non_minimal_property_vbis` | +| The printer writes each value of the standard's worked table (0, 127, 128, 16383, 16384, 2097151, 2097152, 268435455) as the bytes the table gives, and the variable byte integer reader reads those bytes as that value (those rows only) | `Spec.vbi_worked_table` | +| A variable byte integer whose first four bytes all carry a continuation mark is refused, whatever follows | `Spec.decVBI_four_byte_cap` | +| A packet whose remaining length has a continuation mark on each of its first four bytes is refused, whatever the header byte and whatever follows | `Spec.parsePacket_four_byte_cap` | +| The whole input reader accepts a byte list exactly when the stream reader takes one packet from it and leaves nothing | `Spec.parse_whole` | +| Every packet the stream reader takes starts with one of the header bytes of `Spec.headerBytes` | `Spec.header_rule` | +| Every CONNECT the stream reader takes starts 0x10, the body length, 0, 4, `MQTT`, 5 and a flags byte that keeps `Spec.ConnectFlagsRule`; a will topic is not empty and holds no wildcard | `Spec.connect_rule` | +| Every PUBLISH the stream reader takes has a topic name with no wildcard, empty only beside a Topic Alias, and a packet identifier that stands exactly at QoS 1 and 2 and is never 0 | `Spec.publish_rule` | +| Every SUBSCRIBE the stream reader takes has a packet identifier other than 0, at least one filter, and filters that keep `Spec.FilterRule` | `Spec.subscribe_rule` | +| Every property block of every packet the stream reader takes keeps `Spec.BlockRule` | `Spec.property_rule` | +| Every PINGREQ the stream reader takes is 192, 0, and every PINGRESP 208, 0 | `Spec.empty_body_rule` | +| A SUBSCRIBE with flags 0000 rather than 0010 is refused (one example input; every input: `Spec.header_rule`) | `Spec.rejects_subscribe_flags` | +| A PUBLISH with the reserved QoS value 3 is refused (one example input; every input: `Spec.header_rule`) | `Spec.rejects_publish_qos3` | +| A PUBLISH with DUP set at QoS 0 is refused (one example input, header 0x38), while the same packet with header 0x30 is accepted (every input: `Spec.header_rule`) | `Spec.rejects_dup_at_qos0` | +| An empty PUBLISH topic name is accepted with a Topic Alias and refused without one (one example input each; every input: `Spec.publish_rule`) | `Spec.empty_topic_needs_alias` | +| A PUBLISH whose topic name is `a/#` is refused (one example input; every input: `Spec.publish_rule`) | `Spec.rejects_wildcard_topic` | +| A CONNECT whose protocol name is `MQTU` is refused (one example input; every input: `Spec.connect_rule`) | `Spec.rejects_wrong_protocol_name` | +| A CONNECT with connect flags 0x03, the reserved bit set, is refused (one example input; every input: `Spec.connect_rule`) | `Spec.rejects_reserved_connect_flag` | +| A CONNECT with the will flag clear and the will QoS or will retain bit set is refused (example inputs: connect flags 0x0A and 0x22; every input: `Spec.connect_rule`) | `Spec.rejects_will_bits_without_will` | +| A CONNECT carrying a Subscription Identifier, which its block does not allow, is refused (one example input; every input: `Spec.property_rule`) | `Spec.rejects_property_wrong_type` | +| A PUBLISH carrying the Topic Alias twice is refused (one example input; every input: `Spec.property_rule`) | `Spec.rejects_repeated_property` | +| SUBSCRIBE topic filters that break the filter rules are refused, one example input each: `a/#/b`, `a+`, the empty filter, `$share/g/t` with No Local, and `$share/g`; `a/+/#` and `$share/g/t` without No Local are accepted (every input: `Spec.subscribe_rule`) | `Spec.rejects_bad_topic_filters` | +| A SUBSCRIBE with packet identifier 0 is refused (one example input; every input: `Spec.subscribe_rule`) | `Spec.rejects_subscribe_id_zero` | +| Property values the standard calls a Protocol Error are refused, one example input each: a Subscription Identifier, Topic Alias, Receive Maximum or Maximum Packet Size of 0, a Request Problem Information or Request Response Information of 2, Authentication Data without an Authentication Method, and a Response Topic that holds a wildcard or is empty (every input: `Spec.property_rule`) | `Spec.rejects_property_value_rules` | +| A DISCONNECT with a one byte body reads as a reason code with no property block and prints back as the same bytes; one with a reason code and an empty property block does the same in its own form (one example of each) | `Spec.disconnect_short_form` | +| A PINGREQ with a one byte body is refused (one example input; every input: `Spec.empty_body_rule`) | `Spec.rejects_pingreq_body` | +| The packet 32, 0, of type 2, is refused (one example input; every input: `Spec.header_rule`) | `Spec.rejects_unknown_type` | diff --git a/Spec.lean b/Spec.lean new file mode 100644 index 0000000..79e4f0e --- /dev/null +++ b/Spec.lean @@ -0,0 +1,439 @@ +/- + The specification as Lean statements: the challenge file. + + A reviewer who did not write this file approves it, and `bar.toml` + records the SHA-256 it had then. The proofs live in `Proofs` + (`Proofs/SpecProofs.lean`); `lake comparator` checks that each one + proves exactly the statement written here. The `sorry` below is + expected in this file only. + + The statements use the definitions in `Mqtt/Value.lean`, + `Mqtt/Parse.lean`, and `Mqtt/Utf8.lean`, the code under proof + named in `bar.toml`, and the definitions in `Spec/Defs.lean`, + which are part of the specification: the rules a statement + holds the reader to are written there, from the standard. +-/ + +import Mqtt +import Spec.Defs + +open Mqtt + +/-! ## The round trips + +The statements the slice stands on. Each one is the statement of +the proved theorem of the same shape in `Proofs/RoundTrip.lean` +(printing, then reading) or `Proofs/Sound.lean` (reading, then +printing), over the same well formedness predicate, +`Mqtt.PacketWF`. -/ + +/-- Parsing the printed form of a well formed packet, with more + stream bytes after it, gives the packet and those bytes back. + So a printer that wrote nothing, or wrote something shorter, + fails this statement. -/ +theorem Spec.parsePacket_print (p : Packet) (rest : List UInt8) + (h : PacketWF p) : + parsePacket (print p ++ rest) = some (p, rest) := sorry + +/-- Parsing the printed form of a well formed packet on its own + gives the packet back. -/ +theorem Spec.parse_print (p : Packet) (h : PacketWF p) : + parse (print p) = some p := sorry + +/-- Every packet the whole input reader accepts is well formed, + and printing it gives back exactly the bytes it read. With + `Spec.parse_print`, the reader accepts a byte list exactly + when it is the printing of a well formed packet, and returns + that packet. So it refuses every byte list that is not such a + printing. -/ +theorem Spec.parse_sound (bs : List UInt8) (p : Packet) + (h : parse bs = some p) : PacketWF p ∧ print p = bs := sorry + +/-- Every packet the stream reader takes from the front of a byte + list is well formed, and the bytes it took are exactly its + printing, with the bytes it returns after them. -/ +theorem Spec.parsePacket_sound (bs : List UInt8) (p : Packet) + (r : List UInt8) (h : parsePacket bs = some (p, r)) : + PacketWF p ∧ bs = print p ++ r := sorry + +/-- Reading a printed variable byte integer gives the number + back, for every value below 2^28, the most four bytes carry. -/ +theorem Spec.decVBI_printVBI (n : Nat) (rest : List UInt8) + (hn : n < 268435456) : + decVBI (printVBI n ++ rest) = some (n, rest) := sorry + +/-! ## Variable byte integers and the packet frame + +Section 1.5.5 of the standard: "The encoded value MUST use the +minimum number of bytes necessary to represent the value". -/ + +/-- What the variable byte integer reader accepts is the + printer's writing of the value it returns, followed by the + bytes it returns; and the value is below 2^28. So every + value has one writing the reader accepts. That this writing + is the shortest is `Spec.printVBI_length` and + `Spec.decVBI_length`. -/ +theorem Spec.decVBI_canonical (bs : List UInt8) (n : Nat) (r : List UInt8) + (h : decVBI bs = some (n, r)) : + n < 268435456 ∧ bs = printVBI n ++ r := sorry + +/-- The printer writes every value below 2^28 in + `Spec.vbiSize` bytes, the fewest that carry it: one byte + below 2^7, two below 2^14, three below 2^21, four below + 2^28. -/ +theorem Spec.printVBI_length (n : Nat) (hn : n < 268435456) : + (printVBI n).length = Spec.vbiSize n := sorry + +/-- What the variable byte integer reader accepts uses exactly + `Spec.vbiSize` bytes for the value it returns, the fewest + that carry it, for every input. So a longer writing, such + as `[128, 0]` for 0 or `[128, 129, 0]` for 128, is refused + (section 1.5.5, [MQTT-1.5.5-1]). -/ +theorem Spec.decVBI_length (bs : List UInt8) (n : Nat) (r : List UInt8) + (h : decVBI bs = some (n, r)) : + bs.length = r.length + Spec.vbiSize n := sorry + +/-- Every packet the stream reader takes is a header byte, the + printer's writing of the body's length (the shortest, by + `Spec.printVBI_length`), and that many body bytes, all + standing in the input; the bytes it returns are exactly the + ones after them. -/ +theorem Spec.parsePacket_frame (bs : List UInt8) (p : Packet) + (r : List UInt8) (h : parsePacket bs = some (p, r)) : + ∃ (b : UInt8) (body : List UInt8), body.length < 268435456 + ∧ bs = b :: (printVBI body.length ++ body) ++ r := sorry + +/-- The remaining length `[128, 0]`, a two byte writing of 0, is + refused, while its shortest writing `[0]` gives the PINGREQ. + For every input: `Spec.decVBI_length` with + `Spec.parsePacket_frame`. -/ +theorem Spec.rejects_non_minimal_remaining_length : + (parse ([192, 128, 0] : List UInt8)).isSome = false + ∧ parse ([192, 0] : List UInt8) = some .pingreq := sorry + +/-- A writing longer than its value needs is refused in each other + place a variable byte integer stands in a packet, one example + input each, while the same packet with the shortest writing is + accepted: the property length 0 of a PUBLISH written `[128, 0]`, + the property identifier 1 (Payload Format Indicator) written + `[129, 0]`, and the Subscription Identifier value 1 of a + SUBSCRIBE written `[129, 128, 0]`. These are single inputs: no + statement here covers every input in these places. -/ +theorem Spec.rejects_non_minimal_property_vbis : + (parse ([48, 5, 0, 1, 97, 128, 0] : List UInt8)).isSome = false + ∧ (parse ([48, 4, 0, 1, 97, 0] : List UInt8)).isSome = true + ∧ (parse ([48, 7, 0, 1, 97, 3, 129, 0, 1] : List UInt8)).isSome = false + ∧ (parse ([48, 6, 0, 1, 97, 2, 1, 1] : List UInt8)).isSome = true + ∧ (parse ([130, 11, 0, 1, 3, 11, 129, 128, 0, 0, 1, 97, 0] + : List UInt8)).isSome = false + ∧ (parse ([130, 9, 0, 1, 2, 11, 1, 0, 1, 97, 0] + : List UInt8)).isSome = true := sorry + +/-- The standard's worked table of variable byte integers + (section 1.5.5): the printer writes each boundary value as the + bytes the table gives, and the reader reads those bytes as that + value. These are single inputs; for other values the bytes are + pinned by the byte count (`Spec.printVBI_length`) and the round + trip (`Spec.decVBI_printVBI`), not by a statement of their + contents. -/ +theorem Spec.vbi_worked_table : + printVBI 0 = [0] ∧ printVBI 127 = [127] + ∧ printVBI 128 = [128, 1] ∧ printVBI 16383 = [255, 127] + ∧ printVBI 16384 = [128, 128, 1] + ∧ printVBI 2097151 = [255, 255, 127] + ∧ printVBI 2097152 = [128, 128, 128, 1] + ∧ printVBI 268435455 = [255, 255, 255, 127] + ∧ decVBI [0] = some (0, []) ∧ decVBI [127] = some (127, []) + ∧ decVBI [128, 1] = some (128, []) + ∧ decVBI [255, 127] = some (16383, []) + ∧ decVBI [128, 128, 1] = some (16384, []) + ∧ decVBI [255, 255, 127] = some (2097151, []) + ∧ decVBI [128, 128, 128, 1] = some (2097152, []) + ∧ decVBI [255, 255, 255, 127] = some (268435455, []) := sorry + +/-! ## The four byte cap + +The standard carries a variable byte integer in at most four +bytes (section 1.5.5). These statements hold for every input, so +a reader with a higher cap, or none, fails them: on +`[128, 128, 128, 128, 1]` such a reader returns 2^28. -/ + +/-- A variable byte integer whose first four bytes all carry a + continuation mark is refused, whatever follows. -/ +theorem Spec.decVBI_four_byte_cap (b0 b1 b2 b3 : UInt8) (rest : List UInt8) + (h0 : 128 ≤ b0.toNat) (h1 : 128 ≤ b1.toNat) (h2 : 128 ≤ b2.toNat) + (h3 : 128 ≤ b3.toNat) : + decVBI (b0 :: b1 :: b2 :: b3 :: rest) = none := sorry + +/-- A packet whose remaining length has a continuation mark on + each of its first four bytes is refused, by the stream reader + and by the whole input reader, whatever the header byte and + whatever follows. -/ +theorem Spec.parsePacket_four_byte_cap (h b0 b1 b2 b3 : UInt8) + (rest : List UInt8) + (h0 : 128 ≤ b0.toNat) (h1 : 128 ≤ b1.toNat) (h2 : 128 ≤ b2.toNat) + (h3 : 128 ≤ b3.toNat) : + parsePacket (h :: b0 :: b1 :: b2 :: b3 :: rest) = none + ∧ parse (h :: b0 :: b1 :: b2 :: b3 :: rest) = none := sorry + +/-! ## The refusal rules, for every input + +Each statement here holds the reader to a rule written in +`Spec/Defs.lean`, part of the specification, for every input. +They are stated for the stream reader `parsePacket`. By +`Spec.parse_whole`, the whole input reader `parse` accepts a +byte list exactly when `parsePacket` takes one packet from it +and leaves nothing, so each holds for `parse` as well. -/ + +/-- The whole input reader accepts a byte list, and returns a + packet, exactly when the stream reader takes that packet + from it and leaves no byte after it. -/ +theorem Spec.parse_whole (bs : List UInt8) (p : Packet) : + parse bs = some p ↔ parsePacket bs = some (p, []) := sorry + +/-- Every packet the stream reader takes starts with one of the + sixteen header bytes of `Spec.headerBytes`. So a SUBSCRIBE + whose flags are not 0010, any other type with flags other + than 0000, a PUBLISH with QoS 3 or with DUP set at QoS 0, + and every packet type outside the seven of this slice are + refused. -/ +theorem Spec.header_rule (bs : List UInt8) (p : Packet) (r : List UInt8) + (h : parsePacket bs = some (p, r)) : + ∃ (b : UInt8) (tl : List UInt8), bs = b :: tl ∧ b ∈ Spec.headerBytes := sorry + +/-- Every CONNECT the stream reader takes is the header byte + 0x10, the length of the body, and a body that starts with + the protocol name `MQTT` as a string field (the bytes 0, 4, + 77, 81, 84, 84; section 3.1.2.1), the protocol level 5 + (section 3.1.2.2), and a connect flags byte that keeps + `Spec.ConnectFlagsRule`. When a will stands, its topic is not + empty and keeps `Spec.TopicNameRule` (sections 3.1.3.3 and + 4.7). -/ +theorem Spec.connect_rule (bs r : List UInt8) (c : Connect) + (h : parsePacket bs = some (.connect c, r)) : + (∃ (f : UInt8) (tail : List UInt8), + bs = 16 :: (printVBI (8 + tail.length) ++ ([0, 4, 77, 81, 84, 84, 5, f] ++ tail)) ++ r + ∧ Spec.ConnectFlagsRule f.toNat) + ∧ ∀ w, c.will = some w → w.topic ≠ [] ∧ Spec.TopicNameRule w.topic := sorry + +/-- Every PUBLISH the stream reader takes has a topic name that + keeps `Spec.TopicNameRule`, and that is empty only when its + properties carry a Topic Alias, 0x23 (section 3.3.2.1: "It is + a Protocol Error if the Topic Name is zero length and there + is no Topic Alias"). Its packet identifier stands exactly + when the QoS is not 0 [MQTT-2.2.1-2], and is never 0 + [MQTT-2.2.1-3]. -/ +theorem Spec.publish_rule (bs r : List UInt8) (m : Publish) + (h : parsePacket bs = some (.publish m, r)) : + Spec.TopicNameRule m.topic ∧ (m.topic = [] → ∃ q ∈ m.props, q.id = 0x23) + ∧ (m.packetId = none ↔ m.qos = 0) ∧ (∀ i, m.packetId = some i → i ≠ 0) := sorry + +/-- Every SUBSCRIBE the stream reader takes has a packet + identifier other than 0 [MQTT-2.2.1-3], at least one topic + filter [MQTT-3.8.3-2], and every topic filter, with its + options, keeps `Spec.FilterRule`. -/ +theorem Spec.subscribe_rule (bs r : List UInt8) (i : Nat) (ps : List Property) + (fs : List (List Char × SubOpts)) + (h : parsePacket bs = some (.subscribe i ps fs, r)) : + i ≠ 0 ∧ fs ≠ [] ∧ ∀ fo ∈ fs, Spec.FilterRule fo.1 fo.2 := sorry + +/-- Every property block of every packet the stream reader + takes, as `Spec.blocks` lists them, keeps `Spec.BlockRule`: + each property is allowed on its block, has its identifier's + value type and keeps the value rules of `Spec.ValueRule`, no + single use property repeats, and Authentication Data stands + only with an Authentication Method. -/ +theorem Spec.property_rule (bs : List UInt8) (p : Packet) (r : List UInt8) + (h : parsePacket bs = some (p, r)) : + ∀ b ∈ Spec.blocks p, Spec.BlockRule b.1 b.2 := sorry + +/-- Every PINGREQ the stream reader takes is the two bytes 192, + 0, and every PINGRESP the two bytes 208, 0: neither carries + a body (sections 3.12 and 3.13). -/ +theorem Spec.empty_body_rule (bs r : List UInt8) : + (parsePacket bs = some (.pingreq, r) → bs = [192, 0] ++ r) + ∧ (parsePacket bs = some (.pingresp, r) → bs = [208, 0] ++ r) := sorry + +/-! ## Example inputs + +Single inputs the reader refuses or accepts, for the headline +rules of `SPEC.md`; the test harness has a named case for each +rule. Each statement is about its own inputs only, so a reader +of the specification can check each rule against a concrete +case. The rule each one illustrates is stated for every input +in the section above, by the statement its docstring names. -/ + +/-- A SUBSCRIBE packet with flags 0000 is refused: the value the + standard fixes for SUBSCRIBE is 0010. For every input: + `Spec.header_rule`. -/ +theorem Spec.rejects_subscribe_flags : + (parse ([128, 7, 0, 1, 0, 0, 1, 97, 0] : List UInt8)).isSome + = false := sorry + +/-- A PUBLISH packet with QoS 3, header 0x36, is refused: that + QoS value is reserved. For every input: `Spec.header_rule`. -/ +theorem Spec.rejects_publish_qos3 : + (parse ([54, 7, 0, 1, 97, 0, 1, 0, 120] : List UInt8)).isSome + = false := sorry + +/-- A PUBLISH with the DUP flag set at QoS 0 is refused (section + 3.3.1.1, [MQTT-3.3.1-2]): the header byte 0x38. The same + packet with DUP clear, header 0x30, is accepted. For every + input: `Spec.header_rule`. -/ +theorem Spec.rejects_dup_at_qos0 : + (parse ([56, 4, 0, 1, 97, 0] : List UInt8)).isSome = false + ∧ parse ([48, 4, 0, 1, 97, 0] : List UInt8) + = some (.publish ⟨false, 0, false, ['a'], none, [], []⟩) := sorry + +/-- A PUBLISH with an empty topic name is accepted when its + properties carry a Topic Alias, which stands for the topic + (sections 3.3.2.1 and 3.3.2.3.4): here Topic Alias 1. The same + packet with no property is refused, since "It is a Protocol + Error if the Topic Name is zero length and there is no Topic + Alias" (section 3.3.2.1). For every input: + `Spec.publish_rule`. -/ +theorem Spec.empty_topic_needs_alias : + parse ([48, 6, 0, 0, 3, 35, 0, 1] : List UInt8) + = some (.publish ⟨false, 0, false, [], none, [⟨35, .twoByte 1⟩], []⟩) + ∧ (parse ([48, 3, 0, 0, 0] : List UInt8)).isSome = false := sorry + +/-- A PUBLISH topic name holding a wildcard is refused: `a/#` is + a filter, not a topic name. For every input: + `Spec.publish_rule`. -/ +theorem Spec.rejects_wildcard_topic : + (parse ([48, 7, 0, 3, 97, 47, 35, 0, 120] : List UInt8)).isSome + = false := sorry + +/-- A CONNECT whose protocol name is not `MQTT` is refused. For + every input: `Spec.connect_rule`. -/ +theorem Spec.rejects_wrong_protocol_name : + (parse ([16, 14, 0, 4, 77, 81, 84, 85, 5, 2, 0, 0, 0, 0, 1, 120] + : List UInt8)).isSome = false := sorry + +/-- A CONNECT with the reserved bit of the connect flags byte + set is refused. For every input: `Spec.connect_rule`. -/ +theorem Spec.rejects_reserved_connect_flag : + (parse ([16, 14, 0, 4, 77, 81, 84, 84, 5, 3, 0, 0, 0, 0, 1, 120] + : List UInt8)).isSome = false := sorry + +/-- A CONNECT whose will flag is clear but whose will QoS or will + retain bit is set is refused (sections 3.1.2.6 + [MQTT-3.1.2-11] and 3.1.2.7 [MQTT-3.1.2-13]): here the + connect flags 0x0A (will QoS 1) and 0x22 (will retain). With + the flags 0x02 the same bytes are the CONNECT of + `Mqtt.Examples.parse_connect`. For every input: + `Spec.connect_rule`. -/ +theorem Spec.rejects_will_bits_without_will : + (parse ([16, 14, 0, 4, 77, 81, 84, 84, 5, 10, 0, 0, 0, 0, 1, 120] + : List UInt8)).isSome = false + ∧ (parse ([16, 14, 0, 4, 77, 81, 84, 84, 5, 34, 0, 0, 0, 0, 1, 120] + : List UInt8)).isSome = false := sorry + +/-- A CONNECT carrying a Subscription Identifier, a property its + block does not allow, is refused. For every input: + `Spec.property_rule`. -/ +theorem Spec.rejects_property_wrong_type : + (parse ([16, 16, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 2, 11, 5, 0, + 1, 120] : List UInt8)).isSome = false := sorry + +/-- A PUBLISH carrying the single use Topic Alias twice in one + block is refused. For every input: `Spec.property_rule`. -/ +theorem Spec.rejects_repeated_property : + (parse ([50, 12, 0, 1, 97, 0, 3, 6, 35, 0, 1, 35, 0, 2] + : List UInt8)).isSome = false := sorry + +/-- SUBSCRIBE topic filters that break the filter rules are + refused, one example input each (sections 4.7.1, 4.7.3, + 4.8.2 and 3.8.3.1): `#` before the last level, `+` sharing + its level, an empty filter, a shared subscription with No + Local set, and `$share/` with no filter after the ShareName. + Two filters that keep the rules are accepted: `a/+/#`, and + `$share/g/t` with No Local clear. For every input: + `Spec.subscribe_rule`. -/ +theorem Spec.rejects_bad_topic_filters : + -- `a/#/b`: `#` not in the last level + (parse ([130, 11, 0, 1, 0, 0, 5, 97, 47, 35, 47, 98, 0] + : List UInt8)).isSome = false + -- `a+`: `+` not alone in its level + ∧ (parse ([130, 8, 0, 1, 0, 0, 2, 97, 43, 0] : List UInt8)).isSome = false + -- the empty filter + ∧ (parse ([130, 6, 0, 1, 0, 0, 0, 0] : List UInt8)).isSome = false + -- `$share/g/t` with No Local set + ∧ (parse ([130, 16, 0, 1, 0, 0, 10, 36, 115, 104, 97, 114, 101, 47, 103, + 47, 116, 4] : List UInt8)).isSome = false + -- `$share/g`: no `/` and filter after the ShareName + ∧ (parse ([130, 14, 0, 1, 0, 0, 8, 36, 115, 104, 97, 114, 101, 47, 103, 0] + : List UInt8)).isSome = false + -- `a/+/#` is accepted + ∧ parse ([130, 11, 0, 1, 0, 0, 5, 97, 47, 43, 47, 35, 0] : List UInt8) + = some (.subscribe 1 [] [(['a', '/', '+', '/', '#'], ⟨0, false, false, 0⟩)]) + -- `$share/g/t` with No Local clear is accepted + ∧ parse ([130, 16, 0, 1, 0, 0, 10, 36, 115, 104, 97, 114, 101, 47, 103, 47, + 116, 0] : List UInt8) + = some (.subscribe 1 [] + [(['$', 's', 'h', 'a', 'r', 'e', '/', 'g', '/', 't'], + ⟨0, false, false, 0⟩)]) := sorry + +/-- A SUBSCRIBE with packet identifier 0 is refused: + identifiers are never 0. For every input: + `Spec.subscribe_rule`. -/ +theorem Spec.rejects_subscribe_id_zero : + (parse ([130, 7, 0, 0, 0, 0, 1, 97, 0] : List UInt8)).isSome + = false := sorry + +/-- Property values the standard calls a Protocol Error are + refused, one input each: a Subscription Identifier of 0, a + Topic Alias of 0, a Receive Maximum of 0, a Maximum Packet + Size of 0, a Request Problem Information or Request Response + Information of 2, Authentication Data with no Authentication + Method, and a Response Topic that holds a wildcard or is + empty. Changing the offending value byte (to 1, or to `b` + for the Response Topic) gives an input the reader accepts. + For every input: `Spec.property_rule`. -/ +theorem Spec.rejects_property_value_rules : + -- Subscription Identifier 0, on a SUBSCRIBE + (parse ([130, 9, 0, 1, 2, 11, 0, 0, 1, 97, 0] : List UInt8)).isSome = false + -- Topic Alias 0, on a PUBLISH + ∧ (parse ([48, 7, 0, 1, 97, 3, 35, 0, 0] : List UInt8)).isSome = false + -- Receive Maximum 0, on a CONNECT + ∧ (parse ([16, 17, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 3, 33, 0, 0, 0, 1, + 120] : List UInt8)).isSome = false + -- Maximum Packet Size 0, on a CONNECT + ∧ (parse ([16, 19, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 5, 39, 0, 0, 0, 0, 0, + 1, 120] : List UInt8)).isSome = false + -- Request Problem Information 2, on a CONNECT + ∧ (parse ([16, 16, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 2, 23, 2, 0, 1, 120] + : List UInt8)).isSome = false + -- Request Response Information 2, on a CONNECT + ∧ (parse ([16, 16, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 2, 25, 2, 0, 1, 120] + : List UInt8)).isSome = false + -- Authentication Data with no Authentication Method, on a CONNECT + ∧ (parse ([16, 17, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 3, 22, 0, 0, 0, 1, + 120] : List UInt8)).isSome = false + -- Response Topic `#`, on a PUBLISH + ∧ (parse ([48, 8, 0, 1, 97, 4, 8, 0, 1, 35] : List UInt8)).isSome = false + -- an empty Response Topic, on a PUBLISH + ∧ (parse ([48, 7, 0, 1, 97, 3, 8, 0, 0] : List UInt8)).isSome = false := sorry + +/-- The two DISCONNECT forms with a reason code are kept apart + (section 3.14.2.2.1: with a remaining length below 2 there is + no property length): the one byte body `[0]` reads as the + reason code alone and prints back as the same three bytes, + and the body `[0, 0]` reads as the reason code with an empty + property block and prints back as the same four bytes. -/ +theorem Spec.disconnect_short_form : + parse ([224, 1, 0] : List UInt8) = some (.disconnect (some (0, none))) + ∧ print (.disconnect (some (0, none))) = [224, 1, 0] + ∧ parse ([224, 2, 0, 0] : List UInt8) + = some (.disconnect (some (0, some []))) + ∧ print (.disconnect (some (0, some []))) = [224, 2, 0, 0] := sorry + +/-- A PINGREQ with a body is refused: its remaining length must + be 0. For every input: `Spec.empty_body_rule`. -/ +theorem Spec.rejects_pingreq_body : + (parse ([192, 1, 0] : List UInt8)).isSome = false := sorry + +/-- The packet `[32, 0]`, of type 2, outside the seven in this + slice, is refused. For every input: `Spec.header_rule`. -/ +theorem Spec.rejects_unknown_type : + (parse ([32, 0] : List UInt8)).isSome = false := sorry diff --git a/Spec/Defs.lean b/Spec/Defs.lean new file mode 100644 index 0000000..0c5877e --- /dev/null +++ b/Spec/Defs.lean @@ -0,0 +1,188 @@ +/- + Definitions the statements in `Spec.lean` use besides the code + under proof. + + This file is part of the specification, with `Spec.lean` and + `SPEC.md`: `bar.toml` lists it among the spec files, so an + approval covers its text. Each definition here is written from + the MQTT 5.0 standard (OASIS Standard, 7 March 2019; section + numbers below are that standard's), not from the reader in + `Mqtt/Parse.lean` or the well formedness rules in + `Mqtt/Value.lean`. The proofs show that what the reader accepts + keeps these definitions. +-/ + +import Mqtt + +namespace Spec + +open Mqtt + +/-! ## Variable byte integers -/ + +/-- The number of bytes in the shortest variable byte integer + writing of `n` (sections 1.5.5 and 2.1.4). Each byte carries + seven bits of the value, so one byte carries values below + 2^7 = 128, two bytes below 2^14 = 16384, three bytes below + 2^21 = 2097152, and four bytes below 2^28, the largest value + the format allows. -/ +def vbiSize (n : Nat) : Nat := + if n < 128 then 1 else if n < 16384 then 2 else if n < 2097152 then 3 else 4 + +/-! ## The fixed header byte -/ + +/-- The fixed header bytes a packet of this slice may start with + (sections 2.1.2 and 2.1.3, Tables 2-1 and 2-2, and section + 3.3.1): CONNECT 0x10, SUBSCRIBE 0x82 (flags 0010), SUBACK + 0x90, PINGREQ 0xC0, PINGRESP 0xD0 and DISCONNECT 0xE0, whose + flags are fixed [MQTT-2.1.3-1]; and the PUBLISH bytes 0x30 to 0x3D whose QoS + bits (2 and 1) are not the reserved value 3 [MQTT-3.3.1-4] + and whose DUP bit (3) is clear at QoS 0 [MQTT-3.3.1-2]. Any + other first byte, including every packet type outside the + seven of this slice, is not on the list. -/ +def headerBytes : List UInt8 := + [0x10, + 0x30, 0x31, 0x32, 0x33, 0x34, 0x35, 0x3A, 0x3B, 0x3C, 0x3D, + 0x82, 0x90, 0xC0, 0xD0, 0xE0] + +/-! ## CONNECT -/ + +/-- The rules on the CONNECT flags byte `f` (section 3.1.2.3): + the reserved bit 0 is clear [MQTT-3.1.2-3]; the will QoS + field, bits 4 and 3, is not 3 [MQTT-3.1.2-12]; and when the + will flag, bit 2, is clear, the will QoS and will retain + bits, 3 to 5, are all clear [MQTT-3.1.2-11] [MQTT-3.1.2-13]. -/ +def ConnectFlagsRule (f : Nat) : Prop := + f % 2 = 0 ∧ f / 8 % 4 ≠ 3 ∧ (f / 4 % 2 = 0 → f / 8 % 8 = 0) + +/-! ## Topic names -/ + +/-- A Topic Name holds neither wildcard character, `+` or `#` + (section 4.7.1, [MQTT-3.3.2-2]). Whether it may be empty + depends on where it stands, so that is said beside each use. -/ +def TopicNameRule (s : List Char) : Prop := + '+' ∉ s ∧ '#' ∉ s + +/-! ## Properties -/ + +/-- The property identifiers each property block of this slice + may carry, from the packet column of the standard's property + table (section 2.2.2, Table 2-4). The will block is the + will properties inside a CONNECT payload (section 3.1.3.2). -/ +def allowedIds : PropSet → List Nat + | .connect => [0x11, 0x15, 0x16, 0x17, 0x19, 0x21, 0x22, 0x26, 0x27] + | .will => [0x01, 0x02, 0x03, 0x08, 0x09, 0x18, 0x26] + | .publish => [0x01, 0x02, 0x03, 0x08, 0x09, 0x0B, 0x23, 0x26] + | .subscribe => [0x0B, 0x26] + | .suback => [0x1F, 0x26] + | .disconnect => [0x11, 0x1C, 0x1F, 0x26] + +/-- A property value keeps the standard's rules for its + identifier: it has the value type of the identifier's row in + Table 2-4, and the value is not one the standard calls a + Protocol Error. Only the identifiers some block of this slice + allows are listed; any other identifier fails. + + - Response Topic (0x08) is used as a Topic Name, so it is not + empty and holds no wildcard (sections 3.3.2.3.5 + [MQTT-3.3.2-14] and 4.7). + - Subscription Identifier (0x0B) is not 0 (sections 3.3.2.3.8 + and 3.8.2.1.2). + - Request Problem Information (0x17) and Request Response + Information (0x19) are 0 or 1 (sections 3.1.2.11.7 and + 3.1.2.11.6). + - Receive Maximum (0x21) is not 0 (section 3.1.2.11.3). + - Topic Alias (0x23) is not 0 (section 3.3.2.3.4, + [MQTT-3.3.2-8]). + - Maximum Packet Size (0x27) is not 0 (section 3.1.2.11.4). -/ +def ValueRule : Nat → PropVal → Prop + | 0x01, .byte _ => True -- Payload Format Indicator + | 0x02, .fourByte _ => True -- Message Expiry Interval + | 0x03, .utf8 _ => True -- Content Type + | 0x08, .utf8 s => s ≠ [] ∧ TopicNameRule s -- Response Topic + | 0x09, .binary _ => True -- Correlation Data + | 0x0B, .varByte n => n ≠ 0 -- Subscription Identifier + | 0x11, .fourByte _ => True -- Session Expiry Interval + | 0x15, .utf8 _ => True -- Authentication Method + | 0x16, .binary _ => True -- Authentication Data + | 0x17, .byte n => n ≤ 1 -- Request Problem Information + | 0x18, .fourByte _ => True -- Will Delay Interval + | 0x19, .byte n => n ≤ 1 -- Request Response Information + | 0x1C, .utf8 _ => True -- Server Reference + | 0x1F, .utf8 _ => True -- Reason String + | 0x21, .twoByte n => n ≠ 0 -- Receive Maximum + | 0x22, .twoByte _ => True -- Topic Alias Maximum + | 0x23, .twoByte n => n ≠ 0 -- Topic Alias + | 0x26, .utf8Pair _ _ => True -- User Property + | 0x27, .fourByte n => n ≠ 0 -- Maximum Packet Size + | _, _ => False + +/-- The properties that may stand more than once in one block: + the User Property (0x26) anywhere it is allowed (section + 3.1.2.11.8 and the like), and the Subscription Identifier + (0x0B) on PUBLISH, which carries one per matching + subscription (section 3.3.2.3.8). Every other property is + single use: "It is a Protocol Error to include" it "more than + once". -/ +def MayRepeat (s : PropSet) (i : Nat) : Prop := + i = 0x26 ∨ (i = 0x0B ∧ s = .publish) + +/-- The rules on one property block of kind `s`: every property + is allowed on the block and keeps `ValueRule`; no single use + identifier stands more than once; and Authentication Data + (0x16) stands only with an Authentication Method (0x15) + (section 3.1.2.11.10). -/ +def BlockRule (s : PropSet) (ps : List Property) : Prop := + (∀ q ∈ ps, q.id ∈ allowedIds s ∧ ValueRule q.id q.val) + ∧ (∀ i, ¬ MayRepeat s i → (ps.map Property.id).count i ≤ 1) + ∧ ((∃ q ∈ ps, q.id = 0x16) → ∃ q ∈ ps, q.id = 0x15) + +/-- Every property block a packet carries, with its kind: the + CONNECT block and, when a will stands, the will block; the + PUBLISH, SUBSCRIBE and SUBACK blocks; and the DISCONNECT + block when the body carries one. -/ +def blocks : Packet → List (PropSet × List Property) + | .connect c => + (.connect, c.props) :: (match c.will with + | some w => [(.will, w.props)] + | none => []) + | .publish p => [(.publish, p.props)] + | .subscribe _ ps _ => [(.subscribe, ps)] + | .suback _ ps _ => [(.suback, ps)] + | .disconnect (some (_, some ps)) => [(.disconnect, ps)] + | _ => [] + +/-! ## Topic filters -/ + +/-- The wildcard rules over the levels of a topic filter, the + filter split at each `/` (section 4.7.1.1): a level that + holds `+` is `+` alone [MQTT-4.7.1-2], and a level that holds + `#` is `#` alone and is the last level [MQTT-4.7.1-1]. -/ +def WildcardRule (ls : List (List Char)) : Prop := + ∀ (i : Nat) (h : i < ls.length), + ('+' ∈ ls[i] → ls[i] = ['+']) ∧ ('#' ∈ ls[i] → ls[i] = ['#'] ∧ i + 1 = ls.length) + +/-- A topic filter outside a shared subscription: at least one + character long [MQTT-4.7.3-1], and its levels, split at each + `/` by the standard library's `List.splitOn`, keep the + wildcard rules. -/ +def PlainFilterRule (f : List Char) : Prop := + f ≠ [] ∧ WildcardRule (f.splitOn '/') + +/-- The text that starts a shared subscription's filter. -/ +def sharePrefix : List Char := ['$', 's', 'h', 'a', 'r', 'e', '/'] + +/-- The rules on a SUBSCRIBE topic filter `f` with options `o`. + A filter that starts with `$share/` is a shared subscription + (section 4.8.2): after `$share/` comes a ShareName at least + one character long that holds no `/`, `+` or `#` + [MQTT-4.8.2-1] [MQTT-4.8.2-2], then a `/` and a filter that + keeps the plain rules; and its No Local option is clear + [MQTT-3.8.3-4]. Any other filter keeps the plain rules. -/ +def FilterRule (f : List Char) (o : SubOpts) : Prop := + (sharePrefix <+: f → ∃ name flt, f = sharePrefix ++ name ++ '/' :: flt + ∧ name ≠ [] ∧ '/' ∉ name ∧ '+' ∉ name ∧ '#' ∉ name + ∧ PlainFilterRule flt ∧ o.noLocal = false) + ∧ (¬ sharePrefix <+: f → PlainFilterRule f) + +end Spec diff --git a/bar.toml b/bar.toml new file mode 100644 index 0000000..4322349 --- /dev/null +++ b/bar.toml @@ -0,0 +1,83 @@ +# Read by bar/check.py in Proven-Commons/mission. +# See playbook/verified-bar.md there for what each field means. + +[project] +name = "mqtt" +# "in-progress" until every bar item passes, then "verified". +status = "in-progress" +page = "README.md" +# GitHub handles of everyone who wrote the specification. +spec_authors = ["abu-aska", "zero-aska"] +# The program people run. A change to it voids the approval. +entry_points = ["Main.lean"] + +[spec] +files = ["SPEC.md", "Spec.lean", "Spec/Defs.lean"] +# The code under proof: the functions the statements are about. +code = [ + # The data types the statements are about, and their constructors. + "Mqtt.PropType", "Mqtt.PropVal", "Mqtt.PropVal.byte", + "Mqtt.PropVal.twoByte", "Mqtt.PropVal.fourByte", "Mqtt.PropVal.varByte", + "Mqtt.PropVal.utf8", "Mqtt.PropVal.utf8Pair", "Mqtt.PropVal.binary", + "Mqtt.Property", "Mqtt.Property.mk", "Mqtt.PropSet", "Mqtt.SubOpts", + "Mqtt.SubOpts.mk", "Mqtt.Will", "Mqtt.Connect", "Mqtt.Publish", + "Mqtt.Publish.mk", "Mqtt.Packet", "Mqtt.Packet.connect", + "Mqtt.Packet.publish", "Mqtt.Packet.subscribe", "Mqtt.Packet.suback", + "Mqtt.Packet.pingreq", "Mqtt.Packet.pingresp", "Mqtt.Packet.disconnect", + # The fields, constructors and match recursors of those types that + # the rules in Spec/Defs.lean read. + "Mqtt.Property.id", "Mqtt.Property.val", "Mqtt.PropVal.rec", + "Mqtt.PropVal.ctorIdx", "Mqtt.PropSet.connect", "Mqtt.PropSet.will", + "Mqtt.PropSet.publish", "Mqtt.PropSet.subscribe", "Mqtt.PropSet.suback", + "Mqtt.PropSet.disconnect", "Mqtt.PropSet.casesOn", "Mqtt.Connect.props", + "Mqtt.Connect.will", "Mqtt.Will.props", "Mqtt.Will.topic", + "Mqtt.Publish.topic", "Mqtt.Publish.qos", "Mqtt.Publish.packetId", + "Mqtt.Publish.props", "Mqtt.SubOpts.noLocal", "Mqtt.Packet.rec", + "Mqtt.Packet.ctorIdx", + # The property table. + "Mqtt.valType", "Mqtt.propTypeOf", "Mqtt.allowedOf", "Mqtt.repeatableIn", + # The byte forms and the printer. + "Mqtt.writeBE", "Mqtt.printVBI", "Mqtt.printStr", "Mqtt.printBin", + "Mqtt.printPropVal", "Mqtt.printProperty", "Mqtt.printPropsList", + "Mqtt.printProps", "Mqtt.printOptsByte", "Mqtt.connectFlags", + "Mqtt.printWillPart", "Mqtt.printOptStr", "Mqtt.printOptBin", + "Mqtt.printConnectBody", "Mqtt.publishHeader", "Mqtt.printIdOpt", + "Mqtt.printPublishBody", "Mqtt.printFilter", "Mqtt.printFilters", + "Mqtt.printSubscribeBody", "Mqtt.printSubackBody", "Mqtt.bodyOf", + "Mqtt.headerOf", "Mqtt.print", + # Well formedness, and the value, topic and filter rules the + # reader and the well formedness share. + "Mqtt.hasNul", "Mqtt.StrWF", "Mqtt.BinWF", "Mqtt.TopicWF", "Mqtt.ValWF", + "Mqtt.propValOK", "Mqtt.authOK", "Mqtt.hasTopicAlias", "Mqtt.PubTopicWF", + "Mqtt.splitLevels", "Mqtt.levelOK", "Mqtt.levelsOK", "Mqtt.plainFilterOK", + "Mqtt.shareSplit", "Mqtt.filterOK", + "Mqtt.PropsWF", "Mqtt.PropsBlockWF", "Mqtt.WillWF", "Mqtt.ConnectWF", + "Mqtt.PublishWF", "Mqtt.OptsWF", "Mqtt.FiltersWF", "Mqtt.PacketFieldsWF", + "Mqtt.PacketWF", + # The strict UTF-8 codec the string reader rests on. + "Mqtt.Utf8.encodeChar", "Mqtt.Utf8.encode", "Mqtt.Utf8.contVal", + "Mqtt.Utf8.decode", + # The length checked readers and the parser. + "Mqtt.readNat", "Mqtt.readBytes", "Mqtt.readByte", "Mqtt.decVBIGo", + "Mqtt.decVBI", "Mqtt.checkChars", "Mqtt.readStr", "Mqtt.readBin", + "Mqtt.readPropVal", "Mqtt.readEntry", "Mqtt.readEntriesGo", + "Mqtt.readEntries", "Mqtt.readProps", "Mqtt.readOptsByte", + "Mqtt.readFiltersGo", "Mqtt.flagBit", "Mqtt.checkTopic", + "Mqtt.checkNoWildcards", + "Mqtt.readWillPart", "Mqtt.readOptStrField", "Mqtt.readOptBinField", + "Mqtt.readConnectBody", "Mqtt.readPacketId", "Mqtt.readPublishBody", + "Mqtt.readSubscribeBody", "Mqtt.readSubackBody", "Mqtt.readDisconnectBody", + "Mqtt.parseBody", "Mqtt.parsePacket", "Mqtt.parse", +] + +# One entry per approval, added in a pull request the reviewer approves. +# [[spec.approval]] +# reviewer = "github-handle" +# date = "2026-11-02" +# sha256 = "..." +# record = "https://github.com/Proven-Commons/mqtt/pull/" + +[tests] +results = "tests/TEST-RESULTS.md" +command = "python3 tests/run_tests.py" +files = ["tests/run_tests.py", "tests/plant_bugs.py"] diff --git a/comparator.json b/comparator.json new file mode 100644 index 0000000..6c55bed --- /dev/null +++ b/comparator.json @@ -0,0 +1 @@ +{"challenge_module":"Spec","permitted_axioms":["propext","Classical.choice","Quot.sound"],"solution_module":"Proofs","theorem_names":["Spec.parsePacket_print","Spec.parse_print","Spec.parse_sound","Spec.parsePacket_sound","Spec.decVBI_printVBI","Spec.decVBI_canonical","Spec.printVBI_length","Spec.decVBI_length","Spec.parsePacket_frame","Spec.rejects_non_minimal_remaining_length","Spec.rejects_non_minimal_property_vbis","Spec.vbi_worked_table","Spec.decVBI_four_byte_cap","Spec.parsePacket_four_byte_cap","Spec.parse_whole","Spec.header_rule","Spec.connect_rule","Spec.publish_rule","Spec.subscribe_rule","Spec.property_rule","Spec.empty_body_rule","Spec.rejects_subscribe_flags","Spec.rejects_publish_qos3","Spec.rejects_dup_at_qos0","Spec.empty_topic_needs_alias","Spec.rejects_wildcard_topic","Spec.rejects_wrong_protocol_name","Spec.rejects_reserved_connect_flag","Spec.rejects_will_bits_without_will","Spec.rejects_property_wrong_type","Spec.rejects_repeated_property","Spec.rejects_bad_topic_filters","Spec.rejects_subscribe_id_zero","Spec.rejects_property_value_rules","Spec.disconnect_short_form","Spec.rejects_pingreq_body","Spec.rejects_unknown_type"]} \ No newline at end of file diff --git a/lake-manifest.json b/lake-manifest.json new file mode 100644 index 0000000..8cae1c0 --- /dev/null +++ b/lake-manifest.json @@ -0,0 +1,6 @@ +{"version": "1.3.0", + "packagesDir": ".lake/packages", + "packages": [], + "name": "mqtt", + "lakeDir": ".lake", + "fixedToolchain": false} diff --git a/lakefile.toml b/lakefile.toml new file mode 100644 index 0000000..ede81c8 --- /dev/null +++ b/lakefile.toml @@ -0,0 +1,17 @@ +name = "mqtt" +version = "0.1.0" +license = "Apache-2.0" +defaultTargets = ["Mqtt", "Proofs", "mqtt"] + +[[lean_lib]] +name = "Mqtt" + +[[lean_lib]] +name = "Proofs" + +[[lean_lib]] +name = "Spec" + +[[lean_exe]] +name = "mqtt" +root = "Main" diff --git a/lean-toolchain b/lean-toolchain new file mode 100644 index 0000000..a6aff06 --- /dev/null +++ b/lean-toolchain @@ -0,0 +1 @@ +leanprover/lean4:v4.35.0 diff --git a/tests/PLANTED-BUGS.md b/tests/PLANTED-BUGS.md new file mode 100644 index 0000000..8f5929c --- /dev/null +++ b/tests/PLANTED-BUGS.md @@ -0,0 +1,23 @@ +# Planted bugs: mqtt + +Written by `python3 tests/plant_bugs.py`. Each plant is a small change to the reader or its rules, put in a scratch copy of the repo. Tests: the harness run against the planted tool, caught when it reports a failure. Proofs: `lake build` with the planted code, caught when the proofs of the approved statements no longer build. Each plant makes the statement named in its row false, and the first failing test input is a witness: the planted reader accepts it, and the statement says no reader that meets it does. So no proof can be repaired to go through. The first row is the control, with no plant: it must pass both. + +| Plant | What it changes | Statement it makes false | Caught by the tests | Caught by the proofs | +| --- | --- | --- | --- | --- | +| none | no plant: the repo as committed | | no failure (sections=5 inputs=4855 agreements=4855 failures=0 paho=no mosquitto=no) | builds | +| cap5 | variable byte integers may take five bytes | `Spec.decVBI_four_byte_cap` | yes, 1 failure; first: FAIL mutation/five byte subscription identifier: got ok:130,13,0,1,6,11,128,128,128,128,1,0,1,97,0, want none | yes, 3 errors; first: error: Proofs/RoundTrip.lean:117:2: Type mismatch | +| longer_writings | a variable byte integer written in more bytes than needed is accepted (128, 0 for 0) | `Spec.decVBI_length` | yes, 5 failures; first: FAIL fixed/vbi non-minimal 134,0 as remaining length: got ok:48,6,0,1,97,0,1,2, want none | yes, 5 errors; first: error: Proofs/Examples.lean:49:55: Tactic `decide` proved that the proposition | +| zero_padding | a field cut short by the end of the input is padded with zero bytes | `Spec.parse_sound` | yes, 46 failures; first: FAIL mutation/connect truncate 64: got ok:16,68,0,4,77,81,84,84,5,238,0,60,12,17,0,0,14,16,38,0,1,107,0,1,118,0,8,99,108,105,101,110,116,45,49,5,24,0,... | yes, 5 errors; first: error: Proofs/RoundTrip.lean:63:6: Tactic `rewrite` failed: Did not find an occurrence of the pattern | +| subscribe_flags | a SUBSCRIBE with flags 0000 is accepted as well as 0010 | `Spec.header_rule` | yes, 2 failures; first: FAIL mutation/subscribe with flags 0000: got ok:130,7,0,1,0,0,1,97,0, want none | yes, 2 errors; first: error: Proofs/Sound.lean:944:10: Tactic `rewrite` failed: Did not find an occurrence of the pattern | +| dup_qos0 | a PUBLISH with DUP set at QoS 0 is accepted | `Spec.header_rule` | yes, 2 failures; first: FAIL mutation/publish dup at qos 0: got ok:56,4,0,1,97,0, want none | yes, 1 error; first: error: Proofs/RoundTrip.lean:1292:2: 'show' tactic failed, pattern | +| will_bits | will QoS and will retain bits are accepted with the will flag clear | `Spec.connect_rule` | yes, 6 failures; first: FAIL mutation/connect will qos 1 without the will flag: got ok:16,14,0,4,77,81,84,84,5,2,0,0,0,0,1,120, want none | yes, 2 errors; first: error: Proofs/RoundTrip.lean:1113:6: Tactic `rewrite` failed: Did not find an occurrence of the pattern | +| empty_topic | an empty PUBLISH topic is accepted without a Topic Alias | `Spec.publish_rule` | yes, 2 failures; first: FAIL mutation/publish empty topic, no topic alias: got ok:48,3,0,0,0, want none | yes, 3 errors; first: error: Proofs/Examples.lean:107:2: Tactic `decide` proved that the proposition | +| disconnect_form | the one byte DISCONNECT body is read as the long form | `Spec.disconnect_short_form` | yes, 90 failures; first: FAIL fixed/disconnect reason only, reprinted as it came: got ok:224,2,0,0, want ok:224,1,0 | yes, 3 errors; first: error: Proofs/Examples.lean:69:66: Tactic `decide` proved that the proposition | +| filters_unchecked | SUBSCRIBE topic filters are not checked at all | `Spec.subscribe_rule` | yes, 415 failures; first: FAIL mutation/topic filter 'a/#/b' options 0: got ok:130,11,0,1,0,0,5,97,47,35,47,98,0, want none | yes, 1 error; first: error: Proofs/RoundTrip.lean:689:10: Tactic `rewrite` failed: Did not find an occurrence of the pattern | +| filter_partial | a # level is accepted before the last level when three or more levels follow it (a/#/b/c/d) | `Spec.subscribe_rule` | yes, 14 failures; first: FAIL forbidden/topic filter hash_not_last '#/-0.c/+/+': input [130, 65, 104, 83, 28, 11, 1, 38, 0, 8, 226, 152, 149, 195, 188, 89, 32, 95, 0, 4, 89, 1... | yes, 1 error; first: error: Proofs/Rules.lean:360:39: Application type mismatch: The argument | +| value_partial | Request Problem Information 3 is accepted | `Spec.property_rule` | yes, 1 failure; first: FAIL forbidden/request problem information 3: input [16, 38, 0, 4, 77, 81, 84, 84, 5, 12, 65, 243, 2, 23, 3, 0, 5, 95, 46, 195, 169, 90, 0, 0, 9, 47, ... | yes, 1 error; first: error: Proofs/Rules.lean:236:33: unsolved goals | +| subid_zero | a Subscription Identifier of 0 is accepted | `Spec.property_rule` | yes, 63 failures; first: FAIL fixed/vbi 0 as a subscription identifier, refused: got ok:130,9,0,1,2,11,0,0,1,97,0, want none | yes, 1 error; first: error: Proofs/Rules.lean:236:33: unsolved goals | +| response_topic_hash | a Response Topic holding # is accepted (+ is still refused) | `Spec.property_rule` | yes, 51 failures; first: FAIL mutation/response topic with #: got ok:48,11,0,1,97,6,8,0,3,97,47,35,120, want none | yes, 1 error; first: error: Proofs/Rules.lean:236:33: unsolved goals | +| auth_unchecked | Authentication Data is accepted without a Method | `Spec.property_rule` | yes, 31 failures; first: FAIL mutation/authentication data without method: got ok:16,18,0,4,77,81,84,84,5,2,0,0,4,22,0,1,120,0,1,120, want none | yes, 1 error; first: error: Proofs/Rules.lean:267:8: Tactic `rewrite` failed: Did not find an occurrence of the pattern | + +Every plant caught by both: yes. diff --git a/tests/TEST-RESULTS.md b/tests/TEST-RESULTS.md new file mode 100644 index 0000000..ae42259 --- /dev/null +++ b/tests/TEST-RESULTS.md @@ -0,0 +1,31 @@ +# Test results: mqtt + +- Oracle: the strict reference decoder and encoder in tests/run_tests.py, written from the OASIS MQTT Version 5.0 standard (OASIS Standard, 7 March 2019) and SPEC.md, run on Python 3.13.17; with a cross-check against paho-mqtt 2.1.0, counted apart +- Seed: 20261026 +- Inputs: 4855 +- Failures: 0 + +Tool: the Lean command line program, one process per section, requests batched. The harness checks parsed structure through the re-encoding the tool prints, together with its own oracle, and checks that every input the tool accepts among the mutations and named cases reprints byte for byte. Inputs counts the sections that run on every machine. + +Paho's Python library (`paho-mqtt`, version 2.1.0) was importable in the interpreter that ran this harness; the Paho cross-check ran. Each of its inputs compares an answer of the Lean tool with Paho's: Paho's encoder output for variable byte integers must come back unchanged, and Paho's Properties.unpack judges property blocks of all six kinds, accepted and refused, the pieces the library exposes without a broker. It does not judge whole packets. Its inputs are listed below and are not part of Inputs. + +The plan's third oracle, MQTT 5.0 specification test material, was NOT used: the standard ships no conformance test suite, and the nearest material, the MQTTV5 codec in Eclipse paho.mqtt.testing, is not wired into this harness. + +Mosquitto was NOT present on this machine (no `mosquitto` or `mosquitto_sub` binary), so no Mosquitto tests ran. + +| Section | Inputs | Agreements | +| --- | --- | --- | +| Fixed cases (spec VBI table, one packet per type, richer hand built packets) | 37 | 37 | +| Oracle differential, random packets of all seven types (seed 20261026) | 3000 | 3000 | +| Mutations and named rejections, settled by the oracle | 325 | 325 | +| Forbidden classes drawn from the seed (property values, Response Topics, Authentication Data, topic filters of 1 to 6 levels), with controls, settled by the oracle | 1484 | 1484 | +| Line protocol cases | 9 | 9 | +| Paho 2.1.0 cross-check, each a Lean answer judged by Paho: its variable byte integer writings as Subscription Identifiers, and property blocks of all six kinds judged by Properties.unpack (Lean accepted 375, refused 352; not counted in Inputs) | 727 | 727 | + +Named differences from the oracles: +- Payload Format Indicator 2 on PUBLISH, and the like: section 3.3.2.3.2 names 0 and 1 but does not call another value a Protocol Error, so this reader accepts it; Paho refuses it. Checked on single blocks, not counted as comparisons. +- Response Topic with a wildcard on PUBLISH, and the like: MQTT-3.3.2-14 forbids wildcards in a Response Topic and 4.7.3-1 an empty one, so this reader refuses them; Paho accepts them. Checked on single blocks, not counted as comparisons. +- Authentication Data without a Method on CONNECT, and the like: section 3.1.2.11.10 makes Authentication Data without an Authentication Method a Protocol Error, so this reader refuses it; Paho accepts it. Checked on single blocks, not counted as comparisons. +- Maximum Packet Size 4294967295 on CONNECT, and the like: section 3.1.2.11.4 makes the Maximum Packet Size a Four Byte Integer and calls only 0 (or a repeat) a Protocol Error, so this reader accepts values up to 2^32 - 1; Paho refuses those above 268435455. Checked on single blocks, not counted as comparisons. +- two Subscription Identifiers on SUBSCRIBE, and the like: section 3.8.2.1.2 makes a second Subscription Identifier on SUBSCRIBE a Protocol Error, so this reader refuses it; Paho allows the repeat on any packet. Checked on single blocks, not counted as comparisons. +- paho-mqtt's VariableByteIntegers.decode reads the longer writing 128, 0 as (0, 2) (value, bytes read); this reader refuses that writing, as MQTT-1.5.5-1 requires (the fixed cases check it), so the property blocks Paho judges hold only shortest writings. diff --git a/tests/plant_bugs.py b/tests/plant_bugs.py new file mode 100644 index 0000000..15019d0 --- /dev/null +++ b/tests/plant_bugs.py @@ -0,0 +1,246 @@ +#!/usr/bin/env python3 +"""Planted bugs: does a wrong reader get caught? + +Each plant below is a small change to the reader or to its rules +in Mqtt/, the kind of bug the statements and the tests are meant +to catch. For each one, in a scratch copy of the repo, the script: + +1. builds the command line tool (`lake build mqtt`), which does + not need the proofs, and runs the test harness against it + (`tests/run_tests.py --skip-build`). The plant is caught by the + tests when the harness reports a failure. +2. builds everything (`lake build`), the proofs included. The + plant is caught by the proofs when that build fails: the proofs + of the approved statements in Spec.lean no longer go through. + For a planted bug that makes a statement false, no proof can + go through. The script reports the first error. + +A run with no plant comes first, as the control: it must build and +pass. The outcome is written to tests/PLANTED-BUGS.md. + +Among the plants are the ones review 1 (finding 10) and the +independent check asked for: a reader with a five byte cap, a +reader that accepts longer writings of a variable byte integer, a +reader that pads a short input with zeros, and a partial weakening +of the filter and value rules (`#` before the last level when three +or more levels follow, and Request Problem Information 3). + +Usage: python3 tests/plant_bugs.py [--keep] [names...] +--keep leaves the scratch copies in place. Names pick plants. +""" + +import os +import shutil +import subprocess +import sys +import tempfile + +HERE = os.path.dirname(os.path.abspath(__file__)) +ROOT = os.path.dirname(HERE) + +# (name, the approved statement the plant makes false, what it +# does, file, text to replace, replacement). The failing test +# input is the witness: the planted reader accepts it, and the +# statement says no reader that meets it does. +PLANTS = [ + ("cap5", "Spec.decVBI_four_byte_cap", + "variable byte integers may take five bytes", + "Mqtt/Parse.lean", " decVBIGo 4 bs", " decVBIGo 5 bs"), + ("longer_writings", "Spec.decVBI_length", + "a variable byte integer written in more bytes than needed is " + "accepted (128, 0 for 0)", + "Mqtt/Parse.lean", + "| some (v, r) => if v = 0 then none else some", + "| some (v, r) => if v = 0 ∧ False then none else some"), + ("zero_padding", "Spec.parse_sound", + "a field cut short by the end of the input is padded with zero " + "bytes", + "Mqtt/Parse.lean", + " if bs.length ≥ n then some (bs.take n, bs.drop n) else none", + " some ((bs ++ List.replicate n 0).take n, bs.drop n)"), + ("subscribe_flags", "Spec.header_rule", + "a SUBSCRIBE with flags 0000 is accepted as well as 0010", + "Mqtt/Parse.lean", + " | 8 => if flags = 2 then readSubscribeBody seg else none", + " | 8 => if flags = 2 ∨ flags = 0 then readSubscribeBody seg else none"), + ("dup_qos0", "Spec.header_rule", + "a PUBLISH with DUP set at QoS 0 is accepted", + "Mqtt/Parse.lean", + "else if (flags / 2) % 4 = 0 ∧ flagBit flags 3 = true then none", + "else if False then none"), + ("will_bits", "Spec.connect_rule", + "will QoS and will retain bits are accepted with the will flag " + "clear", + "Mqtt/Parse.lean", + "if flagBit flags 2 || (flags / 8) % 8 = 0 then", "if true then"), + ("empty_topic", "Spec.publish_rule", + "an empty PUBLISH topic is accepted without a Topic Alias", + "Mqtt/Parse.lean", + " if topic.isEmpty && !hasTopicAlias props then none", + " if false then none"), + ("disconnect_form", "Spec.disconnect_short_form", + "the one byte DISCONNECT body is read as the long form", + "Mqtt/Parse.lean", + "if r1.isEmpty then some (.disconnect (some (rc.toNat, none)))", + "if r1.isEmpty then some (.disconnect (some (rc.toNat, some [])))"), + ("filters_unchecked", "Spec.subscribe_rule", + "SUBSCRIBE topic filters are not checked at all", + "Mqtt/Parse.lean", " if filterOK f o then", + " if true then"), + ("filter_partial", "Spec.subscribe_rule", + "a # level is accepted before the last level when three or more " + "levels follow it (a/#/b/c/d)", + "Mqtt/Value.lean", " | l :: ls => levelOK l && levelsOK ls", + " | l :: ls => (levelOK l || (l == ['#'] && 3 ≤ ls.length)) " + "&& levelsOK ls"), + ("value_partial", "Spec.property_rule", + "Request Problem Information 3 is accepted", + "Mqtt/Value.lean", " | 0x17, .byte n => n ≤ 1\n", + " | 0x17, .byte n => n ≤ 1 || n = 3\n"), + ("subid_zero", "Spec.property_rule", + "a Subscription Identifier of 0 is accepted", + "Mqtt/Value.lean", " | 0x0B, .varByte n => n != 0\n", ""), + ("response_topic_hash", "Spec.property_rule", + "a Response Topic holding # is accepted (+ is still refused)", + "Mqtt/Value.lean", + " | 0x08, .utf8 s => !s.isEmpty && !s.contains '+' && !s.contains '#'", + " | 0x08, .utf8 s => !s.isEmpty && !s.contains '+'"), + ("auth_unchecked", "Spec.property_rule", + "Authentication Data is accepted without a Method", + "Mqtt/Value.lean", + " !(ps.any fun p => p.id == 0x16) || ps.any fun p => p.id == 0x15", + " true"), +] + + +def run(cmd, cwd, timeout=3600): + env = dict(os.environ) + env["PATH"] = os.path.expanduser("~/.elan/bin") + ":" + env.get("PATH", "") + return subprocess.run(cmd, cwd=cwd, env=env, capture_output=True, + text=True, timeout=timeout) + + +def copy_repo(dest): + files = subprocess.run(["git", "ls-files", "-z"], cwd=ROOT, + capture_output=True, text=True, + check=True).stdout.split("\0") + for rel in files: + if not rel: + continue + os.makedirs(os.path.join(dest, os.path.dirname(rel)), exist_ok=True) + shutil.copy2(os.path.join(ROOT, rel), os.path.join(dest, rel)) + # Reuse the build of the unplanted repo, so only what the plant + # touches is rebuilt. + build = os.path.join(ROOT, ".lake") + if os.path.isdir(build): + shutil.copytree(build, os.path.join(dest, ".lake"), symlinks=True) + + +def try_plant(name, stmt, desc, rel, old, new, keep): + d = tempfile.mkdtemp(prefix=f"mqtt-plant-{name}-") + try: + copy_repo(d) + if rel: + path = os.path.join(d, rel) + with open(path) as fh: + text = fh.read() + if text.count(old) != 1: + return dict(name=name, stmt=stmt, desc=desc, error=( + f"the text to replace stands {text.count(old)} times " + f"in {rel}")) + with open(path, "w") as fh: + fh.write(text.replace(old, new)) + tool = run(["lake", "build", "mqtt"], d) + if tool.returncode != 0: + return dict(name=name, stmt=stmt, desc=desc, + error="the tool does not build: " + + (tool.stdout + tool.stderr).strip()[-300:]) + t = run([sys.executable, "tests/run_tests.py", "--skip-build"], d) + fails = [l for l in t.stdout.splitlines() if l.startswith("FAIL")] + summary = [l for l in t.stdout.splitlines() if l.startswith("sections=")] + full = run(["lake", "build"], d) + errs = [l for l in (full.stdout + full.stderr).splitlines() + if l.startswith("error: ") and "build failed" not in l] + return dict(name=name, stmt=stmt, desc=desc, + tests_failed=t.returncode != 0, + n_fail=len(fails), first_fail=fails[0] if fails else "", + summary=summary[0] if summary else "", + proofs_failed=full.returncode != 0, n_err=len(errs), + first_err=errs[0] if errs else "") + finally: + if not keep: + shutil.rmtree(d, ignore_errors=True) + + +def plural(n, word): + return f"{n} {word}" + ("" if n == 1 else "s") + + +def short(text, n=150): + text = text.replace("|", "/") + return text if len(text) <= n else text[:n] + "..." + + +def main(): + keep = "--keep" in sys.argv + picked = [a for a in sys.argv[1:] if not a.startswith("--")] + plants = [p for p in PLANTS if not picked or p[0] in picked] + results = [try_plant("none", "", "no plant: the repo as committed", + None, None, None, keep)] + print(results[0]) + for p in plants: + r = try_plant(*p, keep) + print(r) + results.append(r) + lines = ["# Planted bugs: mqtt", "", + "Written by `python3 tests/plant_bugs.py`. Each plant is a " + "small change to the reader or its rules, put in a scratch " + "copy of the repo. Tests: the harness run against the " + "planted tool, caught when it reports a failure. Proofs: " + "`lake build` with the planted code, caught when the proofs " + "of the approved statements no longer build. Each plant " + "makes the statement named in its row false, and the first " + "failing test input is a witness: the planted reader " + "accepts it, and the statement says no reader that meets it " + "does. So no proof can be repaired to go through. The first " + "row is the control, with no plant: it must pass both.", "", + "| Plant | What it changes | Statement it makes false | " + "Caught by the tests | Caught by the proofs |", + "| --- | --- | --- | --- | --- |"] + ok = True + for r in results: + if "error" in r: + ok = False + lines.append(f"| {r['name']} | {short(r['desc'])} | " + f"`{r['stmt']}` | could not run: " + f"{short(r['error'])} | |") + continue + if r["name"] == "none": + good = not r["tests_failed"] and not r["proofs_failed"] + ok = ok and good + lines.append(f"| none | {r['desc']} | | " + f"{'no failure' if not r['tests_failed'] else 'FAILED'}" + f" ({short(r['summary'])}) | " + f"{'builds' if not r['proofs_failed'] else 'FAILED'} |") + continue + ok = ok and r["tests_failed"] and r["proofs_failed"] + tests = (f"yes, {plural(r['n_fail'], 'failure')}; first: " + f"{short(r['first_fail'])}" if r["tests_failed"] + else "NO: the harness passes") + proofs = (f"yes, {plural(r['n_err'], 'error')}; first: " + f"{short(r['first_err'])}" + if r["proofs_failed"] else "NO: the proofs build") + lines.append(f"| {r['name']} | {short(r['desc'])} | `{r['stmt']}` " + f"| {tests} | {proofs} |") + lines.append("") + lines.append("Every plant caught by both: " + ("yes." if ok else "NO.")) + lines.append("") + if not picked: + with open(os.path.join(HERE, "PLANTED-BUGS.md"), "w") as fh: + fh.write("\n".join(lines)) + print("\n".join(lines)) + return 0 if ok else 1 + + +if __name__ == "__main__": + sys.exit(main()) diff --git a/tests/run_tests.py b/tests/run_tests.py new file mode 100644 index 0000000..53a6d40 --- /dev/null +++ b/tests/run_tests.py @@ -0,0 +1,1681 @@ +#!/usr/bin/env python3 +"""Test harness for the Lean MQTT 5.0 packet codec. + +Layers, all settled against independent expectations: + +1. Fixed cases: the variable byte integer table from section + 2.1.4 of the standard, hand built packets for each of the + seven packet types in this slice, and the DISCONNECT one + byte body form, which is legal and reprints as it came. + +2. A differential against a strict oracle written here from + the standard and from SPEC.md: random packets of all seven + types with varied properties are encoded by the oracle, + read by the Lean tool, and the answer must be the same + bytes reprinted. + +3. A cross-check against Paho's Python library when it is + importable, in which Paho judges each Lean answer: variable + byte integers written by its encoder are fed to the Lean + tool as Subscription Identifiers and must come back + unchanged, and property blocks of all six kinds, accepted + and refused, are judged by Paho's Properties.unpack and by + the Lean tool, whose verdicts must agree. The classes where + Paho departs from the standard are checked apart for their + documented direction, as named differences. When the + library is absent, the run says so and the oracle carries + accept and reject alone. The Mosquitto + test suite is a separate program, not a Python library; the + run checks for its binary and the results file states + whether it was present. + +Mutations of rich packets (truncation at every length, byte +flips at every position) and a list of named rejection cases +are settled by comparing the Lean answer with the oracle's +answer on the same bytes. + +Forbidden classes are drawn from the seed as well: random valid +packets with one rule broken, for every Request Problem +Information and Request Response Information value from 2 to +255, the value 0 of the Subscription Identifier, Receive +Maximum, Topic Alias and Maximum Packet Size, Response Topics +with a wildcard or empty, Authentication Data without a Method, +and topic filters of 1 to 6 levels that break a wildcard or +shared subscription rule. The oracle settles them, and the run +checks that the oracle's own rule checks (prop_value_ok, +filter_ok) call each one forbidden. Controls that keep the rule +must be accepted. + +Results are written to tests/TEST-RESULTS.md. Seed 20261026. + +Usage: python3 tests/run_tests.py [--skip-build] +Run it with the work directory's virtual environment +(./venv/bin/python tests/run_tests.py) to get the Paho +cross-check; without the library that part is skipped and +the results file says so. +""" + +import os +import random +import shutil +import subprocess +import sys + +HERE = os.path.dirname(os.path.abspath(__file__)) +ROOT = os.path.dirname(HERE) +EXE = os.path.join(ROOT, ".lake", "build", "bin", "mqtt") +SEED = 20261026 + +failures = [] +paho_named = [] + + +def check(cond, label, detail=""): + if not cond: + failures.append(f"{label}: {detail}") + print(f"FAIL {label}: {detail}") + + +# --------------------------------------------------------------------------- +# Batch runner: one process for many requests. +# --------------------------------------------------------------------------- + +class Tool: + def __init__(self): + self.lines = [] + + def ask(self, line): + self.lines.append(line) + return len(self.lines) - 1 + + def run(self): + proc = subprocess.run([EXE], input="\n".join(self.lines) + "\n", + capture_output=True, text=True, timeout=1200) + if proc.returncode != 0: + raise RuntimeError(f"tool exited {proc.returncode}: {proc.stderr[:500]}") + self.answers = proc.stdout.splitlines() + if len(self.answers) != len(self.lines): + raise RuntimeError( + f"answer count {len(self.answers)} != request count {len(self.lines)}") + return self.answers + + +def req(bs): + return "parse " + ",".join(str(b) for b in bs) + + +def want_ok(canon): + return "ok:" + ",".join(str(b) for b in canon) + + +# --------------------------------------------------------------------------- +# Oracle: canonical encoder and strict decoder, written from the +# MQTT 5.0 standard and SPEC.md. +# +# Packet representation: +# ("connect", clean, keep_alive, props, client_id, will, +# username, password) +# will is None or (qos, retain, props, topic, payload bytes) +# username is None or str; password is None or bytes +# ("publish", dup, qos, retain, topic, packet_id, props, payload) +# packet_id is None at QoS 0 +# ("subscribe", packet_id, props, filters) +# filters is a list of (str, (qos, no_local, retain_as_published, +# retain_handling)) +# ("suback", packet_id, props, [reason, ...]) +# ("pingreq",) ("pingresp",) +# ("disconnect", None), ("disconnect", (reason, None)) for the +# one byte body, or ("disconnect", (reason, props)) +# A property is (id, value): an int for byte, two byte, four byte, +# and variable byte integer values; a str for a UTF-8 string value; +# a (str, str) pair for a user property; bytes for binary data. +# --------------------------------------------------------------------------- + +class Reject(Exception): + pass + + +def enc_vbi(n): + out = bytearray() + while True: + d = n % 128 + n //= 128 + if n: + out.append(d + 128) + else: + out.append(d) + return bytes(out) + + +def dec_vbi(bs, i): + """Section 1.5.5: at most four bytes, and the writing must be + the shortest one for its value [MQTT-1.5.5-1], checked here + by writing the value again and comparing.""" + start = i + value = 0 + mult = 1 + for _ in range(4): + if i >= len(bs): + raise Reject() + b = bs[i] + i += 1 + value += (b % 128) * mult + if b < 128: + if enc_vbi(value) != bytes(bs[start:i]): + raise Reject() + return value, i + mult *= 128 + raise Reject() + + +def be16(n): + return n.to_bytes(2, "big") + + +def dec_uint(bs, i, w): + if i + w > len(bs): + raise Reject() + return int.from_bytes(bs[i:i + w], "big"), i + w + + +def enc_str(s): + raw = s.encode("utf-8") + return be16(len(raw)) + raw + + +def dec_str(bs, i): + ln, i = dec_uint(bs, i, 2) + if i + ln > len(bs): + raise Reject() + raw = bytes(bs[i:i + ln]) + try: + s = raw.decode("utf-8") + except UnicodeDecodeError: + raise Reject() + if "\x00" in s: + raise Reject() + return s, i + ln + + +def enc_bin(b): + return be16(len(b)) + bytes(b) + + +def dec_bin(bs, i): + ln, i = dec_uint(bs, i, 2) + if i + ln > len(bs): + raise Reject() + return bytes(bs[i:i + ln]), i + ln + + +PROP_TYPE = { + 0x01: "byte", 0x02: "four", 0x03: "utf8", 0x08: "utf8", + 0x09: "binary", 0x0B: "var", 0x11: "four", 0x12: "utf8", + 0x13: "two", 0x15: "utf8", 0x16: "binary", 0x17: "byte", + 0x18: "four", 0x19: "byte", 0x1A: "utf8", 0x1C: "utf8", + 0x1F: "utf8", 0x21: "two", 0x22: "two", 0x23: "two", + 0x24: "byte", 0x25: "byte", 0x26: "pair", 0x27: "four", + 0x28: "byte", 0x29: "byte", 0x2A: "byte", +} + +ALLOWED = { + "connect": [0x11, 0x15, 0x16, 0x17, 0x19, 0x21, 0x22, 0x26, 0x27], + "will": [0x01, 0x02, 0x03, 0x08, 0x09, 0x18, 0x26], + "publish": [0x01, 0x02, 0x03, 0x08, 0x09, 0x0B, 0x23, 0x26], + "subscribe": [0x0B, 0x26], + "suback": [0x1F, 0x26], + "disconnect": [0x11, 0x1C, 0x1F, 0x26], +} + + +def repeatable(setname, pid): + return pid == 0x26 or (pid == 0x0B and setname == "publish") + + +def prop_value_ok(pid, v): + """The value rules the standard sets on single property values + (SPEC.md, Properties): a value breaking one is a Protocol + Error.""" + if pid == 0x08: + # Response Topic: used as a Topic Name (3.3.2.3.5, 4.7). + return v != "" and "+" not in v and "#" not in v + if pid in (0x0B, 0x21, 0x23, 0x27): + # Subscription Identifier (3.3.2.3.8, 3.8.2.1.2), Receive + # Maximum (3.1.2.11.3), Topic Alias (3.3.2.3.4), Maximum + # Packet Size (3.1.2.11.4): never 0. + return v != 0 + if pid in (0x17, 0x19): + # Request Problem Information, Request Response + # Information (3.1.2.11.7, 3.1.2.11.6): 0 or 1. + return v in (0, 1) + return True + + +def enc_prop_val(t, v): + if t == "byte": + return bytes([v]) + if t == "two": + return be16(v) + if t == "four": + return v.to_bytes(4, "big") + if t == "var": + return enc_vbi(v) + if t == "utf8": + return enc_str(v) + if t == "pair": + return enc_str(v[0]) + enc_str(v[1]) + if t == "binary": + return enc_bin(v) + raise ValueError(t) + + +def dec_prop_val(t, bs, i): + if t == "byte": + return dec_uint(bs, i, 1) + if t == "two": + return dec_uint(bs, i, 2) + if t == "four": + return dec_uint(bs, i, 4) + if t == "var": + return dec_vbi(bs, i) + if t == "utf8": + return dec_str(bs, i) + if t == "pair": + k, i = dec_str(bs, i) + v, i = dec_str(bs, i) + return (k, v), i + if t == "binary": + return dec_bin(bs, i) + raise ValueError(t) + + +def enc_props(ps): + body = b"".join(enc_vbi(pid) + enc_prop_val(PROP_TYPE[pid], v) + for pid, v in ps) + return enc_vbi(len(body)) + body + + +def dec_props(setname, bs, i): + ln, i = dec_vbi(bs, i) + if i + ln > len(bs): + raise Reject() + seg = bytes(bs[i:i + ln]) + end = i + ln + ps = [] + seen = [] + j = 0 + while j < len(seg): + pid, j = dec_vbi(seg, j) + if pid not in PROP_TYPE or pid not in ALLOWED[setname]: + raise Reject() + if pid in seen and not repeatable(setname, pid): + raise Reject() + seen.append(pid) + v, j = dec_prop_val(PROP_TYPE[pid], seg, j) + if not prop_value_ok(pid, v): + raise Reject() + ps.append((pid, v)) + if j != len(seg): + raise Reject() + # Authentication Data only with an Authentication Method + # (3.1.2.11.10). + if 0x16 in seen and 0x15 not in seen: + raise Reject() + return ps, end + + +def filter_ok(f, no_local): + """The topic filter rules of sections 4.7.1, 4.7.3, 4.8.2 and + 3.8.3.1, written from the standard's text.""" + if f.startswith("$share/"): + rest = f[len("$share/"):] + if "/" not in rest: + return False # ShareName followed by "/" [MQTT-4.8.2-2] + name, f = rest.split("/", 1) + if name == "" or "+" in name or "#" in name: + return False # [MQTT-4.8.2-1] [MQTT-4.8.2-2] + if no_local: + return False # [MQTT-3.8.3-4] + if f == "": + return False # [MQTT-4.7.3-1] + levels = f.split("/") + for k, level in enumerate(levels): + if "+" in level and level != "+": + return False # [MQTT-4.7.1-2] + if "#" in level and (level != "#" or k != len(levels) - 1): + return False # [MQTT-4.7.1-1] + return True + + +def check_topic(s): + if s == "" or "+" in s or "#" in s: + raise Reject() + return s + + +def flagbit(n, k): + return (n // (2 ** k)) % 2 == 1 + + +def enc_opts(o): + qos, no_local, rap, rh = o + return qos + (4 if no_local else 0) + (8 if rap else 0) + rh * 16 + + +def dec_opts(b): + if b >= 64 or b % 4 == 3 or (b // 16) % 4 == 3: + raise Reject() + return (b % 4, (b // 4) % 2 == 1, (b // 8) % 2 == 1, (b // 16) % 4) + + +def enc_packet(pkt): + tag = pkt[0] + if tag == "connect": + _, clean, ka, props, cid, will, username, password = pkt + flags = ((128 if username is not None else 0) + + (64 if password is not None else 0) + + ((32 if will[1] else 0) + will[0] * 8 + 4 + if will is not None else 0) + + (2 if clean else 0)) + body = enc_str("MQTT") + bytes([5, flags]) + be16(ka) + body += enc_props(props) + body += enc_str(cid) + if will is not None: + body += enc_props(will[2]) + enc_str(will[3]) + enc_bin(will[4]) + if username is not None: + body += enc_str(username) + if password is not None: + body += enc_bin(password) + header = 0x10 + elif tag == "publish": + _, dup, qos, retain, topic, pid, props, payload = pkt + header = 0x30 + (8 if dup else 0) + qos * 2 + (1 if retain else 0) + body = enc_str(topic) + if pid is not None: + body += be16(pid) + body += enc_props(props) + bytes(payload) + elif tag == "subscribe": + _, pid, props, filters = pkt + header = 0x82 + body = be16(pid) + enc_props(props) + for f, o in filters: + body += enc_str(f) + bytes([enc_opts(o)]) + elif tag == "suback": + _, pid, props, reasons = pkt + header = 0x90 + body = be16(pid) + enc_props(props) + bytes(reasons) + elif tag == "pingreq": + header, body = 0xC0, b"" + elif tag == "pingresp": + header, body = 0xD0, b"" + elif tag == "disconnect": + header = 0xE0 + if pkt[1] is None: + body = b"" + elif pkt[1][1] is None: + body = bytes([pkt[1][0]]) + else: + body = bytes([pkt[1][0]]) + enc_props(pkt[1][1]) + else: + raise ValueError(tag) + return bytes([header]) + enc_vbi(len(body)) + body + + +def raw_packet(header, body): + return bytes([header]) + enc_vbi(len(body)) + bytes(body) + + +def dec_connect(seg): + proto, i = dec_str(seg, 0) + if proto != "MQTT": + raise Reject() + level, i = dec_uint(seg, i, 1) + if level != 5: + raise Reject() + flags, i = dec_uint(seg, i, 1) + if flags % 2 != 0 or (flags // 8) % 4 == 3: + raise Reject() + # With the will flag clear, will QoS and will retain are 0 + # [MQTT-3.1.2-11] [MQTT-3.1.2-13]. + if not flagbit(flags, 2) and (flags & 0x38) != 0: + raise Reject() + ka, i = dec_uint(seg, i, 2) + props, i = dec_props("connect", seg, i) + cid, i = dec_str(seg, i) + will = None + if flagbit(flags, 2): + wprops, i = dec_props("will", seg, i) + wtopic, i = dec_str(seg, i) + check_topic(wtopic) + wpay, i = dec_bin(seg, i) + will = ((flags // 8) % 4, flagbit(flags, 5), wprops, wtopic, wpay) + username = None + if flagbit(flags, 7): + username, i = dec_str(seg, i) + password = None + if flagbit(flags, 6): + password, i = dec_bin(seg, i) + if i != len(seg): + raise Reject() + return ("connect", flagbit(flags, 1), ka, props, cid, will, + username, password) + + +def dec_publish(flags, seg): + topic, i = dec_str(seg, 0) + # No wildcard in a Topic Name [MQTT-3.3.2-2]; an empty one + # needs a Topic Alias, checked after the properties (3.3.2.1). + if "+" in topic or "#" in topic: + raise Reject() + qos = (flags // 2) % 4 + # DUP is 0 for all QoS 0 messages [MQTT-3.3.1-2]. + if qos == 0 and flagbit(flags, 3): + raise Reject() + pid = None + if qos != 0: + pid, i = dec_uint(seg, i, 2) + if pid == 0: + raise Reject() + props, i = dec_props("publish", seg, i) + if topic == "" and not any(p == 0x23 for p, _ in props): + raise Reject() + return ("publish", flagbit(flags, 3), qos, flagbit(flags, 0), + topic, pid, props, bytes(seg[i:])) + + +def dec_subscribe(seg): + pid, i = dec_uint(seg, 0, 2) + if pid == 0: + raise Reject() + props, i = dec_props("subscribe", seg, i) + filters = [] + while i < len(seg): + f, i = dec_str(seg, i) + if i >= len(seg): + raise Reject() + o = dec_opts(seg[i]) + i += 1 + if not filter_ok(f, o[1]): + raise Reject() + filters.append((f, o)) + if not filters: + raise Reject() + return ("subscribe", pid, props, filters) + + +def dec_suback(seg): + pid, i = dec_uint(seg, 0, 2) + if pid == 0: + raise Reject() + props, i = dec_props("suback", seg, i) + reasons = list(seg[i:]) + if not reasons: + raise Reject() + return ("suback", pid, props, reasons) + + +def dec_disconnect(seg): + if len(seg) == 0: + return ("disconnect", None) + if len(seg) == 1: + # No property length when the remaining length is below 2 + # (3.14.2.2.1). + return ("disconnect", (seg[0], None)) + props, j = dec_props("disconnect", seg, 1) + if j != len(seg): + raise Reject() + return ("disconnect", (seg[0], props)) + + +def oracle_parse(bs): + """The whole input form: exactly one packet, nothing after it. + Returns the packet, or None when the oracle rejects.""" + try: + if not bs: + return None + header = bs[0] + ln, i = dec_vbi(bs, 1) + if i + ln > len(bs): + return None + seg = bytes(bs[i:i + ln]) + rest = i + ln + typ, flags = header // 16, header % 16 + if typ == 1 and flags == 0: + pkt = dec_connect(seg) + elif typ == 3 and (flags // 2) % 4 != 3: + pkt = dec_publish(flags, seg) + elif typ == 8 and flags == 2: + pkt = dec_subscribe(seg) + elif typ == 9 and flags == 0: + pkt = dec_suback(seg) + elif typ == 12 and flags == 0 and not seg: + pkt = ("pingreq",) + elif typ == 13 and flags == 0 and not seg: + pkt = ("pingresp",) + elif typ == 14 and flags == 0: + pkt = dec_disconnect(seg) + else: + return None + except Reject: + return None + if rest != len(bs): + return None + return pkt + + +def settled_answer(bs): + pkt = oracle_parse(bs) + return want_ok(enc_packet(pkt)) if pkt is not None else "none" + + +# --------------------------------------------------------------------------- +# Random packets. +# --------------------------------------------------------------------------- + +TEXT = "abcdefgXYZ 019._-/" +UNICODE = ["é", "ü", "世", "☕"] + + +def rand_text(rng, lo=0, hi=10, topic_safe=False): + n = rng.randint(lo, hi) + pool = TEXT if topic_safe else TEXT + "".join(UNICODE) + return "".join(rng.choice(pool) for _ in range(n)) + + +def rand_topic(rng): + parts = [rand_text(rng, 1, 5, topic_safe=True) + for _ in range(rng.randint(1, 3))] + return "/".join(parts) + + +def rand_filter(rng): + """A random topic filter that keeps the filter rules: `+` as a + whole level anywhere, `#` only as the whole last level, and + now and then a shared subscription prefix. Broken filters are + forbidden packets, which the named rejection cases cover.""" + n = rng.randint(1, 3) + parts = [] + for k in range(n): + choices = ["+", rand_text(rng, 1, 4, topic_safe=True)] + if k == n - 1: + choices.append("#") + parts.append(rng.choice(choices)) + f = "/".join(parts) + if rng.random() < 0.15: + name = "".join(rng.choice("abcdefgXYZ019._-") + for _ in range(rng.randint(1, 4))) + f = "$share/" + name + "/" + f + return f + + +def rand_bytes(rng, hi=12): + return bytes(rng.randrange(256) for _ in range(rng.randint(0, hi))) + + +def rand_prop_value(rng, pid): + """A random value for a property, kept to the standard's value + rules: a value that breaks one is a forbidden packet, which + the named rejection cases cover instead.""" + while True: + if pid == 0x08: + v = rand_topic(rng) + else: + v = rand_typed_value(rng, PROP_TYPE[pid]) + if prop_value_ok(pid, v): + return v + + +def rand_typed_value(rng, t): + if t == "byte": + return rng.choice([0, 1, 2, 255, rng.randrange(256)]) + if t == "two": + return rng.choice([0, 1, 256, 65535, rng.randrange(65536)]) + if t == "four": + return rng.choice([0, 1, 65536, 4294967295, + rng.randrange(1 << 32)]) + if t == "var": + return rng.choice([0, 1, 127, 128, 16383, 16384, 2097151, + 268435455, rng.randrange(1 << 28)]) + if t == "utf8": + return rand_text(rng, 0, 8) + if t == "pair": + return (rand_text(rng, 1, 5), rand_text(rng, 0, 5)) + if t == "binary": + return rand_bytes(rng, 8) + raise ValueError(t) + + +def rand_props(rng, setname): + ids = list(ALLOWED[setname]) + rng.shuffle(ids) + ids = ids[:rng.randint(0, min(4, len(ids)))] + if 0x16 in ids and 0x15 not in ids: + ids.append(0x15) + ps = [] + for pid in ids: + ps.append((pid, rand_prop_value(rng, pid))) + if repeatable(setname, pid) and rng.random() < 0.4: + ps.append((pid, rand_prop_value(rng, pid))) + return ps + + +def rand_packet(rng): + tag = rng.choice(["connect", "publish", "publish", "subscribe", + "suback", "pingreq", "pingresp", "disconnect"]) + if tag == "connect": + will = None + if rng.random() < 0.5: + will = (rng.randint(0, 2), rng.random() < 0.5, + rand_props(rng, "will"), rand_topic(rng), + rand_bytes(rng)) + return ("connect", rng.random() < 0.5, + rng.choice([0, 1, 60, 65535, rng.randrange(65536)]), + rand_props(rng, "connect"), rand_text(rng, 0, 8), will, + rand_text(rng, 1, 6) if rng.random() < 0.4 else None, + rand_bytes(rng) if rng.random() < 0.4 else None) + if tag == "publish": + qos = rng.choice([0, 1, 2]) + # DUP only at QoS 1 and 2: at QoS 0 it is a forbidden + # packet, which the named rejection cases cover. + props = rand_props(rng, "publish") + topic = rand_topic(rng) + # Now and then an empty topic name with a Topic Alias, + # which section 3.3.2.1 allows. + if rng.random() < 0.1: + topic = "" + if not any(p == 0x23 for p, _ in props): + props.append((0x23, rand_prop_value(rng, 0x23))) + return ("publish", qos != 0 and rng.random() < 0.5, qos, + rng.random() < 0.5, topic, + rng.randint(1, 65535) if qos else None, + props, rand_bytes(rng, 20)) + if tag == "subscribe": + filters = [] + for _ in range(rng.randint(1, 3)): + f = rand_filter(rng) + # No Local is not set on a shared subscription + # [MQTT-3.8.3-4]. + no_local = (not f.startswith("$share/")) and rng.random() < 0.5 + filters.append((f, (rng.randint(0, 2), no_local, + rng.random() < 0.5, rng.randint(0, 2)))) + return ("subscribe", rng.randint(1, 65535), + rand_props(rng, "subscribe"), filters) + if tag == "suback": + return ("suback", rng.randint(1, 65535), + rand_props(rng, "suback"), + [rng.choice([0, 1, 2, 128, 131, 135, 144, 161, + rng.randrange(256)]) + for _ in range(rng.randint(1, 4))]) + if tag == "pingreq": + return ("pingreq",) + if tag == "pingresp": + return ("pingresp",) + if rng.random() < 0.3: + return ("disconnect", None) + reason = rng.choice([0, 4, 129, 135, 142, rng.randrange(256)]) + if rng.random() < 0.3: + return ("disconnect", (reason, None)) + return ("disconnect", (reason, rand_props(rng, "disconnect"))) + + +# --------------------------------------------------------------------------- +# Test sections. +# --------------------------------------------------------------------------- + +VBI_TABLE = [ + (0, [0]), (127, [127]), (128, [128, 1]), (16383, [255, 127]), + (16384, [128, 128, 1]), (2097151, [255, 255, 127]), + (2097152, [128, 128, 128, 1]), + (268435455, [255, 255, 255, 127]), +] + + +def fixed_cases(): + tool = Tool() + entries = [] + + def add(label, bs, expected=None): + idx = tool.ask(req(bs)) + entries.append((label, idx, + expected if expected is not None + else want_ok(bytes(bs)))) + + # The section 2.1.4 table, checked at the oracle first, then + # exercised through the tool as Subscription Identifier values + # on SUBSCRIBE packets, and as remaining lengths where the + # body size is practical. + for value, enc in VBI_TABLE: + check(list(enc_vbi(value)) == enc, f"fixed/vbi {value}", + "oracle encoder differs from the spec table") + pkt = ("subscribe", 1, [(0x0B, value)], + [("a", (0, False, False, 0))]) + if value == 0: + # A Subscription Identifier of 0 is a Protocol Error. + add("vbi 0 as a subscription identifier, refused", + enc_packet(pkt), "none") + else: + add(f"vbi {value} as a property value", enc_packet(pkt)) + for value in (0, 127, 128, 16383, 16384): + if value == 0: + add("remaining length 0", bytes([192, 0])) + else: + body_len = value + payload = bytes(body_len - 4) + pkt = ("publish", False, 0, False, "a", None, [], payload) + bs = enc_packet(pkt) + check(list(bs[1:1 + len(enc_vbi(value))]) == list(enc_vbi(value)), + f"fixed/remaining length {value}", "header bytes differ") + add(f"remaining length {value}", bs) + # Section 1.5.5: a writing longer than the value needs is + # refused, wherever a variable byte integer stands. + add("vbi non-minimal 134,0 as remaining length", + bytes([48, 134, 0, 0, 1, 97, 0, 1, 2]), "none") + add("vbi non-minimal 128,0 as remaining length", + bytes([192, 128, 0]), "none") + add("vbi non-minimal 128,128,0 as remaining length", + bytes([192, 128, 128, 0]), "none") + add("vbi non-minimal 128,0 as property length", + bytes([48, 5, 0, 1, 97, 128, 0]), "none") + add("vbi non-minimal 129,0 as property identifier", + bytes([48, 7, 0, 1, 97, 3, 129, 0, 1]), "none") + add("vbi non-minimal 129,128,0 as subscription identifier", + bytes([130, 11, 0, 1, 3, 11, 129, 128, 0, 0, 1, 97, 0]), "none") + add("vbi with rest in one packet stream position", + bytes([192, 0]), want_ok(bytes([192, 0]))) + + # One hand built packet per type; the literal ones are the + # same bytes proved in Proofs/Examples.lean. + add("pingreq", bytes([192, 0])) + add("pingresp", bytes([208, 0])) + add("disconnect empty", bytes([224, 0])) + add("disconnect reason only, reprinted as it came", + bytes([224, 1, 0])) + add("disconnect reason 142 only", bytes([224, 1, 142])) + add("disconnect reason and empty properties", bytes([224, 2, 0, 0])) + add("publish qos0", bytes([48, 6, 0, 1, 97, 0, 1, 2])) + add("publish qos1", bytes([50, 6, 0, 1, 97, 0, 1, 0])) + add("subscribe one filter", bytes([130, 7, 0, 1, 0, 0, 1, 97, 0])) + add("suback", bytes([144, 4, 0, 1, 0, 0])) + add("connect plain", + bytes([16, 14, 0, 4, 77, 81, 84, 84, 5, 2, 0, 0, 0, 0, 1, 120])) + + richer = [ + ("connect with will, username, password", + ("connect", True, 60, + [(0x11, 3600), (0x26, ("k", "v"))], "client-1", + (1, True, [(0x18, 30), (0x03, "text/plain")], + "last/will", b"\x01\x02"), + "user", b"secret")), + ("publish qos2 with properties", + ("publish", True, 2, True, "sensors/temp", 4242, + [(0x01, 1), (0x02, 600), (0x0B, 7), (0x0B, 9), + (0x26, ("a", "b")), (0x23, 3)], b"hello")), + ("subscribe two filters", + ("subscribe", 9, [(0x0B, 12)], + [("sensors/+", (1, True, False, 1)), + ("alerts/#", (2, False, True, 2))])), + ("suback with reason string", + ("suback", 9, [(0x1F, "done")], [0, 1, 128])), + ("disconnect with properties", + ("disconnect", (142, [(0x11, 0), (0x1F, "bye")]))), + ("disconnect reason with empty properties", + ("disconnect", (0, []))), + ] + for label, pkt in richer: + bs = enc_packet(pkt) + check(oracle_parse(bs) == pkt, f"fixed/{label}", + "oracle does not read its own packet back") + add(label, bs) + + answers = tool.run() + for label, idx, expected in entries: + check(answers[idx] == expected, f"fixed/{label}", + f"got {answers[idx]}, want {expected}") + return len(entries) + + +def oracle_differential(rng, count): + tool = Tool() + entries = [] + for _ in range(count): + pkt = rand_packet(rng) + bs = enc_packet(pkt) + idx = tool.ask(req(bs)) + entries.append((idx, want_ok(bs), pkt[0])) + answers = tool.run() + agree = 0 + seen_types = set() + for idx, expected, tag in entries: + seen_types.add(tag) + if answers[idx] == expected: + agree += 1 + else: + check(False, "oracle differential", + f"got {answers[idx]}, want {expected}") + check(seen_types == {"connect", "publish", "subscribe", "suback", + "pingreq", "pingresp", "disconnect"}, + "oracle differential coverage", f"types seen: {seen_types}") + return len(entries), agree + + +PAHO_PACKET = {"connect": "CONNECT", "will": "WILLMESSAGE", + "publish": "PUBLISH", "subscribe": "SUBSCRIBE", + "suback": "SUBACK", "disconnect": "DISCONNECT"} + +UNKNOWN_IDS = [0x00, 0x04, 0x07, 0x0A, 0x2B, 0x30, 0x7F] + + +def block_packet(setname, block): + """A valid packet around the raw property block `block` (its + length included), standing as the block of kind `setname`.""" + if setname == "connect": + return raw_packet(0x10, enc_str("MQTT") + bytes([5, 2]) + be16(0) + + block + enc_str("c")) + if setname == "will": + return raw_packet(0x10, enc_str("MQTT") + bytes([5, 6]) + be16(0) + + b"\x00" + enc_str("c") + block + enc_str("w") + + enc_bin(b"")) + if setname == "publish": + return raw_packet(0x30, enc_str("a") + block + b"x") + if setname == "subscribe": + return raw_packet(0x82, be16(1) + block + enc_str("a") + b"\x00") + if setname == "suback": + return raw_packet(0x90, be16(1) + block + b"\x00") + if setname == "disconnect": + return raw_packet(0xE0, b"\x00" + block) + raise ValueError(setname) + + +def raw_block(entries): + """A property block from (identifier, value) pairs, any + identifier, written as given: an unknown identifier gets one + value byte.""" + body = b"" + for pid, v in entries: + if pid in PROP_TYPE: + body += enc_vbi(pid) + enc_prop_val(PROP_TYPE[pid], v) + else: + body += enc_vbi(pid) + bytes([v]) + return enc_vbi(len(body)) + body + + +def judge_entries(rng, setname): + """Random properties for a block of kind `setname`, for Paho + to judge: mostly allowed ones, some known identifiers that the + block does not allow, some unknown identifiers, values drawn + across their whole width (so forbidden values such as 0 come + up), and now and then a repeat. The five classes where Paho + departs from the standard are left out here and checked on + their own: a Payload Format Indicator above 1, a Response + Topic that is empty or holds a wildcard, Authentication Data + without a Method, a repeated Subscription Identifier on + SUBSCRIBE, and a Maximum Packet Size above 268435455.""" + out = [] + for _ in range(rng.randint(0, 4)): + r = rng.random() + if r < 0.65: + pid = rng.choice(ALLOWED[setname]) + elif r < 0.92: + pid = rng.choice(sorted(PROP_TYPE)) + else: + out.append((rng.choice(UNKNOWN_IDS), rng.randrange(256))) + continue + if pid == 0x01: + v = rng.randint(0, 1) + elif pid == 0x27: + v = rng.choice([0, 1, 65536, rng.randrange(1, 1 << 28)]) + elif pid == 0x08: + v = rand_topic(rng) + else: + v = rand_typed_value(rng, PROP_TYPE[pid]) + out.append((pid, v)) + if rng.random() < 0.15: + out.append((pid, v if pid in (0x01, 0x08, 0x27) + else rand_typed_value(rng, PROP_TYPE[pid]))) + ids = [i for i, _ in out] + if 0x16 in ids and 0x15 not in ids: + out.append((0x15, rand_text(rng, 1, 4, topic_safe=True))) + if setname == "subscribe" and ids.count(0x0B) > 1: + first = ids.index(0x0B) + out = [e for k, e in enumerate(out) if e[0] != 0x0B or k == first] + rng.shuffle(out) + return out + + +def paho_section(rng, count_blocks): + """Cross-checks in which Paho judges an answer of the Lean + tool. Returns (comparisons, agreements, accepted, refused). + + 1. Paho's encoder writes variable byte integers; each, as the + Subscription Identifier of a SUBSCRIBE, must be accepted + by the Lean tool and reprinted as the same bytes. + 2. Paho's Properties.unpack judges property blocks of all six + kinds that the Lean tool accepts and refuses: the tool's + verdict on the block inside a valid packet must equal + Paho's verdict on the block alone. + The classes where Paho departs from the standard are checked + apart: each must show the documented difference, and they are + not counted as comparisons.""" + from paho.mqtt.properties import Properties, VariableByteIntegers + from paho.mqtt.packettypes import PacketTypes + tool = Tool() + entries = [] + + def paho_accepts(setname, block): + props = Properties(getattr(PacketTypes, PAHO_PACKET[setname])) + try: + _, used = props.unpack(block) + except Exception: + return False + return used == len(block) + + # 1. Paho's writing of each value as a Subscription Identifier. + values = [v for v, _ in VBI_TABLE if v != 0] + values += [rng.randrange(1, 1 << 28) for _ in range(120)] + for v in values: + enc = bytes(VariableByteIntegers.encode(v)) + block = bytes([11]) + enc + body = be16(1) + enc_vbi(len(block)) + block + enc_str("a") + b"\x00" + bs = raw_packet(0x82, body) + entries.append(("paho vbi", tool.ask(req(bs)), want_ok(bs), bs)) + + # 2. Paho judges property blocks. + kinds = sorted(PAHO_PACKET) + for _ in range(count_blocks): + setname = rng.choice(kinds) + block = raw_block(judge_entries(rng, setname)) + bs = block_packet(setname, block) + verdict = paho_accepts(setname, block) + entries.append((f"paho judges a {setname} block {list(block)}", + tool.ask(req(bs)), + want_ok(bs) if verdict else "none", bs)) + + # The documented differences, each checked for its direction. + diffs = [ + ("Payload Format Indicator 2 on PUBLISH", "publish", + [(0x01, 2)], False, True, + "section 3.3.2.3.2 names 0 and 1 but does not call another " + "value a Protocol Error, so this reader accepts it; Paho " + "refuses it"), + ("Payload Format Indicator 255 in the will", "will", + [(0x01, 255)], False, True, None), + ("Response Topic with a wildcard on PUBLISH", "publish", + [(0x08, "a/#")], True, False, + "MQTT-3.3.2-14 forbids wildcards in a Response Topic and " + "4.7.3-1 an empty one, so this reader refuses them; Paho " + "accepts them"), + ("empty Response Topic in the will", "will", [(0x08, "")], + True, False, None), + ("Authentication Data without a Method on CONNECT", "connect", + [(0x16, b"x")], True, False, + "section 3.1.2.11.10 makes Authentication Data without an " + "Authentication Method a Protocol Error, so this reader " + "refuses it; Paho accepts it"), + ("Maximum Packet Size 4294967295 on CONNECT", "connect", + [(0x27, 4294967295)], False, True, + "section 3.1.2.11.4 makes the Maximum Packet Size a Four Byte " + "Integer and calls only 0 (or a repeat) a Protocol Error, so " + "this reader accepts values up to 2^32 - 1; Paho refuses those " + "above 268435455"), + ("Maximum Packet Size 268435456 on CONNECT", "connect", + [(0x27, 268435456)], False, True, None), + ("two Subscription Identifiers on SUBSCRIBE", "subscribe", + [(0x0B, 1), (0x0B, 2)], True, False, + "section 3.8.2.1.2 makes a second Subscription Identifier on " + "SUBSCRIBE a Protocol Error, so this reader refuses it; Paho " + "allows the repeat on any packet"), + ] + diff_entries = [] + for label, setname, props, paho_ok, lean_ok, why in diffs: + block = raw_block(props) + bs = block_packet(setname, block) + diff_entries.append((label, tool.ask(req(bs)), paho_ok, lean_ok, bs, + setname, block, why)) + + answers = tool.run() + agree = accepted = refused = 0 + for label, idx, expected, bs in entries: + if answers[idx] == expected: + agree += 1 + else: + check(False, label, f"Lean {answers[idx]}, Paho's verdict {expected}") + if answers[idx] == "none": + refused += 1 + else: + accepted += 1 + check(answers[idx] == want_ok(bs), label, + f"accepted, but reprinted as {answers[idx]}") + for label, idx, paho_ok, lean_ok, bs, setname, block, why in diff_entries: + got_paho = paho_accepts(setname, block) + got_lean = answers[idx] != "none" + check(got_paho == paho_ok and got_lean == lean_ok, + f"paho difference/{label}", + f"Paho {'accepts' if got_paho else 'refuses'}, Lean " + f"{'accepts' if got_lean else 'refuses'}; documented: Paho " + f"{'accepts' if paho_ok else 'refuses'}, Lean " + f"{'accepts' if lean_ok else 'refuses'}") + if why: + paho_named.append(f"{label}, and the like: {why}. Checked on " + "single blocks, not counted as comparisons.") + paho_named.append( + "paho-mqtt's VariableByteIntegers.decode reads the longer " + "writing 128, 0 as " + f"{VariableByteIntegers.decode(bytes([128, 0]))!r} (value, " + "bytes read); this reader refuses that writing, as " + "MQTT-1.5.5-1 requires (the fixed cases check it), so the " + "property blocks Paho judges hold only shortest writings.") + return len(entries), agree, accepted, refused + + +def mutation_cases(rng): + tool = Tool() + entries = [] + + def settle(label, bs): + idx = tool.ask(req(bs)) + entries.append((label, idx, settled_answer(bs), bs)) + + def expect(label, bs, expected): + idx = tool.ask(req(bs)) + entries.append((label, idx, expected, bs)) + check(settled_answer(bs) == expected, f"mutation/{label}", + "oracle disagrees with the named expectation") + + rich_connect = enc_packet( + ("connect", True, 60, [(0x11, 3600), (0x26, ("k", "v"))], + "client-1", + (1, True, [(0x18, 30)], "last/will", b"\x01\x02"), + "user", b"secret")) + rich_publish = enc_packet( + ("publish", False, 1, False, "sensors/temp", 4242, + [(0x02, 600), (0x26, ("a", "b"))], b"hello world")) + for name, base in (("connect", rich_connect), + ("publish", rich_publish)): + for cut in range(len(base)): + settle(f"{name} truncate {cut}", base[:cut]) + for off in range(len(base)): + mut = bytearray(base) + mut[off] = (mut[off] + 37) % 256 + settle(f"{name} flip at {off}", bytes(mut)) + + def props_packet(setname_header, body_props, tail): + return raw_packet(setname_header, body_props + tail) + + named = [] + # Five byte remaining length: a continuation mark on the + # fourth byte. + named.append(("five byte remaining length", + bytes([192, 255, 255, 255, 255, 127]), "none")) + # The value of these five byte writings fits the input, so a + # reader with a cap above four bytes would accept them: they + # separate the four byte cap from a plain shortage of input. + named.append(("five byte remaining length whose value fits", + bytes([192, 128, 128, 128, 128, 0]), "none")) + named.append(("five byte subscription identifier", + bytes([130, 13, 0, 1, 6, 11, 128, 128, 128, 128, 1, + 0, 1, 97, 0]), "none")) + named.append(("remaining length larger than input", + bytes([192, 5, 0]), "none")) + named.append(("remaining length larger than a publish body", + bytes([48, 100, 0, 1, 97]), "none")) + named.append(("truncated connect variable header", + bytes([16, 8, 0, 4, 77, 81, 84, 84, 5]), "none")) + named.append(("wrong flags on connect", bytes([17, 0]), "none")) + named.append(("wrong flags on suback", + bytes([146, 4, 0, 1, 0, 0]), "none")) + named.append(("wrong flags on pingreq", bytes([193, 0]), "none")) + sub_body = be16(1) + b"\x00" + enc_str("a") + b"\x00" + named.append(("subscribe with flags 0000", + raw_packet(0x80, sub_body), "none")) + pub_body = enc_str("a") + be16(1) + b"\x00" + b"x" + named.append(("publish qos 3", raw_packet(0x36, pub_body), "none")) + q0_body = enc_str("a") + b"\x00" + named.append(("publish dup at qos 0", raw_packet(0x38, q0_body), "none")) + named.append(("publish dup at qos 0 with retain", + raw_packet(0x39, q0_body), "none")) + named.append(("publish qos 0, dup clear (control)", + raw_packet(0x30, q0_body), + want_ok(raw_packet(0x30, q0_body)))) + named.append(("publish dup at qos 1 (control)", + raw_packet(0x3A, pub_body), + want_ok(raw_packet(0x3A, pub_body)))) + wild_body = enc_str("a/#") + b"\x00" + b"x" + named.append(("publish wildcard topic", + raw_packet(0x30, wild_body), "none")) + named.append(("publish wildcard + in topic", + raw_packet(0x30, enc_str("a/+") + b"\x00"), "none")) + named.append(("publish empty topic, no topic alias", + raw_packet(0x30, enc_str("") + b"\x00"), "none")) + named.append(("publish empty topic, other properties only", + raw_packet(0x30, enc_str("") + enc_props([(0x02, 5)])), + "none")) + alias_pub = raw_packet(0x30, enc_str("") + enc_props([(0x23, 1)])) + named.append(("publish empty topic with topic alias, accepted", + alias_pub, want_ok(alias_pub))) + alias_pub1 = raw_packet(0x32, enc_str("") + be16(9) + + enc_props([(0x26, ("k", "v")), (0x23, 7)]) + + b"pay") + named.append(("publish qos 1, empty topic with topic alias, accepted", + alias_pub1, want_ok(alias_pub1))) + badname = (enc_str("MQTU") + bytes([5, 2]) + be16(0) + b"\x00" + + enc_str("x")) + named.append(("connect wrong protocol name", + raw_packet(0x10, badname), "none")) + reserved = bytearray(rich_connect) + # The connect flags byte: header(1) + length(1) + name(6) + # + level(1) puts it at index 9. + reserved[9] = reserved[9] | 1 + named.append(("connect reserved flag bit", bytes(reserved), "none")) + willqos = (enc_str("MQTT") + bytes([5, 2 | 4 | 24]) + be16(0) + + b"\x00" + enc_str("x") + b"\x00" + enc_str("w") + + enc_bin(b"")) + named.append(("connect will qos 3", raw_packet(0x10, willqos), "none")) + plain_tail = be16(0) + b"\x00" + enc_str("x") + for flags, label in ((0x0A, "will qos 1 without the will flag"), + (0x12, "will qos 2 without the will flag"), + (0x22, "will retain without the will flag"), + (0x3A, "will qos and retain without the will flag")): + named.append(("connect " + label, + raw_packet(0x10, enc_str("MQTT") + bytes([5, flags]) + + plain_tail), "none")) + plain = raw_packet(0x10, enc_str("MQTT") + bytes([5, 0x02]) + plain_tail) + named.append(("connect flags 0x02 (control)", plain, want_ok(plain))) + wrong_prop = (enc_str("MQTT") + bytes([5, 2]) + be16(0) + + enc_props([(0x0B, 5)]) + enc_str("x")) + named.append(("subscription identifier on connect", + raw_packet(0x10, wrong_prop), "none")) + table_only = raw_packet(0xE0, bytes([0]) + enc_props([(0x12, "x")])) + named.append(("assigned client identifier on disconnect", + table_only, "none")) + unknown_prop = raw_packet( + 0x30, enc_str("a") + b"\x04\x7f\x01\x00\x00" + b"") + named.append(("unknown property identifier", unknown_prop, "none")) + repeated = raw_packet( + 0x32, enc_str("a") + be16(3) + enc_props([(0x23, 1), (0x23, 2)])) + named.append(("repeated single use property", repeated, "none")) + overrun = raw_packet(0x30, enc_str("a") + b"\x0a\x01\x01") + named.append(("property block length overruns", overrun, "none")) + named.append(("packet identifier 0 in subscribe", + raw_packet(0x82, be16(0) + b"\x00" + enc_str("a") + + b"\x00"), "none")) + named.append(("packet identifier 0 in publish qos1", + raw_packet(0x32, enc_str("a") + be16(0) + b"\x00"), + "none")) + named.append(("empty topic filter list", + raw_packet(0x82, be16(1) + b"\x00"), "none")) + named.append(("empty reason list in suback", + raw_packet(0x90, be16(1) + b"\x00"), "none")) + named.append(("disconnect body of length 1, accepted", + bytes([224, 1, 0]), want_ok(bytes([224, 1, 0])))) + named.append(("pingreq with a body", bytes([192, 1, 0]), "none")) + named.append(("packet type 2, outside this slice", + bytes([32, 0]), "none")) + named.append(("packet type 0", bytes([0, 0]), "none")) + named.append(("trailing byte after one packet", + bytes([192, 0, 0]), "none")) + named.append(("empty input", b"", "none")) + nul_topic = raw_packet(0x30, be16(2) + b"a\x00" + b"\x00") + named.append(("null character in publish topic", nul_topic, "none")) + bad_utf8 = raw_packet(0x30, be16(1) + b"\xff" + b"\x00") + named.append(("ill formed utf-8 in publish topic", bad_utf8, "none")) + overlong = raw_packet(0x30, be16(2) + b"\xc0\x80" + b"\x00") + named.append(("overlong utf-8 in publish topic", overlong, "none")) + # Property values the standard calls a Protocol Error, each + # beside a control that differs in the value alone. + connect_head = enc_str("MQTT") + bytes([5, 2]) + be16(0) + for label, setname, props, ok_props in ( + ("subscription identifier 0 on subscribe", "subscribe", + [(0x0B, 0)], [(0x0B, 1)]), + ("subscription identifier 0 on publish", "publish", + [(0x0B, 0)], [(0x0B, 5)]), + ("topic alias 0", "publish", [(0x23, 0)], [(0x23, 1)]), + ("response topic with #", "publish", [(0x08, "a/#")], + [(0x08, "a/b")]), + ("response topic with +", "publish", [(0x08, "+")], + [(0x08, "x")]), + ("empty response topic", "publish", [(0x08, "")], + [(0x08, "r")]), + ("receive maximum 0", "connect", [(0x21, 0)], [(0x21, 1)]), + ("maximum packet size 0", "connect", [(0x27, 0)], + [(0x27, 1)]), + ("request problem information 2", "connect", [(0x17, 2)], + [(0x17, 1)]), + ("request response information 2", "connect", + [(0x19, 2)], [(0x19, 0)]), + ("authentication data without method", "connect", + [(0x16, b"x")], [(0x15, "m"), (0x16, b"x")]), + ("response topic with # in will properties", "will", + [(0x08, "#")], [(0x08, "w")])): + for props_here, want in ((props, "none"), (ok_props, None)): + if setname == "subscribe": + bs = raw_packet(0x82, be16(1) + enc_props(props_here) + + enc_str("a") + b"\x00") + elif setname == "publish": + bs = raw_packet(0x30, enc_str("a") + enc_props(props_here) + + b"x") + elif setname == "connect": + bs = raw_packet(0x10, connect_head + enc_props(props_here) + + enc_str("x")) + else: + bs = raw_packet(0x10, enc_str("MQTT") + bytes([5, 6]) + + be16(0) + b"\x00" + enc_str("x") + + enc_props(props_here) + enc_str("w") + + enc_bin(b"")) + named.append((label if want else label + " (control)", bs, + want if want else want_ok(bs))) + # Topic filter rules (sections 4.7.1, 4.7.3, 4.8.2, 3.8.3.1). + for flt, opts, good in ( + ("a/#/b", 0, False), ("a#", 0, False), ("a+", 0, False), + ("+a", 0, False), ("a/b+", 0, False), ("#/a", 0, False), + ("", 0, False), ("a/##", 0, False), + ("$share/g/t", 4, False), ("$share/g", 0, False), + ("$share//t", 0, False), ("$share/g/", 0, False), + ("$share/+/t", 0, False), ("$share/g#/t", 0, False), + ("$share/g/a/#/b", 0, False), + ("a/+/#", 0, True), ("#", 0, True), ("+", 0, True), + ("/", 0, True), ("+/+", 0, True), ("a//b", 0, True), + ("$share/g/t", 0, True), ("$share/g/#", 1, True), + ("$share/g/a/b", 0, True), ("$share", 4, True), + ("$sharex/a", 4, True), ("$SYS/#", 0, True)): + bs = raw_packet(0x82, be16(1) + b"\x00" + enc_str(flt) + + bytes([opts])) + label = f"topic filter {flt!r} options {opts}" + named.append((label + (" (accepted)" if good else ""), bs, + want_ok(bs) if good else "none")) + for opts_byte, label in ((64, "options byte reserved bits set"), + (3, "options byte qos 3"), + (48, "options byte retain handling 3")): + named.append((label, + raw_packet(0x82, be16(1) + b"\x00" + enc_str("a") + + bytes([opts_byte])), "none")) + for label, bs, expected in named: + expect(label, bs, expected) + answers = tool.run() + agree = 0 + for label, idx, expected, bs in entries: + if answers[idx] == expected: + agree += 1 + else: + check(False, f"mutation/{label}", + f"got {answers[idx]}, want {expected}") + # Every input the tool accepts reprints byte for byte. + check(answers[idx] in ("none", want_ok(bs)), f"mutation/{label}", + f"accepted, but reprinted as {answers[idx]}") + return len(entries), agree + + +# --------------------------------------------------------------------------- +# Forbidden classes, drawn from the seed. +# --------------------------------------------------------------------------- + +def put_prop(ps, pid, value): + """The property list with every (pid, _) removed and (pid, + value) put at a random place: the value under test is the + only one of its identifier in the block.""" + out = [(i, v) for i, v in ps if i != pid] + return out + [(pid, value)] + + +def packet_with_block(rng, setname, props): + """A random valid packet of the kind that carries a `setname` + property block, with `props` as that block.""" + if setname in ("connect", "will"): + will = (rng.randint(0, 2), rng.random() < 0.5, + rand_props(rng, "will"), rand_topic(rng), rand_bytes(rng)) + cprops = rand_props(rng, "connect") + if setname == "connect": + cprops = props + if rng.random() < 0.5: + will = None + else: + will = (will[0], will[1], props, will[3], will[4]) + return ("connect", rng.random() < 0.5, rng.randrange(65536), cprops, + rand_text(rng, 0, 6), will, + rand_text(rng, 1, 5) if rng.random() < 0.4 else None, + rand_bytes(rng, 6) if rng.random() < 0.4 else None) + if setname == "publish": + qos = rng.choice([0, 1, 2]) + return ("publish", qos != 0 and rng.random() < 0.5, qos, + rng.random() < 0.5, rand_topic(rng), + rng.randint(1, 65535) if qos else None, props, + rand_bytes(rng, 10)) + if setname == "subscribe": + return ("subscribe", rng.randint(1, 65535), props, + [(rand_filter(rng), (rng.randint(0, 2), False, + rng.random() < 0.5, rng.randint(0, 2))) + for _ in range(rng.randint(1, 3))]) + raise ValueError(setname) + + +def wild_topic(rng): + """A topic name with `+` or `#` put in at a random place.""" + t = rand_topic(rng) + k = rng.randint(0, len(t)) + return t[:k] + rng.choice("+#") + t[k:] + + +def safe_level(rng): + return "".join(rng.choice("abcXYZ019._-") for _ in range(rng.randint(1, 4))) + + +def good_plain_filter(rng): + n = rng.randint(1, 6) + parts = [rng.choice(["+", safe_level(rng)]) for _ in range(n)] + if rng.random() < 0.4: + parts[-1] = "#" + return "/".join(parts) + + +def bad_plain_filter(rng): + """A filter of 1 to 6 levels that breaks a wildcard rule: + `#` as a whole level other than the last, or `+` or `#` + inside a level beside other characters.""" + kind = rng.choice(["hash_not_last", "plus_in_level", "hash_in_level"]) + if kind == "hash_not_last": + n = rng.randint(2, 6) + parts = [rng.choice(["+", safe_level(rng)]) for _ in range(n)] + parts[rng.randint(0, n - 2)] = "#" + return kind, "/".join(parts) + n = rng.randint(1, 6) + parts = [rng.choice(["+", safe_level(rng)]) for _ in range(n)] + lvl = safe_level(rng) + k = rng.randint(0, len(lvl)) + ch = "+" if kind == "plus_in_level" else "#" + parts[rng.randrange(n)] = lvl[:k] + ch + lvl[k:] + return kind, "/".join(parts) + + +def bad_filter(rng): + """A filter that breaks a rule of sections 4.7.1, 4.7.3 or + 4.8.2, with the No Local option to send it with.""" + kind = rng.choice(["plain", "plain", "plain", "share_name_empty", + "share_name_wild", "share_no_slash", + "share_empty_filter", "share_bad_filter", + "share_no_local", "empty"]) + name = safe_level(rng) + if kind == "plain": + return bad_plain_filter(rng) + (rng.random() < 0.5,) + if kind == "share_name_empty": + return kind, "$share//" + good_plain_filter(rng), False + if kind == "share_name_wild": + k = rng.randint(0, len(name)) + return kind, ("$share/" + name[:k] + rng.choice("+#") + name[k:] + + "/" + good_plain_filter(rng)), False + if kind == "share_no_slash": + return kind, "$share/" + name, False + if kind == "share_empty_filter": + return kind, "$share/" + name + "/", False + if kind == "share_bad_filter": + return kind, "$share/" + name + "/" + bad_plain_filter(rng)[1], False + if kind == "share_no_local": + return kind, "$share/" + name + "/" + good_plain_filter(rng), True + return kind, "", False + + +def forbidden_cases(rng): + """Inputs of each forbidden class, drawn from the seed: every + Request Problem Information and Request Response Information + value from 2 to 255, the value 0 for the Subscription + Identifier, Receive Maximum, Topic Alias and Maximum Packet + Size, Response Topics that hold a wildcard or are empty, + Authentication Data without a Method, and topic filters of 1 + to 6 levels that break a wildcard or shared subscription + rule. Each is a random valid packet with one rule broken. + The oracle settles each answer, and the run checks that the + oracle (prop_value_ok, filter_ok) does call each one + forbidden; about one in five comes with a control, the same + packet with the rule kept, which must be accepted.""" + tool = Tool() + entries = [] + + def add(label, bs, forbidden): + want = settled_answer(bs) + if forbidden: + check(want == "none", f"forbidden/{label}", + f"the oracle accepts {list(bs)}, which the generator " + "meant to break a rule") + else: + check(want != "none", f"forbidden/{label}", + f"the oracle refuses the control {list(bs)}") + idx = tool.ask(req(bs)) + entries.append((label, idx, want, bs)) + + def value_case(label, setname, pid, bad, good): + base = rand_props(rng, setname) + if pid == 0x16: + base = [(i, v) for i, v in base if i not in (0x15, 0x16)] + seed_state = rng.getstate() + pkt = packet_with_block(rng, setname, put_prop(base, pid, bad)) + add(label, enc_packet(pkt), True) + if rng.random() < 0.2: + # The same draws again, so the control differs from the + # case in the value under test alone (for Authentication + # Data, in an added Authentication Method). + rng2 = random.Random() + rng2.setstate(seed_state) + good_props = (put_prop(base, pid, bad) + [(0x15, "m")] + if pid == 0x16 else put_prop(base, pid, good)) + ok = packet_with_block(rng2, setname, good_props) + add(label + " (control)", enc_packet(ok), False) + + for pid, name in ((0x17, "request problem information"), + (0x19, "request response information")): + for v in range(2, 256): + value_case(f"{name} {v}", "connect", pid, v, rng.randint(0, 1)) + for setname, pid, name, good in ( + ("subscribe", 0x0B, "subscription identifier 0 on subscribe", + lambda: rng.randint(1, 268435455)), + ("publish", 0x0B, "subscription identifier 0 on publish", + lambda: rng.randint(1, 268435455)), + ("connect", 0x21, "receive maximum 0", lambda: rng.randint(1, 65535)), + ("connect", 0x27, "maximum packet size 0", + lambda: rng.randint(1, (1 << 32) - 1)), + ("publish", 0x23, "topic alias 0", lambda: rng.randint(1, 65535))): + for _ in range(30): + value_case(name, setname, pid, 0, good()) + for setname in ("publish", "will"): + for _ in range(50): + value_case(f"response topic with a wildcard in {setname}", + setname, 0x08, wild_topic(rng), rand_topic(rng)) + for _ in range(10): + value_case(f"empty response topic in {setname}", setname, 0x08, + "", rand_topic(rng)) + for _ in range(30): + value_case("authentication data without a method", "connect", 0x16, + rand_bytes(rng, 6), None) + + for _ in range(400): + kind, flt, no_local = bad_filter(rng) + check(not filter_ok(flt, no_local), f"forbidden/filter {flt!r}", + "the generator made a filter the oracle's filter_ok keeps") + others = [(rand_filter(rng), (rng.randint(0, 2), False, + rng.random() < 0.5, rng.randint(0, 2))) + for _ in range(rng.randint(0, 2))] + k = rng.randint(0, len(others)) + opts = (rng.randint(0, 2), no_local, rng.random() < 0.5, + rng.randint(0, 2)) + fs = others[:k] + [(flt, opts)] + others[k:] + pid = rng.randint(1, 65535) + props = rand_props(rng, "subscribe") + add(f"topic filter {kind} {flt!r}", + enc_packet(("subscribe", pid, props, fs)), True) + if rng.random() < 0.25: + good = good_plain_filter(rng) + if kind.startswith("share"): + good = "$share/" + safe_level(rng) + "/" + good + fs2 = others[:k] + [(good, (opts[0], False, opts[2], opts[3]))] \ + + others[k:] + add(f"topic filter control {good!r}", + enc_packet(("subscribe", pid, props, fs2)), False) + + answers = tool.run() + agree = 0 + for label, idx, expected, bs in entries: + if answers[idx] == expected: + agree += 1 + else: + check(False, f"forbidden/{label}", + f"input {list(bs)}: got {answers[idx]}, want {expected}") + check(answers[idx] in ("none", want_ok(bs)), f"forbidden/{label}", + f"accepted, but reprinted as {answers[idx]}") + return len(entries), agree + + +def protocol_cases(): + lines = ["parse 192,0", "parse", "parse 01", "parse 256", + "parse 192,0,0", "bogus 1", "parse 1 2", "Parse 192,0", + "parse 0", ""] + expected = ["ok:192,0", "none", "error", "error", "none", + "error", "error", "error", "none"] + proc = subprocess.run([EXE], input="\n".join(lines) + "\n", + capture_output=True, text=True, timeout=120) + got = proc.stdout.splitlines() + check(got == expected, "protocol", f"got {got}, want {expected}") + return len(expected) + + +# --------------------------------------------------------------------------- + +def main(): + if "--skip-build" not in sys.argv: + subprocess.run(["lake", "build"], cwd=ROOT, check=True, + capture_output=True, text=True, timeout=1200) + rng = random.Random(SEED) + # The sections that run on every machine; their inputs make the + # recorded input count. The Paho cross-check needs the paho-mqtt + # library, so it is listed apart and left out of that count, and + # a run without the library records the same count. + sections = [] + extra = [] + + n_fixed = fixed_cases() + sections.append(("Fixed cases (spec VBI table, one packet per type, " + "richer hand built packets)", n_fixed, n_fixed)) + + n_or, a_or = oracle_differential(rng, 3000) + sections.append(("Oracle differential, random packets of all seven " + "types (seed 20261026)", n_or, a_or)) + + try: + import paho.mqtt + import importlib.metadata as md + try: + paho_version = md.version("paho-mqtt") + except Exception: + paho_version = "unknown" + paho_present = True + except ImportError: + paho_present = False + paho_version = None + # The Paho section draws from its own generator, so whether it + # runs does not change the inputs of the sections after it. + if paho_present: + n_pa, a_pa, acc_pa, ref_pa = paho_section(random.Random(SEED + 1), 600) + extra.append((f"Paho {paho_version} cross-check, each a Lean answer " + "judged by Paho: its variable byte integer writings " + "as Subscription Identifiers, and property blocks of " + "all six kinds judged by Properties.unpack (Lean " + f"accepted {acc_pa}, refused {ref_pa}; not counted in " + "Inputs)", n_pa, a_pa)) + named = paho_named + + n_mut, a_mut = mutation_cases(rng) + sections.append(("Mutations and named rejections, settled by the " + "oracle", n_mut, a_mut)) + # Its own generator, so the sections before it keep their inputs. + n_fb, a_fb = forbidden_cases(random.Random(SEED + 2)) + sections.append(("Forbidden classes drawn from the seed (property " + "values, Response Topics, Authentication Data, topic " + "filters of 1 to 6 levels), with controls, settled by " + "the oracle", n_fb, a_fb)) + n_proto = protocol_cases() + sections.append(("Line protocol cases", n_proto, n_proto)) + + mosquitto = shutil.which("mosquitto") or shutil.which("mosquitto_sub") + failed = len(failures) + total = sum(t for _, t, _ in sections) + oracle = ("the strict reference decoder and encoder in " + "tests/run_tests.py, written from the OASIS MQTT Version " + "5.0 standard (OASIS Standard, 7 March 2019) and SPEC.md, " + f"run on Python {sys.version.split()[0]}") + if paho_present: + oracle += (f"; with a cross-check against paho-mqtt " + f"{paho_version}, counted apart") + lines = [] + lines.append("# Test results: mqtt") + lines.append("") + lines.append(f"- Oracle: {oracle}") + lines.append(f"- Seed: {SEED}") + lines.append(f"- Inputs: {total}") + lines.append(f"- Failures: {failed}") + lines.append("") + lines.append("Tool: the Lean command line program, one process per " + "section, requests batched. The harness checks parsed " + "structure through the re-encoding the tool prints, " + "together with its own oracle, and checks that every " + "input the tool accepts among the mutations and named " + "cases reprints byte for byte. Inputs counts the " + "sections that run on every machine.") + lines.append("") + if paho_present: + lines.append(f"Paho's Python library (`paho-mqtt`, version " + f"{paho_version}) was importable in the interpreter " + "that ran this harness; the Paho cross-check ran. " + "Each of its inputs compares an answer of the Lean " + "tool with Paho's: Paho's encoder output for " + "variable byte integers must come back unchanged, " + "and Paho's Properties.unpack judges property " + "blocks of all six kinds, accepted and refused, the " + "pieces the library exposes without a broker. It " + "does not judge whole packets. Its inputs are " + "listed below and are not part of Inputs.") + else: + lines.append("Paho's Python library (`paho-mqtt`) was NOT " + "importable in the interpreter that ran this " + "harness; the Paho cross-check did not run, and " + "the strict oracle carried accept and reject " + "alone.") + lines.append("") + lines.append("The plan's third oracle, MQTT 5.0 specification test " + "material, was NOT used: the standard ships no " + "conformance test suite, and the nearest material, the " + "MQTTV5 codec in Eclipse paho.mqtt.testing, is not " + "wired into this harness.") + lines.append("") + if mosquitto: + lines.append(f"A Mosquitto binary was found at {mosquitto}; " + "no Mosquitto test cases are wired into this " + "harness.") + else: + lines.append("Mosquitto was NOT present on this machine (no " + "`mosquitto` or `mosquitto_sub` binary), so no " + "Mosquitto tests ran.") + lines.append("") + lines.append("| Section | Inputs | Agreements |") + lines.append("| --- | --- | --- |") + for name, n, agree in sections + extra: + lines.append(f"| {name} | {n} | {agree} |") + lines.append("") + if named: + lines.append("Named differences from the oracles:") + for d in named: + lines.append(f"- {d}") + else: + lines.append("Named differences from the oracles: none.") + lines.append("") + if failed: + lines.append("Failures, the first 40:") + for f in failures[:40]: + lines.append(f"- {f}") + lines.append("") + with open(os.path.join(HERE, "TEST-RESULTS.md"), "w") as fh: + fh.write("\n".join(lines)) + agree = sum(a for _, _, a in sections) + print(f"sections={len(sections)} inputs={total} agreements={agree} " + f"failures={failed} paho={'yes ' + str(paho_version) if paho_present else 'no'} " + f"mosquitto={'yes' if mosquitto else 'no'}") + return 1 if failed else 0 + + +if __name__ == "__main__": + sys.exit(main())