Theory Implem_symmetric

(*******************************************************************************

  Project: Refining Authenticated Key Agreement with Strong Adversaries

  Module:  Implem_symmetric.thy (Isabelle/HOL 2016-1)
  ID:      $Id: Implem_symmetric.thy 132885 2016-12-23 18:41:32Z csprenge $
  Author:  Joseph Lallemand, INRIA Nancy <joseph.lallemand@loria.fr>
           Christoph Sprenger, ETH Zurich <sprenger@inf.ethz.ch>
  
  Symmetric channel implementation (locale interpretation) using
  symmetric encryption and HMACs

  Copyright (c) 2015-2016 Joseph Lallemand and Christoph Sprenger
  Licence: LGPL

*******************************************************************************)

section ‹Symmetric Implementation of Channel Messages›

theory Implem_symmetric
imports Implem
begin

(**************************************************************************************************)
subsection ‹Implementation of channel messages›
(**************************************************************************************************)

fun implem_sym :: "chan  msg" where
  "implem_sym (Insec A B M) = InsecTag, Agent A, Agent B, M"
 |"implem_sym (Confid A B M) = Enc ConfidTag, M (shrK A B)"
 |"implem_sym (Auth A B M) = M, hmac AuthTag, M (shrK A B)"
 |"implem_sym (Secure A B M) = Enc SecureTag, M (shrK A B)"


text ‹
First step: @{locale "basic_implem"}. 
Trivial as there are no assumption, this locale just defines some useful abbreviations and valid.
›
interpretation sym: basic_implem implem_sym
done


text ‹Second step: @{locale "semivalid_implem"}.
Here we prove some basic properties such as injectivity and some properties about the 
interaction of sets of implementation messages with @{term analz}; these properties are 
proved as separate lemmas as the proofs are more complex. 
›

text ‹Auxiliary: simpler definitions of the implSets› for the proofs, using the 
msgSet› definitions. 
›

abbreviation implInsecSet_aux :: "msg set  msg set" where 
  "implInsecSet_aux G  PairSet Tags (PairSet (range Agent) (PairSet (range Agent) G))"

abbreviation implAuthSet_aux :: "msg set  msg set" where 
  "implAuthSet_aux G  PairSet G (HashSet (PairSet (PairSet Tags G) (range (case_prod shrK))))"

abbreviation implConfidSet_aux :: "(agent * agent) set  msg set  msg set" where 
  "implConfidSet_aux Ag G  EncSet (PairSet Tags G) (case_prod shrK`Ag)"

abbreviation implSecureSet_aux :: "(agent * agent) set  msg set  msg set" where 
"implSecureSet_aux Ag G  EncSet (PairSet Tags G) (case_prod shrK`Ag)"

text ‹These auxiliary definitions are overapproximations.›

lemma implInsecSet_implInsecSet_aux: "sym.implInsecSet G  implInsecSet_aux G"
by auto

lemma implAuthSet_implAuthSet_aux: "sym.implAuthSet G  implAuthSet_aux G"
by (auto, auto)

lemma implConfidSet_implConfidSet_aux: "sym.implConfidSet Ag G  implConfidSet_aux Ag G"
by (auto)

lemma implSecureSet_implSecureSet_aux: "sym.implSecureSet Ag G  implSecureSet_aux Ag G"
by (auto)

lemmas implSet_implSet_aux =
  implInsecSet_implInsecSet_aux implAuthSet_implAuthSet_aux
  implConfidSet_implConfidSet_aux implSecureSet_implSecureSet_aux

declare Enc_keys_clean_msgSet_Un [intro]


(**************************************************************************************************)
subsection ‹Lemmas to pull implementation sets out of @{term analz}
(**************************************************************************************************)

text ‹
All these proofs are similar:
\begin{enumerate}
\item prove the lemma for the @{term "implSet_aux"} and with the set added outside of  
  @{term analz} given explicitly,
\item prove the lemma for the @{term "implSet_aux"} but with payload, and
\item prove the lemma for the @{term "implSet"}.
\end{enumerate}
There  are two cases for the confidential and secure messages:
the general case (the payloads stay in @{term  analz}) and the case where the key is unknown
(the messages cannot be opened and are completely removed from the @{term analz}).
›


