theory Prelude_ListNoNumbers_E3
imports "$HETS_ISABELLE_LIB/MainHC"
uses "$HETS_ISABELLE_LIB/prelude"
begin

ML "Header.initialize
    [\"Comp1\", \"IdDef\", \"FlipDef\", \"FstDef\", \"SndDef\",
     \"CurryDef\", \"UncurryDef\", \"NotFalse\", \"NotTrue\",
     \"AndFalse\", \"AndTrue\", \"AndSym\", \"OrDef\", \"OtherwiseDef\",
     \"NotFalse1\", \"NotTrue1\", \"notNot1\", \"notNot2\",
     \"EqualTDef\", \"EqualSymDef\", \"EqualReflex\", \"EqualTransT\",
     \"DiffDef\", \"DiffSymDef\", \"DiffTDef\", \"DiffFDef\", \"TE1\",
     \"TE2\", \"TE3\", \"TE4\", \"IUE1\", \"IUE2\", \"IBE1\", \"IBE2\",
     \"IBE3\", \"IBE4\", \"IBE5\", \"IBE6\", \"IBE7\", \"IBE8\",
     \"IOE01\", \"IOE02\", \"IOE03\", \"IOE04\", \"IOE05\", \"IOE06\",
     \"IOE07\", \"IOE08\", \"IOE09\", \"LeIrreflexivity\",
     \"LeTAsymmetry\", \"LeTTransitive\", \"LeTTotal\", \"GeDef\",
     \"GeIrreflexivity\", \"GeTAsymmetry\", \"GeTTransitive\",
     \"GeTTotal\", \"LeqDef\", \"LeqReflexivity\", \"LeqTTransitive\",
     \"LeqTTotal\", \"GeqDef\", \"GeqReflexivity\", \"GeqTTransitive\",
     \"GeqTTotal\", \"EqTSOrdRel\", \"EqFSOrdRel\", \"EqTOrdRel\",
     \"EqFOrdRel\", \"EqTOrdTSubstE\", \"EqTOrdFSubstE\",
     \"EqTOrdTSubstD\", \"EqTOrdFSubstD\", \"LeTGeFEqFRel\",
     \"LeFGeTEqTRel\", \"LeTGeTRel\", \"LeFGeFRel\", \"LeqTGetTRel\",
     \"LeqFGetFRel\", \"GeTLeTRel\", \"GeFLeFRel\", \"GeqTLeqTRel\",
     \"GeqFLeqFRel\", \"LeqTGeFRel\", \"LeqFGeTRel\", \"GeTLeFEqFRel\",
     \"GeFLeTEqTRel\", \"GeqTLeFRel\", \"GeqFLeTRel\",
     \"LeqTLeTEqTRel\", \"LeqFLeFEqFRel\", \"GeqTGeTEqTRel\",
     \"GeqFGeFEqFRel\", \"LeTGeqFRel\", \"GeTLeqFRel\", \"LeLeqDiff\",
     \"CmpLTDef\", \"CmpEQDef\", \"CmpGTDef\", \"MaxYDef\", \"MaxXDef\",
     \"MinXDef\", \"MinYDef\", \"MaxSym\", \"MinSym\", \"TO1\", \"TO2\",
     \"TO3\", \"TO4\", \"TO5\", \"TO6\", \"TO7\", \"IUO01\", \"IUO02\",
     \"IUO03\", \"IUO04\", \"IUO05\", \"IUO06\", \"IUO07\", \"IOO13\",
     \"IOO14\", \"IOO15\", \"IOO16\", \"IOO17\", \"IOO18\", \"IOO19\",
     \"IOO20\", \"IOO21\", \"IOO22\", \"IOO23\", \"IOO24\", \"IOO25\",
     \"IOO26\", \"IOO27\", \"IOO28\", \"IOO29\", \"IOO30\", \"IOO31\",
     \"IOO32\", \"IOO33\", \"IBO5\", \"IBO6\", \"IBO7\", \"IBO8\",
     \"IBO9\", \"IBO10\", \"IBO11\", \"IBO12\", \"NotDefHead\",
     \"HeadDef\", \"NotDefTail\", \"TailDef\", \"FoldrNil\",
     \"FoldrCons\", \"FoldlNil\", \"FoldlCons\", \"MapNil\",
     \"MapCons\", \"XPlusXPlusNil\", \"XPlusXPlusCons\", \"FilterNil\",
     \"FilterConsT\", \"FilterConsF\", \"ZipNil\", \"ZipConsNil\",
     \"ZipConsCons\", \"UnzipNil\", \"UnzipCons\", \"ILE02\", \"ILO05\",
     \"ILO06\", \"ILO07\", \"ILE01\", \"ILO01\", \"ILO02\", \"ILO03\",
     \"ILO04\", \"ILO08\", \"ILO09\", \"ILO10\", \"ILO11\", \"ILO12\",
     \"ILO13\", \"ILO14\", \"ILO15\", \"ILO16\", \"ILO17\", \"ILO18\",
     \"ILO19\", \"ILO20\", \"ILO21\", \"ILO22\", \"FoldlDecomp\",
     \"MapDecomp\", \"MapFunctor\", \"FilterProm\"]"

typedecl Bool
typedecl ('a1) DList
typedecl ('a1) List
typedecl Unit
typedecl X_Nat

datatype Ordering = EQ | GT | LT

consts
Not__X :: "bool => bool" ("(Not''/ _)" [56] 56)
X_Cons :: "'a partial => 'a List partial => 'a List partial"
X_Nil :: "'a List" ("Nil''")
X__XAmpXAmp__X :: "bool => bool => bool" ("(_/ &&/ _)" [54,54] 52)
X__XEqXEq__X :: "'a partial => 'a partial => bool" ("(_/ ==''/ _)" [54,54] 52)
X__XGtXEq__X :: "'a partial => 'a partial => bool" ("(_/ >=''/ _)" [54,54] 52)
X__XGt__X :: "'a partial => 'a partial => bool" ("(_/ >''/ _)" [54,54] 52)
X__XLtXEq__X :: "'a partial => 'a partial => bool" ("(_/ <=''/ _)" [54,54] 52)
X__XLt__X :: "'a partial => 'a partial => bool" ("(_/ <''/ _)" [54,54] 52)
X__XPlusXPlus__X :: "'a List partial => 'a List partial => 'a List partial" ("(_/ ++''/ _)" [54,54] 52)
X__XSlashXEq__X :: "'a partial => 'a partial => bool" ("(_/ '/=/ _)" [54,54] 52)
X__XVBarXVBar__X :: "bool => bool => bool" ("(_/ ||/ _)" [54,54] 52)
X__o__X :: "('b partial => 'c partial) * ('a partial => 'b partial) => 'a partial => 'c partial"
X_curry :: "('a partial * 'b partial => 'c partial) => 'a partial => 'b partial => 'c partial"
X_filter :: "('a partial => bool) => 'a List partial => 'a List partial"
X_flip :: "('a partial => 'b partial => 'c partial) => 'b partial => 'a partial => 'c partial"
X_foldl :: "('a partial => 'b partial => 'a partial) => 'a partial => 'b List partial => 'a partial"
X_foldr :: "('a partial => 'b partial => 'b partial) => 'b partial => 'a List partial => 'b partial"
X_fst :: "'a partial => 'b partial => 'a partial" ("fst''/'(_,/ _')" [3,3] 999)
X_head :: "'a List partial => 'a partial" ("head/'(_')" [3] 999)
X_id :: "'a partial => 'a partial" ("id''/'(_')" [3] 999)
X_map :: "('a partial => 'b partial) => 'a List partial => 'b List partial"
X_max :: "'a partial => 'a partial => 'a partial"
X_min :: "'a partial => 'a partial => 'a partial"
X_snd :: "'a partial => 'b partial => 'b partial" ("snd''/'(_,/ _')" [3,3] 999)
X_tail :: "'a List partial => 'a List partial" ("tail/'(_')" [3] 999)
X_unzip :: "('a partial * 'b partial) List partial => ('a List partial * 'b List partial) partial" ("unzip/'(_')" [3] 999)
X_zip :: "'a List partial => 'b List partial => ('a partial * 'b partial) List partial"
compare :: "'a partial => 'a partial => Ordering partial"
otherwiseH :: "bool"
uncurry :: "('a partial => 'b partial => 'c partial) => 'a partial * 'b partial => 'c partial"

axioms
Comp1 [rule_format] :
"ALL (f :: 'b partial => 'c partial).
 ALL (g :: 'a partial => 'b partial).
 ALL (y :: 'a partial). X__o__X (f, g) y = f (g y)"

IdDef [rule_format] : "ALL (x :: 'a partial). id'(x) = x"

FlipDef [rule_format] :
"ALL (f :: 'a partial => 'b partial => 'c partial).
 ALL (x :: 'a partial). ALL (y :: 'b partial). X_flip f y x = f x y"

FstDef [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'b partial). fst'(x, y) = x"

SndDef [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'b partial). snd'(x, y) = y"

CurryDef [rule_format] :
"ALL (g :: 'a partial * 'b partial => 'c partial).
 ALL (x :: 'a partial).
 ALL (y :: 'b partial). X_curry g x y = g (x, y)"

UncurryDef [rule_format] :
"ALL (f :: 'a partial => 'b partial => 'c partial).
 ALL (x :: 'a partial).
 ALL (y :: 'b partial). uncurry f (x, y) = f x y"

NotFalse [rule_format] : "Not' False"

NotTrue [rule_format] : "~ Not' True"

AndFalse [rule_format] : "ALL (x :: bool). ~ False && x"

AndTrue [rule_format] : "ALL (x :: bool). True && x = x"

AndSym [rule_format] :
"ALL (x :: bool). ALL (y :: bool). x && y = y && x"

OrDef [rule_format] :
"ALL (x :: bool).
 ALL (y :: bool). x || y = Not' (Not' x && Not' y)"

OtherwiseDef [rule_format] : "otherwiseH"

NotFalse1 [rule_format] : "ALL (x :: bool). Not' x = (~ x)"

NotTrue1 [rule_format] : "ALL (x :: bool). ~ Not' x = x"

notNot1 [rule_format] : "ALL (x :: bool). (~ x) = Not' x"

notNot2 [rule_format] : "ALL (x :: bool). (~ ~ x) = (~ Not' x)"

EqualTDef [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x = y --> x ==' y"

EqualSymDef [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x ==' y = y ==' x"

EqualReflex [rule_format] : "ALL (x :: 'a partial). x ==' x"

EqualTransT [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x ==' y & y ==' z --> x ==' z"

DiffDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x /= y = Not' (x ==' y)"

DiffSymDef [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x /= y = y /= x"

DiffTDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x /= y = Not' (x ==' y)"

DiffFDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x /= y) = x ==' y"

TE1 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). ~ x ==' y --> ~ x = y"

TE2 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). Not' (x ==' y) = (~ x ==' y)"

TE3 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ Not' (x ==' y)) = x ==' y"

TE4 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x ==' y) = (~ x ==' y)"

IUE1 [rule_format] : "makePartial () ==' makePartial ()"

IUE2 [rule_format] : "~ makePartial () /= makePartial ()"

IBE1 [rule_format] : "makePartial () ==' makePartial ()"

IBE2 [rule_format] : "undefinedOp ==' undefinedOp"

IBE3 [rule_format] : "~ undefinedOp ==' makePartial ()"

IBE4 [rule_format] : "~ makePartial () ==' undefinedOp"

IBE5 [rule_format] : "makePartial () /= undefinedOp"

IBE6 [rule_format] : "undefinedOp /= makePartial ()"

IBE7 [rule_format] : "Not' (makePartial () ==' undefinedOp)"

IBE8 [rule_format] : "~ Not' Not' (makePartial () ==' undefinedOp)"

IOE01 [rule_format] : "makePartial LT ==' makePartial LT"

IOE02 [rule_format] : "makePartial EQ ==' makePartial EQ"

IOE03 [rule_format] : "makePartial GT ==' makePartial GT"

IOE04 [rule_format] : "~ makePartial LT ==' makePartial EQ"

IOE05 [rule_format] : "~ makePartial LT ==' makePartial GT"

IOE06 [rule_format] : "~ makePartial EQ ==' makePartial GT"

IOE07 [rule_format] : "makePartial LT /= makePartial EQ"

IOE08 [rule_format] : "makePartial LT /= makePartial GT"

IOE09 [rule_format] : "makePartial EQ /= makePartial GT"

LeIrreflexivity [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x ==' y --> ~ x <' y"

LeTAsymmetry [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x <' y --> ~ y <' x"

LeTTransitive [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x <' y & y <' z --> x <' z"

LeTTotal [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (x <' y | y <' x) | x ==' y"

GeDef [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x >' y = y <' x"

GeIrreflexivity [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x ==' y --> ~ x >' y"

GeTAsymmetry [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x >' y --> ~ y >' x"

GeTTransitive [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). (x >' y) && (y >' z) --> x >' z"

GeTTotal [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). ((x >' y) || (y >' x)) || (x ==' y)"

LeqDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <=' y = (x <' y) || (x ==' y)"

LeqReflexivity [rule_format] : "ALL (x :: 'a partial). x <=' x"

LeqTTransitive [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). (x <=' y) && (y <=' z) --> x <=' z"

LeqTTotal [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (x <=' y) && (y <=' x) = x ==' y"

GeqDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x >=' y = (x >' y) || (x ==' y)"

GeqReflexivity [rule_format] : "ALL (x :: 'a partial). x >=' x"

GeqTTransitive [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). (x >=' y) && (y >=' z) --> x >=' z"

GeqTTotal [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (x >=' y) && (y >=' x) = x ==' y"

EqTSOrdRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x ==' y = (~ x <' y & ~ x >' y)"

EqFSOrdRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x ==' y) = (x <' y | x >' y)"

EqTOrdRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x ==' y = (x <=' y & x >=' y)"

EqFOrdRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x ==' y) = (x <=' y | x >=' y)"

EqTOrdTSubstE [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x ==' y & y <' z --> x <' z"

EqTOrdFSubstE [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x ==' y & ~ y <' z --> ~ x <' z"

EqTOrdTSubstD [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x ==' y & z <' y --> z <' x"

EqTOrdFSubstD [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). x ==' y & ~ z <' y --> ~ z <' x"

LeTGeFEqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <' y = (~ x >' y & ~ x ==' y)"

LeFGeTEqTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x <' y) = (x >' y | x ==' y)"

LeTGeTRel [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x <' y = y >' x"

LeFGeFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x <' y) = (~ y >' x)"

LeqTGetTRel [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x <=' y = y >=' x"

LeqFGetFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x <=' y) = (~ y >=' x)"

GeTLeTRel [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x >' y = y <' x"

GeFLeFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x >' y) = (~ y <' x)"

GeqTLeqTRel [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x >=' y = y <=' x"

GeqFLeqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x >=' y) = (~ y <=' x)"

LeqTGeFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <=' y = (~ x >' y)"

LeqFGeTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x <=' y) = x >' y"

GeTLeFEqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x >' y = (~ x <' y & ~ x ==' y)"

GeFLeTEqTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x >' y) = (x <' y | x ==' y)"

GeqTLeFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x >=' y = (~ x <' y)"

GeqFLeTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x >=' y) = x <' y"

LeqTLeTEqTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <=' y = (x <' y | x ==' y)"

LeqFLeFEqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x <=' y) = (~ x <' y & ~ x ==' y)"

GeqTGeTEqTRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x >=' y = (x >' y | x ==' y)"

GeqFGeFEqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (~ x >=' y) = (~ x >' y & ~ x ==' y)"

LeTGeqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <' y = (~ x >=' y)"

GeTLeqFRel [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x >' y = (~ x <=' y)"

LeLeqDiff [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <' y = (x <=' y) && (x /= y)"

CmpLTDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). compare x y ==' makePartial LT = x <' y"

CmpEQDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). compare x y ==' makePartial EQ = x ==' y"

CmpGTDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). compare x y ==' makePartial GT = x >' y"

MaxYDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_max x y ==' y = x <=' y"

MaxXDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_max x y ==' x = y <=' x"

MinXDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_min x y ==' x = x <=' y"

MinYDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_min x y ==' y = y <=' x"

MaxSym [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_max x y ==' y = X_max y x ==' y"

MinSym [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). X_min x y ==' y = X_min y x ==' y"

TO1 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). (x ==' y | x <' y) = x <=' y"

TO2 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x ==' y --> ~ x <' y"

TO3 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). Not' Not' (x <' y) | Not' (x <' y)"

TO4 [rule_format] :
"ALL (x :: 'a partial).
 ALL (y :: 'a partial). x <' y --> Not' (x ==' y)"

TO5 [rule_format] :
"ALL (w :: 'a partial).
 ALL (x :: 'a partial).
 ALL (y :: 'a partial).
 ALL (z :: 'a partial). (x <' y & y <' z) & z <' w --> x <' w"

TO6 [rule_format] :
"ALL (x :: 'a partial).
 ALL (z :: 'a partial). z <' x --> Not' (x <' z)"

TO7 [rule_format] :
"ALL (x :: 'a partial). ALL (y :: 'a partial). x <' y = y >' x"

IUO01 [rule_format] : "makePartial () <=' makePartial ()"

IUO02 [rule_format] : "~ makePartial () <' makePartial ()"

IUO03 [rule_format] : "makePartial () >=' makePartial ()"

IUO04 [rule_format] : "~ makePartial () >' makePartial ()"

IUO05 [rule_format] :
"X_max (makePartial ()) (makePartial ()) ==' makePartial ()"

IUO06 [rule_format] :
"X_min (makePartial ()) (makePartial ()) ==' makePartial ()"

IUO07 [rule_format] :
"compare (makePartial ()) (makePartial ()) ==' makePartial EQ"

IOO13 [rule_format] : "makePartial LT <' makePartial EQ"

IOO14 [rule_format] : "makePartial EQ <' makePartial GT"

IOO15 [rule_format] : "makePartial LT <' makePartial GT"

IOO16 [rule_format] : "makePartial LT <=' makePartial EQ"

IOO17 [rule_format] : "makePartial EQ <=' makePartial GT"

IOO18 [rule_format] : "makePartial LT <=' makePartial GT"

IOO19 [rule_format] : "makePartial EQ >=' makePartial LT"

IOO20 [rule_format] : "makePartial GT >=' makePartial EQ"

IOO21 [rule_format] : "makePartial GT >=' makePartial LT"

IOO22 [rule_format] : "makePartial EQ >' makePartial LT"

IOO23 [rule_format] : "makePartial GT >' makePartial EQ"

IOO24 [rule_format] : "makePartial GT >' makePartial LT"

IOO25 [rule_format] :
"X_max (makePartial LT) (makePartial EQ) ==' makePartial EQ"

IOO26 [rule_format] :
"X_max (makePartial EQ) (makePartial GT) ==' makePartial GT"

IOO27 [rule_format] :
"X_max (makePartial LT) (makePartial GT) ==' makePartial GT"

IOO28 [rule_format] :
"X_min (makePartial LT) (makePartial EQ) ==' makePartial LT"

IOO29 [rule_format] :
"X_min (makePartial EQ) (makePartial GT) ==' makePartial EQ"

IOO30 [rule_format] :
"X_min (makePartial LT) (makePartial GT) ==' makePartial LT"

IOO31 [rule_format] :
"compare (makePartial LT) (makePartial LT) ==' makePartial EQ"

IOO32 [rule_format] :
"compare (makePartial EQ) (makePartial EQ) ==' makePartial EQ"

IOO33 [rule_format] :
"compare (makePartial GT) (makePartial GT) ==' makePartial EQ"

IBO5 [rule_format] : "undefinedOp <' makePartial ()"

IBO6 [rule_format] : "~ undefinedOp >=' makePartial ()"

IBO7 [rule_format] : "makePartial () >=' undefinedOp"

IBO8 [rule_format] : "~ makePartial () <' undefinedOp"

IBO9 [rule_format] :
"X_max undefinedOp (makePartial ()) ==' makePartial ()"

IBO10 [rule_format] :
"X_min undefinedOp (makePartial ()) ==' undefinedOp"

IBO11 [rule_format] :
"compare (makePartial ()) (makePartial ()) ==' makePartial EQ"

IBO12 [rule_format] :
"compare undefinedOp undefinedOp ==' makePartial EQ"

NotDefHead [rule_format] : "~ defOp (head(makePartial Nil'))"

HeadDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (xs :: 'a List partial). head(X_Cons x xs) = x"

NotDefTail [rule_format] : "~ defOp (tail(makePartial Nil'))"

TailDef [rule_format] :
"ALL (x :: 'a partial).
 ALL (xs :: 'a List partial). tail(X_Cons x xs) = xs"

FoldrNil [rule_format] :
"ALL (f :: 'a partial => 'b partial => 'b partial).
 ALL (s :: 'b partial). X_foldr f s (makePartial Nil') = s"

FoldrCons [rule_format] :
"ALL (f :: 'a partial => 'b partial => 'b partial).
 ALL (s :: 'b partial).
 ALL (x :: 'a partial).
 ALL (xs :: 'a List partial).
 X_foldr f s (X_Cons x xs) = f x (X_foldr f s xs)"

FoldlNil [rule_format] :
"ALL (g :: 'a partial => 'b partial => 'a partial).
 ALL (t :: 'a partial). X_foldl g t (makePartial Nil') = t"

FoldlCons [rule_format] :
"ALL (g :: 'a partial => 'b partial => 'a partial).
 ALL (t :: 'a partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 X_foldl g t (X_Cons z zs) = X_foldl g (g t z) zs"

MapNil [rule_format] :
"ALL (h :: 'a partial => 'b partial).
 X_map h (makePartial Nil') = makePartial Nil'"

MapCons [rule_format] :
"ALL (h :: 'a partial => 'b partial).
 ALL (x :: 'a partial).
 ALL (xs :: 'a List partial).
 X_map h (X_Cons x xs) = X_Cons (h x) (X_map h xs)"

XPlusXPlusNil [rule_format] :
"ALL (l :: 'a List partial). makePartial Nil' ++' l = l"

XPlusXPlusCons [rule_format] :
"ALL (l :: 'a List partial).
 ALL (x :: 'a partial).
 ALL (xs :: 'a List partial).
 X_Cons x xs ++' l = X_Cons x (xs ++' l)"

FilterNil [rule_format] :
"ALL (p :: 'a partial => bool).
 X_filter p (makePartial Nil') = makePartial Nil'"

FilterConsT [rule_format] :
"ALL (p :: 'a partial => bool).
 ALL (x :: 'a partial).
 ALL (xs :: 'a List partial).
 p x --> X_filter p (X_Cons x xs) = X_Cons x (X_filter p xs)"

FilterConsF [rule_format] :
"ALL (p :: 'a partial => bool).
 ALL (x :: 'a partial).
 ALL (xs :: 'a List partial).
 ~ p x --> X_filter p (X_Cons x xs) = X_filter p xs"

ZipNil [rule_format] :
"ALL (l :: 'a List partial).
 X_zip (makePartial Nil') l = makePartial Nil'"

ZipConsNil [rule_format] :
"ALL (l :: 'a List partial).
 ALL (x :: 'a partial).
 ALL (xs :: 'a List partial).
 l = makePartial Nil' --> X_zip (X_Cons x xs) l = makePartial Nil'"

ZipConsCons [rule_format] :
"ALL (l :: 'a List partial).
 ALL (x :: 'a partial).
 ALL (xs :: 'a List partial).
 ALL (y :: 'a partial).
 ALL (ys :: 'a List partial).
 l = X_Cons y ys -->
 X_zip (X_Cons x xs) l = X_Cons (makePartial (x, y)) (X_zip xs ys)"

UnzipNil [rule_format] :
"mapSnd id (mapFst id (unzip(makePartial Nil'))) =
 makePartial (makePartial Nil', makePartial Nil')"

UnzipCons [rule_format] :
"ALL (ps :: ('a partial * 'b partial) List partial).
 ALL (x :: 'a partial).
 ALL (ys :: 'a List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 makePartial (ys, zs) = mapSnd id (mapFst id (unzip(ps))) -->
 mapSnd id (mapFst id (unzip(X_Cons (makePartial (x, z)) ps))) =
 makePartial (X_Cons x ys, X_Cons z zs)"

ILE02 [rule_format] :
"ALL (x :: 'a partial).
 ALL (xs :: 'a List partial).
 ALL (y :: 'a partial).
 ALL (ys :: 'a List partial).
 X_Cons x xs ==' X_Cons y ys = (x ==' y) && (xs ==' ys)"

ILO05 [rule_format] :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial). z <' w --> X_Cons z zs <' X_Cons w ws"

ILO06 [rule_format] :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 z ==' w --> X_Cons z zs <' X_Cons w ws = zs <' ws"

ILO07 [rule_format] :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 ~ z <' w & ~ z ==' w --> ~ X_Cons z zs <' X_Cons w ws"

declare Comp1 [simp]
declare IdDef [simp]
declare FlipDef [simp]
declare FstDef [simp]
declare SndDef [simp]
declare CurryDef [simp]
declare UncurryDef [simp]
declare NotFalse [simp]
declare NotTrue [simp]
declare AndFalse [simp]
declare AndTrue [simp]
declare OtherwiseDef [simp]
declare NotTrue1 [simp]
declare EqualReflex [simp]
declare IUE1 [simp]
declare IUE2 [simp]
declare IBE1 [simp]
declare IBE2 [simp]
declare IBE3 [simp]
declare IBE4 [simp]
declare IBE5 [simp]
declare IBE6 [simp]
declare IBE7 [simp]
declare IBE8 [simp]
declare IOE01 [simp]
declare IOE02 [simp]
declare IOE03 [simp]
declare IOE04 [simp]
declare IOE05 [simp]
declare IOE06 [simp]
declare IOE07 [simp]
declare IOE08 [simp]
declare IOE09 [simp]
declare LeIrreflexivity [simp]
declare LeTAsymmetry [simp]
declare GeIrreflexivity [simp]
declare GeTAsymmetry [simp]
declare GeTTransitive [simp]
declare GeTTotal [simp]
declare LeqReflexivity [simp]
declare LeqTTransitive [simp]
declare LeqTTotal [simp]
declare GeqReflexivity [simp]
declare GeqTTransitive [simp]
declare GeqTTotal [simp]
declare CmpLTDef [simp]
declare CmpEQDef [simp]
declare CmpGTDef [simp]
declare MaxYDef [simp]
declare MaxXDef [simp]
declare MinXDef [simp]
declare MinYDef [simp]
declare TO2 [simp]
declare TO4 [simp]
declare TO6 [simp]
declare IUO01 [simp]
declare IUO02 [simp]
declare IUO03 [simp]
declare IUO04 [simp]
declare IUO05 [simp]
declare IUO06 [simp]
declare IUO07 [simp]
declare IOO13 [simp]
declare IOO14 [simp]
declare IOO15 [simp]
declare IOO16 [simp]
declare IOO17 [simp]
declare IOO18 [simp]
declare IOO19 [simp]
declare IOO20 [simp]
declare IOO21 [simp]
declare IOO22 [simp]
declare IOO23 [simp]
declare IOO24 [simp]
declare IOO25 [simp]
declare IOO26 [simp]
declare IOO27 [simp]
declare IOO28 [simp]
declare IOO29 [simp]
declare IOO30 [simp]
declare IOO31 [simp]
declare IOO32 [simp]
declare IOO33 [simp]
declare IBO5 [simp]
declare IBO6 [simp]
declare IBO7 [simp]
declare IBO8 [simp]
declare IBO9 [simp]
declare IBO10 [simp]
declare IBO11 [simp]
declare IBO12 [simp]
declare NotDefHead [simp]
declare HeadDef [simp]
declare NotDefTail [simp]
declare TailDef [simp]
declare FoldrNil [simp]
declare FoldlNil [simp]
declare MapNil [simp]
declare XPlusXPlusNil [simp]
declare FilterNil [simp]
declare FilterConsF [simp]
declare ZipNil [simp]
declare UnzipNil [simp]
declare ILO05 [simp]
declare ILO06 [simp]

theorem ILE01 : "makePartial Nil' ==' makePartial Nil'"
by (auto)

ML "Header.record \"ILE01\""

theorem ILO01 : "~ makePartial Nil' <' makePartial Nil'"
by (auto)

ML "Header.record \"ILO01\""

theorem ILO02 : "makePartial Nil' <=' makePartial Nil'"
by (auto)

ML "Header.record \"ILO02\""

theorem ILO03 : "~ makePartial Nil' >' makePartial Nil'"
by (auto)

ML "Header.record \"ILO03\""

theorem ILO04 : "makePartial Nil' >=' makePartial Nil'"
by (auto)

ML "Header.record \"ILO04\""

theorem ILO08 :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 X_Cons z zs <=' X_Cons w ws =
 (X_Cons z zs <' X_Cons w ws) || (X_Cons z zs ==' X_Cons w ws)"
by (auto)

ML "Header.record \"ILO08\""

theorem ILO09 :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 X_Cons z zs >' X_Cons w ws = X_Cons w ws <' X_Cons z zs"
by (auto)

ML "Header.record \"ILO09\""

theorem ILO10 :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 X_Cons z zs >=' X_Cons w ws =
 (X_Cons z zs >' X_Cons w ws) || (X_Cons z zs ==' X_Cons w ws)"
by (auto)

ML "Header.record \"ILO10\""

theorem ILO11 :
"compare (makePartial Nil') (makePartial Nil') ==' makePartial EQ =
 makePartial Nil' ==' makePartial Nil'"
by (auto)

ML "Header.record \"ILO11\""

theorem ILO12 :
"compare (makePartial Nil') (makePartial Nil') ==' makePartial LT =
 makePartial Nil' <' makePartial Nil'"
by (auto)

ML "Header.record \"ILO12\""

theorem ILO13 :
"compare (makePartial Nil') (makePartial Nil') ==' makePartial GT =
 makePartial Nil' >' makePartial Nil'"
by (auto)

ML "Header.record \"ILO13\""

theorem ILO14 :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 compare (X_Cons z zs) (X_Cons w ws) ==' makePartial EQ =
 X_Cons z zs ==' X_Cons w ws"
by (auto)

ML "Header.record \"ILO14\""

theorem ILO15 :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 compare (X_Cons z zs) (X_Cons w ws) ==' makePartial LT =
 X_Cons z zs <' X_Cons w ws"
by (auto)

ML "Header.record \"ILO15\""

theorem ILO16 :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 compare (X_Cons z zs) (X_Cons w ws) ==' makePartial GT =
 X_Cons z zs >' X_Cons w ws"
by (auto)

ML "Header.record \"ILO16\""

theorem ILO17 :
"X_max (makePartial Nil') (makePartial Nil') ==' makePartial Nil' =
 makePartial Nil' <=' makePartial Nil'"
by (auto)

ML "Header.record \"ILO17\""

theorem ILO18 :
"X_min (makePartial Nil') (makePartial Nil') ==' makePartial Nil' =
 makePartial Nil' <=' makePartial Nil'"
by (auto)

ML "Header.record \"ILO18\""

theorem ILO19 :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 X_Cons z zs <=' X_Cons w ws =
 X_max (X_Cons z zs) (X_Cons w ws) ==' X_Cons w ws"
by (auto)

ML "Header.record \"ILO19\""

theorem ILO20 :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 X_Cons w ws <=' X_Cons z zs =
 X_max (X_Cons z zs) (X_Cons w ws) ==' X_Cons z zs"
by (auto)

ML "Header.record \"ILO20\""

theorem ILO21 :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 X_Cons z zs <=' X_Cons w ws =
 X_min (X_Cons z zs) (X_Cons w ws) ==' X_Cons z zs"
by (auto)

ML "Header.record \"ILO21\""

theorem ILO22 :
"ALL (w :: 'b partial).
 ALL (ws :: 'b List partial).
 ALL (z :: 'b partial).
 ALL (zs :: 'b List partial).
 X_Cons w ws <=' X_Cons z zs =
 X_min (X_Cons z zs) (X_Cons w ws) ==' X_Cons w ws"
by (auto)

ML "Header.record \"ILO22\""

theorem FoldlDecomp :
"ALL (e :: 'a partial).
 ALL (i :: 'a partial => 'b partial => 'a partial).
 ALL (ts :: 'b List partial).
 ALL (ys :: 'b List partial).
 X_foldl i e (ys ++' ts) = X_foldl i (X_foldl i e ys) ts"
by (auto)

ML "Header.record \"FoldlDecomp\""

theorem MapDecomp :
"ALL (f :: 'a partial => 'b partial).
 ALL (xs :: 'a List partial).
 ALL (zs :: 'a List partial).
 X_map f (xs ++' zs) = X_map f xs ++' X_map f zs"
by (auto)

ML "Header.record \"MapDecomp\""

theorem MapFunctor :
"ALL (f :: 'a partial => 'b partial).
 ALL (g :: 'b partial => 'c partial).
 ALL (xs :: 'a List partial).
 X_map (X__o__X (g, f)) xs = X_map g (X_map f xs)"
by (auto)

ML "Header.record \"MapFunctor\""

theorem FilterProm :
"ALL (f :: 'a partial => 'b partial).
 ALL (p :: 'b partial => bool).
 ALL (xs :: 'a List partial).
 X_filter p (X_map f xs) =
 X_map f (X_filter (id o defOp o X__o__X (bool2partial o p, f)) xs)"
by (auto)

ML "Header.record \"FilterProm\""

end


(*  Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1996  University of Cambridge

Inductive relation "ns_public" for the Needham-Schroeder Public-Key protocol.
Version incorporating Lowe's fix (inclusion of B's identity in round 2).
*)(*<*)
theory NS_Public imports Public begin(*>*)

section{* Modelling the Protocol \label{sec:modelling} *}

text_raw {*
\begin{figure}
\begin{isabelle}
*}

inductive_set ns_public :: "event list set"
  where

   Nil:  "[] \<in> ns_public"

 | Fake: "\<lbrakk>evsf \<in> ns_public;  X \<in> synth (analz (knows Spy evsf))\<rbrakk>
          \<Longrightarrow> Says Spy B X  # evsf \<in> ns_public"

 | NS1:  "\<lbrakk>evs1 \<in> ns_public;  Nonce NA \<notin> used evs1\<rbrakk>
          \<Longrightarrow> Says A B (Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>)
                 # evs1  \<in>  ns_public"

 | NS2:  "\<lbrakk>evs2 \<in> ns_public;  Nonce NB \<notin> used evs2;
           Says A' B (Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs2\<rbrakk>
          \<Longrightarrow> Says B A (Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>)
                # evs2  \<in>  ns_public"

 | NS3:  "\<lbrakk>evs3 \<in> ns_public;
           Says A  B (Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs3;
           Says B' A (Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>)
              \<in> set evs3\<rbrakk>
          \<Longrightarrow> Says A B (Crypt (pubK B) (Nonce NB)) # evs3 \<in> ns_public"

text_raw {*
\end{isabelle}
\caption{An Inductive Protocol Definition}\label{fig:ns_public}
\end{figure}
*}

text {*
Let us formalize the Needham-Schroeder public-key protocol, as corrected by
Lowe:
\begin{alignat*%
}{2}
  &1.&\quad  A\to B  &: \comp{Na,A}\sb{Kb} \\
  &2.&\quad  B\to A  &: \comp{Na,Nb,B}\sb{Ka} \\
  &3.&\quad  A\to B  &: \comp{Nb}\sb{Kb}
\end{alignat*%
}

Each protocol step is specified by a rule of an inductive definition.  An
event trace has type @{text "event list"}, so we declare the constant
@{text ns_public} to be a set of such traces.

Figure~\ref{fig:ns_public} presents the inductive definition.  The
@{text Nil} rule introduces the empty trace.  The @{text Fake} rule models the
adversary's sending a message built from components taken from past
traffic, expressed using the functions @{text synth} and
@{text analz}.
The next three rules model how honest agents would perform the three
protocol steps.

Here is a detailed explanation of rule @{text NS2}.
A trace containing an event of the form
@{term [display,indent=5] "Says A' B (Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>)"}
may be extended by an event of the form
@{term [display,indent=5] "Says B A (Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>)"}
where @{text NB} is a fresh nonce: @{term "Nonce NB \<notin> used evs2"}.
Writing the sender as @{text A'} indicates that @{text B} does not
know who sent the message.  Calling the trace variable @{text evs2} rather
than simply @{text evs} helps us know where we are in a proof after many
case-splits: every subgoal mentioning @{text evs2} involves message~2 of the
protocol.

Benefits of this approach are simplicity and clarity.  The semantic model
is set theory, proofs are by induction and the translation from the informal
notation to the inductive rules is straightforward.
*}

section{* Proving Elementary Properties \label{sec:regularity} *}

(*<*)
declare knows_Spy_partsEs [elim]
declare analz_subset_parts [THEN subsetD, dest]
declare Fake_parts_insert [THEN subsetD, dest]

(*A "possibility property": there are traces that reach the end*)
lemma "\<exists>NB. \<exists>evs \<in> ns_public. Says A B (Crypt (pubK B) (Nonce NB)) \<in> set evs"
apply (intro exI bexI)
apply (rule_tac [2] ns_public.Nil [THEN ns_public.NS1, THEN ns_public.NS2,
                                   THEN ns_public.NS3])
by possibility

(**** Inductive proofs about ns_public ****)

(** Theorems of the form X \<notin> parts (knows Spy evs) imply that NOBODY
    sends messages containing X! **)

(*Spy never sees another agent's private key! (unless it's bad at start)*)
(*>*)

text {*
Secrecy properties can be hard to prove.  The conclusion of a typical
secrecy theorem is
@{term "X \<notin> analz (knows Spy evs)"}.  The difficulty arises from
having to reason about @{text analz}, or less formally, showing that the spy
can never learn~@{text X}.  Much easier is to prove that @{text X} can never
occur at all.  Such \emph{regularity} properties are typically expressed
using @{text parts} rather than @{text analz}.

The following lemma states that @{text A}'s private key is potentially
known to the spy if and only if @{text A} belongs to the set @{text bad} of
compromised agents.  The statement uses @{text parts}: the very presence of
@{text A}'s private key in a message, whether protected by encryption or
not, is enough to confirm that @{text A} is compromised.  The proof, like
nearly all protocol proofs, is by induction over traces.
*}

lemma Spy_see_priK [simp]:
      "evs \<in> ns_public
       \<Longrightarrow> (Key (priK A) \<in> parts (knows Spy evs)) = (A \<in> bad)"
apply (erule ns_public.induct, simp_all)
txt {*
The induction yields five subgoals, one for each rule in the definition of
@{text ns_public}.  The idea is to prove that the protocol property holds initially
(rule @{text Nil}), is preserved by each of the legitimate protocol steps (rules
@{text NS1}--@{text 3}), and even is preserved in the face of anything the
spy can do (rule @{text Fake}).

The proof is trivial.  No legitimate protocol rule sends any keys
at all, so only @{text Fake} is relevant. Indeed, simplification leaves
only the @{text Fake} case, as indicated by the variable name @{text evsf}:
@{subgoals[display,indent=0,margin=65]}
*}
by blast
(*<*)
lemma Spy_analz_priK [simp]:
      "evs \<in> ns_public \<Longrightarrow> (Key (priK A) \<in> analz (knows Spy evs)) = (A \<in> bad)"
by auto
(*>*)

text {*
The @{text Fake} case is proved automatically.  If
@{term "priK A"} is in the extended trace then either (1) it was already in the
original trace or (2) it was
generated by the spy, who must have known this key already.
Either way, the induction hypothesis applies.

\emph{Unicity} lemmas are regularity lemmas stating that specified items
can occur only once in a trace.  The following lemma states that a nonce
cannot be used both as $Na$ and as $Nb$ unless
it is known to the spy.  Intuitively, it holds because honest agents
always choose fresh values as nonces; only the spy might reuse a value,
and he doesn't know this particular value.  The proof script is short:
induction, simplification, @{text blast}.  The first line uses the rule
@{text rev_mp} to prepare the induction by moving two assumptions into the
induction formula.
*}

lemma no_nonce_NS1_NS2:
    "\<lbrakk>Crypt (pubK C) \<lbrace>NA', Nonce NA, Agent D\<rbrace> \<in> parts (knows Spy evs);
      Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace> \<in> parts (knows Spy evs);
      evs \<in> ns_public\<rbrakk>
     \<Longrightarrow> Nonce NA \<in> analz (knows Spy evs)"
apply (erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all)
apply (blast intro: analz_insertI)+
done

text {*
The following unicity lemma states that, if \isa{NA} is secret, then its
appearance in any instance of message~1 determines the other components.
The proof is similar to the previous one.
*}

lemma unique_NA:
     "\<lbrakk>Crypt(pubK B)  \<lbrace>Nonce NA, Agent A \<rbrace> \<in> parts(knows Spy evs);
       Crypt(pubK B') \<lbrace>Nonce NA, Agent A'\<rbrace> \<in> parts(knows Spy evs);
       Nonce NA \<notin> analz (knows Spy evs); evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> A=A' \<and> B=B'"
(*<*)
apply (erule rev_mp, erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all)
(*Fake, NS1*)
apply (blast intro: analz_insertI)+
done
(*>*)

section{* Proving Secrecy Theorems \label{sec:secrecy} *}

(*<*)
(*Secrecy: Spy does not see the nonce sent in msg NS1 if A and B are secure
  The major premise "Says A B ..." makes it a dest-rule, so we use
  (erule rev_mp) rather than rule_format. *)
theorem Spy_not_see_NA:
      "\<lbrakk>Says A B (Crypt(pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs;
        A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
       \<Longrightarrow> Nonce NA \<notin> analz (knows Spy evs)"
apply (erule rev_mp)
apply (erule ns_public.induct, simp_all)
apply spy_analz
apply (blast dest: unique_NA intro: no_nonce_NS1_NS2)+
done

(*Authentication for A: if she receives message 2 and has used NA
  to start a run, then B has sent message 2.*)
lemma A_trusts_NS2_lemma [rule_format]:
   "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
    \<Longrightarrow> Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace> \<in> parts (knows Spy evs) \<longrightarrow>
        Says A B (Crypt(pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs \<longrightarrow>
        Says B A (Crypt(pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs"
apply (erule ns_public.induct, simp_all)
(*Fake, NS1*)
apply (blast dest: Spy_not_see_NA)+
done

theorem A_trusts_NS2:
     "\<lbrakk>Says A  B (Crypt(pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs;
       Says B' A (Crypt(pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs;
       A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> Says B A (Crypt(pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs"
by (blast intro: A_trusts_NS2_lemma)

(*If the encrypted message appears then it originated with Alice in NS1*)
lemma B_trusts_NS1 [rule_format]:
     "evs \<in> ns_public
      \<Longrightarrow> Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace> \<in> parts (knows Spy evs) \<longrightarrow>
          Nonce NA \<notin> analz (knows Spy evs) \<longrightarrow>
          Says A B (Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs"
apply (erule ns_public.induct, simp_all)
(*Fake*)
apply (blast intro!: analz_insertI)
done

(*** Authenticity properties obtained from NS2 ***)

(*Unicity for NS2: nonce NB identifies nonce NA and agents A, B
  [unicity of B makes Lowe's fix work]
  [proof closely follows that for unique_NA] *)

lemma unique_NB [dest]:
     "\<lbrakk>Crypt(pubK A)  \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace> \<in> parts(knows Spy evs);
       Crypt(pubK A') \<lbrace>Nonce NA', Nonce NB, Agent B'\<rbrace> \<in> parts(knows Spy evs);
       Nonce NB \<notin> analz (knows Spy evs); evs \<in> ns_public\<rbrakk>
      \<Longrightarrow> A=A' \<and> NA=NA' \<and> B=B'"
apply (erule rev_mp, erule rev_mp, erule rev_mp)
apply (erule ns_public.induct, simp_all)
(*Fake, NS2*)
apply (blast intro: analz_insertI)+
done
(*>*)

text {*
The secrecy theorems for Bob (the second participant) are especially
important because they fail for the original protocol.  The following
theorem states that if Bob sends message~2 to Alice, and both agents are
uncompromised, then Bob's nonce will never reach the spy.
*}

theorem Spy_not_see_NB [dest]:
 "\<lbrakk>Says B A (Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs;
   A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
  \<Longrightarrow> Nonce NB \<notin> analz (knows Spy evs)"
txt {*
To prove it, we must formulate the induction properly (one of the
assumptions mentions~@{text evs}), apply induction, and simplify:
*}

apply (erule rev_mp, erule ns_public.induct, simp_all)
(*<*)
apply spy_analz
defer
apply (blast intro: no_nonce_NS1_NS2)
apply (blast intro: no_nonce_NS1_NS2)
(*>*)

txt {*
The proof states are too complicated to present in full.
Let's examine the simplest subgoal, that for message~1.  The following
event has just occurred:
\[ 1.\quad  A'\to B'  : \comp{Na',A'}\sb{Kb'} \]
The variables above have been primed because this step
belongs to a different run from that referred to in the theorem
statement --- the theorem
refers to a past instance of message~2, while this subgoal
concerns message~1 being sent just now.
In the Isabelle subgoal, instead of primed variables like $B'$ and $Na'$
we have @{text Ba} and~@{text NAa}:
@{subgoals[display,indent=0]}
The simplifier has used a
default simplification rule that does a case
analysis for each encrypted message on whether or not the decryption key
is compromised.
@{named_thms [display,indent=0,margin=50] analz_Crypt_if [no_vars] (analz_Crypt_if)}
The simplifier has also used @{text Spy_see_priK}, proved in
{\S}\ref{sec:regularity} above, to yield @{term "Ba \<in> bad"}.

Recall that this subgoal concerns the case
where the last message to be sent was
\[ 1.\quad  A'\to B'  : \comp{Na',A'}\sb{Kb'}. \]
This message can compromise $Nb$ only if $Nb=Na'$ and $B'$ is compromised,
allowing the spy to decrypt the message.  The Isabelle subgoal says
precisely this, if we allow for its choice of variable names.
Proving @{term "NB \<noteq> NAa"} is easy: @{text NB} was
sent earlier, while @{text NAa} is fresh; formally, we have
the assumption @{term "Nonce NAa \<notin> used evs1"}.

Note that our reasoning concerned @{text B}'s participation in another
run.  Agents may engage in several runs concurrently, and some attacks work
by interleaving the messages of two runs.  With model checking, this
possibility can cause a state-space explosion, and for us it
certainly complicates proofs.  The biggest subgoal concerns message~2.  It
splits into several cases, such as whether or not the message just sent is
the very message mentioned in the theorem statement.
Some of the cases are proved by unicity, others by
the induction hypothesis.  For all those complications, the proofs are
automatic by @{text blast} with the theorem @{text no_nonce_NS1_NS2}.

The remaining theorems about the protocol are not hard to prove.  The
following one asserts a form of \emph{authenticity}: if
@{text B} has sent an instance of message~2 to~@{text A} and has received the
expected reply, then that reply really originated with~@{text A}.  The
proof is a simple induction.
*}

(*<*)
by (blast intro: no_nonce_NS1_NS2)

lemma B_trusts_NS3_lemma [rule_format]:
     "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk> \<Longrightarrow>
      Crypt (pubK B) (Nonce NB) \<in> parts (knows Spy evs) \<longrightarrow>
      Says B A (Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs \<longrightarrow>
      Says A B (Crypt (pubK B) (Nonce NB)) \<in> set evs"
by (erule ns_public.induct, auto)
(*>*)
theorem B_trusts_NS3:
 "\<lbrakk>Says B A  (Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs;
   Says A' B (Crypt (pubK B) (Nonce NB)) \<in> set evs;
   A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk>
  \<Longrightarrow> Says A B (Crypt (pubK B) (Nonce NB)) \<in> set evs"
(*<*)
by (blast intro: B_trusts_NS3_lemma)

(*** Overall guarantee for B ***)

(*If NS3 has been sent and the nonce NB agrees with the nonce B joined with
  NA, then A initiated the run using NA.*)
theorem B_trusts_protocol [rule_format]:
     "\<lbrakk>A \<notin> bad;  B \<notin> bad;  evs \<in> ns_public\<rbrakk> \<Longrightarrow>
      Crypt (pubK B) (Nonce NB) \<in> parts (knows Spy evs) \<longrightarrow>
      Says B A  (Crypt (pubK A) \<lbrace>Nonce NA, Nonce NB, Agent B\<rbrace>) \<in> set evs \<longrightarrow>
      Says A B (Crypt (pubK B) \<lbrace>Nonce NA, Agent A\<rbrace>) \<in> set evs"
by (erule ns_public.induct, auto)
(*>*)

text {*
From similar assumptions, we can prove that @{text A} started the protocol
run by sending an instance of message~1 involving the nonce~@{text NA}\@.
For this theorem, the conclusion is
@{thm [display] (concl) B_trusts_protocol [no_vars]}
Analogous theorems can be proved for~@{text A}, stating that nonce~@{text NA}
remains secret and that message~2 really originates with~@{text B}.  Even the
flawed protocol establishes these properties for~@{text A};
the flaw only harms the second participant.

\medskip

Detailed information on this protocol verification technique can be found
elsewhere~@{cite "paulson-jcs"}, including proofs of an Internet
protocol~@{cite "paulson-tls"}.  We must stress that the protocol discussed
in this chapter is trivial.  There are only three messages; no keys are
exchanged; we merely have to prove that encrypted data remains secret.
Real world protocols are much longer and distribute many secrets to their
participants.  To be realistic, the model has to include the possibility
of keys being lost dynamically due to carelessness.  If those keys have
been used to encrypt other sensitive information, there may be cascading
losses.  We may still be able to establish a bound on the losses and to
prove that other protocol runs function
correctly~@{cite "paulson-yahalom"}.  Proofs of real-world protocols follow
the strategy illustrated above, but the subgoals can
be much bigger and there are more of them.
\index{protocols!security|)}
*}

(*<*)end(*>*)