Create Pulumi-provisioned web server

PulumiWebServer/BashString.fs

@@ -0,0 +1,26 @@
+namespace PulumiWebServer
+
+type BashString =
+    private
+        {
+            Original : string
+            Safe : string
+        }
+
+    override this.ToString () = this.Safe
+
+[<RequireQualifiedAccess>]
+module BashString =
+    let make (s : string) =
+        {
+            Original = s
+            Safe =
+                // This is actually of course not safe, but it's
+                // close enough.
+                if System.Object.ReferenceEquals (s, null) then
+                    null
+                else
+                    s.Replace ("'", "'\"'\"'") |> sprintf "'%s'"
+        }
+
+    let unsafeOriginal (s : BashString) = s.Original

PulumiWebServer/BashString.fsi

@@ -0,0 +1,11 @@
+namespace PulumiWebServer
+
+type BashString
+
+[<RequireQualifiedAccess>]
+module BashString =
+    val make : string -> BashString
+
+    /// Get the original string that was used to make this BashString.
+    /// This is not safe to interpolate into a Bash script.
+    val unsafeOriginal : BashString -> string

PulumiWebServer/Cloudflare.fs

@@ -0,0 +1,122 @@
+namespace PulumiWebServer
+
+open Nager.PublicSuffix
+open Pulumi
+open Pulumi.Cloudflare
+
+[<RequireQualifiedAccess>]
+type ARecord =
+    {
+        IPv4 : Record option
+        IPv6 : Record option
+    }
+
+type Cname =
+    {
+        Source : string
+        Target : string
+        Record : Record
+    }
+
+type DnsRecord =
+    | Cname of Cname
+    | ARecord of ARecord
+
+[<RequireQualifiedAccess>]
+module Cloudflare =
+
+    let getZone (DomainName domain) : Output<ZoneId> =
+        let args = GetZoneInvokeArgs ()
+        args.Name <- domain
+
+        output {
+            let! zone = GetZone.Invoke args
+            return ZoneId zone.ZoneId
+        }
+
+    let makeARecord (zone : string) (name : string) (ipAddress : Address) =
+        let v6 =
+            match ipAddress.IPv6 with
+            | None -> None
+            | Some ipv6Addr ->
+
+                let args = RecordArgs ()
+                args.ZoneId <- Input.lift zone
+                args.Name <- Input.lift name
+                args.Ttl <- Input.lift 60
+                args.Type <- Input.lift "AAAA"
+                args.Value <- Input.lift ipv6Addr
+                Record ($"{name}-ipv6", args) |> Some
+
+        let v4 =
+            match ipAddress.IPv4 with
+            | None -> None
+            | Some ipv4Addr ->
+
+                let args = RecordArgs ()
+                args.ZoneId <- Input.lift zone
+                args.Name <- Input.lift name
+                args.Ttl <- Input.lift 60
+                args.Type <- Input.lift "A"
+                args.Value <- Input.lift ipv4Addr
+                Record ($"{name}-ipv4", args) |> Some
+
+        {
+            ARecord.IPv4 = v4
+            ARecord.IPv6 = v6
+        }
+
+    let addDns
+        (domain : DomainName)
+        (cnames : Map<WellKnownCname, WellKnownCnameTarget>)
+        (subdomains : Set<WellKnownSubdomain>)
+        (ZoneId zone)
+        (ipAddress : Address)
+        : Map<string, DnsRecord>
+        =
+        let globalSubdomain =
+            let (DomainName domain) = domain
+            let parser = DomainParser (WebTldRuleProvider ())
+            let info = parser.Parse domain
+            info.SubDomain |> Option.ofObj
+
+        let subdomainMarker =
+            match globalSubdomain with
+            | None -> ""
+            | Some s -> $".{s}"
+
+        let cnames =
+            cnames
+            |> Map.toSeq
+            |> Seq.map (fun (cname, target) ->
+                let source = $"{cname.ToString ()}{subdomainMarker}"
+                let target = WellKnownCnameTarget.Reify domain target
+                let args = RecordArgs ()
+                args.ZoneId <- Input.lift zone
+                args.Name <- Input.lift source
+                args.Ttl <- Input.lift 60
+                args.Type <- Input.lift "CNAME"
+                args.Value <- Input.lift target
+
+                source,
+                {
+                    Record = Record ($"{cname}{subdomainMarker}-cname", args)
+                    Source = source
+                    Target = target
+                }
+                |> DnsRecord.Cname
+            )
+            |> Seq.toList
+
+        let subdomains =
+            subdomains
+            |> Seq.map (fun subdomainType ->
+                let subdomain = subdomainType.ToString ()
+                subdomain, DnsRecord.ARecord (makeARecord zone $"{subdomain}{subdomainMarker}" ipAddress)
+            )
+            |> Seq.toList
+
+        (domain.ToString (), DnsRecord.ARecord (makeARecord zone (domain.ToString ()) ipAddress))
+        :: cnames
+        @ subdomains
+        |> Map.ofList

PulumiWebServer/Command.fs