subsubsection ‹Pull @{term implInsecSet} out of @{term analz}
(**************************************************************************************************)

lemma analz_Un_implInsecSet_aux_1:
  "Enc_keys_clean (G  H) 
   analz (implInsecSet_aux G  H)  
     implInsecSet_aux G  Tags 
     PairSet (range Agent) (PairSet (range Agent) G) 
     PairSet (range Agent) G 
     analz (range Agent  G  (range Agent  H))"
proof -
  assume H:"Enc_keys_clean (G  H)"
  have "analz (implInsecSet_aux G  H)  implInsecSet_aux G 
          analz (Tags  PairSet (range Agent) (PairSet (range Agent) G)  H)"
    by (rule analz_Un_PairSet)
  also have "... = implInsecSet_aux G  
            analz (Tags  (PairSet (range Agent) (PairSet (range Agent) G)  H))"
    by (simp only: Un_assoc)
  also have "...  implInsecSet_aux G 
          (Tags  analz (PairSet (range Agent) (PairSet (range Agent) G)  H))"
    by (rule Un_mono, blast, rule analz_Un_Tag, blast intro: H)
  also have "... = implInsecSet_aux G  Tags 
                  analz (PairSet (range Agent) (PairSet (range Agent) G)  H)"
    by auto
  also have "...  implInsecSet_aux G  Tags  (PairSet (range Agent) (PairSet (range Agent) G) 
                  analz (range Agent  PairSet (range Agent) G  H))"
    by (rule Un_mono, blast, rule analz_Un_PairSet)
  also have "... = implInsecSet_aux G  Tags  PairSet (range Agent) (PairSet (range Agent) G) 
                  analz (PairSet (range Agent) G  (range Agent  H))"
    by (auto simp add: Un_assoc Un_commute)
  also have "...  implInsecSet_aux G  Tags  PairSet (range Agent) (PairSet (range Agent) G) 
                  (PairSet (range Agent) G  analz (range Agent  G  (range Agent  H)))"
    by (rule Un_mono, blast, rule analz_Un_PairSet)
  also have "... = implInsecSet_aux G  Tags  (PairSet (range Agent) (PairSet (range Agent) G) 
                  PairSet (range Agent) G)  analz (range Agent  G  (range Agent  H))"
    by (simp only: Un_assoc Un_commute)
   finally show ?thesis by auto
qed

lemma analz_Un_implInsecSet_aux_2:
  "Enc_keys_clean (G  H) 
   analz (implInsecSet_aux G  H)  
     implInsecSet_aux G  Tags  
     synth (analz (G  H))"
proof -
  assume H:"Enc_keys_clean (G  H)"
  have HH:"PairSet (range Agent) (PairSet (range Agent) G) 
                  PairSet (range Agent) G  synth (analz (G  H))"
    by auto
  have HHH:"analz (range Agent  G  (range Agent  H))  synth (analz (G  H))"
    proof -
      have "analz (range Agent  G  (range Agent  H))  
            synth (analz (range Agent  G  (range Agent  H)))"
        by auto
      also have "... = synth (analz (synth (range Agent  G  (range Agent  H))))" by auto
      also have "...  synth (analz (synth (G  H)))"
        proof (rule synth_analz_mono)
          have "range Agent  G  (range Agent  H)  synth (G  H)" by auto
          then have "synth (range Agent  G  (range Agent  H))  synth (synth (G  H))"
            by (rule synth_mono)
          then show "synth (range Agent  G  (range Agent  H))  synth (G  H)" by auto
        qed
      also have "... = synth (analz (G  H))" by auto
      finally show ?thesis .
    qed
  from H have 
   "analz (implInsecSet_aux G  H)   
      implInsecSet_aux G  Tags  PairSet (range Agent) (PairSet (range Agent) G) 
      PairSet (range Agent) G  analz (range Agent  G  (range Agent  H))"
    by (rule analz_Un_implInsecSet_aux_1)
  also have "... = implInsecSet_aux G  Tags  
                   (PairSet (range Agent) (PairSet (range Agent) G) 
                   PairSet (range Agent) G)  analz (range Agent  G  (range Agent  H))"
    by (simp only: Un_assoc Un_commute)
  also have "...  implInsecSet_aux G  Tags  synth (analz (G  H))  
                    synth (analz (G  H))"
     by ((rule Un_mono)+, auto simp add: HH HHH)
  finally show ?thesis by auto
