Lamdera program test

README.md

@@ -21,7 +21,6 @@ Progress:
 - [ ] Actually make this an installable package with nice docs
 - [ ] Stretch goal: elm-review rule to set everything up!
 
-
 ### Vendored packages
 
 This package vendors two other Elm packages in order to make modifications:
@@ -31,15 +30,14 @@ This package vendors two other Elm packages in order to make modifications:
 
 Ideally these will be de-vendored into a regular Elm dependencies in future.
 
-
-
 ### Install
 
 Until this is available as a package:
 
 - Clone this repo into your project as a git submodule (or vendor it manually by copy pasting src)
 - Reference `src` in your project's `elm.json:source-directories`
 - Install the relevant deps:
+
 ```
 yes | lamdera install elm/browser
 yes | lamdera install elm/bytes
@@ -59,12 +57,10 @@ yes | lamdera install TSFoster/elm-sha1
 
 You might also have luck with [elm-git-install](https://github.com/robinheghan/elm-git-install), though its not been tried yet.
 
-
 ### Setup
 
 :warning: This is the conceptual target API, not actual instructions for this code yet! (Instead, follow the types!)
 
-
 1. Create `src/Auth.elm`:
 
 ```elm
@@ -95,10 +91,9 @@ config =
 
 2. Modify the 2 core Model types in `src/Types.elm`:
 
