Parlez-Vous

├── format-elm-files.sh ├── postcss.config.js ├── elm-analyse.json ├── src ├── elm │ ├── UI │ │ ├── Loader.elm │ │ ├── Link.elm │ │ ├── Toast.elm │ │ ├── Icons.elm │ │ └── Nav.elm │ ├── Api │ │ ├── Output.elm │ │ └── Deserialize.elm │ ├── Utils.elm │ ├── Routes │ │ ├── Site.elm │ │ ├── Dash.elm │ │ ├── Home.elm │ │ ├── RegisterSite.elm │ │ └── Home │ │ │ └── Forms.elm │ ├── SharedState.elm │ ├── Main.elm │ ├── Api.elm │ └── Router.elm ├── index.html ├── index.js └── css │ └── custom.css ├── package.json ├── elm.json ├── README.md ├── webpack.config.js └── .gitignore /format-elm-files.sh: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | elm-format --yes ./src/elm 4 | 5 | -------------------------------------------------------------------------------- /postcss.config.js: -------------------------------------------------------------------------------- 1 | module.exports = { 2 | plugins: [ 3 | require('postcss-import'), 4 | require('tailwindcss'), 5 | require('autoprefixer') 6 | ] 7 | } 8 | -------------------------------------------------------------------------------- /elm-analyse.json: -------------------------------------------------------------------------------- 1 | { 2 | "checks" : { 3 | "SingleFieldRecord": false, 4 | "ImportAll": false, 5 | "TriggerWords": false, 6 | "UseConsOverConcat": false 7 | } 8 | } 9 | -------------------------------------------------------------------------------- /src/elm/UI/Loader.elm: -------------------------------------------------------------------------------- 1 | -- Exposes a loding UI component 2 | 3 | 4 | module UI.Loader exposing (donut) 5 | 6 | import Html exposing (Html, div) 7 | import Html.Attributes exposing (class) 8 | 9 | 10 | donut : Html msg 11 | donut = 12 | div [ class "loading__donut" ] [] 13 | -------------------------------------------------------------------------------- /src/index.html: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | 6 | 7 | Parlez-Vous 8 | 9 | 10 | 11 | 12 | -------------------------------------------------------------------------------- /src/elm/Api/Output.elm: -------------------------------------------------------------------------------- 1 | {- 2 | This module defines the data that will get sent 3 | to the API Server 4 | -} 5 | 6 | 7 | module Api.Output exposing 8 | ( RegisterSite 9 | , Signin 10 | , Signup 11 | ) 12 | 13 | 14 | type alias Signup = 15 | { username : String 16 | , email : String 17 | , password : String 18 | , passwordConfirm : String 19 | } 20 | 21 | 22 | type alias Signin = 23 | { username : String 24 | , password : String 25 | } 26 | 27 | 28 | type alias RegisterSite = 29 | { hostname : String 30 | } 31 | -------------------------------------------------------------------------------- /src/index.js: -------------------------------------------------------------------------------- 1 | 'use strict'; 2 | 3 | require('./css/custom.css') 4 | 5 | const Elm = require('./elm/Main.elm').Elm; 6 | 7 | const storagekey = '@pv/token' 8 | 9 | const api = process.env.API || 'https://staging-269700.appspot.com' 10 | 11 | const token = localStorage.getItem(storagekey) 12 | 13 | const app = Elm.Main.init({ 14 | flags: { 15 | token, 16 | api 17 | }, 18 | }); 19 | 20 | app.ports.setToken.subscribe((t) => { 21 | localStorage.setItem(storagekey, t) 22 | }) 23 | 24 | app.ports.removeToken.subscribe(() => { 25 | localStorage.removeItem(storagekey) 26 | }) 27 | -------------------------------------------------------------------------------- /src/css/custom.css: -------------------------------------------------------------------------------- 1 | @tailwind base; 2 | @tailwind components; 3 | @tailwind utilities; 4 | 5 | 6 | /* Custom CSS Below 7 | * 8 | */ 9 | 10 | html, body { 11 | height: 100%; 12 | } 13 | 14 | html > *, body > * { 15 | height: 100%; 16 | } 17 | 18 | @keyframes donut-spin { 19 | 0% { 20 | transform: rotate(0deg); 21 | } 22 | 23 | 100% { 24 | transform: rotate(360deg); 25 | } 26 | } 27 | 28 | .loading__donut { 29 | display: inline-block; 30 | border: 4px solid rgba(0, 0, 0, 0.1); 31 | border-left-color: #fa544b; 32 | border-radius: 50%; 33 | width: 30px; 34 | height: 30px; 35 | animation: donut-spin 1.2s linear infinite; 36 | } 37 | 38 | -------------------------------------------------------------------------------- /package.json: -------------------------------------------------------------------------------- 1 | { 2 | "name": "parlez-vous-site", 3 | "version": "1.0.0", 4 | "description": "", 5 | "main": "Main.elm", 6 | "scripts": { 7 | "start": "webpack-dev-server --port 3060", 8 | "build": "NODE_ENV=production webpack", 9 | "test": "echo \"Error: no test specified\" && exit 1" 10 | }, 11 | "author": "Giorgio Delgado", 12 | "license": "UNLICENSED", 13 | "dependencies": {}, 14 | "devDependencies": { 15 | "autoprefixer": "9.7.4", 16 | "css-loader": "2.1.0", 17 | "elm": "^0.19.1-5", 18 | "elm-format": "^0.8.5", 19 | "elm-webpack-loader": "6.0.0", 20 | "html-webpack-plugin": "3.2.0", 21 | "postcss-import": "^12.0.1", 22 | "postcss-loader": "3.0.0", 23 | "style-loader": "0.23.1", 24 | "tailwindcss": "^1.9.6", 25 | "webpack": "4.28.2", 26 | "webpack-cli": "3.1.2", 27 | "webpack-dev-server": "^3.11.2" 28 | } 29 | } 30 | -------------------------------------------------------------------------------- /elm.json: -------------------------------------------------------------------------------- 1 | { 2 | "type": "application", 3 | "source-directories": [ 4 | "src/elm" 5 | ], 6 | "elm-version": "0.19.1", 7 | "dependencies": { 8 | "direct": { 9 | "elm/browser": "1.0.2", 10 | "elm/core": "1.0.5", 11 | "elm/html": "1.0.0", 12 | "elm/http": "2.0.0", 13 | "elm/json": "1.1.3", 14 | "elm/svg": "1.0.1", 15 | "elm/time": "1.0.0", 16 | "elm/url": "1.0.0", 17 | "krisajenkins/remotedata": "6.0.1", 18 | "pablen/toasty": "1.2.0", 19 | "panthershark/email-parser": "1.0.2", 20 | "supermacro/elm-antd": "7.2.0" 21 | }, 22 | "indirect": { 23 | "avh4/elm-color": "1.0.0", 24 | "elm/bytes": "1.0.8", 25 | "elm/file": "1.0.5", 26 | "elm/parser": "1.1.0", 27 | "elm/random": "1.0.0", 28 | "elm/regex": "1.0.0", 29 | "elm/virtual-dom": "1.0.2", 30 | "elm-community/list-extra": "8.3.0", 31 | "fredcy/elm-parseint": "2.0.1", 32 | "noahzgordon/elm-color-extra": "1.0.2", 33 | "rtfeldman/elm-css": "16.1.1", 34 | "rtfeldman/elm-hex": "1.0.0" 35 | } 36 | }, 37 | "test-dependencies": { 38 | "direct": {}, 39 | "indirect": {} 40 | } 41 | } 42 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Parlez-Vous Landing Page 2 | 3 | > Work In Progress 4 | 5 | `master` maps to https://master--adoring-banach-15797c.netlify.com/ ... consider this the staging branch 6 | 7 | 8 | Need to connect this with the [server](https://github.com/parlez-vous/server) 9 | 10 | 11 | 12 | ### Optimizations 13 | 14 | https://discourse.elm-lang.org/t/optimize-elm-compilation-with-webpack/2191/8 15 | 16 | 17 | 18 | ## Architectural Inspiration 19 | 20 | - [elm-shared-state](https://github.com/ohanhi/elm-shared-state) 21 | - This, I would say, is the app from which I took the most inspiration from. I didn't even change the type names around shared state. 22 | 23 | - [elm-shared-login](https://github.com/jxxcarlson/elm-shared-login) 24 | - Same idea 25 | 26 | - [elm-spa-example](https://github.com/rtfeldman/elm-spa-example) 27 | 28 | 29 | ## Contributing 30 | 31 | ### Adding a new page 32 | 33 | - Add a new `.elm` file to the `Routes` folder. This file will represent the page. 34 | - Connect the `Model` and the `Msg` within the `Router.elm` file 35 | - Update the `parser` which will take care of url handling 36 | - Update the `update` function so that it's aware of events that will occur within the new page 37 | - Update the `view` function so that it renders your page! 38 | - Update the `transitionTrigger` function so that any "on-load" events get fired within your new page 39 | 40 | -------------------------------------------------------------------------------- /src/elm/Utils.elm: -------------------------------------------------------------------------------- 1 | port module Utils exposing 2 | ( getApi 3 | , getNavKey 4 | , logout 5 | , setToken 6 | , toClass 7 | ) 8 | 9 | import Api exposing (Api) 10 | import Browser.Navigation as Nav 11 | import Html exposing (Attribute) 12 | import Html.Attributes exposing (class) 13 | import SharedState exposing (PrivateState, SharedState(..), SharedStateUpdate(..)) 14 | 15 | 16 | port removeToken : () -> Cmd msg 17 | 18 | 19 | port setToken : String -> Cmd msg 20 | 21 | 22 | 23 | -- TODO: turn into extensible record 24 | 25 | 26 | getApi : SharedState -> Api 27 | getApi sharedState = 28 | case sharedState of 29 | Public { api } -> 30 | api 31 | 32 | Private { api } -> 33 | api 34 | 35 | 36 | getNavKey : SharedState -> Nav.Key 37 | getNavKey sharedState = 38 | case sharedState of 39 | Public { navKey } -> 40 | navKey 41 | 42 | Private { navKey } -> 43 | navKey 44 | 45 | 46 | logout : PrivateState -> ( Cmd msg, SharedStateUpdate ) 47 | logout { navKey, api } = 48 | let 49 | publicState = 50 | { navKey = navKey 51 | , api = api 52 | } 53 | in 54 | ( removeToken () 55 | , SharedState.LogOut publicState 56 | ) 57 | 58 | 59 | toClass : List String -> Attribute msg 60 | toClass list = 61 | List.intersperse " " list 62 | |> String.concat 63 | |> class 64 | -------------------------------------------------------------------------------- /src/elm/UI/Link.elm: -------------------------------------------------------------------------------- 1 | module UI.Link exposing 2 | ( Route(..) 3 | , externalLink 4 | , link 5 | , toHref 6 | , toHtml 7 | ) 8 | 9 | import Html exposing (..) 10 | import Html.Attributes exposing (..) 11 | import Utils as Utils 12 | 13 | 14 | type Route 15 | = Home 16 | | Dash 17 | | Site String 18 | | Login 19 | | Signup 20 | | RegisterSite 21 | 22 | 23 | type alias Options = 24 | { route : Route 25 | } 26 | 27 | 28 | type alias Label = 29 | String 30 | 31 | 32 | type Link 33 | = Link Options Label 34 | 35 | 36 | link : Route -> Label -> Link 37 | link route = 38 | Link (Options route) 39 | 40 | 41 | toHref : Route -> String 42 | toHref route = 43 | case route of 44 | Home -> 45 | "/" 46 | 47 | Dash -> 48 | "/dash" 49 | 50 | Site id -> 51 | "/sites/" ++ id 52 | 53 | Login -> 54 | "/login" 55 | 56 | Signup -> 57 | "/signup" 58 | 59 | RegisterSite -> 60 | "/register-site" 61 | 62 | 63 | linkStyles : List String 64 | linkStyles = 65 | [ "text-blue-500" 66 | , "underline" 67 | , "hover:text-blue-700" 68 | ] 69 | 70 | 71 | toHtml : Link -> Html msg 72 | toHtml (Link opts label) = 73 | a [ href (toHref opts.route), Utils.toClass linkStyles ] [ text label ] 74 | 75 | 76 | type alias URL = 77 | String 78 | 79 | 80 | externalLink : URL -> String -> Html a 81 | externalLink url label = 82 | a [ href url, Utils.toClass linkStyles ] [ text label ] 83 | -------------------------------------------------------------------------------- /src/elm/Api/Deserialize.elm: -------------------------------------------------------------------------------- 1 | module Api.Deserialize exposing 2 | ( Admin 3 | , AdminWithToken 4 | , SessionToken 5 | , Site 6 | , Sites 7 | , adminAndTokenDecoder 8 | , adminDecoder 9 | , siteDecoder 10 | ) 11 | 12 | import Json.Decode as D exposing (Decoder) 13 | import Time 14 | 15 | 16 | 17 | -- TODO: convert into opaque type 18 | 19 | 20 | type alias SessionToken = 21 | String 22 | 23 | 24 | type alias Admin = 25 | { id : String 26 | , username : String 27 | , created : Time.Posix 28 | , updated : Time.Posix 29 | } 30 | 31 | 32 | type alias Site = 33 | { id : String 34 | , hostname : String 35 | , created : Time.Posix 36 | , updated : Time.Posix 37 | } 38 | 39 | 40 | type alias Sites = 41 | List Site 42 | 43 | 44 | type alias AdminWithToken = 45 | ( Admin, SessionToken ) 46 | 47 | 48 | adminDecoder : Decoder Admin 49 | adminDecoder = 50 | D.map4 Admin 51 | (D.field "id" D.string) 52 | (D.field "username" D.string) 53 | (D.field "createdAt" posixTimeDecoder) 54 | (D.field "updatedAt" posixTimeDecoder) 55 | 56 | 57 | adminAndTokenDecoder : Decoder ( Admin, SessionToken ) 58 | adminAndTokenDecoder = 59 | D.map2 Tuple.pair 60 | (D.field "data" adminDecoder) 61 | (D.field "sessionToken" D.string) 62 | 63 | 64 | posixTimeDecoder : Decoder Time.Posix 65 | posixTimeDecoder = 66 | D.int 67 | |> D.map Time.millisToPosix 68 | 69 | 70 | siteDecoder : Decoder Site 71 | siteDecoder = 72 | D.map4 Site 73 | (D.field "id" D.string) 74 | (D.field "hostname" D.string) 75 | (D.field "createdAt" posixTimeDecoder) 76 | (D.field "updatedAt" posixTimeDecoder) 77 | -------------------------------------------------------------------------------- /src/elm/Routes/Site.elm: -------------------------------------------------------------------------------- 1 | module Routes.Site exposing 2 | ( Model 3 | , Msg 4 | , initModel 5 | , update 6 | , view 7 | ) 8 | 9 | import Dict 10 | import Html exposing (..) 11 | import Html.Attributes exposing (class) 12 | import RemoteData 13 | import SharedState exposing (PrivateState, SharedStateUpdate) 14 | import UI.Nav as ResponsiveNav exposing (withVnav) 15 | 16 | 17 | type alias Model = 18 | { siteId : String 19 | , navbar : ResponsiveNav.NavState 20 | } 21 | 22 | 23 | type Msg 24 | = ResponsiveNavMsg ResponsiveNav.Msg 25 | 26 | 27 | initModel : String -> Model 28 | initModel siteId = 29 | Model siteId ResponsiveNav.init 30 | 31 | 32 | update : PrivateState -> Msg -> Model -> ( Model, Cmd Msg, SharedStateUpdate ) 33 | update _ msg model = 34 | case msg of 35 | ResponsiveNavMsg subMsg -> 36 | ResponsiveNav.update subMsg model 37 | 38 | 39 | type alias Title = 40 | String 41 | 42 | 43 | view : PrivateState -> Model -> ( Title, Html Msg ) 44 | view state model = 45 | let 46 | viewWithNav = 47 | withVnav state model ResponsiveNavMsg 48 | 49 | maybeSite = 50 | case state.sites of 51 | RemoteData.Success sites_ -> 52 | Dict.get model.siteId sites_ 53 | 54 | _ -> 55 | Nothing 56 | 57 | info = 58 | case maybeSite of 59 | Nothing -> 60 | text "site not found" 61 | 62 | Just site -> 63 | div [ class "m-2 md:m-12 w-full" ] 64 | [ h1 [ class "text-2xl" ] [ text site.hostname ] 65 | , div [] [ text "ayyy you all good!" ] 66 | ] 67 | in 68 | ( "Site" 69 | , viewWithNav info 70 | ) 71 | -------------------------------------------------------------------------------- /src/elm/UI/Toast.elm: -------------------------------------------------------------------------------- 1 | module UI.Toast exposing 2 | ( ToastMsg 3 | , ToastState 4 | , addToast 5 | , init 6 | , update 7 | , view 8 | ) 9 | 10 | import Html exposing (Html, div, text) 11 | import Html.Attributes exposing (class) 12 | import Toasty exposing (Stack) 13 | import Utils 14 | 15 | 16 | type alias ToastState = 17 | Stack String 18 | 19 | 20 | type alias ToastMsg = 21 | Toasty.Msg String 22 | 23 | 24 | type alias WithToasts a = 25 | { a 26 | | toasts : ToastState 27 | } 28 | 29 | 30 | init : ToastState 31 | init = 32 | Toasty.initialState 33 | 34 | 35 | config : Toasty.Config msg 36 | config = 37 | Toasty.config 38 | 39 | 40 | addToast : (Toasty.Msg String -> a) -> String -> ( WithToasts b, Cmd a ) -> ( WithToasts b, Cmd a ) 41 | addToast tagger toast ( model, cmd ) = 42 | let 43 | toasties_ = 44 | { toasties = model.toasts } 45 | 46 | ( { toasties }, newCmd ) = 47 | Toasty.addToast config tagger toast ( toasties_, cmd ) 48 | in 49 | ( { model | toasts = toasties } 50 | , newCmd 51 | ) 52 | 53 | 54 | update : (Toasty.Msg String -> a) -> Toasty.Msg String -> WithToasts b -> ( WithToasts b, Cmd a ) 55 | update tagger toastInfo model = 56 | let 57 | toasties_ = 58 | { toasties = model.toasts 59 | } 60 | 61 | ( { toasties }, cmd ) = 62 | Toasty.update config tagger toastInfo toasties_ 63 | in 64 | ( { model | toasts = toasties } 65 | , cmd 66 | ) 67 | 68 | 69 | 70 | -- TODO: customize inset to provide some space 71 | -- between the bottom and the toast on wider 72 | 73 | 74 | view : (Toasty.Msg String -> msg) -> ToastState -> Html msg 75 | view toMsg toastStack = 76 | div [ class "fixed inset-x-0 bottom-0" ] 77 | [ Toasty.view config renderToast toMsg toastStack ] 78 | 79 | 80 | renderToast : String -> Html msg 81 | renderToast toast = 82 | let 83 | classes = 84 | Utils.toClass 85 | [ "py-1" 86 | , "px-2" 87 | , "bg-red-200" 88 | , "text-red-700" 89 | , "rounded" 90 | , "mb-4" 91 | , "md:mx-auto" 92 | , "md:w-1/6" 93 | ] 94 | in 95 | div [ classes ] [ text toast ] 96 | -------------------------------------------------------------------------------- /webpack.config.js: -------------------------------------------------------------------------------- 1 | const webpack = require('webpack') 2 | const path = require("path"); 3 | const HtmlWebpackPlugin = require('html-webpack-plugin'); 4 | 5 | const SOURCE_DIR = path.join(__dirname, 'src') 6 | 7 | // Copy the specified environment variables into an object we can pass to 8 | // webpack's DefinePlugin 9 | const copyArgs = (args) => 10 | args.reduce( 11 | (acc, key) => ({ 12 | // Create an object with the specified key 13 | ...acc, 14 | [`process.env.${key}`]: JSON.stringify(process.env[key]), 15 | }), 16 | {} 17 | ) 18 | 19 | 20 | const IS_PROD = process.env.NODE_ENV === 'production' 21 | const IS_DEVELOPMENT = !IS_PROD 22 | 23 | 24 | const commonConfig = { 25 | mode: IS_PROD 26 | ? 'production' 27 | : 'development', 28 | 29 | entry: { 30 | app: [ 31 | './src/index.js' 32 | ] 33 | }, 34 | 35 | output: { 36 | path: path.resolve(__dirname + '/dist'), 37 | filename: '[name].js', 38 | publicPath: '/', 39 | }, 40 | 41 | module: { 42 | rules: [ 43 | { 44 | test: /\.css$/, 45 | use: [ 46 | 'style-loader', 47 | 'css-loader', 48 | 'postcss-loader' 49 | ], 50 | }, 51 | { 52 | test: /\.elm$/, 53 | exclude: [/elm-stuff/, /node_modules/], 54 | loader: 'elm-webpack-loader', 55 | options: { 56 | cache: false, 57 | // turns on the time-travelling debugger 58 | // this is a flag that is passed to elm make 59 | debug: IS_DEVELOPMENT, 60 | optimize: IS_PROD, 61 | } 62 | }, 63 | ], 64 | 65 | noParse: /\.elm$/, 66 | }, 67 | 68 | plugins: [ 69 | new HtmlWebpackPlugin({ 70 | template: path.join(SOURCE_DIR, 'index.html'), 71 | minify: { 72 | collapseWhitespace: true, 73 | removeComments: true 74 | } 75 | // favicon: path.resolve('./static/favicon.png') 76 | }), 77 | new webpack.DefinePlugin({ 78 | ...copyArgs([ 79 | 'NODE_ENV', 80 | 'API', 81 | ]), 82 | }) 83 | ], 84 | } 85 | 86 | const developmentConfig = { 87 | devServer: { 88 | inline: true, 89 | stats: { colors: true }, 90 | historyApiFallback: true 91 | }, 92 | } 93 | 94 | 95 | module.exports = IS_DEVELOPMENT 96 | ? { ...commonConfig, ...developmentConfig } 97 | : commonConfig; 98 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | elm-stuff/ 2 | 3 | # Created by https://www.gitignore.io/api/node,macos 4 | # Edit at https://www.gitignore.io/?templates=node,macos 5 | 6 | .vscode/settings.json 7 | 8 | .idea 9 | 10 | dist/ 11 | 12 | ### macOS ### 13 | # General 14 | .DS_Store 15 | .AppleDouble 16 | .LSOverride 17 | 18 | # Icon must end with two \r 19 | Icon 20 | 21 | # Thumbnails 22 | ._* 23 | 24 | # Files that might appear in the root of a volume 25 | .DocumentRevisions-V100 26 | .fseventsd 27 | .Spotlight-V100 28 | .TemporaryItems 29 | .Trashes 30 | .VolumeIcon.icns 31 | .com.apple.timemachine.donotpresent 32 | 33 | # Directories potentially created on remote AFP share 34 | .AppleDB 35 | .AppleDesktop 36 | Network Trash Folder 37 | Temporary Items 38 | .apdisk 39 | 40 | ### Node ### 41 | # Logs 42 | logs 43 | *.log 44 | npm-debug.log* 45 | yarn-debug.log* 46 | yarn-error.log* 47 | 48 | # Runtime data 49 | pids 50 | *.pid 51 | *.seed 52 | *.pid.lock 53 | 54 | # Directory for instrumented libs generated by jscoverage/JSCover 55 | lib-cov 56 | 57 | # Coverage directory used by tools like istanbul 58 | coverage 59 | 60 | # nyc test coverage 61 | .nyc_output 62 | 63 | # Grunt intermediate storage (https://gruntjs.com/creating-plugins#storing-task-files) 64 | .grunt 65 | 66 | # Bower dependency directory (https://bower.io/) 67 | bower_components 68 | 69 | # node-waf configuration 70 | .lock-wscript 71 | 72 | # Compiled binary addons (https://nodejs.org/api/addons.html) 73 | build/Release 74 | 75 | # Dependency directories 76 | node_modules/ 77 | jspm_packages/ 78 | 79 | # TypeScript v1 declaration files 80 | typings/ 81 | 82 | # Optional npm cache directory 83 | .npm 84 | 85 | # Optional eslint cache 86 | .eslintcache 87 | 88 | # Optional REPL history 89 | .node_repl_history 90 | 91 | # Output of 'npm pack' 92 | *.tgz 93 | 94 | # Yarn Integrity file 95 | .yarn-integrity 96 | 97 | # dotenv environment variables file 98 | .env 99 | .env.test 100 | 101 | # parcel-bundler cache (https://parceljs.org/) 102 | .cache 103 | 104 | # next.js build output 105 | .next 106 | 107 | # nuxt.js build output 108 | .nuxt 109 | 110 | # vuepress build output 111 | .vuepress/dist 112 | 113 | # Serverless directories 114 | .serverless/ 115 | 116 | # FuseBox cache 117 | .fusebox/ 118 | 119 | # DynamoDB Local files 120 | .dynamodb/ 121 | 122 | # End of https://www.gitignore.io/api/node,macos 123 | -------------------------------------------------------------------------------- /src/elm/Routes/Dash.elm: -------------------------------------------------------------------------------- 1 | module Routes.Dash exposing 2 | ( Model 3 | , Msg 4 | , initModel 5 | , update 6 | , view 7 | ) 8 | 9 | import Dict 10 | import Html exposing (..) 11 | import Html.Attributes exposing (..) 12 | import RemoteData 13 | import SharedState exposing (PrivateState, SharedStateUpdate(..), SiteDict) 14 | import UI.Link as Link 15 | import UI.Loader as Loader 16 | import UI.Nav as ResponsiveNav exposing (withVnav) 17 | import UI.Toast as Toast 18 | 19 | 20 | 21 | -- MODEL 22 | 23 | 24 | type alias Model = 25 | { toasts : Toast.ToastState 26 | , navbar : ResponsiveNav.NavState 27 | } 28 | 29 | 30 | type Msg 31 | = ToastMsg Toast.ToastMsg 32 | | ResponsiveNavMsg ResponsiveNav.Msg 33 | 34 | 35 | initModel : Model 36 | initModel = 37 | { toasts = Toast.init 38 | , navbar = ResponsiveNav.init 39 | } 40 | 41 | 42 | update : PrivateState -> Msg -> Model -> ( Model, Cmd Msg, SharedStateUpdate ) 43 | update _ msg model = 44 | case msg of 45 | -- this gets triggered __some__time__ 46 | -- after a toast gets added to the stack 47 | -- via `addToast` 48 | ToastMsg subMsg -> 49 | let 50 | ( m, cmd ) = 51 | model 52 | |> Toast.update ToastMsg subMsg 53 | in 54 | ( m 55 | , cmd 56 | , NoUpdate 57 | ) 58 | 59 | ResponsiveNavMsg subMsg -> 60 | ResponsiveNav.update subMsg model 61 | 62 | 63 | viewDash : SiteDict -> Html Msg 64 | viewDash sites = 65 | let 66 | registerSiteLink = 67 | Link.link Link.RegisterSite "registering" 68 | |> Link.toHtml 69 | 70 | content = 71 | if Dict.isEmpty sites then 72 | [ text "hmm... it's awefully quite around here ... start by " 73 | , registerSiteLink 74 | , text " your site!" 75 | ] 76 | 77 | else 78 | [ text "look at you go!" ] 79 | in 80 | div [] content 81 | 82 | 83 | type alias Title = 84 | String 85 | 86 | 87 | view : PrivateState -> Model -> ( Title, Html Msg ) 88 | view state model = 89 | let 90 | welcomeHeader = 91 | h1 [] [ text "Welcome!" ] 92 | 93 | content = 94 | case state.sites of 95 | RemoteData.NotAsked -> 96 | Loader.donut 97 | 98 | RemoteData.Loading -> 99 | Loader.donut 100 | 101 | RemoteData.Success sites -> 102 | viewDash sites 103 | 104 | RemoteData.Failure _ -> 105 | div [] [ text "woopsies!" ] 106 | 107 | viewWithNav = 108 | withVnav state model ResponsiveNavMsg 109 | 110 | html = 111 | viewWithNav 112 | (div [ class "my-5 mx-8" ] 113 | [ welcomeHeader 114 | , content 115 | , Toast.view ToastMsg model.toasts 116 | ] 117 | ) 118 | in 119 | ( "Admin Panel", html ) 120 | -------------------------------------------------------------------------------- /src/elm/SharedState.elm: -------------------------------------------------------------------------------- 1 | module SharedState exposing 2 | ( PrivateState 3 | , PublicState 4 | , SharedState(..) 5 | , SharedStateUpdate(..) 6 | , SiteDict 7 | , init 8 | , toDict 9 | , toPrivate 10 | , update 11 | ) 12 | 13 | import Api exposing (Api) 14 | import Api.Deserialize as Input 15 | import Browser.Navigation 16 | import Dict exposing (Dict) 17 | import RemoteData exposing (WebData) 18 | 19 | 20 | type alias UUID = 21 | String 22 | 23 | 24 | type alias SiteDict = 25 | Dict UUID Input.Site 26 | 27 | 28 | toDict : Input.Sites -> SiteDict 29 | toDict = 30 | List.foldl (\site -> Dict.insert site.id site) Dict.empty 31 | 32 | 33 | type SharedStateUpdate 34 | = NoUpdate 35 | | SetAdmin Input.AdminWithToken 36 | | UpdateSites SiteDict 37 | | InsertSite Input.Site 38 | | LogOut PublicState 39 | 40 | 41 | type alias BaseState a = 42 | { a 43 | | navKey : Browser.Navigation.Key 44 | , api : Api 45 | } 46 | 47 | 48 | type alias PublicState = 49 | BaseState {} 50 | 51 | 52 | type alias PrivateState = 53 | BaseState 54 | { admin : Input.AdminWithToken 55 | , sites : WebData SiteDict 56 | } 57 | 58 | 59 | type SharedState 60 | = Public PublicState 61 | | Private PrivateState 62 | 63 | 64 | toPrivate : Input.AdminWithToken -> PublicState -> PrivateState 65 | toPrivate admin publicState = 66 | { navKey = publicState.navKey 67 | , api = publicState.api 68 | , admin = admin 69 | , sites = RemoteData.NotAsked 70 | } 71 | 72 | 73 | init : Browser.Navigation.Key -> Api -> PublicState 74 | init key api = 75 | { navKey = key 76 | , api = api 77 | } 78 | 79 | 80 | update : SharedStateUpdate -> SharedState -> SharedState 81 | update updateMsg state = 82 | case updateMsg of 83 | -- called when user logs in 84 | SetAdmin admin -> 85 | case state of 86 | Public { navKey, api } -> 87 | Private 88 | { navKey = navKey 89 | , api = api 90 | , admin = admin 91 | , sites = RemoteData.NotAsked 92 | } 93 | 94 | Private _ -> 95 | state 96 | 97 | UpdateSites sites -> 98 | case state of 99 | Public _ -> 100 | state 101 | 102 | Private privateState -> 103 | Private 104 | { privateState 105 | | sites = RemoteData.Success sites 106 | } 107 | 108 | InsertSite site -> 109 | case state of 110 | Public _ -> 111 | state 112 | 113 | Private privateState -> 114 | let 115 | sites = 116 | case privateState.sites of 117 | RemoteData.Success sites_ -> 118 | sites_ 119 | 120 | _ -> 121 | Dict.empty 122 | in 123 | Private 124 | { privateState 125 | | sites = RemoteData.Success <| Dict.insert site.id site sites 126 | } 127 | 128 | LogOut publicState -> 129 | Public publicState 130 | 131 | NoUpdate -> 132 | state 133 | -------------------------------------------------------------------------------- /src/elm/UI/Icons.elm: -------------------------------------------------------------------------------- 1 | module UI.Icons exposing 2 | ( cog 3 | , hamburger 4 | , logo 5 | , rightCaret 6 | , x 7 | ) 8 | 9 | import Html exposing (Html) 10 | import Svg exposing (..) 11 | import Svg.Attributes exposing (..) 12 | 13 | 14 | logo : String -> Html msg 15 | logo width_ = 16 | svg 17 | [ version "1.1" 18 | , width width_ 19 | , viewBox "0 0 142.0155029296875 131.010986328125" 20 | ] 21 | [ g [] 22 | [ svg 23 | [ width "142.0155029296875" 24 | , height "131.010986328125" 25 | , viewBox "28.88103485107422 34.11328887939453 142.0155029296875 131.010986328125" 26 | ] 27 | [ g [] [ Svg.path [ d "M109.63 36.08c4.115 1.547 11.475 6.681 11.3 22.42-.333 30.35-4.893 43.653-21.648 60.353-6.323 6.3-24.225 13.765-39.662 10.346-43.273-9.582-34.589-54.357-12.185-57.9 17.631-2.788 24.256-7.629 31.154-16.251C92.428 37.751 94.022 30.211 109.63 36.08z", fill "#fa544b" ] [], Svg.path [ d "M159.638 49.875c-4.876-1.625-25.013-2.308-40.113 8.1C90.407 78.062 75.611 95.761 62.3 122.034c-4.606 9.09-9.983 21.491-2.029 32.626 4.018 5.626 16.725 9.157 20.893 9.643 48.215 5.625 68.255-18.922 60.5-34.714l-1.989-4.052c-7.629-13.582-.687-24.969 4.442-30.826 16.862-19.252 41.388-36.211 15.521-44.836z", fill "#b7b7b7" ] [], Svg.path [ d "M62.3 122.034q-1.733 3.42-3.248 7.02c.2.045.373.1.57.145 15.437 3.419 33.339-4.044 39.662-10.346 16.755-16.7 21.315-30 21.648-60.353.006-.485-.017-.928-.026-1.393-.46.292-.928.562-1.38.873C90.407 78.062 75.611 95.761 62.3 122.034z", fill "#504d49" ] [] ] ] 28 | ] 29 | ] 30 | 31 | 32 | rightCaret : Html msg 33 | rightCaret = 34 | svg 35 | [ class "fill-current text-teal-500 h-6 inline-block" 36 | , viewBox "0 0 20 20" 37 | ] 38 | [ Svg.path [ d "M11.611 10.049l-4.76-4.873a.783.783 0 011.117-1.093l5.306 5.433a.78.78 0 01-.012 1.105L7.83 15.928a.784.784 0 01-1.106-.013.78.78 0 01.012-1.104l4.875-4.762z" ] [] ] 39 | 40 | 41 | x : Html msg 42 | x = 43 | svg 44 | [ class "fill-current h-8" 45 | , viewBox "0 0 20 20" 46 | ] 47 | [ Svg.path [ d "M15.898 4.045a.698.698 0 00-.986 0l-4.71 4.711-4.709-4.711a.698.698 0 00-.986.986l4.709 4.711-4.71 4.711a.698.698 0 00.985.986l4.711-4.711 4.71 4.711a.695.695 0 00.494.203.694.694 0 00.492-1.189l-4.711-4.711 4.711-4.711a.694.694 0 000-.986z" ] [] ] 48 | 49 | 50 | hamburger : Html msg 51 | hamburger = 52 | svg 53 | [ class "fill-current h-4" 54 | , viewBox "0 0 20 20" 55 | ] 56 | [ Svg.path [ d "M0 3h20v2H0V3zm0 6h20v2H0V9zm0 6h20v2H0v-2z" ] [] ] 57 | 58 | 59 | cog : Html msg 60 | cog = 61 | svg 62 | [ class "fill-current h-8 inline-block" 63 | , viewBox "0 0 24 24" 64 | ] 65 | [ Svg.path 66 | [ fill "#fa544b" 67 | , d "M11.701 16.7a5.002 5.002 0 1 1 0-10.003 5.002 5.002 0 0 1 0 10.004m8.368-3.117a1.995 1.995 0 0 1-1.346-1.885c0-.876.563-1.613 1.345-1.885a.48.48 0 0 0 .315-.574 8.947 8.947 0 0 0-.836-1.993.477.477 0 0 0-.598-.195 2.04 2.04 0 0 1-1.29.08 1.988 1.988 0 0 1-1.404-1.395 2.04 2.04 0 0 1 .076-1.297.478.478 0 0 0-.196-.597 8.98 8.98 0 0 0-1.975-.826.479.479 0 0 0-.574.314 1.995 1.995 0 0 1-1.885 1.346 1.994 1.994 0 0 1-1.884-1.345.482.482 0 0 0-.575-.315c-.708.2-1.379.485-2.004.842a.47.47 0 0 0-.198.582A2.002 2.002 0 0 1 4.445 7.06a.478.478 0 0 0-.595.196 8.946 8.946 0 0 0-.833 1.994.48.48 0 0 0 .308.572 1.995 1.995 0 0 1 1.323 1.877c0 .867-.552 1.599-1.324 1.877a.479.479 0 0 0-.308.57 8.99 8.99 0 0 0 .723 1.79.477.477 0 0 0 .624.194c.595-.273 1.343-.264 2.104.238.117.077.225.185.302.3.527.8.512 1.58.198 2.188a.473.473 0 0 0 .168.628 8.946 8.946 0 0 0 2.11.897.474.474 0 0 0 .57-.313 1.995 1.995 0 0 1 1.886-1.353c.878 0 1.618.567 1.887 1.353a.475.475 0 0 0 .57.313 8.964 8.964 0 0 0 2.084-.883.473.473 0 0 0 .167-.631c-.318-.608-.337-1.393.191-2.195.077-.116.185-.225.302-.302.772-.511 1.527-.513 2.125-.23a.477.477 0 0 0 .628-.19 8.925 8.925 0 0 0 .728-1.793.478.478 0 0 0-.314-.573" 68 | , fillRule "evenodd" 69 | ] 70 | [] 71 | ] 72 | -------------------------------------------------------------------------------- /src/elm/UI/Nav.elm: -------------------------------------------------------------------------------- 1 | {-- 2 | Horizontal Nav 3 | --} 4 | 5 | 6 | module UI.Nav exposing 7 | ( Msg 8 | , NavState 9 | , init 10 | , update 11 | , withHnav 12 | , withVnav 13 | ) 14 | 15 | import Ant.Button as Btn exposing (button) 16 | import Ant.Typography.Text as Text 17 | import Browser.Navigation as Nav 18 | import Dict 19 | import Html exposing (Html, a, div, header, nav) 20 | import Html.Attributes exposing (class) 21 | import Html.Events exposing (onClick) 22 | import RemoteData 23 | import SharedState exposing (PrivateState, SharedStateUpdate) 24 | import UI.Icons exposing (hamburger, logo, x) 25 | import UI.Link as Link 26 | import UI.Loader as Loader 27 | import Utils as Utils 28 | 29 | 30 | type alias NavState = 31 | { responsiveNavVisible : Bool 32 | , siteSummaryVisible : Bool 33 | } 34 | 35 | 36 | type alias WithNavbar a = 37 | { a 38 | | navbar : NavState 39 | } 40 | 41 | 42 | type Msg 43 | = LogOut PrivateState 44 | | ToggleResponsiveNavbar 45 | | RegisterNewSite PrivateState 46 | | GoToHome PrivateState 47 | 48 | 49 | init : NavState 50 | init = 51 | { responsiveNavVisible = True 52 | , siteSummaryVisible = False 53 | } 54 | 55 | 56 | update : Msg -> WithNavbar a -> ( WithNavbar a, Cmd msg, SharedStateUpdate ) 57 | update msg ({ navbar } as parentModel) = 58 | case msg of 59 | ToggleResponsiveNavbar -> 60 | ( { parentModel 61 | | navbar = 62 | { navbar 63 | | responsiveNavVisible = not navbar.responsiveNavVisible 64 | } 65 | } 66 | , Cmd.none 67 | , SharedState.NoUpdate 68 | ) 69 | 70 | GoToHome state -> 71 | ( parentModel 72 | , Link.toHref Link.Home |> Nav.pushUrl state.navKey 73 | , SharedState.NoUpdate 74 | ) 75 | 76 | RegisterNewSite state -> 77 | ( parentModel 78 | , Link.toHref Link.RegisterSite |> Nav.pushUrl state.navKey 79 | , SharedState.NoUpdate 80 | ) 81 | 82 | LogOut privateState -> 83 | let 84 | ( logOutCmd, sharedStateUpdate ) = 85 | Utils.logout privateState 86 | in 87 | ( parentModel 88 | , Cmd.batch [ logOutCmd, Nav.pushUrl privateState.navKey "/" ] 89 | , sharedStateUpdate 90 | ) 91 | 92 | 93 | hnav : List (Html msg) -> Html msg 94 | hnav children = 95 | header [ class "w-auto h-20 pt-6 pb-2 px-4 flex justify-between" ] 96 | [ logo "45" 97 | , nav [] children 98 | ] 99 | 100 | 101 | withVnav : PrivateState -> { a | navbar : NavState } -> (Msg -> msg) -> Html msg -> Html msg 102 | withVnav state { navbar } tagger pageContent = 103 | let 104 | loading = 105 | div [ class "loading-container" ] [ Loader.donut ] 106 | 107 | siteNav = 108 | case state.sites of 109 | RemoteData.Success sites -> 110 | Dict.values sites 111 | |> List.map 112 | (\site -> 113 | div [] 114 | [ Text.text site.hostname 115 | |> Text.withType (Text.Link (Link.toHref <| Link.Site site.id) Text.Self) 116 | |> Text.toHtml 117 | ] 118 | ) 119 | |> div [] 120 | 121 | _ -> 122 | loading 123 | 124 | navTopContents = 125 | [ Html.button [ onClick (tagger <| GoToHome state) ] 126 | [ logo "40" 127 | ] 128 | , siteNav 129 | ] 130 | 131 | navBottomContents = 132 | [ button "Log Out" 133 | |> Btn.onClick (tagger <| LogOut state) 134 | |> Btn.toHtml 135 | , button 136 | "New site" 137 | |> Btn.onClick (tagger <| RegisterNewSite state) 138 | |> Btn.toHtml 139 | ] 140 | 141 | navContent = 142 | div [ class "font-bold flex flex-col items-center h-full" ] 143 | [ div [ class "flex flex-col justify-between h-full" ] 144 | [ div [] navTopContents 145 | , div [] navBottomContents 146 | ] 147 | ] 148 | 149 | regularNav = 150 | header 151 | [ class "hidden bg-gray-200 h-full w-48 p-5 md:block" 152 | ] 153 | [ navContent ] 154 | 155 | closeIcon = 156 | div [ onClick (tagger ToggleResponsiveNavbar) ] 157 | [ x ] 158 | 159 | responsiveNav = 160 | if navbar.responsiveNavVisible then 161 | header 162 | [ class "bg-gray-100 fixed h-full w-2/3 p-5 md:hidden" 163 | ] 164 | [ closeIcon, navContent ] 165 | 166 | else 167 | div 168 | [ class "m-5 flex justify-between md:hidden" 169 | , onClick (tagger ToggleResponsiveNavbar) 170 | ] 171 | [ hamburger ] 172 | in 173 | div [ class "h-full w-full md:flex" ] 174 | [ responsiveNav 175 | , regularNav 176 | , pageContent 177 | ] 178 | 179 | 180 | withHnav : List (Html msg) -> List (Html msg) -> Html msg 181 | withHnav items content = 182 | div [ class "h-full w-full" ] 183 | [ hnav items 184 | , div [ class "w-full mx-4 md:mx-auto text-center" ] 185 | content 186 | ] 187 | -------------------------------------------------------------------------------- /src/elm/Routes/Home.elm: -------------------------------------------------------------------------------- 1 | module Routes.Home exposing 2 | ( Model 3 | , Msg 4 | , initModel 5 | , update 6 | , view 7 | ) 8 | 9 | import Ant.Button as Btn 10 | import Ant.Form.View as FV 11 | import Ant.Layout as Layout 12 | import Ant.Typography as T 13 | import Html exposing (..) 14 | import Html.Attributes exposing (..) 15 | import Html.Events exposing (onClick) 16 | import Routes.Home.Forms as Forms exposing (..) 17 | import SharedState exposing (SharedState(..), SharedStateUpdate) 18 | import Utils 19 | 20 | 21 | 22 | -- MSG 23 | 24 | 25 | type Msg 26 | = LogInFormChanged LogInFormModel 27 | | SignUpFormChanged SignUpFormModel 28 | | ActiveFormToggled 29 | | LogIn String String 30 | | SignUp String String String String 31 | | FormSubmitted FormSubmittedResult 32 | 33 | 34 | type ActiveForm 35 | = LogInActive 36 | | SignUpActive 37 | 38 | 39 | type alias Model = 40 | { logInForm : LogInFormModel 41 | , signUpForm : SignUpFormModel 42 | , activeForm : ActiveForm 43 | } 44 | 45 | 46 | initModel : Model 47 | initModel = 48 | { logInForm = initialLogInFormModel 49 | , signUpForm = initialSignUpFormModel 50 | , activeForm = SignUpActive 51 | } 52 | 53 | 54 | 55 | -- UPDATE 56 | 57 | 58 | {-| Does no-ops for Cmd and ShareStateUpdate 59 | -} 60 | simpleUpdate : Model -> ( Model, Cmd Msg, SharedStateUpdate ) 61 | simpleUpdate newModel = 62 | ( newModel, Cmd.none, SharedState.NoUpdate ) 63 | 64 | 65 | update : SharedState -> Msg -> Model -> ( Model, Cmd Msg, SharedStateUpdate ) 66 | update sharedState msg model = 67 | case msg of 68 | LogInFormChanged newFormState -> 69 | simpleUpdate { model | logInForm = newFormState } 70 | 71 | SignUpFormChanged newFormState -> 72 | simpleUpdate { model | signUpForm = newFormState } 73 | 74 | ActiveFormToggled -> 75 | let 76 | newActiveForm = 77 | case model.activeForm of 78 | LogInActive -> 79 | SignUpActive 80 | 81 | SignUpActive -> 82 | LogInActive 83 | in 84 | simpleUpdate { model | activeForm = newActiveForm } 85 | 86 | LogIn username password -> 87 | let 88 | api = 89 | Utils.getApi sharedState 90 | 91 | ( newFormModel, cmd ) = 92 | Forms.handleSubmitLogin 93 | api 94 | FormSubmitted 95 | model.logInForm 96 | { username = username 97 | , password = password 98 | } 99 | in 100 | ( { model | logInForm = newFormModel } 101 | , cmd 102 | , SharedState.NoUpdate 103 | ) 104 | 105 | SignUp username email password passwordConfirm -> 106 | let 107 | api = 108 | Utils.getApi sharedState 109 | 110 | ( newFormModel, cmd ) = 111 | Forms.handleSubmitSignup 112 | api 113 | FormSubmitted 114 | model.signUpForm 115 | { username = username 116 | , password = password 117 | , email = email 118 | , passwordConfirm = passwordConfirm 119 | } 120 | in 121 | ( { model | signUpForm = newFormModel } 122 | , cmd 123 | , SharedState.NoUpdate 124 | ) 125 | 126 | FormSubmitted submissionResult -> 127 | let 128 | ( cmd, sharedStateUpdate ) = 129 | Forms.handleFormSubmitted submissionResult sharedState 130 | in 131 | ( model, cmd, sharedStateUpdate ) 132 | 133 | 134 | 135 | -- View 136 | 137 | 138 | type alias Title = 139 | String 140 | 141 | 142 | view : SharedState -> Model -> ( Title, Html Msg ) 143 | view _ model = 144 | let 145 | logInForm = 146 | FV.toHtml 147 | { onChange = LogInFormChanged 148 | , action = "Log In" 149 | , loading = "loading ..." 150 | , validation = FV.ValidateOnSubmit 151 | } 152 | (Forms.logInForm LogIn) 153 | model.logInForm 154 | 155 | signUpForm = 156 | FV.toHtml 157 | { onChange = SignUpFormChanged 158 | , action = "Sign Up" 159 | , loading = "loading ..." 160 | , validation = FV.ValidateOnSubmit 161 | } 162 | (Forms.signUpForm SignUp) 163 | model.signUpForm 164 | 165 | activeForm = 166 | case model.activeForm of 167 | SignUpActive -> 168 | signUpForm 169 | 170 | LogInActive -> 171 | logInForm 172 | 173 | headerContent = 174 | div [] [ text "logo placeholder" ] 175 | 176 | toggleActiveFormButton = 177 | let 178 | buttonLabel = 179 | case model.activeForm of 180 | SignUpActive -> 181 | "or log in" 182 | 183 | LogInActive -> 184 | "or sign up" 185 | in 186 | Btn.button buttonLabel 187 | |> Btn.onClick ActiveFormToggled 188 | |> Btn.withType Btn.Link 189 | |> Btn.toHtml 190 | 191 | heading = 192 | let 193 | headingContent = 194 | case model.activeForm of 195 | SignUpActive -> 196 | "Sign Up To ParlezVous" 197 | 198 | LogInActive -> 199 | "Log In To ParlezVous" 200 | in 201 | T.title headingContent 202 | |> T.level T.H2 203 | |> T.toHtml 204 | 205 | mainContent = 206 | div [] 207 | [ heading 208 | , activeForm 209 | , toggleActiveFormButton 210 | ] 211 | 212 | layoutContent = 213 | Layout.layout2 214 | (Layout.header headerContent) 215 | (Layout.content mainContent) 216 | in 217 | ( "Home", Layout.toHtml layoutContent ) 218 | -------------------------------------------------------------------------------- /src/elm/Routes/RegisterSite.elm: -------------------------------------------------------------------------------- 1 | module Routes.RegisterSite exposing 2 | ( Model 3 | , Msg 4 | , initModel 5 | , update 6 | , view 7 | ) 8 | 9 | import Ant.Form as Form exposing (Form) 10 | import Ant.Form.View as FV 11 | import Api 12 | import Api.Deserialize as Input 13 | import Api.Output as Output 14 | import Browser.Navigation as Nav 15 | import Html exposing (..) 16 | import Html.Attributes exposing (class) 17 | import Http 18 | import SharedState exposing (PrivateState, SharedStateUpdate(..)) 19 | import UI.Link exposing (externalLink) 20 | import UI.Nav as ResponsiveNav exposing (withVnav) 21 | import UI.Toast as Toast 22 | import Url exposing (Url) 23 | 24 | 25 | type alias FormValues = 26 | { domain : String 27 | } 28 | 29 | 30 | type alias Model = 31 | { registerSiteForm : FV.Model FormValues 32 | , toasts : Toast.ToastState 33 | , navbar : ResponsiveNav.NavState 34 | } 35 | 36 | 37 | type Msg 38 | = FormChanged (FV.Model FormValues) 39 | | RegisterSite Url 40 | | FormSubmitted (Result Http.Error Input.Site) 41 | | ToastMsg Toast.ToastMsg 42 | | ResponsiveNavMsg ResponsiveNav.Msg 43 | 44 | 45 | initModel : Model 46 | initModel = 47 | let 48 | formModel = 49 | FV.idle 50 | { domain = "" 51 | } 52 | in 53 | { registerSiteForm = formModel 54 | , toasts = Toast.init 55 | , navbar = ResponsiveNav.init 56 | } 57 | 58 | 59 | addToast : String -> ( Model, Cmd Msg ) -> ( Model, Cmd Msg ) 60 | addToast = 61 | Toast.addToast ToastMsg 62 | 63 | 64 | form : Form FormValues Msg 65 | form = 66 | let 67 | domainInputField = 68 | Form.inputField 69 | { parser = 70 | \rawInput -> 71 | let 72 | withProtocol = 73 | "https://" ++ rawInput 74 | in 75 | case Url.fromString withProtocol of 76 | Nothing -> 77 | Err "Invalid URL" 78 | 79 | Just url -> 80 | -- Naive check to see if the URL is a FQDN 81 | if String.contains "." url.host then 82 | Ok url 83 | 84 | else 85 | Err "The Url must be a fully qualified domain name" 86 | , value = .domain 87 | , update = \value values -> { values | domain = value } 88 | , error = always Nothing 89 | , attributes = 90 | { label = "Domain Name" 91 | , placeholder = "example.com" 92 | } 93 | } 94 | in 95 | Form.succeed RegisterSite 96 | |> Form.append domainInputField 97 | 98 | 99 | update : PrivateState -> Msg -> Model -> ( Model, Cmd Msg, SharedStateUpdate ) 100 | update state msg model = 101 | case msg of 102 | FormChanged newForm -> 103 | ( { model 104 | | registerSiteForm = newForm 105 | } 106 | , Cmd.none 107 | , NoUpdate 108 | ) 109 | 110 | RegisterSite url -> 111 | let 112 | data = 113 | Output.RegisterSite url.host 114 | 115 | ( _, token ) = 116 | state.admin 117 | 118 | { registerSite } = 119 | Api.getApiClient state.api 120 | in 121 | ( model 122 | , registerSite token FormSubmitted data 123 | , NoUpdate 124 | ) 125 | 126 | FormSubmitted result -> 127 | case result of 128 | Ok site -> 129 | ( model 130 | , UI.Link.toHref (UI.Link.Site site.id) |> Nav.pushUrl state.navKey 131 | , SharedState.InsertSite site 132 | ) 133 | 134 | Err e -> 135 | let 136 | ( newModel, cmd ) = 137 | case e of 138 | Http.BadStatus statusCode -> 139 | if statusCode == 400 then 140 | ( model, Cmd.none ) 141 | |> addToast "Make sure you enter a Fully Qualified Domain Name!" 142 | 143 | else if statusCode == 409 then 144 | ( model, Cmd.none ) 145 | |> addToast "This Site is already registered!" 146 | 147 | else 148 | ( model, Cmd.none ) 149 | |> addToast "Something went wrong" 150 | 151 | _ -> 152 | ( model, Cmd.none ) 153 | |> addToast "Something went wrong" 154 | in 155 | ( newModel, cmd, NoUpdate ) 156 | 157 | ToastMsg subMsg -> 158 | let 159 | ( m, cmd ) = 160 | model 161 | |> Toast.update ToastMsg subMsg 162 | in 163 | ( m 164 | , cmd 165 | , NoUpdate 166 | ) 167 | 168 | ResponsiveNavMsg subMsg -> 169 | ResponsiveNav.update subMsg model 170 | 171 | 172 | type alias Title = 173 | String 174 | 175 | 176 | view : PrivateState -> Model -> ( Title, Html Msg ) 177 | view state model = 178 | let 179 | viewWithNav = 180 | withVnav state model ResponsiveNavMsg 181 | 182 | domainInputForm = 183 | FV.toHtml 184 | { onChange = FormChanged 185 | , action = "Submit" 186 | , loading = "loading ..." 187 | , validation = FV.ValidateOnSubmit 188 | } 189 | form 190 | model.registerSiteForm 191 | 192 | content = 193 | div [] 194 | [ h1 [] [ text "Register a domain" ] 195 | , text "Ensure that the domain you enter is a " 196 | , externalLink "https://en.wikipedia.org/wiki/Fully_qualified_domain_name" "fully-qualified domain name" 197 | , domainInputForm 198 | ] 199 | 200 | html = 201 | viewWithNav 202 | (div [ class "my-5 mx-8" ] 203 | [ content 204 | , Toast.view ToastMsg model.toasts 205 | ] 206 | ) 207 | in 208 | ( "Register Site", html ) 209 | -------------------------------------------------------------------------------- /src/elm/Main.elm: -------------------------------------------------------------------------------- 1 | module Main exposing (main) 2 | 3 | import Ant.Css 4 | import Api exposing (Api) 5 | import Api.Deserialize as Input 6 | import Browser 7 | import Browser.Navigation as Nav 8 | import Html exposing (..) 9 | import Html.Attributes exposing (..) 10 | import Http 11 | import Router 12 | import SharedState exposing (SharedState(..)) 13 | import Url 14 | 15 | 16 | type alias NotReadyData = 17 | { navKey : Nav.Key 18 | , api : Api 19 | } 20 | 21 | 22 | type alias AppData = 23 | { state : SharedState 24 | , router : Router.Model 25 | } 26 | 27 | 28 | type FailureCode 29 | = E_101 30 | 31 | 32 | 33 | -- | E_102 34 | -- | E_103 35 | -- | etc ... 36 | 37 | 38 | type alias FailureCodes = 39 | { flagApiIsInvalidUrl : FailureCode 40 | } 41 | 42 | 43 | failureCodes : FailureCodes 44 | failureCodes = 45 | { flagApiIsInvalidUrl = E_101 46 | } 47 | 48 | 49 | failureCodeToString : FailureCode -> String 50 | failureCodeToString _ = 51 | "e-101" 52 | 53 | 54 | type Model 55 | = Ready AppData 56 | -- represents a pending state for the application 57 | -- such as when we're checking with the server if a session token is valid 58 | | NotReady NotReadyData 59 | -- initialization failed 60 | | FailedInit FailureCode Nav.Key 61 | 62 | 63 | type Msg 64 | = UrlChanged Url.Url 65 | | LinkClicked Browser.UrlRequest 66 | | SessionVerified Input.SessionToken Url.Url Api (Result Http.Error Input.Admin) 67 | | RouterMsg Router.Msg 68 | 69 | 70 | main : Program Flags Model Msg 71 | main = 72 | Browser.application 73 | { init = init 74 | , update = update 75 | , view = view 76 | , subscriptions = \_ -> Sub.none 77 | , onUrlChange = UrlChanged 78 | , onUrlRequest = LinkClicked 79 | } 80 | 81 | 82 | type alias Flags = 83 | { token : Maybe Input.SessionToken 84 | , api : String 85 | } 86 | 87 | 88 | 89 | -- type alias Model = Int 90 | 91 | 92 | init : Flags -> Url.Url -> Nav.Key -> ( Model, Cmd Msg ) 93 | init flags browserUrl key = 94 | let 95 | maybeApiUrl = 96 | Url.fromString flags.api 97 | in 98 | case ( maybeApiUrl, flags.token ) of 99 | -- The incoming Url from flags must be a valid URL, otherwise we can't make any API Requests 100 | ( Nothing, _ ) -> 101 | ( FailedInit failureCodes.flagApiIsInvalidUrl key, Cmd.none ) 102 | 103 | ( Just apiUrl, Just token ) -> 104 | let 105 | api = 106 | Api.apiFactory apiUrl 107 | 108 | { getAdminSession } = 109 | Api.getApiClient api 110 | in 111 | ( NotReady <| NotReadyData key api 112 | , getAdminSession token <| SessionVerified token browserUrl api 113 | ) 114 | 115 | ( Just apiUrl, Nothing ) -> 116 | let 117 | api = 118 | Api.apiFactory apiUrl 119 | 120 | sharedState = 121 | Public <| SharedState.init key api 122 | 123 | ( routerModel, routerCmd ) = 124 | Router.init browserUrl sharedState 125 | 126 | appData = 127 | { state = sharedState 128 | , router = routerModel 129 | } 130 | in 131 | ( Ready appData 132 | , Cmd.map RouterMsg routerCmd 133 | ) 134 | 135 | 136 | 137 | -- UPDATE 138 | 139 | 140 | getNavKey : Model -> Nav.Key 141 | getNavKey model = 142 | case model of 143 | Ready { state } -> 144 | case state of 145 | Public { navKey } -> 146 | navKey 147 | 148 | Private { navKey } -> 149 | navKey 150 | 151 | NotReady { navKey } -> 152 | navKey 153 | 154 | FailedInit _ navKey -> 155 | navKey 156 | 157 | 158 | update : Msg -> Model -> ( Model, Cmd Msg ) 159 | update msg model = 160 | case msg of 161 | RouterMsg routerMsg -> 162 | updateRouter routerMsg model 163 | 164 | UrlChanged url -> 165 | updateRouter (Router.UrlChange url) model 166 | 167 | LinkClicked urlRequest -> 168 | let 169 | _ = 170 | Debug.log "url request: " urlRequest 171 | in 172 | case urlRequest of 173 | Browser.Internal url -> 174 | ( model 175 | , Nav.pushUrl (getNavKey model) <| Url.toString url 176 | ) 177 | 178 | -- leaving the app! 179 | Browser.External urlStr -> 180 | ( model 181 | , Nav.load urlStr 182 | ) 183 | 184 | SessionVerified token browserUrl api result -> 185 | let 186 | publicState = 187 | SharedState.init key api 188 | 189 | sharedState = 190 | case result of 191 | Ok admin -> 192 | Private <| 193 | SharedState.toPrivate ( admin, token ) publicState 194 | 195 | _ -> 196 | Public publicState 197 | 198 | key = 199 | getNavKey model 200 | 201 | ( routerModel, routerCmd ) = 202 | Router.init browserUrl sharedState 203 | in 204 | ( Ready 205 | { state = sharedState 206 | , router = routerModel 207 | } 208 | , Cmd.map RouterMsg routerCmd 209 | ) 210 | 211 | 212 | updateRouter : Router.Msg -> Model -> ( Model, Cmd Msg ) 213 | updateRouter routerMsg model = 214 | case model of 215 | Ready appData -> 216 | let 217 | ( nextRouterModel, routerCmd, sharedStateUpdate ) = 218 | Router.update appData.state routerMsg appData.router 219 | 220 | nextSharedState = 221 | SharedState.update sharedStateUpdate appData.state 222 | in 223 | ( Ready 224 | { appData 225 | | state = nextSharedState 226 | , router = nextRouterModel 227 | } 228 | , Cmd.map RouterMsg routerCmd 229 | ) 230 | 231 | _ -> 232 | ( model, Cmd.none ) 233 | 234 | 235 | 236 | -- VIEW 237 | 238 | 239 | view : Model -> Browser.Document Msg 240 | view model = 241 | case model of 242 | Ready { state, router } -> 243 | let 244 | { title, body } = 245 | Router.view state router 246 | in 247 | { title = title 248 | , body = [ Ant.Css.defaultStyles, Html.map RouterMsg body ] 249 | } 250 | 251 | NotReady _ -> 252 | { title = "Loading ..." 253 | , body = [ div [] [ text "Loading ..." ] ] 254 | } 255 | 256 | FailedInit failureCode _ -> 257 | { title = "woops!" 258 | , body = 259 | [ div [] 260 | [ text "Something went wrong :(" 261 | , br [] [] 262 | , text <| "Error code: " ++ failureCodeToString failureCode 263 | ] 264 | ] 265 | } 266 | -------------------------------------------------------------------------------- /src/elm/Api.elm: -------------------------------------------------------------------------------- 1 | module Api exposing 2 | ( Api 3 | , ApiClient 4 | , apiFactory 5 | , getApiClient 6 | , makeCommonRequestUrl 7 | ) 8 | 9 | import Api.Deserialize as Input 10 | import Api.Output as Output 11 | import Http 12 | import Json.Decode as D 13 | import Json.Encode as E 14 | import RemoteData 15 | import Url exposing (Url) 16 | import Url.Builder 17 | 18 | 19 | type Api 20 | = Api Url 21 | 22 | 23 | type alias ApiClient msg = 24 | { adminSignUp : AdminSignUp msg 25 | , adminLogIn : AdminLogIn msg 26 | , getAdminSession : GetAdminSession msg 27 | , getManySites : GetManySites msg 28 | , getSite : GetSite msg 29 | , registerSite : RegisterSite msg 30 | } 31 | 32 | 33 | type alias ToMsg a msg = 34 | Result Http.Error a -> msg 35 | 36 | 37 | type alias RequestTemplate = 38 | { method : String 39 | , headers : List Http.Header 40 | , tracker : Maybe String 41 | , timeout : Maybe Float 42 | } 43 | 44 | 45 | type Method 46 | = Get 47 | | Post 48 | 49 | 50 | apiFactory : Url -> Api 51 | apiFactory = 52 | Api 53 | 54 | 55 | getApiClient : Api -> ApiClient msg 56 | getApiClient api = 57 | { adminLogIn = adminSignin api 58 | , adminSignUp = adminSignup api 59 | , getAdminSession = getAdminSession api 60 | , getManySites = getSites api 61 | , getSite = getSingleSite api 62 | , registerSite = registerSite api 63 | } 64 | 65 | 66 | urlToString : Url -> String 67 | urlToString url = 68 | let 69 | raw = 70 | Url.toString url 71 | in 72 | if String.endsWith "/" raw then 73 | String.dropRight 1 raw 74 | 75 | else 76 | raw 77 | 78 | 79 | makeCommonRequestUrl : Api -> String -> String 80 | makeCommonRequestUrl (Api url) routePath = 81 | let 82 | commonPathRoot = 83 | "common" 84 | 85 | routePathList = 86 | String.split "/" routePath 87 | 88 | pathComponents = 89 | commonPathRoot :: routePathList 90 | in 91 | Url.Builder.crossOrigin 92 | (urlToString url) 93 | pathComponents 94 | [] 95 | 96 | 97 | makeAdminRequestUrl : Api -> String -> String 98 | makeAdminRequestUrl (Api url) routePath = 99 | let 100 | adminPathRoot = 101 | "admins" 102 | 103 | routePathList = 104 | String.split "/" routePath 105 | 106 | pathComponents = 107 | adminPathRoot :: routePathList 108 | in 109 | Url.Builder.crossOrigin 110 | (urlToString url) 111 | pathComponents 112 | [] 113 | 114 | 115 | secureRequestFactory : Method -> Input.SessionToken -> RequestTemplate 116 | secureRequestFactory method token = 117 | let 118 | rawMethod = 119 | case method of 120 | Get -> 121 | "GET" 122 | 123 | Post -> 124 | "POST" 125 | in 126 | { method = rawMethod 127 | , headers = [ Http.header "Authorization" token ] 128 | , tracker = Nothing 129 | , timeout = Nothing 130 | } 131 | 132 | 133 | securePost : 134 | String 135 | -> Input.SessionToken 136 | -> Http.Body 137 | -> Http.Expect msg 138 | -> Cmd msg 139 | securePost endpoint token body expect = 140 | let 141 | extraInfo = 142 | secureRequestFactory Post token 143 | in 144 | Http.request 145 | { method = extraInfo.method 146 | , url = endpoint 147 | , headers = extraInfo.headers 148 | , body = body 149 | , expect = expect 150 | , timeout = extraInfo.timeout 151 | , tracker = extraInfo.tracker 152 | } 153 | 154 | 155 | secureGet : 156 | String 157 | -> Input.SessionToken 158 | -> Http.Expect msg 159 | -> Cmd msg 160 | secureGet endpoint token expect = 161 | let 162 | extraInfo = 163 | secureRequestFactory Get token 164 | in 165 | Http.request 166 | { method = extraInfo.method 167 | , url = endpoint 168 | , headers = extraInfo.headers 169 | , body = Http.emptyBody 170 | , expect = expect 171 | , timeout = extraInfo.timeout 172 | , tracker = extraInfo.tracker 173 | } 174 | 175 | 176 | 177 | -- Api Requests 178 | 179 | 180 | type alias AdminSignUp msg = 181 | ToMsg Input.AdminWithToken msg -> Output.Signup -> Cmd msg 182 | 183 | 184 | adminSignup : Api -> AdminSignUp msg 185 | adminSignup api toMsg data = 186 | let 187 | signupJson = 188 | E.object 189 | [ ( "username", E.string data.username ) 190 | , ( "email", E.string data.email ) 191 | , ( "password", E.string data.password ) 192 | , ( "passwordConfirm", E.string data.passwordConfirm ) 193 | ] 194 | 195 | body = 196 | Http.jsonBody signupJson 197 | 198 | expect = 199 | Http.expectJson toMsg Input.adminAndTokenDecoder 200 | in 201 | Http.post 202 | { body = body 203 | , expect = expect 204 | , url = makeCommonRequestUrl api "signup" 205 | } 206 | 207 | 208 | type alias AdminLogIn msg = 209 | ToMsg Input.AdminWithToken msg -> Output.Signin -> Cmd msg 210 | 211 | 212 | adminSignin : Api -> AdminLogIn msg 213 | adminSignin api toMsg data = 214 | let 215 | signinJson = 216 | E.object 217 | [ ( "usernameOrEmail", E.string data.username ) 218 | , ( "password", E.string data.password ) 219 | ] 220 | 221 | body = 222 | Http.jsonBody signinJson 223 | 224 | expect = 225 | Http.expectJson toMsg Input.adminAndTokenDecoder 226 | in 227 | Http.post 228 | { body = body 229 | , expect = expect 230 | , url = makeCommonRequestUrl api "signin" 231 | } 232 | 233 | 234 | 235 | -- Private Routes 236 | 237 | 238 | type alias GetAdminSession msg = 239 | Input.SessionToken -> ToMsg Input.Admin msg -> Cmd msg 240 | 241 | 242 | getAdminSession : Api -> GetAdminSession msg 243 | getAdminSession api token toMsg = 244 | let 245 | expect = 246 | Http.expectJson toMsg (D.field "data" Input.adminDecoder) 247 | in 248 | secureGet 249 | (makeCommonRequestUrl api "profile") 250 | token 251 | expect 252 | 253 | 254 | type alias GetManySites msg = 255 | Input.SessionToken -> (RemoteData.WebData Input.Sites -> msg) -> Cmd msg 256 | 257 | 258 | getSites : Api -> GetManySites msg 259 | getSites api token toMsg = 260 | let 261 | sitesDecoder = 262 | D.field "data" (D.list Input.siteDecoder) 263 | 264 | expect = 265 | Http.expectJson (RemoteData.fromResult >> toMsg) sitesDecoder 266 | in 267 | secureGet 268 | (makeAdminRequestUrl api "sites") 269 | token 270 | expect 271 | 272 | 273 | type alias GetSite msg = 274 | Input.SessionToken -> String -> (RemoteData.WebData Input.Site -> msg) -> Cmd msg 275 | 276 | 277 | getSingleSite : Api -> GetSite msg 278 | getSingleSite api token siteId toMsg = 279 | let 280 | siteDecoder = 281 | D.field "data" Input.siteDecoder 282 | 283 | expect = 284 | Http.expectJson (RemoteData.fromResult >> toMsg) siteDecoder 285 | in 286 | secureGet 287 | (makeAdminRequestUrl api "sites/" ++ siteId) 288 | token 289 | expect 290 | 291 | 292 | type alias RegisterSite msg = 293 | Input.SessionToken -> ToMsg Input.Site msg -> Output.RegisterSite -> Cmd msg 294 | 295 | 296 | registerSite : Api -> RegisterSite msg 297 | registerSite api token toMsg data = 298 | let 299 | siteJson = 300 | E.object 301 | [ ( "hostname", E.string data.hostname ) 302 | ] 303 | 304 | body = 305 | Http.jsonBody siteJson 306 | 307 | expect = 308 | Http.expectJson 309 | toMsg 310 | (D.field "data" Input.siteDecoder) 311 | in 312 | securePost 313 | (makeAdminRequestUrl api "sites/register") 314 | token 315 | body 316 | expect 317 | -------------------------------------------------------------------------------- /src/elm/Routes/Home/Forms.elm: -------------------------------------------------------------------------------- 1 | module Routes.Home.Forms exposing 2 | ( FormSubmittedResult 3 | , LogInFormModel 4 | , LogInFormValues 5 | , SignUpFormModel 6 | , SignUpFormValues 7 | , handleFormSubmitted 8 | , handleSubmitLogin 9 | , handleSubmitSignup 10 | , initialLogInFormModel 11 | , initialSignUpFormModel 12 | , logInForm 13 | , signUpForm 14 | ) 15 | 16 | import Ant.Form as Form exposing (Form) 17 | import Ant.Form.PasswordField exposing (PasswordFieldValue) 18 | import Ant.Form.View as FV 19 | import Api exposing (Api) 20 | import Api.Deserialize exposing (AdminWithToken) 21 | import Browser.Navigation as Nav 22 | import Email 23 | import Http 24 | import SharedState exposing (SharedState, SharedStateUpdate) 25 | import Utils 26 | 27 | 28 | type alias FormSubmittedResult = 29 | Result Http.Error AdminWithToken 30 | 31 | 32 | type alias SignUpFormModel = 33 | FV.Model SignUpFormValues 34 | 35 | 36 | type alias SignUpFormValues = 37 | { username : String 38 | , email : String 39 | , password : PasswordFieldValue 40 | , passwordConfirm : PasswordFieldValue 41 | } 42 | 43 | 44 | type alias LogInFormModel = 45 | FV.Model LogInFormValues 46 | 47 | 48 | type alias LogInFormValues = 49 | { username : String 50 | , password : PasswordFieldValue 51 | } 52 | 53 | 54 | {-| Initiates API request to server 55 | -} 56 | handleSubmitLogin : 57 | Api 58 | -> (FormSubmittedResult -> msg) 59 | -> LogInFormModel 60 | -> { username : String, password : String } --> 'a' ??? 61 | -> ( LogInFormModel, Cmd msg ) 62 | handleSubmitLogin api tagger formModel data = 63 | let 64 | { adminLogIn } = 65 | Api.getApiClient api 66 | 67 | cmd = 68 | adminLogIn tagger data 69 | in 70 | ( { formModel | state = FV.Loading } 71 | , cmd 72 | ) 73 | 74 | 75 | handleSubmitSignup : 76 | Api 77 | -> (FormSubmittedResult -> msg) 78 | -> SignUpFormModel 79 | -> { email : String, username : String, password : String, passwordConfirm : String } 80 | -> ( SignUpFormModel, Cmd msg ) 81 | handleSubmitSignup api tagger formModel data = 82 | let 83 | { adminSignUp } = 84 | Api.getApiClient api 85 | 86 | cmd = 87 | adminSignUp tagger data 88 | in 89 | ( { formModel | state = FV.Loading } 90 | , cmd 91 | ) 92 | 93 | 94 | {-| Handles server response 95 | -} 96 | handleFormSubmitted : FormSubmittedResult -> SharedState -> ( Cmd msg, SharedStateUpdate ) 97 | handleFormSubmitted result state = 98 | case result of 99 | Ok adminWithToken -> 100 | let 101 | navKey = 102 | Utils.getNavKey state 103 | 104 | commands = 105 | Cmd.batch 106 | [ Utils.setToken <| Tuple.second adminWithToken 107 | , Nav.pushUrl navKey "/dash" 108 | ] 109 | in 110 | ( commands 111 | , SharedState.SetAdmin adminWithToken 112 | ) 113 | 114 | Err e -> 115 | let 116 | _ = 117 | Debug.log "[handleFormSubmitted] Error - " e 118 | in 119 | ( Cmd.none 120 | , SharedState.NoUpdate 121 | ) 122 | 123 | 124 | 125 | {- 126 | updateFormState : Model -> FV.State -> Model 127 | updateFormState ({ loginForm } as model) newState = 128 | { model 129 | | loginForm = { loginForm | state = newState } 130 | } 131 | -} 132 | 133 | 134 | initialSignUpFormModel : SignUpFormModel 135 | initialSignUpFormModel = 136 | let 137 | initialPasswordFieldValue = 138 | { value = "" 139 | , textVisible = False 140 | } 141 | in 142 | FV.idle 143 | { username = "" 144 | , email = "" 145 | , password = initialPasswordFieldValue 146 | , passwordConfirm = initialPasswordFieldValue 147 | } 148 | 149 | 150 | signUpForm : 151 | (String -> String -> String -> String -> msg) 152 | -> Form SignUpFormValues msg 153 | signUpForm tagger = 154 | let 155 | usernameField = 156 | Form.inputField 157 | { parser = Ok 158 | , value = .username 159 | , update = \username values -> { values | username = username } 160 | , error = always Nothing 161 | , attributes = 162 | { label = "Username" 163 | , placeholder = "" 164 | } 165 | } 166 | 167 | emailField = 168 | Form.inputField 169 | { parser = 170 | \rawEmail -> 171 | if Email.isValid rawEmail then 172 | Ok rawEmail 173 | 174 | else 175 | Err "Invalid email" 176 | , value = .email 177 | , update = \email values -> { values | email = email } 178 | , error = always Nothing 179 | , attributes = 180 | { label = "Email" 181 | , placeholder = "" 182 | } 183 | } 184 | 185 | passwordField = 186 | Form.passwordField 187 | { parser = \{ value } -> Ok value 188 | , value = .password 189 | , update = \pswrd values -> { values | password = pswrd } 190 | , error = always Nothing 191 | , attributes = 192 | { label = "Password" 193 | , placeholder = "" 194 | } 195 | } 196 | 197 | passwordConfirmField = 198 | Form.meta 199 | (\values -> 200 | Form.passwordField 201 | { parser = 202 | \{ value } -> 203 | if value == values.password.value then 204 | Ok value 205 | 206 | else 207 | Err "The passwords do not match" 208 | , value = .passwordConfirm 209 | , update = \pswrd vals -> { vals | passwordConfirm = pswrd } 210 | , error = always Nothing 211 | , attributes = 212 | { label = "Confirm Password" 213 | , placeholder = "" 214 | } 215 | } 216 | ) 217 | in 218 | Form.succeed tagger 219 | |> Form.append usernameField 220 | |> Form.append emailField 221 | |> Form.append passwordField 222 | |> Form.append passwordConfirmField 223 | 224 | 225 | initialLogInFormModel : LogInFormModel 226 | initialLogInFormModel = 227 | FV.idle 228 | { username = "" 229 | , password = { value = "", textVisible = False } 230 | } 231 | 232 | 233 | logInForm : (String -> String -> msg) -> Form LogInFormValues msg 234 | logInForm tagger = 235 | let 236 | usernameField = 237 | Form.inputField 238 | { parser = Ok 239 | , value = .username 240 | , update = \username values -> { values | username = username } 241 | , error = always Nothing 242 | , attributes = 243 | { label = "Username" 244 | , placeholder = "" 245 | } 246 | } 247 | 248 | passwordField = 249 | Form.passwordField 250 | { parser = \{ value } -> Ok value 251 | , value = .password 252 | , update = \pswrd values -> { values | password = pswrd } 253 | , error = always Nothing 254 | , attributes = 255 | { label = "Password" 256 | , placeholder = "" 257 | } 258 | } 259 | in 260 | Form.succeed tagger 261 | |> Form.append usernameField 262 | |> Form.append passwordField 263 | -------------------------------------------------------------------------------- /src/elm/Router.elm: -------------------------------------------------------------------------------- 1 | module Router exposing 2 | ( Model 3 | , Msg(..) 4 | , init 5 | , update 6 | , view 7 | ) 8 | 9 | import Api 10 | import Api.Deserialize as Input 11 | import Browser.Navigation as Nav 12 | import Html as Html exposing (..) 13 | import Html.Attributes exposing (class) 14 | import RemoteData exposing (WebData) 15 | import Routes.Dash as Dash 16 | import Routes.Home as Home 17 | import Routes.RegisterSite as RegisterSite 18 | import Routes.Site as Site 19 | import SharedState exposing (PrivateState, SharedState(..), SharedStateUpdate) 20 | import UI.Toast as Toast 21 | import Url exposing (Url) 22 | import Url.Parser as Parser exposing ((), Parser, oneOf, string) 23 | 24 | 25 | type Route 26 | = Home Home.Model 27 | | Dash Dash.Model 28 | | Site Site.Model 29 | | RegisterSite RegisterSite.Model 30 | | NotFound 31 | 32 | 33 | type alias Model = 34 | { activeRoute : Route 35 | , toasts : Toast.ToastState 36 | } 37 | 38 | 39 | type Msg 40 | = UrlChange Url 41 | | ToastMsg Toast.ToastMsg 42 | | SitesResponse (WebData Input.Sites) 43 | | HomeMsg Home.Msg 44 | | DashMsg Dash.Msg 45 | | SiteMsg Site.Msg 46 | | RegisterSiteMsg RegisterSite.Msg 47 | 48 | 49 | parser : Parser (Route -> a) a 50 | parser = 51 | oneOf 52 | [ Parser.map (Home Home.initModel) Parser.top 53 | , Parser.map (Dash Dash.initModel) (Parser.s "dash") 54 | , Parser.map (Site << Site.initModel) (Parser.s "sites" string) 55 | 56 | --, Parser.map (Login Login.initModel) (Parser.s "login") 57 | --, Parser.map (Signup Signup.initModel) (Parser.s "signup") 58 | , Parser.map (RegisterSite RegisterSite.initModel) (Parser.s "register-site") 59 | ] 60 | 61 | 62 | fromUrl : Url -> Route 63 | fromUrl = 64 | Maybe.withDefault NotFound << Parser.parse parser 65 | 66 | 67 | init : Url -> SharedState -> ( Model, Cmd Msg ) 68 | init url sharedState = 69 | let 70 | route = 71 | fromUrl url 72 | in 73 | ( { activeRoute = route, toasts = Toast.init } 74 | , transitionTrigger route sharedState 75 | ) 76 | 77 | 78 | {-| trigger commands on page transitions 79 | and initializations 80 | -} 81 | transitionTrigger : Route -> SharedState -> Cmd Msg 82 | transitionTrigger route state = 83 | case ( route, state ) of 84 | -- redirect guests on private routes 85 | ( Dash _, Public { navKey } ) -> 86 | Nav.pushUrl navKey "/" 87 | 88 | ( Site _, Public { navKey } ) -> 89 | Nav.pushUrl navKey "/" 90 | 91 | ( RegisterSite _, Public { navKey } ) -> 92 | Nav.pushUrl navKey "/" 93 | 94 | -- redirect authed users away from public routes 95 | ( Home _, Private { navKey } ) -> 96 | Nav.pushUrl navKey "/dash" 97 | 98 | ( _, Private { admin, api, sites } ) -> 99 | let 100 | ( _, token ) = 101 | admin 102 | 103 | { getManySites } = 104 | Api.getApiClient api 105 | in 106 | case sites of 107 | RemoteData.NotAsked -> 108 | getManySites token SitesResponse 109 | 110 | _ -> 111 | Cmd.none 112 | 113 | _ -> 114 | Cmd.none 115 | 116 | 117 | update : SharedState -> Msg -> Model -> ( Model, Cmd Msg, SharedStateUpdate ) 118 | update state msg model = 119 | case ( msg, model.activeRoute ) of 120 | ( UrlChange url, _ ) -> 121 | let 122 | newRoute = 123 | fromUrl url 124 | 125 | transitionTriggerMsg = 126 | transitionTrigger newRoute state 127 | in 128 | ( { model | activeRoute = newRoute } 129 | , transitionTriggerMsg 130 | , SharedState.NoUpdate 131 | ) 132 | 133 | ( SitesResponse response, _ ) -> 134 | case response of 135 | RemoteData.Success sites -> 136 | ( model 137 | , Cmd.none 138 | , SharedState.UpdateSites <| SharedState.toDict sites 139 | ) 140 | 141 | RemoteData.Failure _ -> 142 | let 143 | ( newModel, cmd ) = 144 | ( model, Cmd.none ) 145 | |> Toast.addToast ToastMsg "Something went wrong" 146 | in 147 | ( newModel, cmd, SharedState.NoUpdate ) 148 | 149 | _ -> 150 | ( model, Cmd.none, SharedState.NoUpdate ) 151 | 152 | ( HomeMsg homeMsg, Home homeModel ) -> 153 | let 154 | ( newHomeModel, homeCmd, sharedStateUpdate ) = 155 | Home.update state homeMsg homeModel 156 | in 157 | ( { model | activeRoute = Home newHomeModel } 158 | , Cmd.map HomeMsg homeCmd 159 | , sharedStateUpdate 160 | ) 161 | 162 | ( DashMsg dashMsg, Dash dashModel ) -> 163 | case state of 164 | Private privateState -> 165 | let 166 | ( newDashModel, dashCmd, sharedStateUpdate ) = 167 | Dash.update privateState dashMsg dashModel 168 | in 169 | ( { model | activeRoute = Dash newDashModel } 170 | , Cmd.map DashMsg dashCmd 171 | , sharedStateUpdate 172 | ) 173 | 174 | Public _ -> 175 | ( { model | activeRoute = Dash dashModel } 176 | , Cmd.none 177 | , SharedState.NoUpdate 178 | ) 179 | 180 | ( SiteMsg siteMsg, Site siteModel ) -> 181 | case state of 182 | Private privateState -> 183 | let 184 | ( newSiteModel, siteCmd, sharedStateUpdate ) = 185 | Site.update privateState siteMsg siteModel 186 | in 187 | ( { model | activeRoute = Site newSiteModel } 188 | , Cmd.map SiteMsg siteCmd 189 | , sharedStateUpdate 190 | ) 191 | 192 | Public _ -> 193 | ( model 194 | , Cmd.none 195 | , SharedState.NoUpdate 196 | ) 197 | 198 | ( RegisterSiteMsg registerSiteMsg, RegisterSite registersiteModel ) -> 199 | case state of 200 | Private privateState -> 201 | let 202 | ( newRegisterSiteModel, registerSiteCmd, sharedStateUpdate ) = 203 | RegisterSite.update privateState registerSiteMsg registersiteModel 204 | in 205 | ( { model | activeRoute = RegisterSite newRegisterSiteModel } 206 | , Cmd.map RegisterSiteMsg registerSiteCmd 207 | , sharedStateUpdate 208 | ) 209 | 210 | Public _ -> 211 | ( model 212 | , Cmd.none 213 | , SharedState.NoUpdate 214 | ) 215 | 216 | -- Placeholder for now 217 | _ -> 218 | ( model, Cmd.none, SharedState.NoUpdate ) 219 | 220 | 221 | 222 | {--Generalize the following 223 | Site.view privateState siteModel 224 | |> Tuple.mapSecond (Html.map <| SiteMsg siteModel) 225 | |> Tuple.mapSecond (Html.map toMsg) 226 | --} 227 | 228 | 229 | type alias Title = 230 | String 231 | 232 | 233 | type alias AppView = 234 | { title : Title 235 | , body : Html Msg 236 | } 237 | 238 | 239 | viewPrivatePage : 240 | SharedState 241 | -> (PrivateState -> m -> ( Title, Html msg )) 242 | -> m 243 | -> (msg -> Msg) 244 | -> ( Title, Html Msg ) 245 | viewPrivatePage sharedState routeView model tagger = 246 | let 247 | redirectPage = 248 | ( "Redirecting ..." 249 | , div [] [ text "Redirecting ..." ] 250 | ) 251 | in 252 | case sharedState of 253 | Public _ -> 254 | redirectPage 255 | 256 | Private privateState -> 257 | routeView privateState model 258 | |> Tuple.mapSecond (Html.map tagger) 259 | 260 | 261 | view : SharedState -> Model -> AppView 262 | view sharedState model = 263 | let 264 | toastView = 265 | Toast.view ToastMsg model.toasts 266 | 267 | viewPrivateRoute = 268 | viewPrivatePage sharedState 269 | 270 | ( title, html ) = 271 | case model.activeRoute of 272 | Home homeModel -> 273 | Home.view sharedState homeModel 274 | |> Tuple.mapSecond (Html.map HomeMsg) 275 | 276 | Dash dashModel -> 277 | viewPrivateRoute 278 | Dash.view 279 | dashModel 280 | DashMsg 281 | 282 | Site siteModel -> 283 | viewPrivateRoute 284 | Site.view 285 | siteModel 286 | SiteMsg 287 | 288 | RegisterSite registerSiteModel -> 289 | viewPrivateRoute 290 | RegisterSite.view 291 | registerSiteModel 292 | RegisterSiteMsg 293 | 294 | NotFound -> 295 | ( "Woops!", div [] [ text "404 Not Found" ] ) 296 | in 297 | { title = title ++ " | Parlez-Vous " 298 | , body = div [ class "bg-gray-100" ] [ html, toastView ] 299 | } 300 | --------------------------------------------------------------------------------