(*<*)
theory Swap
  imports Core.Semantics Core.TransactionBound Core.Timeout
begin
(*>*)

section \<open>Simple Swap\<close>

text \<open>
A simple swap contract consists on two parties exchanging some \<^term>\<open>amount\<close> of \<^term>\<open>Token\<close>s
atomically. Each participant needs to deposit their tokens into the contract by a certain
\<^term>\<open>depositDeadline\<close>. If they do, the contract makes the swap and pays the participants, if
one of the participant fails to make the deposit, the funds held by the contract can be redeemed
by the owner.
\<close>

subsection \<open>Contract definition\<close>

text \<open>
To reduce the number of parameters we bundle the information required by each participant into a record.
\<close>

record SwapParty =
  \<comment> \<open>A participant of the contract,\<close>
  party           :: Party
  \<comment> \<open>wants to swap an \<^term>\<open>amount\<close> of \<^term>\<open>Token\<close>\<close>
  amount          :: Value
  currency        :: Token
  \<comment> \<open>before a deadline\<close>
  depositDeadline :: Timeout

text \<open>The following helper function allows participants to deposit their tokens into the contract. \<close>

fun makeDeposit :: "SwapParty \<Rightarrow> Contract \<Rightarrow> Contract" where
  "makeDeposit sp continue  =
    \<comment> \<open>The contract waits for a deposit\<close>
    When
      [
        Case
          (Deposit
            \<comment> \<open>into the internal account of the party\<close>
            (party sp)
            \<comment> \<open>from the party wallet\<close>
            (party sp)
            \<comment> \<open>Amount of tokens\<close>
            (currency sp)
            (amount sp)
          )
          \<comment> \<open>Once the deposit has been made, execute the continuation\<close>
          continue
     ]
     \<comment> \<open>If the tokens haven't been deposited by the deadline, close the contract.\<close>
     \<comment> \<open>This will return all current funds to their owners.\<close>
     (depositDeadline sp) Close
   "

text \<open>The following helper function makes a \<^term>\<open>Payment\<close> from one party to the other\<close>
fun makePayment :: "SwapParty \<Rightarrow> SwapParty \<Rightarrow> Contract \<Rightarrow> Contract" where
  "makePayment src dest =
    \<comment> \<open>The contract makes a Payment\<close>
    Pay
      \<comment> \<open>from the party internal account\<close>
      (party src)
      \<comment> \<open>to the destination wallet\<close>
      (Party (party dest))
      \<comment> \<open>of the number of tokens from the source\<close>
      (currency src) (amount src)
  "

text \<open>The actual swap contract waits for both parties to make their deposits, then makes the payout
and closes.\<close>
fun swap :: "SwapParty \<Rightarrow> SwapParty \<Rightarrow> Contract" where
  "swap p1 p2 = makeDeposit p1
                ( makeDeposit p2
                ( makePayment p1 p2
                ( makePayment p2 p1 Close
                )))
  "

subsection \<open>Example execution\label{sec:swap-example-execution}\<close>

text \<open>Let's define two participants that want to trade USD and ADA in the cardano blockchain.\<close>

definition "adaProvider = Role (BS ''Ada Provider'')"
definition "dollarProvider = Role (BS ''Dollar Provider'')"

text "In cardano, the ADA symbol is represented by the empty string"

definition "adaToken = Token (BS '''') (BS '''')"
definition "dollarToken = Token (BS ''85bb65'') (BS ''dollar'')"

text \<open>The contract can be created as follow.\<close>

definition
  "swapExample =
    swap
      \<comment> \<open>Party A trades 10 lovelaces\<close>
      \<comment> \<open>deposited before Monday, October 3, 2022 4:00:00 PM GMT\<close>
      \<lparr> party = adaProvider
      , amount = Constant 10
      , currency = adaToken
      , depositDeadline = 1664812800000
      \<rparr>
      \<comment> \<open>Party B trades 20 cents\<close>
      \<comment> \<open>deposited before Monday, October 3, 2022 5:00:00 PM GMT\<close>
      \<lparr> party = dollarProvider
      , amount = Constant 20
      , currency = dollarToken
      , depositDeadline = 1664816400000
      \<rparr>
  "

