Finish chain refactor

src/Internal/Api/Chain.elm

@@ -63,13 +63,14 @@ andThen f2 f1 =
             )
     )
 
-{-| Optionally run a task that may render events. 
+{-| Optionally run a task that may provide additional information. 
 
-It will always succeed, and hence will not break the chain of events.
+If the provided chain fails, it will be ignored. This way, the chain can be tasked
+without needlessly breaking the whole chain if anything breaks in here.
 
-This function does not work if it aims to deliver crucial context.
+You cannot use this function to execute a task chain that adds or removes context.
 -}
-maybe : TaskChain u a a -> TaskChain u a a
+maybe : IdemChain u a -> IdemChain u a
 maybe f =
         { contextChange = identity
         , messages = []

src/Internal/Api/Context.elm

@@ -13,15 +13,20 @@ Additionaly, there are remove functions which are intended to tell the compiler
 -}
 
 import Internal.Config.Leaking as L
+import Internal.Tools.LoginValues exposing (AccessToken(..))
 
 type Context a =
     Context
         { accessToken : String
         , baseUrl : String
         , transactionId : String
+        , usernameAndPassword : Maybe UsernameAndPassword
         , versions : List String
         }
 
+type alias UsernameAndPassword =
+    { username : String, password : String }
+
 type alias VB a = { a | versions : (), baseUrl : () }
 
 type alias VBA a = { a | accessToken : (), baseUrl : (), versions : () }
@@ -35,6 +40,7 @@ init =
         { accessToken = L.accessToken
         , baseUrl = L.baseUrl
         , transactionId = L.transactionId
+        , usernameAndPassword = Nothing
         , versions = L.versions
         }
 
@@ -53,15 +59,20 @@ getTransactionId : Context { a | transactionId : () } -> String
 getTransactionId (Context { transactionId }) =
     transactionId
 
+{-| Get the username and password of the user, if present. -}
+getUsernameAndPassword : Context { a | accessToken : () } -> Maybe UsernameAndPassword
+getUsernameAndPassword (Context { usernameAndPassword }) =
+    usernameAndPassword
+
 {-| Get the supported spec versions from the Context. -}
 getVersions : Context { a | versions : () } -> List String
 getVersions (Context { versions }) =
     versions
 
 {-| Insert an access token into the context. -}
-setAccessToken : String -> Context a -> Context { a | accessToken : () }
-setAccessToken accessToken (Context data) =
-    Context { data | accessToken = accessToken }
+setAccessToken : { accessToken : String, usernameAndPassword : Maybe UsernameAndPassword } -> Context a -> Context { a | accessToken : () }
+setAccessToken { accessToken, usernameAndPassword } (Context data) =
+    Context { data | accessToken = accessToken, usernameAndPassword = usernameAndPassword }
 
 {-| Insert a base url into the context. -}
 setBaseUrl : String -> Context a -> Context { a | baseUrl : () }

src/Internal/Api/CredUpdate.elm

@@ -1,4 +1,4 @@
-module Internal.Api.All exposing (..)
+module Internal.Api.CredUpdate exposing (..)
 
 import Hash
 import Internal.Api.Chain as Chain exposing (TaskChain, IdemChain)
@@ -6,6 +6,7 @@ import Internal.Api.Context as Context exposing (VB, VBA, VBAT)
 import Internal.Api.GetEvent.Main as GetEvent
 import Internal.Api.Invite.Main as Invite
 import Internal.Api.JoinedMembers.Main as JoinedMembers
+import Internal.Api.LoginWithUsernameAndPassword.Main as LoginWithUsernameAndPassword
 import Internal.Api.Versions.V1.Versions as V
 import Internal.Api.Redact.Main as Redact
 import Internal.Api.SendMessageEvent.Main as SendMessageEvent
@@ -13,11 +14,12 @@ import Internal.Api.SendStateKey.Main as SendStateKey
 import Internal.Api.Sync.Main as Sync
 import Internal.Api.Versions.Main as Versions
 import Internal.Tools.Exceptions as X
-import Internal.Tools.LoginValues exposing (AccessToken)
+import Internal.Tools.LoginValues exposing (AccessToken(..))
 import Internal.Tools.SpecEnums as Enums
 import Json.Encode as E
 import Task exposing (Task)
 import Time
+import Html exposing (input)
 
 
 type CredUpdate
@@ -26,6 +28,7 @@ type CredUpdate
     | GetEvent GetEvent.EventInput GetEvent.EventOutput
     | InviteSent Invite.InviteInput Invite.InviteOutput
     | JoinedMembersToRoom JoinedMembers.JoinedMembersInput JoinedMembers.JoinedMembersOutput
+    | LoggedInWithUsernameAndPassword LoginWithUsernameAndPassword.LoginWithUsernameAndPasswordInput LoginWithUsernameAndPassword.LoginWithUsernameAndPasswordOutput
     | MessageEventSent SendMessageEvent.SendMessageEventInput SendMessageEvent.SendMessageEventOutput
     | RedactedEvent Redact.RedactInput Redact.RedactOutput
     | StateEventSent SendStateKey.SendStateKeyInput SendStateKey.SendStateKeyOutput
@@ -51,6 +54,34 @@ toTask =
                     MultipleUpdates updates
         )
 
