diff --git a/src/Demos/Cookie.elm b/src/Demos/Cookie.elm new file mode 100644 index 0000000..f679c45 --- /dev/null +++ b/src/Demos/Cookie.elm @@ -0,0 +1,288 @@ +module Demos.Cookie exposing (main) + +import Browser +import Dict exposing (Dict) +import Html exposing (Html) +import Html.Attributes +import Html.Events +import Internal.Tools.Exceptions as X +import Json.Decode as D +import Json.Encode as E +import Matrix exposing (VaultUpdate) +import Matrix.Event +import Matrix.Room +import Task +import Time +import Url + + +main = + Browser.element { init = init, update = update, subscriptions = subscriptions, view = view } + + + +-- MODEL + + +type Msg + = Login { accessToken : String, baseUrl : String } + | SendEventToRoom String + | SyncVault + | VaultUpdate (Result X.Error Matrix.VaultUpdate) + | WriteAccessToken String + | WriteBaseUrl String + + +type Model + = LoginMenu { accessToken : String, baseUrl : String } + | CookieView Matrix.Vault + + +init : () -> ( Model, Cmd Msg ) +init _ = + ( LoginMenu { accessToken = "", baseUrl = "" } + , Cmd.none + ) + + + +-- UPDATE + + +update : Msg -> Model -> ( Model, Cmd Msg ) +update msg model = + case ( msg, model ) of + ( Login data, _ ) -> + let + vault : Matrix.Vault + vault = + Matrix.fromAccessToken data + in + ( CookieView vault, Matrix.sync vault |> Task.attempt VaultUpdate ) + + ( VaultUpdate _, LoginMenu _ ) -> + ( model, Cmd.none ) + + ( VaultUpdate u, CookieView vault ) -> + case u of + Ok vu -> + ( vault + |> Matrix.updateWith vu + |> CookieView + , Cmd.none + ) + + Err _ -> + ( model, Cmd.none ) + + ( SendEventToRoom _, LoginMenu _ ) -> + ( model, Cmd.none ) + + ( SendEventToRoom roomId, CookieView vault ) -> + ( model + , vault + |> Matrix.getRoomById roomId + |> Maybe.map + (Matrix.Room.sendOneEvent + { content = E.object [ ( "body", E.string "I sent you a cookie! :)" ) ] + , eventType = "me.noordstar.demo_cookie" + , stateKey = Nothing + } + >> Task.attempt VaultUpdate + ) + |> Maybe.withDefault Cmd.none + ) + + ( SyncVault, LoginMenu _ ) -> + ( model, Cmd.none ) + + ( SyncVault, CookieView vault ) -> + ( model, Matrix.sync vault |> Task.attempt VaultUpdate ) + + ( WriteAccessToken s, LoginMenu data ) -> + ( LoginMenu { data | accessToken = s }, Cmd.none ) + + ( WriteAccessToken _, _ ) -> + ( model, Cmd.none ) + + ( WriteBaseUrl s, LoginMenu data ) -> + ( LoginMenu { data | baseUrl = s }, Cmd.none ) + + ( WriteBaseUrl _, _ ) -> + ( model, Cmd.none ) + + + +-- SUBSCRIPTIONS + + +subscriptions : Model -> Sub Msg +subscriptions model = + case model of + CookieView _ -> + Time.every 5000 (always SyncVault) + + _ -> + Sub.none + + + +-- VIEW + + +cookies : List Matrix.Room.Room -> Dict String Int +cookies = + let + merge : Matrix.Room.Room -> Dict String Int -> Dict String Int + merge room d = + room + |> Matrix.Room.mostRecentEvents + |> List.filterMap + (\event -> + case Matrix.Event.contentType event of + "me.noordstar.demo_cookie" -> + Just (Matrix.Event.sender event) + + _ -> + Nothing + ) + |> List.foldl + (\user users -> + case Dict.get user users of + Just i -> + Dict.insert user (i + 1) users + + Nothing -> + Dict.insert user 1 users + ) + d + in + List.foldl merge Dict.empty + + +view : Model -> Html Msg +view model = + case model of + LoginMenu ({ accessToken, baseUrl } as data) -> + [ Html.span [] [ Html.text "Homeserver URL:" ] + , Html.input + [ Html.Events.onInput WriteBaseUrl + , Html.Attributes.style "font-size" "20px" + , Html.Attributes.style "width" "80%" + ] + [ Html.text baseUrl ] + , Html.span [] [ Html.text "Access token:" ] + , Html.input + [ Html.Events.onInput WriteAccessToken + , Html.Attributes.style "font-size" "20px" + , Html.Attributes.style "width" "80%" + ] + [ Html.text accessToken ] + , case ( Url.fromString baseUrl, accessToken ) of + ( _, "" ) -> + Html.div [ Html.Attributes.style "height" "30px" ] [] + + ( Nothing, _ ) -> + Html.div [ Html.Attributes.style "height" "30px" ] [] + + ( Just _, _ ) -> + Html.button + [ Html.Attributes.style "font-size" "20px" + , Html.Attributes.style "height" "30px" + , Html.Events.onClick (Login data) + ] + [ Html.text "Access" ] + ] + |> Html.div + [ Html.Attributes.style "display" "flex" + , Html.Attributes.style "flex-flow" "column nowrap" + , Html.Attributes.style "justify-content" "space-evenly" + , Html.Attributes.style "align-items" "center" + , Html.Attributes.style "font-size" "20px" + , Html.Attributes.style "height" "250px" + , Html.Attributes.style "background-color" "antiquewhite" + ] + + CookieView vault -> + case Matrix.getRooms vault of + [] -> + Html.text "Loading rooms..." + |> List.singleton + |> Html.div + [ Html.Attributes.style "display" "flex" + , Html.Attributes.style "flex-flow" "column nowrap" + , Html.Attributes.style "justify-content" "space-evenly" + , Html.Attributes.style "align-items" "center" + , Html.Attributes.style "font-size" "20px" + , Html.Attributes.style "background-color" "antiquewhite" + ] + + _ :: _ -> + [ vault + |> Matrix.getRooms + |> cookies + |> Debug.log "Cookies: " + |> Dict.toList + |> List.map + (\( user, amount ) -> + case amount of + 0 -> + user ++ " didn't send you any cookies." + + 1 -> + user ++ " sent you a cookie! 🍪" + + 2 -> + user ++ " sent you 2 cookies! 🍪🍪" + + _ -> + user ++ " sent you " ++ String.fromInt amount ++ " cookies! 🍪🍪🍪" + ) + |> List.map Html.text + |> List.map List.singleton + |> List.map (Html.p []) + |> Html.div [] + , vault + |> Matrix.getRooms + |> List.map + (\room -> + let + roomName : String + roomName = + room + |> Matrix.Room.stateEvent { eventType = "m.room.name", stateKey = "" } + |> Maybe.andThen + (\event -> + case D.decodeValue (D.field "name" D.string) (Matrix.Event.content event) of + Ok title -> + Just title + + Err _ -> + Nothing + ) + |> Maybe.withDefault (Matrix.Room.roomId room) + in + [ Html.text roomName + , Html.text "Click here to send a cookie to everyone in this room!" + ] + |> List.map List.singleton + |> List.map (Html.span []) + |> Html.span + [ Html.Events.onClick <| SendEventToRoom <| Matrix.Room.roomId room + , Html.Attributes.style "display" "flex" + , Html.Attributes.style "flex-flow" "column nowrap" + , Html.Attributes.style "justify-content" "space-evenly" + , Html.Attributes.style "margin" "20px" + , Html.Attributes.style "background-color" "beige" + ] + ) + |> Html.div [] + ] + |> Html.div + [ Html.Attributes.style "display" "flex" + , Html.Attributes.style "flex-flow" "column nowrap" + , Html.Attributes.style "justify-content" "space-evenly" + , Html.Attributes.style "align-items" "center" + , Html.Attributes.style "font-size" "20px" + , Html.Attributes.style "background-color" "antiquewhite" + ] diff --git a/src/Demos/Cookies.html b/src/Demos/Cookies.html new file mode 100644 index 0000000..5b63e71 --- /dev/null +++ b/src/Demos/Cookies.html @@ -0,0 +1,16625 @@ + + + + + Demos.Cookie + + + + + +

