Initial commit (wip)

.gitignore

@@ -0,0 +1,17 @@
+.attr-cache
+.cabal-sandbox
+*.hi
+*.o
+cabal.project.local
+cabal.sandbox.config
+ctags
+dist-newstyle/
+dist/
+ghcid-output.txt
+profile/
+result
+result-*
+tags
+TAGS
+static.out
+/.env

.obelisk/impl/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

.obelisk/impl/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "obelisk",
+  "branch": "develop",
+  "private": false,
+  "rev": "56f2ea5ec06d59e08e6111c374dd0142200860ee",
+  "sha256": "1x07av9ayiaj3b3qknk3rd7k6gv19s27a4iz0wmi75xdg788r6x0"
+}

.obelisk/impl/thunk.nix

@@ -0,0 +1,12 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import (builtins.fetchTarball {
+  url = "https://github.com/NixOS/nixpkgs/archive/3aad50c30c826430b0270fcf8264c8c41b005403.tar.gz";
+  sha256 = "0xwqsf08sywd23x0xvw4c4ghq0l28w2ki22h0bdn766i16z9q2gr";
+}) {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

README.md

@@ -0,0 +1 @@
+# WIP

backend/backend.cabal

@@ -0,0 +1,74 @@
+name: backend
+version: 0.1
+cabal-version: >= 1.10
+build-type: Simple
+
+library
+  hs-source-dirs: src
+  if impl(ghcjs)
+    buildable: False
+  build-depends: base
+               , common
+               , frontend
+               , obelisk-backend
+               , obelisk-route
+               , process
+               , async
+               , which
+               , monad-logger
+               , logging-effect
+               , prettyprinter
+               , string-interpolate
+               , containers
+               , text
+               , witherable
+               , snap-core
+               , websockets-snap
+               , websockets
+               , some
+               , directory
+               , reflex-gadt-api
+               , aeson
+               , bytestring
+               , base64-bytestring
+               , case-insensitive
+               , lens
+               , uuid
+               , http-client
+               , http-conduit
+               , temporary
+               , stm
+               , monad-loops
+               , mtl
+               , transformers
+               , time
+               , time-compat
+               , transformers
+               , obelisk-executable-config-lookup
+
+  default-extensions:
+    OverloadedStrings
+    LambdaCase
+    GADTs
+    ScopedTypeVariables
+    OverloadedStrings
+    FlexibleContexts
+    QuasiQuotes
+    DeriveGeneric
+
+  exposed-modules:
+    Backend
+    
+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits
+
+executable backend
+  main-is: main.hs
+  hs-source-dirs: src-bin
+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -threaded -fno-show-valid-hole-fits
+  if impl(ghcjs)
+    buildable: False
+  build-depends: base
+               , backend
+               , common
+               , frontend
+               , obelisk-backend

backend/src-bin/main.hs

@@ -0,0 +1,6 @@
+import Backend
+import Frontend
+import Obelisk.Backend
+
+main :: IO ()
+main = runBackend backend frontend

backend/src/Backend.hs

@@ -0,0 +1,20 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE PartialTypeSignatures #-}
+{-# OPTIONS_GHC -Wno-unused-do-bind #-}
+{-# LANGUAGE TupleSections #-}
+{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
+
+module Backend
+
+(backend)
+
+where
+
+import Obelisk.Backend
+
+backend :: Backend BackendRoute FrontendRoute
+backend = Backend
+  { _backend_run = \serve -> do
+      pure ()
+  , _backend_routeEncoder = fullRouteEncoder
+  }

backend/static

@@ -0,0 +1 @@
+../static

cabal.project

@@ -0,0 +1,3 @@
+optional-packages:
+  *
+write-ghc-environment-files: never

common/common.cabal

@@ -0,0 +1,39 @@
+name: common
+version: 0.1
+cabal-version: >= 1.10
+build-type: Simple
+
+library
+  hs-source-dirs: src
+  build-depends: base
+               , obelisk-route
+               , mtl
+               , text
+               , reflex-gadt-api
+               , aeson
+               , aeson-gadt-th
+               , constraints-extras
+               , containers
+               , time
+               , lens
+
+  default-extensions:
+    DeriveGeneric
+    FlexibleContexts
+    FlexibleInstances
+    GADTs
+    LambdaCase
+    MultiParamTypeClasses
+    OverloadedStrings
+    QuantifiedConstraints
+    RecursiveDo
+    ScopedTypeVariables
+    TypeFamilies
+    UndecidableInstances
+
+  exposed-modules:
+    Common.Route
+    Common.Helpers
+    Hydra.Types
+
+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits

common/src/Common/Helpers.hs

@@ -0,0 +1,10 @@
+-- |
+
+module Common.Helpers where
+
+headMay :: [a] -> Maybe a
+headMay (a:_) = Just a
+headMay _ = Nothing
+
+seconds :: Int -> Int
+seconds = (* 1000000)

common/src/Common/Route.hs

@@ -0,0 +1,50 @@
+{-# LANGUAGE EmptyCase #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Common.Route where
+
+import Prelude hiding (id, (.))
+
+import Data.Text (Text)
+import Data.Functor.Identity
+
+import Obelisk.Route
+import Obelisk.Route.TH
+
+
+data BackendRoute :: * -> * where
+  -- | Used to handle unparseable routes.
+  BackendRoute_Missing :: BackendRoute ()
+  BackendRoute_Api :: BackendRoute ()
+  -- You can define any routes that will be handled specially by the backend here.
+  -- i.e. These do not serve the frontend, but do something different, such as serving static files.
+
+data FrontendRoute :: * -> * where
+  FrontendRoute_Home :: FrontendRoute ()
+  -- This type is used to define frontend routes, i.e. ones for which the backend will serve the frontend.
+
+fullRouteEncoder
+  :: Encoder (Either Text) Identity (R (FullRoute BackendRoute FrontendRoute)) PageName
+fullRouteEncoder = mkFullRouteEncoder
+  (FullRoute_Backend BackendRoute_Missing :/ ())
+  (\case
+      BackendRoute_Missing -> PathSegment "missing" $ unitEncoder mempty
+      BackendRoute_Api -> PathSegment "api" $ unitEncoder mempty
+  )
+  (\case
+      FrontendRoute_Home -> PathEnd $ unitEncoder mempty
+  )
+
+concat <$> mapM deriveRouteComponent
+  [ ''BackendRoute
+  , ''FrontendRoute
+  ]

common/src/Hydra/Types.hs

@@ -0,0 +1,81 @@
+-- | 
+
+module Hydra.Types where
+
+import GHC.Generics
+import Data.Aeson
+
+import Data.Map (Map)
+import qualified Data.Text as T
+import Data.Text (Text)
+import qualified Data.Map as Map
+import Numeric.Natural (Natural)
+
+-- | Cardano address
+type Address = T.Text
+
+type Lovelace = Integer
+
+type NodeId = T.Text
+
+type TxIn = T.Text
+type WholeUTXO = Map TxIn TxInInfo
+
+ada :: Num a => a -> a
+ada = (* 1000000)
+
+lovelaceToAda :: Integer -> Float
+lovelaceToAda n = fromIntegral n / 1000000
+
+filterOutFuel :: WholeUTXO -> WholeUTXO
+filterOutFuel = Map.filter (not . isFuel)
+
+filterFuel :: WholeUTXO -> WholeUTXO
+filterFuel = Map.filter (isFuel)
+
+isFuel :: TxInInfo -> Bool
+isFuel txinfo = datumhash txinfo == Just fuelMarkerDatumHash
+
+data TxInInfo = TxInInfo
+  { address :: Address
+  , datumhash :: Maybe T.Text
+  , value :: Map T.Text Int
+  }
+  deriving (Eq, Show, Generic)
+
+instance FromJSON TxInInfo
+instance ToJSON TxInInfo
+
+fuelMarkerDatumHash :: T.Text
+fuelMarkerDatumHash = "a654fb60d21c1fed48db2c320aa6df9737ec0204c0ba53b9b94a09fb40e757f3"
+
+
+-- REVIEW(SN): This is also used in hydra-tui
+
+-- Below various types copied/adapted from hydra-poc code
+
+data Host = Host
+  { hostname :: Text
+  , port :: PortNumber
+  }
+  deriving (Ord, Generic, Eq, Show)
+
+instance ToJSON Host
+instance FromJSON Host
+
+
+newtype Party = Party {vkey :: T.Text}
+  deriving (Eq, Show, Read, Generic)
+
+instance ToJSON Party
+instance FromJSON Party
+
+type UTxOType tx = Value
+type Snapshot tx = Value
+type MultiSignature x = Value
+type PostChainTx tx = Value 
+type PostTxError tx = Value
+type ValidationError = Value
+type SnapshotNumber = Natural
+type PortNumber = Natural
+type ContestationPeriod = Natural

config/common/route

@@ -0,0 +1 @@
+http://localhost:8002

config/readme.md

@@ -0,0 +1,9 @@
+### Config
+
+Obelisk projects should contain a config folder with the following subfolders: common, frontend, and backend.
+
+Things that should never be transmitted to the frontend belong in backend/ (e.g., email credentials)
+
+Frontend-only configuration belongs in frontend/.
+
+Shared configuration files (e.g., the route config) belong in common/

default.nix

@@ -0,0 +1,55 @@
+{ system ? builtins.currentSystem
+# , rpSetup ? import ((import ./.obelisk/impl {}).path + "/dep/reflex-platform") {}
+# , android-build ? false
+, obelisk ? import ./.obelisk/impl {
+    inherit system;
+    iosSdkVersion = "13.2";
+
+    # You must accept the Android Software Development Kit License Agreement at
+    # https://developer.android.com/studio/terms in order to build Android apps.
+    # Uncomment and set this to `true` to indicate your acceptance:
+    config.android_sdk.accept_license = true;
+
+    # In order to use Let's Encrypt for HTTPS deployments you must accept
+    # their terms of service at https://letsencrypt.org/repository/.
+    # Uncomment and set this to `true` to indicate your acceptance:
+    terms.security.acme.acceptTerms = true;
+
+    # Override reflex-platform-func in order to get access to haskellOverlaysPre
+    # for adding mobile support.
+  # reflex-platform-func = args@{...}:
+  #   import ((import ./.obelisk/impl {}).path + "/dep/reflex-platform") (args // { __useNewerCompiler = true; });
+  }
+}:
+with obelisk;
+let
+  foldExtensions = lib.foldr lib.composeExtensions (_: _: {});
+  deps = obelisk.nixpkgs.thunkSet ./dep;
+  hydra-pay = import deps.hydra-pay {};  
+
+  pkgs = obelisk.nixpkgs;
+  # cardano-libs-overlay = import ./cardano-libs.nix { inherit deps; hydra-poc = deps.hydra-poc; lib = pkgs.lib; };
+in
+project ./. ({ pkgs, ... }: let
+  haskellLib = pkgs.haskell.lib;
+
+in
+{
+  android.applicationId = "systems.obsidian.obelisk.examples.minimal";
+  android.displayName = "Obelisk Minimal Example";
+  ios.bundleIdentifier = "systems.obsidian.obelisk.examples.minimal";
+  ios.bundleName = "Obelisk Minimal Example";
+
+  overrides = foldExtensions [
+    (self: super: {
+      string-interpolate = haskellLib.doJailbreak (haskellLib.dontCheck super.string-interpolate);
+
+      backend = haskellLib.overrideCabal super.backend (drv: {
+        librarySystemDepends = (drv.librarySystemDepends or []) ++ [
+          pkgs.coreutils
+          hydra-pay.exe
+        ];
+      });
+    })
+  ];
+})

dep/aeson-gadt-th/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/aeson-gadt-th/github.json

@@ -0,0 +1,7 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "aeson-gadt-th",
+  "private": false,
+  "rev": "71a315a4873c2875ad737a3320320849bdcf8a2a",
+  "sha256": "1sjl0a0ig0xfssl4bglakk1b7sj8wqz8hwbg7k2fk10qi7z5hb50"
+}

dep/aeson-gadt-th/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/aeson/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/aeson/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "haskell",
+  "repo": "aeson",
+  "branch": "aeson-1.5",
+  "private": false,
+  "rev": "78e838df44288ac7d7ac2cd77863d2c026d86dbb",
+  "sha256": "181v1nz05jq992wgmz6ns7iwqx0c5w003hv5ki1kvc9zlg5dh3vf"
+}

dep/aeson/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/browser-extension/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/browser-extension/git.json

@@ -0,0 +1,8 @@
+{
+  "url": "ssh://git@code.obsidian.systems/lodewallet/browser-extension",
+  "rev": "ae6f9202e35ce74c630da763a95071eeb337ebc8",
+  "sha256": "0hp1a6a219j1l8jikhp7yya6c55l23rw2360q0vzifgg7fjrd8i3",
+  "private": true,
+  "fetchSubmodules": false,
+  "branch": "aa/createwindow-sim"
+}

dep/browser-extension/thunk.nix

@@ -0,0 +1,14 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = {url, rev, branch ? null, sha256 ? null, fetchSubmodules ? false, private ? false, ...}:
+  let realUrl = let firstChar = builtins.substring 0 1 url; in
+    if firstChar == "/" then /. + url
+    else if firstChar == "." then ./. + url
+    else url;
+  in if !fetchSubmodules && private then builtins.fetchGit {
+    url = realUrl; inherit rev;
+    ${if branch == null then null else "ref"} = branch;
+  } else (import <nixpkgs> {}).fetchgit {
+    url = realUrl; inherit rev sha256;
+  };
+  json = builtins.fromJSON (builtins.readFile ./git.json);
+in fetch json

dep/cardano-node/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/cardano-node/github.json

@@ -0,0 +1,7 @@
+{
+  "owner": "input-output-hk",
+  "repo": "cardano-node",
+  "private": false,
+  "rev": "ebc7be471b30e5931b35f9bbc236d21c375b91bb",
+  "sha256": "1j01m2cp2vdcl26zx9xmipr551v3b2rz9kfn9ik8byfwj1z7652r"
+}

dep/cardano-node/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/constraints-extras/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/constraints-extras/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "constraints-extras",
+  "branch": "release/0.3.2.0",
+  "private": false,
+  "rev": "42835fd9e1b4b3c4a72cd1237c04789f01c92dd0",
+  "sha256": "0z7yfxxi4jywzhlkphs8ss3hd7fll8c90bbl6nr2bj63c87jx6sw"
+}

dep/constraints-extras/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/entropy/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/entropy/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "entropy",
+  "branch": "aa/nonwindow-contexts",
+  "private": false,
+  "rev": "ddda007c44390d0ec8cad58810710864dee60ddd",
+  "sha256": "00b7cqdqbjf953r5gmwmkn2mn36zdxqwx90xih925cni94vi4vw9"
+}

dep/entropy/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/hspec-webdriver-clone/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/hspec-webdriver-clone/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "luigy",
+  "repo": "hspec-webdriver-clone",
+  "branch": "hspec-2.8",
+  "private": false,
+  "rev": "2cbe58872304d2332dfc61efaa9e0432862459d7",
+  "sha256": "1hm8cgw28v6g5xi25i3h1rmac7p4kh340qd5dx0ndjyxjl1lvb0p"
+}

