Ramon meffert/issue8

snowpack.config.js

@@ -5,13 +5,13 @@ module.exports = {
     "src": "/_dist_"
   },
   plugins: [
+    "@snowpack/plugin-sass",
     ["snowpack-plugin-elm", {
       "verbose": false,
       "debugger": "dev",
       "optimize": "build"
     }],
-    "@snowpack/plugin-sass",
-    "@snowpack/plugin-optimize"
+    // "@snowpack/plugin-optimize"
   ],
   install: [
     /* ... */

src/elm/CallSequence/CallSequence.elm

@@ -3,7 +3,11 @@ module CallSequence.CallSequence exposing (..)
 import List exposing (head)
 import GossipGraph.Agent exposing (AgentId)
 import GossipGraph.Call exposing (Call, includes)
-import GossipGraph.Relation exposing (Kind(..))
+import GossipGraph.Relation as Relation exposing (Kind(..))
+import Graph
+import IntDict
+import List.Extra exposing (mapAccumr)
+import GossipGraph.Call as Call
 
 
 {-| A list of consecutive calls. Ordered latest to first call to improve lookup speed.
@@ -21,10 +25,8 @@ containing sequence agent =
             []
 
         call :: calls ->
-            -- this would've read so nicely if Elm supported infix notation. Alas.
-            -- (if call `includes` agent then) (calls `containing` agent)
             if includes call agent then
                 call :: containing calls agent
 
             else
-                containing calls agent
+                containing calls agent

src/elm/CallSequence/Renderer.elm

@@ -7,7 +7,7 @@ import GossipGraph.Agent as Agent exposing (Agent)
 import GossipGraph.Call as Call exposing (Call)
 import Html exposing (Html, div, text)
 import Html.Attributes exposing (class, id)
-import Task exposing (sequence)
+import Utils.Alert as Alert
 
 
 render : Result String CallSequence -> Result String (List Agent) -> List (Html msg)
@@ -22,22 +22,16 @@ render sequenceResult agentsResult =
                 |> List.map (Call.render agents)
 
         (Err error, Ok _) ->
-            [ div [ class "error" ]
-                [ Icon.viewIcon Icon.exclamationTriangle
-                , text (" " ++ error)
-                ]
+            -- Error in parsing sequence
+            [ Alert.render Alert.Error error
             ]
 
         (Ok _, Err _) ->
-            [ div [ class "error" ]
-                [ Icon.viewIcon Icon.exclamationTriangle
-                , text " There was an error parsing the initial gossip graph."
-                ]
+            -- Error in parsing gossip graph
+            [ Alert.render Alert.Warning " There was a problem parsing the initial gossip graph."
             ]
 
-        _ ->
-            [ div [ class "error" ]
-                [ Icon.viewIcon Icon.exclamationTriangle
-                , text " Something went very wrong."
-                ]
+        (Err e1, Err _) ->
+            -- Error in parsing sequence
+            [ Alert.render Alert.Error <| e1 ++ " Additionally, there was a problem parsing the initial gossip graph."
             ]

src/elm/GossipGraph/Call.elm

@@ -1,8 +1,11 @@
 module GossipGraph.Call exposing (..)
 
 import GossipGraph.Agent as Agent exposing (Agent, AgentId)
+import GossipGraph.Relation exposing (Kind(..), Relation)
+import Graph exposing (Graph, NodeContext)
 import Html exposing (Html, div, text)
 import Html.Attributes exposing (class)
+import IntDict
 import Utils.List exposing (get)
 
 
@@ -36,7 +39,7 @@ fromList agents =
             get agents 1
     in
     if List.length agents > 2 then
-        Err "No group calls allowed."
+        Err "A call must contain two agents."
 
     else
         case ( from, to ) of
@@ -48,7 +51,8 @@ fromList agents =
                     Ok { from = f.id, to = t.id }
 
             _ ->
-                Err "There is no one to call. Make sure a call looks like “xy”."
+                -- Seems like this only occurs when there's only one agent
+                Err "A call must contain two agents."
 
 
 {-| Returns whether an agent is in a call
@@ -58,6 +62,8 @@ includes call agent =
     call.from == agent || call.to == agent
 
 
+{-| Renders a single call
+-}
 render : List Agent -> Call -> Html msg
 render agents call =
     case ( Agent.fromId agents call.from, Agent.fromId agents call.to ) of
@@ -67,3 +73,70 @@ render agents call =
         _ ->
             div [ class "call" ]
                 [ text "❌" ]
+
+
+{-| Execute a call on a gossip graph
+
+Make sure the caller knows everything the receiver knows and vice versa. Since
+knowledge is represented as outgoing edges, we can simply add the outgoing edges
+of one agent to the other, making sure no duplicates are created and that
+relations are upgraded when necessary (i.e. number -> secret)
+
+Built on `Graph.update` and `IntDict.merge`.
+
+-}
+execute : Graph Agent Relation -> Call -> Graph Agent Relation
+execute graph { from, to } =
+    let
+        knowledge : AgentId -> Maybe (NodeContext Agent Relation)
+        knowledge id =
+            Graph.get id graph
+
+        -- merges the nodecontext for newId into currentContext
+        merge : AgentId -> Maybe (NodeContext Agent Relation) -> Maybe (NodeContext Agent Relation)
+        merge newId currentContext =
+            let
+                newContext : Maybe (NodeContext Agent Relation)
+                newContext =
+                    knowledge newId
+            in
+            case ( newContext, currentContext ) of
+                ( Just new, Just current ) ->
+                    -- change the current context so it includes the relations from the new context
+                    Just
+                        { current
+                          -- c (current) and n (new) are of type Relation. k is the key of the IntDict,
+                          -- indicating to which node the edge is pointing in the case of NodeContext.outgoing
+                            | outgoing =
+                                IntDict.merge
+                                    -- occurs only in current: just keep it
+                                    (\k c acc -> IntDict.insert k c acc)
+                                    -- occurs in both: check Kind, keep "most knowledge" (S > N)
+                                    (\k c n acc ->
+                                        if c.kind == Secret then
+                                            -- current relation is secret
+                                            IntDict.insert k c acc
+
+                                        else if n.kind == Secret then
+                                            -- new relation is secret
+                                            IntDict.insert k { n | from = current.node.id } acc
+
+                                        else
+                                            -- both relations are Number, so just keep the original
+                                            IntDict.insert k c acc
+                                    )
+                                    -- occurs in new: change n.from and insert
+                                    (\k n acc -> IntDict.insert k { n | from = current.node.id } acc)
+                                    current.outgoing
+                                    new.outgoing
+                                    IntDict.empty
+                        }
+
+                _ ->
+                    Nothing
+    in
+    graph
+        -- first update the caller
+        |> Graph.update from (merge to)
+        -- then update the receiver
+        |> Graph.update to (merge from)

src/elm/GossipGraph/Renderer.elm

@@ -24,7 +24,7 @@ import TypedSvg.Attributes exposing (class, cx, cy, dy, fill, id, markerEnd, mar
 import TypedSvg.Core exposing (Attribute, Svg, text)
 import TypedSvg.Types exposing (Align(..), AnchorAlignment(..), Length(..), MeetOrSlice(..), Paint(..), Scale(..), px)
 import Utils.General exposing (uncurry)
-
+import Utils.Alert as Alert
 
 
 -- MODEL
@@ -66,10 +66,7 @@ render graphResult settings =
             renderGraph graph settings
 
         Err error ->
-            div [ Html.Attributes.class "error" ]
-                [ Icon.viewIcon Icon.exclamationTriangle
-                , text (" " ++ error)
-                ]
+            Alert.render Alert.Error error
 
 
 renderGraph : Graph Agent Relation -> GraphSettings -> Html msg
@@ -99,7 +96,7 @@ renderGraph graph settings =
     svg [ viewBox 0 0 settings.canvasWidth settings.canvasHeight, preserveAspectRatio (Align ScaleMid ScaleMid) Meet ]
         [ defs []
             (arrowHeads settings)
-        , g [ class [ "links" ] ] <| List.map (renderEdge computedGraph settings) <| Graph.edges computedGraph
+        , g [ class [ "links" ] ] <| List.map (renderEdge computedGraph settings) <| List.filter (\e -> e.from /= e.to) <| Graph.edges computedGraph
         , g [ class [ "nodes" ] ] <| List.map (renderNode settings) <| Graph.nodes computedGraph
         ]
 

src/elm/GossipProtocol/GossipProtocol.elm

@@ -1,10 +1,12 @@
 module GossipProtocol.GossipProtocol exposing (..)
 
-import Graph exposing (Graph, NodeContext, fold)
-import GossipGraph.Agent exposing (Agent, AgentId)
-import GossipGraph.Call exposing (Call)
 import CallSequence.CallSequence exposing (CallSequence)
-import GossipGraph.Relation as Relation exposing (Kind(..), Relation)
+import GossipGraph.Agent exposing (Agent, AgentId)
+import GossipGraph.Call as Call exposing (Call)
+import GossipGraph.Relation as Relation exposing (Kind(..), Relation, knows)
+import Graph exposing (Graph, NodeContext)
+import IntDict
+import List.Extra exposing (mapAccumr)
 
 
 {-| Protocol conditions
@@ -18,30 +20,68 @@ type alias ProtocolCondition =
 Select x, y ∈ A, such that x ≠ y, Nxy, and π(x, y)
 
 -}
-select : Graph Agent Relation -> ProtocolCondition -> CallSequence -> List Call
-select graph condition sequence =
+selectCalls : Graph Agent Relation -> ProtocolCondition -> CallSequence -> List Call
+selectCalls graph condition sequence =
     let
         calls : NodeContext Agent Relation -> List Call -> List Call
         calls context acc =
             let
-                -- since identity relations are implied, they aren't modeled so we do not need to filter them out
-                -- that is, x /= y is inherently satisfied
-                -- also, because S ⊆ N ⊆ A², we know for sure that Nxy holds, for `fromNodeContext` returns all relations for an agent,
-                -- so any relation is definitely at least a number relation
+                -- filter out identity relations
                 localRelations =
+                    -- select x, y ∈ A, such that x /= y, Nxy
                     Relation.fromNodeContext context
+                        |> List.filter (\{ from, to } -> from /= to)
 
                 -- the protocol condition needs a pair (x,y)
                 relationPairs =
                     localRelations
                         |> List.map (\r -> ( r.from, r.to ))
             in
-            -- select x, y ∈ A, such that x /= y, Nxy, and π(x, y)
+            -- check π(x, y)
             -- the resulting list of calls is the list of calls that can be executed on G given the call history
             List.filter (\x -> condition x localRelations sequence) relationPairs
-                |> List.map GossipGraph.Call.fromTuple
+                |> List.map Call.fromTuple
                 |> (++) acc
     in
     Graph.fold calls [] graph
 
 
+{-| Given a call sequence, a graph and a protocol condition, figure out whether
+the call sequence is permitted.
+
+Call sequence σ;xy is P-permitted on G iff σ is P-permitted on G and xy is P-permitted on Gσ
+
+-}
+sequencePermittedOn : ProtocolCondition -> Graph Agent Relation -> CallSequence -> Bool
+sequencePermittedOn condition graph sequence =
+    let
+        relations : Graph Agent Relation -> List Relation
+        relations g =
+            Graph.edges g
+                |> List.map .label
+
+        isCallPermitted : Call -> Graph Agent Relation -> CallSequence -> Bool
+        isCallPermitted { from, to } currentGraph callHistory =
+            let
+                rels =
+                    relations currentGraph
+            in
+                (from /= to |> Debug.log "--\nx /= y")
+                -- N^σ xy
+                && (List.any (\r -> knows from to Number r) rels |> Debug.log "Nxy")
+                -- π(x, y)
+                && condition ( from, to ) rels callHistory |> Debug.log "pi(x, y)"
+    in
+    -- results in a tuple of the form ((Bool, (CallSequence, Graph Agent Relation)), List Graph Agent Relation)
+    -- Since the empty call sequence is allowed, start with true
+    -- while traversing the call sequence, we need to keep track of
+    -- - the calls that have occured so far
+    -- - the current state of the graph
+    -- - whether the current call was permitted
+    List.foldr (\call (history, state, permitted) ->
+        (call :: history
+        , Call.execute state call
+        , permitted && isCallPermitted call state history
+        )
+    ) ([], graph, True) sequence
+        |> \(_, _, isPermitted) -> isPermitted