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 Policy = Init.Config.Policy

let DefaultPolicy = Init.Config.DefaultPolicy

let LabelSelector = Init.LabelSelector

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

let rootInit =
      λ ( params
        : { fbDriver : Init.Child.Type
          , guests : Init.Children.Type
          , inputFilterChargens : List XML.Type
          , partitionType : Text
          , wm : Init.Type
          , graphical-log : Init.Type
          , fs-log : Init.Type
          , systemLabel : Text
          }
        ) →
        Init::{
        , 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 = params.fbDriver
            , event_filter =
                Child.flat
                  Child.Attributes::{
                  , binary = "event_filter"
                  , config =
                      let key =
                            λ(name : Text) →
                              XML.leaf
                                { name = "key", attributes = toMap { name } }

                      let remap =
                            λ(name : Text) →
                            λ(to : Text) →
                              XML.leaf
                                { name = "key"
                                , attributes = toMap { name, to }
                                }

                      in  Init.Config::{
                          , content =
                            [ XML.leaf
                                { name = "input"
                                , attributes = toMap { label = "ps2" }
                                }
                            , XML.leaf
                                { name = "input"
                                , attributes = toMap { label = "usb" }
                                }
                            , XML.element
                                { name = "output"
                                , attributes = XML.emptyAttributes
                                , content =
                                  [ XML.element
                                      { name = "chargen"
                                      , attributes = XML.emptyAttributes
                                      , content =
                                            [ XML.element
                                                { name = "remap"
                                                , attributes =
                                                    XML.emptyAttributes
                                                , content =
                                                  [ remap
                                                      "KEY_LEFTMETA"
                                                      "KEY_SCREEN"
                                                  , XML.element
                                                      { name = "merge"
                                                      , attributes =
                                                          XML.emptyAttributes
                                                      , content =
                                                        [ XML.leaf
                                                            { name = "input"
                                                            , attributes = toMap
                                                                { name = "ps2" }
                                                            }
                                                        , XML.leaf
                                                            { name = "input"
                                                            , attributes = toMap
                                                                { name = "usb" }
                                                            }
                                                        ]
                                                      }
                                                  ]
                                                }
                                            , XML.element
                                                { name = "mod1"
                                                , attributes =
                                                    XML.emptyAttributes
                                                , content =
                                                  [ key "KEY_LEFTSHIFT"
                                                  , key "KEY_RIGHTSHIFT"
                                                  ]
                                                }
                                            , XML.element
                                                { name = "mod2"
                                                , attributes =
                                                    XML.emptyAttributes
                                                , content =
                                                  [ key "KEY_LEFTCTRL"
                                                  , key "KEY_RIGHTCTRL"
                                                  ]
                                                }
                                            , XML.element
                                                { name = "mod3"
                                                , attributes =
                                                    XML.emptyAttributes
                                                , content =
                                                  [ key "KEY_RIGHTALT" ]
                                                }
                                            ]
                                          # params.inputFilterChargens
                                      }
                                  ]
                                }
                            ]
                          }
                  , provides = [ "Input" ]
                  , routes =
                    [ ServiceRoute.parentLabel
                        "ROM"
                        (Some "config")
                        (Some "config -> event_filter.config")
                    , ServiceRoute.childLabel
                        "Input"
                        "ps2_drv"
                        (Some "ps2")
                        (None Text)
                    , ServiceRoute.childLabel
                        "Input"
                        "usb_drv"
                        (Some "usb")
                        (None Text)
                    , ServiceRoute.child "Capture" "nitpicker"
                    ]
                  }
            , ps2_drv =
                Child.flat
                  Child.Attributes::{
                  , binary = "ps2_drv"
                  , provides = [ "Input" ]
                  , routes =
                    [ ServiceRoute.childLabel
                        "Platform"
                        "platform_drv"
                        (None Text)
                        (Some "ps2_drv")
                    ]
                  }
            , usb_drv =
                Child.flat
                  Child.Attributes::{
                  , binary = "usb_drv"
                  , config = Init.Config::{
                    , attributes = toMap
                        { uhci = "yes"
                        , ohci = "yes"
                        , ehci = "yes"
                        , xhci = "yes"
                        , bios_handoff = "yes"
                        }
                    , content =
                      [ XML.leaf
                          { name = "hid", attributes = XML.emptyAttributes }
                      ]
                    }
                  , provides = [ "Input" ]
                  , resources = Init.Resources::{
                    , caps = 128
                    , ram = Genode.units.MiB 12
                    }
                  , routes =
                    [ ServiceRoute.childLabel
                        "Platform"
                        "platform_drv"
                        (None Text)
                        (Some "usb_drv")
                    ]
                  }
            , wm =
                Init.toChild
                  params.wm
                  Init.Attributes::{
                  , provides = [ "Capture", "Event", "Gui", "Report", "ROM" ]
                  , romReports = [ label "clipboard", label "shape" ]
                  , routes =
                    [ ServiceRoute.child "Framebuffer" "framebuffer"
                    , ServiceRoute.child "Input" "event_filter"
                    ]
                  }
            , fonts_fs =
                Child.flat
                  Child.Attributes::{
                  , binary = "vfs"
                  , config = Init.Config::{
                    , content =
                      [ XML.element
                          { name = "vfs"
                          , attributes = XML.emptyAttributes
                          , content =
                            [ XML.leaf
                                { name = "rom"
                                , attributes = toMap
                                    { name = "Inconsolata.ttf" }
                                }
                            , XML.element
                                { name = "dir"
                                , attributes = toMap { name = "fonts" }
                                , content =
                                  [ XML.element
                                      { name = "dir"
                                      , attributes = toMap { name = "title" }
                                      , content =
                                        [ XML.leaf
                                            { name = "ttf"
                                            , attributes = toMap
                                                { name = "regular"
                                                , path = "/Inconsolata.ttf"
                                                , size_px = "12"
                                                }
                                            }
                                        ]
                                      }
                                  , XML.element
                                      { name = "dir"
                                      , attributes = toMap { name = "text" }
                                      , content =
                                        [ XML.leaf
                                            { name = "ttf"
                                            , attributes = toMap
                                                { name = "regular"
                                                , path = "/Inconsolata.ttf"
                                                , size_px = "12"
                                                }
                                            }
                                        ]
                                      }
                                  , XML.element
                                      { name = "dir"
                                      , attributes = toMap
                                          { name = "annotation" }
                                      , content =
                                        [ XML.leaf
                                            { name = "ttf"
                                            , attributes = toMap
                                                { name = "regular"
                                                , path = "/Inconsolata.ttf"
                                                , size_px = "12"
                                                }
                                            }
                                        ]
                                      }
                                  , XML.element
                                      { name = "dir"
                                      , attributes = toMap
                                          { name = "monospace" }
                                      , content =
                                        [ XML.leaf
                                            { name = "ttf"
                                            , attributes = toMap
                                                { name = "regular"
                                                , path = "/Inconsolata.ttf"
                                                , size_px = "12"
                                                }
                                            }
                                        ]
                                      }
                                  ]
                                }
                            ]
                          }
                      ]
                    , defaultPolicy = Some DefaultPolicy::{
                      , attributes = toMap { root = "/fonts" }
                      }
                    }
                  , provides = [ "File_system" ]
                  , resources = Init.Resources::{
                    , caps = 256
                    , ram = Genode.units.MiB 12
                    }
                  , routes = [ ServiceRoute.child "Block" "block_router" ]
                  }
            , graphical-log =
                Init.toChild
                  params.graphical-log
                  Init.Attributes::{
                  , routes =
                    [ ServiceRoute.child "Gui" "wm"
                    , ServiceRoute.child "File_system" "fonts_fs"
                    ]
                  }
            , fs-log =
                Init.toChild
                  params.fs-log
                  Init.Attributes::{
                  , routes =
                    [ ServiceRoute.childLabel
                        "File_system"
                        "chroot"
                        (None Text)
                        (Some "dump")
                    ]
                  }
            , rom_to_file =
                Child.flat
                  Child.Attributes::{
                  , binary = "rom_to_file"
                  , config = Init.Config::{
                    , attributes = toMap { rom = "init.config" }
                    }
                  , routes =
                    [ ServiceRoute.childLabel
                        "File_system"
                        "chroot"
                        (None Text)
                        (Some "dump")
                    , ServiceRoute.parentLabel
                        "ROM"
                        (Some "init.config")
                        (Some "config")
                    ]
                  }
            , block =
                Child.flat
                  Child.Attributes::{
                  , binary = "ahci_drv"
                  , config = Init.Config::{
                    , defaultPolicy = Some DefaultPolicy::{
                      , attributes = toMap { device = "0", writeable = "yes" }
                      }
                    }
                  , provides = [ "Block" ]
                  , resources = Init.Resources::{
                    , caps = 256
                    , ram = Genode.units.MiB 10
                    }
                  , routes =
                    [ ServiceRoute.childLabel
                        "Platform"
                        "platform_drv"
                        (None Text)
                        (Some "ahci_drv")
                    ]
                  }
            , block_partitions =
                Child.flat
                  Child.Attributes::{
                  , binary = "part_block"
                  , config = Init.Config::{
                    , content =
                          Prelude.List.map
                            Natural
                            XML.Type
                            ( λ(i : Natural) →
                                XML.leaf
                                  { name = "policy"
                                  , attributes =
                                      let partition =
                                            Prelude.Natural.show (i + 1)

                                      in  toMap
                                            { label_suffix = " ${partition}"
                                            , partition
                                            , writeable = "yes"
                                            }
                                  }
                            )
                            (Prelude.Natural.enumerate 128)
                        # [ XML.leaf
                              { name = "report"
                              , attributes = toMap { partitions = "yes" }
                              }
                          ]
                    }
                  , resources = Resources::{
                    , caps = 256
                    , ram = Genode.units.MiB 8
                    }
                  , provides = [ "Block" ]
                  , routes =
                    [ ServiceRoute.child "Block" "block"
                    , ServiceRoute.child "Report" "block_router"
                    ]
                  }
            , block_router =
                Child.flat
                  Child.Attributes::{
                  , binary = "block_router"
                  , config = Init.Config::{
                    , attributes = toMap { verbose = "yes" }
                    , content =
                      [ XML.element
                          { name = "default-policy"
                          , attributes = XML.emptyAttributes
                          , content =
                            [ XML.leaf
                                { name = "partition"
                                , attributes = toMap
                                    { type = params.partitionType
                                    , writeable = "yes"
                                    }
                                }
                            ]
                          }
                      ]
                    }
                  , resources = Resources::{
                    , caps = 256
                    , ram = Genode.units.MiB 8
                    }
                  , provides = [ "Block", "Report" ]
                  , routes = [ ServiceRoute.child "Block" "block_partitions" ]
                  }
            , file_system =
                Child.flat
                  Child.Attributes::{
                  , binary = "vfs"
                  , config = Init.Config::{
                    , content =
                      [ XML.element
                          { name = "vfs"
                          , attributes = XML.emptyAttributes
                          , content =
                            [ XML.element
                                { name = "dir"
                                , attributes = toMap { name = "ext2" }
                                , content =
                                  [ XML.leaf
                                      { name = "rump"
                                      , attributes = toMap
                                          { fs = "ext2fs"
                                          , writeable = "yes"
                                          , ram = "8M"
                                          }
                                      }
                                  ]
                                }
                            ]
                          }
                      ]
                    , policies =
                      [ Policy::{
                        , label = LabelSelector.suffix "nix/store"
                        , attributes = toMap
                            { root = "/ext2/nix/store", writeable = "no" }
                        }
                      , Policy::{
                        , label = LabelSelector.prefix "chroot"
                        , attributes = toMap
                            { root = "/ext2", writeable = "yes", path = "/" }
                        }
                      , Policy::{
                        , label = LabelSelector.prefix "init -> console"
                        , attributes = toMap { root = "/", writeable = "yes" }
                        }
                      ]
                    }
                  , provides = [ "File_system" ]
                  , resources = Init.Resources::{
                    , caps = 256
                    , ram = Genode.units.MiB 12
                    }
                  , routes = [ ServiceRoute.child "Block" "block_router" ]
                  }
            , chroot =
                Child.flat
                  Child.Attributes::{
                  , binary = "chroot"
                  , config = Init.Config::{
                    , policies =
                      [ Policy::{
                        , label = LabelSelector.label "dump"
                        , attributes = toMap
                            { path = params.systemLabel, writeable = "yes" }
                        }
                      ]
                    , defaultPolicy = Some DefaultPolicy::{
                      , attributes = toMap { writeable = "yes" }
                      }
                    }
                  , provides = [ "File_system" ]
                  , routes = [ ServiceRoute.child "File_system" "file_system" ]
                  }
            , 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")
                    ]
                  }
            , nic_router =
                Child.flat
                  Child.Attributes::{
                  , binary = "nic_router"
                  , config = Init.Config::{
                    , content =
                      [ XML.leaf
                          { name = "uplink"
                          , attributes = toMap { domain = "uplink" }
                          }
                      , XML.element
                          { name = "domain"
                          , attributes = toMap { name = "uplink" }
                          , content =
                            [ XML.leaf
                                { name = "nat"
                                , attributes = toMap
                                    { domain = "default"
                                    , tcp-ports = "1024"
                                    , udp-ports = "1024"
                                    , icmp-ids = "1024"
                                    }
                                }
                            ]
                          }
                      , XML.element
                          { name = "domain"
                          , attributes = toMap
                              { name = "default", interface = "10.0.1.1/24" }
                          , content =
                                [ XML.leaf
                                    { name = "dhcp-server"
                                    , attributes = toMap
                                        { ip_first = "10.0.1.2"
                                        , ip_last = "10.0.1.200"
                                        , dns_server_from = "uplink"
                                        }
                                    }
                                ]
                              # Prelude.List.map
                                  Text
                                  XML.Type
                                  ( λ(proto : Text) →
                                      XML.element
                                        { name = proto
                                        , attributes = toMap
                                            { dst = "0.0.0.0/0"
                                            , domain = "uplink"
                                            }
                                        , content =
                                          [ XML.leaf
                                              { name = "permit-any"
                                              , attributes = toMap
                                                  { domain = "uplink" }
                                              }
                                          ]
                                        }
                                  )
                                  [ "tcp", "udp", "icmp" ]
                          }
                      ]
                    , defaultPolicy = Some DefaultPolicy::{
                      , attributes = toMap { domain = "default" }
                      }
                    }
                  , provides = [ "Nic" ]
                  , resources = Init.Resources::{ ram = Genode.units.MiB 8 }
                  , routes = [ ServiceRoute.child "Nic" "nic_drv" ]
                  }
            , init =
                Init.toChild
                  Init::{ children = params.guests }
                  Init.Attributes::{
                  , routes =
                    [ ServiceRoute.parent "VM"
                    , ServiceRoute.child "Gui" "wm"
                    , { service =
                        { name = "File_system"
                        , label = LabelSelector.last "fonts"
                        }
                      , route =
                          Init.Route.Type.Child
                            { name = "fonts_fs"
                            , label = None Text
                            , diag = None Bool
                            }
                      }
                    , { service =
                        { name = "File_system"
                        , label = LabelSelector.suffix "nix/store"
                        }
                      , route =
                          Init.Route.Type.Child
                            { name = "file_system"
                            , label = Some "nix/store"
                            , diag = None Bool
                            }
                      }
                    , { service =
                        { name = "File_system"
                        , label = LabelSelector.prefix "console"
                        }
                      , route =
                          Init.Route.Type.Child
                            { name = "file_system"
                            , label = None Text
                            , diag = None Bool
                            }
                      }
                    , ServiceRoute.child "File_system" "chroot"
                    , ServiceRoute.child "Nic" "nic_router"
                    , ServiceRoute.child "Rtc" "rtc"
                    , ServiceRoute.parentLabel
                        "ROM"
                        (Some "platform_info")
                        (Some "platform_info")
                    , ServiceRoute.child "Report" "_report_rom"
                    ]
                  }
            }
        , routes = [ ServiceRoute.child "Timer" "timer" ]
        }

in  rootInit