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 httpResponse → netInput).
Context (send : netOutput → action world).
Context (storageId : string).
Definition sendHttpPOST uri data cb := send (netHttpPOST uri data cb).
Definition netGetUpdateCallback ret :=
match ret with
| started abort ⇒ netStarted abort
| done (inl new) ⇒ netSendGotUpdate new
| done (inr r) ⇒ netHttpError r
end.
Definition netCASCallback new ret :=
match ret with
| started abort ⇒ netStarted 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.
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 httpResponse → netInput).
Context (send : netOutput → action world).
Context (storageId : string).
Definition sendHttpPOST uri data cb := send (netHttpPOST uri data cb).
Definition netGetUpdateCallback ret :=
match ret with
| started abort ⇒ netStarted abort
| done (inl new) ⇒ netSendGotUpdate new
| done (inr r) ⇒ netHttpError r
end.
Definition netCASCallback new ret :=
match ret with
| started abort ⇒ netStarted 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.