qed

lemma analz_Un_implInsecSet_aux_3:
  "Enc_keys_clean (G  H) 
   analz (implInsecSet_aux G  H)  synth (analz (G  H))  -payload"
by (rule subset_trans [OF analz_Un_implInsecSet_aux_2], auto)

lemma analz_Un_implInsecSet:
  "Enc_keys_clean (G  H) 
   analz (sym.implInsecSet G  H)  synth (analz (G  H))  -payload"
apply (rule subset_trans [of _ "analz (implInsecSet_aux G  H)" _])
apply (rule analz_mono, rule Un_mono, blast intro!: implSet_implSet_aux, simp)
using analz_Un_implInsecSet_aux_3 apply blast
done


subsection ‹Pull @{term implConfidSet} out of @{term analz}
(**************************************************************************************************)

lemma analz_Un_implConfidSet_aux_1:
  "Enc_keys_clean (G  H) 
   analz (implConfidSet_aux Ag G  H)  
     implConfidSet_aux Ag G  PairSet Tags G  Tags 
     analz (G  H)"
proof -
  assume H:"Enc_keys_clean (G  H)"
  have "analz (implConfidSet_aux Ag G  H)  
        implConfidSet_aux Ag G  analz (PairSet Tags G  H)"
    by (rule analz_Un_EncSet, fast, blast intro: H)
  also have "...  implConfidSet_aux Ag G  (PairSet Tags G  analz (Tags  G  H))"
    by (rule Un_mono, blast, rule analz_Un_PairSet)
  also have "... = implConfidSet_aux Ag G  PairSet Tags G  analz (Tags  (G  H))"
    by (simp only: Un_assoc)
  also have "...  implConfidSet_aux Ag G  PairSet Tags G  (Tags  analz (G  H))"
    by (rule Un_mono, blast, rule analz_Un_Tag, blast intro: H)
   finally show ?thesis by auto
qed

lemma analz_Un_implConfidSet_aux_2:
  "Enc_keys_clean (G  H) 
   analz (implConfidSet_aux Ag G  H)  
     implConfidSet_aux Ag G  PairSet Tags G  Tags 
     synth (analz (G  H))"
proof -
  assume H:"Enc_keys_clean (G  H)"
  from H have "analz (implConfidSet_aux Ag G  H)  
                implConfidSet_aux Ag G  PairSet Tags G  Tags  analz (G  H)"
    by (rule analz_Un_implConfidSet_aux_1)
  also have "...  implConfidSet_aux Ag G  PairSet Tags G  Tags  synth (analz (G  H))"
     by auto
  finally show ?thesis by auto
qed

lemma analz_Un_implConfidSet_aux_3:
  "Enc_keys_clean (G  H) 
  analz (implConfidSet_aux Ag G  H)  synth (analz (G  H))  -payload"
by (rule subset_trans [OF analz_Un_implConfidSet_aux_2], auto)

lemma analz_Un_implConfidSet:
  "Enc_keys_clean (G  H) 
   analz (sym.implConfidSet Ag G  H)  synth (analz (G  H))  -payload"
apply (rule subset_trans [of _ "analz (implConfidSet_aux Ag G  H)" _])
apply (rule analz_mono, rule Un_mono, blast intro!: implSet_implSet_aux, simp)
using analz_Un_implConfidSet_aux_3 apply blast
done

text ‹Pull @{term implConfidSet} out of @{term analz}, 2nd case where the agents are honest.›

lemma analz_Un_implConfidSet_2_aux_1:
  "Enc_keys_clean H 
   Ag  broken (parts H  range LtK) = {} 
   analz (implConfidSet_aux Ag G  H)  implConfidSet_aux Ag G  synth (analz H)"
apply (rule subset_trans [OF analz_Un_EncSet2], simp)
apply (auto dest:analz_into_parts)
done