+{-| Get a functional access token.
+-}
+accessToken : AccessToken -> TaskChain CredUpdate (VB a) (VBA a)
+accessToken ctoken =
+    case ctoken of
+        NoAccess ->
+            X.NoAccessToken
+            |> X.SDKException
+            |> Task.fail
+            |> always
+
+        AccessToken t ->
+            { contextChange = Context.setAccessToken { accessToken = t, usernameAndPassword = Nothing }
+            , messages = []
+            }
+            |> Chain.TaskChainPiece
+            |> Task.succeed
+            |> always
+        
+        UsernameAndPassword { username, password, token } ->
+            case token of
+                Just t ->
+                    accessToken (AccessToken t)
+                
+                Nothing ->
+                    loginWithUsernameAndPassword
+                        { username = username, password = password }
+
 type alias GetEventInput =
     { eventId : String, roomId : String }
 
@@ -74,16 +105,21 @@ getEvent { eventId, roomId } context =
                 }
         )
 
-{-| Insert versions, or get them if they are not provided.
+{-| Get the supported spec versions from the homeserver.
 -}
-getVersions : Maybe V.Versions -> TaskChain CredUpdate { a | baseUrl : () } (VB a)
-getVersions mVersions =
-    case mVersions of
-        Just vs ->
-            withVersions vs
-        
-        Nothing ->
-            versions
+getVersions : TaskChain CredUpdate { a | baseUrl : () } (VB a)
+getVersions context =
+    let
+        input = Context.getBaseUrl context
+    in
+        Versions.getVersions input
+        |> Task.map
+            (\output ->
+                Chain.TaskChainPiece
+                    { contextChange = Context.setVersions output.versions
+                    , messages = [ UpdateVersions output ]
+                    }
+            )
 
 type alias InviteInput =
     { reason : Maybe String
@@ -133,6 +169,33 @@ joinedMembers { roomId } context =
                     }
             )
 
+type alias LoginWithUsernameAndPasswordInput =
+    { password : String
+    , username : String
+    }
+
+loginWithUsernameAndPassword : LoginWithUsernameAndPasswordInput -> TaskChain CredUpdate (VB a) (VBA a)
+loginWithUsernameAndPassword ({ username, password } as data) context =
+    let
+        input = { baseUrl = Context.getBaseUrl context
+                , username = username
+                , password = password
+                }
+    in
+        input
+        |> LoginWithUsernameAndPassword.loginWithUsernameAndPassword (Context.getVersions context)
+        |> Task.map
+            (\output ->
+                Chain.TaskChainPiece
+                    { contextChange = 
+                        Context.setAccessToken
+                            { accessToken = output.accessToken
+                            , usernameAndPassword = Just data
+                            }
+                    , messages = [ LoggedInWithUsernameAndPassword input output ]
+                    }
+            )
+
 type alias RedactInput =
     { eventId : String
     , reason : Maybe String
@@ -253,32 +316,16 @@ sync data context =
                     }
             )
 