+
+
+
+
+
\ No newline at end of file
diff --git a/src/Internal/Room.elm b/src/Internal/Room.elm
index 58694a0..fa26114 100644
--- a/src/Internal/Room.elm
+++ b/src/Internal/Room.elm
@@ -119,6 +119,14 @@ withoutCredentials (Room { room }) =
     room
 
 
+{-| Get a given state event.
+-}
+getStateEvent : { eventType : String, stateKey : String } -> Room -> Maybe Event
+getStateEvent data (Room { room, context }) =
+    Internal.getStateEvent data room
+        |> Maybe.map (Event.withCredentials context)
+
+
 {-| Get older events from the Matrix API.
 -}
 getOlderEvents : { limit : Maybe Int } -> Room -> Task X.Error VaultUpdate
diff --git a/src/Matrix/Room.elm b/src/Matrix/Room.elm
index fa1287f..03f1179 100644
--- a/src/Matrix/Room.elm
+++ b/src/Matrix/Room.elm
@@ -1,5 +1,6 @@
 module Matrix.Room exposing
     ( Room, roomId, mostRecentEvents, findOlderEvents
+    , stateEvent
     , sendMessage, sendMessages, sendOneEvent, sendMultipleEvents
     )
 
@@ -13,6 +14,11 @@ A room represents a channel of communication within a Matrix home server.
 @docs Room, roomId, mostRecentEvents, findOlderEvents
 
 
+# Exploring a room
+
+@docs stateEvent
+
+
 # Sending events
 
 @docs sendMessage, sendMessages, sendOneEvent, sendMultipleEvents
@@ -49,6 +55,13 @@ mostRecentEvents =
     Internal.mostRecentEvents
 
 
+{-| Get a state event in the room.
+-}
+stateEvent : { eventType : String, stateKey : String } -> Room -> Maybe Event.Event
+stateEvent =
+    Internal.getStateEvent
+
+
 {-| Get the Matrix room id of a room.
 -}
 roomId : Room -> String