lemma analz_Un_implConfidSet_2_aux_3:
  "Enc_keys_clean H 
   Ag  broken (parts H  range LtK) = {} 
   analz (implConfidSet_aux Ag G  H)  synth (analz H)  -payload"
by (rule subset_trans [OF analz_Un_implConfidSet_2_aux_1], auto)

lemma analz_Un_implConfidSet_2:
  "Enc_keys_clean H 
   Ag  broken (parts H  range LtK) = {} 
   analz (sym.implConfidSet Ag G  H)  synth (analz H)  -payload"
apply (rule subset_trans [of _ "analz (implConfidSet_aux Ag G  H)" _])
apply (rule analz_mono, rule Un_mono, blast intro!: implSet_implSet_aux, simp)
using analz_Un_implConfidSet_2_aux_3 apply auto
done


subsection ‹Pull @{term implSecureSet} out of @{term analz}
(**************************************************************************************************)

lemma analz_Un_implSecureSet_aux_1:
  "Enc_keys_clean (G  H) 
   analz (implSecureSet_aux Ag G  H)  
     implSecureSet_aux Ag G  PairSet Tags G  Tags 
     analz (G  H)"
proof -
  assume H:"Enc_keys_clean (G  H)"
  have "analz (implSecureSet_aux Ag G  H)  
        implSecureSet_aux Ag G  analz (PairSet Tags G  H)"
    by (rule analz_Un_EncSet, fast, blast intro: H)
  also have "...  implSecureSet_aux Ag G  (PairSet Tags G  analz (Tags  G  H))"
    by (rule Un_mono, blast, rule analz_Un_PairSet)
  also have "... = implSecureSet_aux Ag G  PairSet Tags G  analz (Tags  (G  H))"
    by (simp only: Un_assoc)
  also have "...  implSecureSet_aux Ag G  PairSet Tags G  (Tags  analz (G  H))"
    by (rule Un_mono, blast, rule analz_Un_Tag, blast intro: H)
   finally show ?thesis by auto
qed

lemma analz_Un_implSecureSet_aux_2:
  "Enc_keys_clean (G  H) 
   analz (implSecureSet_aux Ag G  H)  
     implSecureSet_aux Ag G  PairSet Tags G  Tags 
     synth (analz (G  H))"
proof -
  assume H:"Enc_keys_clean (G  H)"
  from H have "analz (implSecureSet_aux Ag G  H)  
                implSecureSet_aux Ag G  PairSet Tags G  Tags  analz (G  H)"
    by (rule analz_Un_implSecureSet_aux_1)
  also have "...  implSecureSet_aux Ag G  PairSet Tags G  Tags  synth (analz (G  H))"
     by auto
  finally show ?thesis by auto
qed

lemma analz_Un_implSecureSet_aux_3:
  "Enc_keys_clean (G  H) 
  analz (implSecureSet_aux Ag G  H)  synth (analz (G  H))  -payload"
by (rule subset_trans [OF analz_Un_implSecureSet_aux_2], auto)

lemma analz_Un_implSecureSet:
  "Enc_keys_clean (G  H) 
   analz (sym.implSecureSet Ag G  H)  synth (analz (G  H))  -payload"
apply (rule subset_trans [of _ "analz (implSecureSet_aux Ag G  H)" _])
apply (rule analz_mono, rule Un_mono, blast intro!: implSet_implSet_aux, simp)
using analz_Un_implSecureSet_aux_3 apply blast
done

text ‹
Pull @{term implSecureSet} out of @{term analz}, 2nd case, where the agents are honest. 
›
lemma analz_Un_implSecureSet_2_aux_1:
  "Enc_keys_clean H 
   Ag  broken (parts H  range LtK) = {} 
   analz (implSecureSet_aux Ag G  H)  implSecureSet_aux Ag G  synth (analz H)"
apply (rule subset_trans [OF analz_Un_EncSet2], simp)
apply (auto dest:analz_into_parts)
done

lemma analz_Un_implSecureSet_2_aux_3:
  "Enc_keys_clean H 
   Ag  broken (parts H  range LtK) = {} 
   analz (implSecureSet_aux Ag G  H)  synth (analz H)  -payload"
by (rule subset_trans [OF analz_Un_implSecureSet_2_aux_1], auto)

