Library Apps.PwMgrWarningBox

A Box to emit warnings for the PWMgr

Require Import Coq.NArith.BinNat Coq.Program.Program Coq.Strings.String.
Require Import FunctionApp TrustedServerSyncBox EncryptionInterface TrustedTickBox PrefixSerializable.
Require Import TickGenerator.
Require Import TrustedTickBoxPrefixSerializable TickGeneratorPrefixSerializable.

Local Open Scope string_scope.

Module PwMgrWarningBox (Algorithm : EncryptionAlgorithm EncryptionStringDataTypes).
  Module SSB := TrustedServerSyncBox EncryptionStringDataTypes Algorithm.

  Definition wInput : Type := (SSB.ssbWarningOutput + TickGenerator.tickGWarningOutput)%type.
  Module Export Coercions.
    Global Coercion wInput_of_ssb (x : SSB.ssbWarningOutput) : wInput := inl x.
    Global Coercion wInput_of_tg (x : TickGenerator.tickGWarningOutput) : wInput := inr x.
  End Coercions.

  Section warnings.
wConsoleErr is a valid warning message outside of our control, like that the server got corrupted or the user typed garbage.
wBad is an event that should never be fired. It should probably be hooked into a loop, and shown not to exist via the termination proof.
wFatalError is a state that's possible, but should kill the program.
    Inductive wOutput :=
    | wConsoleErr (lines : string)
    | wFatalError (lines : string)
    | wBad (msg : string).

    Context (world : Type)
            (handle : wOutputaction world).

    Definition newline := "010"%char.
    Definition newlineS := String newline "".

    Definition emit (body : string) : action world
      := handle (wConsoleErr ("WARNING: " ++ body)).

    Definition debugMsg (debug : N) (component body : string) (level : N) : action world
      := if (level <=? debug)%N
         then handle (wConsoleErr ("DEBUG (" ++ component ++ "): " ++ body))
         else id.

    Definition labelTBStateTransition {T} `{Serializable T} (old new : TrustedTickBox.TickBoxPreState T) (ev : TrustedTickBox.tbInput T)
    : string
      := "from" ++ newlineS ++ " " ++ to_string old ++ newlineS ++ "to (" ++ to_string ev ++ ")" ++ newlineS ++ " " ++ to_string new.

    Definition labelTGBStateTransition (old new : TickGenerator.GatewayState) (ev : TickGenerator.tickGInput)
    : string
      := "from" ++ newlineS ++ " " ++ to_string old ++ newlineS ++ "to (" ++ to_string ev ++ ")" ++ newlineS ++ " " ++ to_string new.

    Definition emitTB {T} `{Serializable T} (debug : N) (ev : tbWarningOutput T) (component : string) : action world
      := let pre := ("In component '" ++ component ++ "', ") in
         match ev with
           | tbWarnNoDataReadyhandle (wBad (pre ++ "data was not ready to send"))
           | tbWarnTicksTooInfrequent ticksemit (pre ++ "tick starvation is occuring: " ++ to_string ticks)
           | tbWarnInvalidWaitBeforeUpdateInterval nhandle (wBad (pre ++ "invalid wait"))
           | tbWarnInvalidEvent st ev'handle (wBad (pre ++ "invalid event"))
           | tbDebugStateTransition old new ev'debugMsg debug component (labelTBStateTransition (T := T) old new ev') 3
         end.

    Definition wLoopBody (wLoop : Nprocess wInput world) (debug : N)
    : wInputaction world × process wInput world
      := fun i
           match i with
             | inl (SSB.ssbGetUpdateWarning ev)
               ⇒ (emitTB debug ev "Get Update Box", wLoop debug)
             | inl (SSB.ssbCASWarning ev)
               ⇒ (emitTB debug ev "Compare And Set Box", wLoop debug)
             | inl (SSB.ssbWarningPushBeforePull)
               ⇒ (emit "Cannot do a server-compare-and-swap before obtaining server's current state",
                   wLoop debug)
             | inl (SSB.ssbEncryptError (SSB.TEB.ebErrorNotEnoughRandomness howMuch given))
               
               ⇒ (handle (wConsoleErr ("Not enough randomness: wanted " ++ (to_string howMuch) ++ ", but got the string: '" ++ given ++ "'")),
                   wLoop debug)
             | inl (SSB.ssbEncryptError (SSB.TEB.ebErrorInvalidMasterKey key pf))
               ⇒ (handle (wFatalError ("Invalid Master Key: " ++ key)),
                   wLoop debug)
             | inl (SSB.ssbEncryptError SSB.TEB.ebErrorNoMasterKey)
               
               ⇒ (handle (wBad "No Master Key in encryption box"),
                   wLoop debug)
             | inl (SSB.ssbDecryptError (SSB.TDB.dbErrorInvalidMasterKey key pf))
               ⇒ (handle (wFatalError ("Invalid Master Key: " ++ key)),
                   wLoop debug)
             | inl (SSB.ssbDecryptError SSB.TDB.dbErrorNoMasterKey)
               
               ⇒ (handle (wBad "No Master Key in decryption box"),
                   wLoop debug)
             | inl (SSB.ssbDecryptError (SSB.TDB.dbErrorInvalidData data tt))
               ⇒ (handle (wConsoleErr ("Server got corrupted - encrypted data recieved is: " ++ data)),
                   wLoop debug)
             | inl (SSB.ssbWarningInvalidTransition ev' st')
               ⇒ (handle (wBad "Server Sync Box invalid transition"), wLoop debug)

             | inr (TickGenerator.TGDebugStateTransition old new ev')
               ⇒ (debugMsg debug "Tick Generator" (labelTGBStateTransition old new ev') 2, wLoop debug)
           end.

    CoFixpoint warningBox (debug : N) :=
      Step (wLoopBody warningBox debug).

  End warnings.
End PwMgrWarningBox.