dep/hspec-webdriver-clone/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/hydra-pay/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/hydra-pay/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "hydra-pay",
+  "branch": "develop",
+  "private": false,
+  "rev": "9d21eb40673da38b0e57af3ea25d41135872b405",
+  "sha256": "1pqnjq2w0njcw4iicmkm1s3d627lspg3s65dfjlc22g9lxpaxs1q"
+}

dep/hydra-pay/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/hydra-poc/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/hydra-poc/github.json

@@ -0,0 +1,7 @@
+{
+  "owner": "input-output-hk",
+  "repo": "hydra-poc",
+  "private": false,
+  "rev": "d4f242b68069765117e7c615101df17708de40a2",
+  "sha256": "0h0ymcw6h3lggvsmyxyvj5582mhmkv6d937qmz0px40gwjjcly05"
+}

dep/hydra-poc/thunk.nix

@@ -0,0 +1,12 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import (builtins.fetchTarball {
+  url = "https://github.com/NixOS/nixpkgs/archive/3aad50c30c826430b0270fcf8264c8c41b005403.tar.gz";
+  sha256 = "0xwqsf08sywd23x0xvw4c4ghq0l28w2ki22h0bdn766i16z9q2gr";
+}) {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/juicy.pixels.ghcjs/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/juicy.pixels.ghcjs/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "juicy.pixels.ghcjs",
+  "branch": "main",
+  "private": false,
+  "rev": "a1c516493c674dba64e8eadb8a65b829477f302d",
+  "sha256": "06dm7kw5p1df0j0mf2wp9yyqxxzx9lih1y3l2ym8dcl1cklrnx57"
+}

dep/juicy.pixels.ghcjs/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/qrcode/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/qrcode/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "qrcode",
+  "branch": "master",
+  "private": false,
+  "rev": "f33abef0451982ae7769b24e9031753ef2c4d826",
+  "sha256": "044bi6fnrzpzam0zyd6yijpkphjnn3z751nnxb3zz2w93wzi6nkd"
+}

dep/qrcode/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/reflex-gadt-api/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/reflex-gadt-api/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "reflex-frp",
+  "repo": "reflex-gadt-api",
+  "branch": "develop",
+  "private": false,
+  "rev": "69aca72b57a74fbf0d06a1b2ac1d247ce9aa207f",
+  "sha256": "116c6lna8pkas95lclm4halagc4f6rxv5hmf7rnl10lxqi9m48qw"
+}

dep/reflex-gadt-api/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/reflex/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/reflex/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "reflex-frp",
+  "repo": "reflex",
+  "branch": "release/0.8.2.0",
+  "private": false,
+  "rev": "823afd9424234cbe0134051f09a6710e54509cec",
+  "sha256": "1zh8v28issyh8sww9aw6y4dqd2qql25nrxxzxg9ky0vrwmhw295c"
+}

dep/reflex/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/secp256k1-haskell/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/secp256k1-haskell/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "haskoin",
+  "repo": "secp256k1-haskell",
+  "branch": "master",
+  "private": false,
+  "rev": "3df963ab6ae14ec122691a97af09a7331511a387",
+  "sha256": "1phnj7wzprrgdhji80rh16savmqq1z9q3z5yi72x8w5v42lf5f2y"
+}

dep/secp256k1-haskell/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/snap-core/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/snap-core/github.json

@@ -0,0 +1,8 @@
+{
+  "owner": "snapframework",
+  "repo": "snap-core",
+  "branch": "master",
+  "private": false,
+  "rev": "2dc0cab7d4ec48cc690898700c7e9f9db8d1d54d",
+  "sha256": "1k5gwhgf489c44mv38wawv3nwl7dxr7zrsg1112s0adbavsjdbxn"
+}

dep/snap-core/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

dep/vessel/default.nix

