Bugfixes for alpha.12 (#3049)

* squashfs-wip

* sdk fixes

* misc fixes

* bump sdk

* Include StartTunnel installation command

Added installation instructions for StartTunnel.

* CA instead of leaf for StartTunnel (#3046)

* updated docs for CA instead of cert

* generate ca instead of self-signed in start-tunnel

* Fix formatting in START-TUNNEL.md installation instructions

* Fix formatting in START-TUNNEL.md

* fix infinite loop

* add success message to install

* hide loopback and bridge gateways

---------

Co-authored-by: Aiden McClelland <me@drbonez.dev>
Co-authored-by: Aiden McClelland <3732071+dr-bonez@users.noreply.github.com>

* prevent gateways from getting stuck empty

* fix set-password

* misc networking fixes

* build and efi fixes

* efi fixes

* alpha.13

* remove cross

* fix tests

* provide path to upgrade

* fix networkmanager issues

* remove squashfs before creating

---------

Co-authored-by: Matt Hill <MattDHill@users.noreply.github.com>

.github/ISSUE_TEMPLATE/bug-report.yml

@@ -0,0 +1,102 @@
+name: 🐛 Bug Report
+description: Create a report to help us improve StartOS
+title: "[bug]: "
+labels: [Bug, Needs Triage]
+assignees:
+  - MattDHill
+body:
+  - type: checkboxes
+    attributes:
+      label: Prerequisites
+      description: Please confirm you have completed the following.
+      options:
+        - label: I have searched for [existing issues](https://github.com/start9labs/start-os/issues) that already report this problem.
+          required: true
+  - type: input
+    attributes:
+      label: Server Hardware
+      description: On what hardware are you running StartOS? Please be as detailed as possible!
+      placeholder: Pi (8GB) w/ 32GB microSD & Samsung T7 SSD
+    validations:
+      required: true
+  - type: input
+    attributes:
+      label: StartOS Version
+      description: What version of StartOS are you running?
+      placeholder: e.g. 0.3.4.3
+    validations:
+      required: true
+  - type: dropdown
+    attributes:
+      label: Client OS
+      description: What operating system is your device running?
+      options:
+        - MacOS
+        - Windows
+        - Linux
+        - iOS
+        - Android
+        - CalyxOS
+        - GrapheneOS
+        - Other
+    validations:
+      required: true
+  - type: input
+    attributes:
+      label: Client OS Version
+      description: What version is your device OS?
+    validations:
+      required: true
+  - type: dropdown
+    attributes:
+      label: Browser
+      description: What browser are you using to connect to your server?
+      options:
+        - Firefox
+        - Brave
+        - Tor Browser
+        - Safari
+        - Chrome
+        - Opera
+        - Edge
+        - Internet Explorer
+        - Other
+    validations:
+      required: true
+  - type: input
+    attributes:
+      label: Browser Version
+      description: What version is your browser?
+      placeholder: e.g. 94.0.2
+    validations:
+      required: true
+  - type: textarea
+    attributes:
+      label: Current Behavior
+      description: A clear description of the bug and how it manifests.
+    validations:
+      required: true
+  - type: textarea
+    attributes:
+      label: Expected Behavior
+      description: A clear description of what you expect to happen.
+    validations:
+      required: true
+  - type: textarea
+    attributes:
+      label: Steps to Reproduce
+      description: Step-by-step instructions to reproduce this behavior.
+      placeholder: |
+        1. On this page...
+        2. Click this button...
+        3. Enter this value...
+        4. See error...
+    validations:
+      required: true
+  - type: textarea
+    attributes:
+      label: Anything else?
+      description: |
+        Screenshots? Links? References? Anything that will give us more context about the issue you are encountering.
+
+        Tip: You can attach images or log files by clicking this area to highlight it and then dragging files in.

.github/ISSUE_TEMPLATE/config.yml

@@ -0,0 +1,7 @@
+contact_links:
+  - name: 📚 Documentation
+    url: https://github.com/start9labs/documentation
+    about: This issue tracker is not for documentation issues. Please file documentation issues on the Start9 Docs repo.
+  - name: 🤔 Support Question
+    url: https://t.me/start9_labs
+    about: This issue tracker is not for support questions. Please post your question in our Telegram community channel.

.github/ISSUE_TEMPLATE/feature-request.yml

@@ -0,0 +1,41 @@
+name: 💡 Feature Request
+description: Suggest an idea for StartOS
+title: "[feat]: "
+labels: [Enhancement]
+assignees:
+  - MattDHill
+body:
+  - type: checkboxes
+    attributes:
+      label: Prerequisites
+      description: Please confirm you have completed the following.
+      options:
+        - label: I have searched for [existing issues](https://github.com/start9labs/start-os/issues) that already suggest this feature.
+          required: true
+  - type: textarea
+    attributes:
+      label: Describe the Feature Request
+      description: A clear and concise description of the feature.
+    validations:
+      required: true
+  - type: textarea
+    attributes:
+      label: Describe the Use Case
+      description: Why is this feature useful? What problem does it solve?
+    validations:
+      required: true
+  - type: textarea
+    attributes:
+      label: Describe Preferred Solution
+      description: How you want this feature added to StartOS?
+  - type: textarea
+    attributes:
+      label: Describe Alternatives
+      description: Describe any alternative solutions or features you have considered.
+  - type: textarea
+    attributes:
+      label: Anything else?
+      description: |
+        Screenshots? Links? References? Anything that will give us more context about the feature you are suggesting.
+
+        Tip: You can attach images or log files by clicking this area to highlight it and then dragging files in.

.github/workflows/startos-iso.yaml

@@ -0,0 +1,285 @@
+name: Debian-based ISO and SquashFS
+
+on:
+  workflow_call:
+  workflow_dispatch:
+    inputs:
+      environment:
+        type: choice
+        description: Environment
+        options:
+          - NONE
+          - dev
+          - unstable
+          - dev-unstable
+      runner:
+        type: choice
+        description: Runner
+        options:
+          - standard
+          - fast
+      platform:
+        type: choice
+        description: Platform
+        options:
+          - ALL
+          - x86_64
+          - x86_64-nonfree
+          - aarch64
+          - aarch64-nonfree
+          - raspberrypi
+          - riscv64
+      deploy:
+        type: choice
+        description: Deploy
+        options:
+          - NONE
+          - alpha
+          - beta
+  push:
+    branches:
+      - master
+      - next/*
+  pull_request:
+    branches:
+      - master
+      - next/*
+
+env:
+  NODEJS_VERSION: "24.11.0"
+  ENVIRONMENT: '${{ fromJson(format(''["{0}", ""]'', github.event.inputs.environment || ''dev''))[github.event.inputs.environment == ''NONE''] }}'
+
+jobs:
+  compile:
+    name: Compile Base Binaries
+    strategy:
+      fail-fast: true
+      matrix:
+        arch: >-
+          ${{
+            fromJson('{
+              "x86_64": ["x86_64"],
+              "x86_64-nonfree": ["x86_64"],
+              "aarch64": ["aarch64"],
+              "aarch64-nonfree": ["aarch64"],
+              "raspberrypi": ["aarch64"],
+              "riscv64": ["riscv64"],
+              "ALL": ["x86_64", "aarch64"]
+            }')[github.event.inputs.platform || 'ALL']
+          }}
+    runs-on: ${{ fromJson('["ubuntu-22.04", "buildjet-32vcpu-ubuntu-2204"]')[github.event.inputs.runner == 'fast'] }}
+    steps:
+      - run: |
+          sudo mount -t tmpfs tmpfs .
+        if: ${{ github.event.inputs.runner == 'fast' }}
+
+      - uses: actions/checkout@v4
+        with:
+          submodules: recursive
+
+      - name: Set up Python
+        uses: actions/setup-python@v5
+        with:
+          python-version: "3.x"
+
+      - uses: actions/setup-node@v4
+        with:
+          node-version: ${{ env.NODEJS_VERSION }}
+
+      - name: Set up docker QEMU
+        uses: docker/setup-qemu-action@v3
+
+      - name: Set up system dependencies
+        run: sudo apt-get update && sudo apt-get install -y qemu-user-static systemd-container squashfuse
+
+      - name: Set up Docker Buildx
+        uses: docker/setup-buildx-action@v3
+
+      - name: Configure sccache
+        uses: actions/github-script@v7
+        with:
+          script: |
+            core.exportVariable('ACTIONS_RESULTS_URL', process.env.ACTIONS_RESULTS_URL || '');
+            core.exportVariable('ACTIONS_RUNTIME_TOKEN', process.env.ACTIONS_RUNTIME_TOKEN || '');
+
+      - name: Make
+        run: make ARCH=${{ matrix.arch }} compiled-${{ matrix.arch }}.tar
+        env:
+          SCCACHE_GHA_ENABLED: on
+          SCCACHE_GHA_VERSION: 0
+
+      - uses: actions/upload-artifact@v4
+        with:
+          name: compiled-${{ matrix.arch }}.tar
+          path: compiled-${{ matrix.arch }}.tar
+  image:
+    name: Build Image
+    needs: [compile]
+    strategy:
+      fail-fast: false
+      matrix:
+        platform: >-
+          ${{
+            fromJson(
+              format(
+                '[
+                  ["{0}"],
+                  ["x86_64", "x86_64-nonfree", "aarch64", "aarch64-nonfree", "raspberrypi"]
+                ]',
+                github.event.inputs.platform || 'ALL'
+              )
+            )[(github.event.inputs.platform || 'ALL') == 'ALL']
+          }}
+    runs-on: >-
+      ${{
+        fromJson(
+          format(
+            '["ubuntu-22.04", "{0}"]',
+            fromJson('{
+              "x86_64": "buildjet-8vcpu-ubuntu-2204",
+              "x86_64-nonfree": "buildjet-8vcpu-ubuntu-2204",
+              "aarch64": "buildjet-8vcpu-ubuntu-2204-arm",
+              "aarch64-nonfree": "buildjet-8vcpu-ubuntu-2204-arm",
+              "raspberrypi": "buildjet-8vcpu-ubuntu-2204-arm",
+              "riscv64": "buildjet-8vcpu-ubuntu-2204",
+            }')[matrix.platform]
+          )
+        )[github.event.inputs.runner == 'fast']
+      }}
+    env:
+      ARCH: >-
+        ${{
+          fromJson('{
+            "x86_64": "x86_64",
+            "x86_64-nonfree": "x86_64",
+            "aarch64": "aarch64",
+            "aarch64-nonfree": "aarch64",
+            "raspberrypi": "aarch64",
+            "riscv64": "riscv64",
+          }')[matrix.platform]
+        }}
+    steps:
+      - name: Free space
+        run: rm -rf /opt/hostedtoolcache*
+        if: ${{ github.event.inputs.runner != 'fast' }}
+
+      - uses: actions/checkout@v4
+        with:
+          submodules: recursive
+
+      - name: Set up Python
+        uses: actions/setup-python@v5
+        with:
+          python-version: "3.x"
+
+      - name: Install dependencies
+        run: |
+          sudo apt-get update
+          sudo apt-get install -y qemu-user-static
+          wget https://deb.debian.org/debian/pool/main/d/debspawn/debspawn_0.6.2-1_all.deb
+          sha256sum ./debspawn_0.6.2-1_all.deb | grep 37ef27458cb1e35e8bce4d4f639b06b4b3866fc0b9191ec6b9bd157afd06a817
+          sudo apt-get install -y ./debspawn_0.6.2-1_all.deb
+
+      - name: Configure debspawn
+        run: |
+          sudo mkdir -p /etc/debspawn/
+          echo "AllowUnsafePermissions=true" | sudo tee /etc/debspawn/global.toml
+          sudo mkdir -p /var/tmp/debspawn
+
+      - run: sudo mount -t tmpfs tmpfs /var/tmp/debspawn
+        if: ${{ github.event.inputs.runner == 'fast' && (matrix.platform == 'x86_64' || matrix.platform == 'x86_64-nonfree') }}
+
+      - name: Download compiled artifacts
+        uses: actions/download-artifact@v4
+        with:
+          name: compiled-${{ env.ARCH }}.tar
+
+      - name: Extract compiled artifacts
+        run: tar -xvf compiled-${{ env.ARCH }}.tar
+
+      - name: Prevent rebuild of compiled artifacts
+        run: |
+          mkdir -p web/node_modules
+          mkdir -p web/dist/raw
+          mkdir -p core/startos/bindings
+          mkdir -p sdk/base/lib/osBindings
+          mkdir -p container-runtime/node_modules
+          mkdir -p container-runtime/dist
+          mkdir -p container-runtime/dist/node_modules
+          mkdir -p core/startos/bindings
+          mkdir -p sdk/dist
+          mkdir -p sdk/baseDist
+          mkdir -p patch-db/client/node_modules
+          mkdir -p patch-db/client/dist
+          mkdir -p web/.angular
+          mkdir -p web/dist/raw/ui
+          mkdir -p web/dist/raw/install-wizard
+          mkdir -p web/dist/raw/setup-wizard
+          mkdir -p web/dist/static/ui
+          mkdir -p web/dist/static/install-wizard
+          mkdir -p web/dist/static/setup-wizard
+          PLATFORM=${{ matrix.platform }} make -t compiled-${{ env.ARCH }}.tar
+
+      - run: git status
+
+      - name: Run iso build
+        run: PLATFORM=${{ matrix.platform }} make iso
+        if: ${{ matrix.platform != 'raspberrypi' }}
+
+      - name: Run img build
+        run: PLATFORM=${{ matrix.platform }} make img
+        if: ${{ matrix.platform == 'raspberrypi' }}
+
+      - uses: actions/upload-artifact@v4
+        with:
+          name: ${{ matrix.platform }}.squashfs
+          path: results/*.squashfs
+
+      - uses: actions/upload-artifact@v4
+        with:
+          name: ${{ matrix.platform }}.iso
+          path: results/*.iso
+        if: ${{ matrix.platform != 'raspberrypi' }}
+
+      - uses: actions/upload-artifact@v4
+        with:
+          name: ${{ matrix.platform }}.img
+          path: results/*.img
+        if: ${{ matrix.platform == 'raspberrypi' }}
+
+      - name: Upload OTA to registry
+        run: >-
+          PLATFORM=${{ matrix.platform }} make upload-ota TARGET="${{
+            fromJson('{
+              "alpha": "alpha-registry-x.start9.com",
+              "beta": "beta-registry.start9.com",
+            }')[github.event.inputs.deploy]
+          }}" KEY="${{
+            fromJson(
+              format('{{
+                "alpha": "{0}",
+                "beta": "{1}",
+              }}', secrets.ALPHA_INDEX_KEY, secrets.BETA_INDEX_KEY)
+            )[github.event.inputs.deploy]
+          }}"
+        if: ${{ github.event.inputs.deploy != '' && github.event.inputs.deploy != 'NONE' }}
+
+  index:
+    if: ${{ github.event.inputs.deploy != '' && github.event.inputs.deploy != 'NONE' }}
+    needs: [image]
+    runs-on: ubuntu-22.04
+    steps:
+      - run: >-
+          curl "https://${{
+            fromJson('{
+              "alpha": "alpha-registry-x.start9.com",
+              "beta": "beta-registry.start9.com",
+            }')[github.event.inputs.deploy]
+          }}:8443/resync.cgi?key=${{
+            fromJson(
+              format('{{
+                "alpha": "{0}",
+                "beta": "{1}",
+              }}', secrets.ALPHA_INDEX_KEY, secrets.BETA_INDEX_KEY)
+            )[github.event.inputs.deploy]
+          }}"

.github/workflows/test.yaml

@@ -0,0 +1,31 @@
+name: Automated Tests
+
+on:
+  push:
+    branches:
+      - master
+      - next/*
+  pull_request:
+    branches:
+      - master
+      - next/*
+
+env:
+  NODEJS_VERSION: "24.11.0"
+  ENVIRONMENT: dev-unstable
+
+jobs:
+  test:
+    name: Run Automated Tests
+    runs-on: ubuntu-22.04
+    steps:
+      - uses: actions/checkout@v4
+        with:
+          submodules: recursive
+
+      - uses: actions/setup-node@v4
+        with:
+          node-version: ${{ env.NODEJS_VERSION }}
+
+      - name: Build And Run Tests
+        run: make test

.gitignore

@@ -1,4 +1,28 @@
 .DS_Store
+.idea
 /*.img
-/buster.zip
-/product_key
+/*.img.gz
+/*.img.xz
+/*-raspios-bullseye-arm64-lite.img
+/*-raspios-bullseye-arm64-lite.zip
+/product_key.txt
+/*_product_key.txt
+.vscode/settings.json
+deploy_web.sh
+deploy_web.sh
+secrets.db
+.vscode/
+/cargo-deps/**/*
+/PLATFORM.txt
+/ENVIRONMENT.txt
+/GIT_HASH.txt
+/VERSION.txt
+/*.deb
+/target
+/*.squashfs
+/results
+/dpkg-workdir
+/compiled.tar
+/compiled-*.tar
+/firmware
+/tmp

.gitmodules

@@ -0,0 +1,4 @@
+[submodule "patch-db"]
+	path = patch-db
+	url = https://github.com/Start9Labs/patch-db.git
+	branch = develop

BuildGuide.md

@@ -1,175 +0,0 @@
-##### Initial Notes & Recommendations
-* Due to issues to cross-compile the image from a desktop, this guide will take you step-by-step through the process of compiling EmbassyOS directly on a Raspberry Pi 4 (4GB or 8GB)
-* This process will go faster if you have an SSD/NVMe USB drive available.
-* This build guide does **not** require a large microSD card, especially if your final build wil be used on an SSD/NVMe USB drive.
-* Basic know-how of linux commands and terminal use is recommended.
-* Follow the guide carefully and do not skip any steps.
-
-# :hammer_and_wrench: Build Guide
-1. Flash [Raspberry Pi OS Lite](https://www.raspberrypi.org/software/operating-systems/) to a microSD and configure your raspi to boot from SSD/NVMe USB drive
-   1. After flashing, create an empty text file called `ssh` in the `boot` partition of the microSD, then proceed with booting the raspi with the flashed microSD (check your router for the IP assigned to your raspi)
-   1. Do the usual initial update/config
-      ```
-      sudo apt update
-      sudo raspi-config
-      ```
-   1. Change `Advanced Options->Boot Order`
-   1. Select `USB Boot` *(it will try to boot from microSD first if it's available)*
-   1. Select `Finish`, then `Yes` to reboot
-   1. After reboot, `sudo shutdown now` to power off the raspi and remove the microSD
-  
-2. Flash the *Raspi OS Lite* (from step 1) to your SSD/NVMe drive
-   > :information_source: Don't worry about rootfs partition size (raspi will increase it for you on initial boot)
-   
-   > :information_source: Every time you re-flash your SSD/NVMe you need to first boot with a microSD and set *Boot Order* again
-
-   1. Don't forget to create the empty `ssh` file
-   1. Connect the drive (remember to remove the microSD) to the raspi and start it up
-   1. Use `sudo raspi-config` to change the default password
-   1. Optional: `sudo apt upgrade -y`
-   1. Optional: `sudo nano /etc/apt/sources.list.d/vscode.list` comment the last line which contains `packages.microsoft.com`
-
-3. Install GHC
-   ```
-   sudo apt update
-   sudo apt install -y ghc
-   
-   #test:
-   ghc --version
-   
-   #example of output:
-   The Glorious Glasgow Haskell Compilation System, version 8.4.4
-   ```
-
-4. Compile Stack:
-   1. Install Stack v2.1.3
-      ```
-      cd ~/
-      wget -qO- https://raw.githubusercontent.com/commercialhaskell/stack/v2.1.3/etc/scripts/get-stack.sh | sh
-      
-      #test with
-      stack --version
-      
-      #example output:
-      Version 2.1.3, Git revision 636e3a759d51127df2b62f90772def126cdf6d1f (7735 commits) arm hpack-0.31.2
-      ```
-    
-   1. Use current Stack to compile Stack v2.5.1:
-      ```
-      git clone --depth 1 --branch v2.5.1 https://github.com/commercialhaskell/stack.git
-      cd stack
-      sudo apt install -y screen
-      screen
-      ```
-      > :information_source: Build (>=3.5h total... We are using `screen` in case of session timeout issues)
-     
-      > :memo:  If you get disconected you can reattach last sesion again by executing `screen -r`
-      ```
-      stack build --stack-yaml=stack-ghc-84.yaml --system-ghc
-      
-      #Install
-      stack install --stack-yaml=stack-ghc-84.yaml --system-ghc
-      export PATH=~/.local/bin:$PATH
-      ```
-
-5. Clone EmbassyOS & try to *make* the `agent`:
-   1. First attempt
-      > :information_source: The first time you run **make** you'll get an error
-      
-      ```
-      sudo apt install -y llvm-9 libgmp-dev
-      export PATH=/usr/lib/llvm-9/bin:$PATH
-      cd ~/
-      git clone https://github.com/Start9Labs/embassy-os.git
-      cd embassy-os/
-      make agent
-      ```
-      > :memo: This will install ghc-8.10.2, then attempt to build but will give errors (in next steps we deal with errors)
-   1. Confirm your cpu info
-      ```
-      cat /proc/cpuinfo | grep Hardware
-      ```
-   1. If your "Hardware" is [BCM2711](https://www.raspberrypi.org/documentation/hardware/raspberrypi/bcm2711/README.md) then:
-      1. Change `C compiler flags` to `-marm -fno-stack-protector -mcpu=cortex-a7` in the GHC settings:
-         ```
-         nano ~/.stack/programs/arm-linux/ghc-8.10.4/lib/ghc-8.10.4/settings
-         ```
-   1. To prevent gcc errors we delete the `setup-exe-src` folder
-      ```
-      rm -rf ~/.stack/setup-exe-src/
-      ```
-
-6. Install requirements for step 7
-   1. Install NVM
-      ```
-      cd ~/ && curl -o- https://raw.githubusercontent.com/nvm-sh/nvm/v0.35.3/install.sh | bash
-      export NVM_DIR="$HOME/.nvm"
-      [ -s "$NVM_DIR/nvm.sh" ] && \. "$NVM_DIR/nvm.sh"  # This loads nvm
-      [ -s "$NVM_DIR/bash_completion" ] && \. "$NVM_DIR/bash_completion"  # This loads nvm bash_completion
-      nvm --version
-      ```
-   1. Install Node.js & NPM
-      ```
-      nvm install node
-      ```
-   1. Install Ionic CLI
-      ```
-      npm install -g @ionic/cli
-      ```
-   1. Install Dependencies
-      ```
-      sudo apt-get install -y build-essential openssl libssl-dev libc6-dev clang libclang-dev libavahi-client-dev upx ca-certificates
-      ```
-   1. Install Rust
-      ```
-      cd ~/ && curl --proto '=https' --tlsv1.2 -sSf https://sh.rustup.rs -o- | bash
-      
-      #Choose option 1
-      source $HOME/.cargo/env
-
-      #Check rust & cargo versions
-      rustc --version
-      cargo --version
-      ```
-
-7. Finally, getting to build the **.img**
-   1. At this stage you hava a working development environment to build your **embassy.img**.
-      Before you do that you can choose to enable SSH login for user `pi` in case something will go wrong or just skip to the next step.
-      ```
-      cd ~/embassy-os
-      sed -e '/passwd -l pi/ s/^#*/#/' -i setup.sh
-      ```
-      > :warning: Default password for user `pi` is `raspberry`, change it the next you login.
-   1. Build the `embassy.img`
-      ```
-      cd ~/embassy-os
-      make
-      
-      #Depending on your hardware this can take 1-2h+
-      #Wait for the "DONE!" message and take note of your product_key
-      exit
-      ```
-8. Flash the `embassy.img` to a microSD
-   1. Copy `embassy.img` from the raspi to your PC with scp
-      ```
-      scp pi@raspi_IP:~/embassy-os/embassy.img .
-      ```
-   1. Connect to raspi again to do `sudo shutdown now`, after a complete shutdown disconnect SSD/NVMe drive
-   1. Flash `embassy.img` to a microSD (do this before flashing to the SSD/NVMe, to be sure it works)
-
-9. Prepare for initial setup
-   1. Boot raspi using flashed microSD
-   1. After a few minutes, the raspi should reboot itself and make it's first [sounds](#embassy-sounds-explained).
-      > :information_source: If needed, you can check the `agent` log with: `journalctl -u agent -ef`
-   1. Proceed with the [initial setup process of EmbassyOS](https://docs.start9labs.com/user-manual/initial-setup.html)
-   1. If all went well you can safely flash `embassy.img` to an SSD/NVMe and repeat step 9
-
-### Embassy sounds explained
-Sound :notes: | Indicating 
-------- | --------
-Bep | Device is powering on
-Chime | Device is ready for setup
-Mario "Coin" | EmbassyOS has started
-Mario "Death" | Device is about to Shutdown/Reboot
-Mario "Power Up" | EmbassyOS update sequence
-Beethoven | Update failed :(

CONTRIBUTING.md

@@ -1,237 +1,133 @@
-<!-- omit in toc -->
-# Contributing to Embassy OS
+# Contributing to StartOS
 
-First off, thanks for taking the time to contribute! ❤️
+This guide is for contributing to the StartOS. If you are interested in packaging a service for StartOS, visit the [service packaging guide](https://docs.start9.com/latest/packaging-guide/). If you are interested in promoting, providing technical support, creating tutorials, or helping in other ways, please visit the [Start9 website](https://start9.com/contribute).
 
-All types of contributions are encouraged and valued. See the [Table of Contents](#table-of-contents) for different ways to help and details about how this project handles them. Please make sure to read the relevant section before making your contribution. It will make it a lot easier for us maintainers and smooth out the experience for all involved. The community looks forward to your contributions. 🎉
+## Collaboration
 
-> And if you like the project, but just don't have time to contribute, that's fine. There are other easy ways to support the project and show your appreciation, which we would also be very happy about:
-> - Star the project
-> - Tweet about it
-> - Refer this project in your project's readme
-> - Mention the project at local meetups and tell your friends/colleagues
-> - Buy an [Embassy](https://start9labs.com)
+- [Matrix](https://matrix.to/#/#community-dev:matrix.start9labs.com)
+- [Telegram](https://t.me/start9_labs/47471)
 
-<!-- omit in toc -->
-## Table of Contents
+## Project Structure
 
-- [I Have a Question](#i-have-a-question)
-- [I Want To Contribute](#i-want-to-contribute)
-  - [Reporting Bugs](#reporting-bugs)
-  - [Suggesting Enhancements](#suggesting-enhancements)
-  - [Your First Code Contribution](#your-first-code-contribution)
-    - [Setting Up Your Development Environment](#setting-up-your-development-environment)
-    - [Building The Image](#building-the-image)
-  - [Improving The Documentation](#improving-the-documentation)
-- [Styleguides](#styleguides)
-  - [Formatting](#formatting)
-  - [Atomic Commits](#atomic-commits)
-  - [Commit Messages](#commit-messages)
-  - [Pull Requests](#pull-requests)
-  - [Rebasing Changes](#rebasing-changes)
-- [Join The Discussion](#join-the-discussion)
-- [Join The Project Team](#join-the-project-team)
+```bash
+/
+├── assets/
+├── container-runtime/
+├── core/
+├── build/
+├── debian/
+├── web/
+├── image-recipe/
+├── patch-db
+└── sdk/
+```
 
+#### assets
 
+screenshots for the StartOS README
 
-## I Have a Question
+#### container-runtime
 
-> If you want to ask a question, we assume that you have read the available [Documentation](https://docs.start9labs.com).
+A NodeJS program that dynamically loads maintainer scripts and communicates with the OS to manage packages
 
-Before you ask a question, it is best to search for existing [Issues](https://github.com/Start9Labs/embassy-os/issues) that might help you. In case you have found a suitable issue and still need clarification, you can write your question in this issue. It is also advisable to search the internet for answers first.
+#### core
 
-If you then still feel the need to ask a question and need clarification, we recommend the following:
+An API, daemon (startd), and CLI (start-cli) that together provide the core functionality of StartOS.
 
-- Open an [Issue](https://github.com/Start9Labs/embassy-os/issues/new).
-- Provide as much context as you can about what you're running into.
-- Provide project and platform versions, depending on what seems relevant.
+#### build
 
-We will then take care of the issue as soon as possible.
+Auxiliary files and scripts to include in deployed StartOS images
 
-<!--
-You might want to create a separate issue tag for questions and include it in this description. People should then tag their issues accordingly.
+#### debian
 
-Depending on how large the project is, you may want to outsource the questioning, e.g. to Stack Overflow or Gitter. You may add additional contact and information possibilities:
-- IRC
-- Slack
-- Gitter
-- Stack Overflow tag
-- Blog
-- FAQ
-- Roadmap
-- E-Mail List
-- Forum
--->
+Maintainer scripts for the StartOS Debian package
 
-## I Want To Contribute
+#### web
 
-> ### Legal Notice <!-- omit in toc -->
-> When contributing to this project, you must agree that you have authored 100% of the content, that you have the necessary rights to the content and that the content you contribute may be provided under the project license.
+Web UIs served under various conditions and used to interact with StartOS APIs.
 
-### Reporting Bugs
+#### image-recipe
 
-<!-- omit in toc -->
-#### Before Submitting a Bug Report
+Scripts for building StartOS images
 
-A good bug report shouldn't leave others needing to chase you up for more information. Therefore, we ask you to investigate carefully, collect information and describe the issue in detail in your report. Please complete the following steps in advance to help us fix any potential bug as fast as possible.
+#### patch-db (submodule)
 
-- Make sure that you are using the latest version.
-- Determine if your bug is really a bug and not an error on your side e.g. using incompatible environment components/versions (Make sure that you have read the [documentation](https://docs.start9labs.com). If you are looking for support, you might want to check [this section](#i-have-a-question)).
-- To see if other users have experienced (and potentially already solved) the same issue you are having, check if there is not already a bug report existing for your bug or error in the [bug tracker](https://github.com/Start9Labs/embassy-os/issues?q=label%3Abug).
-- Also make sure to search the internet (including Stack Overflow) to see if users outside of the GitHub community have discussed the issue.
-- Collect information about the bug:
-  - Stack trace (Traceback)
-  - Client OS, Platform and Version (Windows/Linux/macOS/iOS/Android, Firefox/Tor Browser/Consulate)
-  - Version of the interpreter, compiler, SDK, runtime environment, package manager, depending on what seems relevant.
-  - Possibly your input and the output
-  - Can you reliably reproduce the issue? And can you also reproduce it with older versions?
+A diff based data store used to synchronize data between the web interfaces and server.
 
-<!-- omit in toc -->
-#### How Do I Submit a Good Bug Report?
+#### sdk
 
-> You must never report security related issues, vulnerabilities or bugs to the issue tracker, or elsewhere in public. Instead sensitive bugs must be sent by email to <security@start9labs.com>.
-<!-- You may add a PGP key to allow the messages to be sent encrypted as well. -->
+A typescript sdk for building start-os packages
 
-We use GitHub issues to track bugs and errors. If you run into an issue with the project:
+## Environment Setup
 
-- Open an [Issue](https://github.com/Start9Labs/embassy-os/issues/new). (Since we can't be sure at this point whether it is a bug or not, we ask you not to talk about a bug yet and not to label the issue.)
-- Explain the behavior you would expect and the actual behavior.
-- Please provide as much context as possible and describe the *reproduction steps* that someone else can follow to recreate the issue on their own. This usually includes your code. For good bug reports you should isolate the problem and create a reduced test case.
-- Provide the information you collected in the previous section.
+#### Clone the StartOS repository
 
-Once it's filed:
+```sh
+git clone https://github.com/Start9Labs/start-os.git --recurse-submodules
+cd start-os
+```
 
-- The project team will label the issue accordingly.
-- A team member will try to reproduce the issue with your provided steps. If there are no reproduction steps or no obvious way to reproduce the issue, the team will ask you for those steps and mark the issue as `needs-repro`. Bugs with the `needs-repro` tag will not be addressed until they are reproduced.
-- If the team is able to reproduce the issue, it will be marked `needs-fix`, as well as possibly other tags (such as `critical`), and the issue will be left to be [implemented by someone](#your-first-code-contribution).
+#### Continue to your project of interest for additional instructions:
 
-<!-- You might want to create an issue template for bugs and errors that can be used as a guide and that defines the structure of the information to be included. If you do so, reference it here in the description. -->
+- [`core`](core/README.md)
+- [`web-interfaces`](web-interfaces/README.md)
+- [`build`](build/README.md)
+- [`patch-db`](https://github.com/Start9Labs/patch-db)
 
+## Building
 
-### Suggesting Enhancements
+This project uses [GNU Make](https://www.gnu.org/software/make/) to build its components. To build any specific component, simply run `make <TARGET>` replacing `<TARGET>` with the name of the target you'd like to build
 
-This section guides you through submitting an enhancement suggestion for Embassy OS, **including completely new features and minor improvements to existing functionality**. Following these guidelines will help maintainers and the community to understand your suggestion and find related suggestions.
+### Requirements
 
-<!-- omit in toc -->
-#### Before Submitting an Enhancement
+- [GNU Make](https://www.gnu.org/software/make/)
+- [Docker](https://docs.docker.com/get-docker/)
+- [NodeJS v20.16.0](https://docs.npmjs.com/downloading-and-installing-node-js-and-npm)
+- [sed](https://www.gnu.org/software/sed/)
+- [grep](https://www.gnu.org/software/grep/)
+- [awk](https://www.gnu.org/software/gawk/)
+- [jq](https://jqlang.github.io/jq/)
+- [gzip](https://www.gnu.org/software/gzip/)
+- [brotli](https://github.com/google/brotli)
 
-- Make sure that you are using the latest version.
-- Read the [documentation](https://docs.start9labs.com) carefully and find out if the functionality is already covered, maybe by an individual configuration.
-- Perform a [search](https://github.com/Start9Labs/embassy-os/issues) to see if the enhancement has already been suggested. If it has, add a comment to the existing issue instead of opening a new one.
-- Find out whether your idea fits with the scope and aims of the project. It's up to you to make a strong case to convince the project's developers of the merits of this feature. Keep in mind that we want features that will be useful to the majority of our users and not just a small subset. If you're just targeting a minority of users, consider writing an add-on/plugin library.
+### Environment variables
 
-<!-- omit in toc -->
-#### How Do I Submit a Good Enhancement Suggestion?
+- `PLATFORM`: which platform you would like to build for. Must be one of `x86_64`, `x86_64-nonfree`, `aarch64`, `aarch64-nonfree`, `raspberrypi`
+  - NOTE: `nonfree` images are for including `nonfree` firmware packages in the built ISO
+- `ENVIRONMENT`: a hyphen separated set of feature flags to enable
+  - `dev`: enables password ssh (INSECURE!) and does not compress frontends
+  - `unstable`: enables assertions that will cause errors on unexpected inconsistencies that are undesirable in production use either for performance or reliability reasons
+  - `docker`: use `docker` instead of `podman`
+- `GIT_BRANCH_AS_HASH`: set to `1` to use the current git branch name as the git hash so that the project does not need to be rebuilt on each commit
 
-Enhancement suggestions are tracked as [GitHub issues](https://github.com/Start9Labs/embassy-os/issues).
+### Useful Make Targets
 
-- Use a **clear and descriptive title** for the issue to identify the suggestion.
-- Provide a **step-by-step description of the suggested enhancement** in as many details as possible.
-- **Describe the current behavior** and **explain which behavior you expected to see instead** and why. At this point you can also tell which alternatives do not work for you.
-- You may want to **include screenshots and animated GIFs** which help you demonstrate the steps or point out the part which the suggestion is related to. You can use [this tool](https://www.cockos.com/licecap/) to record GIFs on macOS and Windows, and [this tool](https://github.com/colinkeenan/silentcast) or [this tool](https://github.com/GNOME/byzanz) on Linux. <!-- this should only be included if the project has a GUI -->
-- **Explain why this enhancement would be useful** to most Embassy OS users. You may also want to point out the other projects that solved it better and which could serve as inspiration.
-
-<!-- You might want to create an issue template for enhancement suggestions that can be used as a guide and that defines the structure of the information to be included. If you do so, reference it here in the description. -->
-
-### Project Structure
-Embassy OS has 3 main components: `agent`, `appmgr`, and `ui`.
-- The `ui` (Typescript Ionic Angular) is the code that is deployed to the browser to provide the user interface for Embassy OS
-- The `agent` (Haskell) is a daemon that provides the interface for the `ui` to interact with the Embassy, as well as manage system state.
-- `appmgr` (Rust) is a command line utility and (soon to be) daemon that sets up and manages services and their environments.
-
-### Your First Code Contribution
-
-#### Setting up your development environment
-##### agent
-There are two main workflows to consider when developing on the agent. During the development process you will spend
-most of your time developing in an environment where you cannot actually run the agent. This is because we make heavy
-platform specific assumptions (by nature of the project) around what folders get used and what package management tools
-are used for the underlying system. If you are running this on a platform besides Linux you won't even be able to run
-the agent effectively on your dev machine. Even if you are on Linux you may not want to turn administrative control over
-to the software you are currently developing. So how do you know that anything you are doing is right? We make extensive
-use of Haskell's type system and surrounding tooling. For this you will want to make sure you are using the [haskell-language-server](https://github.com/haskell/haskell-language-server)
-and [stack](https://github.com/commercialhaskell/stack)
-
-At some point though you will want to build the agent for the target platform (Raspberry Pi 4). This is the second build
-flow that you will need to consider.
-
-At Start9 we build the agent in two different ways. The primary way we have done it is on the Raspberry Pi itself. To do
-this you will need stack built for the Raspberry Pi. Unfortunately, however, FPComplete no longer
-distributes ARMv7 binaries for stack. Though hopefully soon we will be able to submit the binaries we've built for this
-project back to them and have them hosted more visibly. The way we bootstrap through this problem is by downloading version
-[2.1.3](https://github.com/commercialhaskell/stack/releases/download/v2.1.3/stack-2.1.3-linux-arm.tar.gz) and using that
-to compile v2.5.1. Before you can successfully compile anything with GHC on the Raspberry Pi. You will need to tweak the
-relevant GHC config. You will need to edit the file at `~/.stack/programs/arm-linux/ghc-8.10.2/lib/ghc-8.10.2/settings`
-and change the line `("C compiler flags", " -marm -fno-stack-protector -mcpu=cortex-a7")` to include `-mcpu=cortex-a7`.
-You will also need to make sure you've downloaded and installed LLVM 9.
-
-Once you have done these things, you simply need to `cd` into the embassy-os project and then run `make agent`.
-
-##### ui
-- Requirements
-  - [Install nodejs](https://nodejs.org/en/)
-  - [Install npm](https://www.npmjs.com/get-npm)
-  - [Install ionic cli](https://ionicframework.com/docs/intro/cli)
-- Scripts (run within ./ui directory)
-  - `npm i` installs ui node package dependencies
-  - `npm run build` compiles project, depositing build artifacts into ./ui/www
-  - `npm run build-prod` as above but customized for deployment to an Embassy
-  - `ionic serve` serves the ui on localhost:8100 for local development. Edit ./ui/use-mocks.json to 'true' to use mocks during local development
-  - `./build-send.sh <embassy .local address suffix>` builds the project and deploys it to the referenced Embassy
-    - Find your Embassy on the LAN using the Start9 Setup App or network tools. It's address will be of the form `start9-<suffix>.local`.
-    - For example `./build-send.sh abcdefgh` will deploy the ui to the Embassy with LAN address `start9-abcdefgh.local`.
-    - SSH keys must be installed on the Embassy prior to running this script.
-
-##### appmgr
-  - [Install Rust](https://rustup.rs)
-  - Recommended: [rust-analyzer](https://rust-analyzer.github.io/)
-
-#### Building The Image
-- Requirements
-  - `ext4fs` (available if running on the Linux kernel)
-  - [Docker](https://docs.docker.com/get-docker/)
-  - GNU Make
-- Building
-  - build the [agent](#agent)
-    - make sure resulting artifact is agent/dist/agent
-  - run `make`
-
-### Improving The Documentation
-You can find the repository for Start9's documentation [here](https://github.com/Start9Labs/documentation). If there is something you would like to see added, let us know, or create an issue yourself. Welcome are contributions for lacking or incorrect information, broken links, requested additions, or general style improvements. 
-
-Contributions in the form of setup guides for integrations with external applications are highly encouraged. If you struggled through a process and would like to share your steps with others, check out the docs for each [service](https://github.com/Start9Labs/documentation/blob/master/source/user-manuals/available-services/index.rst) we support. The wrapper repos contain sections for adding integration guides, such as this [one](https://github.com/Start9Labs/bitcoind-wrapper/tree/master/docs). These not only help out others in the community, but inform how we can create a more seamless and intuitive experience.
-
-## Styleguides
-### Formatting
-Code must be formatted with the formatter designated for each component:
-- `ui`: [tslint](https://palantir.github.io/tslint/)
-- `agent`: [brittany](https://github.com/lspitzner/brittany)
-- `appmgr`: [rustfmt](https://github.com/rust-lang/rustfmt)
-
-### Atomic Commits
-Commits [should be atomic](https://en.wikipedia.org/wiki/Atomic_commit#Atomic_commit_convention) and diffs should be easy to read.
-Do not mix any formatting fixes or code moves with actual code changes.
-
-### Commit Messages
-If a commit touches only 1 component, prefix the message with the affected component. i.e. `appmgr: update to tokio v0.3`.
-
-### Pull Requests
-The body of a pull request should contain sufficient description of what the changes do, as well as a justification.
-You should include references to any relevant [issues](https://github.com/Start9Labs/embassy-os/issues).
-
-### Rebasing Changes
-When a pull request conflicts with the target branch, you may be asked to rebase it on top of the current target branch. The git rebase command will take care of rebuilding your commits on top of the new base.
-
-This project aims to have a clean git history, where code changes are only made in non-merge commits. This simplifies auditability because merge commits can be assumed to not contain arbitrary code changes.
-
-## Join The Discussion
-Current or aspiring contributors? Join our community developer [Matrix channel](https://matrix.to/#/#community-dev:matrix.start9labs.com).
-
-Just interested in or using the project? Join our community [Telegram](https://t.me/start9_labs) or [Matrix](https://matrix.to/#/#community:matrix.start9labs.com).
-
-## Join The Project Team
-Interested in becoming a part of the Start9 Labs team? Send an email to <jobs@start9labs.com>
-
-<!-- omit in toc -->
-## Attribution
-This guide is based on the **contributing-gen**. [Make your own](https://github.com/bttger/contributing-gen)!
+- `iso`: Create a full `.iso` image
+  - Only possible from Debian
+  - Not available for `PLATFORM=raspberrypi`
+  - Additional Requirements:
+    - [debspawn](https://github.com/lkhq/debspawn)
+- `img`: Create a full `.img` image
+  - Only possible from Debian
+  - Only available for `PLATFORM=raspberrypi`
+  - Additional Requirements:
+    - [debspawn](https://github.com/lkhq/debspawn)
+- `format`: Run automatic code formatting for the project
+  - Additional Requirements:
+    - [rust](https://rustup.rs/)
+- `test`: Run automated tests for the project
+  - Additional Requirements:
+    - [rust](https://rustup.rs/)
+- `update`: Deploy the current working project to a device over ssh as if through an over-the-air update
+  - Requires an argument `REMOTE` which is the ssh address of the device, i.e. `start9@192.168.122.2`
+- `reflash`: Deploy the current working project to a device over ssh as if using a live `iso` image to reflash it
+  - Requires an argument `REMOTE` which is the ssh address of the device, i.e. `start9@192.168.122.2`
+- `update-overlay`: Deploy the current working project to a device over ssh to the in-memory overlay without restarting it
+  - WARNING: changes will be reverted after the device is rebooted
+  - WARNING: changes to `init` will not take effect as the device is already initialized
+  - Requires an argument `REMOTE` which is the ssh address of the device, i.e. `start9@192.168.122.2`
+- `wormhole`: Deploy the `startbox` to a device using [magic-wormhole](https://github.com/magic-wormhole/magic-wormhole)
+  - When the build it complete will emit a command to paste into the shell of the device to upgrade it
+  - Additional Requirements:
+    - [magic-wormhole](https://github.com/magic-wormhole/magic-wormhole)
+- `clean`: Delete all compiled artifacts

DEVELOPMENT.md

@@ -0,0 +1,134 @@
+# Setting up your development environment on Debian/Ubuntu
+
+A step-by-step guide
+
+> This is the only officially supported build environment.
+> MacOS has limited build capabilities and Windows requires [WSL2](https://learn.microsoft.com/en-us/windows/wsl/install)
+
+## Installing dependencies
+
+Run the following commands one at a time
+
+```sh
+sudo apt update
+sudo apt install -y ca-certificates curl gpg build-essential
+curl -fsSL https://download.docker.com/linux/debian/gpg | sudo gpg --dearmor -o /usr/share/keyrings/docker-archive-keyring.gpg
+echo "deb [arch=$(dpkg-architecture -q DEB_HOST_ARCH) signed-by=/usr/share/keyrings/docker-archive-keyring.gpg] https://download.docker.com/linux/debian bookworm stable" | sudo tee /etc/apt/sources.list.d/docker.list
+sudo apt update
+sudo apt install -y sed grep gawk jq gzip brotli containerd.io docker-ce docker-ce-cli docker-compose-plugin qemu-user-static binfmt-support squashfs-tools git debspawn rsync b3sum
+sudo mkdir -p /etc/debspawn/
+echo "AllowUnsafePermissions=true" | sudo tee /etc/debspawn/global.toml
+sudo usermod -aG docker $USER
+sudo su $USER
+docker run --privileged --rm tonistiigi/binfmt --install all
+docker buildx create --use
+curl --proto '=https' --tlsv1.2 -sSf https://sh.rustup.rs | sh # proceed with default installation
+curl -o- https://raw.githubusercontent.com/nvm-sh/nvm/master/install.sh | bash
+source ~/.bashrc
+nvm install 24
+nvm use 24
+nvm alias default 24 # this prevents your machine from reverting back to another version
+```
+
+## Cloning the repository
+
+```sh
+git clone --recursive https://github.com/Start9Labs/start-os.git --branch next/major
+cd start-os
+```
+
+## Building an ISO
+
+```sh
+PLATFORM=$(uname -m) ENVIRONMENT=dev make iso
+```
+
+This will build an ISO for your current architecture. If you are building to run on an architecture other than the one you are currently on, replace `$(uname -m)` with the correct platform for the device (one of `aarch64`, `aarch64-nonfree`, `x86_64`, `x86_64-nonfree`, `raspberrypi`)
+
+## Creating a VM
+
+### Install virt-manager
+
+```sh
+sudo apt update
+sudo apt install -y virt-manager
+sudo usermod -aG libvirt $USER
+sudo su $USER
+```
+
+### Launch virt-manager
+
+```sh
+virt-manager
+```
+
+### Create new virtual machine
+
+![Select "Create a new virtual machine"](assets/create-vm/step-1.png)
+![Click "Forward"](assets/create-vm/step-2.png)
+![Click "Browse"](assets/create-vm/step-3.png)
+![Click "+"](assets/create-vm/step-4.png)
+
+#### make sure to set "Target Path" to the path to your results directory in start-os
+
+![Create storage pool](assets/create-vm/step-5.png)
+![Select storage pool](assets/create-vm/step-6.png)
+![Select ISO](assets/create-vm/step-7.png)
+![Select "Generic or unknown OS" and click "Forward"](assets/create-vm/step-8.png)
+![Set Memory and CPUs](assets/create-vm/step-9.png)
+![Create disk](assets/create-vm/step-10.png)
+![Name VM](assets/create-vm/step-11.png)
+![Create network](assets/create-vm/step-12.png)
+
+## Updating a VM
+
+The fastest way to update a VM to your latest code depends on what you changed:
+
+### UI or startd:
+
+```sh
+PLATFORM=$(uname -m) ENVIRONMENT=dev make update-startbox REMOTE=start9@<VM IP>
+```
+
+### Container runtime or debian dependencies:
+
+```sh
+PLATFORM=$(uname -m) ENVIRONMENT=dev make update-deb REMOTE=start9@<VM IP>
+```
+
+### Image recipe:
+
+```sh
+PLATFORM=$(uname -m) ENVIRONMENT=dev make update-squashfs REMOTE=start9@<VM IP>
+```
+
+---
+
+If the device you are building for is not available via ssh, it is also possible to use `magic-wormhole` to send the relevant files.
+
+### Prerequisites:
+
+```sh
+sudo apt update
+sudo apt install -y magic-wormhole
+```
+
+As before, the fastest way to update a VM to your latest code depends on what you changed. Each of the following commands will return a command to paste into the shell of the device you would like to upgrade.
+
+### UI or startd:
+
+```sh
+PLATFORM=$(uname -m) ENVIRONMENT=dev make wormhole
+```
+
+### Container runtime or debian dependencies:
+
+```sh
+PLATFORM=$(uname -m) ENVIRONMENT=dev make wormhole-deb
+```
+
+### Image recipe:
+
+```sh
+PLATFORM=$(uname -m) ENVIRONMENT=dev make wormhole-squashfs
+```

LICENSE

@@ -0,0 +1,21 @@
+MIT License
+
+Copyright (c) 2023 Start9 Labs, Inc.
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

LICENSE.md

@@ -1,25 +0,0 @@
-# START9 PERSONAL USE LICENSE v1.0
-
-This license governs the use of the accompanying Software. If you use the Software, you accept this license. If you do not accept the license, do not use the Software.
-
-1. **Definitions.**
-    1. “Licensor” means the copyright owner, Start9 Labs, Inc, or its successor(s) in interest, or a future assignee of the copyright.
-    2. “Source Code” means the preferred form of the Software for making modifications to it.
-    3. “Object Code” means any non-source form of the Software, including the machine-language output by a compiler or assembler.
-    4. “Distribute” means to convey or to publish and generally has the same meaning here as under U.S. Copyright law.
-    5. “Sell” means practicing any or all of the rights granted to you under the License to provide to third parties, for a fee or other consideration (including without limitation fees for hosting or consulting/support services related to the Software), a product or service whose value derives, entirely or substantially, from the functionality of the Software.
-
-2. **Grant of Rights.** Subject to the terms of this license, the Licensor grants you, the licensee, a non-exclusive, worldwide, royalty-free copyright license to:
-    1. Access, audit, copy, modify, compile, or distribute the Source Code or modifications to the Source Code.
-    2. Run, test, or otherwise use the Object Code.
-
-3. **Limitations.**
-    1. The grant of rights under the License will NOT include, and the License does NOT grant you the right to:
-        1. Sell the Software or any derivative works based thereon.
-        2. Distribute the Object Code.
-    2. If you Distribute the Source Code, or if permission is separately granted to Distribute the Object Code, you expressly undertake not to remove, or modify, in any manner, the copyright notices attached to the Source Code, and displayed in any output of the Object Code when run, and to reproduce these notices, in an identical manner, in any distributed copies of the Software together with a copy of this license. If you Distribute a modified copy of the Software, or a derivative work based thereon, the work must carry prominent notices stating that you modified it, and giving a relevant date.
-    3. The terms of this license will apply to anyone who comes into possession of a copy of the Software, and any modifications or derivative works based thereon, made by anyone.
-
-4. **Contributions.** You hereby grant to Licensor a perpetual, irrevocable, worldwide, non-exclusive, royalty-free license to use and exploit any modifications or derivative works based on the Source Code of which you are the author.
-
-5. **Disclaimer.** THE SOFTWARE IS PROVIDED “AS IS”, WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. LICENSOR HAS NO OBLIGATION TO SUPPORT RECIPIENTS OF THE SOFTWARE.

Makefile

@@ -1,75 +1,386 @@
-UNAME := $(shell uname -m)
+ls-files = $(shell git ls-files --cached --others --exclude-standard $1) 
+PROFILE = release
 
-EMBASSY_SRC := buster.img product_key appmgr/target/armv7-unknown-linux-gnueabihf/release/appmgr ui/www agent/dist/agent agent/config/agent.service lifeline/target/armv7-unknown-linux-gnueabihf/release/lifeline lifeline/lifeline.service setup.sh setup.service docker-daemon.json
-APPMGR_RELEASE_SRC := appmgr/target/armv7-unknown-linux-gnueabihf/release/appmgr
-LIFELINE_RELEASE_SRC := lifeline/target/armv7-unknown-linux-gnueabihf/release/lifeline
+PLATFORM_FILE := $(shell ./check-platform.sh)
+ENVIRONMENT_FILE := $(shell ./check-environment.sh)
+GIT_HASH_FILE := $(shell ./check-git-hash.sh)
+VERSION_FILE := $(shell ./check-version.sh)
+BASENAME := $(shell PROJECT=startos ./basename.sh)
+PLATFORM := $(shell if [ -f ./PLATFORM.txt ]; then cat ./PLATFORM.txt; else echo unknown; fi)
+ARCH := $(shell if [ "$(PLATFORM)" = "raspberrypi" ]; then echo aarch64; else echo $(PLATFORM) | sed 's/-nonfree$$//g'; fi)
+RUST_ARCH := $(shell if [ "$(ARCH)" = "riscv64" ]; then echo riscv64gc; else echo $(ARCH); fi)
+REGISTRY_BASENAME := $(shell PROJECT=start-registry PLATFORM=$(ARCH) ./basename.sh)
+TUNNEL_BASENAME := $(shell PROJECT=start-tunnel PLATFORM=$(ARCH) ./basename.sh)
+IMAGE_TYPE=$(shell if [ "$(PLATFORM)" = raspberrypi ]; then echo img; else echo iso; fi)
+WEB_UIS := web/dist/raw/ui/index.html web/dist/raw/setup-wizard/index.html web/dist/raw/install-wizard/index.html
+COMPRESSED_WEB_UIS := web/dist/static/ui/index.html web/dist/static/setup-wizard/index.html web/dist/static/install-wizard/index.html
+FIRMWARE_ROMS := ./firmware/$(PLATFORM) $(shell jq --raw-output '.[] | select(.platform[] | contains("$(PLATFORM)")) | "./firmware/$(PLATFORM)/" + .id + ".rom.gz"' build/lib/firmware.json)
+BUILD_SRC := $(call ls-files, build) build/lib/depends build/lib/conflicts $(FIRMWARE_ROMS)
+IMAGE_RECIPE_SRC := $(call ls-files, image-recipe/)
+STARTD_SRC := core/startos/startd.service $(BUILD_SRC)
+CORE_SRC := $(call ls-files, core) $(shell git ls-files --recurse-submodules patch-db) $(GIT_HASH_FILE)
+WEB_SHARED_SRC := $(call ls-files, web/projects/shared) $(call ls-files, web/projects/marketplace) $(shell ls -p web/ | grep -v / | sed 's/^/web\//g') web/node_modules/.package-lock.json web/config.json patch-db/client/dist/index.js sdk/baseDist/package.json web/patchdb-ui-seed.json sdk/dist/package.json
+WEB_UI_SRC := $(call ls-files, web/projects/ui)
+WEB_SETUP_WIZARD_SRC := $(call ls-files, web/projects/setup-wizard)
+WEB_INSTALL_WIZARD_SRC := $(call ls-files, web/projects/install-wizard)
+WEB_START_TUNNEL_SRC := $(call ls-files, web/projects/start-tunnel)
+PATCH_DB_CLIENT_SRC := $(shell git ls-files --recurse-submodules patch-db/client)
+GZIP_BIN := $(shell which pigz || which gzip)
+TAR_BIN := $(shell which gtar || which tar)
+COMPILED_TARGETS := core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/startbox core/target/$(RUST_ARCH)-unknown-linux-musl/release/containerbox container-runtime/rootfs.$(ARCH).squashfs
+STARTOS_TARGETS := $(STARTD_SRC) $(ENVIRONMENT_FILE) $(GIT_HASH_FILE) $(VERSION_FILE) $(COMPILED_TARGETS) cargo-deps/$(RUST_ARCH)-unknown-linux-musl/release/startos-backup-fs $(PLATFORM_FILE) \
+	$(shell if [ "$(PLATFORM)" = "raspberrypi" ]; then \
+		echo cargo-deps/aarch64-unknown-linux-musl/release/pi-beep; \
+	fi) \
+	$(shell /bin/bash -c 'if [[ "${ENVIRONMENT}" =~ (^|-)unstable($$|-) ]]; then \
+		echo cargo-deps/$(RUST_ARCH)-unknown-linux-musl/release/flamegraph; \
+	fi') \
+	$(shell /bin/bash -c 'if [[ "${ENVIRONMENT}" =~ (^|-)console($$|-) ]]; then \
+		echo cargo-deps/$(RUST_ARCH)-unknown-linux-musl/release/tokio-console; \
+	fi')
+REGISTRY_TARGETS := core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/registrybox core/startos/start-registryd.service
+TUNNEL_TARGETS := core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/tunnelbox core/startos/start-tunneld.service
+REBUILD_TYPES = 1
 
-ifeq ($(UNAME), armv7l)
-	EMBASSY_SRC := buster.img product_key appmgr/target/release/appmgr ui/www agent/dist/agent agent/config/agent.service lifeline/target/release/lifeline lifeline/lifeline.service setup.sh setup.service docker-daemon.json
-	APPMGR_RELEASE_SRC := appmgr/target/release/appmgr
-	LIFELINE_RELEASE_SRC := lifeline/target/release/lifeline
-endif
-
-APPMGR_SRC := $(shell find appmgr/src) appmgr/Cargo.toml appmgr/Cargo.lock
-LIFELINE_SRC := $(shell find lifeline/src) lifeline/Cargo.toml lifeline/Cargo.lock
-AGENT_SRC := $(shell find agent/src) $(shell find agent/config) agent/stack.yaml agent/package.yaml agent/build.sh
-UI_SRC := $(shell find ui/src) \
-			ui/angular.json \
-			ui/browserslist \
-			ui/client-manifest.yaml \
-			ui/ionic.config.json \
-			ui/postprocess.ts \
-			ui/tsconfig.json \
-			ui/tslint.json \
-			ui/use-mocks.json
-
-all: embassy.img
-
-embassy.img: $(EMBASSY_SRC)
-	chmod +x make_image.sh
-	sudo ./make_image.sh
-
-buster.img:
-	wget -O buster.zip https://downloads.raspberrypi.org/raspios_lite_armhf/images/raspios_lite_armhf-2020-08-24/2020-08-20-raspios-buster-armhf-lite.zip
-	unzip buster.zip
-	rm buster.zip
-	mv 2020-08-20-raspios-buster-armhf-lite.img buster.img
-
-product_key:
-	echo "X\c" > product_key
-	cat /dev/random | base32 | head -c11 | tr '[:upper:]' '[:lower:]' >> product_key
-
-$(APPMGR_RELEASE_SRC): $(APPMGR_SRC)
-ifeq ($(UNAME), armv7l)
-	cd appmgr && cargo update && cargo build --release --features=production
-	arm-linux-gnueabihf-strip appmgr/target/release/appmgr
+ifeq ($(REMOTE),)
+	mkdir = mkdir -p $1
+	rm = rm -rf $1
+	cp = cp -r $1 $2
+	ln = ln -sf $1 $2
 else
-	docker run --rm -it -v ~/.cargo/registry:/root/.cargo/registry -v "$(shell pwd)":/home/rust/src start9/rust-arm-cross:latest sh -c "(cd appmgr && cargo build --release --features=production)"
-	docker run --rm -it -v ~/.cargo/registry:/root/.cargo/registry -v "$(shell pwd)":/home/rust/src start9/rust-arm-cross:latest arm-linux-gnueabi-strip appmgr/target/armv7-unknown-linux-gnueabihf/release/appmgr
+	ifeq ($(SSHPASS),)
+		ssh = ssh $(REMOTE) $1
+	else 
+		ssh = sshpass -p $(SSHPASS) ssh $(REMOTE) $1
+	endif
+	mkdir = $(call ssh,'sudo mkdir -p $1')
+	rm  = $(call ssh,'sudo rm -rf $1')
+	ln = $(call ssh,'sudo ln -sf $1 $2')
+define cp
+	$(TAR_BIN) --transform "s|^$1|x|" -czv -f- $1 | $(call ssh,"sudo tar --transform 's|^x|$2|' -xzv -f- -C /")
+endef
 endif
 
-appmgr: $(APPMGR_RELEASE_SRC)
+.DELETE_ON_ERROR:
 
-agent/dist/agent: $(AGENT_SRC)
-	(cd agent && ./build.sh)
+.PHONY: all metadata install clean format cli uis ui reflash deb $(IMAGE_TYPE) squashfs wormhole wormhole-deb test test-core test-sdk test-container-runtime registry install-registry tunnel install-tunnel
 
-agent: agent/dist/agent
+all: $(STARTOS_TARGETS)
 
-ui/node_modules: ui/package.json
-	npm --prefix ui install
+touch:
+	touch $(STARTOS_TARGETS)
 
-ui/www: $(UI_SRC) ui/node_modules
-	npm --prefix ui run build-prod
+metadata: $(VERSION_FILE) $(PLATFORM_FILE) $(ENVIRONMENT_FILE) $(GIT_HASH_FILE)
 
-ui: ui/www
+clean:
+	rm -rf core/target
+	rm -rf core/startos/bindings
+	rm -rf web/.angular
+	rm -f web/config.json
+	rm -rf web/node_modules
+	rm -rf web/dist
+	rm -rf patch-db/client/node_modules
+	rm -rf patch-db/client/dist
+	rm -rf patch-db/target
+	rm -rf cargo-deps
+	rm -rf dpkg-workdir
+	rm -rf image-recipe/deb
+	rm -rf results
+	rm -rf build/lib/firmware
+	rm -rf container-runtime/dist
+	rm -rf container-runtime/node_modules
+	rm -f container-runtime/*.squashfs
+	if [ -d container-runtime/tmp/combined ] && mountpoint container-runtime/tmp/combined; then sudo umount container-runtime/tmp/combined; fi
+	if [ -d container-runtime/tmp/lower ] && mountpoint container-runtime/tmp/lower; then sudo umount container-runtime/tmp/lower; fi
+	rm -rf container-runtime/tmp
+	(cd sdk && make clean)
+	rm -f ENVIRONMENT.txt
+	rm -f PLATFORM.txt
+	rm -f GIT_HASH.txt
+	rm -f VERSION.txt
 
-$(LIFELINE_RELEASE_SRC): $(LIFELINE_SRC)
-ifeq ($(UNAME), armv7l)
-	cd lifeline && cargo build --release
-	arm-linux-gnueabihf-strip lifeline/target/release/lifeline
-else
-	docker run --rm -it -v ~/.cargo/registry:/root/.cargo/registry -v "$(shell pwd)":/home/rust/src start9/rust-arm-cross:latest sh -c "(cd lifeline && cargo build --release)"
-	docker run --rm -it -v ~/.cargo/registry:/root/.cargo/registry -v "$(shell pwd)":/home/rust/src start9/rust-arm-cross:latest arm-linux-gnueabi-strip lifeline/target/armv7-unknown-linux-gnueabihf/release/lifeline
-endif
+format:
+	cd core && cargo +nightly fmt
 
-lifeline: $(LIFELINE_RELEASE_SRC)
+test: | test-core test-sdk test-container-runtime
+
+test-core: $(CORE_SRC) $(ENVIRONMENT_FILE) 
+	./core/run-tests.sh
+
+test-sdk: $(call ls-files, sdk) sdk/base/lib/osBindings/index.ts
+	cd sdk && make test
+
+test-container-runtime: container-runtime/node_modules/.package-lock.json $(call ls-files, container-runtime/src) container-runtime/package.json container-runtime/tsconfig.json 
+	cd container-runtime && npm test
+
+cli:
+	./core/install-cli.sh
+
+registry: core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/registrybox
+
+install-registry: $(REGISTRY_TARGETS)
+	$(call mkdir,$(DESTDIR)/usr/bin)
+	$(call cp,core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/registrybox,$(DESTDIR)/usr/bin/start-registrybox)
+	$(call ln,/usr/bin/start-registrybox,$(DESTDIR)/usr/bin/start-registryd)
+	$(call ln,/usr/bin/start-registrybox,$(DESTDIR)/usr/bin/start-registry)
+
+	$(call mkdir,$(DESTDIR)/lib/systemd/system)
+	$(call cp,core/startos/start-registryd.service,$(DESTDIR)/lib/systemd/system/start-registryd.service)
+
+core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/registrybox: $(CORE_SRC) $(ENVIRONMENT_FILE)
+	ARCH=$(ARCH) PROFILE=$(PROFILE) ./core/build-registrybox.sh
+
+tunnel: core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/tunnelbox
+
+install-tunnel: core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/tunnelbox core/startos/start-tunneld.service
+	$(call mkdir,$(DESTDIR)/usr/bin)
+	$(call cp,core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/tunnelbox,$(DESTDIR)/usr/bin/start-tunnelbox)
+	$(call ln,/usr/bin/start-tunnelbox,$(DESTDIR)/usr/bin/start-tunneld)
+	$(call ln,/usr/bin/start-tunnelbox,$(DESTDIR)/usr/bin/start-tunnel)
+
+	$(call mkdir,$(DESTDIR)/lib/systemd/system)
+	$(call cp,core/startos/start-tunneld.service,$(DESTDIR)/lib/systemd/system/start-tunneld.service)
+
+	$(call mkdir,$(DESTDIR)/usr/lib/startos/scripts)
+	$(call cp,build/lib/scripts/forward-port,$(DESTDIR)/usr/lib/startos/scripts/forward-port)
+
+core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/tunnelbox: $(CORE_SRC) $(ENVIRONMENT_FILE) $(GIT_HASH_FILE) web/dist/static/start-tunnel/index.html
+	ARCH=$(ARCH) PROFILE=$(PROFILE) ./core/build-tunnelbox.sh
+
+deb: results/$(BASENAME).deb
+
+results/$(BASENAME).deb: dpkg-build.sh $(call ls-files,debian/startos) $(STARTOS_TARGETS)
+	PLATFORM=$(PLATFORM) REQUIRES=debian ./build/os-compat/run-compat.sh ./dpkg-build.sh
+
+registry-deb: results/$(REGISTRY_BASENAME).deb
+
+results/$(REGISTRY_BASENAME).deb: dpkg-build.sh $(call ls-files,debian/start-registry) $(REGISTRY_TARGETS)
+	PROJECT=start-registry PLATFORM=$(ARCH) REQUIRES=debian ./build/os-compat/run-compat.sh ./dpkg-build.sh
+
+tunnel-deb: results/$(TUNNEL_BASENAME).deb
+
+results/$(TUNNEL_BASENAME).deb: dpkg-build.sh $(call ls-files,debian/start-tunnel) $(TUNNEL_TARGETS)
+	PROJECT=start-tunnel PLATFORM=$(ARCH) REQUIRES=debian DEPENDS=wireguard-tools,iptables,conntrack ./build/os-compat/run-compat.sh ./dpkg-build.sh
+
+$(IMAGE_TYPE): results/$(BASENAME).$(IMAGE_TYPE)
+
+squashfs: results/$(BASENAME).squashfs
+
+results/$(BASENAME).$(IMAGE_TYPE) results/$(BASENAME).squashfs: $(IMAGE_RECIPE_SRC) results/$(BASENAME).deb
+	./image-recipe/run-local-build.sh "results/$(BASENAME).deb"
+
+# For creating os images. DO NOT USE
+install: $(STARTOS_TARGETS)
+	$(call mkdir,$(DESTDIR)/usr/bin)
+	$(call mkdir,$(DESTDIR)/usr/sbin)
+	$(call cp,core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/startbox,$(DESTDIR)/usr/bin/startbox)
+	$(call ln,/usr/bin/startbox,$(DESTDIR)/usr/bin/startd)
+	$(call ln,/usr/bin/startbox,$(DESTDIR)/usr/bin/start-cli)
+	if [ "$(PLATFORM)" = "raspberrypi" ]; then $(call cp,cargo-deps/aarch64-unknown-linux-musl/release/pi-beep,$(DESTDIR)/usr/bin/pi-beep); fi
+	if /bin/bash -c '[[ "${ENVIRONMENT}" =~ (^|-)unstable($$|-) ]]'; then \
+		$(call cp,cargo-deps/$(RUST_ARCH)-unknown-linux-musl/release/flamegraph,$(DESTDIR)/usr/bin/flamegraph); \
+	fi
+	if /bin/bash -c '[[ "${ENVIRONMENT}" =~ (^|-)console($$|-) ]]'; then \
+		$(call cp,cargo-deps/$(RUST_ARCH)-unknown-linux-musl/release/tokio-console,$(DESTDIR)/usr/bin/tokio-console); \
+	fi
+	$(call cp,cargo-deps/$(RUST_ARCH)-unknown-linux-musl/release/startos-backup-fs,$(DESTDIR)/usr/bin/startos-backup-fs)
+	$(call ln,/usr/bin/startos-backup-fs,$(DESTDIR)/usr/sbin/mount.backup-fs)
+	
+	$(call mkdir,$(DESTDIR)/lib/systemd/system)
+	$(call cp,core/startos/startd.service,$(DESTDIR)/lib/systemd/system/startd.service)
+
+	$(call mkdir,$(DESTDIR)/usr/lib)
+	$(call rm,$(DESTDIR)/usr/lib/startos)
+	$(call cp,build/lib,$(DESTDIR)/usr/lib/startos)
+	$(call mkdir,$(DESTDIR)/usr/lib/startos/container-runtime)
+	$(call cp,container-runtime/rootfs.$(ARCH).squashfs,$(DESTDIR)/usr/lib/startos/container-runtime/rootfs.squashfs)
+
+	$(call cp,PLATFORM.txt,$(DESTDIR)/usr/lib/startos/PLATFORM.txt)
+	$(call cp,ENVIRONMENT.txt,$(DESTDIR)/usr/lib/startos/ENVIRONMENT.txt)
+	$(call cp,GIT_HASH.txt,$(DESTDIR)/usr/lib/startos/GIT_HASH.txt)
+	$(call cp,VERSION.txt,$(DESTDIR)/usr/lib/startos/VERSION.txt)
+
+	$(call cp,firmware/$(PLATFORM),$(DESTDIR)/usr/lib/startos/firmware)
+
+update-overlay: $(STARTOS_TARGETS)
+	@echo "\033[33m!!! THIS WILL ONLY REFLASH YOUR DEVICE IN MEMORY !!!\033[0m"
+	@echo "\033[33mALL CHANGES WILL BE REVERTED IF YOU RESTART THE DEVICE\033[0m"
+	@if [ -z "$(REMOTE)" ]; then >&2 echo "Must specify REMOTE" && false; fi
+	@if [ "`ssh $(REMOTE) 'cat /usr/lib/startos/VERSION.txt'`" != "`cat ./VERSION.txt`" ]; then >&2 echo "StartOS requires migrations: update-overlay is unavailable." && false; fi
+	$(call ssh,"sudo systemctl stop startd")
+	$(MAKE) install REMOTE=$(REMOTE) SSHPASS=$(SSHPASS) PLATFORM=$(PLATFORM)
+	$(call ssh,"sudo systemctl start startd")
+
+wormhole: core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/startbox
+	@echo "Paste the following command into the shell of your StartOS server:"
+	@echo
+	@wormhole send core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/startbox 2>&1 | awk -Winteractive '/wormhole receive/ { printf "sudo /usr/lib/startos/scripts/chroot-and-upgrade \"cd /usr/bin && rm startbox && wormhole receive --accept-file %s && chmod +x startbox\"\n", $$3 }'
+
+wormhole-deb: results/$(BASENAME).deb
+	@echo "Paste the following command into the shell of your StartOS server:"
+	@echo
+	@wormhole send results/$(BASENAME).deb 2>&1 | awk -Winteractive '/wormhole receive/ { printf "sudo /usr/lib/startos/scripts/chroot-and-upgrade '"'"'cd $$(mktemp -d) && wormhole receive --accept-file %s && apt-get install -y --reinstall ./$(BASENAME).deb'"'"'\n", $$3 }'
+
+wormhole-squashfs: results/$(BASENAME).squashfs
+	$(eval SQFS_SUM := $(shell b3sum results/$(BASENAME).squashfs | head -c 32))
+	$(eval SQFS_SIZE := $(shell du -s --bytes results/$(BASENAME).squashfs | awk '{print $$1}'))
+	@echo "Paste the following command into the shell of your StartOS server:"
+	@echo
+	@wormhole send results/$(BASENAME).squashfs 2>&1 | awk -Winteractive '/wormhole receive/ { printf "sudo sh -c '"'"'/usr/lib/startos/scripts/prune-images $(SQFS_SIZE) && /usr/lib/startos/scripts/prune-boot && cd /media/startos/images && wormhole receive --accept-file %s && CHECKSUM=$(SQFS_SUM) /usr/lib/startos/scripts/upgrade ./$(BASENAME).squashfs'"'"'\n", $$3 }'
+
+update: $(STARTOS_TARGETS)
+	@if [ -z "$(REMOTE)" ]; then >&2 echo "Must specify REMOTE" && false; fi
+	$(call ssh,'sudo /usr/lib/startos/scripts/chroot-and-upgrade --create')
+	$(MAKE) install REMOTE=$(REMOTE) SSHPASS=$(SSHPASS) DESTDIR=/media/startos/next PLATFORM=$(PLATFORM)
+	$(call ssh,'sudo /media/startos/next/usr/lib/startos/scripts/chroot-and-upgrade --no-sync "apt-get install -y $(shell cat ./build/lib/depends)"')
+
+update-startbox: core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/startbox # only update binary (faster than full update)
+	@if [ -z "$(REMOTE)" ]; then >&2 echo "Must specify REMOTE" && false; fi
+	$(call ssh,'sudo /usr/lib/startos/scripts/chroot-and-upgrade --create')
+	$(call cp,core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/startbox,/media/startos/next/usr/bin/startbox)
+	$(call ssh,'sudo /media/startos/next/usr/lib/startos/scripts/chroot-and-upgrade --no-sync true')
+
+update-deb: results/$(BASENAME).deb # better than update, but only available from debian
+	@if [ -z "$(REMOTE)" ]; then >&2 echo "Must specify REMOTE" && false; fi
+	$(call ssh,'sudo /usr/lib/startos/scripts/chroot-and-upgrade --create')
+	$(call mkdir,/media/startos/next/tmp/startos-deb)
+	$(call cp,results/$(BASENAME).deb,/media/startos/next/tmp/startos-deb/$(BASENAME).deb)
+	$(call ssh,'sudo /media/startos/next/usr/lib/startos/scripts/chroot-and-upgrade --no-sync "apt-get install -y --reinstall /tmp/startos-deb/$(BASENAME).deb"')
+
+update-squashfs: results/$(BASENAME).squashfs
+	@if [ -z "$(REMOTE)" ]; then >&2 echo "Must specify REMOTE" && false; fi
+	$(eval SQFS_SUM := $(shell b3sum results/$(BASENAME).squashfs))
+	$(eval SQFS_SIZE := $(shell du -s --bytes results/$(BASENAME).squashfs | awk '{print $$1}'))
+	$(call ssh,'/usr/lib/startos/scripts/prune-images $(SQFS_SIZE)')
+	$(call ssh,'/usr/lib/startos/scripts/prune-boot')
+	$(call cp,results/$(BASENAME).squashfs,/media/startos/images/next.rootfs)
+	$(call ssh,'sudo CHECKSUM=$(SQFS_SUM) /usr/lib/startos/scripts/upgrade /media/startos/images/next.rootfs')
+
+emulate-reflash: $(STARTOS_TARGETS)
+	@if [ -z "$(REMOTE)" ]; then >&2 echo "Must specify REMOTE" && false; fi
+	$(call ssh,'sudo /usr/lib/startos/scripts/chroot-and-upgrade --create')
+	$(MAKE) install REMOTE=$(REMOTE) SSHPASS=$(SSHPASS) DESTDIR=/media/startos/next PLATFORM=$(PLATFORM)
+	$(call ssh,'sudo rm -f /media/startos/config/disk.guid /media/startos/config/overlay/etc/hostname')
+	$(call ssh,'sudo /media/startos/next/usr/lib/startos/scripts/chroot-and-upgrade --no-sync "apt-get install -y $(shell cat ./build/lib/depends)"')
+
+upload-ota: results/$(BASENAME).squashfs
+	TARGET=$(TARGET) KEY=$(KEY) ./upload-ota.sh
+
+container-runtime/debian.$(ARCH).squashfs: ./container-runtime/download-base-image.sh
+	ARCH=$(ARCH) ./container-runtime/download-base-image.sh
+
+container-runtime/package-lock.json: sdk/dist/package.json
+	npm --prefix container-runtime i
+	touch container-runtime/package-lock.json
+
+container-runtime/node_modules/.package-lock.json: container-runtime/package-lock.json
+	npm --prefix container-runtime ci
+	touch container-runtime/node_modules/.package-lock.json
+
+sdk/base/lib/osBindings/index.ts: $(shell if [ "$(REBUILD_TYPES)" -ne 0 ]; then echo core/startos/bindings/index.ts; fi)
+	mkdir -p sdk/base/lib/osBindings
+	rsync -ac --delete core/startos/bindings/ sdk/base/lib/osBindings/
+	touch sdk/base/lib/osBindings/index.ts
+
+core/startos/bindings/index.ts: $(call ls-files, core) $(ENVIRONMENT_FILE)
+	rm -rf core/startos/bindings
+	./core/build-ts.sh
+	ls core/startos/bindings/*.ts | sed 's/core\/startos\/bindings\/\([^.]*\)\.ts/export { \1 } from ".\/\1";/g' | grep -v '"./index"' | tee core/startos/bindings/index.ts
+	npm --prefix sdk exec -- prettier --config ./sdk/base/package.json -w ./core/startos/bindings/*.ts
+	touch core/startos/bindings/index.ts
+
+sdk/dist/package.json sdk/baseDist/package.json: $(call ls-files, sdk) sdk/base/lib/osBindings/index.ts
+	(cd sdk && make bundle)
+	touch sdk/dist/package.json
+	touch sdk/baseDist/package.json
+
+# TODO: make container-runtime its own makefile?
+container-runtime/dist/index.js: container-runtime/node_modules/.package-lock.json $(call ls-files, container-runtime/src) container-runtime/package.json container-runtime/tsconfig.json 
+	npm --prefix container-runtime run build
+
+container-runtime/dist/node_modules/.package-lock.json container-runtime/dist/package.json container-runtime/dist/package-lock.json: container-runtime/package.json container-runtime/package-lock.json sdk/dist/package.json container-runtime/install-dist-deps.sh
+	./container-runtime/install-dist-deps.sh
+	touch container-runtime/dist/node_modules/.package-lock.json
+
+container-runtime/rootfs.$(ARCH).squashfs: container-runtime/debian.$(ARCH).squashfs container-runtime/container-runtime.service container-runtime/update-image.sh container-runtime/deb-install.sh container-runtime/dist/index.js container-runtime/dist/node_modules/.package-lock.json core/target/$(RUST_ARCH)-unknown-linux-musl/release/containerbox
+	ARCH=$(ARCH) REQUIRES=linux ./build/os-compat/run-compat.sh ./container-runtime/update-image.sh
+
+build/lib/depends build/lib/conflicts: $(ENVIRONMENT_FILE) $(PLATFORM_FILE) $(shell ls build/dpkg-deps/*)
+	PLATFORM=$(PLATFORM) ARCH=$(ARCH) build/dpkg-deps/generate.sh
+
+$(FIRMWARE_ROMS): build/lib/firmware.json download-firmware.sh $(PLATFORM_FILE)
+	./download-firmware.sh $(PLATFORM)
+
+core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/startbox: $(CORE_SRC) $(COMPRESSED_WEB_UIS) web/patchdb-ui-seed.json $(ENVIRONMENT_FILE)
+	ARCH=$(ARCH) PROFILE=$(PROFILE) ./core/build-startbox.sh
+	touch core/target/$(RUST_ARCH)-unknown-linux-musl/$(PROFILE)/startbox
+
+core/target/$(RUST_ARCH)-unknown-linux-musl/release/containerbox: $(CORE_SRC) $(ENVIRONMENT_FILE)
+	ARCH=$(ARCH) ./core/build-containerbox.sh
+	touch core/target/$(RUST_ARCH)-unknown-linux-musl/release/containerbox
+
+web/package-lock.json: web/package.json sdk/baseDist/package.json
+	npm --prefix web i
+	touch web/package-lock.json
+
+web/node_modules/.package-lock.json: web/package-lock.json
+	npm --prefix web ci
+	touch web/node_modules/.package-lock.json
+
+web/.angular/.updated: patch-db/client/dist/index.js sdk/baseDist/package.json web/node_modules/.package-lock.json
+	rm -rf web/.angular
+	mkdir -p web/.angular
+	touch web/.angular/.updated
+
+web/dist/raw/ui/index.html: $(WEB_UI_SRC) $(WEB_SHARED_SRC) web/.angular/.updated
+	npm --prefix web run build:ui
+	touch web/dist/raw/ui/index.html
+
+web/dist/raw/setup-wizard/index.html: $(WEB_SETUP_WIZARD_SRC) $(WEB_SHARED_SRC) web/.angular/.updated
+	npm --prefix web run build:setup
+	touch web/dist/raw/setup-wizard/index.html
+
+web/dist/raw/install-wizard/index.html: $(WEB_INSTALL_WIZARD_SRC) $(WEB_SHARED_SRC) web/.angular/.updated
+	npm --prefix web run build:install
+	touch web/dist/raw/install-wizard/index.html
+
+web/dist/raw/start-tunnel/index.html: $(WEB_START_TUNNEL_SRC) $(WEB_SHARED_SRC) web/.angular/.updated
+	npm --prefix web run build:tunnel
+	touch web/dist/raw/start-tunnel/index.html
+
+web/dist/static/%/index.html: web/dist/raw/%/index.html
+	./compress-uis.sh $*
+
+web/config.json: $(GIT_HASH_FILE) web/config-sample.json
+	jq '.useMocks = false' web/config-sample.json | jq '.gitHash = "$(shell cat GIT_HASH.txt)"' > web/config.json
+
+patch-db/client/node_modules/.package-lock.json: patch-db/client/package.json
+	npm --prefix patch-db/client ci
+	touch patch-db/client/node_modules/.package-lock.json
+
+patch-db/client/dist/index.js: $(PATCH_DB_CLIENT_SRC) patch-db/client/node_modules/.package-lock.json
+	rm -rf patch-db/client/dist
+	npm --prefix patch-db/client run build
+	touch patch-db/client/dist/index.js
+
+# used by github actions
+compiled-$(ARCH).tar: $(COMPILED_TARGETS) $(ENVIRONMENT_FILE) $(GIT_HASH_FILE) $(VERSION_FILE)
+	tar -cvf $@ $^
+
+# this is a convenience step to build all web uis - it is not referenced elsewhere in this file
+uis: $(WEB_UIS) 
+
+# this is a convenience step to build the UI
+ui: web/dist/raw/ui
+
+cargo-deps/aarch64-unknown-linux-musl/release/pi-beep:
+	ARCH=aarch64 ./build-cargo-dep.sh pi-beep
+
+cargo-deps/$(RUST_ARCH)-unknown-linux-musl/release/tokio-console:
+	ARCH=$(ARCH) PREINSTALL="apk add musl-dev pkgconfig" ./build-cargo-dep.sh tokio-console
+
+cargo-deps/$(RUST_ARCH)-unknown-linux-musl/release/startos-backup-fs:
+	ARCH=$(ARCH) PREINSTALL="apk add fuse3 fuse3-dev fuse3-static musl-dev pkgconfig" ./build-cargo-dep.sh --git https://github.com/Start9Labs/start-fs.git startos-backup-fs
+
+cargo-deps/$(RUST_ARCH)-unknown-linux-musl/release/flamegraph:
+	ARCH=$(ARCH) PREINSTALL="apk add musl-dev pkgconfig" ./build-cargo-dep.sh flamegraph

README.md

@@ -1,47 +1,82 @@
-# EmbassyOS
-[![Version](https://img.shields.io/github/v/tag/Start9Labs/embassy-os?color=success)](https://github.com/Start9Labs/embassy-os/releases)
-[![community](https://img.shields.io/badge/community-matrix-yellow)](https://matrix.to/#/#community:matrix.start9labs.com)
-[![community](https://img.shields.io/badge/community-telegram-informational)](https://t.me/start9_labs)
-[![support](https://img.shields.io/badge/support-docs-important)](https://docs.start9labs.com)
-[![developer](https://img.shields.io/badge/developer-matrix-blueviolet)](https://matrix.to/#/#community-dev:matrix.start9labs.com)
-[![website](https://img.shields.io/website?down_color=lightgrey&down_message=offline&up_color=green&up_message=online&url=https%3A%2F%2Fstart9labs.com)](https://start9labs.com)
+<div align="center">
+  <img src="web/projects/shared/assets/img/icon.png" alt="StartOS Logo" width="16%" />
+  <h1 style="margin-top: 0;">StartOS</h1>
+  <a href="https://github.com/Start9Labs/start-os/releases">
+    <img alt="GitHub release (with filter)" src="https://img.shields.io/github/v/release/start9labs/start-os?logo=github">
+  </a>
+  <a href="https://github.com/Start9Labs/start-os/actions/workflows/startos-iso.yaml">
+    <img src="https://github.com/Start9Labs/start-os/actions/workflows/startos-iso.yaml/badge.svg">
+  </a>
+    <a href="https://heyapollo.com/product/startos">
+    <img alt="Static Badge" src="https://img.shields.io/badge/apollo-review%20%E2%AD%90%E2%AD%90%E2%AD%90%E2%AD%90%E2%AD%90%20-slateblue">
+  </a>
+  <a href="https://twitter.com/start9labs">
+    <img alt="X (formerly Twitter) Follow" src="https://img.shields.io/twitter/follow/start9labs">
+  </a>
+  <a href="https://matrix.to/#/#community:matrix.start9labs.com">
+    <img alt="Static Badge" src="https://img.shields.io/badge/community-matrix-yellow?logo=matrix">
+  </a>
+  <a href="https://t.me/start9_labs">
+    <img alt="Static Badge" src="https://img.shields.io/badge/community-telegram-blue?logo=telegram">
+  </a>
+  <a href="https://docs.start9.com">
+    <img alt="Static Badge" src="https://img.shields.io/badge/docs-orange?label=%F0%9F%91%A4%20support">
+  </a>
+  <a href="https://matrix.to/#/#community-dev:matrix.start9labs.com">
+    <img alt="Static Badge" src="https://img.shields.io/badge/developer-matrix-darkcyan?logo=matrix">
+  </a>
+  <a href="https://start9.com">
+    <img alt="Website" src="https://img.shields.io/website?up_message=online&down_message=offline&url=https%3A%2F%2Fstart9.com&logo=website&label=%F0%9F%8C%90%20website">
+  </a>
+</div>
+<br />
+<div align="center">
+  <h3>
+    Welcome to the era of Sovereign Computing
+  </h3>
+  <p>
+    StartOS is an open source Linux distribution optimized for running a personal server. It facilitates the discovery, installation, network configuration, service configuration, data backup, dependency management, and health monitoring of self-hosted software services.
+  </p>
+</div>
+<br />
+<p align="center">
+<img src="assets/StartOS.png" alt="StartOS" width="85%">
+</p>
+<br />
 
-[![mastodon](https://img.shields.io/mastodon/follow/000000001?domain=https%3A%2F%2Fmastodon.start9labs.com&label=Follow&style=social)](http://mastodon.start9labs.com)
-[![twitter](https://img.shields.io/twitter/follow/start9labs?label=Follow)](https://twitter.com/start9labs)
+## Running StartOS
+> [!WARNING]
+> StartOS is in beta. It lacks features. It doesn't always work perfectly. Start9 servers are not plug and play. Using them properly requires some effort and patience. Please do not use StartOS or purchase a server if you are unable or unwilling to follow instructions and learn new concepts.
 
-### _Anyone can do it. No one can stop it._ ###
+### 💰 Buy a Start9 server
+This is the most convenient option. Simply [buy a server](https://store.start9.com) from Start9 and plug it in.
 
-EmbassyOS is a mass-market, graphical operating system designed to facilitate the discovery, installation, configuration, private self-hosting, and reliable operation of open-source software services and applications. It aims to eliminate trust and custodianship from personal computing.
+### 👷 Build your own server
+This option is easier than you might imagine, and there are 4 reasons why you might prefer it:
+1. You already have hardware
+1. You want to save on shipping costs
+1. You prefer not to divulge your physical address
+1. You just like building things
 
-<img src="assets/eos.png" width="100%">
+To pursue this option, follow one of our [DIY guides](https://start9.com/latest/diy).
 
-## :warning: Caution
-Some technologies supported by this software, such as [Lightning](https://lightning.network/), are considered in active development and might experience issues. Do not commit any funds you are not willing to lose. Be #reckless at your own risk. 
+## ❤️ Contributing
+There are multiple ways to contribute: work directly on StartOS, package a service for the marketplace, or help with documentation and guides. To learn more about contributing, see [here](https://start9.com/contribute/).
 
-## Running EmbassyOS
-There are multiple ways to obtain and begin using EmbassyOS.
+To report security issues, please email our security team - security@start9.com.
 
-### :moneybag: Buy an Embassy
-This is the most convenient option. Simply [buy an Embassy](https://start9labs.com) from Start9 Labs and plug it in. Depending on where you live, shipping costs and import duties may vary.
+## 🌎 Marketplace
+There are dozens of services available for StartOS, and new ones are being added all the time. Check out the full list of available services [here](https://marketplace.start9.com/marketplace). To read more about the Marketplace ecosystem, check out this [blog post](https://blog.start9.com/start9-marketplace-strategy/)
 
-### :construction_worker: Build your own Embassy
-While not as convenient as buying an Embassy, this option is easier than you might imagine, and there are 4 reasons why you might prefer it:
-1. You already have a Raspberry Pi and would like to re-purpose it.
-1. You want to save on shipping costs.
-1. You prefer not to divulge your physical shipping address.
-1. You just like building things.
+## 🖥️ User Interface Screenshots
 
-To pursue this option, follow this [guide](https://docs.start9labs.com/getting-started/diy.html).
-
-### :hammer_and_wrench: Build EmbassyOS from Source
-
-EmbassyOS can be built from source, for personal use, for free.
-A detailed guide for doing so can be found [here](https://github.com/Start9Labs/embassy-os/blob/master/BuildGuide.md).
-
-## :heart: Contributing
-To contribute to the development of EmbassyOS, see [here](https://github.com/Start9Labs/embassy-os/blob/master/CONTRIBUTING.md).
-
-## UI Screenshots
-<img src="assets/ServicesRunning.png" alt="Embassy Services" width="100%"> | <img src="assets/ServiceDetails.png" alt="Service Details" width="100%">
---- | ---
-<img src="assets/Embassy.png" alt="EmbassyOS" width="100%"> | <img src="assets/Marketplace.png" alt="Marketplace" width="100%">
+<p align="center">
+<img src="assets/registry.png" alt="StartOS Marketplace" width="49%">
+<img src="assets/community.png" alt="StartOS Community Registry" width="49%">
+<img src="assets/c-lightning.png" alt="StartOS NextCloud Service" width="49%">
+<img src="assets/btcpay.png" alt="StartOS BTCPay Service" width="49%">
+<img src="assets/nextcloud.png" alt="StartOS System Settings" width="49%">
+<img src="assets/system.png" alt="StartOS System Settings" width="49%">
+<img src="assets/welcome.png" alt="StartOS System Settings" width="49%">
+<img src="assets/logs.png" alt="StartOS System Settings" width="49%">
+</p>

START-TUNNEL.md

@@ -0,0 +1,77 @@
+# StartTunnel
+
+A self-hosted WireGuard VPN optimized for creating VLANs and reverse tunneling to personal servers.
+
+You can think of StartTunnel as "virtual router in the cloud".
+
+Use it for private remote access to self-hosted services running on a personal server, or to expose self-hosted services to the public Internet without revealing the host server's IP address.
+
+## Features
+
+- **Create Subnets**: Each subnet creates a private, virtual local area network (VLAN), similar to the LAN created by a home router.
+
+- **Add Devices**: When you add a device (server, phone, laptop) to a subnet, it receives a LAN IP address on that subnet as well as a unique WireGuard config that must be copied, downloaded, or scanned into the device.
+
+- **Forward Ports**: Forwarding a port creates a "reverse tunnel", exposing a specific port on a specific device to the public Internet.
+
+## Features
+
+- **Create Subnets**: Each subnet creates a private, virtual local area network (VLAN), similar to the LAN created by a home router.
+
+- **Add Devices**: When you add a device (server, phone, laptop) to a subnet, it receives a LAN IP address on that subnet as well as a unique Wireguard config that must be copied, downloaded, or scanned into the device.
+
+- **Forward Ports**: Forwarding a port creates a "reverse tunnel", exposing a specific port on a specific device to the public Internet.
+
+## Installation
+
+1.  Rent a low cost VPS. For most use cases, the cheapest option should be enough.
+
+    - It must have a dedicated public IP address.
+    - For compute (CPU), memory (RAM), and storage (disk), choose the minimum spec.
+    - For transfer (bandwidth), it depends on (1) your use case and (2) your home Internet's _upload_ speed. Even if you intend to serve large files or stream content from your server, there is no reason to pay for speeds that exceed your home Internet's upload speed.
+
+1.  Provision the VPS with the latest version of Debian.
+
+1.  Access the VPS via SSH.
+
+1.  Install StartTunnel:
+
+```sh
+TMP_DIR=$(mktemp -d) && (cd $TMP_DIR && wget https://github.com/Start9Labs/start-os/releases/download/v0.4.0-alpha.12/start-tunnel-0.4.0-alpha.12-unknown.dev_$(uname -m).deb && apt-get install -y ./start-tunnel-0.4.0-alpha.12-unknown.dev_$(uname -m).deb) && rm -rf $TMP_DIR && systemctl start start-tunneld && echo "Installation Succeeded"
+```
+
+5. [Initialize the web interface](#web-interface) (recommended)
+
+## Updating
+
+```sh
+TMP_DIR=$(mktemp -d) && (cd $TMP_DIR && wget https://github.com/Start9Labs/start-os/releases/download/v0.4.0-alpha.12/start-tunnel-0.4.0-alpha.12-unknown.dev_$(uname -m).deb && apt-get install --reinstall -y ./start-tunnel-0.4.0-alpha.12-unknown.dev_$(uname -m).deb) && rm -rf $TMP_DIR && systemctl daemon-reload && systemctl restart start-tunneld && echo "Update Succeeded"
+```
+
+## CLI
+
+By default, StartTunnel is managed via the `start-tunnel` command line interface, which is self-documented.
+
+```
+start-tunnel --help
+```
+
+## Web Interface
+
+If you choose to enable the web interface (recommended in most cases), StartTunnel can be accessed as a website from the browser, or programmatically via API.
+
+1.  Initialize the web interface.
+
+        start-tunnel web init
+
+1.  When prompted, select the IP address at which to host the web interface. In many cases, there will be only one IP address.
+
+1.  When prompted, enter the port at which to host the web interface. The default is 8443, and we recommend using it. If you change the default, choose an uncommon port to avoid conflicts.
+
+1.  Select whether to autogenerate a self-signed certificate or provide your own certificate and key. If you choose to autogenerate, you will be asked to list all IP addresses and domains for which to sign the certificate. For example, if you intend to access your StartTunnel web UI at a domain, include the domain in the list.
+
+1.  You will receive a success message with 3 pieces of information:
+
+    - <https://IP:port>: the URL where you can reach your personal web interface.
+    - Password: an autogenerated password for your interface. If you lose/forget it, you can reset using the CLI.
+    - Root Certificate Authority: the Root CA of your StartTunnel instance. If not already, trust it in your browser or system keychain.

agent/.gitignore

@@ -1,40 +0,0 @@
-dist*
-static/tmp/
-static/combined/
-config/client_session_key.aes
-*.hi
-*.o
-*.sqlite3
-*.sqlite3-shm
-*.sqlite3-wal
-.hsenv*
-cabal-dev/
-.stack-work/
-.stack-work-devel/
-yesod-devel/
-.cabal-sandbox
-cabal.sandbox.config
-.DS_Store
-*.swp
-*.keter
-*~
-.vscode
-\#*
-stack.yaml.lock
-*.env
-agent_*
-agent.*
-agent*
-!agent.service
-executables/*
-hidden/*
-cabal.project.local
-dump/*
-*.tar.gz
-assets/
-911.txt
-model
-product_key
-build-send.sh
-*.aes
-*.hie

agent/.stylish-haskell.yaml

@@ -1,252 +0,0 @@
-# stylish-haskell configuration file
-# ==================================
-
-# The stylish-haskell tool is mainly configured by specifying steps. These steps
-# are a list, so they have an order, and one specific step may appear more than
-# once (if needed). Each file is processed by these steps in the given order.
-steps:
-  # Convert some ASCII sequences to their Unicode equivalents. This is disabled
-  # by default.
-  # - unicode_syntax:
-  #     # In order to make this work, we also need to insert the UnicodeSyntax
-  #     # language pragma. If this flag is set to true, we insert it when it's
-  #     # not already present. You may want to disable it if you configure
-  #     # language extensions using some other method than pragmas. Default:
-  #     # true.
-  #     add_language_pragma: true
-
-  # Align the right hand side of some elements.  This is quite conservative
-  # and only applies to statements where each element occupies a single
-  # line. All default to true.
-  - simple_align:
-      cases: true
-      top_level_patterns: true
-      records: true
-
-  # Import cleanup
-  - imports:
-      # There are different ways we can align names and lists.
-      #
-      # - global: Align the import names and import list throughout the entire
-      #   file.
-      #
-      # - file: Like global, but don't add padding when there are no qualified
-      #   imports in the file.
-      #
-      # - group: Only align the imports per group (a group is formed by adjacent
-      #   import lines).
-      #
-      # - none: Do not perform any alignment.
-      #
-      # Default: global.
-      align: global
-
-      # The following options affect only import list alignment.
-      #
-      # List align has following options:
-      #
-      # - after_alias: Import list is aligned with end of import including
-      #   'as' and 'hiding' keywords.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #   >                                          init, last, length)
-      #
-      # - with_alias: Import list is aligned with start of alias or hiding.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #   >                                 init, last, length)
-      #
-      # - with_module_name: Import list is aligned `list_padding` spaces after
-      #   the module name.
-      #
-      #   > import qualified Data.List      as List (concat, foldl, foldr, head,
-      #                          init, last, length)
-      #
-      #   This is mainly intended for use with `pad_module_names: false`.
-      #
-      #   > import qualified Data.List as List (concat, foldl, foldr, head,
-      #                          init, last, length, scanl, scanr, take, drop,
-      #                          sort, nub)
-      #
-      # - new_line: Import list starts always on new line.
-      #
-      #   > import qualified Data.List      as List
-      #   >     (concat, foldl, foldr, head, init, last, length)
-      #
-      # Default: after_alias
-      list_align: after_alias
-
-      # Right-pad the module names to align imports in a group:
-      #
-      # - true: a little more readable
-      #
-      #   > import qualified Data.List       as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #
-      # - false: diff-safe
-      #
-      #   > import qualified Data.List as List (concat, foldl, foldr, init,
-      #   >                                     last, length)
-      #   > import qualified Data.List.Extra as List (concat, foldl, foldr,
-      #   >                                           init, last, length)
-      #
-      # Default: true
-      pad_module_names: true
-
-      # Long list align style takes effect when import is too long. This is
-      # determined by 'columns' setting.
-      #
-      # - inline: This option will put as much specs on same line as possible.
-      #
-      # - new_line: Import list will start on new line.
-      #
-      # - new_line_multiline: Import list will start on new line when it's
-      #   short enough to fit to single line. Otherwise it'll be multiline.
-      #
-      # - multiline: One line per import list entry.
-      #   Type with constructor list acts like single import.
-      #
-      #   > import qualified Data.Map as M
-      #   >     ( empty
-      #   >     , singleton
-      #   >     , ...
-      #   >     , delete
-      #   >     )
-      #
-      # Default: inline
-      long_list_align: inline
-
-      # Align empty list (importing instances)
-      #
-      # Empty list align has following options
-      #
-      # - inherit: inherit list_align setting
-      #
-      # - right_after: () is right after the module name:
-      #
-      #   > import Vector.Instances ()
-      #
-      # Default: inherit
-      empty_list_align: inherit
-
-      # List padding determines indentation of import list on lines after import.
-      # This option affects 'long_list_align'.
-      #
-      # - <integer>: constant value
-      #
-      # - module_name: align under start of module name.
-      #   Useful for 'file' and 'group' align settings.
-      #
-      # Default: 4
-      list_padding: 4
-
-      # Separate lists option affects formatting of import list for type
-      # or class. The only difference is single space between type and list
-      # of constructors, selectors and class functions.
-      #
-      # - true: There is single space between Foldable type and list of it's
-      #   functions.
-      #
-      #   > import Data.Foldable (Foldable (fold, foldl, foldMap))
-      #
-      # - false: There is no space between Foldable type and list of it's
-      #   functions.
-      #
-      #   > import Data.Foldable (Foldable(fold, foldl, foldMap))
-      #
-      # Default: true
-      separate_lists: true
-
-      # Space surround option affects formatting of import lists on a single
-      # line. The only difference is single space after the initial
-      # parenthesis and a single space before the terminal parenthesis.
-      #
-      # - true: There is single space associated with the enclosing
-      #   parenthesis.
-      #
-      #   > import Data.Foo ( foo )
-      #
-      # - false: There is no space associated with the enclosing parenthesis
-      #
-      #   > import Data.Foo (foo)
-      #
-      # Default: false
-      space_surround: false
-
-  # Language pragmas
-  - language_pragmas:
-
-      # We can generate different styles of language pragma lists.
-      #
-      # - vertical: Vertical-spaced language pragmas, one per line.
-      #
-      # - compact: A more compact style.
-      #
-      # - compact_line: Similar to compact, but wrap each line with
-      #   `{-#LANGUAGE #-}'.
-      #
-      # Default: vertical.
-      style: vertical
-
-      # Align affects alignment of closing pragma brackets.
-      #
-      # - true: Brackets are aligned in same column.
-      #
-      # - false: Brackets are not aligned together. There is only one space
-      #   between actual import and closing bracket.
-      #
-      # Default: true
-      align: true
-
-      # stylish-haskell can detect redundancy of some language pragmas. If this
-      # is set to true, it will remove those redundant pragmas. Default: true.
-      remove_redundant: false
-
-  # Replace tabs by spaces. This is disabled by default.
-  - tabs:
-      # Number of spaces to use for each tab. Default: 8, as specified by the
-      # Haskell report.
-      spaces: 4
-
-  # Remove trailing whitespace
-  - trailing_whitespace: {}
-
-  # Squash multiple spaces between the left and right hand sides of some
-  # elements into single spaces. Basically, this undoes the effect of
-  # simple_align but is a bit less conservative.
-  # - squash: {}
-
-# A common setting is the number of columns (parts of) code will be wrapped
-# to. Different steps take this into account. Default: 80.
-columns: 120
-
-# By default, line endings are converted according to the OS. You can override
-# preferred format here.
-#
-# - native: Native newline format. CRLF on Windows, LF on other OSes.
-#
-# - lf: Convert to LF ("\n").
-#
-# - crlf: Convert to CRLF ("\r\n").
-#
-# Default: native.
-newline: native
-
-# Sometimes, language extensions are specified in a cabal file or from the
-# command line instead of using language pragmas in the file. stylish-haskell
-# needs to be aware of these, so it can parse the file correctly.
-#
-# No language extensions are enabled by default.
-language_extensions:
-    - NoImplicitPrelude
-    - FlexibleContexts
-    - FlexibleInstances
-    - GeneralizedNewtypeDeriving
-    - LambdaCase
-    - MultiWayIf
-    - NamedFieldPuns
-    - NumericUnderscores
-    - OverloadedStrings
-    - TypeApplications

agent/Changelog.md

@@ -1,12 +0,0 @@
-# 0.2.5
-
-- Upgrade to GHC 8.10.2 / Stackage nightly-2020-09-29
-- Remove internet connectivity check from startup sequence
-- Move ssh setup to synchronizers
-- Adds new dependency management structure
-- Changes version implementation from semver to new "emver" implementation
-- Adds autoconfigure feature
-- Remaps "Restarting" container status to "Crashed" for better UX
-- Persists logs after restart
-- Rewrites nginx ssl conf during UI upgrade
-- Implements better caching strategy for static assets

agent/README.md

@@ -1,7 +0,0 @@
-# Design Decision Log
-
-* 1/4/20 - Switching from HTTPS to HTTP over local LAN. Due to eventual Tor support/default, this gives
-us the neatest slot for the Tor support
-	* This means it is possible to snoop on traffic between the companion app and the server if you
-	have a LAN presence.
-	* This also makes it possible to masquerade as the server if you have a LAN presence

agent/TODO.md

@@ -1,3 +0,0 @@
-* When adding ssh keys, don't add if identical one exists
-* When adding ssh keys, check for newline at the end of the file. if not exists, add it.
-* If `appmgr stop <ID>` throws no error, but completes without the app being stopped, we need to restart dockerd.

agent/ambassador-agent.cabal

@@ -1,518 +0,0 @@
-cabal-version: 1.12
-
--- This file has been generated from package.yaml by hpack version 0.34.4.
---
--- see: https://github.com/sol/hpack
-
-name:           ambassador-agent
-version:        0.2.13
-build-type:     Simple
-extra-source-files:
-    ./migrations/0.1.0::0.1.0
-    ./migrations/0.1.0::0.1.1
-    ./migrations/0.1.1::0.1.2
-    ./migrations/0.1.2::0.1.3
-    ./migrations/0.1.3::0.1.4
-    ./migrations/0.1.4::0.1.5
-    ./migrations/0.1.5::0.2.0
-    ./migrations/0.2.0::0.2.1
-    ./migrations/0.2.10::0.2.11
-    ./migrations/0.2.11::0.2.12
-    ./migrations/0.2.12::0.2.13
-    ./migrations/0.2.1::0.2.2
-    ./migrations/0.2.2::0.2.3
-    ./migrations/0.2.3::0.2.4
-    ./migrations/0.2.4::0.2.5
-    ./migrations/0.2.5::0.2.6
-    ./migrations/0.2.6::0.2.7
-    ./migrations/0.2.7::0.2.8
-    ./migrations/0.2.8::0.2.9
-    ./migrations/0.2.9::0.2.10
-
-flag dev
-  description: Turn on development settings, like auto-reload templates.
-  manual: False
-  default: False
-
-flag disable-auth
-  description: disable authorization checks
-  manual: False
-  default: False
-
-flag library-only
-  description: Build for use with "yesod devel"
-  manual: False
-  default: False
-
-library
-  exposed-modules:
-      Application
-      Auth
-      Constants
-      Daemon.AppNotifications
-      Daemon.RefreshProcDev
-      Daemon.SslRenew
-      Daemon.TorHealth
-      Daemon.ZeroConf
-      Foundation
-      Handler.Apps
-      Handler.Authenticate
-      Handler.Backups
-      Handler.Hosts
-      Handler.Icons
-      Handler.Login
-      Handler.Network
-      Handler.Notifications
-      Handler.PasswordUpdate
-      Handler.PowerOff
-      Handler.Register
-      Handler.Register.Nginx
-      Handler.Register.Tor
-      Handler.SelfUpdate
-      Handler.SshKeys
-      Handler.Status
-      Handler.Tor
-      Handler.Types.Apps
-      Handler.Types.HmacSig
-      Handler.Types.Hosts
-      Handler.Types.Metrics
-      Handler.Types.Parse
-      Handler.Types.Register
-      Handler.Types.V0.Base
-      Handler.Types.V0.Specs
-      Handler.Types.V0.Ssh
-      Handler.Types.V0.Wifi
-      Handler.Util
-      Handler.V0
-      Handler.Wifi
-      Lib.Algebra.Domain.AppMgr
-      Lib.Algebra.Domain.AppMgr.TH
-      Lib.Algebra.Domain.AppMgr.Types
-      Lib.Algebra.State.RegistryUrl
-      Lib.Avahi
-      Lib.Background
-      Lib.ClientManifest
-      Lib.Crypto
-      Lib.Database
-      Lib.Error
-      Lib.External.AppManifest
-      Lib.External.AppMgr
-      Lib.External.Metrics.Df
-      Lib.External.Metrics.Iotop
-      Lib.External.Metrics.ProcDev
-      Lib.External.Metrics.Temperature
-      Lib.External.Metrics.Top
-      Lib.External.Metrics.Types
-      Lib.External.Registry
-      Lib.External.Specs.Common
-      Lib.External.Specs.CPU
-      Lib.External.Specs.Memory
-      Lib.External.Util
-      Lib.External.WpaSupplicant
-      Lib.IconCache
-      Lib.Metrics
-      Lib.Migration
-      Lib.Notifications
-      Lib.Password
-      Lib.ProductKey
-      Lib.SelfUpdate
-      Lib.Sound
-      Lib.Ssh
-      Lib.Ssl
-      Lib.Synchronizers
-      Lib.SystemCtl
-      Lib.SystemPaths
-      Lib.Tor
-      Lib.TyFam.ConditionalData
-      Lib.Types.Core
-      Lib.Types.Emver
-      Lib.Types.Emver.Orphans
-      Lib.Types.NetAddress
-      Lib.Types.ServerApp
-      Lib.Types.Url
-      Lib.WebServer
-      Model
-      Orphans.Digest
-      Orphans.UUID
-      Settings
-      Startlude
-      Startlude.ByteStream
-      Startlude.ByteStream.Char8
-      Util.Conduit
-      Util.File
-      Util.Function
-      Util.Text
-  other-modules:
-      Paths_ambassador_agent
-  hs-source-dirs:
-      src
-  default-extensions:
-      NoImplicitPrelude
-      BlockArguments
-      ConstraintKinds
-      DataKinds
-      DeriveAnyClass
-      DeriveFunctor
-      DeriveGeneric
-      DerivingStrategies
-      EmptyCase
-      FlexibleContexts
-      FlexibleInstances
-      GADTs
-      GeneralizedNewtypeDeriving
-      InstanceSigs
-      KindSignatures
-      LambdaCase
-      MultiParamTypeClasses
-      MultiWayIf
-      NamedFieldPuns
-      NumericUnderscores
-      OverloadedStrings
-      PolyKinds
-      RankNTypes
-      StandaloneDeriving
-      StandaloneKindSignatures
-      TupleSections
-      TypeApplications
-      TypeFamilies
-      TypeOperators
-  build-depends:
-      aeson
-    , aeson-flatten
-    , attoparsec
-    , base >=4.9.1.0 && <5
-    , bytestring
-    , casing
-    , comonad
-    , conduit
-    , conduit-extra
-    , connection
-    , containers
-    , cryptonite
-    , cryptonite-conduit
-    , data-default
-    , directory
-    , errors
-    , exceptions
-    , exinst
-    , fast-logger
-    , file-embed
-    , filelock
-    , filepath
-    , fused-effects
-    , fused-effects-th
-    , git-embed
-    , http-api-data
-    , http-client
-    , http-client-tls
-    , http-conduit
-    , http-types
-    , interpolate
-    , iso8601-time
-    , json-rpc
-    , lens
-    , lens-aeson
-    , lifted-async
-    , lifted-base
-    , memory
-    , mime-types
-    , monad-control
-    , monad-logger
-    , network
-    , persistent
-    , persistent-sqlite
-    , persistent-template
-    , process
-    , process-extras
-    , protolude
-    , regex-compat
-    , resourcet
-    , shell-conduit
-    , singletons
-    , stm
-    , streaming
-    , streaming-bytestring
-    , streaming-conduit
-    , streaming-utils
-    , tar-conduit
-    , template-haskell
-    , text >=0.11 && <2.0
-    , time
-    , transformers
-    , transformers-base
-    , typed-process
-    , unix
-    , unliftio
-    , unliftio-core
-    , unordered-containers
-    , uuid
-    , wai
-    , wai-cors
-    , wai-extra
-    , warp
-    , yaml
-    , yesod
-    , yesod-auth
-    , yesod-core
-    , yesod-form
-    , yesod-persistent
-  if (flag(dev)) || (flag(library-only))
-    ghc-options: -Wall -Wunused-packages -fwarn-tabs -O0 -fdefer-typed-holes
-    cpp-options: -DDEVELOPMENT
-  else
-    ghc-options: -Wall -Wunused-packages -fwarn-tabs -O2 -fdefer-typed-holes
-  if (flag(disable-auth))
-    cpp-options: -DDISABLE_AUTH
-  default-language: Haskell2010
-
-executable agent
-  main-is: main.hs
-  hs-source-dirs:
-      app
-  default-extensions:
-      NoImplicitPrelude
-      BlockArguments
-      ConstraintKinds
-      DataKinds
-      DeriveAnyClass
-      DeriveFunctor
-      DeriveGeneric
-      DerivingStrategies
-      EmptyCase
-      FlexibleContexts
-      FlexibleInstances
-      GADTs
-      GeneralizedNewtypeDeriving
-      InstanceSigs
-      KindSignatures
-      LambdaCase
-      MultiParamTypeClasses
-      MultiWayIf
-      NamedFieldPuns
-      NumericUnderscores
-      OverloadedStrings
-      PolyKinds
-      RankNTypes
-      StandaloneDeriving
-      StandaloneKindSignatures
-      TupleSections
-      TypeApplications
-      TypeFamilies
-      TypeOperators
-  ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N -fdefer-typed-holes
-  build-depends:
-      aeson
-    , aeson-flatten
-    , ambassador-agent
-    , attoparsec
-    , base >=4.9.1.0 && <5
-    , bytestring
-    , casing
-    , comonad
-    , conduit
-    , conduit-extra
-    , connection
-    , containers
-    , cryptonite
-    , cryptonite-conduit
-    , data-default
-    , directory
-    , errors
-    , exceptions
-    , exinst
-    , fast-logger
-    , file-embed
-    , filelock
-    , filepath
-    , fused-effects
-    , fused-effects-th
-    , git-embed
-    , http-api-data
-    , http-client
-    , http-client-tls
-    , http-conduit
-    , http-types
-    , interpolate
-    , iso8601-time
-    , json-rpc
-    , lens
-    , lens-aeson
-    , lifted-async
-    , lifted-base
-    , memory
-    , mime-types
-    , monad-control
-    , monad-logger
-    , network
-    , persistent
-    , persistent-sqlite
-    , persistent-template
-    , process
-    , process-extras
-    , protolude
-    , regex-compat
-    , resourcet
-    , shell-conduit
-    , singletons
-    , stm
-    , streaming
-    , streaming-bytestring
-    , streaming-conduit
-    , streaming-utils
-    , tar-conduit
-    , template-haskell
-    , text >=0.11 && <2.0
-    , time
-    , transformers
-    , transformers-base
-    , typed-process
-    , unix
-    , unliftio
-    , unliftio-core
-    , unordered-containers
-    , uuid
-    , wai
-    , wai-cors
-    , wai-extra
-    , warp
-    , yaml
-    , yesod
-    , yesod-auth
-    , yesod-core
-    , yesod-form
-    , yesod-persistent
-  if flag(library-only)
-    buildable: False
-  default-language: Haskell2010
-
-test-suite agent-test
-  type: exitcode-stdio-1.0
-  main-is: Main.hs
-  other-modules:
-      ChecklistSpec
-      Lib.External.AppManifestSpec
-      Lib.SoundSpec
-      Lib.Types.EmverProp
-      Live.Metrics
-      Live.Serialize
-      Spec
-  hs-source-dirs:
-      test
-  default-extensions:
-      NoImplicitPrelude
-      BlockArguments
-      ConstraintKinds
-      DataKinds
-      DeriveAnyClass
-      DeriveFunctor
-      DeriveGeneric
-      DerivingStrategies
-      EmptyCase
-      FlexibleContexts
-      FlexibleInstances
-      GADTs
-      GeneralizedNewtypeDeriving
-      InstanceSigs
-      KindSignatures
-      LambdaCase
-      MultiParamTypeClasses
-      MultiWayIf
-      NamedFieldPuns
-      NumericUnderscores
-      OverloadedStrings
-      PolyKinds
-      RankNTypes
-      StandaloneDeriving
-      StandaloneKindSignatures
-      TupleSections
-      TypeApplications
-      TypeFamilies
-      TypeOperators
-  ghc-options: -Wall -fdefer-typed-holes
-  build-depends:
-      aeson
-    , aeson-flatten
-    , ambassador-agent
-    , attoparsec
-    , base >=4.9.1.0 && <5
-    , bytestring
-    , casing
-    , comonad
-    , conduit
-    , conduit-extra
-    , connection
-    , containers
-    , cryptonite
-    , cryptonite-conduit
-    , data-default
-    , directory
-    , errors
-    , exceptions
-    , exinst
-    , fast-logger
-    , file-embed
-    , filelock
-    , filepath
-    , fused-effects
-    , fused-effects-th
-    , git-embed
-    , hedgehog
-    , hspec >=2.0.0
-    , hspec-expectations
-    , http-api-data
-    , http-client
-    , http-client-tls
-    , http-conduit
-    , http-types
-    , interpolate
-    , iso8601-time
-    , json-rpc
-    , lens
-    , lens-aeson
-    , lifted-async
-    , lifted-base
-    , memory
-    , mime-types
-    , monad-control
-    , monad-logger
-    , network
-    , persistent
-    , persistent-sqlite
-    , persistent-template
-    , process
-    , process-extras
-    , protolude
-    , random
-    , regex-compat
-    , resourcet
-    , shell-conduit
-    , singletons
-    , stm
-    , streaming
-    , streaming-bytestring
-    , streaming-conduit
-    , streaming-utils
-    , tar-conduit
-    , template-haskell
-    , text >=0.11 && <2.0
-    , time
-    , transformers
-    , transformers-base
-    , typed-process
-    , unix
-    , unliftio
-    , unliftio-core
-    , unordered-containers
-    , uuid
-    , wai
-    , wai-cors
-    , wai-extra
-    , warp
-    , yaml
-    , yesod
-    , yesod-auth
-    , yesod-core
-    , yesod-form
-    , yesod-persistent
-    , yesod-test
-  default-language: Haskell2010

agent/app/main.hs

@@ -1,5 +0,0 @@
-import           Application                    ( appMain )
-import           Startlude
-
-main :: IO ()
-main = appMain

agent/brittany.yaml

@@ -1,60 +0,0 @@
-conf_debug:
-  dconf_roundtrip_exactprint_only: false
-  dconf_dump_bridoc_simpl_par: false
-  dconf_dump_ast_unknown: false
-  dconf_dump_bridoc_simpl_floating: false
-  dconf_dump_config: false
-  dconf_dump_bridoc_raw: false
-  dconf_dump_bridoc_final: false
-  dconf_dump_bridoc_simpl_alt: false
-  dconf_dump_bridoc_simpl_indent: false
-  dconf_dump_annotations: false
-  dconf_dump_bridoc_simpl_columns: false
-  dconf_dump_ast_full: false
-conf_forward:
-  options_ghc:
-    - -XNoImplicitPrelude
-    - -XBlockArguments
-    - -XFlexibleContexts
-    - -XFlexibleInstances
-    - -XGeneralizedNewtypeDeriving
-    - -XKindSignatures
-    - -XLambdaCase
-    - -XMultiWayIf
-    - -XNamedFieldPuns
-    - -XNumericUnderscores
-    - -XOverloadedStrings
-    - -XTemplateHaskell
-    - -XTypeApplications
-conf_errorHandling:
-  econf_ExactPrintFallback: ExactPrintFallbackModeInline
-  econf_Werror: false
-  econf_omit_output_valid_check: false
-  econf_produceOutputOnErrors: false
-conf_preprocessor:
-  ppconf_CPPMode: CPPModeWarn
-  ppconf_hackAroundIncludes: false
-conf_obfuscate: false
-conf_roundtrip_exactprint_only: false
-conf_version: 1
-conf_layout:
-  lconfig_reformatModulePreamble: true
-  lconfig_altChooser:
-    tag: AltChooserBoundedSearch
-    contents: 3
-  lconfig_allowSingleLineExportList: false
-  lconfig_importColumn: 50
-  lconfig_hangingTypeSignature: true
-  lconfig_importAsColumn: 50
-  lconfig_alignmentLimit: 30
-  lconfig_allowHangingQuasiQuotes: true
-  lconfig_indentListSpecial: true
-  lconfig_indentAmount: 4
-  lconfig_alignmentBreakOnMultiline: true
-  lconfig_experimentalSemicolonNewlines: false
-  lconfig_cols: 120
-  lconfig_indentPolicy: IndentPolicyFree
-  lconfig_indentWhereSpecial: false
-  lconfig_columnAlignMode:
-    tag: ColumnAlignModeMajority
-    contents: 0.7

agent/build.sh

@@ -1,6 +0,0 @@
-#!/bin/bash
-
-cat config/settings.yml | grep app-mgr-version-spec
-cat package.yaml | grep version
-
-stack --local-bin-path ./dist build --copy-bins #--flag start9-agent:disable-auth

agent/cabal.project

@@ -1,23 +0,0 @@
--- Generated by stackage-to-hackage
-
-index-state: 2021-04-26T18:08:38Z
-
-with-compiler: ghc-8.10.2
-
-packages:
-    ./
-
-source-repository-package
-    type: git
-    location: https://github.com/ProofOfKeags/persistent.git
-    tag: 3b52b13d9ce79cdef14bb1c37cc527657a529462
-    subdir: persistent-sqlite
-
-allow-older: *
-allow-newer: *
-
-package *
-    ghc-options: -haddock
-
-package ambassador-agent
-    ghc-options: -fwrite-ide-info

agent/config/agent.service

@@ -1,14 +0,0 @@
-[Unit]
-Description=Boot process for system reset.
-After=network.target lifeline.service avahi-daemon.service systemd-time-wait-sync.service
-Requires=network.target
-Wants=avahi-daemon.service
-
-[Service]
-Type=simple
-ExecStart=/usr/local/bin/agent
-Restart=always
-RestartSec=3
-
-[Install]
-WantedBy=multi-user.target

agent/config/journald.conf

@@ -1,6 +0,0 @@
-[Journal]
-Storage=persistent
-SystemMaxUse=100M
-SystemMaxFileSize=10M
-MaxRetentionSec=1month
-MaxFileSec=1week

agent/config/nginx.conf

@@ -1,29 +0,0 @@
-user www-data;
-worker_processes 1;
-pid /run/nginx.pid;
-include /etc/nginx/modules-enabled/*.conf;
-
-events {
-	worker_connections 768;
-	multi_accept on;
-}
-
-http {
-	sendfile on;
-	tcp_nopush on;
-	tcp_nodelay on;
-	keepalive_timeout 65;
-	types_hash_max_size 2048;
-
-	include /etc/nginx/mime.types;
-	default_type application/octet-stream;
-
-	access_log /var/log/nginx/access.log;
-	error_log /var/log/nginx/error.log;
-
-	gzip on;
-
-	server_names_hash_bucket_size 128;
-	include /etc/nginx/conf.d/*.conf;
-	include /etc/nginx/sites-enabled/*;
-}

agent/config/restarter.service

@@ -1,7 +0,0 @@
-[Unit]
-Description=restarts dead containers
-Requires=docker.service
-
-[Service]
-Type=oneshot
-ExecStart=/usr/local/bin/appmgr repair-app-status

agent/config/restarter.timer

@@ -1,9 +0,0 @@
-[Unit]
-Description=restarter
-
-[Timer]
-OnUnitActiveSec=60s
-OnBootSec=60s
-
-[Install]
-WantedBy=timers.target

agent/config/routes

@@ -1,61 +0,0 @@
-/auth                                 AuthR                    Auth               getAuth !noAuth
-
-/git                                  GitR                     GET
-/authenticate                         AuthenticateR            GET
-/version                              VersionR                 GET                !noAuth
-/versionLatest                        VersionLatestR           GET                !noAuth
-/v0                                   ServerR                  GET PATCH
-
-/v0/name                              NameR                    PATCH
-/v0/autoCheckUpdates                  AutoCheckUpdatesR        PATCH
-
-/v0/welcome/#Version                  WelcomeR                 POST
-/v0/specs                             SpecsR                   GET
-/v0/metrics                           MetricsR                 GET
-
-/v0/logs                              LogsR                    GET
-/v0/sshKeys                           SshKeysR                 GET POST
-/v0/sshKeys/#Text                     SshKeyByFingerprintR     DELETE
-/v0/password                          PasswordR                PATCH
-
-/v0/apps/store                        AvailableAppsR           GET                        -- reg reliant
-/v0/apps/installed                    InstalledAppsR           GET
-/v0/apps/#AppId/store                 AvailableAppByIdR        GET                        -- reg reliant
-
-/v0/apps/#AppId/store/#VersionRange   AvailableAppVersionInfoR GET                        -- reg reliant
-/v0/apps/#AppId/installed             InstalledAppByIdR        GET
-/v0/apps/#AppId/logs                  AppLogsByIdR             GET
-/v0/apps/#AppId/install               InstallNewAppR           POST                       -- reg reliant
-/v0/apps/#AppId/config                AppConfigR               GET PATCH
-/v0/apps/#AppId/start                 StartServerAppR          POST
-/v0/apps/#AppId/restart               RestartServerAppR        POST
-/v0/apps/#AppId/stop                  StopServerAppR           POST
-/v0/apps/#AppId/uninstall             UninstallAppR            POST
-/v0/apps/#AppId/notifications         AppNotificationsR        GET
-/v0/apps/#AppId/metrics               AppMetricsR              GET
-/v0/apps/#AppId/icon                  AppIconR                 GET                !noAuth !cached
-/v0/apps/#AppId/icon/store            AvailableAppIconR        GET                !noAuth !cached -- reg reliant
-/v0/apps/#AppId/backup                CreateBackupR            POST
-/v0/apps/#AppId/backup/stop           StopBackupR              POST
-/v0/apps/#AppId/backup/restore        RestoreBackupR           POST
-/v0/apps/#AppId/autoconfig/#AppId     AutoconfigureR           POST
-/v0/apps/#AppId/actions               ActionR                  POST
-
-/v0/network/lan/reset                 ResetLanR                POST
-
-/v0/disks                             DisksR                   GET
-/v0/disks/eject                       EjectR                   POST
-
-/v0/update                            UpdateAgentR             POST
-/v0/wifi                              WifiR                    GET POST
-/v0/wifi/#Text                        WifiBySsidR              POST DELETE
-
-/v0/notifications                     NotificationsR           GET
-/v0/notifications/#UUID               NotificationR            DELETE
-
-/v0/shutdown                          ShutdownR                POST
-/v0/restart                           RestartR                 POST
-
-/v0/register                          RegisterR                POST               !noAuth
-/v0/hosts                             HostsR                   GET                !noAuth
-/v0/certificate                       CertificateR             GET

agent/config/settings.yml

@@ -1,37 +0,0 @@
-# Values formatted like "_env:YESOD_ENV_VAR_NAME:default_value" can be overridden by the specified environment variable.
-# See https://github.com/yesodweb/yesod/wiki/Configuration#overriding-configuration-values-with-environment-variables
-
-static-dir: "_env:YESOD_STATIC_DIR:static"
-host: "_env:YESOD_HOST:*4" # any IPv4 host
-port: 5959 # NB: The port `yesod devel` uses is distinct from this value. Set the `yesod devel` port from the command line.
-ip-from-header: "_env:YESOD_IP_FROM_HEADER:false"
-detailed-logging: "_env:DETAILED_LOGGING:false"
-
-# Default behavior: determine the application root from the request headers.
-# Uncomment to set an explicit approot
-#approot:        "_env:YESOD_APPROOT:http://localhost:3000"
-
-# By default, `yesod devel` runs in development, and built executables use
-# production settings (see below). To override this, use the following:
-#
-# development: false
-
-# Optional values with the following production defaults.
-# In development, they default to the inverse.
-#
-# detailed-logging: false
-# should-log-all: false
-# reload-templates: false
-# mutable-static: false
-# skip-combining: false
-# auth-dummy-login : false
-
-# NB: If you need a numeric value (e.g. 123) to parse as a String, wrap it in single quotes (e.g. "_env:YESOD_PGPASS:'123'")
-# See https://github.com/yesodweb/yesod/wiki/Configuration#parsing-numeric-values-as-strings
-filesystem-base: "_env:FILESYSTEM_BASE:/"
-database:
-  database: "start9_agent.sqlite3"
-  poolsize: "_env:YESOD_SQLITE_POOLSIZE:10"
-
-app-mgr-version-spec: "=0.2.13"
-#analytics: UA-YOURCODE

agent/config/torrc

@@ -1,5 +0,0 @@
-SOCKSPort 0.0.0.0:9050 # Default: Bind to localhost:9050 for local connections.
-HiddenServiceDir /var/lib/tor/agent/
-HiddenServicePort 5959 127.0.0.1:5959
-HiddenServicePort 80 127.0.0.1:80
-HiddenServicePort 443 127.0.0.1:443

agent/hie.yaml

@@ -1,13 +0,0 @@
-cradle:
-  stack:
-    - path: "./src"
-      component: "ambassador-agent:lib"
-
-    - path: "./app/main.hs"
-      component: "ambassador-agent:exe:agent"
-
-    - path: "./test"
-      component: "ambassador-agent:test:agent-test"
-
-    - path: "./"
-      component: "ambassador-agent:lib"

agent/migrations/0.1.0::0.1.0

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.1.0::0.1.1

@@ -1 +0,0 @@
-CREATE TABLE "replay_nonce"("id" VARCHAR PRIMARY KEY,"created_at" TIMESTAMP NOT NULL);

agent/migrations/0.1.1::0.1.2

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.1.2::0.1.3

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.1.3::0.1.4

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.1.4::0.1.5

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.1.5::0.2.0

@@ -1,2 +0,0 @@
-DROP TABLE authorized_key;
-DROP TABLE replay_nonce;

agent/migrations/0.2.0::0.2.1

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.10::0.2.11

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.11::0.2.12

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.12::0.2.13

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.1::0.2.2

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.2::0.2.3

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.3::0.2.4

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.4::0.2.5

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.5::0.2.6

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.6::0.2.7

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.7::0.2.8

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.8::0.2.9

@@ -1 +0,0 @@
-SELECT TRUE;

agent/migrations/0.2.9::0.2.10

@@ -1 +0,0 @@
-SELECT TRUE;

agent/package.yaml

@@ -1,185 +0,0 @@
-name: ambassador-agent
-version: 0.2.13
-
-default-extensions:
-  - NoImplicitPrelude
-  - BlockArguments
-  - ConstraintKinds
-  - DataKinds
-  - DeriveAnyClass
-  - DeriveFunctor
-  - DeriveGeneric
-  - DerivingStrategies
-  - EmptyCase
-  - FlexibleContexts
-  - FlexibleInstances
-  - GADTs
-  - GeneralizedNewtypeDeriving
-  - InstanceSigs
-  - KindSignatures
-  - LambdaCase
-  - MultiParamTypeClasses
-  - MultiWayIf
-  - NamedFieldPuns
-  - NumericUnderscores
-  - OverloadedStrings
-  - PolyKinds
-  - RankNTypes
-  - StandaloneDeriving
-  - StandaloneKindSignatures
-  - TupleSections
-  - TypeApplications
-  - TypeFamilies
-  - TypeOperators
-
-dependencies:
-  - base >=4.9.1.0 && <5
-  - aeson
-  - aeson-flatten
-  - attoparsec
-  - bytestring
-  - casing
-  - comonad
-  - conduit
-  - conduit-extra
-  - connection
-  - containers
-  - cryptonite
-  - cryptonite-conduit
-  - data-default
-  - directory
-  - errors
-  - exceptions
-  - exinst
-  - fast-logger
-  - file-embed
-  - filelock
-  - filepath
-  - fused-effects
-  - fused-effects-th
-  - git-embed
-  - http-api-data
-  - http-client
-  - http-client-tls
-  - http-conduit
-  - http-types
-  - interpolate
-  - iso8601-time
-  - json-rpc
-  - lens
-  - lens-aeson
-  - lifted-async
-  - lifted-base
-  - memory
-  - mime-types
-  - monad-control
-  - monad-logger
-  - network
-  - persistent
-  - persistent-sqlite
-  - persistent-template
-  - process
-  - process-extras
-  - protolude
-  - resourcet
-  - regex-compat # TODO: trim this dep
-  - shell-conduit
-  - singletons
-  - stm
-  - streaming
-  - streaming-bytestring
-  - streaming-conduit
-  - streaming-utils
-  - tar-conduit
-  - template-haskell
-  - text >=0.11 && <2.0
-  - time
-  - transformers
-  - transformers-base
-  - typed-process
-  - unix
-  - unliftio # TODO: trim this dep
-  - unliftio-core # TODO: trim this dep
-  - unordered-containers
-  - uuid
-  - wai
-  - wai-cors
-  - wai-extra
-  - warp
-  - yaml
-  - yesod
-  - yesod-auth
-  - yesod-core
-  - yesod-form
-  - yesod-persistent
-
-flags:
-  library-only:
-    manual: false
-    default: false
-    description: Build for use with "yesod devel"
-  dev:
-    manual: false
-    default: false
-    description: Turn on development settings, like auto-reload templates.
-  disable-auth:
-    manual: false
-    default: false
-    description: disable authorization checks
-library:
-  source-dirs: src
-  when:
-    - condition: (flag(dev)) || (flag(library-only))
-      then:
-        cpp-options: -DDEVELOPMENT
-        ghc-options:
-          - -Wall
-          - -Wunused-packages
-          - -fwarn-tabs
-          - -O0
-          - -fdefer-typed-holes
-      else:
-        ghc-options:
-          - -Wall
-          - -Wunused-packages
-          - -fwarn-tabs
-          - -O2
-          - -fdefer-typed-holes
-    - condition: (flag(disable-auth))
-      cpp-options: -DDISABLE_AUTH
-tests:
-  agent-test:
-    source-dirs: test
-    main: Main.hs
-    ghc-options:
-      - -Wall
-      - -fdefer-typed-holes
-    dependencies:
-      - ambassador-agent
-      - hspec >=2.0.0
-      - hspec-expectations
-      - hedgehog
-      - yesod-test
-      - random
-    when:
-      - condition: false
-        other-modules: Paths_ambassador_agent
-
-executables:
-  agent:
-    source-dirs: app
-    main: main.hs
-    ghc-options:
-      - -Wall
-      - -threaded
-      - -rtsopts
-      - -with-rtsopts=-N
-      - -fdefer-typed-holes
-    dependencies:
-      - ambassador-agent
-    when:
-      - buildable: false
-        condition: flag(library-only)
-      - condition: false
-        other-modules: Paths_ambassador_agent
-extra-source-files: ./migrations/*

agent/src/Application.hs

@@ -1,247 +0,0 @@
-{-# LANGUAGE CPP                   #-}
-{-# LANGUAGE FlexibleContexts      #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE RecordWildCards       #-}
-{-# LANGUAGE ScopedTypeVariables   #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeFamilies          #-}
-module Application
-    ( appMain
-    , makeFoundation
-    , makeLogWare
-    -- * for DevelMain
-    , getApplicationRepl
-    , getAppSettings
-    , shutdownAll
-    , shutdownWeb
-    , startWeb
-    -- * for GHCI
-    , handler
-    , runDb
-    , getAgentCtx
-    , sleep
-    )
-where
-
-import           Startlude               hiding (runReader)
-
-import           Control.Concurrent.STM.TVar    ( newTVarIO )
-import           Control.Monad.Logger
-import           Control.Effect.Labelled        ( Labelled, runLabelled )
-import qualified Data.HashMap.Strict           as HM
-import           Data.IORef
-
-import           Database.Persist.Sql
-import           Database.Persist.Sqlite        ( createSqlitePool
-                                                , runSqlite
-                                                , sqlPoolSize
-                                                , sqlDatabase
-                                                )
-import           Git.Embed
-import           Network.HTTP.Client.TLS        ( getGlobalManager )
-import           Network.Wai
-import           Network.Wai.Handler.Warp       ( getPort )
-import           System.Directory               ( createDirectoryIfMissing )
-import           System.Environment             ( setEnv )
-import           System.IO               hiding ( putStrLn, writeFile )
-import           System.Log.FastLogger          ( defaultBufSize
-                                                , newStdoutLoggerSet
-                                                )
-import           Yesod.Core
-import           Yesod.Default.Config2
-import           Yesod.Persist.Core
-
-import           Constants
-import qualified Daemon.AppNotifications       as AppNotifications
-import           Daemon.RefreshProcDev
-import qualified Daemon.SslRenew as SSLRenew
-import           Daemon.TorHealth
-import           Daemon.ZeroConf
-import           Foundation
-import           Lib.Algebra.State.RegistryUrl
-import           Lib.Background
-import           Lib.Database
-import           Lib.External.Metrics.ProcDev
-import           Lib.SelfUpdate
-import           Lib.Sound
-import           Lib.SystemPaths
-import           Lib.Tor                        ( newTorManager )
-import           Lib.WebServer
-import           Model
-import           Settings
-
-appMain :: IO ()
-appMain = do
-    hSetBuffering stdout LineBuffering
-    args <- getArgs
-
-    -- Get the settings from all relevant sources
-    settings <- loadYamlSettings [] [configSettingsYmlValue] useEnv
-
-    settings' <- case args of
-        ["--port", n] -> case readMaybe @Word16 $ toS n of
-            Just n' -> pure $ settings { appPort = n' }
-            Nothing -> do
-                die . toS $ "Invalid Port: " <> n
-        ["--git-hash"] -> do
-            putStrLn @Text $embedGitRevision
-            exitSuccess
-        ["--version"] -> do
-            putStrLn @Text (show agentVersion)
-            exitSuccess
-        _ -> pure settings
-    createDirectoryIfMissing False (toS $ agentDataDirectory `relativeTo` appFilesystemBase settings')
-
-    -- Generate the foundation from the settings
-    foundation <- makeFoundation settings'
-
-    startupSequence foundation
-
--- | This function allocates resources (such as a database connection pool),
--- performs initialization and returns a foundation datatype value. This is also
--- the place to put your migrate statements to have automatic database
--- migrations handled by Yesod.
-makeFoundation :: AppSettings -> IO AgentCtx
-makeFoundation appSettings = do
-    now                         <- getCurrentTime
-    -- Some basic initializations: HTTP connection manager, logger, and static
-    -- subsite.
-    appLogger                   <- newStdoutLoggerSet defaultBufSize >>= makeYesodLogger
-    appHttpManager              <- getGlobalManager
-    appTorManager               <- newTorManager (appTorSocksPort appSettings)
-    appWebServerThreadId        <- newIORef Nothing
-    appSelfUpdateSpecification  <- newEmptyMVar
-    appIsUpdating               <- newIORef Nothing
-    appIsUpdateFailed           <- newIORef Nothing
-    appOsVersionLatest          <- newIORef Nothing
-    appBackgroundJobs           <- newTVarIO (JobCache HM.empty)
-    def                         <- getDefaultProcDevMetrics
-    appProcDevMomentCache       <- newIORef (now, mempty, def)
-    appLastTorRestart           <- newIORef now
-    appLanThread                <- forkIO (sleep 10) >>= newMVar
-
-    -- We need a log function to create a connection pool. We need a connection
-    -- pool to create our foundation. And we need our foundation to get a
-    -- logging function. To get out of this loop, we initially create a
-    -- temporary foundation without a real connection pool, get a log function
-    -- from there, and then create the real foundation.
-    let mkFoundation appConnPool appIconTags = AgentCtx { .. }
-    -- The AgentCtx {..} syntax is an example of record wild cards. For more
-    -- information, see:
-    -- https://ocharles.org.uk/blog/posts/2014-12-04-record-wildcards.html
-        tempFoundation = mkFoundation
-            (panic "connPool forced in tempFoundation")
-            (panic "iconTags forced in tempFoundation")
-        logFunc        = messageLoggerSource tempFoundation appLogger
-
-    db <- interpDb dbPath
-
-    -- Create the database connection pool, will create sqlite file if doesn't already exist
-    pool <- flip runLoggingT logFunc $ createSqlitePool (toS db) (sqlPoolSize . appDatabaseConf $ appSettings)
-
-    -- run migrations only if agent in charge
-    when (appPort appSettings == 5959) $ do
-        runSqlite db $ runMigration migrateAll
-        void . interpDb $ ensureCoherentDbVersion pool logFunc
-
-    iconTags <- if appPort appSettings == 5959
-        then do
-            iconDigests <- runSqlPool (selectList [] []) pool
-            newTVarIO . HM.fromList $ (unIconDigestKey . entityKey &&& iconDigestTag . entityVal) <$> iconDigests
-        else newTVarIO HM.empty
-
-    -- Return the foundation
-    pure $ mkFoundation pool iconTags
-    where
-        interpDb :: (Labelled "sqlDatabase" (ReaderT Text)) (Labelled "filesystemBase" (ReaderT Text) IO) a -> IO a
-        interpDb = injectFilesystemBaseFromContext appSettings
-                . flip runReaderT (sqlDatabase . appDatabaseConf $ appSettings)
-                . runLabelled @"sqlDatabase"
-
-getAppSettings :: IO AppSettings
-getAppSettings = loadYamlSettings [configSettingsYml] [] useEnv
-
-
-startupSequence :: AgentCtx -> IO ()
-startupSequence foundation = do
-
-#ifdef DISABLE_AUTH
-    withAgentVersionLog_ "[WARNING] Agent auth disabled!"
-#endif
-
-    injectFilesystemBaseFromContext (appSettings foundation) . runRegistryUrlIOC $ getRegistryUrl >>= \case
-        Nothing -> pure ()
-        Just x -> liftIO $ do
-            withAgentVersionLog "Detected Alternate Registry URL" x
-            -- this is so that appmgr inherits the alternate registry url when it is called.
-            setEnv "REGISTRY_URL" (show x)
-
-    -- proc dev metrics refresh loop
-    withAgentVersionLog_ "Initializing proc dev refresh loop"
-    void . forkIO . forever $ forkIO (refreshProcDev foundation) >> threadDelay 5_000_000
-    withAgentVersionLog_ "Proc dev metrics refreshing"
-
-    -- web
-    withAgentVersionLog_ "Starting web server"
-    void . forkIO . startWeb $ foundation
-    withAgentVersionLog_ "Web server running"
-
-    -- all these actions are destructive in some way, and only webserver is needed for self-update
-    when (appPort (appSettings foundation) == 5959) $ do
-        synchronizeSystemState foundation agentVersion
-
-        -- app notifications refresh loop
-        withAgentVersionLog_ "Initializing app notifications refresh loop"
-        void . forkIO . forever $ forkIO (runReaderT AppNotifications.fetchAndSave foundation) >> threadDelay 5_000_000
-        withAgentVersionLog_ "App notifications refreshing"
-
-        withAgentVersionLog_ "Initializing SSL certificate renewal loop"
-        void . forkIO . forever $ forkIO (SSLRenew.renewSslLeafCert foundation) *> sleep 86_400
-        withAgentVersionLog_ "SSL Renewal daemon started"
-
-        withAgentVersionLog_ "Initializing Tor health check loop"
-        void . forkIO . forever $ forkIO (runReaderT torHealth foundation) *> sleep 300
-        withAgentVersionLog_ "Tor health check loop running"
-
-        -- reloading avahi daemon
-        -- DRAGONS! make sure this step happens AFTER system synchronization
-        withAgentVersionLog_ "Publishing Agent to Avahi Daemon"
-        runReaderT publishAgentToAvahi foundation
-        withAgentVersionLog_ "Avahi Daemon reloaded with Agent service"
-
-        when (appPort (appSettings foundation) == 5959) $ do
-            playSong 400 marioCoin
-
-    withAgentVersionLog_ "Listening for Self-Update Signal"
-    waitForUpdateSignal foundation
-
-sleep :: Integer -> IO ()
-sleep n = let (full, r) = (n * 1_000_000) `divMod` fromIntegral (maxBound :: Int) in
-    replicateM_ (fromIntegral full) (threadDelay maxBound) *> threadDelay (fromIntegral r)
-
---------------------------------------------------------------
--- Functions for DevelMain.hs (a way to run the AgentCtx from GHCi)
---------------------------------------------------------------
-
-getApplicationRepl :: IO (Int, AgentCtx, Application)
-getApplicationRepl = do
-    foundation <- getAppSettings >>= makeFoundation
-    wsettings  <- getDevSettings $ warpSettings foundation
-    app1       <- makeApplication foundation
-    return (getPort wsettings, foundation, app1)
-
-getAgentCtx :: IO AgentCtx
-getAgentCtx = getAppSettings >>= makeFoundation
-
----------------------------------------------
--- Functions for use in development with GHCi
----------------------------------------------
-
--- | Run a handler
-handler :: Handler a -> IO a
-handler h = getAppSettings >>= makeFoundation >>= flip unsafeHandler h
-
--- | Run DB queries
-runDb :: ReaderT SqlBackend Handler a -> IO a
-runDb = handler . runDB
-

agent/src/Auth.hs

@@ -1,19 +0,0 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE QuasiQuotes #-}
-module Auth where
-
-import           Startlude
-
-import           Yesod.Core
-
-data Auth = Auth
-
-getAuth :: a -> Auth
-getAuth = const Auth
-
-mkYesodSubData "Auth" [parseRoutes|
-/login LoginR POST
-/logout LogoutR POST
-|]

agent/src/Constants.hs

@@ -1,16 +0,0 @@
-module Constants where
-
-import           Startlude
-
-import           Data.Version                   ( showVersion )
-import           Lib.Types.Emver                ( Version )
-import           Paths_ambassador_agent         ( version )
-
-agentVersion :: Version
-agentVersion = fromString $ showVersion version
-
-withAgentVersionLog :: (Show a, MonadIO m) => Text -> a -> m ()
-withAgentVersionLog t a = liftIO $ putStrLn @Text $ show agentVersion <> "-- " <> t <> ": " <> show a
-
-withAgentVersionLog_ :: Text -> IO ()
-withAgentVersionLog_ t = putStrLn @Text $ show agentVersion <> "-- " <> t

agent/src/Daemon/AppNotifications.hs

@@ -1,48 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-module Daemon.AppNotifications where
-
-import           Startlude
-
-import qualified Data.HashMap.Strict           as HM
-import           Data.UUID.V4
-import           Data.Time.Clock.POSIX
-import           Database.Persist.Sql
-
-import           Foundation
-import           Lib.Error
-import           Lib.Algebra.Domain.AppMgr     as AppMgr2
-import           Lib.External.AppMgr           as AppMgr
-import           Lib.Types.Core
-import           Lib.Types.Emver
-import           Model
-
-toModelNotif :: (AppId, Version) -> AppMgrNotif -> Notification
-toModelNotif (appId, appVersion) AppMgrNotif {..} =
-    let prefix = (<> "1") $ case appMgrNotifLevel of
-            INFO    -> "0"
-            SUCCESS -> "1"
-            WARN    -> "2"
-            ERROR   -> "3"
-    in  Notification (posixSecondsToUTCTime . fromRational $ appMgrNotifTime)
-                     Nothing
-                     appId
-                     appVersion
-                     (prefix <> show appMgrNotifCode)
-                     appMgrNotifTitle
-                     appMgrNotifMessage
-
-fetchAndSave :: ReaderT AgentCtx IO ()
-fetchAndSave = handleErr $ do
-    pool <- asks appConnPool
-    apps <- HM.toList <$> AppMgr2.runAppMgrCliC (AppMgr2.list [AppMgr2.flags| |])
-    for_ apps $ \(appId, AppMgr2.InfoRes { infoResVersion }) -> do
-        notifs <- AppMgr.notifications appId
-        let mods = toModelNotif (appId, infoResVersion) <$> notifs
-        keys <- liftIO $ replicateM (length mods) (NotificationKey <$> nextRandom)
-        let ents = zipWith Entity keys mods
-        lift $ flip runSqlPool pool $ insertEntityMany ents
-    where
-        handleErr m = runExceptT m >>= \case
-            Left  e -> putStrLn (errorMessage $ toError e)
-            Right _ -> pure ()

agent/src/Daemon/RefreshProcDev.hs

@@ -1,20 +0,0 @@
-module Daemon.RefreshProcDev where
-
-import           Startlude
-
-import           Data.IORef
-
-import           Foundation
-import           Lib.Error
-import           Lib.External.Metrics.ProcDev
-
-refreshProcDev :: AgentCtx -> IO ()
-refreshProcDev agentCtx = do
-    let procDevCache = appProcDevMomentCache agentCtx
-    (oldTime, oldMoment, _) <- liftIO . readIORef . appProcDevMomentCache $ agentCtx
-
-    eProcDev                <- runS9ErrT $ getProcDevMetrics (oldTime, oldMoment)
-    case eProcDev of
-        Left  e -> putStrLn @Text . show $ e
-        Right (newTime, newMoment, newMetrics) -> liftIO $ writeIORef procDevCache (newTime, newMoment, newMetrics)
-

agent/src/Daemon/SslRenew.hs

@@ -1,83 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-module Daemon.SslRenew where
-
-import           Startlude               hiding ( err )
-
-import           Data.String.Interpolate        ( i )
-import           System.Process                 ( system )
-
-import           Foundation
-import           Lib.SystemPaths
-import           Settings
-import           Lib.Ssl
-import           Daemon.ZeroConf                ( getStart9AgentHostname )
-import           Lib.Tor
-import           Control.Carrier.Lift
-import           System.Directory               ( doesPathExist
-                                                , removePathForcibly
-                                                , renameDirectory
-                                                )
-import           Lib.SystemCtl
-import qualified Lib.Notifications             as Notifications
-import           Database.Persist.Sql           ( runSqlPool )
-import           Lib.Types.Core
-import           Constants
-
-renewSslLeafCert :: AgentCtx -> IO ()
-renewSslLeafCert ctx = do
-    let base = appFilesystemBase . appSettings $ ctx
-    sid <- injectFilesystemBase base getStart9AgentHostname
-    let hostname = sid <> ".local"
-    tor <- injectFilesystemBase base getAgentHiddenServiceUrl
-    putStr @Text "SSL Renewal Required? "
-    needsRenew <- doesSslNeedRenew (toS $ entityCertPath sid `relativeTo` base)
-    print needsRenew
-    when needsRenew $ runM . injectFilesystemBase base $ do
-        intCaKeyPath   <- toS <$> getAbsoluteLocationFor intermediateCaKeyPath
-        intCaConfPath  <- toS <$> getAbsoluteLocationFor intermediateCaOpenSslConfPath
-        intCaCertPath  <- toS <$> getAbsoluteLocationFor intermediateCaCertPath
-
-        sslDirTmp      <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> sslDirectory)
-        entKeyPathTmp  <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityKeyPath sid)
-        entConfPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityConfPath sid)
-        entCertPathTmp <- toS <$> getAbsoluteLocationFor (agentTmpDirectory <> entityCertPath sid)
-
-        (ec, out, err) <- writeLeafCert
-            DeriveCertificate { applicantConfPath = entConfPathTmp
-                              , applicantKeyPath  = entKeyPathTmp
-                              , applicantCertPath = entCertPathTmp
-                              , signingConfPath   = intCaConfPath
-                              , signingKeyPath    = intCaKeyPath
-                              , signingCertPath   = intCaCertPath
-                              , duration          = 365
-                              }
-            hostname
-            tor
-        liftIO $ do
-            putStrLn @Text "openssl logs"
-            putStrLn @Text "exit code: "
-            print ec
-            putStrLn @String $ "stdout: " <> out
-            putStrLn @String $ "stderr: " <> err
-        case ec of
-            ExitSuccess -> pure ()
-            ExitFailure n ->
-                liftIO
-                    . void
-                    $ flip runSqlPool (appConnPool ctx)
-                    $ Notifications.emit (AppId "EmbassyOS") agentVersion
-                    $ Notifications.CertRenewFailed (ExitFailure n) out err
-        let sslDir = toS $ sslDirectory `relativeTo` base
-        liftIO $ removePathForcibly sslDir
-        liftIO $ renameDirectory sslDirTmp sslDir
-        liftIO $ systemCtl RestartService "nginx" $> ()
-
-
-doesSslNeedRenew :: FilePath -> IO Bool
-doesSslNeedRenew cert = do
-    exists <- doesPathExist cert
-    if exists
-        then do
-            ec <- liftIO $ system [i|openssl x509 -checkend 2592000 -noout -in #{cert}|]
-            pure $ ec /= ExitSuccess
-        else pure False

agent/src/Daemon/TorHealth.hs

@@ -1,50 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-module Daemon.TorHealth where
-
-import           Startlude
-
-import           Data.String.Interpolate.IsString
-
-import           Foundation
-import           Lib.SystemPaths
-import           Lib.Tor
-import           Yesod                          ( RenderRoute(renderRoute) )
-import           Network.HTTP.Simple            ( getResponseBody )
-import           Network.HTTP.Client            ( parseRequest )
-import           Network.HTTP.Client            ( httpLbs )
-import           Data.ByteString.Lazy           ( toStrict )
-import qualified UnliftIO.Exception            as UnliftIO
-import           Settings
-import           Data.IORef                     ( writeIORef
-                                                , readIORef
-                                                )
-import           Lib.SystemCtl
-
-torHealth :: ReaderT AgentCtx IO ()
-torHealth = do
-    settings <- asks appSettings
-    host     <- injectFilesystemBaseFromContext settings getAgentHiddenServiceUrl
-    let url = mappend [i|http://#{host}:5959|] . fold $ mappend "/" <$> fst (renderRoute VersionR)
-    response <- UnliftIO.try @_ @SomeException $ torGet (toS url)
-    case response of
-        Left _ -> do
-            putStrLn @Text "Failed Tor health check"
-            lastRestart <- asks appLastTorRestart >>= liftIO . readIORef
-            cooldown    <- asks $ appTorRestartCooldown . appSettings
-            now         <- liftIO getCurrentTime
-            if now > addUTCTime cooldown lastRestart
-                then do
-                    ec <- liftIO $ systemCtl RestartService "tor"
-                    case ec of
-                        ExitSuccess   -> asks appLastTorRestart >>= liftIO . flip writeIORef now
-                        ExitFailure _ -> do
-                            putStrLn @Text "Failed to restart tor daemon after failed tor health check"
-                else do
-                    putStrLn @Text "Failed tor healthcheck inside of cooldown window, tor will not be restarted"
-        Right _ -> pure ()
-
-torGet :: String -> ReaderT AgentCtx IO ByteString
-torGet url = do
-    manager <- asks appTorManager
-    req     <- parseRequest url
-    liftIO $ toStrict . getResponseBody <$> httpLbs req manager

agent/src/Daemon/ZeroConf.hs

@@ -1,65 +0,0 @@
-{-# LANGUAGE TypeApplications #-}
-module Daemon.ZeroConf where
-
-import           Startlude               hiding ( ask )
-
-import           Control.Lens
-import           Control.Effect.Reader.Labelled ( ask )
-import           Control.Monad.Trans.Reader     ( withReaderT )
-import           Crypto.Hash
-import           Data.ByteArray                 ( convert )
-import           Data.ByteArray.Encoding
-import qualified Data.ByteString               as BS
-import           System.FilePath.Lens
-
-import           Foundation
-import qualified Lib.Avahi                     as Avahi
-import           Lib.ProductKey
-import           Lib.SystemPaths
-
-import           Settings
-import qualified Lib.Algebra.Domain.AppMgr     as AppMgr2
-import           Control.Carrier.Lift
-import           Lib.Error
-
-start9AgentServicePrefix :: IsString a => a
-start9AgentServicePrefix = "start9-"
-
-getStart9AgentHostname :: (HasFilesystemBase sig m, MonadIO m, ConvertText Text a) => m a
-getStart9AgentHostname = do
-    base   <- ask @"filesystemBase"
-    suffix <-
-        liftIO
-        $   decodeUtf8
-        .   convertToBase Base16
-        .   BS.take 4
-        .   convert
-        .   hashWith SHA256
-        .   encodeUtf8
-        <$> getProductKey base
-    pure . toS $ start9AgentServicePrefix <> suffix
-
-getStart9AgentHostnameLocal :: (HasFilesystemBase sig m, MonadIO m) => m Text
-getStart9AgentHostnameLocal = getStart9AgentHostname <&> (<> ".local")
-
-publishAgentToAvahi :: ReaderT AgentCtx IO ()
-publishAgentToAvahi = do
-    filesystemBase     <- asks $ appFilesystemBase . appSettings
-    start9AgentService <- injectFilesystemBase filesystemBase getStart9AgentHostname
-    lift $ Avahi.createDaemonConf $ toS start9AgentService
-    agentPort <- asks $ appPort . appSettings
-    services  <- lift Avahi.listServices
-    let serviceNames = view basename <$> services
-    unless (start9AgentService `elem` serviceNames) $ withReaderT appSettings $ Avahi.createService
-        (toS start9AgentService)
-        (Avahi.WildcardsEnabled, "%h")
-        "_http._tcp"
-        agentPort
-    lift Avahi.reload
-    lift $ threadDelay 10_000_000
-    tid <- asks appLanThread >>= liftIO . takeMVar
-    liftIO $ killThread tid
-    tid' <- liftIO $ forkIO (runM . void . runExceptT @S9Error $ AppMgr2.runAppMgrCliC AppMgr2.lanEnable)
-    asks appLanThread >>= liftIO . flip putMVar tid'
-
-

agent/src/Foundation.hs

@@ -1,226 +0,0 @@
-{-# LANGUAGE CPP                   #-}
-{-# LANGUAGE InstanceSigs          #-}
-{-# LANGUAGE MultiParamTypeClasses #-}
-{-# LANGUAGE QuasiQuotes           #-}
-{-# LANGUAGE PartialTypeSignatures #-}
-{-# LANGUAGE RankNTypes            #-}
-{-# LANGUAGE TemplateHaskell       #-}
-{-# LANGUAGE TypeFamilies          #-}
-{-# LANGUAGE ViewPatterns          #-}
-
-module Foundation where
-
-import           Startlude
-
-import qualified Control.Effect.Labelled       as FE
-import qualified Control.Carrier.Lift          as FE
-import           Control.Concurrent.STM
-import           Control.Monad.Base
-import           Control.Monad.Logger           ( LogSource )
-import           Control.Monad.Trans.Control
-import           Crypto.Hash                    ( MD5, Digest )
-import qualified Data.HashMap.Strict           as HM
-import           Data.IORef
-import           Data.Set
-import           Data.UUID
-import           Database.Persist              as Persist
-import           Database.Persist.Sql
-import           Network.HTTP.Client            (Manager)
-import           Network.HTTP.Types             (status200)
-import           Network.Wai
-import           Yesod.Core
-import           Yesod.Core.Types
-import           Yesod.Auth                     ( AuthenticationResult(..)
-                                                , Creds(..)
-                                                , YesodAuth(..)
-                                                , YesodAuthPersist
-                                                , maybeAuth
-                                                )
-import qualified Yesod.Auth.Message            as Msg
-import           Yesod.Form
-import qualified Yesod.Core.Unsafe             as Unsafe
-import           Yesod.Persist.Core
-
-import           Auth
-import           Constants
-import           Lib.Algebra.State.RegistryUrl
-import           Lib.Background
-import           Lib.Error
-import           Lib.External.Metrics.ProcDev
-import           Lib.SystemPaths
-import           Lib.Types.Core
-import           Lib.Types.Emver
-import           Model
-import           Settings
-
-
--- | The foundation datatype for your application. This can be a good place to
--- keep settings and values requiring initialization before your application
--- starts running, such as database connections. Every handler will have
--- access to the data present here.
-data OsVersionCache = OsVersionCache { osVersion :: Version, lastChecked :: UTCTime }
-
-data AgentCtx = AgentCtx
-    { appSettings                 :: AppSettings
-    , appHttpManager              :: Manager
-    , appTorManager               :: Manager
-    , appConnPool                 :: ConnectionPool -- ^ Database connection pool.
-    , appLogger                   :: Logger
-    , appWebServerThreadId        :: IORef (Maybe ThreadId)
-    , appIsUpdating               :: IORef (Maybe Version)
-    , appIsUpdateFailed           :: IORef (Maybe S9Error)
-    , appOsVersionLatest          :: IORef (Maybe OsVersionCache)
-    , appProcDevMomentCache       :: IORef (UTCTime, ProcDevMomentStats, ProcDevMetrics)
-    , appSelfUpdateSpecification  :: MVar VersionRange
-    , appBackgroundJobs           :: TVar JobCache
-    , appIconTags                 :: TVar (HM.HashMap AppId (Digest MD5))
-    , appLastTorRestart           :: IORef UTCTime
-    , appLanThread                :: MVar ThreadId
-    }
-
-setWebProcessThreadId :: ThreadId -> AgentCtx -> IO ()
-setWebProcessThreadId tid a = writeIORef (appWebServerThreadId a) . Just $ tid
-
--- This is where we define all of the routes in our application. For a full
--- explanation of the syntax, please see:
--- http://www.yesodweb.com/book/routing-and-handlers
---
--- Note that this is really half the story; in Application.hs, mkYesodDispatch
--- generates the rest of the code. Please see the following documentation
--- for an explanation for this split:
--- http://www.yesodweb.com/book/scaffolding-and-the-site-template#scaffolding-and-the-site-template_foundation_and_application_modules
---
--- This function also generates the following type synonyms:
--- type Handler = HandlerT AgentCtx IO
-mkYesodData "AgentCtx" $(parseRoutesFile "config/routes")
-
-noCacheUnlessSpecified :: Handler a -> Handler a
-noCacheUnlessSpecified action = do
-    getCurrentRoute >>= \case
-        Nothing -> action
-        Just r -> if "cached" `member` routeAttrs r
-            then action
-            else addHeader "Cache-Control" "no-store" >> action
--- Please see the documentation for the Yesod typeclass. There are a number
--- of settings which can be configured by overriding methods here.
-instance Yesod AgentCtx where
-    approot = ApprootRelative
-    authRoute _ = Nothing
-
-    isAuthorized route _ | "noAuth" `member` routeAttrs route = pure Authorized
-                         -- HACK! So that updating from 0.1.5 to 0.2.x doesn't leave you unreachable during system sync
-                         -- in the old companion
-                         | (fst $ renderRoute route) == ["v0"] = do
-                             isUpdating <- fmap isJust $ getsYesod appIsUpdating >>= liftIO . readIORef
-                             fresh <- fmap Startlude.null . runDB $ selectList ([] :: [Filter Account]) []
-                             if isUpdating && fresh
-                                 then sendResponseStatus status200 (object ["status" .= ("UPDATING" :: Text)])
-                                 else requireSessionAuth
-                         | otherwise                          = requireSessionAuth
-
--- Yesod Middleware allows you to run code before and after each handler function.
--- The defaultYesodMiddleware adds the response header "Vary: Accept, Accept-Language" and performs authorization checks.
--- Some users may also want to add the defaultCsrfMiddleware, which:
---   a) Sets a cookie with a CSRF token in it.
---   b) Validates that incoming write requests include that token in either a header or POST parameter.
--- To add it, chain it together with the defaultMiddleware: yesodMiddleware = defaultYesodMiddleware . defaultCsrfMiddleware
--- For details, see the CSRF documentation in the Yesod.Core.Handler module of the yesod-core package.
-    yesodMiddleware :: ToTypedContent res => Handler res -> Handler res
-    yesodMiddleware = defaultYesodMiddleware . cutoffDuringUpdate . noCacheUnlessSpecified
-
--- What messages should be logged. The following includes all messages when
--- in development, and warnings and errors in production.
-    shouldLogIO :: AgentCtx -> LogSource -> LogLevel -> IO Bool
-    shouldLogIO app _source level =
-        return $ appShouldLogAll (appSettings app) || level == LevelInfo || level == LevelWarn || level == LevelError
-
-    makeLogger :: AgentCtx -> IO Logger
-    makeLogger = return . appLogger
-
-    makeSessionBackend :: AgentCtx -> IO (Maybe SessionBackend)
-    makeSessionBackend ctx = strictSameSiteSessions $ do
-        filepath <- injectFilesystemBaseFromContext settings $ getAbsoluteLocationFor sessionSigningKeyPath
-        fmap Just $ defaultClientSessionBackend minutes $ toS filepath
-        where
-            settings = appSettings ctx
-            minutes = 7 * 24 * 60 -- 7 days
-
-instance RenderMessage AgentCtx FormMessage where
-    renderMessage _ _ = defaultFormMessage
-instance YesodAuth AgentCtx where
-    type AuthId AgentCtx = AccountId
-    loginDest _ = AuthenticateR
-    logoutDest _ = AuthenticateR
-    authPlugins _ = []
-
-    -- This gets called on login, but after HashDB's postLoginR handler is called.  This validates the username and password, so creds here are legit.
-    authenticate creds = liftHandler $ runDB $ do
-        x <- getBy $ UniqueAccount $ credsIdent creds
-        pure $ case x of
-            Just (Entity uid _) -> Authenticated uid
-            Nothing -> UserError Msg.NoIdentifierProvided
-
-instance YesodAuthPersist AgentCtx
-
--- How to run database actions.
-instance YesodPersist AgentCtx where
-    type YesodPersistBackend AgentCtx = SqlBackend
-    runDB :: SqlPersistT Handler a -> Handler a
-    runDB action = runSqlPool action . appConnPool =<< getYesod
-
-instance YesodPersistRunner AgentCtx where
-    getDBRunner :: Handler (DBRunner AgentCtx, Handler ())
-    getDBRunner = defaultGetDBRunner appConnPool
-
-unsafeHandler :: AgentCtx -> Handler a -> IO a
-unsafeHandler = Unsafe.fakeHandlerGetLogger appLogger
-
-appLogFunc :: AgentCtx -> LogFunc
-appLogFunc = appLogger >>= flip messageLoggerSource
-
-cutoffDuringUpdate :: Handler a -> Handler a
-cutoffDuringUpdate m = do
-    appIsUpdating <- getsYesod appIsUpdating >>= liftIO . readIORef
-    case appIsUpdating of
-        Just _ -> do
-            path <- asks $ pathInfo . reqWaiRequest . handlerRequest
-            case path of
-                [v] | v == "v" <> (show . major $ agentVersion) -> m
-                [auth] | auth == "auth" -> m
-                (_:ssh:_) | ssh == "sshKeys" -> m
-                _ -> handleS9ErrT $ throwE UpdateInProgressE
-        Nothing -> m
-
--- Returns authorized iff there is a valid (non-expired, signed + encrypted) session containing an account.
--- The only way for such a session to exist is if a previous login succeeded
-requireSessionAuth :: Handler AuthResult
-requireSessionAuth = do
-#ifdef DISABLE_AUTH
-    pure Authorized
-#else
-    maybeAuth >>= \case
-        Nothing -> pure AuthenticationRequired
-        Just _  -> pure Authorized
-#endif
-
-type AgentRunner m =
-    RegistryUrlIOC (FE.Labelled "filesystemBase" (ReaderT Text) (FE.Labelled "httpManager" (ReaderT Manager) (FE.LiftC (ReaderT AgentCtx m))))
-
-runInContext :: MonadResource m => AgentRunner m a -> ReaderT AgentCtx m a
-runInContext action = do
-    ctx <- ask
-    let s = appSettings ctx
-    action
-        & runRegistryUrlIOC
-        & FE.runLabelled @"filesystemBase"
-        & flip runReaderT (appFilesystemBase s)
-        & FE.runLabelled @"httpManager"
-        & flip runReaderT (appHttpManager ctx)
-        & FE.runM
-
-instance MonadBase IO Handler where
-    liftBase m = HandlerFor $ const m
-instance MonadBaseControl IO Handler where
-    type StM Handler a = a
-    liftBaseWith f = HandlerFor $ \handlerData -> f (($ handlerData) . unHandlerFor)
-    restoreM = pure

agent/src/Handler/Apps.hs

@@ -1,839 +0,0 @@
-{-# LANGUAGE NamedFieldPuns   #-}
-{-# LANGUAGE QuasiQuotes      #-}
-{-# LANGUAGE RecordWildCards  #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell  #-}
-{-# LANGUAGE TupleSections    #-}
-{-# LANGUAGE TypeApplications #-}
-module Handler.Apps where
-
-import           Startlude               hiding ( Reader
-                                                , asks
-                                                , catchError
-                                                , empty
-                                                , execState
-                                                , forkFinally
-                                                , modify
-                                                , runReader
-                                                )
-
-import           Control.Carrier.Error.Church
-import           Control.Carrier.Lift
-import           Control.Carrier.Reader
-import qualified Control.Concurrent.Async.Lifted
-                                               as LAsync
-import qualified Control.Concurrent.Lifted     as Lifted
-import           Control.Concurrent.STM.TVar
-import           Control.Effect.Empty    hiding ( guard )
-import           Control.Effect.Labelled        ( HasLabelled
-                                                , Labelled
-                                                , runLabelled
-                                                )
-import qualified Control.Exception.Lifted      as Lifted
-import           Control.Lens            hiding ( (??) )
-import           Control.Monad.Logger
-import           Control.Monad.Trans.Control    ( MonadBaseControl )
-import           Crypto.Hash
-import           Data.Aeson
-import           Data.Aeson.Lens
-import           Data.Aeson.Types               ( parseMaybe )
-import qualified Data.ByteString.Lazy          as LBS
-import qualified Data.HashMap.Lazy             as HML
-import qualified Data.HashMap.Strict           as HM
-import           Data.IORef
-import qualified Data.List.NonEmpty            as NE
-import           Data.Singletons
-import           Data.Singletons.Prelude.Bool   ( If
-                                                , SBool(..)
-                                                )
-import           Data.Singletons.Prelude.List   ( Elem )
-import qualified Data.Text                     as Text
-import           Database.Persist
-import           Database.Persist.Sql           ( ConnectionPool )
-import           Database.Persist.Sqlite        ( runSqlPool )
-import           Exinst
-import           Network.HTTP.Types
-import qualified Network.JSONRPC               as JSONRPC
-import           Yesod.Core.Content
-import           Yesod.Core.Handler      hiding ( cached )
-import           Yesod.Core.Json
-import           Yesod.Core.Types               ( JSONResponse(..) )
-import           Yesod.Persist.Core
-
-import           Foundation
-import           Handler.Backups
-import           Handler.Icons
-import           Handler.Network
-import           Handler.Types.Apps
-import           Handler.Util
-import qualified Lib.Algebra.Domain.AppMgr     as AppMgr2
-import           Lib.Algebra.State.RegistryUrl
-import           Lib.Background
-import           Lib.Error
-import qualified Lib.External.AppManifest      as AppManifest
-import qualified Lib.External.AppMgr           as AppMgr
-import qualified Lib.External.Registry         as Reg
-import           Lib.IconCache
-import qualified Lib.Notifications             as Notifications
-import           Lib.SystemPaths
-import           Lib.TyFam.ConditionalData
-import           Lib.Types.Core
-import           Lib.Types.Emver
-import           Lib.Types.NetAddress
-import           Lib.Types.ServerApp
-import           Model
-import           Settings
-
-pureLog :: Show a => a -> Handler a
-pureLog = liftA2 (*>) ($logInfo . show) pure
-
-logRet :: ToJSON a => Handler a -> Handler a
-logRet = (>>= liftA2 (*>) ($logInfo . decodeUtf8 . LBS.toStrict . encode) pure)
-
-mkAppStatus :: HM.HashMap AppId (BackupJobType, a) -> AppId -> AppContainerStatus -> AppStatus
-mkAppStatus hm appId status = case HM.lookup appId hm of
-    Nothing                 -> AppStatusAppMgr status
-    Just (CreateBackup , _) -> AppStatusTmp CreatingBackup
-    Just (RestoreBackup, _) -> AppStatusTmp RestoringBackup
-
-
-type AllEffects m
-    = AppMgr2.AppMgrCliC
-          ( RegistryUrlIOC
-                ( Labelled
-                      "iconTagCache"
-                      (ReaderT (TVar (HM.HashMap AppId (Digest MD5))))
-                      ( Labelled
-                            "filesystemBase"
-                            (ReaderT Text)
-                            ( Labelled
-                                  "databaseConnection"
-                                  (ReaderT ConnectionPool)
-                                  ( Labelled
-                                        "lanThread"
-                                        (ReaderT (MVar ThreadId))
-                                        (ReaderT AgentCtx (ErrorC S9Error (LiftC m)))
-                                  )
-                            )
-                      )
-                )
-          )
-
-intoHandler :: AllEffects Handler x -> Handler x
-intoHandler m = do
-    ctx <- getYesod
-    let fsbase = appFilesystemBase . appSettings $ ctx
-    runM
-        . handleS9ErrC
-        . flip runReaderT ctx
-        . flip runReaderT (appLanThread ctx)
-        . runLabelled @"lanThread"
-        . flip runReaderT (appConnPool ctx)
-        . runLabelled @"databaseConnection"
-        . flip runReaderT fsbase
-        . runLabelled @"filesystemBase"
-        . flip runReaderT (appIconTags ctx)
-        . runLabelled @"iconTagCache"
-        . runRegistryUrlIOC
-        . AppMgr2.runAppMgrCliC
-        $ m
-{-# INLINE intoHandler #-}
-
--- TODO nasty. Also, note that if AppMgr.getInstalledApp fails for any app we will not return available apps res.
-getAvailableAppsR :: Handler (JSONResponse [AppAvailablePreview])
-getAvailableAppsR = disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> getAvailableAppsLogic
-
-getAvailableAppsLogic :: ( Has (Reader AgentCtx) sig m
-                         , Has (Error S9Error) sig m
-                         , Has RegistryUrl sig m
-                         , Has AppMgr2.AppMgr sig m
-                         , MonadIO m
-                         , MonadBaseControl IO m
-                         )
-                      => m [AppAvailablePreview]
-getAvailableAppsLogic = do
-    jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
-    let installCache = inspect SInstalling jobCache
-    (Reg.AppIndexRes apps, serverApps) <- LAsync.concurrently Reg.getAppIndex (AppMgr2.list [AppMgr2.flags|-s -d|])
-    let remapped = remapAppMgrInfo jobCache serverApps
-    pure $ foreach apps $ \app@StoreApp { storeAppId } ->
-        let installing =
-                (   (storeAppVersionInfoVersion . snd . installInfo &&& const (AppStatusTmp Installing))
-                .   fst
-                <$> HM.lookup storeAppId installCache
-                )
-            installed = ((view _2 &&& view _1) <$> HM.lookup storeAppId remapped)
-        in  storeAppToAvailablePreview app $ installing <|> installed
-
-getAvailableAppByIdR :: AppId -> Handler (JSONResponse AppAvailableFull)
-getAvailableAppByIdR appId =
-    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> getAvailableAppByIdLogic appId
-
-getAvailableAppByIdLogic :: ( Has (Reader AgentCtx) sig m
-                            , Has (Error S9Error) sig m
-                            , Has RegistryUrl sig m
-                            , Has AppMgr2.AppMgr sig m
-                            , MonadIO m
-                            , MonadBaseControl IO m
-                            )
-                         => AppId
-                         -> m AppAvailableFull
-getAvailableAppByIdLogic appId = do
-    let storeAppId' = storeAppId
-    jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
-    let installCache = inspect SInstalling jobCache
-    ((Reg.AppIndexRes storeApps, serverApps), AppManifest.AppManifest { appManifestLicenseName, appManifestLicenseLink }) <-
-        LAsync.concurrently (LAsync.concurrently Reg.getAppIndex (AppMgr2.list [AppMgr2.flags|-s -d|]))
-                            (Reg.getAppManifest appId)
-    StoreApp {..} <- pure (find ((== appId) . storeAppId) storeApps) `orThrowM` NotFoundE "appId" (show appId)
-    let remapped = remapAppMgrInfo jobCache serverApps
-    let installingInfo =
-            (   (storeAppVersionInfoVersion . snd . installInfo &&& const (AppStatusTmp Installing))
-                .   fst
-                <$> HM.lookup appId installCache
-                )
-                <|> ((view _2 &&& view _1) <$> HM.lookup appId remapped)
-    let latest = extract storeAppVersions
-    dependencies <- AppMgr2.checkDependencies (AppMgr2.LocalOnly False)
-                                              appId
-                                              (Just . exactly $ storeAppVersionInfoVersion latest)
-    enrichedDeps <- maybe (throwError (NotFoundE "dependencyId for" (show appId))) pure $ flip
-        HML.traverseWithKey
-        dependencies
-        \depId depInfo ->
-            let
-                base = storeAppToAppBase <$> find ((== depId) . storeAppId') storeApps
-                status =
-                    (HM.lookup depId installCache $> AppStatusTmp Installing) <|> (view _1 <$> HM.lookup depId remapped)
-            in
-                (, status, depInfo) <$> base
-    let dependencyRequirements = fmap (dependencyInfoToDependencyRequirement (AsInstalled SFalse)) enrichedDeps
-    pure AppAvailableFull
-        { appAvailableFullBase                   = AppBase
-                                                       appId
-                                                       storeAppTitle
-                                                       (storeIconUrl appId (storeAppVersionInfoVersion $ extract storeAppVersions))
-        , appAvailableFullLicenseName            = appManifestLicenseName
-        , appAvailableFullLicenseLink            = appManifestLicenseLink
-        , appAvailableFullInstallInfo            = installingInfo
-        , appAvailableFullVersionLatest          = storeAppVersionInfoVersion latest
-        , appAvailableFullDescriptionShort       = storeAppDescriptionShort
-        , appAvailableFullDescriptionLong        = storeAppDescriptionLong
-        , appAvailableFullReleaseNotes           = storeAppVersionInfoReleaseNotes latest
-        , appAvailableFullDependencyRequirements = HM.elems dependencyRequirements
-        , appAvailableFullVersions               = storeAppVersionInfoVersion <$> storeAppVersions
-        , appAvailableFullInstallAlert           = storeAppVersionInfoInstallAlert latest
-        }
-
-getAppLogsByIdR :: AppId -> Handler (JSONResponse [Text])
-getAppLogsByIdR appId = disableEndpointOnFailedUpdate $ handleS9ErrT $ do
-    logs <- AppMgr.getAppLogs appId
-    pure . JSONResponse . lines $ logs
-
-getInstalledAppsR :: Handler (JSONResponse [AppInstalledPreview])
-getInstalledAppsR = disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> getInstalledAppsLogic
-
-cached :: MonadIO m => m a -> m (m a)
-cached action = do
-    ref <- liftIO $ newIORef Nothing
-    pure $ liftIO (readIORef ref) >>= \case
-        Nothing -> action >>= liftA2 (*>) (liftIO . writeIORef ref . Just) pure
-        Just x  -> pure x
-
-getInstalledAppsLogic :: (Has (Reader AgentCtx) sig m, Has AppMgr2.AppMgr sig m, MonadIO m) => m [AppInstalledPreview]
-getInstalledAppsLogic = do
-    jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
-    let installCache = installInfo . fst <$> inspect SInstalling jobCache
-    serverApps <- AppMgr2.list [AppMgr2.flags|-s -d -m|]
-    let remapped           = remapAppMgrInfo jobCache serverApps
-        installingPreviews = flip
-            HM.mapWithKey
-            installCache
-            \installingId (StoreApp {..}, StoreAppVersionInfo {..}) -> AppInstalledPreview
-                { appInstalledPreviewBase             = AppBase installingId
-                                                                storeAppTitle
-                                                                (iconUrl installingId storeAppVersionInfoVersion)
-                , appInstalledPreviewStatus           = AppStatusTmp Installing
-                , appInstalledPreviewVersionInstalled = storeAppVersionInfoVersion
-                , appInstalledPreviewTorAddress       = Nothing
-                , appInstalledPreviewLanAddress       = Nothing
-                , appInstalledPreviewTorUi            = False
-                , appInstalledPreviewLanUi            = False
-                }
-        installedPreviews = flip
-            HML.mapWithKey
-            remapped
-            \appId (s, v, AppMgr2.InfoRes {..}) ->
-                let
-                    mLanAddress = do -- Maybe
-                        addrBase <- infoResTorAddress
-                        let
-                            lanConfs = mapMaybe AppManifest.portMapEntryLan
-                                $ AppManifest.appManifestPortMapping infoResManifest
-                        guard (not . null $ lanConfs)
-                        pure $ LanAddress . (".onion" `Text.replace` ".local") . unTorAddress $ addrBase
-                in  AppInstalledPreview { appInstalledPreviewBase = AppBase appId infoResTitle (iconUrl appId v)
-                                        , appInstalledPreviewStatus = s
-                                        , appInstalledPreviewVersionInstalled = v
-                                        , appInstalledPreviewTorAddress = infoResTorAddress
-                                        , appInstalledPreviewLanAddress = mLanAddress
-                                        , appInstalledPreviewTorUi = AppManifest.torUiAvailable infoResManifest
-                                        , appInstalledPreviewLanUi = AppManifest.lanUiAvailable infoResManifest
-                                        }
-
-    pure $ HML.elems $ HML.union installingPreviews installedPreviews
-
-getInstalledAppByIdR :: AppId -> Handler (JSONResponse AppInstalledFull)
-getInstalledAppByIdR appId =
-    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> getInstalledAppByIdLogic appId
-
-getInstalledAppByIdLogic :: ( Has (Reader AgentCtx) sig m
-                            , Has RegistryUrl sig m
-                            , Has (Error S9Error) sig m
-                            , Has AppMgr2.AppMgr sig m
-                            , MonadIO m
-                            , MonadBaseControl IO m
-                            )
-                         => AppId
-                         -> m AppInstalledFull
-getInstalledAppByIdLogic appId = do
-    jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
-    let installCache = installInfo . fst <$> inspect SInstalling jobCache
-    db          <- asks appConnPool
-    backupTime' <- LAsync.async $ liftIO $ flip runSqlPool db $ getLastSuccessfulBackup appId
-    let installing = do
-            backupTime <- lift $ LAsync.wait backupTime'
-            hoistMaybe $ HM.lookup appId installCache <&> \(StoreApp {..}, StoreAppVersionInfo {..}) -> AppInstalledFull
-                { appInstalledFullBase = AppBase appId storeAppTitle (iconUrl appId storeAppVersionInfoVersion)
-                , appInstalledFullLicenseName            = Nothing
-                , appInstalledFullLicenseLink            = Nothing
-                , appInstalledFullStatus                 = AppStatusTmp Installing
-                , appInstalledFullVersionInstalled       = storeAppVersionInfoVersion
-                , appInstalledFullInstructions           = Nothing
-                , appInstalledFullLastBackup             = backupTime
-                , appInstalledFullTorAddress             = Nothing
-                , appInstalledFullLanAddress             = Nothing
-                , appInstalledFullTorUi                  = False
-                , appInstalledFullLanUi                  = False
-                , appInstalledFullConfiguredRequirements = []
-                , appInstalledFullUninstallAlert         = Nothing
-                , appInstalledFullRestoreAlert           = Nothing
-                , appInstalledFullStartAlert             = Nothing
-                , appInstalledFullActions                = []
-                }
-    serverApps <- AppMgr2.list [AppMgr2.flags|-s -d|]
-    let remapped = remapAppMgrInfo jobCache serverApps
-    appManifestFetchCached <- cached Reg.getAppIndex
-    let
-        installed = do
-            (status, version, AppMgr2.InfoRes {..}) <- hoistMaybe (HM.lookup appId remapped)
-            manifest' <- lift $ LAsync.async $ AppMgr2.infoResManifest <<$>> AppMgr2.info [AppMgr2.flags|-M|] appId
-            instructions'                           <- lift $ LAsync.async $ AppMgr2.instructions appId
-            requirements                            <- LAsync.runConcurrently $ flip
-                HML.traverseWithKey
-                (HML.filter AppMgr2.dependencyInfoRequired infoResDependencies)
-                \depId depInfo -> LAsync.Concurrently $ do
-                    let
-                        fromInstalled = (AppMgr2.infoResTitle &&& AppMgr2.infoResVersion)
-                            <$> hoistMaybe (HM.lookup depId serverApps)
-                    let fromStore = do
-                            Reg.AppIndexRes res <- lift appManifestFetchCached
-                            (storeAppTitle &&& storeAppVersionInfoVersion . extract . storeAppVersions)
-                                <$> hoistMaybe (find ((== depId) . storeAppId) res)
-                    (title, v) <- fromInstalled <|> fromStore
-                    let base = AppBase depId title (iconUrl depId v)
-                    let
-                        depStatus =
-                            (HM.lookup depId installCache $> AppStatusTmp Installing)
-                                <|> (view _1 <$> HM.lookup depId remapped)
-                    pure $ dependencyInfoToDependencyRequirement (AsInstalled STrue) (base, depStatus, depInfo)
-            manifest <- (lift $ LAsync.wait manifest') >>= \case
-                Nothing -> throwError $ NotFoundE "manifest" (show appId)
-                Just x  -> pure x
-            instructions <- lift $ LAsync.wait instructions'
-            backupTime   <- lift $ LAsync.wait backupTime'
-            let lanAddress = do
-                    addrBase <- infoResTorAddress
-                    let lanConfs = mapMaybe AppManifest.portMapEntryLan $ AppManifest.appManifestPortMapping manifest
-                    guard (not . null $ lanConfs)
-                    pure $ LanAddress . (".onion" `Text.replace` ".local") . unTorAddress $ addrBase
-            pure AppInstalledFull { appInstalledFullBase = AppBase appId infoResTitle (iconUrl appId version)
-                                  , appInstalledFullLicenseName            = AppManifest.appManifestLicenseName manifest
-                                  , appInstalledFullLicenseLink            = AppManifest.appManifestLicenseLink manifest
-                                  , appInstalledFullStatus                 = status
-                                  , appInstalledFullVersionInstalled       = version
-                                  , appInstalledFullInstructions           = instructions
-                                  , appInstalledFullLastBackup             = backupTime
-                                  , appInstalledFullTorAddress             = infoResTorAddress
-                                  , appInstalledFullLanAddress             = lanAddress
-                                  , appInstalledFullTorUi                  = AppManifest.torUiAvailable manifest
-                                  , appInstalledFullLanUi                  = AppManifest.lanUiAvailable manifest
-                                  , appInstalledFullConfiguredRequirements = HM.elems requirements
-                                  , appInstalledFullUninstallAlert = AppManifest.appManifestUninstallAlert manifest
-                                  , appInstalledFullRestoreAlert = AppManifest.appManifestRestoreAlert manifest
-                                  , appInstalledFullStartAlert             = AppManifest.appManifestStartAlert manifest
-                                  , appInstalledFullActions                = AppManifest.appManifestActions manifest
-                                  }
-    runMaybeT (installing <|> installed) `orThrowM` NotFoundE "appId" (show appId)
-
-postUninstallAppR :: AppId -> Handler (JSONResponse (WithBreakages ()))
-postUninstallAppR appId = do
-    dry <- AppMgr2.DryRun . isJust <$> lookupGetParam "dryrun"
-    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> postUninstallAppLogic appId dry
-
-postUninstallAppLogic :: ( HasFilesystemBase sig m
-                         , Has (Reader AgentCtx) sig m
-                         , Has (Error S9Error) sig m
-                         , Has AppMgr2.AppMgr sig m
-                         , MonadIO m
-                         , HasLabelled "databaseConnection" (Reader ConnectionPool) sig m
-                         , HasLabelled "iconTagCache" (Reader (TVar (HM.HashMap AppId (Digest MD5)))) sig m
-                         , HasLabelled "lanThread" (Reader (MVar ThreadId)) sig m
-                         )
-                      => AppId
-                      -> AppMgr2.DryRun
-                      -> m (WithBreakages ())
-postUninstallAppLogic appId dryrun = do
-    jobCache <- asks appBackgroundJobs >>= liftIO . readTVarIO
-    let tmpStatuses = statuses jobCache
-    serverApps <- AppMgr2.list [AppMgr2.flags| |]
-    when (not $ HM.member appId serverApps) $ throwError (AppNotInstalledE appId)
-    case HM.lookup appId tmpStatuses of
-        Just Installing      -> throwError (TemporarilyForbiddenE appId "uninstall" (show Installing))
-        Just CreatingBackup  -> throwError (TemporarilyForbiddenE appId "uninstall" (show CreatingBackup))
-        Just RestoringBackup -> throwError (TemporarilyForbiddenE appId "uninstall" (show RestoringBackup))
-        _                    -> pure ()
-    let flags = if coerce dryrun then Left dryrun else Right (AppMgr2.Purge True)
-    breakageIds <- HM.keys . AppMgr2.unBreakageMap <$> AppMgr2.remove flags appId
-    bs <- pure (traverse (hydrate $ (AppMgr2.infoResTitle &&& AppMgr2.infoResVersion) <$> serverApps) breakageIds)
-        `orThrowM` InternalE "Reported app breakage for app that isn't installed, contact support"
-    when (not $ coerce dryrun) $ do
-        clearIcon appId
-        postResetLanLogic
-    pure $ WithBreakages bs ()
-
-type InstallResponse :: Bool -> Type
-data InstallResponse a = InstallResponse (If a (WithBreakages ()) AppInstalledFull)
-instance ToJSON (Some1 InstallResponse) where
-    toJSON (Some1 STrue  (InstallResponse a)) = toJSON a
-    toJSON (Some1 SFalse (InstallResponse a)) = toJSON a
-postInstallNewAppR :: AppId -> Handler (JSONResponse (Some1 InstallResponse))
-postInstallNewAppR appId = do
-    dryrun <- isJust <$> lookupGetParam "dryrun"
-    InstallNewAppReq { installNewAppVersion } <- requireCheckJsonBody
-    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> do
-        withSomeSing dryrun $ \sb -> Some1 sb . InstallResponse <$> postInstallNewAppLogic appId installNewAppVersion sb
-
-postInstallNewAppLogic :: forall sig m a
-                        . ( Has (Reader AgentCtx) sig m
-                          , HasLabelled "lanThread" (Reader (MVar ThreadId)) sig m
-                          , HasLabelled "databaseConnection" (Reader ConnectionPool) sig m
-                          , HasLabelled "iconTagCache" (Reader (TVar (HM.HashMap AppId (Digest MD5)))) sig m
-                          , Has (Error S9Error) sig m
-                          , Has RegistryUrl sig m
-                          , Has AppMgr2.AppMgr sig m
-                          , HasFilesystemBase sig m
-                          , MonadIO m
-                          , MonadBaseControl IO m
-                          )
-                       => AppId
-                       -> Version
-                       -> SBool a
-                       -> m (If a (WithBreakages ()) AppInstalledFull)
-postInstallNewAppLogic appId appVersion dryrun = do
-    db   <- asks appConnPool
-    full <- (Just <$> getInstalledAppByIdLogic appId) `catchError` \case
-        NotFoundE "appId" appId' ->
-            if AppId appId' == appId then pure Nothing else throwError (NotFoundE "appId" appId')
-        other -> throwError other
-    case full of
-        Just aif@AppInstalledFull{} -> if appInstalledFullVersionInstalled aif == appVersion
-            then pure $ case dryrun of
-                STrue  -> WithBreakages [] ()
-                SFalse -> aif
-            else installIt db True
-        Nothing -> installIt db False
-    where
-        installIt :: ConnectionPool -> Bool -> m (If a (WithBreakages ()) AppInstalledFull)
-        installIt db isUpdate = do
-            jobCacheTVar                <- asks appBackgroundJobs
-            store@StoreApp {..}         <- Reg.getStoreAppInfo appId `orThrowM` NotFoundE "appId" (show appId)
-            vinfo@StoreAppVersionInfo{} <-
-                find ((== appVersion) . storeAppVersionInfoVersion) storeAppVersions
-                    `orThrowPure` NotFoundE "version" (show appVersion)
-            -- if it is a dry run of an update we don't want to modify the cache
-            case dryrun of
-                STrue -> if not isUpdate
-                    then pure $ WithBreakages [] ()
-                    else do
-                        serverApps' <- LAsync.async $ AppMgr2.list [AppMgr2.flags| |]
-                        hm          <- AppMgr2.update (AppMgr2.DryRun True) appId (Just $ exactly appVersion)
-                        (serverApps :: HM.HashMap AppId (AppMgr2.InfoRes ( 'Right '[]))) <- LAsync.wait serverApps'
-                        breakages   <-
-                            traverse (hydrate ((AppMgr2.infoResTitle &&& AppMgr2.infoResVersion) <$> serverApps))
-                                     (HM.keys $ AppMgr2.unBreakageMap hm)
-                                `orThrowPure` InternalE
-                                                  "Breakage reported for app that isn't installed, contact support"
-                        pure $ WithBreakages breakages ()
-                SFalse -> do
-                    let
-                        action = do
-                            iconAction <- LAsync.async $ saveIcon (toS storeAppIconUrl)
-                            let install = if isUpdate
-                                    then void $ AppMgr2.update (AppMgr2.DryRun False) appId (Just $ exactly appVersion)
-                                    else AppMgr2.install (AppMgr2.NoCache True) appId (Just $ exactly appVersion)
-                            let
-                                success = liftIO $ void $ flip runSqlPool db $ Notifications.emit
-                                    appId
-                                    appVersion
-                                    Notifications.InstallSuccess
-                            let failure e = liftIO $ do
-                                    let notif = case e of
-                                            AppMgrE _ ec -> Notifications.InstallFailedAppMgrExitCode ec
-                                            _            -> Notifications.InstallFailedS9Error e
-                                    void $ flip runSqlPool db $ Notifications.emit appId appVersion notif
-                                    putStrLn @Text (show e)
-                            let todo = do
-                                    install
-                                    () <- LAsync.wait iconAction
-                                    success
-                            todo `catchError` failure
-                    tid <- action `Lifted.forkFinally` const postInstall
-                    liftIO $ atomically $ modifyTVar' jobCacheTVar (insertJob appId (Install store vinfo) tid)
-                    getInstalledAppByIdLogic appId
-        postInstall :: m ()
-        postInstall = do
-            jobCache <- asks appBackgroundJobs
-            pool     <- asks appConnPool
-            liftIO . atomically $ modifyTVar jobCache (deleteJob appId)
-            ls <- AppMgr2.list [AppMgr2.flags| |]
-            LAsync.forConcurrently_ (HM.toList ls) $ \(k, AppMgr2.InfoRes {..}) -> when
-                infoResNeedsRestart
-                (            postRestartServerAppLogic k
-                `catchError` \e -> liftIO $ runSqlPool
-                                 (void $ Notifications.emit k infoResVersion (Notifications.RestartFailed e))
-                                 pool
-                )
-            postResetLanLogic
-
-
-postStartServerAppR :: AppId -> Handler ()
-postStartServerAppR appId = disableEndpointOnFailedUpdate . intoHandler $ postStartServerAppLogic appId
-
-postStartServerAppLogic :: (Has (Error S9Error) sig m, Has AppMgr2.AppMgr sig m, Has (Reader AgentCtx) sig m, MonadIO m)
-                        => AppId
-                        -> m ()
-postStartServerAppLogic appId = do
-    jobCache       <- asks appBackgroundJobs >>= liftIO . readTVarIO
-    info           <- AppMgr2.info [AppMgr2.flags|-s -d|] appId `orThrowM` AppNotInstalledE appId
-    (status, _, _) <- (HM.lookup appId $ remapAppMgrInfo jobCache (HM.singleton appId info))
-        `orThrowPure` InternalE "Remapping magically deleted keys between source and target structures"
-    case status of
-        AppStatusAppMgr Stopped -> AppMgr2.start appId
-        other                   -> throwError $ AppStateActionIncompatibleE appId other Start
-
-postRestartServerAppR :: AppId -> Handler ()
-postRestartServerAppR appId = disableEndpointOnFailedUpdate . intoHandler $ postRestartServerAppLogic appId
-
-postRestartServerAppLogic :: ( Has (Reader AgentCtx) sig m
-                             , Has AppMgr2.AppMgr sig m
-                             , Has (Error S9Error) sig m
-                             , MonadBaseControl IO m
-                             , MonadIO m
-                             )
-                          => AppId
-                          -> m ()
-postRestartServerAppLogic appId = do
-    jobCache <- asks appBackgroundJobs
-    answer   <- Lifted.newEmptyMVar
-    void . Lifted.fork $ do
-        tid     <- Lifted.myThreadId
-        problem <- liftIO . atomically $ do
-            JobCache jobs <- readTVar jobCache
-            case HM.lookup appId jobs of
-                Just (Some1 s _, _) -> pure (Just . throwError $ TemporarilyForbiddenE appId "restart" (show s))
-                Nothing             -> do
-                    modifyTVar jobCache (insertJob appId RestartApp tid)
-                    pure Nothing
-        case problem of
-            Nothing -> do
-                AppMgr2.restart appId `Lifted.finally` (liftIO . atomically) (modifyTVar jobCache (deleteJob appId))
-                Lifted.putMVar answer Nothing
-            Just p -> Lifted.putMVar answer (Just p)
-    Lifted.takeMVar answer >>= \case
-        Nothing -> pure ()
-        Just p  -> p
-
-
-postStopServerAppR :: AppId -> Handler (JSONResponse (WithBreakages ()))
-postStopServerAppR appId = disableEndpointOnFailedUpdate do
-    dryrun <- isJust <$> lookupGetParam "dryrun"
-    mRes   <- intoHandler $ runMaybeT (JSONResponse <$> postStopServerAppLogic appId (AppMgr2.DryRun dryrun))
-    case mRes of
-        Nothing -> sendResponseStatus status200 ()
-        Just x  -> pure x
-
-postStopServerAppLogic :: ( Has Empty sig m
-                          , Has (Reader AgentCtx) sig m
-                          , Has (Error S9Error) sig m
-                          , Has AppMgr2.AppMgr sig m
-                          , MonadIO m
-                          , MonadBaseControl IO m
-                          )
-                       => AppId
-                       -> AppMgr2.DryRun
-                       -> m (WithBreakages ())
-postStopServerAppLogic appId dryrun = do
-    jobCache <- asks appBackgroundJobs
-    titles   <- (AppMgr2.infoResTitle &&& AppMgr2.infoResVersion) <<$>> AppMgr2.list [AppMgr2.flags| |]
-    let stopIt = do
-            breakages <- AppMgr2.stop dryrun appId
-            bases     <- traverse (hydrate titles) (HM.keys $ AppMgr2.unBreakageMap breakages)
-                `orThrowPure` InternalE "Breakages reported for app that isn't installed, contact support"
-            pure $ WithBreakages bases ()
-    status <- AppMgr2.infoResStatus <<$>> AppMgr2.info [AppMgr2.flags|-S|] appId
-    case (dryrun, status) of
-        (_                   , Nothing     ) -> throwError $ NotFoundE "appId" (show appId)
-        (AppMgr2.DryRun False, Just Running) -> do
-            tid <- (void stopIt)
-                `Lifted.forkFinally` const ((liftIO . atomically) (modifyTVar jobCache (deleteJob appId)))
-            liftIO . atomically $ modifyTVar jobCache (insertJob appId StopApp tid)
-            empty
-        (AppMgr2.DryRun True , Just Running   ) -> stopIt
-        (AppMgr2.DryRun False, Just Restarting) -> do
-            tid <- (void stopIt)
-                `Lifted.forkFinally` const ((liftIO . atomically) (modifyTVar jobCache (deleteJob appId)))
-            liftIO . atomically $ modifyTVar jobCache (insertJob appId StopApp tid)
-            empty
-        (AppMgr2.DryRun True, Just Restarting) -> stopIt
-        (_, Just other) -> throwError $ AppStateActionIncompatibleE appId (AppStatusAppMgr other) Stop
-
-getAppConfigR :: AppId -> Handler TypedContent
-getAppConfigR =
-    disableEndpointOnFailedUpdate
-        . handleS9ErrT
-        . fmap (TypedContent typeJson . toContent)
-        . AppMgr.getConfigurationAndSpec
-
-patchAppConfigR :: AppId -> Handler (JSONResponse (WithBreakages ()))
-patchAppConfigR appId = disableEndpointOnFailedUpdate $ do
-    dryrun  <- isJust <$> lookupGetParam "dryrun"
-    value   <- requireCheckJsonBody @_ @Value
-    realVal <-
-        runM . handleS9ErrC $ ((value ^? key "config") `orThrowPure` (InvalidRequestE value "Missing 'config' key"))
-    intoHandler $ JSONResponse <$> patchAppConfigLogic appId (AppMgr2.DryRun dryrun) realVal
-
-patchAppConfigLogic :: ( Has (Reader AgentCtx) sig m
-                       , Has (Error S9Error) sig m
-                       , Has AppMgr2.AppMgr sig m
-                       , MonadBaseControl IO m
-                       , MonadIO m
-                       )
-                    => AppId
-                    -> AppMgr2.DryRun
-                    -> Value
-                    -> m (WithBreakages ())
-patchAppConfigLogic appId dryrun cfg = do
-    serverApps                <- AppMgr2.list [AppMgr2.flags| |]
-    AppMgr2.ConfigureRes {..} <- AppMgr2.configure dryrun appId (Just cfg)
-    when (not $ coerce dryrun) $ for_ configureResNeedsRestart postRestartServerAppLogic
-    breakages <-
-        traverse (hydrate ((AppMgr2.infoResTitle &&& AppMgr2.infoResVersion) <$> serverApps))
-                 (HM.keys configureResStopped)
-            `orThrowPure` InternalE "Breakage reported for app that is not installed, contact support"
-    pure $ WithBreakages breakages ()
-
-
-getAppNotificationsR :: AppId -> Handler (JSONResponse [Entity Notification])
-getAppNotificationsR appId = disableEndpointOnFailedUpdate $ runDB $ do
-    page     <- lookupGetParam "page" `orDefaultTo` 1
-    pageSize <- lookupGetParam "perPage" `orDefaultTo` 20
-    evs      <- selectList [NotificationAppId ==. appId]
-                           [Desc NotificationCreatedAt, LimitTo pageSize, OffsetBy ((page - 1) * pageSize)]
-    let toArchive = fmap entityKey $ filter ((== Nothing) . notificationArchivedAt . entityVal) evs
-    void $ Notifications.archive toArchive
-    pure $ JSONResponse evs
-    where
-        orDefaultTo :: (Monad m, Read a) => m (Maybe Text) -> a -> m a
-        orDefaultTo m a = do
-            m' <- m
-            case m' >>= readMaybe . toS of
-                Nothing -> pure a
-                Just x  -> pure x
-
-getAppMetricsR :: AppId -> Handler TypedContent
-getAppMetricsR appId =
-    disableEndpointOnFailedUpdate . handleS9ErrT $ fmap (TypedContent typeJson . toContent) $ AppMgr.stats appId
-
-getAvailableAppVersionInfoR :: AppId -> VersionRange -> Handler (JSONResponse AppVersionInfo)
-getAvailableAppVersionInfoR appId version =
-    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> getAvailableAppVersionInfoLogic appId version
-
-getAvailableAppVersionInfoLogic :: ( Has (Reader AgentCtx) sig m
-                                   , Has (Error S9Error) sig m
-                                   , Has RegistryUrl sig m
-                                   , Has AppMgr2.AppMgr sig m
-                                   , MonadIO m
-                                   , MonadBaseControl IO m
-                                   )
-                                => AppId
-                                -> VersionRange
-                                -> m AppVersionInfo
-getAvailableAppVersionInfoLogic appId appVersionSpec = do
-    jobCache                  <- asks appBackgroundJobs >>= liftIO . readTVarIO
-    Reg.AppIndexRes storeApps <- Reg.getAppIndex
-    let titles =
-            (storeAppTitle &&& storeAppVersionInfoVersion . extract . storeAppVersions) <$> indexBy storeAppId storeApps
-    StoreApp {..} <- find ((== appId) . storeAppId) storeApps `orThrowPure` NotFoundE "appId" (show appId)
-    serverApps    <- AppMgr2.list [AppMgr2.flags|-s -d|]
-    let remapped = remapAppMgrInfo jobCache serverApps
-    StoreAppVersionInfo {..} <-
-        maximumMay (NE.filter ((<|| appVersionSpec) . storeAppVersionInfoVersion) storeAppVersions)
-            `orThrowPure` NotFoundE "version spec " (show appVersionSpec)
-    dependencies <- AppMgr2.checkDependencies (AppMgr2.LocalOnly False)
-                                              appId
-                                              (Just $ exactly storeAppVersionInfoVersion)
-    requirements <- flip HML.traverseWithKey dependencies $ \depId depInfo -> do
-        base <- hydrate titles depId `orThrowPure` NotFoundE "metadata for" (show depId)
-        let status =
-                (HM.lookup depId (inspect SInstalling jobCache) $> AppStatusTmp Installing)
-                    <|> (view _1 <$> HM.lookup depId remapped)
-        pure $ dependencyInfoToDependencyRequirement (AsInstalled SFalse) (base, status, depInfo)
-    pure AppVersionInfo { appVersionInfoVersion                = storeAppVersionInfoVersion
-                        , appVersionInfoReleaseNotes           = storeAppVersionInfoReleaseNotes
-                        , appVersionInfoDependencyRequirements = HM.elems requirements
-                        , appVersionInfoInstallAlert           = storeAppVersionInfoInstallAlert
-                        }
-
-postAutoconfigureR :: AppId -> AppId -> Handler (JSONResponse (WithBreakages AutoconfigureChangesRes))
-postAutoconfigureR dependency dependent = do
-    dry <- AppMgr2.DryRun . isJust <$> lookupGetParam "dryrun"
-    disableEndpointOnFailedUpdate . intoHandler $ JSONResponse <$> postAutoconfigureLogic dependency dependent dry
-
-postAutoconfigureLogic :: ( Has (Reader AgentCtx) sig m
-                          , Has AppMgr2.AppMgr sig m
-                          , Has (Error S9Error) sig m
-                          , MonadBaseControl IO m
-                          , MonadIO m
-                          )
-                       => AppId
-                       -> AppId
-                       -> AppMgr2.DryRun
-                       -> m (WithBreakages AutoconfigureChangesRes)
-postAutoconfigureLogic dependency dependent dry = do
-    -- IMPORTANT! AppMgr reverses arguments from the endpoint
-    appData <- AppMgr2.list [AppMgr2.flags| |]
-    let apps = HM.keys appData
-    case (dependency `elem` apps, dependent `elem` apps) of
-        (False, _    ) -> throwError $ NotFoundE "appId" (show dependency)
-        (_    , False) -> throwError $ NotFoundE "appId" (show dependent)
-        _              -> pure ()
-    AppMgr2.AutoconfigureRes {..} <- AppMgr2.autoconfigure dry dependent dependency
-    when (not $ coerce dry) $ for_ (AppMgr2.configureResNeedsRestart autoconfigureConfigRes) postRestartServerAppLogic
-    let titles = (AppMgr2.infoResTitle &&& AppMgr2.infoResVersion) <$> appData
-    bases <- traverse (hydrate titles) (HM.keys (AppMgr2.configureResStopped autoconfigureConfigRes))
-        `orThrowPure` InternalE "Breakages reported for app that isn't installed, contact support"
-    pure $ WithBreakages bases (AutoconfigureChangesRes $ HM.lookup dependency autoconfigureChanged)
-
-indexBy :: (Eq k, Hashable k) => (v -> k) -> [v] -> HM.HashMap k v
-indexBy = flip foldr HM.empty . (>>= HM.insertWith const)
-{-# INLINE indexBy #-}
-
-hydrate :: HM.HashMap AppId (Text, Version) -> AppId -> Maybe AppBase
-hydrate titles appId = HM.lookup appId titles <&> \(t, v) -> AppBase appId t (iconUrl appId v)
-
-remapAppMgrInfo :: (Elem 'AppMgr2.IncludeDependencies ls ~ 'True, Elem 'AppMgr2.IncludeStatus ls ~ 'True)
-                => JobCache
-                -> HM.HashMap AppId (AppMgr2.InfoRes ( 'Right ls)) -- ^ AppMgr response
-                -> HM.HashMap AppId (AppStatus, Version, AppMgr2.InfoRes ( 'Right ls))
-remapAppMgrInfo jobCache serverApps = flip
-    HML.mapWithKey
-    serverApps
-    \appId infoRes@AppMgr2.InfoRes {..} ->
-        let refinedDepInfo = flip
-                HML.mapWithKey
-                infoResDependencies
-                \depId depInfo ->
-                    case
-                            ( HM.lookup depId tmpStatuses
-                            , AppMgr2.infoResStatus <$> HM.lookup depId serverApps
-                            , AppMgr2.dependencyInfoError depInfo
-                            )
-                        of
-                            -- mute all of the not-running violations that are currently backing up and container is paused
-                            (Just CreatingBackup, Just Paused, Just AppMgr2.NotRunning) ->
-                                depInfo { AppMgr2.dependencyInfoError = Nothing }
-                            (_, _, _) -> depInfo
-            realViolations =
-                any (isJust . AppMgr2.dependencyInfoError <&&> AppMgr2.dependencyInfoRequired) refinedDepInfo
-            (status, version) =
-                maybe (AppStatusAppMgr infoResStatus, infoResVersion) (first AppStatusTmp)
-                    $   ((, infoResVersion) <$> HM.lookup appId tmpStatuses)
-                    <|> (guard (not infoResIsConfigured || infoResIsRecoverable) $> (NeedsConfig, infoResVersion))
-                    <|> (guard realViolations $> (BrokenDependencies, infoResVersion))
-        in  ( status
-            , version
-            , infoRes
-                { AppMgr2.infoResDependencies = case status of
-                                                    AppStatusTmp NeedsConfig -> HM.empty
-                                                    _                        -> refinedDepInfo
-                }
-            )
-    where tmpStatuses = statuses jobCache
-
-storeAppToAppBase :: StoreApp -> AppBase
-storeAppToAppBase StoreApp {..} =
-    AppBase storeAppId storeAppTitle (storeIconUrl storeAppId (storeAppVersionInfoVersion $ extract storeAppVersions))
-
-storeAppToAvailablePreview :: StoreApp -> Maybe (Version, AppStatus) -> AppAvailablePreview
-storeAppToAvailablePreview s@StoreApp {..} installed = AppAvailablePreview
-    (storeAppToAppBase s)
-    (storeAppVersionInfoVersion $ extract storeAppVersions)
-    storeAppDescriptionShort
-    installed
-    storeAppTimestamp
-
-type AsInstalled :: Bool -> Type
-newtype AsInstalled a = AsInstalled { unAsInstalled :: SBool a }
-dependencyInfoToDependencyRequirement :: AsInstalled a
-                                      -> (AppBase, Maybe AppStatus, AppMgr2.DependencyInfo)
-                                      -> (AppDependencyRequirement (If a Strip Keep))
-dependencyInfoToDependencyRequirement asInstalled (base, status, AppMgr2.DependencyInfo {..}) = do
-    let appDependencyRequirementBase        = base
-    let appDependencyRequirementDescription = dependencyInfoDescription
-    let appDependencyRequirementVersionSpec = dependencyInfoVersionSpec
-    let appDependencyRequirementViolation = case (status, dependencyInfoError) of
-            (Just s@(AppStatusTmp Installing), _) -> Just $ IncompatibleStatus s
-            (Nothing, _                        ) -> Just Missing
-            (_      , Just AppMgr2.NotInstalled) -> Just Missing
-            (_, Just (AppMgr2.InvalidVersion _ _)) -> Just IncompatibleVersion
-            (_, Just (AppMgr2.UnsatisfiedConfig reasons)) -> Just . IncompatibleConfig $ reasons
-            (Just s , Just AppMgr2.NotRunning  ) -> Just $ IncompatibleStatus s
-            (_      , Nothing                  ) -> Nothing
-    case asInstalled of
-        AsInstalled STrue ->
-            let appDependencyRequirementReasonOptional = ()
-                appDependencyRequirementDefault        = ()
-            in  AppDependencyRequirement { .. }
-        AsInstalled SFalse ->
-            let appDependencyRequirementReasonOptional = dependencyInfoReasonOptional
-                appDependencyRequirementDefault        = dependencyInfoRequired
-            in  AppDependencyRequirement { .. }
-
-postActionR :: AppId -> Handler (JSONResponse JSONRPC.Response)
-postActionR appId = do
-    req <- requireCheckJsonBody
-    fmap JSONResponse . intoHandler $ postActionLogic appId req
-
-postActionLogic :: (Has (Error S9Error) sig m, Has AppMgr2.AppMgr sig m)
-                => AppId
-                -> JSONRPC.Request
-                -> m JSONRPC.Response
-postActionLogic appId (JSONRPC.Request { getReqMethod, getReqId }) = do
-    hm <- AppMgr2.action appId getReqMethod
-    case (HM.lookup "result" hm, HM.lookup "error" hm >>= parseMaybe parseJSON) of
-        (Just v , _      ) -> pure (JSONRPC.Response JSONRPC.V2 v getReqId)
-        (_      , Just e ) -> pure (JSONRPC.ResponseError JSONRPC.V2 e getReqId)
-        (Nothing, Nothing) -> throwError
-            $ AppMgrParseE "action" (decodeUtf8 . LBS.toStrict $ encode (Object hm)) "Invalid JSONRPC Response"
-postActionLogic _ r = throwError $ InvalidRequestE (toJSON r) "Invalid JSONRPC Request"

agent/src/Handler/Authenticate.hs

@@ -1,9 +0,0 @@
-module Handler.Authenticate where
-
-import           Startlude
-
-import           Foundation
-
--- handled by auth switch in Foundation
-getAuthenticateR :: Handler ()
-getAuthenticateR = pure ()

agent/src/Handler/Backups.hs

@@ -1,244 +0,0 @@
-{-# LANGUAGE QuasiQuotes     #-}
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Backups where
-
-import           Startlude               hiding ( Reader
-                                                , ask
-                                                , runReader
-                                                )
-
-import           Control.Carrier.Error.Church
-import           Control.Carrier.Lift
-import           Control.Carrier.Reader         ( runReader )
-import           Control.Effect.Labelled hiding ( Handler )
-import           Control.Effect.Reader.Labelled
-import           Data.Aeson
-import qualified Data.HashMap.Strict           as HM
-import           Data.UUID.V4
-import           Database.Persist.Sql
-import           Yesod.Auth
-import           Yesod.Core
-import           Yesod.Core.Types
-
-import           Control.Concurrent.STM
-import           Exinst
-import           Foundation
-import           Handler.Network
-import           Handler.Util
-import qualified Lib.Algebra.Domain.AppMgr     as AppMgr2
-import           Lib.Background
-import           Lib.Error
-import qualified Lib.External.AppMgr           as AppMgr
-import qualified Lib.Notifications             as Notifications
-import           Lib.Password
-import           Lib.Types.Core
-import           Lib.Types.Emver
-import           Model
-
-
-data CreateBackupReq = CreateBackupReq
-    { createBackupLogicalName :: FilePath
-    , createBackupPassword    :: Maybe Text
-    }
-    deriving (Eq, Show)
-instance FromJSON CreateBackupReq where
-    parseJSON = withObject "Create Backup Req" $ \o -> do
-        createBackupLogicalName <- o .: "logicalname"
-        createBackupPassword    <- o .:? "password" .!= Nothing
-        pure CreateBackupReq { .. }
-
-data RestoreBackupReq = RestoreBackupReq
-    { restoreBackupLogicalName :: FilePath
-    , restoreBackupPassword    :: Maybe Text
-    }
-    deriving (Eq, Show)
-instance FromJSON RestoreBackupReq where
-    parseJSON = withObject "Restore Backup Req" $ \o -> do
-        restoreBackupLogicalName <- o .: "logicalname"
-        restoreBackupPassword    <- o .:? "password" .!= Nothing
-        pure RestoreBackupReq { .. }
-
-data EjectDiskReq = EjectDiskReq
-    { ejectDiskLogicalName :: Text
-    }
-    deriving (Eq, Show)
-instance FromJSON EjectDiskReq where
-    parseJSON = withObject "Eject Disk Req" $ \o -> do
-        ejectDiskLogicalName <- o .: "logicalName"
-        pure EjectDiskReq { .. }
-
--- Handlers
-
-postCreateBackupR :: AppId -> Handler ()
-postCreateBackupR appId = disableEndpointOnFailedUpdate $ do
-    req           <- requireCheckJsonBody
-    AgentCtx {..} <- getYesod
-    account       <- entityVal <$> requireAuth
-    case validatePass account <$> (createBackupPassword req) of
-        Just False -> runM . handleS9ErrC $ throwError BackupPassInvalidE
-        _ ->
-            createBackupLogic appId req
-                & AppMgr2.runAppMgrCliC
-                & runLabelled @"databaseConnection"
-                & runReader appConnPool
-                & runLabelled @"backgroundJobCache"
-                & runReader appBackgroundJobs
-                & handleS9ErrC
-                & runM
-
-
-postStopBackupR :: AppId -> Handler ()
-postStopBackupR appId = disableEndpointOnFailedUpdate $ do
-    cache <- getsYesod appBackgroundJobs
-    stopBackupLogic appId & runLabelled @"backgroundJobCache" & runReader cache & handleS9ErrC & runM
-
-postRestoreBackupR :: AppId -> Handler ()
-postRestoreBackupR appId = disableEndpointOnFailedUpdate $ do
-    req           <- requireCheckJsonBody
-    AgentCtx {..} <- getYesod
-    restoreBackupLogic appId req
-        & AppMgr2.runAppMgrCliC
-        & runLabelled @"databaseConnection"
-        & runReader appConnPool
-        & runLabelled @"backgroundJobCache"
-        & runReader appBackgroundJobs
-        & runLabelled @"lanThread"
-        & runReader appLanThread
-        & handleS9ErrC
-        & runM
-
-getDisksR :: Handler (JSONResponse [AppMgr.DiskInfo])
-getDisksR = fmap JSONResponse . runM . handleS9ErrC $ listDisksLogic
-
-postEjectR :: Handler ()
-postEjectR = runM . handleS9ErrC $ requireCheckJsonBody >>= ejectDiskLogic . ejectDiskLogicalName
-
--- Logic
-
-createBackupLogic :: ( HasLabelled "backgroundJobCache" (Reader (TVar JobCache)) sig m
-                     , HasLabelled "databaseConnection" (Reader ConnectionPool) sig m
-                     , Has (Error S9Error) sig m
-                     , Has AppMgr2.AppMgr sig m
-                     , MonadIO m
-                     )
-                  => AppId
-                  -> CreateBackupReq
-                  -> m ()
-createBackupLogic appId CreateBackupReq {..} = do
-    jobCache <- ask @"backgroundJobCache"
-    db       <- ask @"databaseConnection"
-    version  <- fmap AppMgr2.infoResVersion $ AppMgr2.info [AppMgr2.flags| |] appId `orThrowM` NotFoundE "appId"
-                                                                                                         (show appId)
-    res <- liftIO . atomically $ do
-        (JobCache jobs) <- readTVar jobCache
-        case HM.lookup appId jobs of
-            Just (Some1 SCreatingBackup  _, _) -> pure (Left $ BackupE appId "Already creating backup")
-            Just (Some1 SRestoringBackup _, _) -> pure (Left $ BackupE appId "Cannot backup during restore")
-            Just (Some1 _                _, _) -> pure (Left $ BackupE appId "Cannot backup: incompatible status")
-            Nothing                            -> do
-                -- this panic is here because we don't have the threadID yet, and it is required. We want to write the
-                -- TVar anyway though so that we don't accidentally launch multiple backup jobs
-                -- TODO: consider switching to MVar's for this
-                modifyTVar jobCache (insertJob appId Backup $ panic "ThreadID prematurely forced")
-                pure $ Right ()
-    case res of
-        Left  e  -> throwError e
-        Right () -> do
-            tid <- liftIO . forkIO $ do
-                appmgrRes <- runExceptT (AppMgr.backupCreate createBackupPassword appId createBackupLogicalName)
-                atomically $ modifyTVar' jobCache (deleteJob appId)
-                let notif = case appmgrRes of
-                        Left  e -> Notifications.BackupFailed e
-                        Right _ -> Notifications.BackupSucceeded
-                flip runSqlPool db $ do
-                    void $ insertBackupResult appId version (isRight appmgrRes)
-                    void $ Notifications.emit appId version notif
-            liftIO . atomically $ modifyTVar jobCache (insertJob appId Backup tid)
-
-stopBackupLogic :: ( HasLabelled "backgroundJobCache" (Reader (TVar JobCache)) sig m
-                   , Has (Error S9Error) sig m
-                   , MonadIO m
-                   )
-                => AppId
-                -> m ()
-stopBackupLogic appId = do
-    jobCache <- ask @"backgroundJobCache"
-    res      <- liftIO . atomically $ do
-        (JobCache jobs) <- readTVar jobCache
-        case HM.lookup appId jobs of
-            Just (Some1 SCreatingBackup _, tid) -> do
-                modifyTVar jobCache (deleteJob appId)
-                pure (Right tid)
-            Just (Some1 SRestoringBackup _, _) -> pure (Left $ BackupE appId "Cannot interrupt restore")
-            _ -> pure (Left $ NotFoundE "backup job" (show appId))
-    case res of
-        Left  e   -> throwError e
-        Right tid -> liftIO $ killThread tid
-
-restoreBackupLogic :: ( HasLabelled "backgroundJobCache" (Reader (TVar JobCache)) sig m
-                      , HasLabelled "databaseConnection" (Reader ConnectionPool) sig m
-                      , HasLabelled "lanThread" (Reader (MVar ThreadId)) sig m
-                      , Has (Error S9Error) sig m
-                      , Has AppMgr2.AppMgr sig m
-                      , MonadIO m
-                      )
-                   => AppId
-                   -> RestoreBackupReq
-                   -> m ()
-restoreBackupLogic appId RestoreBackupReq {..} = do
-    lanThread <- ask @"lanThread"
-    jobCache  <- ask @"backgroundJobCache"
-    db        <- ask @"databaseConnection"
-    version   <- fmap AppMgr2.infoResVersion $ AppMgr2.info [AppMgr2.flags| |] appId `orThrowM` NotFoundE "appId"
-                                                                                                          (show appId)
-    res <- liftIO . atomically $ do
-        (JobCache jobs) <- readTVar jobCache
-        case HM.lookup appId jobs of
-            Just (Some1 SCreatingBackup  _, _) -> pure (Left $ BackupE appId "Cannot restore during backup")
-            Just (Some1 SRestoringBackup _, _) -> pure (Left $ BackupE appId "Already restoring backup")
-            Just (Some1 _                _, _) -> pure (Left $ BackupE appId "Cannot backup: incompatible status")
-            Nothing                            -> do
-                -- this panic is here because we don't have the threadID yet, and it is required. We want to write the
-                -- TVar anyway though so that we don't accidentally launch multiple backup jobs
-                -- TODO: consider switching to MVar's for this
-                modifyTVar jobCache (insertJob appId Restore $ panic "ThreadID prematurely forced")
-                pure $ Right ()
-    case res of
-        Left  e -> throwError e
-        Right _ -> do
-            tid <- liftIO . forkIO $ do
-                appmgrRes <- runExceptT (AppMgr.backupRestore restoreBackupPassword appId restoreBackupLogicalName)
-                atomically $ modifyTVar jobCache (deleteJob appId)
-                let notif = case appmgrRes of
-                        Left  e -> Notifications.RestoreFailed e
-                        Right _ -> Notifications.RestoreSucceeded
-                resetRes <- runExceptT @S9Error $ runReader lanThread . runLabelled @"lanThread" $ postResetLanLogic
-                case resetRes of
-                    Left  _  -> pure () -- temporarily forbidden is the only possible thing here so ignore it
-                    Right () -> pure ()
-                flip runSqlPool db $ void $ Notifications.emit appId version notif
-            liftIO . atomically $ modifyTVar jobCache (insertJob appId Restore tid)
-
-listDisksLogic :: (Has (Error S9Error) sig m, MonadIO m) => m [AppMgr.DiskInfo]
-listDisksLogic = runExceptT AppMgr.diskShow >>= liftEither
-
-ejectDiskLogic :: (Has (Error S9Error) sig m, MonadIO m) => Text -> m ()
-ejectDiskLogic t = do
-    (ec, _) <- AppMgr.readProcessInheritStderr "eject" [toS t] ""
-    case ec of
-        ExitSuccess   -> pure ()
-        ExitFailure n -> throwError $ EjectE n
-
-insertBackupResult :: MonadIO m => AppId -> Version -> Bool -> SqlPersistT m (Entity BackupRecord)
-insertBackupResult appId appVersion succeeded = do
-    uuid <- liftIO nextRandom
-    now  <- liftIO getCurrentTime
-    let k = (BackupRecordKey uuid)
-    let v = (BackupRecord now appId appVersion succeeded)
-    insertKey k v
-    pure $ Entity k v
-
-getLastSuccessfulBackup :: MonadIO m => AppId -> SqlPersistT m (Maybe UTCTime)
-getLastSuccessfulBackup appId = backupRecordCreatedAt . entityVal <<$>> selectFirst
-    [BackupRecordAppId ==. appId, BackupRecordSucceeded ==. True]
-    [Desc BackupRecordCreatedAt]

agent/src/Handler/Hosts.hs

@@ -1,56 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Hosts where
-
-import           Startlude               hiding ( ask )
-
-import           Control.Carrier.Lift           ( runM )
-import           Data.Conduit
-import qualified Data.Conduit.Binary           as CB
-import           Yesod.Core              hiding ( expiresAt )
-
-import           Foundation
-import           Handler.Register               ( checkExistingPasswordRegistration
-                                                , getRegistration
-                                                )
-import           Handler.Types.Hosts
-import           Lib.Crypto
-import           Lib.Error
-import           Lib.Password                   ( rootAccountName )
-import           Lib.ProductKey
-import           Lib.SystemPaths                ( injectFilesystemBaseFromContext
-                                                , rootCaCertPath
-                                                , SystemPath(relativeTo)
-                                                )
-import           Settings
-
-getHostsR :: Handler HostsRes
-getHostsR = handleS9ErrT $ do
-    settings   <- getsYesod appSettings
-    productKey <- liftIO . getProductKey . appFilesystemBase $ settings
-    hostParams <- extractHostsQueryParams
-
-    verifyHmac productKey hostParams
-
-    mClaimedAt <- checkExistingPasswordRegistration rootAccountName
-    case mClaimedAt of
-        Nothing        -> pure $ NullReply
-        Just claimedAt -> do
-            fmap HostsRes . mapExceptT (liftIO . runM . injectFilesystemBaseFromContext settings) $ getRegistration
-                productKey
-                claimedAt
-
-verifyHmac :: MonadIO m => Text -> HostsParams -> S9ErrT m ()
-verifyHmac productKey params = do
-    let computedHmacDigest = computeHmac productKey hostsParamsExpiration hostsParamsSalt
-    unless (hostsParamsHmac == computedHmacDigest) $ throwE unauthorizedHmac
-    where
-        HostsParams { hostsParamsHmac, hostsParamsExpiration, hostsParamsSalt } = params
-        unauthorizedHmac = ClientCryptographyE "Unauthorized hmac"
-
-getCertificateR :: Handler TypedContent
-getCertificateR = do
-    base <- getsYesod $ appFilesystemBase . appSettings
-    respondSource "application/x-x509-ca-cert"
-        $  CB.sourceFile (toS $ rootCaCertPath `relativeTo` base)
-        .| awaitForever sendChunkBS

agent/src/Handler/Icons.hs

@@ -1,106 +0,0 @@
-{-# LANGUAGE PartialTypeSignatures #-}
-module Handler.Icons where
-
-import           Startlude               hiding ( Reader
-                                                , runReader
-                                                )
-
-import           Control.Carrier.Error.Either
-import           Control.Carrier.Lift
-import           Data.Conduit
-import           Data.Conduit.Binary           as CB
-import qualified Data.Text                     as T
-import           Network.HTTP.Simple
-import           System.FilePath.Posix
-import           Yesod.Core
-
-import           Control.Carrier.Reader  hiding ( asks )
-import           Control.Concurrent.STM         ( modifyTVar
-                                                , readTVarIO
-                                                )
-import           Control.Effect.Labelled        ( runLabelled )
-import           Crypto.Hash.Conduit            ( hashFile )
-import qualified Data.HashMap.Strict           as HM
-import           Foundation
-import           Lib.Algebra.State.RegistryUrl
-import           Lib.Error
-import qualified Lib.External.Registry         as Reg
-import           Lib.IconCache
-import           Lib.SystemPaths         hiding ( (</>) )
-import           Lib.Types.Core
-import           Lib.Types.Emver
-import           Lib.Types.ServerApp
-import           Settings
-
-iconUrl :: AppId -> Version -> Text
-iconUrl appId version = (foldMap (T.cons '/') . fst . renderRoute . AppIconR $ appId) <> "?" <> show version
-
-storeIconUrl :: AppId -> Version -> Text
-storeIconUrl appId version =
-    (foldMap (T.cons '/') . fst . renderRoute . AvailableAppIconR $ appId) <> "?" <> show version
-
-getAppIconR :: AppId -> Handler TypedContent
-getAppIconR appId = handleS9ErrT $ do
-    ctx <- getYesod
-    let iconTags = appIconTags ctx
-    storedTag <- liftIO $ readTVarIO iconTags >>= pure . HM.lookup appId
-    path      <- case storedTag of
-        Nothing -> interp ctx $ do
-            findIcon appId >>= \case
-                Nothing -> fetchIcon
-                Just fp -> do
-                    tag <- hashFile fp
-                    saveTag appId tag
-                    pure fp
-        Just x -> do
-            setWeakEtag (show x)
-            interp ctx $ findIcon appId >>= \case
-                Nothing -> do
-                    liftIO $ atomically $ modifyTVar iconTags (HM.delete appId)
-                    fetchIcon
-                Just fp -> pure fp
-    cacheSeconds 86_400
-    lift $ respondSource (parseContentType path) $ CB.sourceFile path .| awaitForever sendChunkBS
-    where
-        fetchIcon = do
-            url <- find ((== appId) . storeAppId) . Reg.storeApps <$> Reg.getAppIndex >>= \case
-                Nothing -> throwError $ NotFoundE "icon" (show appId)
-                Just x  -> pure . toS $ storeAppIconUrl x
-            bp <- getAbsoluteLocationFor iconBasePath
-            saveIcon url
-            pure (toS bp </> takeFileName url)
-        interp ctx =
-            mapExceptT (liftIO . runM)
-                . runReader (appConnPool ctx)
-                . runLabelled @"databaseConnection"
-                . runReader (appFilesystemBase $ appSettings ctx)
-                . runLabelled @"filesystemBase"
-                . runReader (appIconTags ctx)
-                . runLabelled @"iconTagCache"
-                . runRegistryUrlIOC
-
-
-getAvailableAppIconR :: AppId -> Handler TypedContent
-getAvailableAppIconR appId = handleS9ErrT $ do
-    s   <- getsYesod appSettings
-    url <- do
-        find ((== appId) . storeAppId) . Reg.storeApps <$> interp s Reg.getAppIndex >>= \case
-            Nothing -> throwE $ NotFoundE "icon" (show appId)
-            Just x  -> pure . toS $ storeAppIconUrl x
-    req <- case parseRequest url of
-        Nothing -> throwE $ RegistryParseE (toS url) "invalid url"
-        Just x  -> pure x
-    cacheSeconds 86_400
-    lift $ respondSource (parseContentType url) $ httpSource req getResponseBody .| awaitForever sendChunkBS
-    where interp s = ExceptT . liftIO . runError . injectFilesystemBaseFromContext s . runRegistryUrlIOC
-
-parseContentType :: FilePath -> ContentType
-parseContentType = contentTypeMapping . takeExtension
-    where
-        contentTypeMapping ext = case ext of
-            ".png"  -> typePng
-            ".jpeg" -> typeJpeg
-            ".jpg"  -> typeJpeg
-            ".gif"  -> typeGif
-            ".svg"  -> typeSvg
-            _       -> typePlain

agent/src/Handler/Login.hs

@@ -1,75 +0,0 @@
-{-# LANGUAGE CPP                        #-}
-{-# LANGUAGE QuasiQuotes                #-}
-{-# LANGUAGE ConstraintKinds            #-}
-{-# LANGUAGE FlexibleContexts           #-}
-{-# LANGUAGE TypeFamilies               #-}
-{-# LANGUAGE RankNTypes                 #-}
-{-# LANGUAGE ScopedTypeVariables        #-}
-{-# LANGUAGE OverloadedStrings          #-}
-{-# LANGUAGE RecordWildCards            #-}
-
-module Handler.Login
-    ( HasPasswordHash(..)
-    , defaultStrength
-    , setPasswordStrength
-    , setPassword
-    , validatePass
-      -- * Interface to database and Yesod.Auth
-    , validateUserWithPasswordHash
-    -- Login Route Handler
-    , postLoginR
-    -- Logout Route Handler
-    , postLogoutR
-    )
-where
-
-import           Startlude
-import           Data.Aeson                     ( withObject )
-import           Yesod.Auth                     ( setCredsRedirect
-                                                , clearCreds
-                                                , Creds(..)
-                                                )
-import           Yesod.Core
-import           Yesod.Persist
-
-import           Auth
-import           Foundation
-import           Lib.Password
-import           Model
-
--- Internal data type for receiving JSON encoded accountIdentifier and password
-data LoginReq = LoginReq
-    { loginReqName     :: Text
-    , loginReqPassword :: Text
-    }
-
-instance FromJSON LoginReq where
-    parseJSON = withObject "Login Request" $ \o -> do
-        -- future version can pass an accountIdentifier
-        let loginReqName = rootAccountName
-        loginReqPassword <- o .: "password"
-        pure LoginReq { .. }
-
--- the redirect in the 'then' block gets picked up by the 'authenticate'
--- function in the YesodAuth instance for AgentCtx
-postLoginR :: SubHandlerFor Auth AgentCtx TypedContent
-postLoginR = do
-    LoginReq name password <- requireCheckJsonBody
-    isValid                <- liftHandler $ validateUserWithPasswordHash (UniqueAccount name) password
-    if isValid then liftHandler $ setCredsRedirect $ Creds "hashdb" name [] else notAuthenticated
-
--- the redirect in the 'then' block gets picked up by the 'authenticate'
--- function in the YesodAuth instance for AgentCtx
-postLogoutR :: SubHandlerFor Auth AgentCtx ()
-postLogoutR = liftHandler $ clearCreds False
-
--- | Given a user unique identifier and password in plaintext, validate them against
---   the database values.  This function simply looks up the user id in the
---   database and calls 'validatePass' to do the work.
-validateUserWithPasswordHash :: Unique Account -> Text -> Handler Bool
-validateUserWithPasswordHash name password = do
-    account <- runDB $ getBy name
-    pure case account of
-        Nothing       -> False
-        Just account' -> flip validatePass password . entityVal $ account'
-

agent/src/Handler/Network.hs

@@ -1,36 +0,0 @@
-module Handler.Network where
-
-import           Startlude               hiding ( Reader
-                                                , ask
-                                                , asks
-                                                , runReader
-                                                )
-
-import           Control.Carrier.Lift           ( runM )
-import           Control.Effect.Error
-import           Lib.Error
-import           Yesod.Core                     ( getYesod )
-
-import           Control.Carrier.Reader         ( runReader )
-import           Control.Effect.Labelled        ( runLabelled )
-import           Control.Effect.Reader.Labelled
-import           Foundation
-import qualified Lib.Algebra.Domain.AppMgr     as AppMgr2
-import           Lib.Types.Core
-
-postResetLanR :: Handler ()
-postResetLanR = do
-    ctx <- getYesod
-    runM . handleS9ErrC . runReader (appLanThread ctx) . runLabelled @"lanThread" $ postResetLanLogic
-
-postResetLanLogic :: (MonadIO m, HasLabelled "lanThread" (Reader (MVar ThreadId)) sig m, Has (Error S9Error) sig m)
-                  => m ()
-postResetLanLogic = do
-    threadVar <- ask @"lanThread"
-    mtid      <- liftIO . tryTakeMVar $ threadVar
-    case mtid of
-        Nothing  -> throwError $ TemporarilyForbiddenE (AppId "LAN") "reset" "being reset"
-        Just tid -> liftIO $ do
-            killThread tid
-            newTid <- forkIO (void . runM . runExceptT @S9Error . AppMgr2.runAppMgrCliC $ AppMgr2.lanEnable)
-            putMVar threadVar newTid

agent/src/Handler/Notifications.hs

@@ -1,32 +0,0 @@
-module Handler.Notifications where
-
-import           Startlude
-
-import           Data.UUID
-import           Database.Persist
-import           Yesod.Core.Handler
-import           Yesod.Core.Types               ( JSONResponse(..) )
-import           Yesod.Persist.Core
-
-import           Foundation
-import qualified Lib.Notifications             as Notification
-import           Model
-
-getNotificationsR :: Handler (JSONResponse [Entity Notification])
-getNotificationsR = runDB $ do
-    page     <- lookupGetParam "page" `orDefaultTo` 1
-    pageSize <- lookupGetParam "perPage" `orDefaultTo` 20
-    evs      <- selectList [] [Desc NotificationCreatedAt, LimitTo pageSize, OffsetBy ((page - 1) * pageSize)]
-    let toArchive = fmap entityKey $ filter ((== Nothing) . notificationArchivedAt . entityVal) evs
-    void $ Notification.archive toArchive
-    pure $ JSONResponse evs
-    where
-        orDefaultTo :: (Monad m, Read a) => m (Maybe Text) -> a -> m a
-        orDefaultTo m a = do
-            m' <- m
-            case m' >>= readMaybe . toS of
-                Nothing -> pure a
-                Just x  -> pure x
-
-deleteNotificationR :: UUID -> Handler ()
-deleteNotificationR notifId = runDB $ delete (coerce @_ @(Key Notification) notifId)

agent/src/Handler/PasswordUpdate.hs

@@ -1,36 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-module Handler.PasswordUpdate where
-
-import           Startlude               hiding ( ask )
-
-import           Data.Aeson
-import           Yesod.Core              hiding ( expiresAt )
-import           Yesod.Persist
-
-
-import           Foundation
-import           Lib.Error
-import           Lib.Password
-import           Model
-
-patchPasswordR :: Handler ()
-patchPasswordR = handleS9ErrT $ do
-    PasswordUpdateReq {..} <- requireCheckJsonBody
-    updateAccountRegistration rootAccountName passwordUpdateReqPassword
-data PasswordUpdateReq = PasswordUpdateReq
-    { passwordUpdateReqPassword :: Text
-    } deriving (Eq, Show)
-instance FromJSON PasswordUpdateReq where
-    parseJSON = withObject "Update Password" $ \o -> do
-        passwordUpdateReqPassword <- o .: "value"
-        pure PasswordUpdateReq { .. }
-
-updateAccountRegistration :: Text -> Text -> S9ErrT Handler ()
-updateAccountRegistration acctName newPassword = do
-    now     <- liftIO $ getCurrentTime
-    account <- (lift . runDB . getBy $ UniqueAccount acctName) >>= \case
-        Nothing -> throwE $ NotFoundE "account" acctName
-        Just a  -> pure a
-
-    account' <- setPassword newPassword $ (entityVal account) { accountUpdatedAt = now }
-    (lift . runDB $ Yesod.Persist.replace (entityKey account) account')

agent/src/Handler/PowerOff.hs

@@ -1,28 +0,0 @@
-module Handler.PowerOff where
-
-import           Startlude
-
-import           System.Process
-
-import           Foundation
-import           Lib.Sound
-import           Yesod.Core.Handler
-import           Network.HTTP.Types
-
-postShutdownR :: Handler ()
-postShutdownR = do
-    liftIO $ callCommand "/bin/sync"
-    liftIO $ playSong 400 marioDeath
-    void $ liftIO $ forkIO $ do
-        threadDelay 1_000_000
-        callCommand "/sbin/shutdown now"
-    sendResponseStatus status200 ()
-
-postRestartR :: Handler ()
-postRestartR = do
-    liftIO $ callCommand "/bin/sync"
-    liftIO $ playSong 400 marioDeath
-    void $ liftIO $ forkIO $ do
-        threadDelay 1_000_000
-        callCommand "/sbin/reboot"
-    sendResponseStatus status200 ()

agent/src/Handler/Register.hs

@@ -1,166 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Register where
-
-import           Startlude               hiding ( ask )
-
-import           Control.Carrier.Error.Either   ( runError
-                                                , Error
-                                                , throwError
-                                                )
-import           Control.Carrier.Lift
-import           Control.Effect.Throw           ( liftEither )
-import           Crypto.Cipher.Types
-import           Data.ByteArray.Sized
-import qualified Data.ByteString               as BS
-import qualified Data.Text                     as T
-import           Database.Persist
-import           Network.HTTP.Types.Status
-import           Yesod.Core              hiding ( expiresAt )
-import           Yesod.Persist.Core
-
-import           Daemon.ZeroConf
-import           Foundation
-import           Handler.Register.Nginx
-import           Handler.Register.Tor
-import           Handler.Types.HmacSig
-import           Handler.Types.Register
-import           Lib.Crypto
-import           Lib.Error
-import           Lib.Password
-import           Lib.ProductKey
-import           Lib.Ssl
-import           Lib.SystemPaths
-import           Lib.Tor
-import           Model
-import           Settings
-
-postRegisterR :: Handler RegisterRes
-postRegisterR = handleS9ErrT $ do
-    settings           <- getsYesod appSettings
-
-    productKey         <- liftIO . getProductKey . appFilesystemBase $ settings
-    req                <- requireCheckJsonBody
-
-    -- Decrypt torkey and password. This acts as product key authentication.
-    torKeyFileContents <- decryptTorkey productKey req
-    password           <- decryptPassword productKey req
-    rsaKeyFileContents <- decryptRSAKey productKey req
-
-    -- Check for existing registration.
-    checkExistingPasswordRegistration rootAccountName >>= \case
-        Nothing        -> pure ()
-        Just claimedAt -> do
-            res <- mapExceptT (liftIO . runM . injectFilesystemBaseFromContext settings)
-                $ getRegistration productKey claimedAt
-            sendResponseStatus (Status 209 "Preexisting") res
-
-    -- install new tor hidden service key and restart tor
-    registerResTorAddress <- runM (injectFilesystemBaseFromContext settings $ bootupTor torKeyFileContents) >>= \case
-        Just t  -> pure t
-        Nothing -> throwE TorServiceTimeoutE
-
-    -- install new ssl CA cert + nginx conf and restart nginx
-    registerResCert <-
-        runM . handleS9ErrC . liftEither <=< liftIO . runM . injectFilesystemBaseFromContext settings $ do
-            bootupHttpNginx
-            runError @S9Error $ bootupSslNginx rsaKeyFileContents
-
-    -- create an hmac of the torAddress + caCert for front end
-    registerResTorAddressSig <- produceProofOfKey productKey registerResTorAddress
-    registerResCertSig       <- produceProofOfKey productKey registerResCert
-
-    -- must match CN in config/csr.conf
-    let registerResCertName = root_CA_CERT_NAME
-    registerResLanAddress <- runM . injectFilesystemBaseFromContext settings $ getStart9AgentHostnameLocal
-
-    -- registration successful, save the password hash
-    registerResClaimedAt  <- saveAccountRegistration rootAccountName password
-    pure RegisterRes { .. }
-
-
-decryptTorkey :: MonadIO m => Text -> RegisterReq -> S9ErrT m ByteString
-decryptTorkey productKey RegisterReq { registerTorKey, registerTorCtrCounter, registerTorKdfSalt } = do
-    aesKey <- case mkAesKey registerTorKdfSalt productKey of
-        Just k  -> pure k
-        Nothing -> throwE ProductKeyE
-
-    torKeyFileContents <- case makeIV registerTorCtrCounter of
-        Just counter -> pure $ decryptAes256Ctr aesKey counter (unSizedByteArray registerTorKey)
-        Nothing      -> throwE $ ClientCryptographyE "invalid torkey aes ctr counter"
-
-    unless (torKeyPrefix `BS.isPrefixOf` torKeyFileContents) (throwE $ ClientCryptographyE "invalid tor key encryption")
-
-    pure torKeyFileContents
-    where torKeyPrefix = "== ed25519v1-secret: type0 =="
-
-decryptPassword :: MonadIO m => Text -> RegisterReq -> S9ErrT m Text
-decryptPassword productKey RegisterReq { registerPassword, registerPasswordCtrCounter, registerPasswordKdfSalt } = do
-    aesKey <- case mkAesKey registerPasswordKdfSalt productKey of
-        Just k  -> pure k
-        Nothing -> throwE ProductKeyE
-
-    password <- case makeIV registerPasswordCtrCounter of
-        Just counter -> pure $ decryptAes256Ctr aesKey counter registerPassword
-        Nothing      -> throwE $ ClientCryptographyE "invalid password aes ctr counter"
-
-    let decoded = decodeUtf8 password
-    unless (passwordPrefix `T.isPrefixOf` decoded) (throwE $ ClientCryptographyE "invalid password encryption")
-
-    -- drop password prefix in this case
-    pure . T.drop (T.length passwordPrefix) $ decoded
-    where passwordPrefix = "== password =="
-
-decryptRSAKey :: MonadIO m => Text -> RegisterReq -> S9ErrT m ByteString
-decryptRSAKey productKey RegisterReq { registerRsa, registerRsaCtrCounter, registerRsaKdfSalt } = do
-    aesKey <- case mkAesKey registerRsaKdfSalt productKey of
-        Just k  -> pure k
-        Nothing -> throwE ProductKeyE
-
-    cert <- case makeIV registerRsaCtrCounter of
-        Just counter -> pure $ decryptAes256Ctr aesKey counter registerRsa
-        Nothing      -> throwE $ ClientCryptographyE "invalid password aes ctr counter"
-
-    unless (certPrefix `BS.isPrefixOf` cert) (throwE $ ClientCryptographyE "invalid cert encryption")
-
-    pure cert
-    where certPrefix = "-----BEGIN RSA PRIVATE KEY-----"
-
-
-checkExistingPasswordRegistration :: Text -> S9ErrT Handler (Maybe UTCTime)
-checkExistingPasswordRegistration acctIdentifier = lift . runDB $ do
-    mAccount <- getBy $ UniqueAccount acctIdentifier
-    pure $ fmap (accountCreatedAt . entityVal) mAccount
-
-saveAccountRegistration :: Text -> Text -> S9ErrT Handler UTCTime
-saveAccountRegistration acctName password = lift . runDB $ do
-    now     <- liftIO getCurrentTime
-    account <- setPassword password $ accountNoPw now
-    insert_ account
-    pure now
-    where accountNoPw t = Account t t acctName ""
-
-produceProofOfKey :: MonadIO m => Text -> Text -> m HmacSig
-produceProofOfKey key message = do
-    salt <- random16
-    let hmac = computeHmac key message salt
-    pure $ HmacSig hmac message salt
-
-getRegistration :: (MonadIO m, HasFilesystemBase sig m, Has (Error S9Error) sig m) => Text -> UTCTime -> m RegisterRes
-getRegistration productKey registerResClaimedAt = do
-    torAddress <- getAgentHiddenServiceUrlMaybe >>= \case
-        Nothing -> throwError $ NotFoundE "prior registration" "torAddress"
-        Just t  -> pure $ t
-    caCert <- readSystemPath rootCaCertPath >>= \case
-        Nothing -> throwError $ NotFoundE "prior registration" "cert"
-        Just t  -> pure t
-
-    -- create an hmac of the torAddress + caCert for front end
-    registerResTorAddressSig <- produceProofOfKey productKey torAddress
-    registerResCertSig       <- produceProofOfKey productKey caCert
-
-    let registerResCertName = root_CA_CERT_NAME
-    registerResLanAddress <- getStart9AgentHostnameLocal
-
-    pure RegisterRes { .. }

agent/src/Handler/Register/Nginx.hs

@@ -1,158 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE QuasiQuotes #-}
-module Handler.Register.Nginx where
-
-import           Startlude               hiding ( ask
-                                                , catchError
-                                                , err
-                                                )
-
-import           Control.Carrier.Error.Church
-import           Control.Effect.Lift
-import qualified Control.Effect.Reader.Labelled
-                                               as Fused
-import qualified Data.ByteString               as BS
-import           System.Directory
-import           Daemon.ZeroConf
-import           Lib.ClientManifest
-import           Lib.Error
-import           Lib.Ssl
-import           Lib.Synchronizers
-import           Lib.SystemPaths
-import           Lib.Tor
-import           System.Posix                   ( removeLink )
-
--- Left error, Right CA cert for hmac signing
-bootupSslNginx :: (HasFilesystemBase sig m, Has (Error S9Error) sig m, Has (Lift IO) sig m, MonadIO m)
-               => ByteString
-               -> m Text
-bootupSslNginx rsaKeyFileContents = do
-    -- we need to ensure if the ssl setup fails that we remove all openssl key material and the nginx ssl conf before
-    -- starting again
-    resetSslState
-    cert <- writeSslKeyAndCert rsaKeyFileContents
-    sid  <- getStart9AgentHostname
-    installAmbassadorUiNginxHTTPS (sslOverrides sid) "start9-ambassador-ssl.conf"
-    pure cert
-    where
-        sslOverrides sid =
-            let hostname = sid <> ".local"
-            in  NginxSiteConfOverride
-                    { nginxSiteConfOverrideAdditionalServerName = hostname
-                    , nginxSiteConfOverrideListen = 443
-                    , nginxSiteConfOverrideSsl = Just $ NginxSsl { nginxSslKeyPath         = entityKeyPath sid
-                                                                 , nginxSslCertPath        = entityCertPath sid
-                                                                 , nginxSslOnlyServerNames = [hostname]
-                                                                 }
-                    }
-
-resetSslState :: (HasFilesystemBase sig m, Has (Lift IO) sig m, MonadIO m) => m ()
-resetSslState = do
-    base <- Fused.ask @"filesystemBase"
-    host <- getStart9AgentHostname
-    -- remove all files we explicitly create
-    traverse_
-        (liftIO . removePathForcibly . toS . flip relativeTo base)
-        [ rootCaKeyPath
-        , relBase $ (rootCaCertPath `relativeTo` base) <> ".csr"
-        , rootCaCertPath
-        , intermediateCaKeyPath
-        , relBase $ (intermediateCaCertPath `relativeTo` base) <> ".csr"
-        , intermediateCaCertPath
-        , entityKeyPath host
-        , relBase $ (entityCertPath host `relativeTo` base) <> ".csr"
-        , entityCertPath host
-        , entityConfPath host
-        , nginxSitesAvailable nginxSslConf
-        ]
-    liftIO $ do
-        withCurrentDirectory (toS $ flip relativeTo base $ rootCaDirectory <> "/newcerts")
-            $   listDirectory "."
-            >>= traverse_ removePathForcibly
-        withCurrentDirectory (toS $ flip relativeTo base $ intermediateCaDirectory <> "/newcerts")
-            $   listDirectory "."
-            >>= traverse_ removePathForcibly
-        writeFile (toS $ flip relativeTo base $ rootCaDirectory <> "/index.txt")         ""
-        writeFile (toS $ flip relativeTo base $ intermediateCaDirectory <> "/index.txt") ""
-    _ <- liftIO $ try @SomeException . removeLink . toS $ nginxSitesEnabled nginxSslConf `relativeTo` base
-    pure ()
-
-bootupHttpNginx :: (HasFilesystemBase sig m, MonadIO m) => m ()
-bootupHttpNginx = installAmbassadorUiNginxHTTP "start9-ambassador.conf"
-
-writeSslKeyAndCert :: (MonadIO m, HasFilesystemBase sig m, Has (Error S9Error) sig m) => ByteString -> m Text
-writeSslKeyAndCert rsaKeyFileContents = do
-    directory     <- toS <$> getAbsoluteLocationFor sslDirectory
-    caKeyPath     <- toS <$> getAbsoluteLocationFor rootCaKeyPath
-    caConfPath    <- toS <$> getAbsoluteLocationFor rootCaOpenSslConfPath
-    caCertPath    <- toS <$> getAbsoluteLocationFor rootCaCertPath
-    intCaKeyPath  <- toS <$> getAbsoluteLocationFor intermediateCaKeyPath
-    intCaConfPath <- toS <$> getAbsoluteLocationFor intermediateCaOpenSslConfPath
-    intCaCertPath <- toS <$> getAbsoluteLocationFor intermediateCaCertPath
-    sid           <- getStart9AgentHostname
-    entKeyPath    <- toS <$> getAbsoluteLocationFor (entityKeyPath sid)
-    entConfPath   <- toS <$> getAbsoluteLocationFor (entityConfPath sid)
-    entCertPath   <- toS <$> getAbsoluteLocationFor (entityCertPath sid)
-    torAddr       <- getAgentHiddenServiceUrl
-
-    let hostname = sid <> ".local"
-
-    liftIO $ createDirectoryIfMissing False directory
-    liftIO $ BS.writeFile caKeyPath rsaKeyFileContents
-
-    (exit, str1, str2) <- writeRootCaCert caConfPath caKeyPath caCertPath
-    liftIO $ do
-        putStrLn @Text "openssl logs"
-        putStrLn @Text "exit code: "
-        print exit
-        putStrLn @String $ "stdout: " <> str1
-        putStrLn @String $ "stderr: " <> str2
-    case exit of
-        ExitSuccess    -> pure ()
-        ExitFailure ec -> throwError $ OpenSslE "root" ec str1 str2
-
-    (exit', str1', str2') <- writeIntermediateCert $ DeriveCertificate { applicantConfPath = intCaConfPath
-                                                                       , applicantKeyPath  = intCaKeyPath
-                                                                       , applicantCertPath = intCaCertPath
-                                                                       , signingConfPath   = caConfPath
-                                                                       , signingKeyPath    = caKeyPath
-                                                                       , signingCertPath   = caCertPath
-                                                                       , duration          = 3650
-                                                                       }
-    liftIO $ do
-        putStrLn @Text "openssl logs"
-        putStrLn @Text "exit code: "
-        print exit'
-        putStrLn @String $ "stdout: " <> str1'
-        putStrLn @String $ "stderr: " <> str2'
-    case exit' of
-        ExitSuccess    -> pure ()
-        ExitFailure ec -> throwError $ OpenSslE "intermediate" ec str1' str2'
-
-
-    liftIO $ BS.writeFile entConfPath (domain_CSR_CONF hostname)
-
-    (exit'', str1'', str2'') <- writeLeafCert
-        DeriveCertificate { applicantConfPath = entConfPath
-                          , applicantKeyPath  = entKeyPath
-                          , applicantCertPath = entCertPath
-                          , signingConfPath   = intCaConfPath
-                          , signingKeyPath    = intCaKeyPath
-                          , signingCertPath   = intCaCertPath
-                          , duration          = 365
-                          }
-        hostname
-        torAddr
-
-    liftIO $ do
-        putStrLn @Text "openssl logs"
-        putStrLn @Text "exit code: "
-        print exit''
-        putStrLn @String $ "stdout: " <> str1''
-        putStrLn @String $ "stderr: " <> str2''
-    case exit'' of
-        ExitSuccess    -> pure ()
-        ExitFailure ec -> throwError $ OpenSslE "leaf" ec str1' str2'
-
-    readSystemPath' rootCaCertPath

agent/src/Handler/Register/Tor.hs

@@ -1,44 +0,0 @@
-{-# LANGUAGE NamedFieldPuns #-}
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Register.Tor where
-
-import           Startlude               hiding ( ask )
-
-import           Control.Effect.Reader.Labelled
-import qualified Data.ByteString               as BS
-import           System.Directory
-import           System.Process
-import           Lib.SystemCtl
-import           Lib.SystemPaths
-import           Lib.Tor
-
-bootupTor :: (HasFilesystemBase sig m, MonadIO m) => ByteString -> m (Maybe Text)
-bootupTor torKeyFileContents = do
-    base <- ask @"filesystemBase"
-    writeTorPrivateKeyFile torKeyFileContents
-
-    putStrLn @Text "restarting tor"
-    liftIO . void $ systemCtl RestartService "tor"
-    putStrLn @Text "restarted tor"
-
-    liftIO . fmap (join . hush) $ race
-        (threadDelay 30_000_000)
-        (runMaybeT . asum . repeat $ MaybeT . fmap hush $ try @SomeException
-            (threadDelay 100_000 *> injectFilesystemBase base getAgentHiddenServiceUrl)
-        )
-
-writeTorPrivateKeyFile :: (MonadIO m, HasFilesystemBase sig m) => ByteString -> m ()
-writeTorPrivateKeyFile contents = do
-    directory          <- fmap toS . getAbsoluteLocationFor $ agentTorHiddenServiceDirectory
-    privateKeyFilePath <- fmap toS . getAbsoluteLocationFor $ agentTorHiddenServicePrivateKeyPath
-    liftIO $ do
-        -- Clean out directory
-        removePathForcibly directory
-        createDirectory directory
-
-        -- write private key file
-        BS.writeFile privateKeyFilePath contents
-
-        -- Set ownership and permissions so tor executable can generate other files
-        callCommand $ "chown -R debian-tor:debian-tor " <> directory
-        callCommand $ "chmod 2700 " <> directory

agent/src/Handler/SelfUpdate.hs

@@ -1,51 +0,0 @@
-{-# LANGUAGE QuasiQuotes     #-}
-{-# LANGUAGE TemplateHaskell #-}
-
-module Handler.SelfUpdate where
-
-import           Startlude
-
-import           Control.Carrier.Error.Either
-import           Data.Aeson
-import           Yesod.Core
-
-import           Foundation
-import           Lib.Algebra.State.RegistryUrl
-import           Lib.Error
-import           Lib.External.Registry
-import           Lib.SystemPaths
-import           Lib.Types.Emver
-
-newtype UpdateAgentReq = UpdateAgentReq { updateAgentVersionSpecification :: VersionRange } deriving (Eq, Show)
-
-instance FromJSON UpdateAgentReq where
-    parseJSON = withObject "update agent request" $ fmap UpdateAgentReq . (.: "version")
-
-newtype UpdateAgentRes = UpdateAgentRes { status :: UpdateInitStatus } deriving (Eq)
-instance ToJSON UpdateAgentRes where
-    toJSON (UpdateAgentRes status) = object ["status" .= status]
-
-instance ToTypedContent UpdateAgentRes where
-    toTypedContent = toTypedContent . toJSON
-instance ToContent UpdateAgentRes where
-    toContent = toContent . toJSON
-
-
-data UpdateInitStatus = UpdatingAlreadyInProgress | UpdatingCommence deriving (Show, Eq)
-instance ToJSON UpdateInitStatus where
-    toJSON UpdatingAlreadyInProgress = String "UPDATING_ALREADY_IN_PROGRESS"
-    toJSON UpdatingCommence          = String "UPDATING_COMMENCE"
-
-postUpdateAgentR :: Handler UpdateAgentRes
-postUpdateAgentR = handleS9ErrT $ do
-    settings <- getsYesod appSettings
-    avs      <- updateAgentVersionSpecification <$> requireCheckJsonBody
-    mVersion <- interp settings $ getLatestAgentVersionForSpec avs
-
-    when (isNothing mVersion) $ throwE $ NoCompliantAgentE avs
-
-    updateSpecBox <- getsYesod appSelfUpdateSpecification
-    success       <- liftIO $ tryPutMVar updateSpecBox avs
-
-    if success then pure $ UpdateAgentRes UpdatingCommence else pure $ UpdateAgentRes UpdatingAlreadyInProgress
-    where interp s = ExceptT . liftIO . runError . injectFilesystemBaseFromContext s . runRegistryUrlIOC

agent/src/Handler/SshKeys.hs

@@ -1,39 +0,0 @@
-{-# LANGUAGE QuasiQuotes     #-}
-{-# LANGUAGE RecordWildCards #-}
-module Handler.SshKeys where
-
-import           Startlude
-
-import           Yesod.Core
-import           Yesod.Core.Types               ( JSONResponse(..) )
-
-import           Foundation
-import           Lib.Error
-import           Lib.Ssh
-import           Util.Function
-import           Handler.Types.V0.Ssh
-
-postSshKeysR :: Handler SshKeyFingerprint
-postSshKeysR = handleS9ErrT $ do
-    settings <- getsYesod appSettings
-    key      <- sshKey <$> requireCheckJsonBody
-    case fingerprint key of
-        Left  e  -> throwE $ InvalidSshKeyE (toS e)
-        Right fp -> do
-            runReaderT (createSshKey key) settings
-            pure $ uncurry3 SshKeyFingerprint fp
-
-deleteSshKeyByFingerprintR :: Text -> Handler ()
-deleteSshKeyByFingerprintR key = handleS9ErrT $ do
-    settings <- getsYesod appSettings
-    runReaderT (deleteSshKey key) settings >>= \case
-        True  -> pure ()
-        False -> throwE $ NotFoundE "sshKey" key
-
-getSshKeysR :: Handler (JSONResponse [SshKeyFingerprint]) -- deprecated in 0.2.0
-getSshKeysR = handleS9ErrT $ do
-    settings <- getsYesod appSettings
-    keys     <- runReaderT getSshKeys settings
-    JSONResponse <$> case traverse fingerprint keys of
-        Left  e  -> throwE $ InvalidSshKeyE (toS e)
-        Right as -> pure $ uncurry3 SshKeyFingerprint <$> as

agent/src/Handler/Status.hs

@@ -1,81 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-module Handler.Status where
-
-import           Startlude
-
-import           Control.Carrier.Error.Either
-import           Data.Aeson.Encoding
-import           Git.Embed
-import           Yesod.Core.Handler
-import           Yesod.Core.Json
-import           Yesod.Core.Types
-
-import           Constants
-import           Daemon.ZeroConf
-import           Foundation
-import           Handler.Types.Metrics
-import           Handler.Types.V0.Specs
-import           Handler.Types.V0.Base
-import           Lib.Algebra.State.RegistryUrl
-import           Lib.Error
-import           Lib.External.Metrics.Df
-import qualified Lib.External.Registry         as Reg
-import           Lib.External.Specs.CPU
-import           Lib.External.Specs.Memory
-import           Lib.Metrics
-import           Lib.SystemPaths         hiding ( (</>) )
-import           Lib.Tor
-import           Settings
-import           Control.Carrier.Lift           ( runM )
-import           System.Process
-import qualified UnliftIO
-import           System.FileLock
-
-getVersionR :: Handler AppVersionRes
-getVersionR = pure . AppVersionRes $ agentVersion
-
-getVersionLatestR :: Handler VersionLatestRes
-getVersionLatestR = handleS9ErrT $ do
-    s <- getsYesod appSettings
-    uncurry VersionLatestRes <$> interp s Reg.getLatestAgentVersion
-    where interp s = ExceptT . liftIO . runError . injectFilesystemBaseFromContext s . runRegistryUrlIOC
-
-
-getSpecsR :: Handler Encoding -- deprecated in 0.2.0
-getSpecsR = handleS9ErrT $ do
-    settings        <- getsYesod appSettings
-    specsCPU        <- liftIO getCpuInfo
-    specsMem        <- liftIO getMem
-    specsDisk       <- fmap show . metricDiskSize <$> getDfMetrics
-    specsNetworkId  <- lift . runM . injectFilesystemBaseFromContext settings $ getStart9AgentHostname
-    specsTorAddress <- lift . runM . injectFilesystemBaseFromContext settings $ getAgentHiddenServiceUrl
-    specsLanAddress <-
-        fmap (<> ".local") . lift . runM . injectFilesystemBaseFromContext settings $ getStart9AgentHostname
-
-    let specsAgentVersion = agentVersion
-    returnJsonEncoding SpecsRes { .. }
-
-getMetricsR :: Handler (JSONResponse MetricsRes)
-getMetricsR = do
-    app <- getYesod
-    fmap (JSONResponse . MetricsRes) . handleS9ErrT . getServerMetrics $ app
-
-embassyNamePath :: SystemPath
-embassyNamePath = "/root/agent/name.txt"
-
-patchServerR :: Handler ()
-patchServerR = do
-    PatchServerReq { patchServerReqName } <- requireCheckJsonBody @_ @PatchServerReq
-    base <- getsYesod $ appFilesystemBase . appSettings
-    liftIO $ writeFile (toS $ embassyNamePath `relativeTo` base) patchServerReqName
-
-getGitR :: Handler Text
-getGitR = pure $embedGitRevision
-
-getLogsR :: Handler (JSONResponse [Text])
-getLogsR = do
-    let debugLock = "/root/agent/tmp/debug.lock"
-    UnliftIO.bracket (liftIO $ lockFile debugLock Exclusive) (liftIO . unlockFile) $ const $ do
-        liftIO $ callCommand "journalctl -u agent --since \"1 hour ago\" > /root/agent/tmp/debug.log"
-        liftIO $ JSONResponse . lines <$> readFile "/root/agent/tmp/debug.log"

agent/src/Handler/Tor.hs

@@ -1,24 +0,0 @@
-module Handler.Tor where
-
-import           Startlude
-
-import           Data.Aeson
-import           Yesod.Core
-
-import           Foundation
-import           Lib.SystemPaths
-import           Lib.Tor
-import           Control.Carrier.Lift           ( runM )
-
-newtype GetTorRes = GetTorRes { unGetTorRes :: Text }
-instance ToJSON GetTorRes where
-    toJSON a = object ["torAddress" .= unGetTorRes a]
-instance ToContent GetTorRes where
-    toContent = toContent . toJSON
-instance ToTypedContent GetTorRes where
-    toTypedContent = toTypedContent . toJSON
-
-getTorAddressR :: Handler GetTorRes
-getTorAddressR = do
-    settings <- getsYesod appSettings
-    runM $ GetTorRes <$> injectFilesystemBaseFromContext settings getAgentHiddenServiceUrl

agent/src/Handler/Types/Apps.hs

@@ -1,213 +0,0 @@
-{-# LANGUAGE StandaloneKindSignatures #-}
-{-# LANGUAGE QuasiQuotes     #-}
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Types.Apps where
-
-import           Startlude
-
-import           Data.Aeson
-import           Data.Aeson.Flatten
-import           Data.Singletons
-
-import qualified Lib.External.AppManifest      as Manifest
-import           Lib.TyFam.ConditionalData
-import           Lib.Types.Core
-import           Lib.Types.Emver
-import           Lib.Types.Emver.Orphans        ( )
-import           Lib.Types.NetAddress
-data AppBase = AppBase
-    { appBaseId      :: AppId
-    , appBaseTitle   :: Text
-    , appBaseIconUrl :: Text
-    }
-    deriving (Eq, Show)
-instance ToJSON AppBase where
-    toJSON AppBase {..} = object ["id" .= appBaseId, "title" .= appBaseTitle, "iconURL" .= appBaseIconUrl]
-
-data AppAvailablePreview = AppAvailablePreview
-    { appAvailablePreviewBase             :: AppBase
-    , appAvailablePreviewVersionLatest    :: Version
-    , appAvailablePreviewDescriptionShort :: Text
-    , appAvailablePreviewInstallInfo      :: Maybe (Version, AppStatus)
-    , appAvailablePreviewTimestamp        :: UTCTime
-    }
-    deriving (Eq, Show)
-instance ToJSON AppAvailablePreview where
-    toJSON AppAvailablePreview {..} = mergeTo (toJSON appAvailablePreviewBase) $ object
-        [ "versionLatest" .= appAvailablePreviewVersionLatest
-        , "descriptionShort" .= appAvailablePreviewDescriptionShort
-        , "versionInstalled" .= (fst <$> appAvailablePreviewInstallInfo)
-        , "status" .= (snd <$> appAvailablePreviewInstallInfo)
-        , "latestVersionTimestamp" .= appAvailablePreviewTimestamp
-        ]
-
-data AppInstalledPreview = AppInstalledPreview
-    { appInstalledPreviewBase             :: AppBase
-    , appInstalledPreviewStatus           :: AppStatus
-    , appInstalledPreviewVersionInstalled :: Version
-    , appInstalledPreviewTorAddress       :: Maybe TorAddress
-    , appInstalledPreviewLanAddress       :: Maybe LanAddress
-    , appInstalledPreviewTorUi            :: Bool
-    , appInstalledPreviewLanUi            :: Bool
-    }
-    deriving (Eq, Show)
-instance ToJSON AppInstalledPreview where
-    toJSON AppInstalledPreview {..} = mergeTo (toJSON appInstalledPreviewBase) $ object
-        [ "status" .= appInstalledPreviewStatus
-        , "versionInstalled" .= appInstalledPreviewVersionInstalled
-        , "torAddress" .= (unTorAddress <$> appInstalledPreviewTorAddress)
-        , "lanAddress" .= (unLanAddress <$> appInstalledPreviewLanAddress)
-        , "torUi" .= appInstalledPreviewTorUi
-        , "lanUi" .= appInstalledPreviewLanUi
-        ]
-
-data InstallNewAppReq = InstallNewAppReq
-    { installNewAppVersion :: Version
-    , installNewAppDryRun  :: Bool
-    }
-    deriving (Eq, Show)
-instance FromJSON InstallNewAppReq where
-    parseJSON = withObject "Install New App Request" $ \o -> do
-        installNewAppVersion <- o .: "version"
-        installNewAppDryRun  <- o .:? "dryRun" .!= False
-        pure InstallNewAppReq { .. }
-
-data AppAvailableFull = AppAvailableFull
-    { appAvailableFullBase                   :: AppBase
-    , appAvailableFullLicenseName            :: Maybe Text
-    , appAvailableFullLicenseLink            :: Maybe Text
-    , appAvailableFullInstallInfo            :: Maybe (Version, AppStatus)
-    , appAvailableFullVersionLatest          :: Version
-    , appAvailableFullDescriptionShort       :: Text
-    , appAvailableFullDescriptionLong        :: Text
-    , appAvailableFullReleaseNotes           :: Text
-    , appAvailableFullInstallAlert           :: Maybe Text
-    , appAvailableFullDependencyRequirements :: [Full AppDependencyRequirement]
-    , appAvailableFullVersions               :: NonEmpty Version
-    }
-    -- deriving Eq
-instance ToJSON AppAvailableFull where
-    toJSON AppAvailableFull {..} = mergeTo
-        (toJSON appAvailableFullBase)
-        (object
-            [ "licenseName" .= appAvailableFullLicenseName
-            , "licenseLink" .= appAvailableFullLicenseLink
-            , "versionInstalled" .= fmap fst appAvailableFullInstallInfo
-            , "status" .= fmap snd appAvailableFullInstallInfo
-            , "versionLatest" .= appAvailableFullVersionLatest
-            , "descriptionShort" .= appAvailableFullDescriptionShort
-            , "descriptionLong" .= appAvailableFullDescriptionLong
-            , "versions" .= appAvailableFullVersions
-            , "releaseNotes" .= appAvailableFullReleaseNotes
-            , "serviceRequirements" .= appAvailableFullDependencyRequirements
-            , "installAlert" .= appAvailableFullInstallAlert
-            ]
-        )
-
-type AppDependencyRequirement :: (Type ~> Type) -> Type
-data AppDependencyRequirement f = AppDependencyRequirement
-    { appDependencyRequirementBase           :: AppBase
-    , appDependencyRequirementReasonOptional :: Apply f (Maybe Text)
-    , appDependencyRequirementDefault        :: Apply f Bool
-    , appDependencyRequirementDescription    :: Maybe Text
-    , appDependencyRequirementViolation      :: Maybe ApiDependencyViolation
-    , appDependencyRequirementVersionSpec    :: VersionRange
-    }
-instance ToJSON (AppDependencyRequirement Strip) where
-    toJSON AppDependencyRequirement {..} = mergeTo (toJSON appDependencyRequirementBase) $ object
-        [ "versionSpec" .= appDependencyRequirementVersionSpec
-        , "description" .= appDependencyRequirementDescription
-        , "violation" .= appDependencyRequirementViolation
-        ]
-instance ToJSON (AppDependencyRequirement Keep) where
-    toJSON r =
-        let stripped = r { appDependencyRequirementReasonOptional = (), appDependencyRequirementDefault = () }
-        in
-            mergeTo
-                (toJSON @(AppDependencyRequirement Strip) stripped)
-                (object
-                    [ "optional" .= appDependencyRequirementReasonOptional r
-                    , "default" .= appDependencyRequirementDefault r
-                    ]
-                )
-
--- filter non required dependencies in installed show
--- mute violations downstream of version for installing apps
-data AppInstalledFull = AppInstalledFull
-    { appInstalledFullBase                   :: AppBase
-    , appInstalledFullLicenseName            :: Maybe Text
-    , appInstalledFullLicenseLink            :: Maybe Text
-    , appInstalledFullStatus                 :: AppStatus
-    , appInstalledFullVersionInstalled       :: Version
-    , appInstalledFullTorAddress             :: Maybe TorAddress
-    , appInstalledFullLanAddress             :: Maybe LanAddress
-    , appInstalledFullTorUi                  :: Bool
-    , appInstalledFullLanUi                  :: Bool
-    , appInstalledFullInstructions           :: Maybe Text
-    , appInstalledFullLastBackup             :: Maybe UTCTime
-    , appInstalledFullConfiguredRequirements :: [Stripped AppDependencyRequirement]
-    , appInstalledFullUninstallAlert         :: Maybe Text
-    , appInstalledFullRestoreAlert           :: Maybe Text
-    , appInstalledFullStartAlert             :: Maybe Text
-    , appInstalledFullActions                :: [Manifest.Action]
-    }
-instance ToJSON AppInstalledFull where
-    toJSON AppInstalledFull {..} = object
-        [ "instructions" .= appInstalledFullInstructions
-        , "lastBackup" .= appInstalledFullLastBackup
-        , "configuredRequirements" .= appInstalledFullConfiguredRequirements
-        , "torAddress" .= (unTorAddress <$> appInstalledFullTorAddress)
-        , "lanAddress" .= (unLanAddress <$> appInstalledFullLanAddress)
-        , "torUi" .= appInstalledFullTorUi
-        , "lanUi" .= appInstalledFullLanUi
-        , "id" .= appBaseId appInstalledFullBase
-        , "title" .= appBaseTitle appInstalledFullBase
-        , "licenseName" .= appInstalledFullLicenseName
-        , "licenseLink" .= appInstalledFullLicenseLink
-        , "iconURL" .= appBaseIconUrl appInstalledFullBase
-        , "versionInstalled" .= appInstalledFullVersionInstalled
-        , "status" .= appInstalledFullStatus
-        , "uninstallAlert" .= appInstalledFullUninstallAlert
-        , "restoreAlert" .= appInstalledFullRestoreAlert
-        , "startAlert" .= appInstalledFullStartAlert
-        , "actions" .= appInstalledFullActions
-        ]
-
-data AppVersionInfo = AppVersionInfo
-    { appVersionInfoVersion                :: Version
-    , appVersionInfoReleaseNotes           :: Text
-    , appVersionInfoDependencyRequirements :: [Full AppDependencyRequirement]
-    , appVersionInfoInstallAlert           :: Maybe Text
-    }
-instance ToJSON AppVersionInfo where
-    toJSON AppVersionInfo {..} = object
-        [ "version" .= appVersionInfoVersion
-        , "releaseNotes" .= appVersionInfoReleaseNotes
-        , "serviceRequirements" .= appVersionInfoDependencyRequirements
-        , "installAlert" .= appVersionInfoInstallAlert
-        ]
-
-data ApiDependencyViolation
-    = Missing
-    | IncompatibleVersion
-    | IncompatibleConfig [Text] -- rule violations
-    | IncompatibleStatus AppStatus
-
-instance ToJSON ApiDependencyViolation where
-    toJSON Missing             = object ["name" .= ("missing" :: Text)]
-    toJSON IncompatibleVersion = object ["name" .= ("incompatible-version" :: Text)]
-    toJSON (IncompatibleConfig ruleViolations) =
-        object ["name" .= ("incompatible-config" :: Text), "ruleViolations" .= ruleViolations]
-    toJSON (IncompatibleStatus status) = object ["name" .= ("incompatible-status" :: Text), "status" .= status]
-
-data WithBreakages a = WithBreakages [AppBase] a
-instance {-# Overlappable #-} ToJSON a => ToJSON (WithBreakages a) where
-    toJSON (WithBreakages breakages thing) = mergeTo (toJSON thing) (object ["breakages" .= breakages])
-instance ToJSON (WithBreakages ()) where
-    toJSON (WithBreakages breakages _) = object ["breakages" .= breakages]
-
-newtype AutoconfigureChangesRes = AutoconfigureChangesRes
-    { autoconfigureChangesConfig :: Maybe Value
-    }
-instance ToJSON AutoconfigureChangesRes where
-    toJSON AutoconfigureChangesRes {..} = object ["config" .= autoconfigureChangesConfig]

agent/src/Handler/Types/HmacSig.hs

@@ -1,28 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Types.HmacSig where
-
-import           Startlude
-
-import           Crypto.Hash
-import           Data.Aeson
-import           Data.ByteArray.Encoding
-import           Data.ByteArray.Sized
-import           Yesod.Core
-
-import           Handler.Types.Parse
-
-data HmacSig = HmacSig
-    { sigHmac    :: Digest SHA256
-    , sigMessage :: Text
-    , sigSalt    :: SizedByteArray 16 ByteString
-    }
-    deriving (Eq, Show)
-
-instance ToJSON HmacSig where
-    toJSON (HmacSig {..}) =
-        object ["hmac" .= fromUnsizedBs Base16 sigHmac, "message" .= sigMessage, "salt" .= fromSizedBs Base16 sigSalt]
-
-instance ToTypedContent HmacSig where
-    toTypedContent = toTypedContent . toJSON
-instance ToContent HmacSig where
-    toContent = toContent . toJSON

agent/src/Handler/Types/Hosts.hs

@@ -1,44 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Types.Hosts where
-
-import           Startlude
-
-import           Crypto.Hash
-import           Data.Aeson
-import           Data.ByteArray.Encoding
-import           Data.ByteArray.Sized
-import           Yesod.Core
-
-import           Handler.Types.Parse
-import           Handler.Types.Register
-import           Lib.Error
-
-data HostsParams = HostsParams
-    { hostsParamsHmac       :: Digest SHA256 -- hmac of an expiration timestamp
-    , hostsParamsExpiration :: Text -- This is a UTC time text string. we leave it as text as it is precisely this which is signed by the above hmac.
-    , hostsParamsSalt       :: SizedByteArray 16 ByteString
-    }
-
-data HostsRes = NullReply | HostsRes RegisterRes
-    deriving (Eq, Show)
-
-instance ToJSON HostsRes where
-    toJSON NullReply              = Null
-    toJSON (HostsRes registerRes) = toJSON registerRes
-
-instance ToTypedContent HostsRes where
-    toTypedContent = toTypedContent . toJSON
-instance ToContent HostsRes where
-    toContent = toContent . toJSON
-
-extractHostsQueryParams :: MonadHandler m => S9ErrT m HostsParams
-extractHostsQueryParams = do
-    hostsParamsHmac <- lookupGetParam "hmac" <&> (>>= sizedBs @32 Base16 >=> digestFromByteString) >>= orThrow400 "hmac"
-    hostsParamsSalt <- lookupGetParam "salt" <&> (>>= sizedBs @16 Base16) >>= orThrow400 "salt"
-    hostsParamsExpiration <- lookupGetParam "message" >>= orThrow400 "message"
-
-    pure HostsParams { .. }
-    where
-        orThrow400 desc = \case
-            Nothing -> throwE $ HostsParamsE desc
-            Just p  -> pure p

agent/src/Handler/Types/Metrics.hs

@@ -1,26 +0,0 @@
-{-# LANGUAGE DeriveGeneric   #-}
-{-# LANGUAGE NamedFieldPuns  #-}
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Types.Metrics where
-
-import           Startlude
-
-import           Lib.Metrics
-
-import           Data.Aeson
-import           Yesod.Core.Content
-
-newtype MetricsRes = MetricsRes { unMetricsRes :: ServerMetrics }
-instance ToJSON MetricsRes where
-    toJSON     = toJSON . unMetricsRes
-    toEncoding = toEncoding . unMetricsRes
-instance ToTypedContent MetricsRes where
-    toTypedContent = toTypedContent . toJSON
-instance ToContent MetricsRes where
-    toContent = toContent . toJSON
-
-newtype PatchServerReq = PatchServerReq { patchServerReqName :: Text }
-instance FromJSON PatchServerReq where
-    parseJSON = withObject "Patch Server Request" $ \o -> do
-        patchServerReqName <- o .: "name"
-        pure $ PatchServerReq { patchServerReqName }

agent/src/Handler/Types/Parse.hs

@@ -1,32 +0,0 @@
-module Handler.Types.Parse where
-
-import           Startlude
-
-import           Control.Monad.Fail
-import           Data.Aeson.Types
-import           Data.ByteArray
-import           Data.ByteArray.Encoding
-import           Data.ByteArray.Sized
-
-mToParser :: String -> Maybe a -> Parser a
-mToParser failureText = \case
-  Nothing -> fail failureText
-  Just t -> pure t
-
-toUnsizedBs :: String -> Base -> Text -> Parser ByteString
-toUnsizedBs failureText base = mToParser failureText . unsizedBs base
-
-unsizedBs :: Base -> Text -> Maybe ByteString
-unsizedBs base = hush . convertFromBase base . encodeUtf8
-
-toSizedBs :: KnownNat n => String -> Base -> Text -> Parser (SizedByteArray n ByteString)
-toSizedBs failureText base = mToParser failureText . sizedBs base
-
-sizedBs :: KnownNat n => Base -> Text -> Maybe (SizedByteArray n ByteString)
-sizedBs base = sizedByteArray <=< unsizedBs base
-
-fromUnsizedBs :: ByteArrayAccess ba => Base -> ba -> Text
-fromUnsizedBs base = decodeUtf8 . convertToBase base
-
-fromSizedBs :: (KnownNat n, ByteArrayAccess ba) => Base -> SizedByteArray n ba -> Text
-fromSizedBs b = fromUnsizedBs b . unSizedByteArray

agent/src/Handler/Types/Register.hs

@@ -1,65 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Types.Register where
-
-import           Startlude
-
-import           Data.Aeson
-import           Data.ByteArray.Encoding
-import           Data.ByteArray.Sized
-import           Yesod.Core
-
-import           Handler.Types.HmacSig
-import           Handler.Types.Parse
-
-data RegisterReq = RegisterReq
-    { registerTorKey             :: SizedByteArray 96 ByteString -- Represents a tor private key along with tor private key file prefix.
-    , registerTorCtrCounter      :: SizedByteArray 16 ByteString
-    , registerTorKdfSalt         :: SizedByteArray 16 ByteString
-    , registerPassword           :: ByteString -- Encrypted password
-    , registerPasswordCtrCounter :: SizedByteArray 16 ByteString
-    , registerPasswordKdfSalt    :: SizedByteArray 16 ByteString
-    , registerRsa                :: ByteString -- Encrypted RSA key
-    , registerRsaCtrCounter      :: SizedByteArray 16 ByteString
-    , registerRsaKdfSalt         :: SizedByteArray 16 ByteString
-    }
-    deriving (Eq, Show)
-
-
-data RegisterRes = RegisterRes
-    { registerResClaimedAt     :: UTCTime
-    , registerResTorAddressSig :: HmacSig
-    , registerResCertSig       :: HmacSig
-    , registerResCertName      :: Text
-    , registerResLanAddress    :: Text
-    }
-    deriving (Eq, Show)
-
-instance FromJSON RegisterReq where
-    parseJSON = withObject "Register Tor Request" $ \o -> do
-        registerTorKey             <- o .: "torkey" >>= toSizedBs "Invalid torkey encryption" Base16
-        registerTorCtrCounter      <- o .: "torkeyCounter" >>= toSizedBs "Invalid torkey ctr counter" Base16
-        registerTorKdfSalt         <- o .: "torkeySalt" >>= toSizedBs "Invalid torkey pbkdf2 salt" Base16
-
-        registerPassword           <- o .: "password" >>= toUnsizedBs "Invalid password encryption" Base16
-        registerPasswordCtrCounter <- o .: "passwordCounter" >>= toSizedBs "Invalid password ctr counter" Base16
-        registerPasswordKdfSalt    <- o .: "passwordSalt" >>= toSizedBs "Invalid password pbkdf2 salt" Base16
-
-        registerRsa                <- o .: "rsaKey" >>= toUnsizedBs "Invalid rsa encryption" Base16
-        registerRsaCtrCounter      <- o .: "rsaCounter" >>= toSizedBs "Invalid rsa ctr counter" Base16
-        registerRsaKdfSalt         <- o .: "rsaSalt" >>= toSizedBs "Invalid rsa pbkdf2 salt" Base16
-
-        pure RegisterReq { .. }
-
-instance ToJSON RegisterRes where
-    toJSON (RegisterRes {..}) = object
-        [ "claimedAt" .= registerResClaimedAt
-        , "torAddressSig" .= registerResTorAddressSig
-        , "certSig" .= registerResCertSig
-        , "certName" .= registerResCertName
-        , "lanAddress" .= registerResLanAddress
-        ]
-
-instance ToTypedContent RegisterRes where
-    toTypedContent = toTypedContent . toJSON
-instance ToContent RegisterRes where
-    toContent = toContent . toJSON

agent/src/Handler/Types/V0/Base.hs

@@ -1,82 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Types.V0.Base where
-
-import           Startlude
-
-import           Data.Aeson
-import           Database.Persist
-import           Yesod.Core
-
-import           Handler.Types.V0.Ssh
-import           Handler.Types.V0.Specs
-import           Handler.Types.V0.Wifi
-import           Lib.Types.Core
-import           Lib.Types.Emver
-import           Model
-
-data VersionLatestRes = VersionLatestRes
-    { versionLatestVersion      :: Version
-    , versionLatestReleaseNotes :: Maybe Text
-    }
-    deriving (Eq, Show)
-instance ToJSON VersionLatestRes where
-    toJSON VersionLatestRes {..} =
-        object $ ["versionLatest" .= versionLatestVersion, "releaseNotes" .= versionLatestReleaseNotes]
-instance ToTypedContent VersionLatestRes where
-    toTypedContent = toTypedContent . toJSON
-instance ToContent VersionLatestRes where
-    toContent = toContent . toJSON
-
-data ServerRes = ServerRes
-    { serverId                     :: Text
-    , serverName                   :: Text
-    , serverStatus                 :: Maybe AppStatus
-    , serverStatusAt               :: UTCTime
-    , serverVersionInstalled       :: Version
-    , serverNotifications          :: [Entity Notification]
-    , serverWifi                   :: WifiList
-    , serverSsh                    :: [SshKeyFingerprint]
-    , serverAlternativeRegistryUrl :: Maybe Text
-    , serverSpecs                  :: SpecsRes
-    , serverWelcomeAck             :: Bool
-    , serverAutoCheckUpdates       :: Bool
-    }
-    deriving (Eq, Show)
-
-type JsonEncoding a = Encoding
-jsonEncode :: (Monad m, ToJSON a) => a -> m (JsonEncoding a)
-jsonEncode = returnJsonEncoding
-
-instance ToJSON ServerRes where
-    toJSON ServerRes {..} = object
-        [ "serverId" .= serverId
-        , "name" .= serverName
-        , "status" .= case serverStatus of
-            Nothing   -> String "UPDATING"
-            Just stat -> toJSON stat
-        , "versionInstalled" .= serverVersionInstalled
-        , "notifications" .= serverNotifications
-        , "wifi" .= serverWifi
-        , "ssh" .= serverSsh
-        , "alternativeRegistryUrl" .= serverAlternativeRegistryUrl
-        , "specs" .= serverSpecs
-        , "welcomeAck" .= serverWelcomeAck
-        , "autoCheckUpdates" .= serverAutoCheckUpdates
-        ]
-instance ToTypedContent ServerRes where
-    toTypedContent = toTypedContent . toJSON
-instance ToContent ServerRes where
-    toContent = toContent . toJSON
-
-newtype AppVersionRes = AppVersionRes
-    { unAppVersionRes :: Version } deriving (Eq, Show)
-instance ToJSON AppVersionRes where
-    toJSON AppVersionRes { unAppVersionRes } = object ["version" .= unAppVersionRes]
-instance FromJSON AppVersionRes where
-    parseJSON = withObject "app version response" $ \o -> do
-        av <- o .: "version"
-        pure $ AppVersionRes av
-instance ToContent AppVersionRes where
-    toContent = toContent . toJSON
-instance ToTypedContent AppVersionRes where
-    toTypedContent = toTypedContent . toJSON

agent/src/Handler/Types/V0/Specs.hs

@@ -1,48 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Types.V0.Specs where
-
-import           Startlude
-
-import           Lib.Types.Emver
-import           Lib.Types.Emver.Orphans        ( )
-
-import           Data.Aeson
-import           Yesod.Core
-
-data SpecsRes = SpecsRes
-    { specsCPU          :: Text
-    , specsMem          :: Text
-    , specsDisk         :: Maybe Text
-    , specsNetworkId    :: Text
-    , specsAgentVersion :: Version
-    , specsTorAddress   :: Text
-    , specsLanAddress   :: Text
-    }
-    deriving (Eq, Show)
-
-instance ToJSON SpecsRes where
-    toJSON SpecsRes {..} = object
-        [ "EmbassyOS Version" .= specsAgentVersion
-        , "Tor Address" .= specsTorAddress
-        , "LAN Address" .= specsLanAddress
-        , "Network ID" .= specsNetworkId
-        , "CPU" .= specsCPU
-        , "Memory" .= specsMem
-        , "Disk" .= specsDisk
-        ]
-    toEncoding SpecsRes {..} =
-        pairs
-            . fold
-            $ [ "EmbassyOS Version" .= specsAgentVersion
-              , "Tor Address" .= specsTorAddress
-              , "LAN Address" .= specsLanAddress
-              , "Network ID" .= specsNetworkId
-              , "CPU" .= specsCPU
-              , "Memory" .= specsMem
-              , "Disk" .= specsDisk
-              ]
-
-instance ToTypedContent SpecsRes where
-    toTypedContent = toTypedContent . toJSON
-instance ToContent SpecsRes where
-    toContent = toContent . toJSON

agent/src/Handler/Types/V0/Ssh.hs

@@ -1,25 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Types.V0.Ssh where
-
-import           Startlude
-
-import           Lib.Ssh
-
-import           Data.Aeson
-import           Yesod.Core
-
-newtype SshKeyModReq = SshKeyModReq { sshKey :: Text } deriving (Eq, Show)
-instance FromJSON SshKeyModReq where
-    parseJSON = withObject "ssh key" $ fmap SshKeyModReq . (.: "sshKey")
-
-data SshKeyFingerprint = SshKeyFingerprint
-    { sshKeyAlg      :: SshAlg
-    , sshKeyHash     :: Text
-    , sshKeyHostname :: Text
-    } deriving (Eq, Show)
-instance ToJSON SshKeyFingerprint where
-    toJSON SshKeyFingerprint {..} = object ["alg" .= sshKeyAlg, "hash" .= sshKeyHash, "hostname" .= sshKeyHostname]
-instance ToTypedContent SshKeyFingerprint where
-    toTypedContent = toTypedContent . toJSON
-instance ToContent SshKeyFingerprint where
-    toContent = toContent . toJSON

agent/src/Handler/Types/V0/Wifi.hs

@@ -1,32 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-module Handler.Types.V0.Wifi where
-
-import           Startlude
-
-import           Data.Aeson
-import           Yesod.Core
-
-data AddWifiReq = AddWifiReq
-    { addWifiSsid     :: Text
-    , addWifiPassword :: Text
-    , addWifiCountry  :: Text
-    , skipConnect     :: Bool
-    } deriving (Eq, Show)
-instance FromJSON AddWifiReq where
-    parseJSON = withObject "AddWifiReq" $ \o -> do
-        addWifiSsid     <- o .: "ssid"
-        addWifiPassword <- o .: "password"
-        addWifiCountry  <- o .:? "country" .!= "US"
-        skipConnect     <- o .:? "skipConnect" .!= False
-        pure AddWifiReq { .. }
-
-data WifiList = WifiList
-    { wifiListCurrent :: Maybe Text
-    , wifiListSsids   :: [Text]
-    } deriving (Eq, Show)
-instance ToJSON WifiList where
-    toJSON WifiList {..} = object ["current" .= wifiListCurrent, "ssids" .= wifiListSsids]
-instance ToTypedContent WifiList where
-    toTypedContent = toTypedContent . toJSON
-instance ToContent WifiList where
-    toContent = toContent . toJSON

agent/src/Handler/Util.hs

@@ -1,16 +0,0 @@
-module Handler.Util where
-
-import           Startlude
-
-import           Data.IORef
-import           Yesod.Core
-
-import           Foundation
-import           Lib.Error
-
-disableEndpointOnFailedUpdate :: Handler a -> Handler a
-disableEndpointOnFailedUpdate m = handleS9ErrT $ do
-    updateFailed <- getsYesod appIsUpdateFailed >>= liftIO . readIORef
-    case updateFailed of
-        Just e  -> throwE e
-        Nothing -> lift m

agent/src/Handler/V0.hs

@@ -1,144 +0,0 @@
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-module Handler.V0 where
-
-import           Startlude               hiding ( runReader )
-
-import           Control.Carrier.Lift           ( runM )
-import           Data.Aeson
-import           Data.IORef
-import qualified Data.Text                     as T
-import           Database.Persist              as Persist
-import           Yesod.Core.Handler
-import           Yesod.Persist.Core
-import           Yesod.Core.Json
-
-import           Constants
-import           Daemon.ZeroConf
-import           Foundation
-import           Handler.Types.V0.Specs
-import           Handler.Types.V0.Ssh
-import           Handler.Types.V0.Base
-import           Handler.Types.V0.Wifi
-import           Lib.Error
-import           Lib.External.Metrics.Df
-import           Lib.External.Specs.CPU
-import           Lib.External.Specs.Memory
-import qualified Lib.External.WpaSupplicant    as WpaSupplicant
-import           Lib.Notifications
-import           Lib.SystemPaths
-import           Lib.Ssh
-import           Lib.Tor
-import           Lib.Types.Core
-import           Lib.Types.Emver
-import           Model
-import           Settings
-import           Util.Function
-
-
-getServerR :: Handler (JsonEncoding ServerRes)
-getServerR = handleS9ErrT $ do
-    agentCtx <- getYesod
-    let settings = appSettings agentCtx
-    now        <- liftIO getCurrentTime
-    isUpdating <- getsYesod appIsUpdating >>= liftIO . readIORef
-
-    let status = if isJust isUpdating then Nothing else Just Running
-
-    notifs <- case isUpdating of
-        Nothing -> lift . runDB $ do
-            notif <- selectList [NotificationArchivedAt ==. Nothing] [Desc NotificationCreatedAt]
-            void . archive . fmap entityKey $ notif
-            pure notif
-        Just _ -> pure []
-
-    alternativeRegistryUrl <- runM $ injectFilesystemBaseFromContext settings $ readSystemPath altRegistryUrlPath
-    name                   <- runM $ injectFilesystemBaseFromContext settings $ readSystemPath serverNamePath
-    ssh                    <- readFromPath settings sshKeysFilePath >>= parseSshKeys
-    wifi <- WpaSupplicant.runWlan0 $ liftA2 WifiList WpaSupplicant.getCurrentNetwork WpaSupplicant.listNetworks
-    specs                  <- getSpecs settings
-    welcomeAck             <- fmap isJust . lift . runDB . Persist.get $ WelcomeAckKey agentVersion
-    autoCheckUpdates       <- runM $ injectFilesystemBaseFromContext settings $ fmap not (existsSystemPath disableAutoCheckUpdatesPath)
-
-    let sid = T.drop 7 $ specsNetworkId specs
-
-    jsonEncode ServerRes { serverId                     = specsNetworkId specs
-                         , serverName                   = fromMaybe ("Embassy:" <> sid) name
-                         , serverStatus                 = AppStatusAppMgr <$> status
-                         , serverStatusAt               = now
-                         , serverVersionInstalled       = agentVersion
-                         , serverNotifications          = notifs
-                         , serverWifi                   = wifi
-                         , serverSsh                    = ssh
-                         , serverAlternativeRegistryUrl = alternativeRegistryUrl
-                         , serverSpecs                  = specs
-                         , serverWelcomeAck             = welcomeAck
-                         , serverAutoCheckUpdates       = autoCheckUpdates
-                         }
-    where
-        parseSshKeys :: Text -> S9ErrT Handler [SshKeyFingerprint]
-        parseSshKeys keysContent = do
-            let keys = lines . T.strip $ keysContent
-            case traverse fingerprint keys of
-                Left  e  -> throwE $ InvalidSshKeyE (toS e)
-                Right as -> pure $ uncurry3 SshKeyFingerprint <$> as
-
-postWelcomeR :: Version -> Handler ()
-postWelcomeR version = runDB $ repsert (WelcomeAckKey version) WelcomeAck
-
-getSpecs :: MonadIO m => AppSettings -> S9ErrT m SpecsRes
-getSpecs settings = do
-    specsCPU        <- liftIO getCpuInfo
-    specsMem        <- liftIO getMem
-    specsDisk       <- fmap show . metricDiskSize <$> getDfMetrics
-    specsNetworkId  <- runM $ injectFilesystemBaseFromContext settings getStart9AgentHostname
-    specsTorAddress <- runM $ injectFilesystemBaseFromContext settings getAgentHiddenServiceUrl
-    specsLanAddress <- fmap (<> ".local") . runM $ injectFilesystemBaseFromContext settings getStart9AgentHostname
-
-    let specsAgentVersion = agentVersion
-    pure $ SpecsRes { .. }
-
-readFromPath :: MonadIO m => AppSettings -> SystemPath -> S9ErrT m Text
-readFromPath settings sp = runM (injectFilesystemBaseFromContext settings (readSystemPath sp)) >>= \case
-    Nothing  -> throwE $ MissingFileE sp
-    Just res -> pure res
-
---------------------- UPDATES TO SERVER -------------------------
-
-newtype PatchReq = PatchReq { patchValue :: Text } deriving(Eq, Show)
-instance FromJSON PatchReq where
-    parseJSON = withObject "Patch Request" $ \o -> PatchReq <$> o .: "value"
-
-newtype NullablePatchReq = NullablePatchReq { mpatchValue :: Maybe Text } deriving(Eq, Show)
-instance FromJSON NullablePatchReq where
-    parseJSON = withObject "Nullable Patch Request" $ \o -> NullablePatchReq <$> o .:? "value"
-
-newtype BoolPatchReq = BoolPatchReq { bpatchValue :: Bool } deriving (Eq, Show)
-
-instance FromJSON BoolPatchReq where
-    parseJSON = withObject "Patch Request" $ \o -> BoolPatchReq <$> o .: "value"
-
-patchNameR :: Handler ()
-patchNameR = patchFile serverNamePath
-
-patchAutoCheckUpdatesR :: Handler ()
-patchAutoCheckUpdatesR = do
-    settings         <- getsYesod appSettings
-    BoolPatchReq val <- requireCheckJsonBody
-    runM $ injectFilesystemBaseFromContext settings $ if val
-        then deleteSystemPath disableAutoCheckUpdatesPath
-        else writeSystemPath disableAutoCheckUpdatesPath ""
-
-patchFile :: SystemPath -> Handler ()
-patchFile path = do
-    settings     <- getsYesod appSettings
-    PatchReq val <- requireCheckJsonBody
-    runM $ injectFilesystemBaseFromContext settings $ writeSystemPath path val
-
-patchNullableFile :: SystemPath -> Handler ()
-patchNullableFile path = do
-    settings              <- getsYesod appSettings
-    NullablePatchReq mVal <- requireCheckJsonBody
-    runM $ injectFilesystemBaseFromContext settings $ case mVal of
-        Just val -> writeSystemPath path $ T.strip val
-        Nothing  -> deleteSystemPath path

agent/src/Handler/Wifi.hs

@@ -1,76 +0,0 @@
-{-# LANGUAGE QuasiQuotes     #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE TemplateHaskell #-}
-module Handler.Wifi where
-
-import           Startlude
-
-import           Data.String.Interpolate.IsString
-import qualified Data.Text                     as T
-import           Network.HTTP.Types
-import           Yesod.Core
-
-import           Constants
-import           Foundation
-import           Handler.Types.V0.Wifi
-import           Lib.Error
-import qualified Lib.External.WpaSupplicant    as WpaSupplicant
-
-getWifiR :: Handler WifiList
-getWifiR = WpaSupplicant.runWlan0 $ liftA2 WifiList WpaSupplicant.getCurrentNetwork WpaSupplicant.listNetworks
-
-postWifiR :: Handler ()
-postWifiR = handleS9ErrT $ do
-    AddWifiReq { addWifiSsid, addWifiPassword, addWifiCountry, skipConnect } <- requireCheckJsonBody
-    unless (T.all isAscii addWifiSsid) $ throwE InvalidSsidE
-    unless (T.all isAscii addWifiPassword) $ throwE InvalidPskE
-
-    _ <- liftIO . forkIO . WpaSupplicant.runWlan0 $ do
-        lift $ withAgentVersionLog_ [i|Adding new WiFi network: '#{addWifiSsid}'|]
-        WpaSupplicant.addNetwork addWifiSsid addWifiPassword addWifiCountry
-        unless skipConnect $ do
-            mCurrent <- WpaSupplicant.getCurrentNetwork
-            connected <- WpaSupplicant.selectNetwork addWifiSsid addWifiCountry
-            unless connected do
-                lift $ withAgentVersionLog_ [i|Failed to add new WiFi network: '#{addWifiSsid}'|]
-                WpaSupplicant.removeNetwork addWifiSsid
-                case mCurrent of
-                    Nothing -> pure ()
-                    Just current -> void $ WpaSupplicant.selectNetwork current addWifiSsid
-    sendResponseStatus status200 ()
-
-
-postWifiBySsidR :: Text -> Handler ()
-postWifiBySsidR ssid = handleS9ErrT $ do
-    unless (T.all isAscii ssid) $ throwE InvalidSsidE
-
-    -- TODO: Front end never sends this on switching between networks. This means that we can only
-    -- switch to US networks.
-    country <- fromMaybe "US" <$> lookupGetParam "country"
-    _       <- liftIO . forkIO . WpaSupplicant.runWlan0 $ do
-        mCurrent <- WpaSupplicant.getCurrentNetwork
-        connected <- WpaSupplicant.selectNetwork ssid country
-        if connected
-            then lift $ withAgentVersionLog_ [i|Successfully connected to WiFi: #{ssid}|]
-            else do
-                lift $ withAgentVersionLog_ [i|Failed to add new WiFi network: '#{ssid}'|]
-                case mCurrent of
-                    Nothing -> lift $ withAgentVersionLog_ [i|No WiFi to revert to!|]
-                    Just current -> void $ WpaSupplicant.selectNetwork current country
-    sendResponseStatus status200 ()
-
-deleteWifiBySsidR :: Text -> Handler ()
-deleteWifiBySsidR ssid = handleS9ErrT $ do
-    unless (T.all isAscii ssid) $ throwE InvalidSsidE
-    WpaSupplicant.runWlan0 $ do
-        current <- WpaSupplicant.getCurrentNetwork
-        case current of
-            Nothing -> deleteIt
-            Just ssid' -> if ssid == ssid'
-                then do
-                    eth0 <- WpaSupplicant.isConnectedToEthernet
-                    if eth0
-                        then deleteIt
-                        else lift $ throwE WifiOrphaningE
-                else deleteIt
-    where deleteIt = void $ WpaSupplicant.removeNetwork ssid

agent/src/Lib/Algebra/Domain/AppMgr.hs

@@ -1,483 +0,0 @@
-{-# OPTIONS_GHC -fno-warn-name-shadowing #-} -- because of my sheer laziness in dealing with conditional data
-{-# OPTIONS_GHC -fno-show-valid-hole-fits #-} -- to not make dev'ing this module cripplingly slow
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE StandaloneKindSignatures #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE UndecidableInstances #-}
-{-# LANGUAGE NoMonomorphismRestriction #-}
-module Lib.Algebra.Domain.AppMgr
-    ( module Lib.Algebra.Domain.AppMgr
-    , module Lib.Algebra.Domain.AppMgr.Types
-    , module Lib.Algebra.Domain.AppMgr.TH
-    ) where
-
-import           Startlude
-
-import           Control.Algebra
-import           Control.Effect.Error
-import           Control.Effect.TH
-import           Data.Aeson
-import           Data.Aeson.Types               ( Parser )
-import qualified Data.HashMap.Strict           as HM
-import           Data.Singletons.Prelude hiding ( Error )
-import           Data.Singletons.Prelude.Either
-import qualified Data.String                   as String
-
-import           Control.Monad.Base             ( MonadBase(..) )
-import           Control.Monad.Fail             ( MonadFail(fail) )
-import           Control.Monad.Trans.Class      ( MonadTrans )
-import           Control.Monad.Trans.Control    ( MonadBaseControl(..)
-                                                , MonadTransControl(..)
-                                                , defaultLiftBaseWith
-                                                , defaultRestoreM
-                                                )
-import           Control.Monad.Trans.Resource   ( MonadResource(..) )
-import qualified Data.ByteString.Char8         as C8
-import qualified Data.ByteString.Lazy          as LBS
-import           Data.String.Interpolate.IsString
-                                                ( i )
-import           Lib.Algebra.Domain.AppMgr.TH
-import           Lib.Algebra.Domain.AppMgr.Types
-import           Lib.Error
-import qualified Lib.External.AppManifest      as Manifest
-import           Lib.TyFam.ConditionalData
-import           Lib.Types.Core                 ( AppContainerStatus(..)
-                                                , AppId(..)
-                                                )
-import           Lib.Types.Emver
-import           Lib.Types.NetAddress
-import           System.Process
-import           System.Process.Typed
-
-
-type InfoRes :: Either OnlyInfoFlag [IncludeInfoFlag] -> Type
-data InfoRes a = InfoRes
-    { infoResTitle         :: Include (IsRight a) Text
-    , infoResVersion       :: Include (IsRight a) Version
-    , infoResTorAddress    :: Include (IsRight a) (Maybe TorAddress)
-    , infoResIsConfigured  :: Include (IsRight a) Bool
-    , infoResIsRecoverable :: Include (IsRight a) Bool
-    , infoResNeedsRestart  :: Include (IsRight a) Bool
-    , infoResConfig        :: Include (Either_ (DefaultEqSym1 'OnlyConfig) (ElemSym1 'IncludeConfig) a) Value
-    , infoResDependencies
-          :: Include
-              (Either_ (DefaultEqSym1 'OnlyDependencies) (ElemSym1 'IncludeDependencies) a)
-              (HM.HashMap AppId DependencyInfo)
-    , infoResManifest
-          :: Include (Either_ (DefaultEqSym1 'OnlyManifest) (ElemSym1 'IncludeManifest) a) Manifest.AppManifest
-    , infoResStatus :: Include (Either_ (DefaultEqSym1 'OnlyStatus) (ElemSym1 'IncludeStatus) a) AppContainerStatus
-    }
-instance SingI (a :: Either OnlyInfoFlag [IncludeInfoFlag]) => FromJSON (InfoRes a) where
-    parseJSON = withObject "AppMgr Info/List Response" $ \o -> do
-        let recurse :: forall (a :: [IncludeInfoFlag]) . SingI a => Value -> Parser (InfoRes ( 'Right a))
-            recurse = parseJSON @(InfoRes ( 'Right a))
-        let infoResConfig       = ()
-        let infoResDependencies = ()
-        let infoResManifest     = ()
-        let infoResStatus       = ()
-        case sing @a of
-            SLeft f -> do
-                let infoResTitle         = ()
-                let infoResVersion       = ()
-                let infoResTorAddress    = ()
-                let infoResIsConfigured  = ()
-                let infoResIsRecoverable = ()
-                let infoResNeedsRestart  = ()
-                case f of
-                    SOnlyConfig       -> let infoResConfig = (Object o) in pure InfoRes { .. }
-                    SOnlyDependencies -> parseJSON (Object o) >>= \infoResDependencies -> pure InfoRes { .. }
-                    SOnlyManifest     -> parseJSON (Object o) >>= \infoResManifest -> pure InfoRes { .. }
-                    SOnlyStatus       -> o .: "status" >>= \infoResStatus -> pure InfoRes { .. }
-            SRight ls -> do
-                infoResTitle         <- o .: "title"
-                infoResVersion       <- o .: "version"
-                infoResTorAddress    <- TorAddress <<$>> o .: "tor-address"
-                infoResIsConfigured  <- o .: "configured"
-                infoResIsRecoverable <- o .:? "recoverable" .!= False
-                infoResNeedsRestart  <- o .:? "needs-restart" .!= False
-                let base = (InfoRes { .. } :: InfoRes ( 'Right '[]))
-                case ls of
-                    SNil -> pure base
-                    SCons SIncludeConfig (rest :: Sing b) -> do
-                        InfoRes {..}  <- withSingI rest $ recurse @b (Object o)
-                        infoResConfig <- o .: "config"
-                        pure InfoRes { .. }
-                    SCons SIncludeDependencies (rest :: Sing b) -> do
-                        InfoRes {..}        <- withSingI rest $ recurse @b (Object o)
-                        infoResDependencies <- o .: "dependencies"
-                        pure InfoRes { .. }
-                    SCons SIncludeManifest (rest :: Sing b) -> do
-                        InfoRes {..}    <- withSingI rest $ recurse @b (Object o)
-                        infoResManifest <- o .: "manifest"
-                        pure InfoRes { .. }
-                    SCons SIncludeStatus (rest :: Sing b) -> do
-                        InfoRes {..}  <- withSingI rest $ recurse @b (Object o)
-                        infoResStatus <- o .: "status"
-                        pure InfoRes { .. }
-
-data DependencyInfo = DependencyInfo
-    { dependencyInfoVersionSpec    :: VersionRange
-    , dependencyInfoReasonOptional :: Maybe Text
-    , dependencyInfoDescription    :: Maybe Text
-    , dependencyInfoConfigRules    :: [ConfigRule]
-    , dependencyInfoRequired       :: Bool
-    , dependencyInfoError          :: Maybe DependencyViolation
-    }
-    deriving (Eq, Show)
-instance FromJSON DependencyInfo where
-    parseJSON = withObject "AppMgr DependencyInfo" $ \o -> do
-        dependencyInfoVersionSpec    <- o .: "version"
-        dependencyInfoReasonOptional <- o .: "optional"
-        dependencyInfoDescription    <- o .: "description"
-        dependencyInfoConfigRules    <- o .: "config"
-        dependencyInfoRequired       <- o .: "required"
-        dependencyInfoError          <- o .:? "error"
-        pure DependencyInfo { .. }
-
-data ConfigRule = ConfigRule
-    { configRuleRule        :: Text
-    , configRuleDescription :: Text
-    , configRuleSuggestions :: [ConfigRuleSuggestion]
-    }
-    deriving (Eq, Show)
-instance FromJSON ConfigRule where
-    parseJSON = withObject "AppMgr Config Rule" $ \o -> do
-        configRuleRule        <- o .: "rule"
-        configRuleDescription <- o .: "description"
-        configRuleSuggestions <- o .: "suggestions"
-        pure ConfigRule { .. }
-data ConfigRuleSuggestion
-    = SuggestionPush Text Value
-    | SuggestionSet Text Target
-    | SuggestionDelete Text
-    deriving (Eq, Show)
-instance FromJSON ConfigRuleSuggestion where
-    parseJSON = withObject "AppMgr ConfigRule Suggestion" $ \o -> do
-        let push = do
-                o' <- o .: "PUSH"
-                t  <- o' .: "to"
-                v  <- o' .: "value"
-                pure $ SuggestionPush t v
-        let set = do
-                o' <- o .: "SET"
-                v  <- o' .: "var"
-                t  <- parseJSON (Object o')
-                pure $ SuggestionSet v t
-        let delete = SuggestionDelete <$> o .: "DELETE"
-        push <|> set <|> delete
-
-data Target
-    = To Text
-    | ToValue Value
-    | ToEntropy Text Word16
-    deriving (Eq, Show)
-instance FromJSON Target where
-    parseJSON = withObject "Suggestion SET Target" $ \o -> do
-        (To <$> o .: "to") <|> (ToValue <$> o .: "to-value") <|> do
-            o' <- o .: "to-entropy"
-            ToEntropy <$> o' .: "charset" <*> o' .: "len"
-
-data DependencyError
-    = Violation DependencyViolation
-    | PointerUpdateError Text
-    | Other Text
-    deriving (Eq, Show)
-instance FromJSON DependencyError where
-    parseJSON v = (Violation <$> parseJSON v) <|> case v of
-        Object o -> (PointerUpdateError <$> o .: "pointer-update-error") <|> (Other <$> o .: "other")
-        other    -> fail $ "Invalid DependencyError. Expected Object, got " <> (show other)
-
-data DependencyViolation
-    = NotInstalled
-    | NotRunning
-    | InvalidVersion VersionRange Version
-    | UnsatisfiedConfig [Text]
-    deriving (Eq, Show)
-instance FromJSON DependencyViolation where
-    parseJSON (String "not-installed") = pure NotInstalled
-    parseJSON (String "not-running"  ) = pure NotRunning
-    parseJSON (Object o) =
-        let version = do
-                o' <- o .: "incorrect-version"
-                s  <- o' .: "expected"
-                v  <- o' .: "received"
-                pure $ InvalidVersion s v
-            config = UnsatisfiedConfig <$> o .: "config-unsatisfied"
-        in  version <|> config
-    parseJSON other = fail $ "Invalid Dependency Violation" <> show other
-
-data AutoconfigureRes = AutoconfigureRes
-    { autoconfigureConfigRes :: ConfigureRes
-    , autoconfigureChanged   :: HM.HashMap AppId Value
-    }
-instance FromJSON AutoconfigureRes where
-    parseJSON = withObject "AppMgr AutoconfigureRes" $ \o -> do
-        autoconfigureConfigRes <- parseJSON (Object o)
-        autoconfigureChanged   <- o .: "changed"
-        pure AutoconfigureRes { .. }
-
-data ConfigureRes = ConfigureRes
-    { configureResNeedsRestart :: [AppId]
-    , configureResStopped      :: HM.HashMap AppId (AppId, DependencyError) -- TODO: Consider making this nested hashmaps
-    }
-    deriving Eq
-instance FromJSON ConfigureRes where
-    parseJSON = withObject "AppMgr ConfigureRes" $ \o -> do
-        configureResNeedsRestart <- o .: "needs-restart"
-        configureResStopped'     <- o .: "stopped"
-        configureResStopped      <- for
-            configureResStopped'
-            \v -> do
-                depId    <- v .: "dependency"
-                depError <- v .: "error"
-                pure (depId, depError)
-        pure ConfigureRes { .. }
-
-newtype BreakageMap = BreakageMap { unBreakageMap :: HM.HashMap AppId (AppId, DependencyError) }
-instance FromJSON BreakageMap where
-    parseJSON = withObject "Breakage Map" $ \o -> do
-        fmap (BreakageMap . HM.fromList) $ for (HM.toList o) $ \(k, v) -> do
-            case v of
-                Object v' -> do
-                    depId    <- v' .: "dependency"
-                    depError <- v' .: "error"
-                    pure (AppId k, (depId, depError))
-                otherwise -> fail $ "Expected Breakage Object, got" <> show otherwise
-
-data AppMgr (m :: Type -> Type) k where
-    -- Backup ::_
-    CheckDependencies ::LocalOnly -> AppId -> Maybe VersionRange -> AppMgr m (HM.HashMap AppId DependencyInfo)
-    Configure ::DryRun -> AppId -> Maybe Value -> AppMgr m ConfigureRes
-    Autoconfigure ::DryRun -> AppId -> AppId -> AppMgr m AutoconfigureRes
-    -- Disks ::_
-    Info ::Sing (flags :: Either OnlyInfoFlag [IncludeInfoFlag]) -> AppId -> AppMgr m (Maybe (InfoRes flags))
-    InfoRaw ::OnlyInfoFlag -> AppId -> AppMgr m (Maybe Text)
-    -- Inspect ::_
-    Install ::NoCache -> AppId -> Maybe VersionRange -> AppMgr m ()
-    Instructions ::AppId -> AppMgr m (Maybe Text)
-    List ::Sing ('Right (flags :: [IncludeInfoFlag])) -> AppMgr m (HM.HashMap AppId (InfoRes ('Right flags)))
-    -- Logs ::_
-    -- Notifications ::_
-    -- Pack ::_
-    Remove ::Either DryRun Purge -> AppId -> AppMgr m BreakageMap
-    Restart ::AppId -> AppMgr m ()
-    -- SelfUpdate ::_
-    -- Semver ::_
-    Start ::AppId -> AppMgr m ()
-    Stop ::DryRun -> AppId -> AppMgr m BreakageMap
-    -- Tor ::_
-    Update ::DryRun -> AppId -> Maybe VersionRange -> AppMgr m BreakageMap
-    -- Verify ::_
-    LanEnable ::AppMgr m ()
-    Action ::AppId -> Text -> AppMgr m (HM.HashMap Text Value)
-makeSmartConstructors ''AppMgr
-
-newtype AppMgrCliC m a = AppMgrCliC { runAppMgrCliC :: m a }
-    deriving newtype (Functor, Applicative, Monad, MonadIO)
-instance MonadTrans AppMgrCliC where
-    lift = AppMgrCliC
-instance MonadResource m => MonadResource (AppMgrCliC m) where
-    liftResourceT = lift . liftResourceT
-instance MonadBase IO m => MonadBase IO (AppMgrCliC m) where
-    liftBase = AppMgrCliC . liftBase
-instance MonadTransControl AppMgrCliC where
-    type StT AppMgrCliC a = a
-    liftWith f = AppMgrCliC $ f $ runAppMgrCliC
-    restoreT = AppMgrCliC
-instance MonadBaseControl IO m => MonadBaseControl IO (AppMgrCliC m) where
-    type StM (AppMgrCliC m) a = StM m a
-    liftBaseWith = defaultLiftBaseWith
-    restoreM     = defaultRestoreM
-
-instance (Has (Error S9Error) sig m, Algebra sig m, MonadIO m) => Algebra (AppMgr :+: sig) (AppMgrCliC m) where
-    alg hdl sig ctx = case sig of
-        (L (CheckDependencies (LocalOnly b) appId version)) -> do
-            let local = if b then ("--local-only" :) else id
-                args  = "check-dependencies" : local [versionSpec version (show appId), "--json"]
-            (ec, out) <- readProcessInheritStderr "appmgr" args ""
-            res       <- case ec of
-                ExitSuccess -> case eitherDecodeStrict out of
-                    Left  e -> throwError $ AppMgrParseE (toS $ String.unwords args) (decodeUtf8 out) e
-                    Right x -> pure x
-                ExitFailure 6 -> throwError $ NotFoundE "appId@version" (versionSpec version (show appId))
-                ExitFailure n -> throwError $ AppMgrE "check-dependencies" n
-            pure $ ctx $> res
-        (L (Configure (DryRun b) appId cfg)) -> do
-            let dryrun = if b then ("--dry-run" :) else id
-            let input = case cfg of
-                    Nothing -> ""
-                    Just x  -> LBS.toStrict $ encode x
-            let args = "configure" : dryrun [show appId, "--json", "--stdin"]
-            (ec, out, e) <- readProcessWithExitCode' "appmgr" args input
-            res          <- case ec of
-                ExitSuccess -> case eitherDecodeStrict out of
-                    Left  e -> throwError $ AppMgrParseE (toS $ String.unwords args) (decodeUtf8 out) e
-                    Right x -> pure x
-                ExitFailure 4 -> throwError $ (AppMgrInvalidConfigE . decodeUtf8) e -- doesn't match spec
-                ExitFailure 5 -> throwError $ (AppMgrInvalidConfigE . decodeUtf8) e -- doesn't match rules
-                ExitFailure n -> throwError $ AppMgrE "configure" n
-            pure $ ctx $> res
-        (L (Autoconfigure (DryRun dry) dependent dependency)) -> do
-            let flags = (if dry then ("--dry-run" :) else id) . ("--json" :)
-            let args  = "autoconfigure-dependency" : flags [show dependent, show dependency]
-            (ec, out) <- readProcessInheritStderr "appmgr" args ""
-            res       <- case ec of
-                ExitSuccess -> case eitherDecodeStrict out of
-                    Left  e -> throwError $ AppMgrParseE (toS $ String.unwords args) (decodeUtf8 out) e
-                    Right a -> pure a
-                ExitFailure n -> throwError $ AppMgrE "autoconfigure-dependency" n
-            pure $ ctx $> res
-        (L (Info fs appId)) -> do
-            let args = case fromSing fs of
-                    Left  o  -> ["info", genExclusiveFlag o, show appId, "--json"]
-                    Right ls -> "info" : ((genInclusiveFlag <$> ls) <> [show appId, "--json"])
-            (ec, out) <- readProcessInheritStderr "appmgr" args ""
-            res       <- case ec of
-                ExitSuccess -> case withSingI fs $ eitherDecodeStrict out of
-                    Left  e -> throwError $ AppMgrParseE (show args) (decodeUtf8 out) e
-                    Right x -> pure $ Just x
-                ExitFailure 6 -> pure Nothing
-                ExitFailure n -> throwError $ AppMgrE "info" n
-            pure $ ctx $> res
-        (L (InfoRaw f appId)) -> do
-            let args = ["info", genExclusiveFlag f, show appId, "--json"]
-            (ec, out) <- readProcessInheritStderr "appmgr" args ""
-            res       <- case ec of
-                ExitSuccess   -> pure (Just $ decodeUtf8 out)
-                ExitFailure 6 -> pure Nothing
-                ExitFailure n -> throwError $ AppMgrE "info (raw)" n
-            pure $ ctx $> res
-        (L (Install (NoCache b) appId version)) -> do
-            let nocache = if b then ("--no-cache" :) else id
-            let versionSpec :: (IsString a, Semigroup a, ConvertText String a) => a -> a
-                versionSpec = case version of
-                    Nothing -> id
-                    Just x  -> (<> [i|@#{x}|])
-            let args = "install" : nocache [versionSpec (show appId)]
-            (ec, _) <- readProcessInheritStderr "appmgr" args ""
-            case ec of
-                ExitSuccess   -> pure ctx
-                ExitFailure 6 -> throwError $ NotFoundE "appId" (show appId)
-                ExitFailure n -> throwError $ AppMgrE "install" n
-        (L (Instructions appId)) -> do
-            (ec, out) <- readProcessInheritStderr "appmgr" ["instructions", show appId] ""
-            case ec of
-                ExitSuccess   -> pure $ ctx $> Just (decodeUtf8 out)
-                ExitFailure 6 -> pure $ ctx $> Nothing
-                ExitFailure n -> throwError $ AppMgrE "instructions" n
-        (L (List (SRight flags))) -> do
-            let renderedFlags = (genInclusiveFlag <$> fromSing flags) <> ["--json"]
-            let args          = "list" : renderedFlags
-            let runIt retryCount = do
-                    (ec, out) <- readProcessInheritStderr "appmgr" args ""
-                    case ec of
-                        ExitSuccess -> case withSingI flags $ eitherDecodeStrict out of
-                            Left  e -> throwError $ AppMgrParseE (toS $ String.unwords args) (decodeUtf8 out) e
-                            Right x -> pure $ ctx $> x
-                        ExitFailure 6 ->
-                            if retryCount > 0 then runIt (retryCount - 1) else throwError $ AppMgrE "list" 6
-                        ExitFailure n -> throwError $ AppMgrE "list" n
-            runIt (1 :: Word) -- with 1 retry
-        (L (Remove dryorpurge appId)) -> do
-            let args = "remove" : case dryorpurge of
-                    Left  (DryRun True) -> ["--dry-run", show appId, "--json"]
-                    Right (Purge  True) -> ["--purge", show appId, "--json"]
-                    _                   -> [show appId]
-            (ec, out) <- readProcessInheritStderr "appmgr" args ""
-            res       <- case ec of
-                ExitSuccess -> case eitherDecodeStrict out of
-                    Left  e -> throwError $ AppMgrParseE (toS $ String.unwords args) (decodeUtf8 out) e
-                    Right x -> pure x
-                ExitFailure 6 -> throwError $ NotFoundE "appId" (show appId)
-                ExitFailure n -> throwError $ AppMgrE (toS $ String.unwords args) n
-            pure $ ctx $> res
-        (L (Restart appId)) -> do
-            (ec, _) <- readProcessInheritStderr "appmgr" ["restart", show appId] ""
-            case ec of
-                ExitSuccess   -> pure ctx
-                ExitFailure 6 -> throwError $ NotFoundE "appId" (show appId)
-                ExitFailure n -> throwError $ AppMgrE "restart" n
-        (L (Start appId)) -> do
-            (ec, _) <- readProcessInheritStderr "appmgr" ["start", show appId] ""
-            case ec of
-                ExitSuccess   -> pure ctx
-                ExitFailure 6 -> throwError $ NotFoundE "appId" (show appId)
-                ExitFailure n -> throwError $ AppMgrE "start" n
-        (L (Stop (DryRun dry) appId)) -> do
-            let args = "stop" : (if dry then ("--dry-run" :) else id) [show appId, "--json"]
-            (ec, out) <- readProcessInheritStderr "appmgr" args ""
-            case ec of
-                ExitSuccess -> case eitherDecodeStrict out of
-                    Left  e -> throwError $ AppMgrParseE (toS $ String.unwords args) (decodeUtf8 out) e
-                    Right x -> pure $ ctx $> x
-                ExitFailure 6 -> throwError $ NotFoundE "appId" (show appId)
-                ExitFailure n -> throwError $ AppMgrE (toS $ String.unwords args) n
-        (L (Update (DryRun dry) appId version)) -> do
-            let args = "update" : (if dry then ("--dry-run" :) else id) [versionSpec version (show appId), "--json"]
-            (ec, out) <- readProcessInheritStderr "appmgr" args ""
-            case ec of
-                ExitSuccess ->
-                    let output = if not dry then fromMaybe "" $ lastMay (C8.lines out) else out
-                    in  case eitherDecodeStrict output of
-                            Left  e -> throwError $ AppMgrParseE (toS $ String.unwords args) (decodeUtf8 out) e
-                            Right x -> pure $ ctx $> x
-                ExitFailure 6 ->
-                    throwError $ NotFoundE "appId@version" ([i|#{appId}#{maybe "" (('@':) . show) version}|])
-                ExitFailure n -> throwError $ AppMgrE (toS $ String.unwords args) n
-        (L LanEnable            ) -> liftIO $ callProcess "appmgr" ["lan", "enable"] $> ctx
-        (L (Action appId action)) -> do
-            let args = ["actions", show appId, toS action]
-            (ec, out) <- readProcessInheritStderr "appmgr" args ""
-            case ec of
-                ExitSuccess -> case eitherDecodeStrict out of
-                    Left  e -> throwError $ AppMgrParseE (toS $ String.unwords args) (decodeUtf8 out) e
-                    Right x -> pure $ ctx $> x
-                ExitFailure 6 -> throwError $ NotFoundE "appId" (show appId)
-                ExitFailure n -> throwError $ AppMgrE (toS $ String.unwords args) n
-        R other -> AppMgrCliC $ alg (runAppMgrCliC . hdl) other ctx
-        where
-            versionSpec :: (IsString a, Semigroup a, ConvertText String a) => Maybe VersionRange -> a -> a
-            versionSpec v = case v of
-                Nothing -> id
-                Just x  -> (<> [i|@#{x}|])
-    {-# INLINE alg #-}
-
-genInclusiveFlag :: IncludeInfoFlag -> String
-genInclusiveFlag = \case
-    IncludeConfig       -> "-c"
-    IncludeDependencies -> "-d"
-    IncludeManifest     -> "-m"
-    IncludeStatus       -> "-s"
-
-genExclusiveFlag :: OnlyInfoFlag -> String
-genExclusiveFlag = \case
-    OnlyConfig       -> "-C"
-    OnlyDependencies -> "-D"
-    OnlyManifest     -> "-M"
-    OnlyStatus       -> "-S"
-
-readProcessInheritStderr :: MonadIO m => String -> [String] -> ByteString -> m (ExitCode, ByteString)
-readProcessInheritStderr a b c = liftIO $ do
-    let pc =
-            setStdin (byteStringInput $ LBS.fromStrict c)
-                $ setStderr inherit
-                $ setEnvInherit
-                $ setStdout byteStringOutput
-                $ (System.Process.Typed.proc a b)
-    withProcessWait pc
-        $ \process -> atomically $ liftA2 (,) (waitExitCodeSTM process) (fmap LBS.toStrict $ getStdout process)
-
-readProcessWithExitCode' :: MonadIO m => String -> [String] -> ByteString -> m (ExitCode, ByteString, ByteString)
-readProcessWithExitCode' a b c = liftIO $ do
-    let pc =
-            setStdin (byteStringInput $ LBS.fromStrict c)
-                $ setStderr byteStringOutput
-                $ setEnvInherit
-                $ setStdout byteStringOutput
-                $ (System.Process.Typed.proc a b)
-    withProcessWait pc $ \process -> atomically $ liftA3 (,,)
-                                                         (waitExitCodeSTM process)
-                                                         (fmap LBS.toStrict $ getStdout process)
-                                                         (fmap LBS.toStrict $ getStderr process)

agent/src/Lib/Algebra/Domain/AppMgr/TH.hs

@@ -1,43 +0,0 @@
-{-# LANGUAGE TemplateHaskell #-}
-module Lib.Algebra.Domain.AppMgr.TH where
-
-import           Startlude
-
-import           Data.Singletons
-import           Data.String
-import           Language.Haskell.TH.Syntax
-import           Language.Haskell.TH.Quote      ( QuasiQuoter(..) )
-
-import           Lib.Algebra.Domain.AppMgr.Types
-
-flags :: QuasiQuoter
-flags = QuasiQuoter
-    { quoteType = \s ->
-        let
-            w = Data.String.words s
-            additive []       = Just []
-            additive (f : fs) = case f of
-                "-s" -> ('IncludeStatus :) <$> additive fs
-                "-c" -> ('IncludeConfig :) <$> additive fs
-                "-d" -> ('IncludeDependencies :) <$> additive fs
-                "-m" -> ('IncludeManifest :) <$> additive fs
-                _    -> Nothing
-            exclusive [f] = case f of
-                "-S" -> Just 'OnlyStatus
-                "-C" -> Just 'OnlyConfig
-                "-D" -> Just 'OnlyDependencies
-                "-M" -> Just 'OnlyManifest
-                _    -> Nothing
-            exclusive _ = Nothing
-            typ = case eitherA (exclusive w) (additive w) of
-                Nothing         -> panic $ "Invalid Flags: '" <> toS s <> "'"
-                Just (Left  o ) -> pure $ AppT (PromotedT 'Left) (PromotedT $ o)
-                Just (Right ls) -> pure $ AppT
-                    (PromotedT 'Right)
-                    (foldr (\f fs -> AppT (AppT PromotedConsT . PromotedT $ f) fs) PromotedNilT ls)
-        in
-            typ
-    , quoteExp  = \s -> AppTypeE (VarE 'sing) <$> quoteType flags s
-    , quotePat  = panic "appmgr 'flags' cannot be used in patterns"
-    , quoteDec  = panic "appmgr 'flags' cannot be used in declarations"
-    }

agent/src/Lib/Algebra/Domain/AppMgr/Types.hs

@@ -1,29 +0,0 @@
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE TemplateHaskell #-}
-{-# LANGUAGE UndecidableInstances #-}
-module Lib.Algebra.Domain.AppMgr.Types where
-
-import           Startlude
-
-import           Data.Singletons.TH
-
-newtype LocalOnly = LocalOnly { unLocalOnly :: Bool }
-newtype NoCache = NoCache { unNoCache :: Bool }
-newtype Purge = Purge { unPurge :: Bool }
-newtype DryRun = DryRun { unDryRun :: Bool }
-
-$(singletons [d|
-    data IncludeInfoFlag
-        = IncludeConfig
-        | IncludeDependencies
-        | IncludeManifest
-        | IncludeStatus deriving (Eq, Show) |])
-
-$(singletons [d|
-    data OnlyInfoFlag
-        = OnlyConfig
-        | OnlyDependencies
-        | OnlyManifest
-        | OnlyStatus deriving (Eq, Show) |])
-

agent/src/Lib/Algebra/State/RegistryUrl.hs

@@ -1,84 +0,0 @@
-{-# LANGUAGE UndecidableInstances #-}
-module Lib.Algebra.State.RegistryUrl where
-
-import           Startlude               hiding ( State
-                                                , get
-                                                , put
-                                                )
-
-import           Control.Algebra
-import           Control.Effect.State
-import           Control.Monad.Catch
-import           Control.Monad.Trans.Class
-import           Control.Monad.Trans.Resource
-import qualified Data.Text                     as T
-
-import           Lib.SystemPaths
-import           Lib.Types.Url
-import           Control.Monad.Trans.Control
-import           Control.Monad.Base
-
-data RegistryUrl (m :: Type -> Type) k where
-    GetRegistryUrl ::RegistryUrl m (Maybe Url)
-    PutRegistryUrl ::Url -> RegistryUrl m ()
-
-getRegistryUrl :: Has RegistryUrl sig m => m (Maybe Url)
-getRegistryUrl = send GetRegistryUrl
-
-putRegistryUrl :: Has RegistryUrl sig m => Url -> m ()
-putRegistryUrl = send . PutRegistryUrl
-
-
-newtype RegistryUrlIOC m a = RegistryUrlIOC { runRegistryUrlIOC :: m a }
-    deriving newtype (Functor, Applicative, Monad, MonadIO)
-
-instance MonadTrans RegistryUrlIOC where
-    lift = RegistryUrlIOC
-
-instance MonadThrow m => MonadThrow (RegistryUrlIOC m) where
-    throwM = lift . throwM
-
-instance MonadResource m => MonadResource (RegistryUrlIOC m) where
-    liftResourceT = lift . liftResourceT
-
-instance MonadTransControl RegistryUrlIOC where
-    type StT RegistryUrlIOC a = a
-    liftWith f = RegistryUrlIOC $ f $ runRegistryUrlIOC
-    restoreT = RegistryUrlIOC
-instance MonadBase IO m => MonadBase IO (RegistryUrlIOC m) where
-    liftBase = RegistryUrlIOC . liftBase
-instance MonadBaseControl IO m => MonadBaseControl IO (RegistryUrlIOC m) where
-    type StM (RegistryUrlIOC m) a = StM m a
-    liftBaseWith = defaultLiftBaseWith
-    restoreM     = defaultRestoreM
-
--- the semantics of this are currently as follows, url fetches will fail with an empty value if the path does not exist
--- as well as if the url in the file desired does not parse as a url
-instance (MonadIO m, Algebra sig m, HasFilesystemBase sig m) => Algebra (RegistryUrl :+: sig) (RegistryUrlIOC m) where
-    alg hdl sig ctx = case sig of
-        L GetRegistryUrl -> do
-            result <- readSystemPath altRegistryUrlPath
-            case result of
-                Nothing -> pure $ ctx $> Nothing
-                Just raw ->
-                    let stripped = T.strip raw
-                    in  case parseUrl stripped of
-                            Left _ -> do
-                                putStrLn @Text $ "Could not parse alternate registry url: " <> stripped
-                                pure $ ctx $> Nothing
-                            Right url -> pure $ ctx $> (Just url)
-        L (PutRegistryUrl url) -> do
-            writeSystemPath altRegistryUrlPath (show url)
-            pure ctx
-        R other -> RegistryUrlIOC $ alg (runRegistryUrlIOC . hdl) other ctx
-    {-# INLINE alg #-}
-
-
-newtype RegistryUrlStateC m a = RegistryUrlStateC { runRegistryUrlStateC :: m a }
-    deriving newtype (Functor, Applicative, Monad, MonadIO)
-instance (Monad m, Has (State (Maybe Url)) sig m) => Algebra (RegistryUrl :+: sig) (RegistryUrlStateC m) where
-    alg hdl sig ctx = case sig of
-        L GetRegistryUrl       -> (ctx $>) <$> get
-        L (PutRegistryUrl url) -> (ctx $>) <$> put (Just url)
-        R other                -> RegistryUrlStateC $ alg (runRegistryUrlStateC . hdl) other ctx
-

agent/src/Lib/Avahi.hs

@@ -1,68 +0,0 @@
-{-# LANGUAGE QuasiQuotes      #-}
-{-# LANGUAGE TypeApplications #-}
-module Lib.Avahi where
-
-import           Startlude               hiding ( (<.>) )
-
-import           Data.String.Interpolate.IsString
-import qualified Data.Text                     as T
-import           System.Directory
-
-import           Lib.Error
-import           Lib.SystemCtl
-import           Lib.SystemPaths
-import           Settings
-
-avahiConf :: Text -> Text
-avahiConf hostname = T.drop 1 $ [i|
-[server]
-host-name=#{hostname}
-domain-name=local
-use-ipv4=yes
-use-ipv6=no
-allow-interfaces=wlan0,eth0
-ratelimit-interval-usec=100000
-ratelimit-burst=1000
-
-[wide-area]
-enable-wide-area=yes
-
-[publish]
-
-[reflector]
-
-[rlimits]
-|]
-
-data WildcardReplacement =
-      WildcardsEnabled
-    | WildcardsDisabled
-    deriving (Eq, Show)
-
-serviceConfig :: (WildcardReplacement, Text) -> Text -> Word16 -> Text
-serviceConfig (wildcards, name) protocol port = T.drop 1 $ [i|
-<?xml version="1.0" standalone='no'?><!--*-nxml-*-->
-<!DOCTYPE service-group SYSTEM "avahi-service.dtd">
-<service-group>
-    <name replace-wildcards=#{show $ bool ("no" :: Text) "yes" (wildcards == WildcardsEnabled) :: Text}>#{name}</name>
-    <service protocol="ipv4">
-        <type>#{protocol}</type>
-        <port>#{port}</port>
-    </service>
-</service-group>|]
-
-createService :: (MonadReader AppSettings m, MonadIO m) => Text -> (WildcardReplacement, Text) -> Text -> Word16 -> m ()
-createService title params proto port = do
-    base <- asks appFilesystemBase
-    liftIO $ writeFile (toS $ avahiServicePath title `relativeTo` base) $ serviceConfig params proto port
-
-createDaemonConf :: Text -> IO ()
-createDaemonConf = writeFile "/etc/avahi/avahi-daemon.conf" . avahiConf
-
-listServices :: IO [FilePath]
-listServices = listDirectory "/etc/avahi/services"
-
-reload :: IO ()
-reload = do
-    ec <- systemCtl RestartService "avahi-daemon"
-    unless (ec == ExitSuccess) $ throwIO . AvahiE $ "systemctl restart avahi-daemon" <> show ec