Device pairing from XML

module devicePairing

import nanyx/encoding

-- Extracting a device-pairing payload from an XML element. The two kinds of
-- registration are told apart by a tag, and `proc` collects the required
-- sub-elements, failing as a whole if any is missing.

type Element = (
  name: string
  attrs: map(string, string)
  children: list(Element)
  text: string
)

def Element.subtag: (Element, string) -> #some(Element) | #notFound = { el, name ->
  el.children \find { .name == name }
}

def Element.subtagText: (Element, string) -> #some(string) | #notFound = { el, name ->
  el \subtag(name) \Option.map { .text }
}

def Element.subtagBinary: (Element, string) -> #some(Binary) | #notFound = { el, name ->
  el \subtagText(name) \Option.map(Base64.decode)
}

def Element.attr: (Element, string) -> #some(string) | #notFound = { el, name -> el.attrs(name) }

-- A missing required element is an extraction failure
def required: (#some(a) | #notFound) -> #some(a) | #error(#extractionFailed) = {
  | #some(value) -> #some(value)
  | #notFound -> #error(#extractionFailed)
}

type CompanionRegistration = (
  pubKey: string
  ref: Binary
  deviceIdentity?: string
  keyIndexList?: Binary
  keyIndexListTs?: int
  refCert?: Binary
)

type TrustCircleOnboarding = (
  appId: int
  authKey: string
  deviceIdentity: string
  famDeviceId: Binary
  keyIndexList: Binary
  keyIndexListTs: int
  ref: Binary
)

export type Payload =
  | #companion(CompanionRegistration)
  | #trustCircle(TrustCircleOnboarding)

export type Context = #companionRegistration | #trustCircleOnboarding

def keyIndexListTs: Element -> #some(int) | #notFound = { el ->
  el \subtag("key_index_list") \Option.then { .attr("ts") } \Option.then(Int.parse)
}

export def extractPairDevicePayload: (Element, Context) -> #some(Payload) | #error(#extractionFailed) = {
  | el, #companionRegistration -> proc {
      def pubKey = try required(el \subtagText("pub_key"))
      def ref = try required(el \subtagBinary("ref"))

      -- The remaining elements are optional: a missing one becomes `#none`
      def deviceIdentity = el \subtagText("device_identity") except #notFound -> #none
      def keyIndexList = el \subtagBinary("key_index_list") except #notFound -> #none
      def ts = keyIndexListTs(el) except #notFound -> #none
      def refCert = el \subtagBinary("ref_cert") except #notFound -> #none

      return #companion(CompanionRegistration(
        pubKey = pubKey
        ref = ref
        deviceIdentity = deviceIdentity
        keyIndexList = keyIndexList
        keyIndexListTs = ts
        refCert = refCert
      ))
    }

  | el, #trustCircleOnboarding -> proc {
      return #trustCircle(TrustCircleOnboarding(
        appId = try required(el \subtagText("app_id") \Option.then(Int.parse))
        authKey = try required(el \subtagText("auth_key"))
        deviceIdentity = try required(el \subtagText("device_identity"))
        famDeviceId = try required(el \subtagBinary("fam_device_id"))
        keyIndexList = try required(el \subtagBinary("key_index_list"))
        keyIndexListTs = try required(keyIndexListTs(el))
        ref = try required(el \subtagBinary("ref"))
      ))
    }
}

-- Building the reply --------------------------------------------------------

def element: (string, list(Element)) -> Element = { name, children ->
  Element(name = name, attrs = [], children = children, text = "")
}

def textElement: (string, string) -> Element = { name, text ->
  Element(name = name, attrs = [], children = [], text = text)
}

export def pairSuccessReply: (deviceId: string, Payload) -> Element = { deviceId, payload ->
  def device = Element(name = "device", attrs = ["id" => deviceId], children = [], text = "")

  def identity =
    match payload
      | #companion(c) -> c.deviceIdentity \Option.map { id -> textElement("device_identity", id) }
      | #trustCircle(t) -> #some(textElement("device_identity", t.deviceIdentity))

  element("pair_success", [device, ...(identity \Option.toList)])
}

This program lives in the repository as examples/pairing.nyx.