lemma analz_Un_implSecureSet_2:
  "Enc_keys_clean H 
   Ag  broken (parts H  range LtK) = {} 
   analz (sym.implSecureSet Ag G  H)  synth (analz H)  -payload"
apply (rule subset_trans [of _ "analz (implSecureSet_aux Ag G  H)" _])
apply (rule analz_mono, rule Un_mono, blast intro!: implSet_implSet_aux, simp)
using analz_Un_implSecureSet_2_aux_3 apply auto
done


subsection ‹Pull @{term implAuthSet} out of @{term analz}
(**************************************************************************************************)

lemma analz_Un_implAuthSet_aux_1:
  "Enc_keys_clean (G  H) 
   analz (implAuthSet_aux G  H)  
     implAuthSet_aux G  HashSet (PairSet (PairSet Tags G) (range (case_prod shrK))) 
     analz (G  H)"
proof -
  assume H:"Enc_keys_clean (G  H)"
  have "analz (implAuthSet_aux G  H)  implAuthSet_aux G 
          analz (G  HashSet (PairSet (PairSet Tags G) (range (case_prod shrK)))  H)"
    by (rule analz_Un_PairSet)
  also have "... = implAuthSet_aux G 
          analz (HashSet (PairSet (PairSet Tags G) (range (case_prod shrK)))  G  H)"
    by (simp only: Un_assoc Un_commute)
  also have "... = implAuthSet_aux G 
          analz (HashSet (PairSet (PairSet Tags G) (range (case_prod shrK)))  (G  H))"
    by (simp only: Un_assoc)
  also have 
    "...  implAuthSet_aux G  
            (HashSet (PairSet (PairSet Tags G) (range (case_prod shrK))) 
             analz (G  H))"
    by (rule Un_mono, blast, rule analz_Un_HashSet, blast intro: H, auto)
  also have "... = implAuthSet_aux G  
                   HashSet (PairSet (PairSet Tags G) (range (case_prod shrK))) 
                   analz (G  H)"
    by auto
   finally show ?thesis by auto
qed

lemma analz_Un_implAuthSet_aux_2:
  "Enc_keys_clean (G  H) 
   analz (implAuthSet_aux G  H) 
     implAuthSet_aux G  HashSet (PairSet (PairSet Tags G) (range (case_prod shrK))) 
     synth (analz (G  H))"
proof -
  assume H:"Enc_keys_clean (G  H)"
  from H have 
    "analz (implAuthSet_aux G  H)  
       implAuthSet_aux G  
       HashSet (PairSet (PairSet Tags G) (range (case_prod shrK))) 
       analz (G  H)"
    by (rule analz_Un_implAuthSet_aux_1)
  also have 
    "...  implAuthSet_aux G  
            HashSet (PairSet (PairSet Tags G) (range (case_prod shrK))) 
            synth (analz (G  H))"
     by auto
  finally show ?thesis by auto
qed

lemma analz_Un_implAuthSet_aux_3:
  "Enc_keys_clean (G  H) 
  analz (implAuthSet_aux G  H)  synth (analz (G  H))  -payload"
by (rule subset_trans [OF analz_Un_implAuthSet_aux_2], auto)

lemma analz_Un_implAuthSet:
  "Enc_keys_clean (G  H) 
   analz (sym.implAuthSet G  H)  synth (analz (G  H))  -payload"
apply (rule subset_trans [of _ "analz (implAuthSet_aux G  H)" _])
apply (rule analz_mono, rule Un_mono, blast intro!: implSet_implSet_aux, simp)
using analz_Un_implAuthSet_aux_3 apply blast
done

declare Enc_keys_clean_msgSet_Un [rule del]


subsection ‹Locale interpretations›
(**************************************************************************************************)