subsubsection \<open>Happy path\<close>

text \<open>If both parties deposit before their deadline,\<close>

definition
  "happyPathTransactions =
    [
      \<comment> \<open>First party deposit\<close>
      \<lparr> interval = (1664812600000, 1664812700000)
      , inputs = [
                  IDeposit
                    adaProvider
                    adaProvider
                    adaToken
                    10
                 ]
      \<rparr>
     \<comment> \<open>Second party deposit\<close>
    , \<lparr> interval = (1664812900000, 1664813100000)
      , inputs = [
                  IDeposit
                    dollarProvider
                    dollarProvider
                    dollarToken
                    20
                 ]
      \<rparr>
    ]
  "

text  \<open>payments are made to swap the tokens\<close>
definition
  "happyPathPayments =
    [ Payment adaProvider (Party dollarProvider) adaToken 10
    , Payment dollarProvider (Party adaProvider) dollarToken 20
    ]
  "

text \<open>and the contract is closed without emitting a warning\<close>

proposition
 "playTrace 0 swapExample happyPathTransactions = TransactionOutput txOut
  \<Longrightarrow>
     txOutContract txOut = Close
     \<and> txOutPayments txOut = happyPathPayments
     \<and> txOutWarnings txOut = []"
(*<*)apply (code_simp)
     apply (auto simp add: happyPathPayments_def  adaProvider_def adaToken_def dollarProvider_def  dollarToken_def)
     done(*>*)

subsection \<open>Contract guarantees\<close>

subsubsection \<open>Number of transactions\<close>
text \<open>Counting the amount of When's, it is easy to notice that there can be at most two transactions\<close>

proposition (*<*)maxSwapTransactions:(*>*)
  "maxTransactionsInitialState (swap a b) = 2"
(*<*)by simp(*>*)

text \<open>Expressed in a different way, if we use the lemma defined in \secref{sec:transaction-bound} we can
state that, if the execution of the contract yields a succesful \<^term>\<open>TransactionOutput\<close>, then the number
of transactions must be lower or equal than @{value "maxTransactionsInitialState (swap a b)"}\<close>

lemma
  "playTrace
      initialTime
      (swap a b)
      transactions = TransactionOutput txOut
   \<Longrightarrow> length transactions \<le> 2"
(*<*)by (metis maxSwapTransactions playTrace_only_accepts_maxTransactionsInitialState)(*>*)

subsubsection \<open>Maximum time\<close>

text \<open>If the deadline of the second party is bigger than the first, then that deadline is the
maximum time of the contract.\<close>
proposition
  "sp1 =
         \<lparr> party = p1
         , amount = a1
         , currency = t1
         , depositDeadline = d1
         \<rparr>
   \<Longrightarrow> sp2 =
         \<lparr> party = p2
         , amount = a2
         , currency = t2
         , depositDeadline = d2
         \<rparr>
   \<Longrightarrow> d2 > d1
   \<Longrightarrow> d1 > 0
   \<Longrightarrow> contract = swap sp1 sp2
   \<Longrightarrow> maxTimeContract (contract) = d2
  "
  (*<*)by simp(*>*)

(*<*)
\<comment> \<open>Section ommited for the moment\<close>
text \<open>Expressed in another way, by using the lemma defined in \secref{sec:max-time-guarantee} we can
guarantee that if we apply an empty transaction after the contract deadline, the contract will close.\<close>

lemma
 "sp1 =  \<lparr> party = p1, amount = a1, currency = t1, depositDeadline = d1 \<rparr>
   \<Longrightarrow> sp2 = \<lparr> party = p2, amount = a2, currency = t2, depositDeadline = d2 \<rparr>
   \<Longrightarrow> d2 > d1
   \<Longrightarrow> d1 > 0
   \<Longrightarrow> contract = swap sp1 sp2
   \<Longrightarrow> validAndPositive_state sta
   \<Longrightarrow> iniTime \<ge> minTime sta
   \<Longrightarrow> iniTime \<ge> d2
   \<Longrightarrow> endTime \<ge> iniTime
   \<Longrightarrow> accounts sta \<noteq> [] \<or> contract \<noteq> Close
   \<Longrightarrow> isClosedAndEmpty (computeTransaction \<lparr> interval = (iniTime, endTime)
                                            , inputs = [] \<rparr> sta contract)
  "
  using  swapExample_def happyPathTransactions_def dollarProvider_def dollarToken_def adaProvider_def adaToken_def
  apply (simp_all)
  oops

