Library Apps.PwMgrNet

Require Import FunctionApp List Program StorageClient String System.
Import ListNotations.
Open Scope string_scope.

Section net.

  Context {world0 : Type}.

  Inductive netInput :=
  | netStarted (abort : action world0)
  | netGetUpdate
  | netCAS (old new : string)
  | netSendGotUpdate (new : string)
  | netHttpError (r : httpResponse).

  Context (world : Type).

  Inductive netOutput :=
  | netLift (a : action world0)
  | netGotUpdate (new : string)
  | netHttpPOST (uri : string) (data : list (string × string)) (cb : abortable world0 httpResponsenetInput).

  Context (send : netOutputaction world).
  Context (storageId : string).

  Definition sendHttpPOST uri data cb := send (netHttpPOST uri data cb).

  Definition netGetUpdateCallback ret :=
    match ret with
      | started abortnetStarted abort
      | done (inl new) ⇒ netSendGotUpdate new
      | done (inr r) ⇒ netHttpError r
    end.

  Definition netCASCallback new ret :=
    match ret with
      | started abortnetStarted abort
      | done (inl None) ⇒ netSendGotUpdate new
      | done (inl (Some other)) ⇒ netSendGotUpdate other
      | done (inr r) ⇒ netHttpError r
    end.

  CoFixpoint netLoop (abort : action world0) :=
    Step (fun i
            match i with
              | netStarted abort'(id, netLoop abort')
              | netGetUpdate
                (send (netLift abort) storageGet sendHttpPOST storageId netGetUpdateCallback,
                netLoop id)
              | netCAS old new
                (send (netLift abort) storageSet sendHttpPOST storageId old new (netCASCallback new),
                 netLoop id)
              | netSendGotUpdate new
                (send (netGotUpdate new) storagePoll sendHttpPOST storageId new netGetUpdateCallback,
                 netLoop id)
              | netHttpError _(id, netLoop id)
            end).

  Definition net := netLoop id.

End net.

Arguments netInput : clear implicits.
Arguments netOutput : clear implicits.
Arguments net : clear implicits.