@@ -0,0 +1,2 @@
+# DO NOT HAND-EDIT THIS FILE
+import (import ./thunk.nix)

dep/vessel/github.json

@@ -0,0 +1,7 @@
+{
+  "owner": "obsidiansystems",
+  "repo": "vessel",
+  "private": false,
+  "rev": "03b1465abeb2dea16d32feb0963f11d0ed00f2f8",
+  "sha256": "18vyh4ds2mng9lmn435dpbf9rj3fh9z1rimk4f2s3war9j4j5wnq"
+}

dep/vessel/thunk.nix

@@ -0,0 +1,9 @@
+# DO NOT HAND-EDIT THIS FILE
+let fetch = { private ? false, fetchSubmodules ? false, owner, repo, rev, sha256, ... }:
+  if !fetchSubmodules && !private then builtins.fetchTarball {
+    url = "https://github.com/${owner}/${repo}/archive/${rev}.tar.gz"; inherit sha256;
+  } else (import <nixpkgs> {}).fetchFromGitHub {
+    inherit owner repo rev sha256 fetchSubmodules private;
+  };
+  json = builtins.fromJSON (builtins.readFile ./github.json);
+in fetch json

frontend/frontend.cabal

@@ -0,0 +1,59 @@
+name: frontend
+version: 0.1
+cabal-version: >= 1.10
+build-type: Simple
+
+library
+  hs-source-dirs: src
+  build-depends: base
+               , common
+               , obelisk-frontend
+               , obelisk-route
+               , jsaddle
+               , reflex-dom-core
+               , obelisk-executable-config-lookup
+               , obelisk-generated-static
+               , text
+               , string-interpolate
+               , containers
+               , aeson
+               , bytestring
+               , witherable
+               , transformers
+               , time
+               , lens
+               , random
+  default-extensions:
+    RecursiveDo
+    RankNTypes
+    FlexibleContexts
+    PartialTypeSignatures
+    ScopedTypeVariables
+    OverloadedStrings
+    TypeFamilies
+    RecursiveDo
+    LambdaCase
+    DeriveGeneric
+  exposed-modules:
+    Frontend
+  other-modules:
+    HydraPay.Config
+    HydraPay.Api
+  ghc-options: -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -O -fno-show-valid-hole-fits
+
+executable frontend
+  main-is: main.hs
+  hs-source-dirs: src-bin
+  build-depends: base
+               , common
+               , obelisk-frontend
+               , obelisk-route
+               , reflex-dom
+               , obelisk-generated-static
+               , frontend
+  ghc-options: -threaded -O -Wall -Wredundant-constraints -Wincomplete-uni-patterns -Wincomplete-record-updates -fno-show-valid-hole-fits
+  if impl(ghcjs)
+    ghc-options: -dedupe
+    cpp-options: -DGHCJS_BROWSER
+  if os(darwin)
+    ghc-options: -dynamic

frontend/src-bin/main.hs

@@ -0,0 +1,10 @@
+import Frontend
+import Common.Route
+import Obelisk.Frontend
+import Obelisk.Route.Frontend
+import Reflex.Dom
+
+main :: IO ()
+main = do
+  let Right validFullEncoder = checkEncoder fullRouteEncoder
+  run $ runFrontend validFullEncoder frontend

frontend/src/Frontend.hs