\<comment> \<open>Another lemma to add would be: If d2 < d1, and the first deposit is made before d1 but after d2, then the second deposit can never be made.\<close>
\<comment> \<open>Another lemma to make would be around negative amounts, to show that they give warnings. Maybe show that if amounts are positive and d2 > d1 there can never be a warning?\<close>

(*>*)

(*<*)
end
(*>*)


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *
 * @TAG(NICTA_BSD)
 *)

theory Simple
imports
  "AutoCorres.AutoCorres"
begin

external_file "simple.c"

(* Parse the input file. *)
install_C_file "simple.c"

(* Abstract the input file. *)
autocorres [ ts_force pure = max, ts_force nondet = gcd, unsigned_word_abs = gcd ] "simple.c"

(* Generated theorems and proofs. *)
thm simple.max'_def simple.max'_ac_corres
thm simple.gcd'_def simple.gcd'_ac_corres

context simple begin

(* Show generated "max'" function matches in-built "max". *)
lemma "max' a b = max a b"
  unfolding max'_def max_def
  by (rule refl)

(* Show "gcd'" calculates the gcd. *)
lemma gcd_wp [wp]:
    "\<lbrace> P (gcd a b) \<rbrace> gcd' a b \<lbrace> P \<rbrace>!"
  (* Unfold definition of "gcd'". *)
  apply (unfold gcd'_def)

  (* Annoate the loop with an invariant and measure. *)
  apply (subst whileLoop_add_inv [where
     I="\<lambda>(a', b') s. gcd a b = gcd a' b' \<and> P (gcd a b) s"
     and M="\<lambda>((a', b'), s). a'"])

  (* Solve using weakest-precondition. *)
  apply (wp; clarsimp)
   apply (metis gcd.commute gcd_red_nat)
  using gt_or_eq_0 by fastforce

lemma monad_to_gets:
    "\<lbrakk> \<And>P. \<lbrace> P \<rbrace> f \<lbrace> \<lambda>r s. P s \<and> r = v s \<rbrace>!; empty_fail f \<rbrakk> \<Longrightarrow> f = gets v"
  apply atomize
  apply (monad_eq simp: validNF_def valid_def no_fail_def empty_fail_def)
  apply (rule conjI)
   apply clarsimp
   apply (drule_tac x="\<lambda>s'. s = s'" in spec)
   apply clarsimp
   apply force
  apply clarsimp
  apply (drule_tac x="\<lambda>s'. s' = t" in spec)
  apply clarsimp
  apply force
  done

lemma gcd_to_return [simp]:
    "gcd' a b = return (gcd a b)"
  apply (subst monad_to_gets [where v="\<lambda>_. gcd a b"])
    apply (wp gcd_wp)
    apply simp
   apply (clarsimp simp: gcd'_def)
   apply (rule empty_fail_bind)
    apply (rule empty_fail_whileLoop)
    apply (clarsimp simp: split_def)
   apply (clarsimp simp: split_def)
  apply (clarsimp simp: split_def)
  done

end

end


(*  Title:      HOL/Auth/n_germanSimp_lemma_inv__9_on_rules.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_germanSimp Protocol Case Study*}

theory n_germanSimp_lemma_inv__9_on_rules imports n_germanSimp_lemma_on_inv__9
begin
section{*All lemmas on causal relation between inv__9*}
lemma lemma_inv__9_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__9  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqSVsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqE__part__0Vsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqE__part__1Vsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__0Vsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__1Vsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvAckVsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvInvAckVsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntSVsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntEVsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntSVsinv__9) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntEVsinv__9) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end