-
 ```elm
 import Auth.Common
-import Dict exposing (Dict)
+import SeqDict as Dict exposing (Dict)
 import Lamdera
 import Url exposing (Url)
 

elm.json

@@ -26,8 +26,11 @@
         "elm/time": "1.0.0 <= v < 2.0.0",
         "elm/url": "1.0.0 <= v < 2.0.0",
         "elmcraft/core-extra": "2.0.0 <= v < 3.0.0",
+        "ianmackenzie/elm-units": "2.10.0 <= v < 3.0.0",
         "ktonon/elm-crypto": "1.1.2 <= v < 2.0.0",
-        "ktonon/elm-word": "2.1.2 <= v < 3.0.0"
+        "ktonon/elm-word": "2.1.2 <= v < 3.0.0",
+        "lamdera/containers": "1.0.0 <= v < 2.0.0",
+        "lamdera/program-test": "3.0.0 <= v < 4.0.0"
     },
     "test-dependencies": {}
 }

src/Auth/Common.elm

@@ -1,67 +1,67 @@
 module Auth.Common exposing (..)
 
 import Base64.Encode as Base64
-import Browser.Navigation exposing (Key)
 import Bytes exposing (Bytes)
 import Bytes.Encode as Bytes
-import Dict exposing (Dict)
-import Http
-import Json.Decode as Json
+import Duration
+import Effect.Browser.Navigation
+import Effect.Command exposing (BackendOnly, Command, FrontendOnly)
+import Effect.Lamdera exposing (ClientId, SessionId)
+import Effect.Process
+import Effect.Task
+import Effect.Time
 import OAuth
 import OAuth.AuthorizationCode as OAuth
-import Process
-import Task exposing (Task)
-import Time
 import Url exposing (Protocol(..), Url)
 
 
-type alias Config frontendMsg toBackend backendMsg toFrontend frontendModel backendModel =
+type alias Config frontendMsg toBackend backendMsg toFrontend frontendModel backendModel toMsg =
     { toBackend : ToBackend -> toBackend
     , toFrontend : ToFrontend -> toFrontend
     , backendMsg : BackendMsg -> backendMsg
-    , sendToFrontend : SessionId -> toFrontend -> Cmd backendMsg
-    , sendToBackend : toBackend -> Cmd frontendMsg
-    , methods : List (Method frontendMsg backendMsg frontendModel backendModel)
-    , renewSession : SessionId -> ClientId -> backendModel -> ( backendModel, Cmd backendMsg )
+    , sendToFrontend : SessionId -> toFrontend -> Command BackendOnly toFrontend backendMsg
+    , sendToBackend : toBackend -> Command FrontendOnly toBackend frontendMsg
+    , methods : List (Method frontendMsg backendMsg frontendModel backendModel FrontendOnly toMsg)
+    , renewSession : SessionId -> ClientId -> backendModel -> ( backendModel, Command BackendOnly toMsg backendMsg )
     }
 
 
-type Method frontendMsg backendMsg frontendModel backendModel
-    = ProtocolOAuth (ConfigurationOAuth frontendMsg backendMsg frontendModel backendModel)
-    | ProtocolEmailMagicLink (ConfigurationEmailMagicLink frontendMsg backendMsg frontendModel backendModel)
+type Method frontendMsg backendMsg frontendModel backendModel restriction toMsg
+    = ProtocolOAuth (ConfigurationOAuth frontendMsg backendMsg frontendModel backendModel restriction toMsg)
+    | ProtocolEmailMagicLink (ConfigurationEmailMagicLink frontendMsg backendMsg frontendModel backendModel restriction toMsg)
 
 
-type alias ConfigurationEmailMagicLink frontendMsg backendMsg frontendModel backendModel =
+type alias ConfigurationEmailMagicLink frontendMsg backendMsg frontendModel backendModel restriction toMsg =
     { id : String
     , initiateSignin :
         SessionId
         -> ClientId
         -> backendModel
         -> { username : Maybe String }
-        -> Time.Posix
-        -> ( backendModel, Cmd backendMsg )
+        -> Effect.Time.Posix
+        -> ( backendModel, Command BackendOnly toMsg backendMsg )
     , onFrontendCallbackInit :
         frontendModel
         -> MethodId
         -> Url
-        -> Key
-        -> (ToBackend -> Cmd frontendMsg)
-        -> ( frontendModel, Cmd frontendMsg )
+        -> Effect.Browser.Navigation.Key
+        -> (ToBackend -> Command restriction toMsg frontendMsg)
+        -> ( frontendModel, Command restriction toMsg frontendMsg )
     , onAuthCallbackReceived :
         SessionId
         -> ClientId
         -> Url
         -> AuthCode
         -> State
-        -> Time.Posix
+        -> Effect.Time.Posix
         -> (BackendMsg -> backendMsg)
         -> backendModel
-        -> ( backendModel, Cmd backendMsg )
+        -> ( backendModel, Command BackendOnly toMsg backendMsg )
     , placeholder : frontendMsg -> backendMsg -> frontendModel -> backendModel -> ()
     }
 
 
-type alias ConfigurationOAuth frontendMsg backendMsg frontendModel backendModel =
+type alias ConfigurationOAuth frontendMsg backendMsg frontendModel backendModel restriction toMsg =
     { id : String
     , authorizationEndpoint : Url
     , tokenEndpoint : Url
@@ -70,14 +70,14 @@ type alias ConfigurationOAuth frontendMsg backendMsg frontendModel backendModel
     , clientId : String
     , clientSecret : String
     , scope : List String
-    , getUserInfo : OAuth.AuthenticationSuccess -> Task Error UserInfo
+    , getUserInfo : OAuth.AuthenticationSuccess -> Effect.Task.Task restriction Error UserInfo
     , onFrontendCallbackInit :
         frontendModel
         -> MethodId
         -> Url
-        -> Key
-        -> (ToBackend -> Cmd frontendMsg)
-        -> ( frontendModel, Cmd frontendMsg )
+        -> Effect.Browser.Navigation.Key
+        -> (ToBackend -> Command FrontendOnly toMsg frontendMsg)
+        -> ( frontendModel, Command FrontendOnly toMsg frontendMsg )
     , placeholder : ( backendModel, backendMsg ) -> ()
     }
 
@@ -98,10 +98,10 @@ type ToBackend
 
 
 type BackendMsg
-    = AuthSigninInitiated_ { sessionId : SessionId, clientId : ClientId, methodId : MethodId, baseUrl : Url, now : Time.Posix, username : Maybe String }
+    = AuthSigninInitiated_ { sessionId : SessionId, clientId : ClientId, methodId : MethodId, baseUrl : Url, now : Effect.Time.Posix, username : Maybe String }
     | AuthSigninInitiatedDelayed_ SessionId ToFrontend
-    | AuthCallbackReceived_ SessionId ClientId MethodId Url String String Time.Posix
-    | AuthSuccess SessionId ClientId MethodId Time.Posix (Result Error ( UserInfo, Maybe Token ))
+    | AuthCallbackReceived_ SessionId ClientId MethodId Url String String Effect.Time.Posix
+    | AuthSuccess SessionId ClientId MethodId Effect.Time.Posix (Result Error ( UserInfo, Maybe Token ))
     | AuthRenewSession SessionId ClientId
     | AuthLogout SessionId ClientId
 
@@ -122,8 +122,8 @@ type AuthChallengeReason
 type alias Token =
     { methodId : MethodId
     , token : OAuth.Token
-    , created : Time.Posix
-    , expires : Time.Posix
+    , created : Effect.Time.Posix
+    , expires : Effect.Time.Posix
     }
 
 
@@ -179,14 +179,14 @@ type alias UserInfo =
 
 
 type alias PendingAuth =
-    { created : Time.Posix
+    { created : Effect.Time.Posix
     , sessionId : SessionId
     , state : String
     }
 
 
 type alias PendingEmailAuth =
-    { created : Time.Posix
+    { created : Effect.Time.Posix
     , sessionId : SessionId
     , username : String
     , fullname : String
@@ -231,12 +231,12 @@ sleepTask isDev msg =
     -- make sure we sleep a little before a redirect otherwise we won't have our
     -- persisted state.
     (if isDev then
-        Process.sleep 3000
+        Effect.Process.sleep (Duration.milliseconds 3000)
 
      else
-        Process.sleep 0
+        Effect.Process.sleep (Duration.milliseconds 0)
     )
-        |> Task.perform (always msg)
+        |> Effect.Task.perform (always msg)
 
 
 nothingIfEmpty s =
@@ -253,11 +253,3 @@ nothingIfEmpty s =
 
 
 -- Lamdera aliases
-
-
-type alias SessionId =
-    String
-
-
-type alias ClientId =
-    String