interpretation sym: semivalid_implem implem_sym
proof (unfold_locales)
  fix x A B M x' A' B' M'
  show "implem_sym (Chan x A B M) = implem_sym (Chan x' A' B' M') 
        x = x'  A = A'  B = B'  M = M'"
    by (cases x, (cases x', auto)+)
next
  fix M' M x x' A A' B B'
  assume H: "M'  payload"
  then have A1: "y. y  parts {M'}  y  payload" 
        and A2: "y. M' = y  y  payload" by auto
  assume "implem_sym (Chan x A B M)  parts {implem_sym (Chan x' A' B' M')}"
  then show "x = x'  A = A'  B = B'  M = M'"
    by (cases "x", (cases x', auto dest!: A1 A2)+)
next
  fix I
  assume "I  sym.valid"
  then show "Enc_keys_clean I"
    proof (simp add: Enc_keys_clean_def, intro allI impI)
      fix X Y
      assume "Enc X Y  parts I"
      obtain x A B M where "M  payload" and "Enc X Y  parts {implem_sym (Chan x A B M)}"
      using parts_singleton [OF Enc X Y  parts I] I  sym.valid
        by (auto elim!: sym.validE)
      then show "Y  range LtK  Y  payload" by (cases x, auto)
    qed
next
  fix Z
  show "composed (implem_sym Z)"
    proof (cases Z, simp)
      fix x A B M
      show "composed (implem_sym (Chan x A B M))" by (cases x, auto)
    qed
next
  fix x A B M
  show "implem_sym (Chan x A B M)  payload"
    by (cases x, auto)
next
  fix X K
  assume "X  sym.valid"
  then obtain x A B M where "M  payload" "X = implem_sym (Chan x A B M)" 
    by (auto elim: sym.validE)
  then show "LtK K  parts {X}"
  by (cases x, auto)

next
  fix G H
  assume "G  payload" "Enc_keys_clean H"
  hence "Enc_keys_clean (G  H)" by (auto intro: Enc_keys_clean_Un)
  then show "analz ({implem_sym (Insec A B M) |A B M. M  G}  H)  
               synth (analz (G  H))  - payload"
    by (rule analz_Un_implInsecSet)
next
  fix G H
  assume "G  payload" "Enc_keys_clean H"
  hence "Enc_keys_clean (G  H)" by (auto intro: Enc_keys_clean_Un)
  then show "analz ({implem_sym (Auth A B M) |A B M. M  G}  H)  
               synth (analz (G  H))  - payload"
    by (rule analz_Un_implAuthSet)
next
  fix G H Ag
  assume "G  payload" "Enc_keys_clean H"
  hence "Enc_keys_clean (G  H)" by (auto intro: Enc_keys_clean_Un)
  then show "analz ({implem_sym (Confid A B M) |A B M. (A, B)  Ag  M  G}  H)  
               synth (analz (G  H))  - payload"
    by (rule analz_Un_implConfidSet)
next
  fix G H Ag
  assume "G  payload" "Enc_keys_clean H"
  hence "Enc_keys_clean (G  H)" by (auto intro: Enc_keys_clean_Un)
  then show "analz ({implem_sym (Secure A B M) |A B M. (A, B)  Ag  M  G}  H)  
               synth (analz (G  H))  - payload"
    by (rule analz_Un_implSecureSet)
next
  fix G H Ag
  assume "Enc_keys_clean H"
  hence "Enc_keys_clean H" by auto
  moreover assume "Ag  broken (parts H  range LtK) = {}"
  ultimately show "analz ({implem_sym (Confid A B M) |A B M. (A, B)  Ag  M  G}  H)  
               synth (analz H)  - payload"
    by (rule analz_Un_implConfidSet_2)
next
  fix G H Ag
  assume "Enc_keys_clean H"
  moreover assume "Ag  broken (parts H  range LtK) = {}"
  ultimately show "analz ({implem_sym (Secure A B M) |A B M. (A, B)  Ag  M  G}  H)  
               synth (analz H)  - payload"
    by (rule analz_Un_implSecureSet_2)
qed

text ‹
Third step: @{locale "valid_implem"}.
The lemmas giving conditions on $M$, $A$ and $B$ for 
@{prop "implXXX A B M  synth (analz Z)"}.
›

lemma implInsec_synth_analz:
  "H  payload  sym.valid  range LtK  Tags 
   sym.implInsec A B M  synth (analz H) 
   sym.implInsec A B M  H  M  synth (analz H)"
apply (erule synth.cases, auto)
done

lemma implConfid_synth_analz:
  "H  payload  sym.valid  range LtK  Tags 
   sym.implConfid A B M  synth (analz H) 
   sym.implConfid A B M  H  M  synth (analz H)"
apply (erule synth.cases, auto)
― ‹1 subgoal›
apply (frule sym.analz_valid [where x=confid], auto)
done

lemma implAuth_synth_analz:
  "H  payload  sym.valid  range LtK  Tags 
   sym.implAuth A B M  synth (analz H) 
   sym.implAuth A B M  H  (M  synth (analz H)  (A, B)  broken H)"
using [[simproc del: defined_all]] proof (erule synth.cases, simp_all)
  fix X
  assume H:  "H  payload  sym.valid  range LtK  Tags"
  assume H':"M, hmac AuthTag, M (shrK A B) = X" " X  analz H"
  hence "sym.implAuth A B M  analz H" by auto
  with H have "sym.implAuth A B M  H" by (rule sym.analz_valid)
  with H' show "X  H  M  synth (analz H)  (A, B)  broken H"
    by auto
next
  fix X Y
  assume H:"H  payload  sym.valid  range LtK  Tags"
  assume H':"M = X  hmac AuthTag, M (shrK A B) = Y" "Y  synth (analz H)"
  hence "hmac AuthTag, M (shrK A B)  synth (analz H)" by auto
  then have "hmac AuthTag, M (shrK A B)  analz H  
             shrK A B  synth (analz H)"
    by (rule synth.cases, auto)
  then show "X, hmac AuthTag, X (shrK A B)  H  (A, B)  broken H"
    proof
      assume "shrK A B  synth (analz H)"
      with H have "(A, B)  broken H" by (auto dest:sym.analz_LtKeys)
      then show ?thesis by auto
    next
      assume "hmac AuthTag, M (shrK A B)  analz H"
      hence "hmac AuthTag, M (shrK A B)  parts H" by (rule analz_into_parts)
      with H have "hmac AuthTag, M (shrK A B)  parts H" 
        by (auto dest!:payload_parts elim!:payload_Hash)
      from H obtain Z where "Z  H" and H'':"hmac AuthTag, M (shrK A B)  parts {Z}"
        using parts_singleton [OF hmac AuthTag, M (shrK A B)  parts H] by blast
      moreover with H have "Z  sym.valid" by (auto dest!: subsetD)
      moreover with H'' have "Z = sym.implAuth A B M"
        by (auto) (erule sym.valid_cases, auto)
      ultimately have "sym.implAuth A B M  H" by auto
      with H' show ?thesis by auto
    qed
qed

lemma implSecure_synth_analz:
  "H  payload  sym.valid  range LtK  Tags 
   sym.implSecure A B M  synth (analz H) 
   sym.implSecure A B M  H  (M  synth (analz H)  (A, B)  broken H)"
apply (erule synth.cases, auto)
(* 1 subgoal*)
apply (frule sym.analz_valid [where x=secure], auto)
apply (frule sym.analz_valid [where x=secure], auto)
apply (auto dest:sym.analz_LtKeys)
done


interpretation sym: valid_implem implem_sym
proof (unfold_locales)
  fix H A B M
  assume "H  payload  sym.valid  range LtK  Tags"
         "implem_sym (Insec A B M)  synth (analz H)"
  then show "implem_sym (Insec A B M)  H  M  synth (analz H)"
    by (rule implInsec_synth_analz)
next
  fix H A B M
  assume "H  payload  sym.valid  range LtK  Tags"
         "implem_sym (Confid A B M)  synth (analz H)"
  then show "implem_sym (Confid A B M)  H  M  synth (analz H)"
    by (rule implConfid_synth_analz)
next
  fix H A B M
  assume "H  payload  sym.valid  range LtK  Tags"
         "implem_sym (Auth A B M)  synth (analz H)"
  then show "implem_sym (Auth A B M)  H  
             M  synth (analz H)  (A, B)  broken H"
    by (rule implAuth_synth_analz)
next
  fix H A B M
  assume "H  payload  sym.valid  range LtK  Tags"
         "implem_sym (Secure A B M)  synth (analz H)"
  then show "implem_sym (Secure A B M)  H  
             M  synth (analz H)  (A, B)  broken H"
    by (rule implSecure_synth_analz)
qed

end