@@ -0,0 +1,93 @@
+namespace PulumiWebServer
+
+open System.IO
+open Pulumi
+open Pulumi.Command.Remote
+
+[<RequireQualifiedAccess>]
+module Command =
+
+    let deleteBeforeReplace =
+        CustomResourceOptions (DeleteBeforeReplace = System.Nullable true)
+
+    let createSecretFile (args : CommandArgs) (username : string) (toWrite : BashString) (filePath : string) : unit =
+        if filePath.Contains "'" then
+            failwith $"filepath contained quote: {filePath}"
+
+        if username.Contains "'" then
+            failwith $"username contained quote: {username}"
+
+        let argsString =
+            $"""OLD_UMASK=$(umask) && \
+umask 077 && \
+mkdir -p "$(dirname {filePath})" && \
+echo {toWrite} > '{filePath}' && \
+chown '{username}' '{filePath}' && \
+umask "$OLD_UMASK"
+"""
+
+        args.Create <- Input.ofOutput (Output.CreateSecret argsString)
+        args.Delete <- $"rm -f '{filePath}'"
+
+    let connection (privateKey : FileInfo) (address : Address) =
+        let inputArgs = Inputs.ConnectionArgs ()
+
+        inputArgs.Host <-
+            address.IPv4
+            |> Option.defaultWith (fun () -> Option.get address.IPv6)
+            |> Input.lift
+
+        inputArgs.Port <- Input.lift 22
+        inputArgs.User <- Input.lift "root"
+
+        inputArgs.PrivateKey <- File.ReadAllText privateKey.FullName |> Output.CreateSecret |> Input.ofOutput
+
+        inputArgs |> Output.CreateSecret |> Input.ofOutput
+
+    let contentAddressedCopy
+        (PrivateKey privateKey)
+        (address : Address)
+        (name : string)
+        (trigger : Output<'a>)
+        (targetPath : string)
+        (fileContents : string)
+        : Command
+        =
+        let args = CommandArgs ()
+        args.Connection <- connection privateKey address
+
+        args.Triggers <- trigger |> Output.map (unbox<obj> >> Seq.singleton) |> InputList.ofOutput
+
+        // TODO - do this by passing into stdin instead
+        if targetPath.Contains '\'' || targetPath.Contains '\n' then
+            failwith $"Can't copy a file to a location with a quote mark in, got: {targetPath}"
+
+        let delimiter = "EOF"
+
+        if fileContents.Contains delimiter then
+            failwith "String contained delimiter; please implement something better"
+
+        let commandString =
+            [
+                $"mkdir -p \"$(dirname {targetPath})\" && \\"
+                "{"
+                $"cat <<'{delimiter}'"
+                fileContents
+                delimiter
+                sprintf "} | tee '%s'" targetPath
+            ]
+            |> String.concat "\n"
+            |> Output.CreateSecret
+
+        args.Create <- commandString
+        args.Delete <- $"rm -f '{targetPath}'"
+
+        Command (name, args, deleteBeforeReplace)
+
+    let addToNixFileCommand (args : CommandArgs) (filename : string) : unit =
+        args.Create <-
+            $"""while ! ls /preserve/nixos/configuration.nix; do sleep 5; done
+sed -i '4i\
+    ./{filename}' /preserve/nixos/configuration.nix"""
+
+        args.Delete <- $"""sed -i -n '/{filename}/!p' /preserve/nixos/configuration.nix || exit 0"""

PulumiWebServer/Configuration.fs

@@ -0,0 +1,197 @@
+namespace PulumiWebServer
+
+open System
+open System.Collections.Generic
+open System.IO
+open Newtonsoft.Json
+
+[<NoComparison>]
+type Configuration =
+    {
+        /// Name of this server, as it will be known to Pulumi.
+        /// This isn't e.g. a hostname or anything; it's the key on which Pulumi deduplicates
+        /// different runs of this plan.
+        Name : string
+        /// Private key with which to talk to the server
+        PrivateKey : PrivateKey
+        /// Public key corresponding to the PrivateKey (default has ".pub" appended)
+        PublicKeyOverride : PublicKey option
+        /// Email address to which Let's Encrypt is to send emails
+        AcmeEmail : EmailAddress
+        /// Umbrella domain name for all services
+        Domain : DomainName
+        /// All cnames to be created in DNS
+        Cnames : Map<WellKnownCname, WellKnownCnameTarget>
+        /// All subdomains which are not cnames;
+        /// e.g. (WellKnownSubdomain.Www, "www") would indicate
+        /// the `www.domain.name` address, in the counterfactual
+        /// world where `Www` were implemented as a subdomain
+        /// and not a cname
+        Subdomains : Set<WellKnownSubdomain>
+        /// Linux user to create on the server
+        RemoteUsername : Username
+        GiteaConfig : GiteaConfig option
+        RadicaleConfig : RadicaleConfig option
+    }
+
+    member this.NginxConfig =
+        {
+            Domain = this.Domain
+            WebSubdomain = WellKnownCname.Www
+            AcmeEmail = this.AcmeEmail
+        }
+
+    member this.PublicKey =
+        match this.PublicKeyOverride with
+        | Some k -> k
+        | None ->
+            let (PrivateKey k) = this.PrivateKey
+            Path.Combine (k.Directory.FullName, k.Name + ".pub") |> FileInfo |> PublicKey
+
+[<RequireQualifiedAccess>]
+[<Struct>]
+type SerialisedGiteaConfig =
+    {
+        [<JsonProperty(Required = Required.Always)>]
+        ServerPassword : string
+        [<JsonProperty(Required = Required.Always)>]
+        AdminPassword : string
+        [<JsonProperty(Required = Required.Always)>]
+        AdminUsername : string
+        [<JsonProperty(Required = Required.Always)>]
+        AdminEmailAddress : string
+    }
+
+    static member Make (config : GiteaConfig) =
+        {
+            SerialisedGiteaConfig.ServerPassword = config.ServerPassword |> BashString.unsafeOriginal
+            AdminPassword = config.AdminPassword |> BashString.unsafeOriginal
+            AdminUsername = config.AdminUsername |> BashString.unsafeOriginal
+            AdminEmailAddress = config.AdminEmailAddress |> BashString.unsafeOriginal
+        }
+
+    static member Deserialise (config : SerialisedGiteaConfig) : GiteaConfig =
+        {
+            GiteaConfig.ServerPassword = config.ServerPassword |> BashString.make
+            AdminPassword = config.AdminPassword |> BashString.make
+            AdminUsername = config.AdminUsername |> BashString.make
+            AdminEmailAddress = config.AdminEmailAddress |> BashString.make
+        }
+
+[<RequireQualifiedAccess>]
+[<Struct>]
+type SerialisedRadicaleConfig =
+    {
+        [<JsonProperty(Required = Required.Always)>]
+        User : string
+        [<JsonProperty(Required = Required.Always)>]
+        Password : string
+        [<JsonProperty(Required = Required.DisallowNull)>]
+        GitEmail : string
+    }
+
+    static member Make (config : RadicaleConfig) =
+        {
+            SerialisedRadicaleConfig.User = config.User
+            Password = config.Password
+            GitEmail = config.GitEmail |> Option.toObj
+        }
+
+    static member Deserialise (c : SerialisedRadicaleConfig) : RadicaleConfig =
+        {
+            RadicaleConfig.User = c.User
+            Password = c.Password
+            GitEmail = c.GitEmail |> Option.ofObj
+        }
+
+[<NoComparison>]
+[<RequireQualifiedAccess>]
+type SerialisedConfig =
+    {
+        [<JsonProperty(Required = Required.Always)>]
+        Name : string
+        /// Path to private key
+        [<JsonProperty(Required = Required.Always)>]
+        PrivateKey : string
+        /// Path to public key
+        [<JsonProperty(Required = Required.DisallowNull)>]
+        PublicKey : string
+        [<JsonProperty(Required = Required.Always)>]
+        AcmeEmail : string
+        [<JsonProperty(Required = Required.Always)>]
+        Domain : string
+        [<JsonProperty(Required = Required.Always)>]
+        Cnames : Dictionary<string, string>
+        [<JsonProperty(Required = Required.DisallowNull)>]
+        Subdomains : string[]
+        [<JsonProperty(Required = Required.Always)>]
+        RemoteUsername : string
+        GiteaConfig : Nullable<SerialisedGiteaConfig>
+        RadicaleConfig : Nullable<SerialisedRadicaleConfig>
+    }
+
+    static member Make (config : Configuration) =
+        {
+            SerialisedConfig.PrivateKey = let (PrivateKey p) = config.PrivateKey in p.FullName
+            Name = config.Name
+            PublicKey =
+                match config.PublicKeyOverride with
+                | None -> null
+                | Some (PublicKey p) -> p.FullName
+            AcmeEmail = config.AcmeEmail.ToString ()
+            Domain = config.Domain.ToString ()
+            Cnames =
+                config.Cnames
+                |> Map.toSeq
+                |> Seq.map (fun (cname, target) ->
+                    KeyValuePair (cname.ToString (), WellKnownCnameTarget.Serialise target)
+                )
+                |> Dictionary
+            Subdomains = config.Subdomains |> Seq.map (fun sub -> sub.ToString ()) |> Seq.toArray
+            RemoteUsername = config.RemoteUsername.ToString ()
+            GiteaConfig = config.GiteaConfig |> Option.map SerialisedGiteaConfig.Make |> Option.toNullable
+            RadicaleConfig =
+                config.RadicaleConfig
+                |> Option.map SerialisedRadicaleConfig.Make
+                |> Option.toNullable
+        }
+
+    static member Deserialise (config : SerialisedConfig) : Configuration =
+        {
+            Configuration.PrivateKey = FileInfo config.PrivateKey |> PrivateKey
+            Name = config.Name
+            PublicKeyOverride =
+                match config.PublicKey with
+                | null -> None
+                | key -> FileInfo key |> PublicKey |> Some
+            AcmeEmail = config.AcmeEmail |> EmailAddress
+            Domain = config.Domain |> DomainName
+            Cnames =
+                config.Cnames
+                |> Seq.map (fun (KeyValue (cname, target)) ->
+                    WellKnownCname.Parse cname, WellKnownCnameTarget.Deserialise target
+                )
+                |> Map.ofSeq
+            Subdomains =
+                match config.Subdomains with
+                | null -> Set.empty
+                | subdomains -> subdomains |> Seq.map WellKnownSubdomain.Parse |> Set.ofSeq
+            RemoteUsername = config.RemoteUsername |> Username
+            GiteaConfig =
+                config.GiteaConfig
+                |> Option.ofNullable
+                |> Option.map SerialisedGiteaConfig.Deserialise
+            RadicaleConfig =
+                config.RadicaleConfig
+                |> Option.ofNullable
+                |> Option.map SerialisedRadicaleConfig.Deserialise
+        }
+
+[<RequireQualifiedAccess>]
+module Configuration =
+
+    let get (configFile : Stream) : Configuration =
+        use reader = new StreamReader (configFile)
+
+        JsonConvert.DeserializeObject<SerialisedConfig> (reader.ReadToEnd ())
+        |> SerialisedConfig.Deserialise

PulumiWebServer/DigitalOcean.fs

@@ -0,0 +1,42 @@
+namespace PulumiWebServer
+
+open Pulumi
+open System.IO
+open Pulumi.DigitalOcean
+open Pulumi.DigitalOcean.Outputs
+
+[<RequireQualifiedAccess>]
+module DigitalOcean =
+    let saveSshKey (PublicKey publicKey) : SshKey =
+        let args = SshKeyArgs ()
+        args.PublicKey <- File.ReadAllText publicKey.FullName |> Input.lift
+        SshKey ("default", args)
+
+    let makeNixosServer (name : string) (region : Region) (sshKeys : Input<SshFingerprint>[]) : Output<Droplet> =
+        output {
+            let args =
+                DropletArgs (Name = Input.lift name, Size = InputUnion.liftRight DropletSlug.DropletS1VCPU1GB)
+
+            args.Tags.Add (Input.lift "nixos")
+            args.Image <- "ubuntu-22-04-x64" |> Input.lift
+            args.Monitoring <- Input.lift false
+            args.Backups <- Input.lift false
+            args.Ipv6 <- true
+            args.Region <- InputUnion.liftRight region
+            args.DropletAgent <- Input.lift false
+            args.GracefulShutdown <- Input.lift false
+
+            args.SshKeys.Add (sshKeys |> Array.map (Input.map (fun (SshFingerprint s) -> s)))
+
+            return Droplet (name, args)
+        }
+
+    let storedSshKeys (dep : 'a Output) : Output<GetSshKeysSshKeyResult list> =
+        let args = GetSshKeysInvokeArgs ()
+
+        output {
+            let! _ = dep
+            let! keys = GetSshKeys.Invoke args
+
+            return keys.SshKeys |> Seq.toList |> List.sortBy (fun s -> s.Fingerprint)
+        }

PulumiWebServer/Domain.fs

@@ -0,0 +1,141 @@
+namespace PulumiWebServer
+
+open System.IO
+
+type ZoneId = | ZoneId of string
+
+[<NoComparison ; CustomEquality>]
+type PublicKey =
+    | PublicKey of FileInfo
+
+    override this.Equals (other : obj) =
+        match this, other with
+        | PublicKey this, (:? PublicKey as PublicKey other) -> this.FullName = other.FullName
+        | _, _ -> false
+
+    override this.GetHashCode () =
+        match this with
+        | PublicKey p -> p.FullName.GetHashCode ()
+
+[<NoComparison ; CustomEquality>]
+type PrivateKey =
+    | PrivateKey of FileInfo
+
+    override this.Equals (other : obj) =
+        match this, other with
+        | PrivateKey this, (:? PrivateKey as PrivateKey other) -> this.FullName = other.FullName
+        | _, _ -> false
+
+    override this.GetHashCode () =
+        match this with
+        | PrivateKey p -> p.FullName.GetHashCode ()
+
+type Username =
+    | Username of string
+
+    override this.ToString () =
+        match this with
+        | Username s -> s
+
+type SshFingerprint = | SshFingerprint of string
+
+type SshKey =
+    {
+        PublicKeyContents : string
+        Fingerprint : SshFingerprint
+    }
+
+type EmailAddress =
+    | EmailAddress of string
+
+    override this.ToString () =
+        match this with
+        | EmailAddress s -> s
+
+[<RequireQualifiedAccess>]
+module SshKey =
+    let fingerprint (key : SshKey) = key.Fingerprint
+
+
+type DomainName =
+    | DomainName of string
+
+    override this.ToString () =
+        match this with
+        | DomainName s -> s
+
+type Address =
+    {
+        IPv4 : string option
+        IPv6 : string option
+    }
+
+    member this.Get () =
+        // TODO: default to IPv6 for access
+        match this.IPv4 with
+        | Some v -> v
+        | None ->
+
+            match this.IPv6 with
+            | Some v -> v
+            | None -> failwith "could not get"
+
+    override this.ToString () =
+        let ipv4 =
+            match this.IPv4 with
+            | Some s -> s
+            | None -> ""
+
+        let ipv6 =
+            match this.IPv6 with
+            | Some s -> s
+            | None -> ""
+
+        [ ipv4 ; ipv6 ] |> String.concat " ; "
+
+type WellKnownSubdomain =
+    | Nextcloud
+    | Gitea
+    | Radicale
+
+    override this.ToString () =
+        match this with
+        | Nextcloud -> "nextcloud"
+        | Gitea -> "gitea"
+        | Radicale -> "calendar"
+
+    static member Parse (s : string) =
+        match s with
+        | "nextcloud" -> WellKnownSubdomain.Nextcloud
+        | "gitea" -> WellKnownSubdomain.Gitea
+        | "calendar" -> WellKnownSubdomain.Radicale
+        | _ -> failwith $"Failed to deserialise: {s}"
+
+
+type WellKnownCnameTarget =
+    | Root
+
+    static member Reify (DomainName domain) (target : WellKnownCnameTarget) : string =
+        match target with
+        | WellKnownCnameTarget.Root -> domain
+
+    static member Serialise (t : WellKnownCnameTarget) : string =
+        match t with
+        | WellKnownCnameTarget.Root -> "root"
+
+    static member Deserialise (t : string) : WellKnownCnameTarget =
+        match t with
+        | "root" -> WellKnownCnameTarget.Root
+        | _ -> failwith $"Failed to deserialise: {t}"
+
+type WellKnownCname =
+    | Www
+
+    override this.ToString () =
+        match this with
+        | Www -> "www"
+
+    static member Parse (s : string) =
+        match s with
+        | "www" -> WellKnownCname.Www
+        | _ -> failwith $"Failed to deserialise: {s}"

PulumiWebServer/Gitea.fs

@@ -0,0 +1,90 @@
+namespace PulumiWebServer
+
+open Pulumi
+open Pulumi.Command.Remote
+
+[<RequireQualifiedAccess>]
+type GiteaConfig =
+    {
+        ServerPassword : BashString
+        AdminPassword : BashString
+        AdminUsername : BashString
+        AdminEmailAddress : BashString
+    }
+
+[<RequireQualifiedAccess>]
+module Gitea =
+
+    let private writeConfig
+        (trigger : Output<'a>)
+        (DomainName domain)
+        (privateKey : PrivateKey)
+        (address : Address)
+        (config : GiteaConfig)
+        : Command
+        =
+        let giteaConfig =
+            Utils.getEmbeddedResource typeof<PrivateKey>.Assembly "gitea.nix"
+            |> fun s -> s.Replace ("@@DOMAIN@@", domain)
+            |> fun s -> s.Replace ("@@GITEA_SUBDOMAIN@@", WellKnownSubdomain.Gitea.ToString ())
+            |> fun s -> s.Replace ("@@GITEA_ADMIN_USERNAME@@", config.AdminUsername.ToString ())
+            |> fun s -> s.Replace ("@@GITEA_ADMIN_EMAIL@@", config.AdminEmailAddress.ToString ())
+
+        Command.contentAddressedCopy
+            privateKey
+            address
+            "write-gitea-config"
+            trigger
+            "/preserve/nixos/gitea.nix"
+            giteaConfig
+
+    let private loadConfig<'a>
+        (onChange : Output<'a>)
+        (PrivateKey privateKey as pk)
+        (address : Address)
+        (config : GiteaConfig)
+        : Command list
+        =
+        let loadNix =
+            let args = CommandArgs ()
+
+            args.Triggers <- onChange |> Output.map (unbox<obj> >> Seq.singleton) |> InputList.ofOutput
+
+            args.Connection <- Command.connection privateKey address
+
+            Command.addToNixFileCommand args "gitea.nix"
+
+            Command ("configure-gitea", args, Command.deleteBeforeReplace)
+
+        let writePassword =
+            let args = CommandArgs ()
+            args.Connection <- Command.connection privateKey address
+
+            Command.createSecretFile args "root" config.ServerPassword "/preserve/keys/gitea-db-pass"
+
+            Command ("configure-gitea-password", args, Command.deleteBeforeReplace)
+
+        let writeGiteaUserPassword =
+            let args = CommandArgs ()
+            args.Connection <- Command.connection privateKey address
+
+            Command.createSecretFile args "root" config.AdminPassword "/preserve/keys/gitea-admin-pass"
+
+            Command ("write-gitea-password", args, Command.deleteBeforeReplace)
+
+        [ loadNix ; writePassword ; writeGiteaUserPassword ]
+
+    let configure<'a>
+        (infectNixTrigger : Output<'a>)
+        (domain : DomainName)
+        (privateKey : PrivateKey)
+        (address : Address)
+        (config : GiteaConfig)
+        : Module
+        =
+        let writeConfig = writeConfig infectNixTrigger domain privateKey address config
+
+        {
+            WriteConfigFile = writeConfig
+            EnableConfig = loadConfig writeConfig.Stdout privateKey address config
+        }

PulumiWebServer/Htpasswd.fs

@@ -0,0 +1,34 @@
+namespace PulumiWebServer
+
+open System.Diagnostics
+
+[<RequireQualifiedAccess>]
+module Htpasswd =
+
+    /// Return the contents of an htpasswd file
+    let generate (username : string) (password : string) : string =
+        let args = ProcessStartInfo ()
+        args.FileName <- "htpasswd"
+        args.RedirectStandardOutput <- true
+        args.RedirectStandardError <- true
+        args.RedirectStandardInput <- true
+        args.UseShellExecute <- false
+        args.Arguments <- $"-n -i -B {username}"
+
+        use p = new Process ()
+        p.StartInfo <- args
+
+        if not <| p.Start () then
+            failwith "failed to start htpasswd"
+
+        p.StandardInput.Write password
+        p.StandardInput.Close ()
+
+        p.WaitForExit ()
+
+        if p.ExitCode = 0 then
+            p.StandardOutput.ReadToEnd ()
+        else
+
+            printfn $"{p.StandardError.ReadToEnd ()}"
+            failwith $"Bad exit code from htpasswd: {p.ExitCode}"

PulumiWebServer/Local.fs

@@ -0,0 +1,19 @@
+namespace PulumiWebServer
+
+open System.Diagnostics
+
+[<RequireQualifiedAccess>]
+module Local =
+    let forgetKey (address : Address) : unit =
+        let address = address.Get ()
+        let psi = ProcessStartInfo "/usr/bin/ssh-keygen"
+        psi.Arguments <- $"-R {address}"
+        psi.RedirectStandardError <- true
+        psi.RedirectStandardOutput <- true
+        psi.UseShellExecute <- false
+        let proc = psi |> Process.Start
+        proc.WaitForExit ()
+        let error = proc.StandardOutput.ReadToEnd ()
+        // We don't expect to have configured SSH yet, so this is fine.
+        if proc.ExitCode <> 0 then
+            failwith $"Unexpectedly failed to forget key: {address} ({proc.ExitCode}). {error}"

PulumiWebServer/Module.fs

@@ -0,0 +1,13 @@
+namespace PulumiWebServer
+
+open Pulumi.Command.Remote
+
+type Module =
+    {
+        /// This is expected to be able to run in parallel with any
+        /// other Module.
+        WriteConfigFile : Command
+        /// This is expected to be able to run in parallel with any
+        /// other Module. TODO actually it's not?
+        EnableConfig : Command list
+    }

PulumiWebServer/Nginx.fs

@@ -0,0 +1,78 @@
+namespace PulumiWebServer
+
+open Pulumi
+open Pulumi.Command.Remote
+
+type NginxConfig =
+    {
+        Domain : DomainName
+        WebSubdomain : WellKnownCname
+        AcmeEmail : EmailAddress
+    }
+
+    member this.Domains =
+        [ this.WebSubdomain ]
+        |> List.map (fun subdomain -> $"%O{subdomain}.{this.Domain}")
+        |> fun subdomains -> this.Domain.ToString () :: subdomains
+
+[<RequireQualifiedAccess>]
+module Nginx =
+
+    let private createNixConfig (config : NginxConfig) : string =
+        let configTemplate =
+            Utils.getEmbeddedResource typeof<NginxConfig>.Assembly "nginx.nix"
+            |> fun s ->
+                s
+                    .Replace("@@DOMAIN@@", config.Domain.ToString ())
+                    .Replace("@@WEBROOT_SUBDOMAIN@@", config.WebSubdomain.ToString ())
+                    .Replace ("@@ACME_EMAIL@@", config.AcmeEmail.ToString ())
+
+        let certConfig =
+            config.Domains
+            |> List.map (fun domain ->
+                [
+                    $"\"{domain}\" ="
+                    "{"
+                    "  server = \"https://acme-v02.api.letsencrypt.org/directory\";"
+                    "};"
+                ]
+                |> String.concat "\n"
+            )
+            |> String.concat "\n"
+
+        configTemplate.Replace ("\"@@DOMAINS@@\"", sprintf "{%s}" certConfig)
+
+    let private loadConfig (onChange : Output<'a>) (PrivateKey privateKey) (address : Address) =
+        let args = CommandArgs ()
+
+        args.Triggers <- InputList.ofOutput<obj> (onChange |> Output.map (unbox<obj> >> Seq.singleton))
+
+        args.Connection <- Command.connection privateKey address
+
+        Command.addToNixFileCommand args "nginx.nix"
+
+        Command ("configure-nginx", args, Command.deleteBeforeReplace)
+
+    let private writeConfig
+        (trigger : Output<'a>)
+        (nginxConfig : NginxConfig)
+        (privateKey : PrivateKey)
+        (address : Address)
+        : Command
+        =
+        let nginx = createNixConfig nginxConfig
+        Command.contentAddressedCopy privateKey address "write-nginx-config" trigger "/preserve/nixos/nginx.nix" nginx
+
+    let configure<'a>
+        (infectNixTrigger : Output<'a>)
+        (privateKey : PrivateKey)
+        (address : Address)
+        (config : NginxConfig)
+        : Module
+        =
+        let writeConfig = writeConfig infectNixTrigger config privateKey address
+
+        {
+            WriteConfigFile = writeConfig
+            EnableConfig = loadConfig writeConfig.Stdout privateKey address |> List.singleton
+        }

PulumiWebServer/Nix/flake.lock

@@ -0,0 +1,64 @@
+{
+  "nodes": {
+    "home-manager": {
+      "inputs": {
+        "nixpkgs": [
+          "nixpkgs"
+        ],
+        "utils": "utils"
+      },
+      "locked": {
+        "lastModified": 1672349765,
+        "narHash": "sha256-Ul3lSGglgHXhgU3YNqsNeTlRH1pqxbR64h+2hM+HtnM=",
+        "owner": "nix-community",
+        "repo": "home-manager",
+        "rev": "dd99675ee81fef051809bc87d67eb07f5ba022e8",
+        "type": "github"
+      },
+      "original": {
+        "owner": "nix-community",
+        "repo": "home-manager",
+        "type": "github"
+      }
+    },
+    "nixpkgs": {
+      "locked": {
+        "lastModified": 1672262501,
+        "narHash": "sha256-ZNXqX9lwYo1tOFAqrVtKTLcJ2QMKCr3WuIvpN8emp7I=",
+        "owner": "NixOS",
+        "repo": "nixpkgs",
+        "rev": "e182da8622a354d44c39b3d7a542dc12cd7baa5f",
+        "type": "github"
+      },
+      "original": {
+        "owner": "NixOS",
+        "ref": "nixos-unstable",
+        "repo": "nixpkgs",
+        "type": "github"
+      }
+    },
+    "root": {
+      "inputs": {
+        "home-manager": "home-manager",
+        "nixpkgs": "nixpkgs"
+      }
+    },
+    "utils": {
+      "locked": {
+        "lastModified": 1667395993,
+        "narHash": "sha256-nuEHfE/LcWyuSWnS8t12N1wc105Qtau+/OdUAjtQ0rA=",
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "rev": "5aed5285a952e0b949eb3ba02c12fa4fcfef535f",
+        "type": "github"
+      },
+      "original": {
+        "owner": "numtide",
+        "repo": "flake-utils",
+        "type": "github"
+      }
+    }
+  },
+  "root": "root",
+  "version": 7
+}

PulumiWebServer/Nix/flake.nix

@@ -0,0 +1,23 @@
+{
+  inputs = {
+    nixpkgs.url = "github:NixOS/nixpkgs/nixos-unstable";
+    home-manager = {
+      url = "github:nix-community/home-manager";
+      inputs.nixpkgs.follows = "nixpkgs";
+    };
+  };
+
+  outputs = {
+    self,
+    nixpkgs,
+    home-manager,
+  }: {
+    nixosConfigurations.nixos-server = nixpkgs.lib.nixosSystem {
+      system = "x86_64-linux";
+      modules = [
+        ./configuration.nix
+      ];
+    };
+    nix.registry.nixpkgs.flake = nixpkgs;
+  };
+}

PulumiWebServer/Nix/gitea.nix

@@ -0,0 +1,115 @@
+{
+  config,
+  pkgs,
+  ...
+}: let
+  port = 3001;
+in {
+  services.gitea = {
+    enable = true;
+    appName = "Gitea";
+    lfs.enable = true;
+    stateDir = "/preserve/gitea";
+    database = {
+      type = "postgres";
+      passwordFile = "/preserve/gitea/gitea-db-pass";
+    };
+    domain = "@@GITEA_SUBDOMAIN@@.@@DOMAIN@@";
+    rootUrl = "https://@@GITEA_SUBDOMAIN@@.@@DOMAIN@@/";
+    httpPort = port;
+    settings = let
+      docutils = pkgs.python37.withPackages (ps:
+        with ps; [
+          docutils
+          pygments
+        ]);
+    in {
+      mailer = {
+        ENABLED = true;
+        FROM = "gitea@" + "@@DOMAIN@@";
+      };
+      service = {
+        REGISTER_EMAIL_CONFIRM = true;
+        DISABLE_REGISTRATION = true;
+        COOKIE_SECURE = true;
+      };
+      "markup.restructuredtext" = {
+        ENABLED = true;
+        FILE_EXTENSIONS = ".rst";
+        RENDER_COMMAND = ''${docutils}/bin/rst2html.py'';
+        IS_INPUT_FILE = false;
+      };
+    };
+  };
+
+  services.postgresql = {
+    enable = true;
+    # TODO: make this use the /preserve mount
+    # dataDir = "/preserve/postgresql/data";
+    authentication = ''
+      local gitea all ident map=gitea-users
+    '';
+    identMap = ''
+      gitea-users gitea gitea
+    '';
+  };
+
+  services.nginx.virtualHosts."@@GITEA_SUBDOMAIN@@.@@DOMAIN@@" = {
+    forceSSL = true;
+    enableACME = true;
+    locations."/" = {
+      proxyPass = "http://localhost:${toString port}/";
+    };
+  };
+
+  systemd.services.gitea-supply-password = {
+    description = "gitea-supply-password";
+    wantedBy = ["gitea.service"];
+    path = [pkgs.gitea];
+    script = ''
+      mkdir -p /preserve/gitea && \
+      chown -R gitea /preserve/gitea && \
+      ln -f /preserve/keys/gitea-admin-pass /preserve/gitea/gitea-admin-pass && \
+      chown gitea /preserve/gitea/gitea-admin-pass && \
+      ln -f /preserve/keys/gitea-db-pass /preserve/gitea/gitea-db-pass && \
+      chown gitea /preserve/gitea/gitea-db-pass
+    '';
+    serviceConfig = {
+      Restart = "no";
+      Type = "oneshot";
+      User = "root";
+      Group = "root";
+    };
+  };
+
+  # The Gitea module does not allow adding users declaratively
+  systemd.services.gitea-add-user = {
+    description = "gitea-add-user";
+    after = ["gitea-supply-password.service"];
+    wantedBy = ["multi-user.target"];
+    path = [pkgs.gitea];
+    script = ''      TMPFILE=$(mktemp)
+      PASSWORD=$(cat /preserve/gitea/gitea-admin-pass)
+      set +e
+      ${pkgs.gitea} migrate -c /preserve/gitea/data/custom/conf/app.ini
+      ${pkgs.gitea}/bin/gitea admin user create --admin --username @@GITEA_ADMIN_USERNAME@@ --password "$PASSWORD" --email @@GITEA_ADMIN_EMAIL@@ 2>"$TMPFILE" 1>"$TMPFILE"
+      EXITCODE=$?
+      if [ $EXITCODE -eq 1 ]; then
+        if grep 'already exists' "$TMPFILE" 2>/dev/null 1>/dev/null; then
+          EXITCODE=0
+        fi
+      fi
+      cat "$TMPFILE"
+      rm "$TMPFILE"
+      exit $EXITCODE
+    '';
+    serviceConfig = {
+      Restart = "no";
+      Type = "oneshot";
+      User = "gitea";
+      Group = "gitea";
+      WorkingDirectory = config.services.gitea.stateDir;
+    };
+    environment = {GITEA_WORK_DIR = config.services.gitea.stateDir;};
+  };
+}

PulumiWebServer/Nix/nginx.nix

@@ -0,0 +1,39 @@
+{...}: let
+  domain = "@@DOMAIN@@";
+in {
+  security.acme.acceptTerms = true;
+  security.acme.defaults.email = "@@ACME_EMAIL@@";
+  security.acme.certs = "@@DOMAINS@@";
+
+  networking.firewall.allowedTCPPorts = [
+    80 # required for the ACME challenge
+    443
+  ];
+
+  services.nginx = {
+    enable = true;
+    recommendedTlsSettings = true;
+    recommendedOptimisation = true;
+    recommendedGzipSettings = true;
+
+    virtualHosts."${domain}" = {
+      globalRedirect = "@@WEBROOT_SUBDOMAIN@@.${domain}";
+      addSSL = true;
+      enableACME = true;
+      root = "/preserve/www/html";
+    };
+
+    virtualHosts."@@WEBROOT_SUBDOMAIN@@.${domain}" = {
+      addSSL = true;
+      enableACME = true;
+      root = "/preserve/www/html";
+      extraConfig = ''
+        location ~* \.(?:ico|css|js|gif|jpe?g|png|woff2)$ {
+            expires 30d;
+            add_header Pragma public;
+            add_header Cache-Control "public";
+        }
+      '';
+    };
+  };
+}

PulumiWebServer/Nix/radicale.nix

@@ -0,0 +1,32 @@
+{pkgs, ...}: let
+  port = 5232;
+  enableGit = true;
+  storage =
+    if enableGit
+    then {
+      hook = "${pkgs.git}/bin/git add -A && (${pkgs.git}/bin/git diff --cached --quiet || ${pkgs.git}/bin/git commit -m 'Changes by '%(user)s)";
+      filesystem_folder = "/preserve/radicale/data";
+    }
+    else {};
+in {
+  services.radicale = {
+    enable = true;
+    settings = {
+      server.hosts = ["0.0.0.0:${toString port}"];
+      auth = {
+        type = "htpasswd";
+        htpasswd_filename = "/preserve/keys/radicale-users";
+        htpasswd_encryption = "bcrypt";
+      };
+      storage = storage;
+    };
+  };
+
+  services.nginx.virtualHosts."@@RADICALE_SUBDOMAIN@@.@@DOMAIN@@" = {
+    forceSSL = true;
+    enableACME = true;
+    locations."/" = {
+      proxyPass = "http://localhost:${toString port}/";
+    };
+  };
+}

PulumiWebServer/Nix/userconfig.nix

@@ -0,0 +1,34 @@
+{pkgs, ...}: {
+  users.mutableUsers = false;
+  users.users."@@USER@@" = {
+    isNormalUser = true;
+    home = "/home/@@USER@@";
+    extraGroups = ["wheel"];
+    openssh.authorizedKeys.keys = ["@@AUTHORIZED_KEYS@@"];
+  };
+
+  security.sudo = {
+    enable = true;
+    extraRules = [
+      {
+        users = ["@@USER@@"];
+        commands = [
+          {
+            command = "ALL";
+            options = ["NOPASSWD"];
+          }
+        ];
+      }
+    ];
+  };
+
+  nix.extraOptions = ''
+    experimental-features = nix-command flakes
+  '';
+
+  environment.systemPackages = [
+    pkgs.vim
+    pkgs.git
+    pkgs.home-manager
+  ];
+}

PulumiWebServer/Program.fs

@@ -0,0 +1,171 @@
+namespace PulumiWebServer
+
+open System
+open Nager.PublicSuffix
+open Pulumi
+open Pulumi.DigitalOcean
+open System.IO
+
+module Program =
+
+    let stripSubdomain (DomainName str) =
+        let parser = DomainParser (WebTldRuleProvider ())
+        let info = parser.Parse str
+        $"{info.Domain}.{info.TLD}" |> DomainName
+
+    let config =
+        use file =
+            FileInfo("/Users/patrick/Documents/GitHub/WebsiteConfig/config.json")
+                .OpenRead ()
+
+        Configuration.get file
+
+    [<EntryPoint>]
+    let main _argv =
+        fun () ->
+            output {
+                let! existingKeys = DigitalOcean.storedSshKeys (Output.Create "")
+
+                let keyContents =
+                    let (PublicKey file) = config.PublicKey
+                    File.ReadAllText file.FullName
+
+                let key =
+                    existingKeys
+                    |> Seq.filter (fun key -> key.PublicKey = keyContents)
+                    |> Seq.tryHead
+
+                let key =
+                    match key with
+                    | None -> (DigitalOcean.saveSshKey config.PublicKey).Name
+                    | Some key -> Output.Create key.Name
+
+                let! keys =
+                    DigitalOcean.storedSshKeys key
+                    |> Output.map (
+                        Seq.map (fun s ->
+                            {
+                                Fingerprint = SshFingerprint s.Fingerprint
+                                PublicKeyContents = s.PublicKey
+                            }
+                        )
+                        >> Seq.sort
+                        >> Array.ofSeq
+                    )
+
+                let! droplet =
+                    keys
+                    |> Array.map (SshKey.fingerprint >> Input.lift)
+                    |> DigitalOcean.makeNixosServer "server-staging" Region.LON1
+
+                let! ipv4 = droplet.Ipv4Address
+                let! ipv6 = droplet.Ipv6Address
+
+                let address =
+                    {
+                        IPv4 = Option.ofObj ipv4
+                        IPv6 = Option.ofObj ipv6
+                    }
+
+                let! zone = Cloudflare.getZone (stripSubdomain config.Domain)
+
+                let dns =
+                    Cloudflare.addDns config.Domain config.Cnames config.Subdomains zone address
+
+                let! _ = Server.waitForReady config.PrivateKey address
+
+                let deps =
+                    let dnsDeps =
+                        dns
+                        |> Map.toList
+                        |> List.collect (fun (_, record) ->
+                            match record with
+                            | DnsRecord.ARecord record -> [ record.IPv4 ; record.IPv6 ]
+                            | DnsRecord.Cname _ -> []
+                        )
+                        |> List.choose id
+                        |> List.map (fun record -> record.Urn)
+
+                    dnsDeps |> Output.sequence |> Output.map (String.concat ",")
+
+                let! _ = deps
+
+                let infectNix = Server.infectNix config.PrivateKey address
+                let! _ = infectNix.Stdout
+
+                // The nixos rebuild has blatted the known public key.
+                Local.forgetKey address
+                let! _ = Server.waitForReady config.PrivateKey address
+
+                let initialSetupModules =
+                    [
+                        yield Server.configureUser infectNix.Stdout config.RemoteUsername keys config.PrivateKey address
+                        yield! Server.writeFlake infectNix.Stdout config.PrivateKey address
+                    ]
+
+                let! _ =
+                    initialSetupModules
+                    |> Seq.map (fun m -> m.WriteConfigFile.Stdout)
+                    |> Output.sequence
+                // Load the configuration
+                let setup =
+                    initialSetupModules
+                    |> Seq.map (fun m ->
+                        m.EnableConfig
+                        |> Seq.map (fun c -> c.Stdout)
+                        |> Output.sequence
+                        |> Output.map (String.concat "\n---\n")
+                    )
+                    |> Output.sequence
+                    |> Output.map (String.concat "\n===\n")
+
+                let rebuild = Server.nixRebuild 0 setup config.PrivateKey address
+                let! _ = rebuild.Stdout
+
+                // If this is a new node, reboot
+                let firstReboot = Server.reboot "post-infect" droplet.Urn config.PrivateKey address
+                let! _ = firstReboot.Stdout
+
+                let! _ = Server.waitForReady config.PrivateKey address
+
+                let copyPreserve = Server.copyPreserve config.PrivateKey address
+                let! _ = copyPreserve.Stdout
+
+                let modules =
+                    [
+                        Nginx.configure copyPreserve.Stdout config.PrivateKey address config.NginxConfig
+                        |> Some
+                        config.GiteaConfig
+                        |> Option.map (Gitea.configure copyPreserve.Stdout config.Domain config.PrivateKey address)
+                        config.RadicaleConfig
+                        |> Option.map (Radicale.configure copyPreserve.Stdout config.Domain config.PrivateKey address)
+                    ]
+                    |> List.choose id
+
+                let configFiles =
+                    modules |> Seq.map (fun m -> m.WriteConfigFile.Stdout) |> Output.sequence
+
+                // Wait for the config files to be written
+                let! _ = configFiles
+
+                // Load the configuration
+                let modules =
+                    modules
+                    |> Seq.map (fun m ->
+                        m.EnableConfig
+                        |> Seq.map (fun c -> c.Stdout)
+                        |> Output.sequence
+                        |> Output.map (String.concat "\n---\n")
+                    )
+                    |> Output.sequence
+                    |> Output.map (String.concat "\n===\n")
+
+                let rebuild = Server.nixRebuild 1 modules config.PrivateKey address
+                let! _ = rebuild.Stdout
+
+                return ()
+            }
+            |> ignore
+        |> Deployment.RunAsync
+        |> Async.AwaitTask
+        |> Async.RunSynchronously

PulumiWebServer/Pulumi.dev.yaml

@@ -0,0 +1,5 @@
+config:
+  cloudflare:apiToken:
+    secure: AAABAOaQPcYG4jCFbYYr6r0dqR2f5csiAulm+GGu6EZeR1pVgqoVKUOHK3hmlW+FYUcXvnhs9Rpd9tQ15dIkplJdOp/2CEgv
+  digitalocean:token:
+    secure: AAABAAnqEO15oRMrB/9nBZaz+9ZLqo+OLz0k23QQFCS8eFgM45sGrUQIPoeCSWJ/tq+AThr8wjhe3qU6PJWxRD+zpLSHS2E/y+EH1o9WyPCi0eXeFY3uttp5ToDiVbCDiyCNVtUBwQ==

PulumiWebServer/Pulumi.fs

@@ -0,0 +1,67 @@
+namespace Pulumi
+
+open Pulumi
+
+[<RequireQualifiedAccess>]
+module Input =
+
+    let lift<'a> (x : 'a) : 'a Input = Input.op_Implicit x
+    let ofOutput<'a> (x : 'a Output) : 'a Input = Input.op_Implicit x
+    let map<'a, 'b> (f : 'a -> 'b) (x : Input<'a>) : Input<'b> = x.Apply f |> ofOutput
+
+[<RequireQualifiedAccess>]
+module Output =
+
+    let map<'a, 'b> (f : 'a -> 'b) (x : 'a Output) : 'b Output = x.Apply f
+
+    let sequence<'a> (xs : 'a Output seq) : 'a list Output =
+        let func (o : 'a list Output) (x : 'a Output) : 'a list Output =
+            o.Apply<'a list> (fun o -> x.Apply<'a list> (fun x -> x :: o))
+
+        xs |> Seq.fold func (Output.Create []) |> map List.rev
+
+type OutputEvaluator<'ret> =
+    abstract Eval<'a> : Output<'a> -> 'ret
+
+type OutputCrate =
+    abstract Apply<'ret> : OutputEvaluator<'ret> -> 'ret
+
+[<RequireQualifiedAccess>]
+module OutputCrate =
+    let make<'a> (o : Output<'a>) =
+        { new OutputCrate with
+            member _.Apply e = e.Eval o
+        }
+
+    // Yuck but this is the type signature we need for consumption by Pulumi
+    let sequence (xs : OutputCrate seq) : obj list Output =
+        let func (o : obj list Output) (x : OutputCrate) : obj list Output =
+            { new OutputEvaluator<_> with
+                member _.Eval<'a> (x : 'a Output) =
+                    o.Apply<obj list> (fun o -> x.Apply<obj list> (fun x -> unbox<obj> x :: o))
+            }
+            |> x.Apply
+
+        xs |> Seq.fold func (Output.Create []) |> Output.map List.rev
+
+[<RequireQualifiedAccess>]
+module InputList =
+    let ofOutput<'a> (x : 'a seq Output) : 'a InputList = InputList.op_Implicit x
+
+    let lift<'a> (x : 'a seq) : 'a InputList =
+        x |> Seq.toArray |> InputList.op_Implicit
+
+[<RequireQualifiedAccess>]
+module InputUnion =
+    let liftLeft<'a, 'b> (x : 'a) : InputUnion<'a, 'b> = InputUnion.op_Implicit x
+
+    let liftRight<'a, 'b> (x : 'b) : InputUnion<'a, 'b> = InputUnion.op_Implicit x
+
+type OutputComputation () =
+    member _.Bind (x : Output<'a>, f : 'a -> Output<'b>) : Output<'b> = x.Apply<'b> f
+    member _.Return (x : 'a) : Output<'a> = Output.Create<'a> x
+    member _.ReturnFrom (x : 'a Output) = x
+
+[<AutoOpen>]
+module ComputationExpressions =
+    let output = OutputComputation ()

PulumiWebServer/Pulumi.staging.yaml

@@ -0,0 +1,5 @@
+config:
+  cloudflare:apiToken:
+    secure: AAABAK391jNLL3SDyFJBn/mBEdcZ7tUyJhwrRsdrHvckN+GzrBw5CJq4+ftaRRSIZEObTd/3wPFmoxcqgmIsiGAEBjHqLGak
+  digitalocean:token:
+    secure: AAABAIypnl37QdxXkzb8LIQvB26ncgvEjf8NgGx+KNe4rzJACTVCvvkxsf2lWG8Zf9uY2PO6WLk4qjIS6Mgm2SdQkEM1HgL2BYxyK+OGPNKb/ks9Dlw+TnkIZRVILyYlyqE7e5DRvg==

PulumiWebServer/Pulumi.yaml

@@ -0,0 +1,4 @@
+name: PulumiWebServer
+description: Pulumi configuration for my personal web server
+runtime:
+  name: dotnet

PulumiWebServer/PulumiWebServer.fsproj

@@ -0,0 +1,44 @@
+<Project Sdk="Microsoft.NET.Sdk">
+
+    <PropertyGroup>
+        <TargetFramework>net7.0</TargetFramework>
+        <OutputType>Exe</OutputType>
+    </PropertyGroup>
+
+    <ItemGroup>
+        <PackageReference Include="Nager.PublicSuffix" Version="2.4.0" />
+        <PackageReference Include="Newtonsoft.Json" Version="13.0.1" />
+        <PackageReference Include="Pulumi" Version="3.37.2" />
+        <PackageReference Include="Pulumi.Cloudflare" Version="4.9.0" />
+        <PackageReference Include="Pulumi.Command" Version="0.4.1" />
+        <PackageReference Include="Pulumi.DigitalOcean" Version="4.14.0" />
+    </ItemGroup>
+
+    <ItemGroup>
+      <Compile Include="Domain.fs" />
+      <Compile Include="Utils.fs" />
+      <Compile Include="Htpasswd.fs" />
+      <Compile Include="BashString.fsi" />
+      <Compile Include="BashString.fs" />
+      <Compile Include="Pulumi.fs" />
+      <Compile Include="Module.fs" />
+      <Compile Include="Command.fs" />
+      <Compile Include="Cloudflare.fs" />
+      <Compile Include="DigitalOcean.fs" />
+      <Compile Include="Nginx.fs" />
+      <Compile Include="Server.fs" />
+      <Compile Include="Gitea.fs" />
+      <Compile Include="Radicale.fs" />
+      <Compile Include="Local.fs" />
+      <Compile Include="Configuration.fs" />
+      <Compile Include="Program.fs" />
+      <EmbeddedResource Include="Nix\nginx.nix" />
+      <EmbeddedResource Include="Nix\userconfig.nix" />
+      <EmbeddedResource Include="Nix\gitea.nix" />
+      <EmbeddedResource Include="Nix\radicale.nix" />
+      <EmbeddedResource Include="Nix\flake.nix" />
+      <EmbeddedResource Include="Nix\flake.lock" />
+      <Content Include="config.schema.json" />
+    </ItemGroup>
+    
+</Project>

PulumiWebServer/Radicale.fs

@@ -0,0 +1,122 @@
+namespace PulumiWebServer
+
+open Pulumi
+open Pulumi.Command.Remote
+
+type RadicaleConfig =
+    {
+        /// The user who will log in to the CalDAV server
+        User : string
+        /// The password for the user when they log in to the CalDAV server
+        Password : string
+        /// The email address for the Git user, if we are going to set up Git versioning.
+        GitEmail : string option
+    }
+
+[<RequireQualifiedAccess>]
+module Radicale =
+
+    let private loadConfig<'a>
+        (onChange : Output<'a>)
+        (PrivateKey privateKey as pk)
+        (address : Address)
+        (config : RadicaleConfig)
+        : Command list
+        =
+        let loadNix =
+            let args = CommandArgs ()
+
+            args.Triggers <- onChange |> Output.map (unbox<obj> >> Seq.singleton) |> InputList.ofOutput
+
+            args.Connection <- Command.connection privateKey address
+
+            Command.addToNixFileCommand args "radicale.nix"
+
+            Command ("configure-radicale", args, Command.deleteBeforeReplace)
+
+        let createUser = Server.createUser pk address (BashString.make "radicale")
+
+        let writePassword =
+            let password = Htpasswd.generate config.User config.Password |> BashString.make
+
+            let args = CommandArgs ()
+            args.Connection <- Command.connection privateKey address
+
+            args.Triggers <- createUser.Stdout |> Output.map (box >> Seq.singleton) |> InputList.ofOutput
+
+            Command.createSecretFile args "root" password "/preserve/keys/radicale-users"
+
+            Command ("configure-radicale-user", args, Command.deleteBeforeReplace)
+
+        let writeGit =
+            match config.GitEmail with
+            | None -> []
+            | Some gitEmail ->
+                let writeGitConfig =
+                    $"""[user]
+  email = "%s{gitEmail}"
+  name = "radicale"
+"""
+                    |> Command.contentAddressedCopy
+                        pk
+                        address
+                        "radicale-gitconfig"
+                        onChange
+                        "/preserve/radicale/data/.git/config"
+
+                let writeGitIgnore =
+                    """.Radicale.cache
+.Radicale.lock
+.Radicale.tmp-*"""
+                    |> Command.contentAddressedCopy
+                        pk
+                        address
+                        "radicale-gitignore"
+                        onChange
+                        "/preserve/radicale/data/.gitignore"
+
+                [ writeGitConfig ; writeGitIgnore ]
+
+        [ yield loadNix ; yield writePassword ; yield! writeGit ]
+
+    let private writeConfig
+        (enableGit : bool)
+        (trigger : Output<'a>)
+        (DomainName domain)
+        (privateKey : PrivateKey)
+        (address : Address)
+        : Command
+        =
+        let radicaleConfig =
+            Utils.getEmbeddedResource typeof<PrivateKey>.Assembly "radicale.nix"
+            |> fun s -> s.Replace ("@@DOMAIN@@", domain)
+            |> fun s -> s.Replace ("@@RADICALE_SUBDOMAIN@@", WellKnownSubdomain.Radicale.ToString ())
+            |> fun s ->
+                if not enableGit then
+                    s.Replace ("enableGit = true", "enableGit = false")
+                else
+                    s
+
+        Command.contentAddressedCopy
+            privateKey
+            address
+            "write-radicale-config"
+            trigger
+            "/preserve/nixos/radicale.nix"
+            radicaleConfig
+
+    let configure
+        (infectNixTrigger : Output<'a>)
+        (domain : DomainName)
+        (privateKey : PrivateKey)
+        (address : Address)
+        (config : RadicaleConfig)
+        : Module
+        =
+        let writeConfig =
+            writeConfig config.GitEmail.IsSome infectNixTrigger domain privateKey address
+
+        {
+            WriteConfigFile = writeConfig
+            EnableConfig = loadConfig writeConfig.Stdout privateKey address config
+        }

PulumiWebServer/Server.fs

@@ -0,0 +1,176 @@
+namespace PulumiWebServer
+
+open System
+open System.Diagnostics
+open Pulumi
+open Pulumi.Command.Remote
+
+[<RequireQualifiedAccess>]
+module Server =
+
+    let createUser (PrivateKey privateKey) (address : Address) (name : BashString) =
+        let args = CommandArgs ()
+        args.Connection <- Command.connection privateKey address
+
+        args.Create <- $"useradd --no-create-home --no-user-group {name} 2>/dev/null 1>/dev/null || echo {name}"
+
+        Command ($"create-user-{name}", args)
+
+    let rec waitForReady (PrivateKey privateKey as pk) (address : Address) : Output<unit> =
+        output {
+            let psi = ProcessStartInfo "/usr/bin/ssh"
+
+            psi.Arguments <-
+                $"root@{address.Get ()} -o ConnectTimeout=5 -o IdentityFile={privateKey.FullName} -o StrictHostKeyChecking=off echo hello"
+
+            psi.RedirectStandardError <- true
+            psi.RedirectStandardOutput <- true
+            psi.UseShellExecute <- false
+            let proc = psi |> Process.Start
+            proc.WaitForExit ()
+            let output = proc.StandardOutput.ReadToEnd ()
+            let error = proc.StandardOutput.ReadToEnd ()
+            // We don't expect to have configured SSH yet, so this is fine.
+            if proc.ExitCode = 0 && output.StartsWith "hello" then
+                // For some reason /usr/bin/ssh can get in at this point even though Pulumi cannot :(
+                // error: ssh: handshake failed: ssh: unable to authenticate, attempted methods [none publickey], no supported methods remain
+
+                System.Threading.Thread.Sleep (TimeSpan.FromSeconds 10.0)
+                return ()
+            else
+                printfn $"Sleeping due to: {proc.ExitCode} {error}"
+                System.Threading.Thread.Sleep (TimeSpan.FromSeconds 5.0)
+                return! waitForReady pk address
+        }
+
+    let infectNix (PrivateKey privateKey) (address : Address) =
+        let args = CommandArgs ()
+        args.Connection <- Command.connection privateKey address
+
+        // IMPORTANT NOTE: do not inline this script. It is licensed under the GPL, so we
+        // must invoke it without "establishing intimate communication" with it.
+        // https://www.gnu.org/licenses/gpl-faq.html#GPLPlugins
+        args.Create <-
+            """if ! ls /run/current-system 1>/dev/null; then
+    curl https://raw.githubusercontent.com/elitak/nixos-infect/318fc516d1d87410fd06178331a9b2939b9f2fef/nixos-infect > /tmp/infect.sh || exit 1
+    while ! NO_REBOOT=1 PROVIDER=digitalocean NIX_CHANNEL=nixos-22.05 bash /tmp/infect.sh 2>&1 1>/tmp/infect.log; do
+      sleep 5;
+    done
+fi && mkdir -p /preserve/nixos && cp /etc/nixos/* /preserve/nixos && touch /preserve/ready.txt && date"""
+
+        Command ("nix-infect", args)
+
+    let writeFlake (trigger : Output<'a>) (privateKey : PrivateKey) (address : Address) =
+        let flakeFile = Utils.getEmbeddedResource typeof<PrivateKey>.Assembly "flake.nix"
+        let flakeLock = Utils.getEmbeddedResource typeof<PrivateKey>.Assembly "flake.lock"
+
+        [
+            {
+                WriteConfigFile =
+                    Command.contentAddressedCopy
+                        privateKey
+                        address
+                        "write-flake"
+                        trigger
+                        "/preserve/nixos/flake.nix"
+                        flakeFile
+                EnableConfig = []
+            }
+            {
+                WriteConfigFile =
+                    Command.contentAddressedCopy
+                        privateKey
+                        address
+                        "write-flake-lock"
+                        trigger
+                        "/preserve/nixos/flake.lock"
+                        flakeLock
+                EnableConfig = []
+            }
+        ]
+
+    let private writeUserConfig
+        (trigger : Output<'a>)
+        (keys : SshKey seq)
+        (Username username)
+        (privateKey : PrivateKey)
+        (address : Address)
+        : Command
+        =
+        let keys =
+            keys
+            |> Seq.collect (fun k -> k.PublicKeyContents.Split '\n')
+            |> Seq.filter (not << String.IsNullOrEmpty)
+
+        let userConfig =
+            Utils.getEmbeddedResource typeof<PrivateKey>.Assembly "userconfig.nix"
+            |> fun s ->
+                s
+                    .Replace("@@AUTHORIZED_KEYS@@", keys |> String.concat "\" \"")
+                    .Replace ("@@USER@@", username)
+
+        Command.contentAddressedCopy
+            privateKey
+            address
+            "write-user-config"
+            trigger
+            "/preserve/nixos/userconfig.nix"
+            userConfig
+
+    let private loadUserConfig (onChange : Output<'a>) (PrivateKey privateKey) (address : Address) =
+        let args = CommandArgs ()
+
+        args.Triggers <- onChange |> Output.map (unbox<obj> >> Seq.singleton) |> InputList.ofOutput
+
+        args.Connection <- Command.connection privateKey address
+
+        Command.addToNixFileCommand args "userconfig.nix"
+
+        Command ("configure-users", args, Command.deleteBeforeReplace)
+
+    let configureUser<'a>
+        (infectNixTrigger : Output<'a>)
+        (remoteUser : Username)
+        (keys : SshKey seq)
+        (privateKey : PrivateKey)
+        (address : Address)
+        : Module
+        =
+        let writeConfig =
+            writeUserConfig infectNixTrigger keys remoteUser privateKey address
+
+        {
+            WriteConfigFile = writeConfig
+            EnableConfig = loadUserConfig writeConfig.Stdout privateKey address |> List.singleton
+        }
+
+    let nixRebuild (counter : int) (onChange : Output<'a>) (PrivateKey privateKey) (address : Address) =
+        let args = CommandArgs ()
+        args.Connection <- Command.connection privateKey address
+        // The rebuild fails with exit code 1, indicating that we need to restart. This is fine.
+        args.Create <-
+            // TODO /nix/var/nix/profiles/system/sw/bin/nixos-rebuild might do it
+            "$(find /nix/store -type f -name nixos-rebuild | head -1) switch --flake /preserve/nixos#nixos-server || exit 0"
+
+        args.Triggers <- onChange |> Output.map (unbox<obj> >> Seq.singleton) |> InputList.ofOutput
+
+        Command ($"nixos-rebuild-{counter}", args)
+
+    let reboot (stage : string) (onChange : Output<'a>) (PrivateKey privateKey) (address : Address) =
+        let args = CommandArgs ()
+        args.Connection <- Command.connection privateKey address
+
+        args.Triggers <- InputList.ofOutput<obj> (onChange |> Output.map (unbox<obj> >> Seq.singleton))
+
+        args.Create <-
+            "while ! ls /preserve/ready.txt ; do sleep 10; done && rm -f /preserve/ready.txt && shutdown -r now"
+
+        Command ($"reboot-{stage}", args)
+
+    let copyPreserve (PrivateKey privateKey) (address : Address) =
+        let args = CommandArgs ()
+        args.Connection <- Command.connection privateKey address
+
+        args.Create <- "mkdir /preserve && cp -ar /old-root/preserve/nixos /preserve/nixos"
+
+        Command ("copy-preserve", args)

PulumiWebServer/Utils.fs

@@ -0,0 +1,16 @@
+namespace PulumiWebServer
+
+open System.IO
+open System.Reflection
+
+[<RequireQualifiedAccess>]
+module Utils =
+    let getEmbeddedResource (assembly : Assembly) (name : string) : string =
+        use s =
+            assembly.GetManifestResourceNames ()
+            |> Seq.filter (fun s -> s.EndsWith name)
+            |> Seq.exactlyOne
+            |> assembly.GetManifestResourceStream
+            |> fun s -> new StreamReader (s)
+
+        s.ReadToEnd ()

PulumiWebServer/config.schema.json

@@ -0,0 +1,114 @@
+{
+  "$schema": "http://json-schema.org/draft-04/schema#",
+  "title": "SerialisedConfig",
+  "type": "object",
+  "additionalProperties": false,
+  "required": [
+    "name",
+    "privateKey",
+    "acmeEmail",
+    "domain",
+    "cnames",
+    "remoteUsername"
+  ],
+  "properties": {
+    "name": {
+      "type": "string"
+    },
+    "privateKey": {
+      "type": "string"
+    },
+    "publicKey": {
+      "type": "string"
+    },
+    "acmeEmail": {
+      "type": "string"
+    },
+    "domain": {
+      "type": "string"
+    },
+    "cnames": {
+      "type": "object",
+      "additionalProperties": {
+        "type": "string"
+      }
+    },
+    "subdomains": {
+      "type": "array",
+      "items": {
+        "type": "string"
+      }
+    },
+    "remoteUsername": {
+      "type": "string"
+    },
+    "giteaConfig": {
+      "oneOf": [
+        {
+          "type": "null"
+        },
+        {
+          "$ref": "#/definitions/SerialisedGiteaConfig"
+        }
+      ]
+    },
+    "radicaleConfig": {
+      "oneOf": [
+        {
+          "type": "null"
+        },
+        {
+          "$ref": "#/definitions/SerialisedRadicaleConfig"
+        }
+      ]
+    }
+  },
+  "definitions": {
+    "SerialisedGiteaConfig": {
+      "type": "object",
+      "additionalProperties": false,
+      "required": [
+        "serverPassword",
+        "adminPassword",
+        "adminUsername",
+        "adminEmailAddress"
+      ],
+      "properties": {
+        "serverPassword": {
+          "type": "string"
+        },
+        "adminPassword": {
+          "type": "string"
+        },
+        "adminUsername": {
+          "type": "string"
+        },
+        "adminEmailAddress": {
+          "type": "string"
+        }
+      }
+    },
+    "SerialisedRadicaleConfig": {
+      "type": "object",
+      "additionalProperties": false,
+      "required": [
+        "user",
+        "password"
+      ],
+      "properties": {
+        "user": {
+          "type": "string"
+        },
+        "password": {
+          "type": "string"
+        },
+        "gitEmail": {
+          "type": [
+            "null",
+            "string"
+          ]
+        }
+      }
+    }
+  }
+}