@@ -0,0 +1,890 @@
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE ExtendedDefaultRules #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# OPTIONS_GHC -Wno-unused-local-binds #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-type-defaults #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE RecursiveDo #-}
+
+module Frontend
+  ( frontend
+  )
+where
+
+import Prelude hiding (filter)
+
+import Hydra.Types
+import HydraPay.Api as HydraPayApi
+import Text.Read (readMaybe)
+import Text.Printf (printf)
+import System.Random
+import qualified Data.Map as Map
+import Data.Fixed
+import qualified Data.Text as T
+
+import Obelisk.Frontend
+import Obelisk.Route
+import Obelisk.Route.Frontend
+import Reflex.Dom.Core
+import Common.Route
+import Control.Lens
+import Control.Monad.Fix
+import Control.Monad.IO.Class
+-- import Common.Api as ChannelsApi
+import Control.Monad.Trans.Class
+
+import Language.Javascript.JSaddle (jsg, js, liftJSM, fromJSValUnchecked)
+import Data.Int (Int64)
+import Data.Monoid
+import Data.Witherable (catMaybes)
+import Data.Maybe (isJust)
+
+default (T.Text)
+
+-- This runs in a monad that can be run on the client or the server.
+-- To run code in a pure client or pure server context, use one of the
+-- `prerender` functions.
+frontend :: Frontend (R FrontendRoute)
+frontend = Frontend
+  { _frontend_head = do
+      el "title" $ text "Hydra Pay Payment Channel Demo"
+
+      elAttr "meta" ("name"=:"viewport" <> "content"=:"width=device-width, initial-scale=1.0, maximum-scale=1.0, user-scalable=no") blank
+      elAttr "link" ("rel" =: "preconnect" <> "href" =: "https://fonts.googleapis.com") blank
+      elAttr "link" ("rel" =: "preconnect" <> "href" =: "https://fonts.gstatic.com") blank
+      elAttr "link" ("href"=:"https://fonts.googleapis.com/css2?family=Inria+Sans:wght@300&family=Inter:wght@100;200;300;400;500;600;700;800;900&family=Krona+One&family=Rajdhani:wght@300;400;500;600;700&display=swap" <> "rel"=:"stylesheet") blank
+      elAttr "link" ("rel"=:"stylesheet" <> "href"=:"https://fonts.googleapis.com/css2?family=Material+Symbols+Rounded:opsz,wght,FILL,GRAD@48,400,0,0") blank
+      elAttr "script" ("src"=:"https://cdn.tailwindcss.com") blank
+  , _frontend_body = elAttr "div" ("class" =: "w-screen h-screen overflow-hidden flex flex-col bg-gray-100" <> "style" =: "font-family: 'Inter', sans-serif;") $ do
+      elClass "div" "flex-shrink-0 px-8 py-4 text-xl font-semibold" $ el "h1" $ text "Hydra Pay"
+      prerender_ (text "Loading Payment Channel Demo") $ elClass "div" "w-full h-full mt-10 flex-grow px-8 overflow-hidden" $ do
+        pb <- getPostBuild
+        endpoint <- liftJSM $ do
+          let
+            webSocketProtocol :: T.Text -> T.Text
+            webSocketProtocol "https:" = "wss:"
+            webSocketProtocol _ = "ws:"
+
+          wsProtocol <- fmap webSocketProtocol $ fromJSValUnchecked =<< jsg "location" ^. js "protocol"
+
+          theHostname <- fromJSValUnchecked =<< jsg "location" ^. js "hostname"
+          let thePort = "8000" -- fromJSValUnchecked =<< jsg "location" ^. js "port"
+
+          pure $ mconcat [ wsProtocol
+                       , "//"
+                       , theHostname
+                       , ":"
+                       , thePort
+                       , "/hydra/api"
+                       ]
+        rec
+          lastTagId <- foldDyn (+) 0 $ fromIntegral . length <$> sendToHydraPay
+
+          let
+            sendToHydraPay =
+              attachWith (\tid msgs -> uncurry Tagged <$> zip [tid..] msgs) (current lastTagId) sendMsg
+
+            serverMsg = fmapMaybe id $ rws ^. webSocket_recv
+
+            subscriptions = fmapMaybe (preview _PlainMsg) serverMsg
+            responses = fmapMaybe (preview _TaggedMsg) serverMsg
+
+            authResponse = fmapMaybe (preview (_AuthResult) . tagged_payload) responses
+
+          rws :: RawWebSocket t (Maybe ApiMsg) <- jsonWebSocket endpoint $ def
+            & webSocketConfig_send .~ sendToHydraPay
+
+          (_, sendMsg :: Event t [ClientMsg]) <- runEventWriterT $ elClass "div" "w-full h-full flex flex-row text-gray-700" $ do
+            -- managedDevnetReply <- requester lastTagId responses (GetIsManagedDevnet  <$ pb)
+            -- _ <- runWithReplace blank $
+            --   mapMaybe ((\case
+            --                 IsManagedDevnet x -> Just (monitorView lastTagId responses x)
+            --                 _ -> Nothing)
+            --              . tagged_payload)
+            --   managedDevnetReply
+            elClass "div" "flex-grow" $ elClass "div" "max-w-lg" $ mdo
+              (_, authenticatedE) <-
+                runEventWriterT
+                . runWithReplace (tellEvent =<< lift (authentication lastTagId responses))
+                . ffor authenticatedE $ \() -> do
+                    text "You're authenticated"
+                    blank
+              runWithReplace blank (fundCreateInit lastTagId responses <$ authenticatedE)
+              pure ()
+        pure ()
+  }
+
+
+requestPb :: (PostBuild t m, EventWriter t [ClientMsg] m, MonadHold t m) =>
+  Dynamic t Int64
+  -> Event t (Tagged ServerMsg)
+  -> ClientMsg
+  -> m (Event t ServerMsg)
+requestPb lastId serverMsg msg = do
+  pb <- getPostBuild
+  requester lastId serverMsg (msg <$ pb)
+
+
+requestPbExpected :: (PostBuild t m, EventWriter t [ClientMsg] m, MonadHold t m) =>
+  Dynamic t Int64
+  -> Event t (Tagged ServerMsg)
+  -> Getting (Data.Monoid.First b) ServerMsg b
+  -> ClientMsg
+  -> m (Event t (Maybe b))
+requestPbExpected lastId serverMsg sel msg = do
+  fmap (preview sel) <$> requestPb lastId serverMsg msg
+
+requestPbExact :: (PostBuild t m, EventWriter t [ClientMsg] m, MonadHold t m) =>
+  Dynamic t Int64
+  -> Event t (Tagged ServerMsg)
+  -> Getting (Data.Monoid.First b) ServerMsg b
+  -> ClientMsg
+  -> m (Event t b)
+requestPbExact lastId serverMsg sel msg = do
+  catMaybes <$> requestPbExpected lastId serverMsg sel msg
+
+getAddresses :: (PostBuild t m, EventWriter t [ClientMsg] m, MonadHold t m) =>
+  Dynamic t Int64
+  -> Event t (Tagged ServerMsg) -> m (Event t [Address])
+getAddresses lastId serverMsg =
+  requestPbExact lastId serverMsg _DevnetAddresses (GetDevnetAddresses 2)
+
+viewUntil :: _ => Workflow t m (Maybe a) -> m (Event t a)
+viewUntil = fmap catMaybes . workflowView
+
+doFundingTx ::
+  ( NotReady t m,
+    Adjustable t m,
+    PostBuild t m,
+    EventWriter t [ClientMsg] m,
+    MonadHold t m,
+    MonadFix m
+  ) =>
+  Dynamic t Int64 ->
+  Event t (Tagged ServerMsg) ->
+  Lovelace ->
+  TxType ->
+  Address ->
+  m (Event t Bool)
+doFundingTx lastId serverMsg amnt typ addr = viewUntil $ Workflow $ do
+  fundsTxE <- requestPbExact lastId serverMsg _FundsTx (GetAddTx typ addr amnt)
+  pure . (Nothing,) . ffor fundsTxE $ \tx -> Workflow $ do
+    submitSuccessE <- requestPbExpected lastId serverMsg _OperationSuccess (LiveDocEzSubmitTx tx addr)
+    pure . (Nothing,) . ffor submitSuccessE $ \v -> Workflow . pure $ (Just (isJust v), never)
+
+-- TODO: Use Either instead of Bool to get the errors/unexpected values reported back
+andWhen :: _ => m (Event t Bool) -> m (Event t Bool) -> m (Event t Bool)
+andWhen me mc = viewUntil . Workflow $ do
+  e <- me
+  pure . (Nothing,) . ffor e $ \case
+    False -> Workflow $ pure (Just False, never)
+    True -> Workflow $ do
+      c <- mc
+      pure . (Nothing,) . ffor c $ Workflow . pure . (, never) . Just
+
+doAllFunding ::
+  ( NotReady t m,
+    Adjustable t m,
+    PostBuild t m,
+    EventWriter t [ClientMsg] m,
+    MonadHold t m,
+    MonadFix m, _
+  ) =>
+  Dynamic t Int64 ->
+  Event t (Tagged ServerMsg) ->
+  Lovelace ->
+  [Address] ->
+  m (Event t Bool)
+doAllFunding lastId serverMsg amnt [one, two] =
+  (text "Funding Alice" >> doFundingTx lastId serverMsg amnt Funds one)
+  `andWhen` (text "Fueling Alice" >> doFundingTx lastId serverMsg amnt Fuel one)
+  `andWhen` (text "Funding Bob" >> doFundingTx lastId serverMsg amnt Funds two)
+  `andWhen` (text "Fueling Bob" >> doFundingTx lastId serverMsg amnt Fuel one)
+
+singletonWorkflow :: _ => a -> Workflow t m a
+singletonWorkflow = Workflow . pure . (,never)
+
+createAndInitHead :: _ => _ -> _ -> [_] -> m (Event t Bool)
+createAndInitHead lastId serverMsg addrs = do
+  ((True <$) <$> requestPbExact lastId serverMsg _OperationSuccess (CreateHead (HeadCreate theHeadName addrs)))
+    `andWhen`
+    ((True <$) <$> requestPbExact lastId serverMsg _OperationSuccess (InitHead (HeadInit theHeadName 3)))
+
+
+
+
+fundCreateInit :: (NotReady t m, Adjustable t m, PostBuild t m,
+   EventWriter t [ClientMsg] m, MonadHold t m, MonadFix m, _) =>
+  Dynamic t Int64 -> Event t (Tagged ServerMsg) -> m (Event t [Address])
+fundCreateInit lastId serverMsg = do
+  addrE <- getAddresses lastId serverMsg
+  viewUntil . Workflow . pure . (Nothing,) . ffor addrE $ \addrs -> Workflow $ do
+    res <- doAllFunding lastId serverMsg (ada 100) addrs
+           `andWhen` createAndInitHead lastId serverMsg addrs
+    -- TODO: This just assumes all went well, it should check for errors and abort.
+    -- (I.e. check whether res == False.)
+    pure . (Nothing,) $ Workflow (do
+                            text "Head created"
+                            pure . (,never) . Just $ addrs)
+                         <$ res
+
+
+
+        -- gotAddrs <- fmap switchDyn $ prerender (pure never) $ do
+        --   rec
+        --     jsBuild <- getPostBuild
+        --     -- FIXME: something changed here
+        --     result <- getAndDecode $ "/demo-addresses" <$ leftmost [jsBuild]
+        --                                                            --, () <$ failedToLoad]
+        --     let
+        --       -- If we failed it is likely the server just hot reloaded in development
+        --       -- and we just try again immediately
+        --       failedToLoad = fmapMaybe (preview _Nothing) result
+        --       addrsRecv = fmapMaybe (preview _Just) result
+        --   pure addrsRecv
+
+        -- rec
+        --   addrs <- holdDyn (Nothing :: Maybe [Address]) gotAddrs
+        --   nextId <- foldDyn (+) (0 :: Int) $ 1 <$ newTx
+
+        --   let
+        --     insertNewTx = (current $ Map.insert <$> nextId) <@> newTx
+
+        --   latestPopupTxs <- foldDyn ($) mempty $ mergeWith (.) $ [ insertNewTx
+        --                                                          , removeStaleTxs
+        --                                                          ]
+        --   latestTxs <- foldDyn ($) mempty $ mergeWith (.) $ [ insertNewTx
+        --                                                     ]
+        --   let
+        --     totalTxDisplayTime = 4
+        --     -- We assume the first and second index to be Bob and Alice respectively
+        --     bobAddress = ffor addrs $ join . fmap (^? ix 0)
+        --     aliceAddress = ffor addrs $ join . fmap (^? ix 1)
+
+        --     newTxPopup tx = do
+        --       transitionIn <- getPostBuild >>= delay 0.1
+        --       transitionOut <- tickLossyFromPostBuildTime totalTxDisplayTime
+        --       removeThisPopup <- tickLossyFromPostBuildTime $ totalTxDisplayTime + 2
+        --       visible <- holdDyn False $ mergeWith (&&) [True <$ transitionIn, False <$ transitionOut]
+        --       let
+        --         mkClasses b =
+        --           mconcat [ "transition pointer-events-none duration-1000 px-8 py-4 rounded-lg bg-white mb-4 drop-shadow-lg "
+        --                   , bool "opacity-0" "opacity-100" b
+        --                   ]
+        --       elDynClass "div" (mkClasses <$> visible) $ do
+        --         elClass "div" "text-xs text-gray-500 mb-2" $ text "New Transaction"
+
+        --         elClass "div" "flex flex-row justify-between items-center" $ do
+        --           elClass "div" "flex flex-col mr-16" $ do
+        --             elClass "div" "text-gray-600" $ do
+        --               text "To "
+        --               dynText $ demoTx_to <$> tx
+        --             elClass "div" "text-xl" $ do
+        --               dynText $ T.pack . printf "%.2f" . lovelaceToAda . demoTx_amount <$> tx
+        --               text "ADA"
+
+        --           elClass "div" "flex flex-row text-gray-400" $ do
+        --             elClass "div" "flex flex-col" $ do
+        --               elClass "div" "text-xs" $ text "Time"
+        --               elClass "div" "" $ do
+        --                 dynText $ showAsMs . demoTx_time <$> tx
+        --                 text "ms"
+        --       pure $ () <$ removeThisPopup
+
+        --   -- When we get a server response, go to open a channel
+        --   newTx <- appView bobAddress aliceAddress latestTxs
+
+        --   removeStaleTxs <- elClass "div" "pointer-events-none absolute top-0 right-0 p-4 h-full overflow-hidden leading-none" $ elClass "div" "flex flex-col-reverse" $ do
+        --     eventList <- listWithKey latestPopupTxs $ \txid tx -> do
+        --       removalEv <- newTxPopup tx
+        --       pure $ Map.delete txid <$ removalEv
+
+        --     pure $ switchDyn $ mergeWith (.) . Map.elems <$> eventList
+        -- subRoute_ $ \case
+        --   _ -> do
+        --     setRoute $ FrontendRoute_OpenChannel :/ () <$ gotAddrs
+        --     setRoute $ FrontendRoute_Setup :/ () <$ postBuild
+        -- setRoute $ FrontendRoute_PaymentChannel :/ () <$ newTx
+        -- pure ()
+
+data DemoTx = DemoTx
+  { demoTx_to :: T.Text
+  , demoTx_amount :: Lovelace
+  , demoTx_time :: Pico
+  }
+  deriving (Eq, Show)
+
+showAsMs :: Pico -> T.Text
+showAsMs = T.pack . printf "%.2f" . (realToFrac :: Pico -> Float) . (*1000)
+
+
+-- TODO(skylar): Use Requester from reflex
+requester :: (Reflex t, EventWriter t [ClientMsg] m, MonadHold t m) => Dynamic t Int64 -> Event t (Tagged ServerMsg) -> Event t ClientMsg -> m (Event t ServerMsg)
+requester lastTagId serverMsg clientMsg = do
+  waitingTag <- holdDyn Nothing $ current (Just <$> lastTagId) <@ clientMsg
+
+  let
+    isWhatWeAreWaitingFor (Just nid) msg@(Tagged nid' _) | nid == nid' = Just msg
+    isWhatWeAreWaitingFor _ _ = Nothing
+
+    properServerMsg = attachWithMaybe isWhatWeAreWaitingFor (current waitingTag) serverMsg
+
+  tellEvent $ pure <$> clientMsg
+  pure (tagged_payload <$> properServerMsg)
+
+
+authentication ::
+  ( PostBuild t m
+  , SetRoute t (R FrontendRoute) m
+  , SetRoute t (R FrontendRoute) m
+  , RouteToUrl (R FrontendRoute) m
+  , MonadIO (Performable m)
+  , PerformEvent t m
+  , TriggerEvent t m
+  , DomBuilder t m
+  , MonadFix m
+  , MonadHold t m
+  , EventWriter t [ClientMsg] m
+  ) => Dynamic t Int64 -> Event t (Tagged ServerMsg) -> m (Event t ())
+authentication lastTagId serverMsg = do
+    apiKeyInput <- inputElement $ def
+                   & initialAttributes .~ ("class" =: "pl-4 pr-2 py-1 bg-transparent text-right" <> "placeholder" =: "Hydra Pay API Key")
+    let
+      pressedEnter = keypress Enter apiKeyInput
+
+    authReply <- requester lastTagId serverMsg $
+      Authenticate <$> current (_inputElement_value apiKeyInput) <@ pressedEnter
+    pure . mapMaybe (\case
+                 (AuthResult True) -> Just ()
+                 _ -> Nothing)
+      $ authReply
+
+initialBalances :: _ => _ -> _ -> (_,_) -> m ()
+initialBalances lastTagId serverMsg (bobAddress, aliceAddress)= do
+      -- Page Title
+      elClass "div" "mb-2 font-semibold" $ text "Open a Payment Channel"
+      -- Divider
+      elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+      -- Balances
+      elClass "div" "text-2xl mb-2 font-semibold mt-8" $ text "Current Balances"
+
+      elClass "div" "flex flex-row mt-4" $ do
+        balanceWidget lastTagId serverMsg "Bob" bobAddress never L1B
+        balanceWidget lastTagId serverMsg "Alice" aliceAddress never L1B
+
+      -- Divider
+      elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+      -- Open Payment Channel UI
+      elClass "div" "mt-8" $ do
+        elClass "div" "text-sm mb-1" $ text "Amount to Spend"
+        _ :: Dynamic t (Maybe Float) <- el "div" $ elClass "div" "w-fit border-2 border-gray-200 flex flex-row items-center" $ do
+          amountInput <- inputElement $ def
+            & initialAttributes .~ ("class" =: "pl-4 pr-2 py-1 bg-transparent text-right" <> "placeholder" =: "1 ADA" <> "type" =: "number")
+            & inputElementConfig_initialValue .~ "1000"
+          elClass "span" "mx-2 my-1" $ text "ADA"
+          pure $ readMaybe . T.unpack <$> _inputElement_value amountInput
+        elClass "div" "text-xs my-1" $ text "100 ADA in fast payment collateral will also be held in hydra pay"
+        pure ()
+
+        todo_CONTINUE_WITH_THIS_BUTTON <-  elClass "button" "rounded mt-4 p-4 text-center w-full bg-gray-800 text-white font-bold" $ text "Open Payment Channel"
+        pure ()
+      pure ()
+
+
+data BalanceType = L1B | HdB
+
+theHeadName = "channelsHead"
+
+balanceWidget :: _ => _ -> _ -> _ -> _ -> Event t () -> _ -> m (Dynamic t _)
+balanceWidget lastTagId serverMsg name addr refetch btype = do
+  elClass "div" "text-lg flex flex-col mr-10" $ do
+    elClass "div" "font-semibold" $ text name
+    -- NOTE(skylar): We assume we have loaded bobAddress if this is visible, so we don't worry about the outer Nothing
+    fmap (fmap getFirst . snd) . runDynamicWriterT . elClass "div" "font-semibold" $ mdo
+        balanceResult' <- requestPb lastTagId serverMsg ((case btype of
+                                                 L1B -> GetL1Balance
+                                                 HdB -> GetHeadBalance theHeadName)
+                                         addr)
+
+        let balanceResult = fmap (\case
+                                 L1Balance b -> Just b
+                                 HeadBalance b -> Just b
+                                 _ -> Nothing)
+                        balanceResult'
+        let
+          gotBalance = fmapMaybe (preview _Just) balanceResult
+          reqFailed = fmapMaybe (preview _Nothing) balanceResult
+
+        delayedFail <- delay 1 reqFailed
+        mBalance <- holdDyn (Nothing :: Maybe Float) $ Just . lovelaceToAda <$> gotBalance
+        tellDyn (First <$> mBalance)
+
+        dyn_ $ ffor mBalance $ \case
+          Nothing -> elClass "div" "animate-pulse bg-gray-700 w-16 h-4" blank
+          Just balance -> do
+            text $ T.pack . printf "%.2f" $ balance
+            text " ADA"
+
+        pure $ maybe 0 id <$> mBalance
+
+
+paymentChannel :: _ => _ -> _ -> [Address] -> _ -> m (Event t DemoTx)
+paymentChannel lastTagId serverMsg [aliceAddress, bobAddress] latestTxs = do
+      -- Page Title
+      elClass "div" "w-full flex flex-row items-baseline justify-between" $ do
+        elClass "div" "mb-2 font-semibold" $ text "Bob & Alice's Payment Channel"
+        todo_CONTINUE_WITH_THIS_BUTTON <- elClass "button" "rounded mt-4 px-6 py-2 text-center bg-gray-800 text-white font-semibold" $ text "Close Payment Channel"
+        pure ()
+
+      -- Divider
+      elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+      elClass "div" "text-2xl mb-2 font-semibold mt-8" $ text "L1 Balance"
+
+      elClass "div" "flex flex-row mt-4" $ do
+        balanceWidget lastTagId serverMsg "Bob" bobAddress never L1B
+        balanceWidget lastTagId serverMsg "Alice" aliceAddress never L1B
+
+      -- Divider
+      elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+      -- Balances
+      elClass "div" "text-2xl mb-2 font-semibold mt-8" $ do
+        text "Payment Channel Balance"
+
+      rec
+        (bobBalance, aliceBalance) <- elClass "div" "flex flex-row mt-4" $ do
+          bb <- balanceWidget lastTagId serverMsg "Bob" bobAddress autoTx HdB
+          ab <- balanceWidget lastTagId serverMsg "Alice" aliceAddress autoTx HdB
+          pure (bb, ab)
+
+        -- Divider
+        elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+        -- Statistics
+        elClass "div" "text-2xl mb-2 font-semibold mt-8" $ text "Statistics"
+
+        elClass "div" "flex flex-row mt-4" $ do
+          elClass "div" "mr-16" $ do
+            elClass "div" "text-lg font-semibold" $ text "Total Transactions"
+            elClass "div" "text-3xl text-gray-600" $ dynText $ T.pack . show . Map.size <$> latestTxs
+
+          elClass "div" "mr-16" $ do
+            elClass "div" "text-lg font-semibold" $ text "Total Time"
+            elClass "div" "text-3xl text-gray-600" $ do
+              dynText $ showAsMs . Map.foldr ((+) . demoTx_time) 0 <$> latestTxs
+              text "ms"
+
+        -- Divider
+        elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+        -- Action buttons: Send & Automate
+        (automateButton, _) <- elClass "div" "" $ do
+          todo_CONTINUE_WITH_THIS_BUTTON <- elClass "button" "rounded mt-4 px-6 py-2 text-center bg-gray-800 text-white font-semibold mr-4" $ text "Send ADA"
+          elClass' "button" "rounded mt-4 px-6 py-2 text-center bg-gray-800 text-white font-semibold" $ dynText $ ffor automating $ \case
+            True -> "Automating"
+            False -> "Automate"
+
+        let
+          toggleAutomate = domEvent Click automateButton
+
+        automating <- foldDyn ($) False $ not <$ toggleAutomate
+
+        fmap (getFirst . snd) . runEventWriterT . dyn $ ffor automating $ \case
+          False -> pure ()
+          True -> do
+            tick <- tickLossyFromPostBuildTime 1
+            randomAmount :: Event t Lovelace <- performEvent $ (liftIO $ ada <$> randomRIO (1,10)) <$ tick
+            let
+              nextToAddr :: Dynamic t Address = ffor2 bobBalance aliceBalance $ \bb ab ->
+                if bb > ab then aliceAddress else bobAddress
+
+              nextFromAddr = ffor2 bobBalance aliceBalance $ \bb ab ->
+                if bb > ab then bobAddress else aliceAddress
+
+              bobIsTo = (fmap (== bobAddress) nextToAddr)
+              toName = ffor bobIsTo $ \case
+                True -> "Bob"
+                False -> "Alice"
+
+            sendAdaResponse <- requester  lastTagId serverMsg $
+                (\from to am -> SubmitHeadTx from $ HeadSubmitTx theHeadName to am)
+                <$> current nextFromAddr
+                <*> current nextToAddr
+                <@> randomAmount
+
+            -- picoToLatestTx <- holdDyn Nothing $ Just <$> changeDemoBuildTxFunc
+
+            let
+              sendSuccess = fmapMaybe (preview _TxConfirmed) $ sendAdaResponse
+
+--            changeDemoBuildTxFunc :: _ = attachWith DemoTx <$> current toName <@> randomAmount
+
+            -- pure $ attachWithMaybe (<*>) (current picoToLatestTx) $ Just <$> sendSuccess
+            tellEvent never -- TODO: put DemoTxes here
+            pure ()
+
+      -- Transaction History
+      elClass "div" "text-2xl mb-2 font-semibold mt-8" $ text "History"
+
+      let
+        historyItem tx = do
+          elClass "div" "transition pointer-events-none duration-1000 px-4 py-2 rounded bg-white mb-4 drop-shadow " $ do
+            elClass "div" "flex flex-row justify-between items-center" $ do
+              elClass "div" "flex flex-col mr-16" $ do
+                elClass "div" "text-gray-600" $ do
+                  text "To "
+                  dynText $ demoTx_to <$> tx
+                elClass "div" "text-xl" $ do
+                  dynText $ T.pack . printf "%.2f" . lovelaceToAda . demoTx_amount <$> tx
+                  text "ADA"
+
+              elClass "div" "flex flex-row text-gray-400" $ do
+                elClass "div" "flex flex-col" $ do
+                  elClass "div" "text-xs" $ text "Time"
+                  elClass "div" "" $ do
+                    dynText $ showAsMs . demoTx_time <$> tx
+                    text "ms"
+
+      let
+        noHistory = Map.null <$> latestTxs
+
+      elDynClass "div" "overflow-y-scroll flex-grow" $ dyn_ $ ffor noHistory $ \case
+        True -> elClass "div" "text-gray-500" $ text "There is no history yet for this payment channel"
+        False -> do
+          _ <- elClass "div" "flex flex-col-reverse w-full" $ listWithKey latestTxs $ \_ tx -> historyItem tx
+          pure ()
+
+      pure never -- TODO: PUT AUTO TX BACK HERE
+  
+
+
+--    mapMaybe 
+
+    -- dyn_ $ ffor mApiKey $ \case
+    --   Nothing -> text "Please enter your API Key"
+    --   Just apiKey -> mdo
+    --     (authEl, _) <- elClass' "button" "rounded mt-4 p-4 text-center w-full bg-gray-800 text-white font-bold" $ text "Authenticate"
+
+    --     lastTagId <- foldDyn (+) 0 $ fromIntegral . length <$> sendToHydraPay
+
+    --     let
+    --       authenticate = Authenticate apiKey <$ domEvent Click authEl
+
+    --       sendMsg =
+    --         mergeWith (<>) $ (fmap . fmap) pure $ [authenticate]
+
+    --       sendToHydraPay =
+    --         attachWith (\tid msgs -> fmap (uncurry Tagged) $ zip [tid..] msgs) (current lastTagId) sendMsg
+
+    --       serverMsg = fmapMaybe id $ rws ^. webSocket_recv
+
+-- appView :: forall t m.
+--   ( PostBuild t m
+--   , Prerender t m
+--   , SetRoute t (R FrontendRoute) (Client m)
+--   , SetRoute t (R FrontendRoute) m
+--   , RouteToUrl (R FrontendRoute) m
+--   , MonadIO (Performable m)
+--   , PerformEvent t m
+--   , TriggerEvent t m
+--   , DomBuilder t m
+--   , MonadFix m
+--   , MonadHold t m
+--   ) => Dynamic t (Maybe T.Text) -> Dynamic t (Maybe T.Text) -> Dynamic t (Map Int DemoTx) -> RoutedT t (R FrontendRoute) m (Event t DemoTx)
+-- appView bobAddress aliceAddress latestTxs = do
+--   fmap switchDyn $ elClass "div" "w-full h-full text-gray-700 max-w-4xl mx-auto p-4 rounded flex flex-col" $ subRoute $ \case
+--     FrontendRoute_Home -> homeView >> pure never
+--     FrontendRoute_Setup -> do
+--       elClass "div" "text-3xl flex flex-col justify-center items-center" $ do
+--         el "div" $ text "Fast Payments Demo"
+--         elClass "div" "text-lg" $ text "populating addresses..."
+--         pure never
+
+--     FrontendRoute_OpeningChannel -> do
+--       elClass "div" "text-3xl flex flex-col justify-center items-center" $ do
+--         el "div" $ text "Fast Payments Demo"
+
+--         let
+--           messages = [ "Sending funds from Bob and Alice into Hydra Pay"
+--                      , "Creating payment channel"
+--                      , "Waiting for payment channel"
+--                      ]
+
+--         tick <- tickLossyFromPostBuildTime 2
+--         rec
+--           currentIndex <- holdDyn (0 :: Int) $ fmap (min (length messages - 1) . (+1)) $ current currentIndex <@ tick
+--         elClass "div" "text-lg" $ do
+--           dynText $ (messages !!) <$> currentIndex
+--           text "..."
+
+--         prerender_ blank $ mdo
+--             ws :: RawWebSocket t (Maybe ChannelsApi.ServerMsg) <- lift $ jsonWebSocket "ws://localhost:8000/api" $ (WebSocketConfig @t @ChannelsApi.ClientMsg) wssend never True []
+--             let wssend = [DemoInit] <$ _webSocket_open ws
+--             setRoute $ FrontendRoute_PaymentChannel :/ () <$ ffilter (== Just InitDone) (_webSocket_recv ws)
+--       pure never
+
+--     FrontendRoute_ClosingChannel -> do
+--       elClass "div" "text-3xl flex flex-col justify-center items-center" $ do
+--         el "div" $ text "Fast Payments Demo"
+
+--         let
+--           messages = [ "Closing payment channel"
+--                      , "Settling payment channel on L1"
+--                      , "Withdrawing funds from payment channel"
+--                      ]
+
+--         tick <- tickLossyFromPostBuildTime 5
+--         rec
+--           currentIndex <- holdDyn (0 :: Int) $ fmap (min (length messages - 1) . (+1)) $ current currentIndex <@ tick
+--         elClass "div" "text-lg" $ do
+--           dynText $ (messages !!) <$> currentIndex
+--           text "..."
+
+--         prerender_ blank $ mdo
+--             ws :: RawWebSocket t (Maybe ChannelsApi.ServerMsg) <- lift $ jsonWebSocket "ws://localhost:8000/api" $ (WebSocketConfig @t @ChannelsApi.ClientMsg) wssend never True []
+--             let wssend = [CloseFanout] <$ _webSocket_open ws
+--             setRoute $ FrontendRoute_OpenChannel :/ () <$ ffilter (== Just CloseFanoutDone) (_webSocket_recv ws)
+--       pure never
+
+--     FrontendRoute_OpenChannel -> do
+--       -- Page Title
+--       elClass "div" "mb-2 font-semibold" $ text "Open a Payment Channel"
+--       -- Divider
+--       elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+--       -- Balances
+--       elClass "div" "text-2xl mb-2 font-semibold mt-8" $ text "Current Balances"
+
+--       elClass "div" "flex flex-row mt-4" $ do
+--         balanceWidget "Bob" bobAddress never "l1-balance"
+--         balanceWidget "Alice" aliceAddress never "l1-balance"
+
+--       -- Divider
+--       elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+--       -- Open Payment Channel UI
+--       elClass "div" "mt-8" $ do
+--         elClass "div" "text-sm mb-1" $ text "Amount to Spend"
+--         _ :: Dynamic t (Maybe Float) <- el "div" $ elClass "div" "w-fit border-2 border-gray-200 flex flex-row items-center" $ do
+--           amountInput <- inputElement $ def
+--             & initialAttributes .~ ("class" =: "pl-4 pr-2 py-1 bg-transparent text-right" <> "placeholder" =: "1 ADA" <> "type" =: "number")
+--             & inputElementConfig_initialValue .~ "1000"
+--           elClass "span" "mx-2 my-1" $ text "ADA"
+--           pure $ readMaybe . T.unpack <$> _inputElement_value amountInput
+--         elClass "div" "text-xs my-1" $ text "100 ADA in fast payment collateral will also be held in hydra pay"
+--         pure ()
+
+--         routeLink (FrontendRoute_OpeningChannel :/ ()) $ elClass "button" "rounded mt-4 p-4 text-center w-full bg-gray-800 text-white font-bold" $ text "Open Payment Channel"
+--       pure never
+
+--     FrontendRoute_SendFunds -> mdo
+--       -- Page Header
+--       elClass "div" "relative w-full flex flex-row items-baseline justify-between" $ do
+--         elClass "div" "mb-2 font-semibold" $ text "Bob & Alice's Payment Channel"
+--         (backButton, _) <- elClass' "button" "absolute -left-8 rounded w-6 h-6 bg-gray-300 text-center font-semibold" $ text "<"
+--         -- NOTE(skylar): Route link prevents the absolute-ness being applied properly, so we just use setRoute!
+--         setRoute $ FrontendRoute_PaymentChannel :/ () <$ domEvent Click backButton
+
+--       -- Divider
+--       elClass "div" "w-full h-px bg-gray-200" blank
+
+--       -- Balances
+--       elClass "div" "text-2xl mb-2 font-semibold mt-8" $ do
+--         text "Current Balances "
+--         elClass "span" "text-sm" $ text " In payment channel"
+
+--       elClass "div" "flex flex-row mt-4" $ do
+--         balanceWidget "Bob" bobAddress never "head-balance"
+--         balanceWidget "Alice" aliceAddress never "head-balance"
+
+--       -- Divider
+--       elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+--       -- Send
+--       elClass "div" "text-2xl mb-4 font-semibold mt-8" $ text "Send ADA"
+
+--       -- To/From Selector
+--       rec
+--         (selectorButton, _) <- elClass' "button" "w-fit bg-gray-300 px-4 py-2 rounded flex gap-6 flex-row" $ do
+--           elClass "div" "" $ do
+--             elClass "div" "text-left text-xs" $ text "From"
+--             elClass "div" "font-semibold" $ dynText $ ffor bobIsTo $ \case
+--               True -> "Alice"
+--               False -> "Bob"
+
+--           elClass "div" "" $ do
+--             elClass "div" "text-left text-xs" $ text "To"
+--             elClass "div" "font-semibold" $ dynText $ toName
+
+--         let
+--           toName = ffor bobIsTo $ \case
+--             True -> "Bob"
+--             False -> "Alice"
+
+--           bobIsTo = ((==) <$> toAddr <*> bobAddress)
+--           changeSelection = current nextSelection <@ domEvent Click selectorButton
+--           fromAddr = ffor3 bobIsTo bobAddress aliceAddress $ \isBob bob alice ->
+--             if isBob then alice else bob
+--           nextSelection = fromAddr
+
+--         sendBuild <- getPostBuild
+--         toAddr <- holdDyn Nothing $ leftmost [current bobAddress <@ sendBuild, changeSelection]
+--         pure ()
+
+--       lovelaceSendAmount :: Dynamic t (Maybe Integer) <- el "div" $ elClass "div" "mt-4 w-full border-2 border-gray-200 flex flex-row items-center" $ do
+--           amountInput <- inputElement $ def
+--             & initialAttributes .~ ("class" =: "text-gray-500 w-full px-8 py-6 bg-transparent text-center text-xl" <> "placeholder" =: "1 ADA" <> "type" =: "number")
+--             & inputElementConfig_initialValue .~ "10"
+--           elClass "span" "mx-2 my-1" $ text "ADA"
+--           pure $ fmap ((round :: Float -> Integer) . ada) . readMaybe . T.unpack <$> _inputElement_value amountInput
+
+--       (sendButton, _) <- elClass' "button" "rounded mt-4 p-4 text-center w-full bg-gray-800 text-white font-bold" $ text "Send ADA"
+
+--       let
+--         txSendPayload = liftA2 (HeadSubmitTx "demo") <$> toAddr <*> lovelaceSendAmount
+--         sendAda = fmapMaybe (preview _Just) $ current txSendPayload <@ domEvent Click sendButton
+--         sendUrl = (fmap ("/submit-tx/"<>) <$> fromAddr)
+--         sendReq = liftA2 postJson <$> sendUrl <*> txSendPayload
+
+--         sendSuccess = fmapMaybe (preview _Just) $ (decodeText <=< _xhrResponse_responseText) <$> sendAdaResponse
+
+--         latestTxFunc = liftA2 DemoTx <$> (Just <$> toName) <*> lovelaceSendAmount
+
+--       -- Dynamic function to construct the last transaction
+--       picoToLatestTx <- holdDyn Nothing $ attachPromptlyDynWith const latestTxFunc sendAda
+
+--       sendAdaResponse <- fmap switchDyn $ prerender (pure never) $ do
+--         performRequestAsync $ fmapMaybe (preview _Just) $ current sendReq <@ sendAda
+
+--       pure $ attachWithMaybe (\mf a -> mf <*> Just a) (current picoToLatestTx) sendSuccess
+
+--     FrontendRoute_PaymentChannel -> do
+--       -- Page Title
+--       elClass "div" "w-full flex flex-row items-baseline justify-between" $ do
+--         elClass "div" "mb-2 font-semibold" $ text "Bob & Alice's Payment Channel"
+--         routeLink (FrontendRoute_ClosingChannel :/ ()) $ elClass "button" "rounded mt-4 px-6 py-2 text-center bg-gray-800 text-white font-semibold" $ text "Close Payment Channel"
+
+--       -- Divider
+--       elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+--       elClass "div" "text-2xl mb-2 font-semibold mt-8" $ text "L1 Balance"
+
+--       elClass "div" "flex flex-row mt-4" $ do
+--         balanceWidget "Bob" bobAddress never "l1-balance"
+--         balanceWidget "Alice" aliceAddress never "l1-balance"
+
+--       -- Divider
+--       elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+--       -- Balances
+--       elClass "div" "text-2xl mb-2 font-semibold mt-8" $ do
+--         text "Payment Channel Balance"
+
+--       rec
+--         (bobBalance, aliceBalance) <- elClass "div" "flex flex-row mt-4" $ do
+--           bb <- balanceWidget "Bob" bobAddress autoTx "head-balance"
+--           ab <- balanceWidget "Alice" aliceAddress autoTx "head-balance"
+--           pure (bb, ab)
+
+--         -- Divider
+--         elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+--         -- Statistics
+--         elClass "div" "text-2xl mb-2 font-semibold mt-8" $ text "Statistics"
+
+--         elClass "div" "flex flex-row mt-4" $ do
+--           elClass "div" "mr-16" $ do
+--             elClass "div" "text-lg font-semibold" $ text "Total Transactions"
+--             elClass "div" "text-3xl text-gray-600" $ dynText $ T.pack . show . Map.size <$> latestTxs
+
+--           elClass "div" "mr-16" $ do
+--             elClass "div" "text-lg font-semibold" $ text "Total Time"
+--             elClass "div" "text-3xl text-gray-600" $ do
+--               dynText $ showAsMs . Map.foldr ((+) . demoTx_time) 0 <$> latestTxs
+--               text "ms"
+
+--         -- Divider
+--         elClass "div" "mt-2 w-full h-px bg-gray-200" blank
+
+--         -- Action buttons: Send & Automate
+--         (automateButton, _) <- elClass "div" "" $ do
+--           routeLink (FrontendRoute_SendFunds :/ ()) $ elClass "button" "rounded mt-4 px-6 py-2 text-center bg-gray-800 text-white font-semibold mr-4" $ text "Send ADA"
+--           elClass' "button" "rounded mt-4 px-6 py-2 text-center bg-gray-800 text-white font-semibold" $ dynText $ ffor automating $ \case
+--             True -> "Automating"
+--             False -> "Automate"
+
+--         let
+--           toggleAutomate = domEvent Click automateButton
+
+--         automating <- foldDyn ($) False $ not <$ toggleAutomate
+
+--         autoTxEv <- dyn $ ffor automating $ \case
+--           False -> pure never
+--           True -> fmap switchDyn $ prerender (pure never) $ do
+--             tick <- tickLossyFromPostBuildTime 1
+--             randomAmount :: Event t Lovelace <- performEvent $ (liftIO $ ada <$> randomRIO (1,10)) <$ tick
+--             let
+--               nextToAddr = join $ ffor2 bobBalance aliceBalance $ \bb ab ->
+--                 if bb > ab then aliceAddress else bobAddress
+
+--               nextFromAddr = join $ ffor2 bobBalance aliceBalance $ \bb ab ->
+--                 if bb > ab then bobAddress else aliceAddress
+
+--               sendUrl = (fmap ("/submit-tx/"<>) <$> nextFromAddr)
+
+--               bobIsTo = ((==) <$> nextToAddr <*> bobAddress)
+--               toName = ffor bobIsTo $ \case
+--                 True -> "Bob"
+--                 False -> "Alice"
+
+--               changeDemoBuildTxFunc = attachWith DemoTx (current toName) randomAmount
+
+--               submitPayload = attachWith (<*>) (current $ fmap (HeadSubmitTx "demo") <$> nextToAddr) $ Just <$> randomAmount
+--               submitReq = attachWithMaybe (<*>) (current $ fmap postJson <$> sendUrl) submitPayload
+
+--             picoToLatestTx <- holdDyn Nothing $ Just <$> changeDemoBuildTxFunc
+--             sendAdaResponse <- performRequestAsync submitReq
+
+--             let
+--               sendSuccess = fmapMaybe (preview _Just) $ (decodeText <=< _xhrResponse_responseText) <$> sendAdaResponse
+
+--             pure $ attachWithMaybe (<*>) (current picoToLatestTx) $ Just <$> sendSuccess
+
+--         autoTx <- switchHold never autoTxEv
+
+--       -- Transaction History
+--       elClass "div" "text-2xl mb-2 font-semibold mt-8" $ text "History"
+
+--       let
+--         historyItem tx = do
+--           elClass "div" "transition pointer-events-none duration-1000 px-4 py-2 rounded bg-white mb-4 drop-shadow " $ do
+--             elClass "div" "flex flex-row justify-between items-center" $ do
+--               elClass "div" "flex flex-col mr-16" $ do
+--                 elClass "div" "text-gray-600" $ do
+--                   text "To "
+--                   dynText $ demoTx_to <$> tx
+--                 elClass "div" "text-xl" $ do
+--                   dynText $ T.pack . printf "%.2f" . lovelaceToAda . demoTx_amount <$> tx
+--                   text "ADA"
+
+--               elClass "div" "flex flex-row text-gray-400" $ do
+--                 elClass "div" "flex flex-col" $ do
+--                   elClass "div" "text-xs" $ text "Time"
+--                   elClass "div" "" $ do
+--                     dynText $ showAsMs . demoTx_time <$> tx
+--                     text "ms"
+
+--       let
+--         noHistory = Map.null <$> latestTxs
+
+--       elDynClass "div" "overflow-y-scroll flex-grow" $ dyn_ $ ffor noHistory $ \case
+--         True -> elClass "div" "text-gray-500" $ text "There is no history yet for this payment channel"
+--         False -> do
+--           _ <- elClass "div" "flex flex-col-reverse w-full" $ listWithKey latestTxs $ \_ tx -> historyItem tx
+--           pure ()
+
+--       pure autoTx

