-- SPDX-License-Identifier: CC0-1.0

let Genode = env:DHALL_GENODE

let Prelude = Genode.Prelude

let XML = Prelude.XML

let Init = Genode.Init

let Child = Init.Child

let Resources = Init.Resources

let ServiceRoute = Init.ServiceRoute

let Vfs/inline =
        λ(name : Text)
      → λ(body : Text)
      → XML.element
          { name = "inline"
          , attributes = toMap { name = name }
          , content = [ XML.text body ]
          }

let label =
        λ(label : Text)
      → { local = label, route = label } : Child.Attributes.Label

let routeLogRom =
      λ(label : Text) → ServiceRoute.parentLabel "ROM" (Some "log") (Some label)

let Params/Type =
      { vdiFilename : Text
      , vdiUuid : Text
      , memorySize : Natural
      , vmName : Text
      }

let rootInit =
        λ(params : Params/Type)
      → Init::{
        , routes = [ ServiceRoute.child "Timer" "timer" ]
        , verbose = True
        , children = toMap
            { timer =
                Child.flat
                  Child.Attributes::{
                  , binary = "timer_drv"
                  , provides = [ "Timer" ]
                  }
            , rtc =
                Child.flat
                  Child.Attributes::{
                  , binary = "rtc_drv"
                  , provides = [ "Rtc" ]
                  , routes =
                    [ ServiceRoute.parent "IO_PORT"
                    , ServiceRoute.parent "IO_MEM"
                    ]
                  }
            , acpi_drv =
                Child.flat
                  Child.Attributes::{
                  , binary = "acpi_drv"
                  , priority = 1
                  , resources = Resources::{
                    , caps = 350
                    , ram = Genode.units.MiB 4
                    }
                  , romReports = [ label "acpi", label "smbios_table" ]
                  , routes = [ ServiceRoute.parent "IO_MEM" ]
                  }
            , platform_drv =
                Child.flat
                  Child.Attributes::{
                  , binary = "platform_drv"
                  , resources = Resources::{
                    , caps = 400
                    , ram = Genode.units.MiB 4
                    , constrainPhys = True
                    }
                  , reportRoms = [ label "acpi" ]
                  , romReports = [ label "pci" ]
                  , provides = [ "Acpi", "Platform" ]
                  , routes =
                    [ ServiceRoute.parent "IRQ"
                    , ServiceRoute.parent "IO_MEM"
                    , ServiceRoute.parent "IO_PORT"
                    , ServiceRoute.parentLabel
                        "ROM"
                        (Some "system")
                        (Some "system")
                    ]
                  , config = Init.Config::{
                    , attributes = toMap { system = "yes" }
                    , content =
                        let PciPolicy/Type =
                              { labelSuffix : Text, pciClass : Text }

                        in    [ XML.text
                                  ''
                                  <report pci="yes"/>
                                  <policy label_suffix="ps2_drv">
                                    <device name="PS2"/>
                                  </policy>
                                  <policy label_suffix="intel_fb_drv">
                                    <pci class="VGA"/>
                                    <pci bus="0" device="0" function="0"/>
                                    <pci class="ISABRIDGE"/>
                                  </policy>
                                  <policy label_suffix="audio">
                                    <pci class="AUDIO"/>
                                    <pci class="HDAUDIO"/>
                                  </policy>
                                  <policy label="acpica"/>
                                  ''
                              ]
                            # Prelude.List.map
                                PciPolicy/Type
                                XML.Type
                                (   λ(policy : PciPolicy/Type)
                                  → XML.element
                                      { name = "policy"
                                      , attributes = toMap
                                          { label_suffix = policy.labelSuffix }
                                      , content =
                                        [ XML.leaf
                                            { name = "pci"
                                            , attributes = toMap
                                                { class = policy.pciClass }
                                            }
                                        ]
                                      }
                                )
                                [ { labelSuffix = "ahci_drv"
                                  , pciClass = "AHCI"
                                  }
                                , { labelSuffix = "nic_drv"
                                  , pciClass = "ETHERNET"
                                  }
                                , { labelSuffix = "usb_drv", pciClass = "USB" }
                                , { labelSuffix = "vesa_fb_drv"
                                  , pciClass = "VGA"
                                  }
                                ]
                    }
                  }
            , framebuffer =
                Child.flat
                  Child.Attributes::{
                  , binary = "vesa_fb_drv"
                  , provides = [ "Framebuffer" ]
                  , resources = Init.Resources::{
                    , caps = 256
                    , ram = Genode.units.MiB 48
                    }
                  , routes =
                    [ ServiceRoute.parent "IO_MEM"
                    , ServiceRoute.parent "IO_PORT"
                    , ServiceRoute.childLabel
                        "Platform"
                        "platform_drv"
                        (None Text)
                        (Some "vesa_fb_drv")
                    ]
                  }
            , ps2_drv =
                Child.flat
                  Child.Attributes::{
                  , binary = "ps2_drv"
                  , provides = [ "Input" ]
                  , routes =
                    [ ServiceRoute.childLabel
                        "Platform"
                        "platform_drv"
                        (None Text)
                        (Some "ps2_drv")
                    ]
                  }
            , nitpicker =
                Child.flat
                  Child.Attributes::{
                  , binary = "nitpicker"
                  , config = Init.Config::{
                    , content =
                      [ XML.text
                          ''
                          <domain name="pointer" layer="1" content="client" label="no" origin="pointer" />
                          <domain name="default" layer="2" content="client" label="yes" hover="always" focus="click"/>
                          <domain name="log" layer="3" content="client" label="yes" hover="always"/>
                          <policy label_prefix="pointer" domain="pointer"/>
                          <policy label_prefix="log" domain="log"/>
                          <default-policy domain="default"/>
                           ''
                      ]
                    }
                  , provides = [ "Nitpicker" ]
                  , resources = Resources::{
                    , caps = 256
                    , ram = Genode.units.MiB 64
                    }
                  , routes =
                    [ ServiceRoute.child "Framebuffer" "framebuffer"
                    , ServiceRoute.child "Input" "ps2_drv"
                    ]
                  }
            , pointer =
                Child.flat
                  Child.Attributes::{
                  , binary = "pointer"
                  , provides = [ "Report" ]
                  , routes = [ ServiceRoute.child "Nitpicker" "nitpicker" ]
                  }
            , nit_fb =
                Child.flat
                  Child.Attributes::{
                  , binary = "nit_fb"
                  , config = Init.Config::{
                    , attributes = toMap { width = "600", height = "768" }
                    }
                  , provides = [ "Framebuffer", "Input" ]
                  , resources = Resources::{ ram = Genode.units.MiB 8 }
                  , routes =
                    [ ServiceRoute.childLabel
                        "Nitpicker"
                        "nitpicker"
                        (None Text)
                        (Some "log")
                    ]
                  }
            , terminal =
                Child.flat
                  Child.Attributes::{
                  , binary = "terminal"
                  , provides = [ "Terminal" ]
                  , resources = Resources::{
                    , caps = 256
                    , ram = Genode.units.MiB 4
                    }
                  , routes =
                    [ ServiceRoute.child "Framebuffer" "nit_fb"
                    , ServiceRoute.child "Input" "nit_fb"
                    ]
                  , config = Init.Config::{
                    , content =
                      [ Prelude.XML.text
                          ''
                          <vfs>
                          	<rom name="Inconsolata.ttf"/>
                          	<dir name="fonts">
                          		<dir name="monospace">
                          			<ttf name="regular" path="/Inconsolata.ttf" size_px="10"/>
                          		</dir>
                          	</dir>
                          </vfs>
                          ''
                      ]
                    }
                  }
            , terminal_log =
                Child.flat
                  Child.Attributes::{
                  , binary = "terminal_log"
                  , provides = [ "LOG" ]
                  , routes = [ ServiceRoute.child "Terminal" "terminal" ]
                  }
            , log_core =
                Child.flat
                  Child.Attributes::{
                  , binary = "log_core"
                  , routes =
                    [ routeLogRom "core_log"
                    , ServiceRoute.childLabel
                        "LOG"
                        "terminal_log"
                        (Some "log")
                        (Some "core")
                    ]
                  }
            , log_kernel =
                Child.flat
                  Child.Attributes::{
                  , binary = "log_core"
                  , routes =
                    [ routeLogRom "kernel_log"
                    , ServiceRoute.childLabel
                        "LOG"
                        "terminal_log"
                        (Some "log")
                        (Some "kernel")
                    ]
                  }
            , nic_drv =
                Child.flat
                  Child.Attributes::{
                  , binary = "ipxe_nic_drv"
                  , provides = [ "Nic" ]
                  , resources = Init.Resources::{
                    , caps = 128
                    , ram = Genode.units.MiB 4
                    }
                  , routes =
                    [ ServiceRoute.childLabel
                        "Platform"
                        "platform_drv"
                        (None Text)
                        (Some "nic_drv")
                    ]
                  }
            , vbox =
                let vboxConfig =
                      ''
                      <VirtualBox xmlns="http://www.virtualbox.org/" version="1.14-freebsd">
                        <Machine uuid="{37ab43a5-38d8-4491-93f5-5b0b077f5c32}" name="ubuntu_16_04_64" OSType="Ubuntu_64" snapshotFolder="Snapshots" lastStateChange="2018-01-23T18:40:00Z">
                          <MediaRegistry>
                            <HardDisks>
                              <HardDisk uuid="{${params.vdiUuid}}" location="${params.vdiFilename}" format="VDI" type="Normal"/>
                            </HardDisks>
                            <DVDImages>
                            </DVDImages>
                          </MediaRegistry>
                          <Hardware>
                            <CPU count="2">
                              <PAE enabled="true"/>
                              <LongMode enabled="true"/>
                              <HardwareVirtExLargePages enabled="false"/>
                            </CPU>
                            <Memory RAMSize="${Prelude.Natural.show
                                                 params.memorySize}"/>
                            <HID Pointing="USBTablet"/>
                            <Display VRAMSize="20"/>
                            <RemoteDisplay enabled="false"/>
                            <BIOS>
                              <IOAPIC enabled="true"/>
                            </BIOS>
                            <USB>
                              <Controllers>
                              </Controllers>
                            </USB>
                            <Network>
                              <Adapter slot="0" enabled="true" MACAddress="0800271D7901" cable="true" type="82540EM">
                                <BridgedInterface/>
                              </Adapter>
                            </Network>
                            <UART>
                              <Port slot="0" enabled="false" IOBase="0x3f8" IRQ="4" hostMode="Disconnected"/>
                              <Port slot="1" enabled="false" IOBase="0x2f8" IRQ="3" hostMode="Disconnected"/>
                            </UART>
                            <LPT>
                              <Port slot="0" enabled="false" IOBase="0x378" IRQ="7"/>
                              <Port slot="1" enabled="false" IOBase="0x378" IRQ="7"/>
                            </LPT>
                            <AudioAdapter controller="HDA" driver="OSS" enabled="false"/>
                            <RTC localOrUTC="UTC"/>
                            <SharedFolders>
                            </SharedFolders>
                          </Hardware>
                          <StorageControllers>
                            <StorageController name="SATA" type="AHCI" PortCount="4" useHostIOCache="true" Bootable="true" IDE0MasterEmulationPort="0" IDE0SlaveEmulationPort="1" IDE1MasterEmulationPort="2" IDE1SlaveEmulationPort="3">
                              <AttachedDevice type="HardDisk" port="0" device="0">
                                <Image uuid="{${params.vdiUuid}}"/>
                              </AttachedDevice>
                            </StorageController>
                          </StorageControllers>
                        </Machine>
                      </VirtualBox>
                      ''

                in  Child.flat
                      Child.Attributes::{
                      , binary = "virtualbox5-nova"
                      , config = Init.Config::{
                        , attributes = toMap
                            { vbox_file = "machine.vbox"
                            , vm_name = "linux"
                            , xhci = "no"
                            }
                        , content =
                          [ XML.leaf
                              { name = "libc"
                              , attributes = toMap
                                  { stdout = "/dev/log"
                                  , stderr = "/dev/log"
                                  , rtc = "/dev/rtc"
                                  }
                              }
                          , XML.element
                              { name = "vfs"
                              , attributes = XML.emptyAttributes
                              , content =
                                  let tag =
                                          λ(name : Text)
                                        → XML.leaf
                                            { name = name
                                            , attributes = XML.emptyAttributes
                                            }

                                  in  [ Vfs/inline "machine.vbox" vboxConfig
                                      , XML.element
                                          { name = "dir"
                                          , attributes = toMap { name = "dev" }
                                          , content = [ tag "log", tag "rtc" ]
                                          }
                                      , XML.element
                                          { name = "dir"
                                          , attributes = toMap { name = "nix" }
                                          , content =
                                            [ XML.element
                                                { name = "dir"
                                                , attributes = toMap
                                                    { name = "store" }
                                                , content =
                                                  [ XML.leaf
                                                      { name = "ram"
                                                      , attributes = toMap
                                                          { writeable = "no"
                                                          , label = "nix"
                                                          }
                                                      }
                                                  ]
                                                }
                                            ]
                                          }
                                      , XML.leaf
                                          { name = "ram"
                                          , attributes = toMap
                                              { writeable = "yes" }
                                          }
                                      ]
                              }
                          ]
                        }
                      , resources = Resources::{
                        , caps = 1024
                        , ram =
                              Genode.units.MiB 64
                            + Genode.units.MiB params.memorySize
                        }
                      , routes =
                        [ ServiceRoute.parent "VM"
                        , ServiceRoute.child "Nitpicker" "nitpicker"
                        , ServiceRoute.child "File_system" "chroot"
                        , ServiceRoute.child "Nic" "nic_drv"
                        , ServiceRoute.child "Rtc" "rtc"
                        , ServiceRoute.child "Report" "pointer"
                        , ServiceRoute.parentLabel
                            "ROM"
                            (Some "platform_info")
                            (Some "platform_info")
                        ]
                      }
            }
        }

in  rootInit