Merge branch '4-compiler-bug' into 4-transfer-api

pull/24/head
Bram 2024-05-27 16:44:57 +02:00
commit 567ac5596a
17 changed files with 405 additions and 355 deletions

View File

@ -1,4 +1,4 @@
module Internal.Api.BaseUrl.Api exposing (..) module Internal.Api.BaseUrl.Api exposing (baseUrl)
{-| {-|
@ -7,6 +7,8 @@ module Internal.Api.BaseUrl.Api exposing (..)
This module looks for the right homeserver address. This module looks for the right homeserver address.
@docs baseUrl
-} -}
import Internal.Api.Chain as C import Internal.Api.Chain as C
@ -19,6 +21,8 @@ import Internal.Values.Envelope as E
import Internal.Values.Vault as V import Internal.Values.Vault as V
{-| Get the homeserver base URL of a given server name.
-}
baseUrl : BaseUrlInput -> C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) ph { ph | baseUrl : () } baseUrl : BaseUrlInput -> C.TaskChain R.Error (E.EnvelopeUpdate V.VaultUpdate) ph { ph | baseUrl : () }
baseUrl data = baseUrl data =
R.toChain R.toChain

View File

@ -1,7 +1,7 @@
module Internal.Api.Chain exposing module Internal.Api.Chain exposing
( TaskChain, CompleteChain ( TaskChain, CompleteChain
, IdemChain, toTask , IdemChain, toTask
, fail, succeed, andThen, catchWith , fail, succeed, andThen, catchWith, maybe
) )
{-| {-|
@ -27,7 +27,7 @@ avoid leaking values passing through the API in unexpected ways.
## Operations ## Operations
@docs fail, succeed, andThen, catchWith @docs fail, succeed, andThen, catchWith, maybe
-} -}

View File