frontend/src/HydraPay/Api.hs

@@ -0,0 +1,252 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module HydraPay.Api where
+
+import Data.Map
+import Data.Int
+import GHC.Generics
+import Data.Aeson as Aeson
+import qualified Data.Text as T
+import Control.Applicative((<|>))
+
+import Control.Lens.TH
+
+import Data.Fixed (Pico)
+import Hydra.Types
+import qualified HydraPay.Config as Config
+
+type HeadName = T.Text
+
+data HydraPayStats = HydraPayStats
+  { _hydraPayStats_heads :: Integer
+  , _hydraPayStats_nodes :: Integer
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON HydraPayStats
+instance FromJSON HydraPayStats
+
+data HeadCreate = HeadCreate
+  { headCreate_name :: HeadName
+  , headCreate_participants :: [Address]
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON HeadCreate
+instance FromJSON HeadCreate
+
+data HeadInit = HeadInit
+  { headInit_name :: HeadName
+  , headInit_contestation :: Integer
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON HeadInit
+instance FromJSON HeadInit
+
+data HeadCommit = HeadCommit
+  { headCommit_name :: HeadName
+  , headCommit_participant :: Address
+  , headCommit_amount :: Lovelace
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON HeadCommit
+instance FromJSON HeadCommit
+
+data HeadSubmitTx = HeadSubmitTx
+  { headSubmitTx_name :: HeadName
+  , headSubmitTx_toAddr :: Address
+  , amount :: Lovelace
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON HeadSubmitTx
+instance FromJSON HeadSubmitTx
+
+-- This is the API json type that we need to send back out
+data HeadStatus = HeadStatus
+  { headStatus_name :: HeadName
+  , headStatus_running :: Bool
+  , headStatus_status :: Status
+  , headStatus_balances :: Map Address Lovelace
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON HeadStatus
+instance FromJSON HeadStatus
+
+
+data Tagged a = Tagged
+  { tagged_id :: Int64
+  , tagged_payload :: a
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON a => ToJSON (Tagged a)
+instance FromJSON a => FromJSON (Tagged a)
+
+data HydraPayError
+  = InvalidPayload
+  | HeadCreationFailed
+  | NotEnoughParticipants
+  | HeadExists HeadName
+  | HeadDoesn'tExist
+  | NetworkIsn'tRunning
+  | FailedToBuildFundsTx
+  | NodeCommandFailed
+  -- ^ Anytime a command fails
+  | NotAParticipant
+  | ProcessError String
+  | NoValidUTXOToCommit
+  | InsufficientFunds
+  | FanoutNotPossible
+  | TxInvalid {utxo :: WholeUTXO, transaction :: Value, validationError :: ValidationError}
+  deriving (Eq, Show, Generic)
+
+instance ToJSON HydraPayError
+instance FromJSON HydraPayError
+
+-- | State the head can be in, progressing linearly though the states.
+data Status
+  = Status_Pending
+  | Status_Init
+  | Status_Committing
+  | Status_Open
+  | Status_Closed
+  | Status_Fanout
+  | Status_Finalized
+  deriving (Eq, Ord, Show, Generic)
+
+instance ToJSON Status
+instance FromJSON Status
+
+data ClientMsg
+  = ClientHello
+  | Authenticate T.Text
+  | DoesHeadExist T.Text
+  | CreateHead HeadCreate
+  | InitHead HeadInit
+  | CommitHead HeadCommit
+  | CloseHead HeadName
+
+  | TearDownHead HeadName
+  -- ^ Kills network and removes head
+
+  | CheckFuel Address
+  | Withdraw Address
+  | GetAddTx TxType Address Lovelace
+
+  | SubscribeTo HeadName
+  | SubmitHeadTx Address HeadSubmitTx
+
+  | RestartDevnet
+  | GetStats
+
+  | GetDevnetAddresses Integer -- Amount of addresses
+
+  | GetL1Balance Address
+  | GetHeadBalance HeadName Address
+
+  | LiveDocEzSubmitTx Tx Address
+  | GetIsManagedDevnet
+  | GetHydraPayMode
+  | GetProxyInfo Address
+  deriving (Eq, Show, Generic)
+
+instance ToJSON ClientMsg
+instance FromJSON ClientMsg
+
+type Version = T.Text
+
+versionStr :: Version
+versionStr = "0.1.0"
+
+data ServerMsg
+  = ServerHello Version
+  | OperationSuccess
+  | HeadInfo HeadStatus
+  | TxConfirmed Pico
+  | FundsTx Tx
+  | FuelAmount Lovelace
+  | SubscriptionStarted HeadName
+  | AlreadySubscribed HeadName
+  | InvalidMessage T.Text
+  | UnhandledMessage
+  | HeadExistsResult Bool
+  | DevnetRestarted
+  | ServerError HydraPayError
+  | HeadStatusChanged HeadName Status (Map Address Lovelace)
+  | NodeMessage Value
+  | DevnetAddresses [Address]
+  | CurrentStats HydraPayStats
+  | RequestError T.Text
+  | NotAuthenticated
+  | AuthResult Bool
+  | L1Balance Lovelace
+  | HeadBalance Lovelace
+  | BalanceChange HeadName (Map Address Lovelace)
+  | HeadRemoved HeadName
+  | ApiError T.Text
+  | HydraPayMode Config.HydraPayMode
+  | IsManagedDevnet Bool
+  | ProxyAddressInfo ProxyInfo
+  deriving (Eq, Show, Generic)
+
+instance ToJSON ServerMsg
+instance FromJSON ServerMsg
+
+-- | Information about the managed proxy-address
+-- for a specific address
+data ProxyInfo = ProxyInfo
+  { proxyInfo_address :: Address
+  , proxyInfo_proxyAddress :: Address
+  , proxyInfo_balance :: Lovelace
+  , proxyInfo_fuel :: Lovelace
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON ProxyInfo
+instance FromJSON ProxyInfo
+
+data ApiMsg
+  = TaggedMsg (Tagged ServerMsg)
+  | PlainMsg ServerMsg
+
+instance FromJSON ApiMsg where
+  parseJSON v = (TaggedMsg <$> parseJSON v) <|> (PlainMsg <$> parseJSON v)
+
+data Tx = Tx
+  { txType :: T.Text
+  , txDescription :: T.Text
+  , txCborHex :: T.Text
+  }
+  deriving (Eq, Show, Generic)
+
+instance ToJSON Tx where
+  toJSON (Tx t d c) =
+    object [ "type" .= t
+           , "description" .= d
+           , "cborHex" .= c
+           ]
+
+instance FromJSON Tx where
+  parseJSON = withObject "Tx" $ \v -> Tx
+    <$> v .: "type"
+    <*> v .: "description"
+    <*> v .: "cborHex"
+
+data TxType =
+  Funds | Fuel
+  deriving (Eq, Show, Generic)
+
+instance ToJSON TxType
+instance FromJSON TxType
+
+isFuelType :: TxType -> Bool
+isFuelType Fuel = True
+isFuelType _ = False
+
+makeLenses ''HydraPayStats
+makePrisms ''ApiMsg
+makePrisms ''ServerMsg

frontend/src/HydraPay/Config.hs

@@ -0,0 +1,45 @@
+module HydraPay.Config where
+
+import Data.Aeson.Types (FromJSON, ToJSON)
+import GHC.Generics (Generic)
+
+data HydraPayConfig = HydraPayConfig
+  { _hydraPayMode :: HydraPayMode
+  , _port :: Int
+  , _bind :: String
+  }
+  deriving (Show,Read)
+
+-- | Configure Cardano (L1) and Hydra networks. This is either an
+-- explicit configuration for Cardano Node and Hydra Nodes, or the
+-- default mode which runs a devnet for live documentation.
+data HydraPayMode
+  = ManagedDevnetMode
+  | ConfiguredMode
+    { _cardanoNodeParams :: CardanoNodeParams
+    , _hydraNodeParams :: HydraNodeParams
+    }
+  deriving (Eq,Show,Read,Generic)
+
+instance ToJSON HydraPayMode
+instance FromJSON HydraPayMode
+
+data CardanoNodeParams = CardanoNodeParams
+  { _testnetMagic :: Int
+  , _nodeSocket :: FilePath
+  , _ledgerGenesis :: FilePath
+  }
+  deriving (Eq,Show,Read,Generic)
+
+instance ToJSON CardanoNodeParams
+instance FromJSON CardanoNodeParams
+
+data HydraNodeParams = HydraNodeParams
+  { _hydraScriptsTxId :: String
+  , _hydraLedgerProtocolParameters :: FilePath
+  , _hydraLedgerGenesis :: FilePath
+  }
+  deriving (Eq,Show,Read,Generic)
+
+instance ToJSON HydraNodeParams
+instance FromJSON HydraNodeParams

release.nix

@@ -0,0 +1,5 @@
+let self = import ./. {};
+in
+{
+  inherit (self) exe;
+}

static/main.css

@@ -0,0 +1,3 @@
+p {
+  color: red;  
+}