-{-| Get the supported spec versions from the homeserver.
+{-| Insert versions, or get them if they are not provided.
 -}
-versions : TaskChain CredUpdate { a | baseUrl : () } (VB a)
-versions context =
-    let
-        input = Context.getBaseUrl context
-    in
-        Versions.getVersions input
-        |> Task.map
-            (\output ->
-                Chain.TaskChainPiece
-                    { contextChange = Context.setVersions output.versions
-                    , messages = [ UpdateVersions output ]
-                    }
-            )
+versions : Maybe V.Versions -> TaskChain CredUpdate { a | baseUrl : () } (VB a)
+versions mVersions =
+    case mVersions of
+        Just vs ->
+            withVersions vs
         
-{-| Create a task that inserts an access token into the context.
--}
-withAccessToken : String -> TaskChain CredUpdate a { a | accessToken : () }
-withAccessToken accessToken =
-    { contextChange = Context.setAccessToken accessToken
-    , messages = []
-    }
-    |> Chain.TaskChainPiece
-    |> Task.succeed
-    |> always
+        Nothing ->
+            getVersions
 
 {-| Create a task that insert the base URL into the context. 
 -}
@@ -311,9 +358,9 @@ withTransactionId toString =
 
 {-| Create a task that inserts versions into the context.
 -}
-withVersions : V.Versions -> TaskChain CredUpdate a { a | versions : () }
-withVersions versions =
-    { contextChange = Context.setVersions versions.versions
+withVersions : V.Versions -> TaskChain CredUpdate { a | baseUrl : () } (VB a)
+withVersions vs =
+    { contextChange = Context.setVersions vs.versions
     , messages = []
     }
     |> Chain.TaskChainPiece

src/Internal/Api/LoginWithUsernameAndPassword/Api.elm

@@ -0,0 +1,40 @@
+module Internal.Api.LoginWithUsernameAndPassword.Api exposing (..)
+
+import Internal.Api.LoginWithUsernameAndPassword.V1.Login as SO
+import Internal.Api.Request as R
+import Internal.Tools.Exceptions as X
+import Json.Encode as E
+import Task exposing (Task)
+
+type alias LoginWithUsernameAndPasswordInputV1 =
+    { baseUrl : String
+    , password : String
+    , username : String
+    }
+
+type alias LoginWithUsernameAndPasswordOutputV1 =
+    SO.LoggedInResponse
+
+
+loginWithUsernameAndPasswordV1 : LoginWithUsernameAndPasswordInputV1 -> Task X.Error LoginWithUsernameAndPasswordOutputV1
+loginWithUsernameAndPasswordV1 data =
+    R.rawApiCall
+        { headers = R.NoHeaders
+        , method = "POST"
+        , baseUrl = data.baseUrl
+        , path = "/_matrix/client/v3/login"
+        , pathParams = []
+        , queryParams = []
+        , bodyParams =
+            [ [ ( "type", E.string "m.id.user" )
+                , ( "user", E.string data.username )
+                ]
+                |> E.object
+                |> R.RequiredValue "identifier"
+            , R.RequiredString "password" data.password
+            , R.RequiredString "type" "m.login.password"
+            ]
+        , timeout = Nothing
+        , decoder = always SO.loggedInResponseDecoder
+        }
+

src/Internal/Api/LoginWithUsernameAndPassword/Main.elm

@@ -0,0 +1,23 @@
+module Internal.Api.LoginWithUsernameAndPassword.Main exposing (..)
+
+import Internal.Api.LoginWithUsernameAndPassword.Api as Api
+import Internal.Tools.Exceptions as X
+import Internal.Tools.VersionControl as VC
+import Task exposing (Task)
+
+loginWithUsernameAndPassword : List String -> LoginWithUsernameAndPasswordInput -> Task X.Error LoginWithUsernameAndPasswordOutput
+loginWithUsernameAndPassword versions =
+    VC.withBottomLayer
+        { current = Api.loginWithUsernameAndPasswordV1
+        , version = "v1.5"
+        }
+        |> VC.mostRecentFromVersionList versions
+        |> Maybe.withDefault (always <| Task.fail X.UnsupportedSpecVersion)
+
+
+type alias LoginWithUsernameAndPasswordInput =
+    Api.LoginWithUsernameAndPasswordInputV1
+
+type alias LoginWithUsernameAndPasswordOutput =
+    Api.LoginWithUsernameAndPasswordOutputV1
+

src/Internal/Api/LoginWithUsernameAndPassword/V1/Login.elm

@@ -1,4 +1,4 @@
-module Internal.Api.PreApi.Objects.Login exposing
+module Internal.Api.LoginWithUsernameAndPassword.V1.Login exposing
     ( DiscoveryInformation
     , HomeserverInformation
     , IdentityServerInformation

src/Internal/Api/PreApi/Main.elm

@@ -8,7 +8,7 @@ that the credentials type needs to know about before it can make a request.
 
 -}
 
-import Internal.Api.PreApi.Objects.Login as L
+import Internal.Api.LoginWithUsernameAndPassword.V1.Login as L
 import Internal.Api.Versions.V1.Versions as V
 import Internal.Api.Request as R
 import Internal.Tools.Exceptions as X

src/Internal/Api/Task.elm

@@ -0,0 +1,174 @@
+module Internal.Api.Task exposing (..)
+{-| This module contains all tasks that can be executed.
+-}
+
+import Hash
+import Internal.Api.CredUpdate as C exposing (CredUpdate)
+import Internal.Api.Chain as Chain
+import Internal.Tools.LoginValues exposing (AccessToken)
+import Internal.Api.Versions.V1.Versions as V
+import Json.Encode as E
+import Internal.Tools.SpecEnums as Enums
+
+type alias FutureTask = C.FutureTask
+
+type alias GetEventInput =
+    { accessToken : AccessToken
+    , baseUrl : String
+    , eventId : String
+    , roomId : String
+    , versions : Maybe V.Versions
+    }
+
+getEvent : GetEventInput -> FutureTask
+getEvent { accessToken, baseUrl, eventId, roomId, versions } =
+    C.withBaseUrl baseUrl
+    |> Chain.andThen (C.versions versions)
+    |> Chain.andThen (C.accessToken accessToken)
+    |> Chain.andThen (C.getEvent { eventId = eventId, roomId = roomId })
+    |> C.toTask
+
+type alias InviteInput =
+    { accessToken : AccessToken
+    , baseUrl : String
+    , reason : Maybe String
+    , roomId : String
+    , userId : String
+    , versions : Maybe V.Versions 
+    }
+
+invite : InviteInput -> FutureTask
+invite { accessToken, baseUrl, reason, roomId, userId, versions } =
+    C.withBaseUrl baseUrl
+    |> Chain.andThen (C.versions versions)
+    |> Chain.andThen (C.accessToken accessToken)
+    |> Chain.andThen (C.invite { reason = reason, roomId = roomId, userId = userId })
+    |> C.toTask
+
+type alias JoinedMembersInput =
+    { accessToken : AccessToken
+    , baseUrl : String
+    , roomId : String
+    , versions : Maybe V.Versions
+    }
+
+joinedMembers : JoinedMembersInput -> FutureTask
+joinedMembers { accessToken, baseUrl, roomId, versions } =
+    C.withBaseUrl baseUrl
+    |> Chain.andThen (C.versions versions)
+    |> Chain.andThen (C.accessToken accessToken)
+    |> Chain.andThen (C.joinedMembers { roomId = roomId })
+    |> C.toTask
+
+type alias RedactInput =
+    { accessToken : AccessToken
+    , baseUrl : String
+    , eventId : String
+    , extraTransactionNoise : String
+    , reason : Maybe String
+    , roomId : String
+    , versions : Maybe V.Versions
+    }
+
+redact : RedactInput -> FutureTask
+redact { accessToken, baseUrl, eventId, extraTransactionNoise, reason, roomId, versions} =
+    C.withBaseUrl baseUrl
+    |> Chain.andThen (C.versions versions)
+    |> Chain.andThen (C.accessToken accessToken)
+    |> Chain.andThen
+        (C.withTransactionId
+            (\now ->
+                [ Hash.fromInt now
+                , Hash.fromString baseUrl
+                , Hash.fromString eventId
+                , Hash.fromString extraTransactionNoise
+                , Hash.fromString (reason |> Maybe.withDefault "noreason")
+                , Hash.fromString roomId
+                ]
+                |> List.foldl Hash.independent (Hash.fromString "redact")
+                |> Hash.toString
+            )
+        )
+    |> Chain.andThen (C.redact { eventId = eventId, reason = reason, roomId = roomId })
+    |> Chain.andThen
+        ( Chain.maybe <| C.getEvent { eventId = eventId, roomId = roomId })
+    |> C.toTask
+
+type alias SendMessageEventInput =
+    { accessToken : AccessToken
+    , baseUrl : String
+    , content : E.Value
+    , eventType : String
+    , extraTransactionNoise : String
+    , roomId : String
+    , versions : Maybe V.Versions
+    }
+
+sendMessageEvent : SendMessageEventInput -> FutureTask
+sendMessageEvent { accessToken, baseUrl, content, eventType, extraTransactionNoise, roomId, versions } =
+    C.withBaseUrl baseUrl
+    |> Chain.andThen (C.versions versions)
+    |> Chain.andThen (C.accessToken accessToken)
+    |> Chain.andThen
+        ( C.withTransactionId
+            (\now ->
+                [ Hash.fromInt now
+                , Hash.fromString baseUrl
+                , Hash.fromString (E.encode 0 content)
+                , Hash.fromString eventType
+                , Hash.fromString extraTransactionNoise
+                , Hash.fromString roomId
+                ]
+                |> List.foldl Hash.independent (Hash.fromString "send message")
+                |> Hash.toString
+            )
+        )
+    |> Chain.andThen (C.sendMessageEvent { content = content, eventType = eventType, roomId = roomId })
+    -- TODO: Get event from API to see what it looks like
+    |> C.toTask
+
+type alias SendStateKeyInput =
+    { accessToken : AccessToken
+    , baseUrl : String
+    , content : E.Value
+    , eventType : String
+    , roomId : String
+    , stateKey : String
+    , versions : Maybe V.Versions
+    }
+
+sendStateKey : SendStateKeyInput -> FutureTask
+sendStateKey { accessToken, baseUrl, content, eventType, roomId, stateKey, versions } =
+    C.withBaseUrl baseUrl
+    |> Chain.andThen (C.versions versions)
+    |> Chain.andThen (C.accessToken accessToken)
+    |> Chain.andThen (C.sendStateEvent { content = content, eventType = eventType, roomId = roomId, stateKey = stateKey})
+    -- TODO: Get event from API to see what it looks like
+    |> C.toTask
+
+type alias SyncInput =
+    { accessToken : AccessToken
+    , baseUrl : String
+    , filter : Maybe String
+    , fullState : Maybe Bool
+    , setPresence : Maybe Enums.UserPresence
+    , since : Maybe String
+    , timeout : Maybe Int
+    , versions : Maybe V.Versions
+    }
+
+sync : SyncInput -> FutureTask
+sync { accessToken, baseUrl, filter, fullState, setPresence, since, timeout, versions } =
+    C.withBaseUrl baseUrl
+    |> Chain.andThen (C.versions versions)
+    |> Chain.andThen (C.accessToken accessToken)
+    |> Chain.andThen 
+        (C.sync 
+            { filter = filter
+            , fullState = fullState
+            , setPresence = setPresence
+            , since = since
+            , timeout = timeout
+            }
+        )
+    |> C.toTask

src/Internal/Credentials.elm

@@ -8,7 +8,8 @@ This file combines the internal functions with the API endpoints to create a ful
 -}
 
 import Dict
-import Internal.Api.All as Api
+import Internal.Api.Task as Api
+import Internal.Api.CredUpdate exposing (CredUpdate(..))
 import Internal.Context as Context exposing (Context)
 import Internal.Event as Event
 import Internal.Room as Room
@@ -87,13 +88,13 @@ insertRoom =
 
 {-| Update the Credentials type with new values
 -}
-updateWith : Api.CredUpdate -> Credentials -> Credentials
+updateWith : CredUpdate -> Credentials -> Credentials
 updateWith credUpdate ((Credentials ({ cred, context } as data)) as credentials) =
     case credUpdate of
-        Api.MultipleUpdates updates ->
+        MultipleUpdates updates ->
             List.foldl updateWith credentials updates
 
-        Api.GetEvent input output ->
+        GetEvent input output ->
             case getRoomById input.roomId credentials of
                 Just room ->
                     output
@@ -107,26 +108,26 @@ updateWith credUpdate ((Credentials ({ cred, context } as data)) as credentials)
                     credentials
 
         -- TODO
-        Api.InviteSent _ _ ->
+        InviteSent _ _ ->
             credentials
 
-        Api.JoinedMembersToRoom _ _ ->
+        JoinedMembersToRoom _ _ ->
             credentials
 
         -- TODO
-        Api.MessageEventSent _ _ ->
+        MessageEventSent _ _ ->
             credentials
         
         -- TODO
-        Api.RedactedEvent _ _ ->
+        RedactedEvent _ _ ->
             credentials
 
         -- TODO
-        Api.StateEventSent _ _ ->
+        StateEventSent _ _ ->
             credentials
 
         -- TODO
-        Api.SyncUpdate input output ->
+        SyncUpdate input output ->
             let
                 jRooms : List IRoom.IRoom
                 jRooms =
@@ -179,18 +180,22 @@ updateWith credUpdate ((Credentials ({ cred, context } as data)) as credentials)
                 |> (\x -> { cred = x, context = context })
                 |> Credentials
 
-        Api.UpdateAccessToken token ->
+        UpdateAccessToken token ->
             Credentials { data | context = Context.addToken token context }
 
-        Api.UpdateVersions versions ->
+        UpdateVersions versions ->
             Credentials { data | context = Context.addVersions versions context }
 
+        -- TODO: Save all info
+        LoggedInWithUsernameAndPassword _ output ->
+            Credentials { data | context = Context.addToken output.accessToken context }
+
 
 {-| Synchronize credentials
 -}
-sync : Credentials -> Task X.Error Api.CredUpdate
+sync : Credentials -> Task X.Error CredUpdate
 sync (Credentials { cred, context }) =
-    Api.syncCredentials
+    Api.sync
         { accessToken = Context.accessToken context
         , baseUrl = Context.baseUrl context
         , filter = Nothing

src/Internal/Room.elm

@@ -4,7 +4,8 @@ module Internal.Room exposing (..)
 -}
 
 import Dict
-import Internal.Api.All as Api
+import Internal.Api.CredUpdate exposing (CredUpdate)
+import Internal.Api.Task as Api
 import Internal.Api.Sync.V2.SpecObjects as Sync
 import Internal.Context as Context exposing (Context)
 import Internal.Event as Event exposing (Event)
@@ -135,7 +136,7 @@ roomId =
 
 {-| Sends a new event to the Matrix room associated with the given `Room`.
 -}
-sendEvent : Room -> { eventType : String, content : E.Value } -> Task X.Error Api.CredUpdate
+sendEvent : Room -> { eventType : String, content : E.Value } -> Task X.Error CredUpdate
 sendEvent (Room { context, room }) { eventType, content } =
     Api.sendMessageEvent
         { accessToken = Context.accessToken context
@@ -150,7 +151,7 @@ sendEvent (Room { context, room }) { eventType, content } =
 
 {-| Sends a new text message to the Matrix room associated with the given `Room`.
 -}
-sendMessage : Room -> String -> Task X.Error Api.CredUpdate
+sendMessage : Room -> String -> Task X.Error CredUpdate
 sendMessage (Room { context, room }) text =
     Api.sendMessageEvent
         { accessToken = Context.accessToken context