@ -22,6 +22,8 @@ import Internal.Values.Vault as V
import Json.Encode as E import Json.Encode as E
{-| Log in using a username and password.
-}
loginWithUsernameAndPassword : LoginWithUsernameAndPasswordInput -> A.TaskChain (Phantom a) (Phantom { a | accessToken : () }) loginWithUsernameAndPassword : LoginWithUsernameAndPasswordInput -> A.TaskChain (Phantom a) (Phantom { a | accessToken : () })
loginWithUsernameAndPassword = loginWithUsernameAndPassword =
A.startWithVersion "r0.0.0" loginWithUsernameAndPasswordV1 A.startWithVersion "r0.0.0" loginWithUsernameAndPasswordV1
@ -46,8 +48,10 @@ loginWithUsernameAndPassword =
|> A.versionChain |> A.versionChain
{-| Context needed for logging in with a username and password
-}
type alias Phantom a = type alias Phantom a =
{ a | baseUrl : (), versions : () } { a | baseUrl : (), now : (), versions : () }
type alias LoginWithUsernameAndPasswordInput = type alias LoginWithUsernameAndPasswordInput =
@ -159,7 +163,8 @@ type alias PhantomV1 a =
loginWithUsernameAndPasswordV1 : LoginWithUsernameAndPasswordInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () }) loginWithUsernameAndPasswordV1 : LoginWithUsernameAndPasswordInputV1 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV1 { username, password } context = loginWithUsernameAndPasswordV1 { username, password } =
\context ->
A.request A.request
{ attributes = { attributes =
[ R.bodyString "password" password [ R.bodyString "password" password
@ -194,7 +199,8 @@ loginWithUsernameAndPasswordV1 { username, password } context =
loginWithUsernameAndPasswordV2 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () }) loginWithUsernameAndPasswordV2 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, password } context = loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request A.request
{ attributes = { attributes =
[ R.bodyOpString "device_id" deviceId [ R.bodyOpString "device_id" deviceId
@ -235,7 +241,8 @@ loginWithUsernameAndPasswordV2 { deviceId, initialDeviceDisplayName, username, p
loginWithUsernameAndPasswordV3 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () }) loginWithUsernameAndPasswordV3 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, password } context = loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request A.request
{ attributes = { attributes =
[ R.bodyOpString "address" Nothing [ R.bodyOpString "address" Nothing
@ -283,7 +290,8 @@ loginWithUsernameAndPasswordV3 { deviceId, initialDeviceDisplayName, username, p
loginWithUsernameAndPasswordV4 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () }) loginWithUsernameAndPasswordV4 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, password } context = loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request A.request
{ attributes = { attributes =
[ R.bodyOpString "address" Nothing [ R.bodyOpString "address" Nothing
@ -335,7 +343,8 @@ loginWithUsernameAndPasswordV4 { deviceId, initialDeviceDisplayName, username, p
loginWithUsernameAndPasswordV5 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () }) loginWithUsernameAndPasswordV5 : LoginWithUsernameAndPasswordInputV2 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, password } context = loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, password } =
\context ->
A.request A.request
{ attributes = { attributes =
[ R.bodyOpString "address" Nothing [ R.bodyOpString "address" Nothing
@ -387,7 +396,8 @@ loginWithUsernameAndPasswordV5 { deviceId, initialDeviceDisplayName, username, p
loginWithUsernameAndPasswordV6 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () }) loginWithUsernameAndPasswordV6 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } context = loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } =
\context ->
A.request A.request
{ attributes = { attributes =
[ R.bodyOpString "address" Nothing [ R.bodyOpString "address" Nothing
@ -440,7 +450,8 @@ loginWithUsernameAndPasswordV6 { deviceId, enableRefreshToken, initialDeviceDisp
loginWithUsernameAndPasswordV7 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () }) loginWithUsernameAndPasswordV7 : LoginWithUsernameAndPasswordInputV3 i -> A.TaskChain (PhantomV1 a) (PhantomV1 { a | accessToken : () })
loginWithUsernameAndPasswordV7 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } context = loginWithUsernameAndPasswordV7 { deviceId, enableRefreshToken, initialDeviceDisplayName, username, password } =
\context ->
A.request A.request
{ attributes = { attributes =
[ R.bodyOpString "address" Nothing [ R.bodyOpString "address" Nothing

View File

@ -28,6 +28,8 @@ import Internal.Values.Context as Context
import Internal.Values.Envelope as E import Internal.Values.Envelope as E
{-| Update message type that is being returned.
-}
type alias Msg = type alias Msg =
Backpack Backpack

View File

@ -19,8 +19,11 @@ import Task
import Time import Time
{-| Get the current time and place it in the context.
-}
getNow : A.TaskChain a { a | now : () } getNow : A.TaskChain a { a | now : () }
getNow _ = getNow =
\_ ->
Task.map Task.map
(\now -> (\now ->
{ messages = [ E.SetNow now ] { messages = [ E.SetNow now ]

View File

@ -1,4 +1,4 @@
module Internal.Api.SendMessageEvent.Api exposing (..) module Internal.Api.SendMessageEvent.Api exposing (Phantom, sendMessageEvent)
{-| {-|
@ -7,7 +7,7 @@ module Internal.Api.SendMessageEvent.Api exposing (..)
This module helps send message events to rooms on the Matrix API. This module helps send message events to rooms on the Matrix API.
@docs Phantom @docs Phantom, sendMessageEvent
-} -}
@ -19,6 +19,8 @@ import Internal.Tools.Json as Json
import Internal.Values.Envelope as E import Internal.Values.Envelope as E
{-| Send a message event to the Matrix room.
-}
sendMessageEvent : SendMessageEventInput -> A.TaskChain (Phantom a) (Phantom a) sendMessageEvent : SendMessageEventInput -> A.TaskChain (Phantom a) (Phantom a)
sendMessageEvent = sendMessageEvent =
A.startWithVersion "r0.0.0" sendMessageEventV1 A.startWithVersion "r0.0.0" sendMessageEventV1
@ -44,8 +46,10 @@ sendMessageEvent =
|> A.versionChain |> A.versionChain
{-| Context needed for sending a message event
-}
type alias Phantom a = type alias Phantom a =
a { a | accessToken : (), baseUrl : (), versions : () }
type alias PhantomV1 a = type alias PhantomV1 a =

View File

@ -65,7 +65,7 @@ type alias UFTask a b =
{-| Get an access token to talk to the Matrix API {-| Get an access token to talk to the Matrix API
-} -}
getAccessToken : UFTask { a | now : () } { a | accessToken : (), now : () } getAccessToken : UFTask { a | baseUrl : (), now : (), versions : () } { a | accessToken : (), baseUrl : (), now : (), versions : () }
getAccessToken c = getAccessToken c =
case Context.fromApiFormat c of case Context.fromApiFormat c of
context -> context ->

View File

@ -50,8 +50,6 @@ for interacting with the Matrix API.
import Internal.Config.Text as Text import Internal.Config.Text as Text
import Internal.Grammar.UserId as U import Internal.Grammar.UserId as U
import Internal.Tools.Json as Json import Internal.Tools.Json as Json
import Json.Decode as D
import Json.Encode as E
import Set exposing (Set) import Set exposing (Set)

View File

@ -56,7 +56,7 @@ import Internal.Tools.Json as Json
import Internal.Values.Event as Event exposing (Event) import Internal.Values.Event as Event exposing (Event)
import Internal.Values.StateManager as StateManager exposing (StateManager) import Internal.Values.StateManager as StateManager exposing (StateManager)
import Internal.Values.Timeline as Timeline exposing (Timeline) import Internal.Values.Timeline as Timeline exposing (Timeline)
import Internal.Values.User as User exposing (User) import Internal.Values.User exposing (User)
import Json.Encode as E import Json.Encode as E
@ -255,7 +255,7 @@ update ru room =
AddSync batch -> AddSync batch ->
addSync batch room addSync batch room
Invite user -> Invite _ ->
-- TODO: Invite user -- TODO: Invite user
room room

View File

@ -36,7 +36,7 @@ Since the username is safely parsed, one can get these parts of the username.
-} -}
import Internal.Config.Log as Log exposing (log) import Internal.Config.Log exposing (log)
import Internal.Grammar.ServerName as ServerName import Internal.Grammar.ServerName as ServerName
import Internal.Grammar.UserId as UserId import Internal.Grammar.UserId as UserId
import Internal.Tools.Json as Json import Internal.Tools.Json as Json

View File

@ -33,8 +33,6 @@ Rooms are environments where people can have a conversation with each other.
-} -}
import FastDict as Dict exposing (Dict) import FastDict as Dict exposing (Dict)
import Internal.Api.Request as Request
import Internal.Config.Log exposing (Log)
import Internal.Config.Text as Text import Internal.Config.Text as Text
import Internal.Tools.Hashdict as Hashdict exposing (Hashdict) import Internal.Tools.Hashdict as Hashdict exposing (Hashdict)
import Internal.Tools.Json as Json import Internal.Tools.Json as Json

View File

@ -3,10 +3,13 @@ module Test.Values.Context exposing (..)
import Expect import Expect
import Fuzz exposing (Fuzzer) import Fuzz exposing (Fuzzer)
import Internal.Config.Leaks as Leaks import Internal.Config.Leaks as Leaks
import Internal.Values.Context as Context exposing (Context) import Internal.Tools.Hashdict as Hashdict
import Internal.Values.Context as Context exposing (Context, Versions)
import Json.Decode as D import Json.Decode as D
import Json.Encode as E import Json.Encode as E
import Set
import Test exposing (..) import Test exposing (..)
import Test.Tools.Timestamp as TestTimestamp
fuzzer : Fuzzer Context fuzzer : Fuzzer Context
@ -16,14 +19,28 @@ fuzzer =
maybeString = maybeString =
Fuzz.maybe Fuzz.string Fuzz.maybe Fuzz.string
in in
Fuzz.map7 Context Fuzz.map8 (\a b c d e f ( g, h ) ( i, j ) -> Context a b c d e f g h i j)
(Fuzz.constant <| Hashdict.empty .value)
maybeString maybeString
maybeString maybeString
(Fuzz.maybe TestTimestamp.fuzzer)
maybeString maybeString
maybeString maybeString
(Fuzz.pair
Fuzz.string
maybeString maybeString
)
(Fuzz.pair
maybeString maybeString
(Fuzz.maybe <| Fuzz.list Fuzz.string) (Fuzz.maybe <| versionsFuzzer)
)
versionsFuzzer : Fuzzer Versions
versionsFuzzer =
Fuzz.map2 Versions
(Fuzz.list Fuzz.string)
(Fuzz.map Set.fromList <| Fuzz.list Fuzz.string)
{-| If a leak is spotted, make sure to change the leaking value and then test {-| If a leak is spotted, make sure to change the leaking value and then test
@ -64,7 +81,7 @@ leaks =
|> Expect.notEqual Leaks.transaction |> Expect.notEqual Leaks.transaction
) )
, fuzz2 fuzzer , fuzz2 fuzzer
(Fuzz.list Fuzz.string) versionsFuzzer
"Versions" "Versions"
(\context value -> (\context value ->
context context
@ -110,7 +127,7 @@ apiContext =
|> Expect.equal value |> Expect.equal value
) )
, fuzz2 fuzzer , fuzz2 fuzzer
(Fuzz.list Fuzz.string) versionsFuzzer
"Versions" "Versions"
(\context value -> (\context value ->
context context
@ -126,7 +143,7 @@ json : Test
json = json =
describe "JSON encode + JSON decode" describe "JSON encode + JSON decode"
[ test "Empty is {}" [ test "Empty is {}"
(Context.init (Context.init ""
|> Context.encode |> Context.encode
|> E.encode 0 |> E.encode 0
|> Expect.equal "{}" |> Expect.equal "{}"

View File

@ -28,7 +28,7 @@ suite =
[ fuzz Fuzz.string [ fuzz Fuzz.string
"currentVersion" "currentVersion"
(\s -> (\s ->
s { content = s, serverName = "" }
|> Envelope.init |> Envelope.init
|> Envelope.extractSettings .currentVersion |> Envelope.extractSettings .currentVersion
|> Expect.equal Default.currentVersion |> Expect.equal Default.currentVersion
@ -36,7 +36,7 @@ suite =
, fuzz Fuzz.string , fuzz Fuzz.string
"deviceName" "deviceName"
(\s -> (\s ->
s { content = s, serverName = "" }
|> Envelope.init |> Envelope.init
|> Envelope.extractSettings .deviceName |> Envelope.extractSettings .deviceName
|> Expect.equal Default.deviceName |> Expect.equal Default.deviceName
@ -44,7 +44,7 @@ suite =
, fuzz Fuzz.string , fuzz Fuzz.string
"syncTime" "syncTime"
(\s -> (\s ->
s { content = s, serverName = "" }
|> Envelope.init |> Envelope.init
|> Envelope.extractSettings .syncTime |> Envelope.extractSettings .syncTime
|> Expect.equal Default.syncTime |> Expect.equal Default.syncTime

View File

@ -1,9 +1,7 @@
module Test.Values.Room exposing (..) module Test.Values.Room exposing (..)
import Expect
import Fuzz exposing (Fuzzer) import Fuzz exposing (Fuzzer)
import Internal.Values.Room as Room exposing (Room) import Internal.Values.Room as Room exposing (Room)
import Json.Decode as D
import Json.Encode as E import Json.Encode as E
import Test exposing (..) import Test exposing (..)
import Test.Filter.Timeline as TestFilter import Test.Filter.Timeline as TestFilter

View File

@ -2,7 +2,7 @@ module Test.Values.Timeline exposing (..)
import Expect import Expect
import Fuzz exposing (Fuzzer) import Fuzz exposing (Fuzzer)
import Internal.Filter.Timeline as Filter exposing (Filter) import Internal.Filter.Timeline as Filter
import Internal.Tools.Json as Json import Internal.Tools.Json as Json
import Internal.Values.Timeline as Timeline exposing (Batch, Timeline) import Internal.Values.Timeline as Timeline exposing (Batch, Timeline)
import Json.Decode as D import Json.Decode as D

View File

@ -0,0 +1,13 @@
module Test.Values.User exposing (..)
import Fuzz exposing (Fuzzer)
import Internal.Grammar.ServerName as SN
import Internal.Values.User exposing (User)
fuzzer : Fuzzer User
fuzzer =
Fuzz.constant
{ localpart = "temporary"
, domain = { host = SN.DNS "matrix.org", port_ = Nothing }
}

View File

@ -1,20 +1,22 @@
module Test.Values.Vault exposing (..) module Test.Values.Vault exposing (..)
import FastDict as Dict exposing (Dict) import FastDict as Dict
import Fuzz exposing (Fuzzer) import Fuzz exposing (Fuzzer)
import Internal.Tools.Json as Json import Internal.Tools.Json as Json
import Internal.Values.Vault exposing (Vault) import Internal.Values.Vault exposing (Vault)
import Test exposing (..) import Test exposing (..)
import Test.Tools.Hashdict as TestHashdict import Test.Tools.Hashdict as TestHashdict
import Test.Values.Room as TestRoom import Test.Values.Room as TestRoom
import Test.Values.User as TestUser
vault : Fuzzer Vault vault : Fuzzer Vault
vault = vault =
Fuzz.map2 Vault Fuzz.map3 Vault
(Fuzz.string (Fuzz.string
|> Fuzz.map (\k -> ( k, Json.encode Json.int 0 )) |> Fuzz.map (\k -> ( k, Json.encode Json.int 0 ))
|> Fuzz.list |> Fuzz.list
|> Fuzz.map Dict.fromList |> Fuzz.map Dict.fromList
) )
(TestHashdict.fuzzer .roomId TestRoom.fuzzer) (TestHashdict.fuzzer .roomId TestRoom.fuzzer)
TestUser.fuzzer