[MOD] DBA: Allow password update for admin user

(:~
 : Users page.
 :
 : @author Christian Grün, BaseX Team, 2014-16
 :)
module namespace _ = 'dba/jobs-users';

import module namespace Sessions = 'http://basex.org/modules/sessions';
import module namespace Session = 'http://basex.org/modules/session';
import module namespace cons = 'dba/cons' at '../modules/cons.xqm';
import module namespace html = 'dba/html' at '../modules/html.xqm';
import module namespace tmpl = 'dba/tmpl' at '../modules/tmpl.xqm';
import module namespace util = 'dba/util' at '../modules/util.xqm';

(:~ Top category :)
declare variable $_:CAT := 'jobs-users';

(:~
 : Jobs and users page.
 : @param  $sort   table sort key
 : @param  $error  error message
 : @param  $info   info message
 : @return page
 :)
declare
  %rest:GET
  %rest:path("/dba/jobs-users")
  %rest:query-param("sort", "{$sort}", "")
  %rest:query-param("error", "{$error}")
  %rest:query-param("info",  "{$info}")
  %output:method("html")
function _:jobs-users(
  $sort   as xs:string,
  $error  as xs:string?,
  $info   as xs:string?
) as element() {
  cons:check(),

  (: request data in a single step :)
  let $data := try {
    util:eval('element result {
      element users { user:list-details() },
      element sessions { admin:sessions() },
      element jobs { jobs:list-details() },
      element current-job { jobs:current() }
    }')
  } catch * {
    element error { $cons:DATA-ERROR || ': ' || $err:description }
  }
  let $error := ($data/self::error/string(), $error)[1]

  return tmpl:wrap(map { 'top': $_:CAT, 'info': $info, 'error': $error },

        <form action="{ $_:CAT }" method="post" class="update">

Jobs

        {
          let $entries :=
            let $curr := $data/current-job
            for $job in $data/jobs/job
            let $id := $job/@id
            let $ms := xs:dayTimeDuration($job/@duration) div xs:dayTimeDuration('PT0.001S')
            let $you := if($id = $curr) then '✓' else '–'
            order by $ms descending
            return <e id='{ $id }' type='{ $job/@type }' state='{ $job/@state }'
              user='{ $job/@user }' sec='{ $ms div 1000 }' start='{ $job/@start}'
              end='{ $job/@end }' you='{ $you }'/>

          let $headers := (
            <id>{ html:label($entries, ('ID', 'IDs')) }</id>,
            <type>Type</type>,
            <state>State</state>,
            <user>User</user>,
            <sec type='number' order='desc'>Seconds</sec>,
            <start type='dateTime' order='desc'>Start</start>,
            <end type='dateTime' order='desc'>End</end>,
            <you>You</you>
          )
          let $buttons := (
            html:button('stop-job', 'Stop', true())
          )
          return html:table($entries, $headers, $buttons, map {}, $sort)
        }
        </form>
        <form action="{ $_:CAT }" method="post" class="update">

Server Sessions

        {
          let $entries :=
            for $id in Sessions:ids()
            let $access := Sessions:accessed($id)
            let $you := if(Session:id() = $id) then '✓' else '–'
            for $name in Sessions:names($id)
            for $value in try {
              let $attr := Sessions:get($id, $name)
              return if($attr instance of element()) then (
                $attr/name
              ) else if($attr instance of xs:string) then (
                $attr
              ) else (
                '...'
              )
            } catch bxerr:BXSE0002 {
              (: ignore non-XQuery session values :)
            }
            return <e id='{ $id || '|' || $name }' name='{ $name }' value='{ $value }'
             access='{ $access }' you='{ $you }'/>
          let $headers := (
            <id type='id'>{  html:label($entries, ('ID', 'IDs')) }</id>,
            <name>Name</name>,
            <value>Value</value>,
            <access type='dateTime' order='desc'>Last Access</access>,
            <you>You</you>
          )
          let $buttons := (
            html:button('kill-session', 'Kill', true())
          )
          return html:table($entries, $headers, $buttons)
        }
        </form>

Database Clients

        {
          let $entries := $data/sessions/session/<e addr='{ @address }' user='{ @user }'/>
          let $headers := (
            <addr>{ html:label($entries, ('Session', 'Sessions')) }</addr>,
            <user>Address</user>
          )
          return html:table($entries, $headers, ())
        }

        <form action="{ $_:CAT }" method="post" class="update">

Users

        {
          let $entries :=
            for $entry in $data/users/user
            let $you := if($cons:SESSION/name = $entry/@name) then '✓' else '–'
            return <e name='{ $entry/@name }' perm='{ $entry/@permission }' you='{ $you }'/>
          let $headers := (
            <name>{ html:label($entries, ('User', 'Users')) }</name>,
            <perm>Permission</perm>,
            <you>You</you>
          )
          let $buttons := (
            html:button('create-user', 'Create…'),
            html:button('drop-user', 'Drop', true())
          )
          let $link := function($value) { 'user' }
          return html:table($entries, $headers, $buttons, map {}, (), $link)
        }
        </form>

  )
};

(:~
 : Redirects to the specified action.
 : @param  $action  action to perform
 : @param  $names   names of users
 : @param  $ids     ids
 :)
declare
  %rest:POST
  %rest:path("/dba/jobs-users")
  %rest:query-param("action", "{$action}")
  %rest:query-param("name",   "{$names}")
  %rest:query-param("id",     "{$ids}")
  %output:method("html")
function _:action(
  $action  as xs:string,
  $names   as xs:string*,
  $ids     as xs:string*
) {
  web:redirect($action,
    if($action = 'create-user') then map { }
    else if($action = 'kill-session') then map { 'id': $ids }
    else if($action = 'stop-job') then map { 'id': $ids }
    else map { 'name': $names, 'redirect': $_:CAT }
  )
};

(:~
 : Users page.
 :
 : @author Christian Grün, BaseX Team, 2014-16
 :)
module namespace _ = 'dba/jobs-users';

import module namespace Sessions = 'http://basex.org/modules/sessions';
import module namespace Session = 'http://basex.org/modules/session';
import module namespace cons = 'dba/cons' at '../modules/cons.xqm';
import module namespace html = 'dba/html' at '../modules/html.xqm';
import module namespace tmpl = 'dba/tmpl' at '../modules/tmpl.xqm';
import module namespace util = 'dba/util' at '../modules/util.xqm';

(:~ Top category :)
declare variable $_:CAT := 'jobs-users';

(:~
 : Jobs and users page.
 : @param  $sort   table sort key
 : @param  $error  error message
 : @param  $info   info message
 : @return page
 :)
declare
  %rest:GET
  %rest:path("/dba/jobs-users")
  %rest:query-param("sort", "{$sort}", "")
  %rest:query-param("error", "{$error}")
  %rest:query-param("info",  "{$info}")
  %output:method("html")
function _:jobs-users(
  $sort   as xs:string,
  $error  as xs:string?,
  $info   as xs:string?
) as element() {
  cons:check(),

  (: request data in a single step :)
  let $data := try {
    util:eval('element result {
      element users { user:list-details() },
      element sessions { admin:sessions() },
      element jobs { jobs:list-details() },
      element current-job { jobs:current() }
    }')
  } catch * {
    element error { $cons:DATA-ERROR || ': ' || $err:description }
  }
  let $error := ($data/self::error/string(), $error)[1]

  return tmpl:wrap(map { 'top': $_:CAT, 'info': $info, 'error': $error },

        <form action="{ $_:CAT }" method="post" class="update">

Jobs

        {
          let $entries :=
            let $curr := $data/current-job
            for $job in $data/jobs/job
            let $id := $job/@id
            let $ms := xs:dayTimeDuration($job/@duration) div xs:dayTimeDuration('PT0.001S')
            let $you := if($id = $curr) then '✓' else '–'
            order by $ms descending
            return <e id='{ $id }' type='{ $job/@type }' state='{ $job/@state }'
              user='{ $job/@user }' sec='{ $ms div 1000 }' start='{ $job/@start}'
              end='{ $job/@end }' you='{ $you }'/>

          let $headers := (
            <id>{ html:label($entries, ('ID', 'IDs')) }</id>,
            <type>Type</type>,
            <state>State</state>,
            <user>User</user>,
            <sec type='number' order='desc'>Seconds</sec>,
            <start type='dateTime' order='desc'>Start</start>,
            <end type='dateTime' order='desc'>End</end>,
            <you>You</you>
          )
          let $buttons := (
            html:button('stop-job', 'Stop', true())
          )
          let $link := function($value) { 'job' }
          return html:table($entries, $headers, $buttons, map {}, $sort, $link)
        }
        </form>
        <form action="{ $_:CAT }" method="post" class="update">

Server Sessions

        {
          let $entries :=
            for $id in Sessions:ids()
            let $access := Sessions:accessed($id)
            let $you := if(Session:id() = $id) then '✓' else '–'
            for $name in Sessions:names($id)
            for $value in try {
              let $attr := Sessions:get($id, $name)
              return if($attr instance of element()) then (
                $attr/name
              ) else if($attr instance of xs:string) then (
                $attr
              ) else (
                '...'
              )
            } catch bxerr:BXSE0002 {
              (: ignore non-XQuery session values :)
            }
            return <e id='{ $id || '|' || $name }' name='{ $name }' value='{ $value }'
             access='{ $access }' you='{ $you }'/>
          let $headers := (
            <id type='id'>{  html:label($entries, ('ID', 'IDs')) }</id>,
            <name>Name</name>,
            <value>Value</value>,
            <access type='dateTime' order='desc'>Last Access</access>,
            <you>You</you>
          )
          let $buttons := (
            html:button('kill-session', 'Kill', true())
          )
          return html:table($entries, $headers, $buttons)
        }
        </form>

Database Clients

        {
          let $entries := $data/sessions/session/<e addr='{ @address }' user='{ @user }'/>
          let $headers := (
            <addr>{ html:label($entries, ('Session', 'Sessions')) }</addr>,
            <user>Address</user>
          )
          return html:table($entries, $headers, ())
        }

        <form action="{ $_:CAT }" method="post" class="update">

Users

        {
          let $entries :=
            for $entry in $data/users/user
            let $you := if($cons:SESSION/name = $entry/@name) then '✓' else '–'
            return <e name='{ $entry/@name }' perm='{ $entry/@permission }' you='{ $you }'/>
          let $headers := (
            <name>{ html:label($entries, ('User', 'Users')) }</name>,
            <perm>Permission</perm>,
            <you>You</you>
          )
          let $buttons := (
            html:button('create-user', 'Create…'),
            html:button('drop-user', 'Drop', true())
          )
          let $link := function($value) { 'user' }
          return html:table($entries, $headers, $buttons)
        }
        </form>

  )
};

(:~
 : Redirects to the specified action.
 : @param  $action  action to perform
 : @param  $names   names of users
 : @param  $ids     ids
 :)
declare
  %rest:POST
  %rest:path("/dba/jobs-users")
  %rest:query-param("action", "{$action}")
  %rest:query-param("name",   "{$names}")
  %rest:query-param("id",     "{$ids}")
  %output:method("html")
function _:action(
  $action  as xs:string,
  $names   as xs:string*,
  $ids     as xs:string*
) {
  web:redirect($action,
    if($action = 'create-user') then map { }
    else if($action = 'kill-session') then map { 'id': $ids }
    else if($action = 'stop-job') then map { 'id': $ids }
    else map { 'name': $names, 'redirect': $_:CAT }
  )
};


Changed redirect to a relative address

Changed redirect to a relative address

When an absolute address was used, the redirection possibly stripped the base path away. Especially using BaseX as a Tomcat webapp, the redirection was broken. Instead of the correct redirection:
``http://localhost:8080/webapp-name/dba`` -> ``http://localhost:8080/webapp-name/dba/databases``
this incorrect was produced:
``http://localhost:8080/webapp-name/dba`` -> ``http://localhost:8080/dba/databases``

 Using a relative address should work *always*.

(:~
 : Utility services.
 :
 : @author Christian Grün, BaseX GmbH, 2014-15
 :)
module namespace _ = 'dba/util';

import module namespace Request = 'http://exquery.org/ns/request';
import module namespace tmpl = 'dba/tmpl' at 'modules/tmpl.xqm';
import module namespace web = 'dba/web' at 'modules/web.xqm';

(:~
 : Redirects to the start page.
 :)
declare
  %updating
  %rest:path("dba")
function _:redirect(
) {
  web:redirect('dba/databases')
};

(:~
 : Returns a file.
 : @param  $file  file or unknown path
 : @return rest response and binary file
 :)
declare
  %rest:path("dba/files/{$file}")
function _:file(
  $file as xs:string
) as item()+ {
  let $path := file:parent(static-base-uri()) || 'files/' || $file
  let $xq := some $x in ('.xq', '.xqm') satisfies ends-with($file, $x)
  return (
    <rest:response>
      <http:response>
        <http:header name="Cache-Control" value="max-age=3600,public"/>
      </http:response>
      <output:serialization-parameters>
        <output:media-type value='{ web:mime-type($file) }'/>
        <output:method value='raw'/>
      </output:serialization-parameters>
    </rest:response>,
    file:read-binary($path)
  )
};

(:~
 : Shows a page not found error.
 : @param  $unknown  unknown page
 : @return page
 :)
declare
  %rest:path("dba/{$unknown}")
  %output:method("html")
function _:any(
  $unknown  as xs:string
) as element(html) {
  web:check(),
  tmpl:wrap(

Page not found!

Page: dba/{ $unknown }

Method: { Request:method() }

  )
};

(:~
 : Login error: redirects to the login page.
 :)
declare
  %updating
  %rest:error("basex:login")
function _:error-login(
) {
  web:redirect("login")
};

(:~
 : Utility services.
 :
 : @author Christian Grün, BaseX GmbH, 2014-15
 :)
module namespace _ = 'dba/util';

import module namespace Request = 'http://exquery.org/ns/request';
import module namespace tmpl = 'dba/tmpl' at 'modules/tmpl.xqm';
import module namespace web = 'dba/web' at 'modules/web.xqm';

(:~
 : Redirects to the start page.
 :)
declare
  %updating
  %rest:path("dba")
function _:redirect(
) {
  web:redirect('/dba/databases')
};

(:~
 : Returns a file.
 : @param  $file  file or unknown path
 : @return rest response and binary file
 :)
declare
  %rest:path("dba/files/{$file}")
function _:file(
  $file as xs:string
) as item()+ {
  let $path := file:parent(static-base-uri()) || 'files/' || $file
  let $xq := some $x in ('.xq', '.xqm') satisfies ends-with($file, $x)
  return (
    <rest:response>
      <http:response>
        <http:header name="Cache-Control" value="max-age=3600,public"/>
      </http:response>
      <output:serialization-parameters>
        <output:media-type value='{ web:mime-type($file) }'/>
        <output:method value='raw'/>
      </output:serialization-parameters>
    </rest:response>,
    file:read-binary($path)
  )
};

(:~
 : Shows a page not found error.
 : @param  $unknown  unknown page
 : @return page
 :)
declare
  %rest:path("dba/{$unknown}")
  %output:method("html")
function _:any(
  $unknown  as xs:string
) as element(html) {
  web:check(),
  tmpl:wrap(

Page not found!

Page: dba/{ $unknown }

Method: { Request:method() }

  )
};

(:~
 : Login error: redirects to the login page.
 :)
declare
  %updating
  %rest:error("basex:login")
function _:error-login(
) {
  web:redirect("login")
};


DHFPROD-2763: fixed the scope of tde templates generated to only focus on actual instances of the entity

(:
  Copyright 2012-2019 MarkLogic Corporation

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
:)
xquery version "1.0-ml";

module namespace hent = "http://marklogic.com/data-hub/hub-entities";

import module namespace es = "http://marklogic.com/entity-services"
at "/MarkLogic/entity-services/entity-services.xqy";
import module namespace tde = "http://marklogic.com/xdmp/tde"
at "/MarkLogic/tde.xqy";

declare namespace search = "http://marklogic.com/appservices/search";

declare variable $ENTITY-MODEL-COLLECTION := "http://marklogic.com/entity-services/models";

declare option xdmp:mapping "false";

declare function hent:get-model($entity-name as xs:string)
{
  hent:get-model($entity-name, ())
};

declare function hent:get-model($entity-name as xs:string, $used-models as xs:string*)
{
  let $model :=
    let $_ := fn:collection($ENTITY-MODEL-COLLECTION)[lower-case(info/title) = lower-case($entity-name)]
    return
      if (fn:count($_) > 1) then
        fn:head(fn:collection($ENTITY-MODEL-COLLECTION)[info/title = $entity-name])
      else
        $_
  where fn:exists($model)
  return
    let $model-map as map:map? := $model
    let $refs := $model//*[fn:local-name(.) = '$ref'][fn:starts-with(., "#/definitions")] ! fn:replace(., "#/definitions/", "")
    let $definitions := map:get($model-map, "definitions")
    let $_ :=
      for $ref in $refs[fn:not(. = $used-models)]
      let $m :=
        if (fn:empty(map:get($definitions, $ref))) then
          let $other-model as map:map? := hent:get-model($ref, ($used-models, $entity-name))
          let $other-defs := map:get($other-model, "definitions")
          for $key in map:keys($other-defs)
          return
            map:put($definitions, $key, map:get($other-defs, $key))
        else ()
      return ()
    return $model-map
};

declare function hent:uber-model() as map:map
{
  hent:uber-model(fn:collection($ENTITY-MODEL-COLLECTION)/object-node())
};

declare function hent:uber-model($models as object-node()*) as map:map
{
  let $uber-model := map:map()
  let $definitions :=
    let $m := map:map()
    let $_ :=
      for $model as map:map in $models
      let $defs := map:get($model, "definitions")
      for $key in map:keys($defs)
      return
        map:put($m, $key, map:get($defs, $key))
    return
      map:put($uber-model, "definitions", $m)
  return
    $uber-model
};

declare function hent:wrap-duplicates(
  $duplicate-map as map:map,
  $property-name as xs:string,
  $item as element()
) as item()
{
  if (map:contains($duplicate-map, $property-name))
  then
    comment { "This item is a duplicate and is commented out so as to create a valid artifact.
",
    xdmp:quote($item),
    "
"
    }
  else (
    map:put($duplicate-map, $property-name, true()),
    $item)
};

(:
  this method doctors the output from ES
  because of https://github.com/marklogic/entity-services/issues/359
:)
declare %private function hent:fix-options($nodes as node()*)
{
  for $n in $nodes
  return
    typeswitch($n)
      case element(search:options) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          $n/@*,
          <search:constraint name="Collection">
            <search:collection/>
          </search:constraint>,
          <search:constraint name="createdByJob">
            <search:value>
              <search:field name="datahubCreatedByJob"/>
            </search:value>
          </search:constraint>,
          <search:constraint name="createdByStep">
            <search:value>
              <search:field name="datahubCreatedByStep"/>
            </search:value>
          </search:constraint>,
          hent:fix-options($n/node())
        }
      case element(search:additional-query) return ()
      case element(search:return-facets) return <search:return-facets>true</search:return-facets>
      case element() return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          $n/@*,
          hent:fix-options($n/node()),

          let $is-range-constraint := $n[self::search:range] and $n/..[self::search:constraint]
          where $is-range-constraint and fn:not($n/search:facet-option[starts-with(., "limit=")])
          return <search:facet-option>limit=25</search:facet-option>
        }
      case text() return
        fn:replace($n, "es:", "*:")
      default return $n
};

declare function hent:dump-search-options($entities as json:array)
{
  let $uber-model := hent:uber-model(json:array-values($entities) ! xdmp:to-json(.)/object-node())
  return
  (: call fix-options because of https://github.com/marklogic/entity-services/issues/359 :)
    hent:fix-options(es:search-options-generate($uber-model))
};

declare function hent:dump-pii($entities as json:array)
{
  let $uber-model := hent:uber-model(json:array-values($entities) ! xdmp:to-json(.)/object-node())
  return es:pii-generate($uber-model)
};

declare function hent:dump-indexes($entities as json:array)
{
  let $uber-model := hent:uber-model(json:array-values($entities) ! xdmp:to-json(.)/object-node())

  let $database-config := xdmp:from-json(es:database-properties-generate($uber-model))

  let $_ :=
    for $x in ("database-name", "schema-database", "triple-index", "collection-lexicon")
    return
      map:delete($database-config, $x)

  let $_ :=
    for $idx in map:get($database-config, "range-path-index") ! json:array-values(.)
    return
      map:put($idx, "path-expression", fn:replace(map:get($idx, "path-expression"), "es:", "*:"))

  let $_ := remove-duplicate-range-indexes($database-config)

  return
    xdmp:to-json($database-config)
};

(:
es:database-properties-generate will generate duplicate range indexes when e.g. two entities have properties with the
same name and namespace and are both configured to have range indexes. This function removes duplicates, where
duplicates are considered to have the same local name, namespace URI, and collation.
:)
declare function hent:remove-duplicate-range-indexes($database-config as item())
{
  let $indexes := map:get($database-config, "range-element-index")
  return
    if (fn:exists($indexes)) then
      let $index-map := map:map()
      let $_ :=
        for $index in json:array-values($indexes)
        let $key := fn:string-join(
          (
            "localname", map:get($index, "localname"),
            "namespace", map:get($index, "namespace-uri"),
            "collation", map:get($index, "collation")
          ), "-"
        )
        where fn:not(map:contains($index-map, $key))
        return map:put($index-map, $key, $index)

      let $deduplicated-indexes := json:array()
      let $_ := map:keys($index-map) ! json:array-push($deduplicated-indexes, map:get($index-map, .))
      let $_ := map:put($database-config, "range-element-index", $deduplicated-indexes)
      return ()
    else
      let $_ := map:put($database-config, "range-element-index", json:array())
      return ()
};

declare variable $generated-primary-key-column as xs:string := "DataHubGeneratedPrimaryKey";
declare variable $generated-primary-key-expression as xs:string := "xdmp:node-uri(.) || '#' || fn:position()";

declare function hent:dump-tde($entities as json:array)
{
  let $entity-values as map:map* := json:array-values($entities)
  let $uber-model := hent:uber-model($entity-values ! xdmp:to-json(.)/object-node())
  let $_set-info := $uber-model => map:put("info", fn:head($entity-values) => map:get("info"))
  let $uber-definitions := $uber-model => map:get("definitions")
  (: Primary keys are required for each definition in an entity. If the primary key is missing, we'll help out by using the doc URI and position as the primary key. :)
  let $_set-primary-keys-for-TDE :=
    for $definition-type in map:keys($uber-definitions)
    let $definition := $uber-definitions => map:get($definition-type)
    where fn:empty($definition => map:get("primaryKey"))
    return (
      $definition => map:put("primaryKey", $generated-primary-key-column),
      $definition => map:get("properties") => map:put($generated-primary-key-column, map:entry("datatype", "string"))
    )
  let $entity-model-contexts := map:keys($uber-definitions) ! ("./" || .)
  let $entity-name := map:get(map:get($uber-model, "info"), "title")
  return hent:fix-tde(es:extraction-template-generate($uber-model), $entity-model-contexts, $uber-definitions, $entity-name)
};

declare variable $default-nullable as element(tde:nullable) := element tde:nullable {fn:true()};
declare variable $default-invalid-values as element(tde:invalid-values) := element tde:invalid-values {"ignore"};
(:
  this method doctors the TDE output from ES
:)

declare function hent:fix-tde($nodes as node()*, $entity-model-contexts as xs:string*, $uber-definitions as map:map)
{
  hent:fix-tde($nodes, $entity-model-contexts, $uber-definitions, ())
};

declare function hent:fix-tde($nodes as node()*, $entity-model-contexts as xs:string*, $uber-definitions as map:map, $entity-name as xs:string?)
{
  for $n in $nodes
  return
    typeswitch($n)
      case document-node() return
        document {
          hent:fix-tde($n/node(), $entity-model-contexts, $uber-definitions, $entity-name)
        }
      case element(tde:nullable) return
        $default-nullable
      case element(tde:invalid-values) return
        $default-invalid-values
      case element(tde:val) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          let $col-name := fn:string($n/../tde:name)
          return
            if (fn:ends-with($col-name, $generated-primary-key-column)) then
              $generated-primary-key-expression
            else if (fn:starts-with($n, $col-name)) then
              let $parts := fn:tokenize($n, "/")
              let $entity-definition := $uber-definitions => map:get(fn:string($parts[2]))
              return
                if (fn:exists($entity-definition)) then
                  let $primary-key := $entity-definition => map:get("primaryKey")
                  return
                    if ($primary-key = $generated-primary-key-column) then
                      $generated-primary-key-expression
                    else
                      fn:string($n) || "/" || $primary-key
                else
                  hent:fix-tde($n/node(), $entity-model-contexts, $uber-definitions, $entity-name)
            else
              hent:fix-tde($n/node(), $entity-model-contexts, $uber-definitions, $entity-name)
        }
      case element(tde:context) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          if ($n = $entity-model-contexts) then
            fn:replace(fn:replace(fn:string($n),"^\.//", "./"), "(.)$", "$1[node()]")
          else
            let $outer-context := fn:replace(fn:string($n),"//\*:instance", "/*:envelope/*:instance")
            return if(fn:not(fn:empty($entity-name))) then
              fn:concat($outer-context, "[*:", $entity-name, "]")
            else
              $outer-context
        }
      case element(tde:column) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          $n/@*,
          hent:fix-tde($n/* except $n/(tde:nullable|tde:invalid-values), $entity-model-contexts, $uber-definitions),
          $default-nullable,
          $default-invalid-values
        }
      case element(tde:subject)|element(tde:predicate)|element(tde:object) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          hent:fix-tde($n/* except $n/tde:invalid-values, $entity-model-contexts, $uber-definitions),
          $default-invalid-values
        }
      case element(tde:template) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          $n/@*,
          let $context-item :=  fn:replace(fn:string($n/tde:context), "\./", "")
          let $parent-context-item := fn:replace(fn:string($n/../../tde:context), "\./", "")
          let $is-join-template := $n/tde:rows/tde:row/tde:view-name = $parent-context-item  || "_" || $context-item
          let $rows := $n/tde:rows/tde:row
          return
            if ($is-join-template) then (
              hent:fix-tde($n/tde:context, $entity-model-contexts, $uber-definitions),
              element tde:rows {
                element tde:row {
                  $rows/(tde:schema-name|tde:view-name|tde:view-layout),
                  element tde:columns {
                    let $join-prefix := $context-item || "_"
                    for $column in $rows/tde:columns/tde:column
                    return
                      element tde:column {
                        $column/@*,
                        if (fn:starts-with($column/tde:name, $join-prefix)) then (
                          hent:fix-tde($column/(tde:name|tde:scalar-type), $entity-model-contexts, $uber-definitions),
                          let $tde-val := fn:string($column/tde:val)
                          let $primary-key := $uber-definitions => map:get($tde-val) => map:get("primaryKey")
                          return
                            element tde:val {
                              if ($primary-key = $generated-primary-key-column) then
                                $generated-primary-key-expression
                              else
                                $tde-val || "/" || $primary-key
                            },
                          $default-nullable,
                          $default-invalid-values,
                          hent:fix-tde($column/(tde:default|tde:reindexing|tde:collation), $entity-model-contexts, $uber-definitions)
                        ) else
                          hent:fix-tde($column/node(), $entity-model-contexts, $uber-definitions)
                      }
                  }
                }
              }
            ) else
              hent:fix-tde($n/node(), $entity-model-contexts, $uber-definitions, $entity-name)
        }
      case element() return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          hent:fix-tde(($n/@*, $n/node()), $entity-model-contexts, $uber-definitions)
        }
      case text() return
        fn:replace(
          fn:replace($n, "^\.\./(.+)$", "(../$1|parent::array-node()/../$1)"),
          "\./" || $generated-primary-key-column,
          $generated-primary-key-expression
        )
      default return $n
};

declare variable $number-types as xs:string+ := ("byte","decimal","double","float","int","integer","long","negativeInteger","nonNegativeInteger","nonPositiveInteger","positiveInteger","short","unsignedLong","unsignedInt","unsignedShort","unsignedByte");
declare variable $string-types as xs:string+ := "dateTime";

declare function hent:json-schema-generate($entity-title as xs:string, $uber-model as map:map)
{
  let $uber-model := map:new((
  (: Ensure we're not change a map for anyone else :)
  map:map(document{$uber-model}/*),
  map:entry("language", "zxx"),
  map:entry("$schema", "http://json-schema.org/draft-07/schema#")
  ))
  let $definitions := $uber-model => map:get("definitions")
  (: JSON Schema needs an extra level of wrapping to account for Entity Model label wrapping it. :)
  let $_nest-refs :=
    for $definition-type in map:keys($definitions)
    let $definition-properties := $definitions => map:get($definition-type) => map:get("properties")
    for $property-name in map:keys($definition-properties)
    let $property := $definition-properties => map:get($property-name)
    let $property-items := $property => map:get("items")
    let $datatype := $property => map:get("datatype")
    let $_set-types := (
      $property => map:put("type", if ($datatype = $number-types) then "number" else if ($datatype = $string-types) then "string" else $datatype),
      $property => map:delete("datatype"),
      if ($property-items instance of map:map) then (
        let $items-datatype := $property => map:get("datatype")
        return (
          $property-items => map:put("type", if ($items-datatype = $number-types) then "number" else if ($items-datatype = $string-types) then "string" else $datatype),
          $property-items => map:delete("datatype"))
      ) else ()
    )
    return
    (: references can be in the property or in items for arrays :)
      if ($property => map:contains("$ref")) then
        map:put($definition-properties, $property-name,
          map:new((
            map:entry("type", "object"),
            map:entry("properties",
              map:entry(fn:tokenize(map:get($property,"$ref"),"/")[fn:last()], $property)
            )
          ))
        )
      else if ($property-items instance of map:map and $property-items => map:contains("$ref")) then
        map:put($property, "items",
          map:new((
            map:entry("type", "object"),
            map:entry("properties",
              map:entry(fn:tokenize(map:get($property-items,"$ref"),"/")[fn:last()], $property-items)
            )
          ))
        )
      else ()
  let $_set-info := (
    $uber-model => map:put("properties", map:entry($entity-title, map:entry("$ref", "#/definitions/"||$entity-title)))
  )
  return xdmp:to-json($uber-model)
};

(:
  Copyright 2012-2019 MarkLogic Corporation

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
:)
xquery version "1.0-ml";

module namespace hent = "http://marklogic.com/data-hub/hub-entities";

import module namespace es = "http://marklogic.com/entity-services"
at "/MarkLogic/entity-services/entity-services.xqy";
import module namespace tde = "http://marklogic.com/xdmp/tde"
at "/MarkLogic/tde.xqy";

declare namespace search = "http://marklogic.com/appservices/search";

declare variable $ENTITY-MODEL-COLLECTION := "http://marklogic.com/entity-services/models";

declare option xdmp:mapping "false";

declare function hent:get-model($entity-name as xs:string)
{
  hent:get-model($entity-name, ())
};

declare function hent:get-model($entity-name as xs:string, $used-models as xs:string*)
{
  let $model :=
    let $_ := fn:collection($ENTITY-MODEL-COLLECTION)[lower-case(info/title) = lower-case($entity-name)]
    return
      if (fn:count($_) > 1) then
        fn:head(fn:collection($ENTITY-MODEL-COLLECTION)[info/title = $entity-name])
      else
        $_
  where fn:exists($model)
  return
    let $model-map as map:map? := $model
    let $refs := $model//*[fn:local-name(.) = '$ref'][fn:starts-with(., "#/definitions")] ! fn:replace(., "#/definitions/", "")
    let $definitions := map:get($model-map, "definitions")
    let $_ :=
      for $ref in $refs[fn:not(. = $used-models)]
      let $m :=
        if (fn:empty(map:get($definitions, $ref))) then
          let $other-model as map:map? := hent:get-model($ref, ($used-models, $entity-name))
          let $other-defs := map:get($other-model, "definitions")
          for $key in map:keys($other-defs)
          return
            map:put($definitions, $key, map:get($other-defs, $key))
        else ()
      return ()
    return $model-map
};

declare function hent:uber-model() as map:map
{
  hent:uber-model(fn:collection($ENTITY-MODEL-COLLECTION)/object-node())
};

declare function hent:uber-model($models as object-node()*) as map:map
{
  let $uber-model := map:map()
  let $definitions :=
    let $m := map:map()
    let $_ :=
      for $model as map:map in $models
      let $defs := map:get($model, "definitions")
      for $key in map:keys($defs)
      return
        map:put($m, $key, map:get($defs, $key))
    return
      map:put($uber-model, "definitions", $m)
  return
    $uber-model
};

declare function hent:wrap-duplicates(
  $duplicate-map as map:map,
  $property-name as xs:string,
  $item as element()
) as item()
{
  if (map:contains($duplicate-map, $property-name))
  then
    comment { "This item is a duplicate and is commented out so as to create a valid artifact.
",
    xdmp:quote($item),
    "
"
    }
  else (
    map:put($duplicate-map, $property-name, true()),
    $item)
};

(:
  this method doctors the output from ES
  because of https://github.com/marklogic/entity-services/issues/359
:)
declare %private function hent:fix-options($nodes as node()*)
{
  for $n in $nodes
  return
    typeswitch($n)
      case element(search:options) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          $n/@*,
          <search:constraint name="Collection">
            <search:collection/>
          </search:constraint>,
          <search:constraint name="createdByJob">
            <search:value>
              <search:field name="datahubCreatedByJob"/>
            </search:value>
          </search:constraint>,
          <search:constraint name="createdByStep">
            <search:value>
              <search:field name="datahubCreatedByStep"/>
            </search:value>
          </search:constraint>,
          hent:fix-options($n/node())
        }
      case element(search:additional-query) return ()
      case element(search:return-facets) return <search:return-facets>true</search:return-facets>
      case element() return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          $n/@*,
          hent:fix-options($n/node()),

          let $is-range-constraint := $n[self::search:range] and $n/..[self::search:constraint]
          where $is-range-constraint and fn:not($n/search:facet-option[starts-with(., "limit=")])
          return <search:facet-option>limit=25</search:facet-option>
        }
      case text() return
        fn:replace($n, "es:", "*:")
      default return $n
};

declare function hent:dump-search-options($entities as json:array)
{
  let $uber-model := hent:uber-model(json:array-values($entities) ! xdmp:to-json(.)/object-node())
  return
  (: call fix-options because of https://github.com/marklogic/entity-services/issues/359 :)
    hent:fix-options(es:search-options-generate($uber-model))
};

declare function hent:dump-pii($entities as json:array)
{
  let $uber-model := hent:uber-model(json:array-values($entities) ! xdmp:to-json(.)/object-node())
  return es:pii-generate($uber-model)
};

declare function hent:dump-indexes($entities as json:array)
{
  let $uber-model := hent:uber-model(json:array-values($entities) ! xdmp:to-json(.)/object-node())

  let $database-config := xdmp:from-json(es:database-properties-generate($uber-model))

  let $_ :=
    for $x in ("database-name", "schema-database", "triple-index", "collection-lexicon")
    return
      map:delete($database-config, $x)

  let $_ :=
    for $idx in map:get($database-config, "range-path-index") ! json:array-values(.)
    return
      map:put($idx, "path-expression", fn:replace(map:get($idx, "path-expression"), "es:", "*:"))

  let $_ := remove-duplicate-range-indexes($database-config)

  return
    xdmp:to-json($database-config)
};

(:
es:database-properties-generate will generate duplicate range indexes when e.g. two entities have properties with the
same name and namespace and are both configured to have range indexes. This function removes duplicates, where
duplicates are considered to have the same local name, namespace URI, and collation.
:)
declare function hent:remove-duplicate-range-indexes($database-config as item())
{
  let $indexes := map:get($database-config, "range-element-index")
  return
    if (fn:exists($indexes)) then
      let $index-map := map:map()
      let $_ :=
        for $index in json:array-values($indexes)
        let $key := fn:string-join(
          (
            "localname", map:get($index, "localname"),
            "namespace", map:get($index, "namespace-uri"),
            "collation", map:get($index, "collation")
          ), "-"
        )
        where fn:not(map:contains($index-map, $key))
        return map:put($index-map, $key, $index)

      let $deduplicated-indexes := json:array()
      let $_ := map:keys($index-map) ! json:array-push($deduplicated-indexes, map:get($index-map, .))
      let $_ := map:put($database-config, "range-element-index", $deduplicated-indexes)
      return ()
    else
      let $_ := map:put($database-config, "range-element-index", json:array())
      return ()
};

declare variable $generated-primary-key-column as xs:string := "DataHubGeneratedPrimaryKey";
declare variable $generated-primary-key-expression as xs:string := "xdmp:node-uri(.) || '#' || fn:position()";

declare function hent:dump-tde($entities as json:array)
{
  let $entity-values as map:map* := json:array-values($entities)
  let $uber-model := hent:uber-model($entity-values ! xdmp:to-json(.)/object-node())
  let $_set-info := $uber-model => map:put("info", fn:head($entity-values) => map:get("info"))
  let $uber-definitions := $uber-model => map:get("definitions")
  (: Primary keys are required for each definition in an entity. If the primary key is missing, we'll help out by using the doc URI and position as the primary key. :)
  let $_set-primary-keys-for-TDE :=
    for $definition-type in map:keys($uber-definitions)
    let $definition := $uber-definitions => map:get($definition-type)
    where fn:empty($definition => map:get("primaryKey"))
    return (
      $definition => map:put("primaryKey", $generated-primary-key-column),
      $definition => map:get("properties") => map:put($generated-primary-key-column, map:entry("datatype", "string"))
    )
  let $entity-model-contexts := map:keys($uber-definitions) ! ("./" || .)
  return hent:fix-tde(es:extraction-template-generate($uber-model), $entity-model-contexts, $uber-definitions)
};

declare variable $default-nullable as element(tde:nullable) := element tde:nullable {fn:true()};
declare variable $default-invalid-values as element(tde:invalid-values) := element tde:invalid-values {"ignore"};
(:
  this method doctors the TDE output from ES
:)
declare function hent:fix-tde($nodes as node()*, $entity-model-contexts as xs:string*, $uber-definitions as map:map)
{
  for $n in $nodes
  return
    typeswitch($n)
      case document-node() return
        document {
          hent:fix-tde($n/node(), $entity-model-contexts, $uber-definitions)
        }
      case element(tde:nullable) return
        $default-nullable
      case element(tde:invalid-values) return
        $default-invalid-values
      case element(tde:val) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          let $col-name := fn:string($n/../tde:name)
          return
            if (fn:ends-with($col-name, $generated-primary-key-column)) then
              $generated-primary-key-expression
            else if (fn:starts-with($n, $col-name)) then
              let $parts := fn:tokenize($n, "/")
              let $entity-definition := $uber-definitions => map:get(fn:string($parts[2]))
              return
                if (fn:exists($entity-definition)) then
                  let $primary-key := $entity-definition => map:get("primaryKey")
                  return
                    if ($primary-key = $generated-primary-key-column) then
                      $generated-primary-key-expression
                    else
                      fn:string($n) || "/" || $primary-key
                else
                  hent:fix-tde($n/node(), $entity-model-contexts, $uber-definitions)
            else
              hent:fix-tde($n/node(), $entity-model-contexts, $uber-definitions)
        }
      case element(tde:context) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          if ($n = $entity-model-contexts) then
            fn:replace(fn:string($n),"^\./", ".//")
          else
            $n/node()
        }
      case element(tde:column) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          $n/@*,
          hent:fix-tde($n/* except $n/(tde:nullable|tde:invalid-values), $entity-model-contexts, $uber-definitions),
          $default-nullable,
          $default-invalid-values
        }
      case element(tde:subject)|element(tde:predicate)|element(tde:object) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          hent:fix-tde($n/* except $n/tde:invalid-values, $entity-model-contexts, $uber-definitions),
          $default-invalid-values
        }
      case element(tde:template) return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          $n/@*,
          let $context-item :=  fn:replace(fn:string($n/tde:context), "\./", "")
          let $parent-context-item := fn:replace(fn:string($n/../../tde:context), "\./", "")
          let $is-join-template := $n/tde:rows/tde:row/tde:view-name = $parent-context-item  || "_" || $context-item
          let $rows := $n/tde:rows/tde:row
          return
            if ($is-join-template) then (
              hent:fix-tde($n/tde:context, $entity-model-contexts, $uber-definitions),
              element tde:rows {
                element tde:row {
                  $rows/(tde:schema-name|tde:view-name|tde:view-layout),
                  element tde:columns {
                    let $join-prefix := $context-item || "_"
                    for $column in $rows/tde:columns/tde:column
                    return
                      element tde:column {
                        $column/@*,
                        if (fn:starts-with($column/tde:name, $join-prefix)) then (
                          hent:fix-tde($column/(tde:name|tde:scalar-type), $entity-model-contexts, $uber-definitions),
                          let $tde-val := fn:string($column/tde:val)
                          let $primary-key := $uber-definitions => map:get($tde-val) => map:get("primaryKey")
                          return
                            element tde:val {
                              if ($primary-key = $generated-primary-key-column) then
                                $generated-primary-key-expression
                              else
                                $tde-val || "/" || $primary-key
                            },
                          $default-nullable,
                          $default-invalid-values,
                          hent:fix-tde($column/(tde:default|tde:reindexing|tde:collation), $entity-model-contexts, $uber-definitions)
                        ) else
                          hent:fix-tde($column/node(), $entity-model-contexts, $uber-definitions)
                      }
                  }
                }
              }
            ) else
              hent:fix-tde($n/node(), $entity-model-contexts, $uber-definitions)
        }
      case element() return
        element { fn:node-name($n) } {
          $n/namespace::node(),
          hent:fix-tde(($n/@*, $n/node()), $entity-model-contexts, $uber-definitions)
        }
      case text() return
        fn:replace(
          fn:replace($n, "^\.\./(.+)$", "(../$1|parent::array-node()/../$1)"),
          "\./" || $generated-primary-key-column,
          $generated-primary-key-expression
        )
      default return $n
};

declare variable $number-types as xs:string+ := ("byte","decimal","double","float","int","integer","long","negativeInteger","nonNegativeInteger","nonPositiveInteger","positiveInteger","short","unsignedLong","unsignedInt","unsignedShort","unsignedByte");
declare variable $string-types as xs:string+ := "dateTime";

declare function hent:json-schema-generate($entity-title as xs:string, $uber-model as map:map)
{
  let $uber-model := map:new((
  (: Ensure we're not change a map for anyone else :)
  map:map(document{$uber-model}/*),
  map:entry("language", "zxx"),
  map:entry("$schema", "http://json-schema.org/draft-07/schema#")
  ))
  let $definitions := $uber-model => map:get("definitions")
  (: JSON Schema needs an extra level of wrapping to account for Entity Model label wrapping it. :)
  let $_nest-refs :=
    for $definition-type in map:keys($definitions)
    let $definition-properties := $definitions => map:get($definition-type) => map:get("properties")
    for $property-name in map:keys($definition-properties)
    let $property := $definition-properties => map:get($property-name)
    let $property-items := $property => map:get("items")
    let $datatype := $property => map:get("datatype")
    let $_set-types := (
      $property => map:put("type", if ($datatype = $number-types) then "number" else if ($datatype = $string-types) then "string" else $datatype),
      $property => map:delete("datatype"),
      if ($property-items instance of map:map) then (
        let $items-datatype := $property => map:get("datatype")
        return (
          $property-items => map:put("type", if ($items-datatype = $number-types) then "number" else if ($items-datatype = $string-types) then "string" else $datatype),
          $property-items => map:delete("datatype"))
      ) else ()
    )
    return
    (: references can be in the property or in items for arrays :)
      if ($property => map:contains("$ref")) then
        map:put($definition-properties, $property-name,
          map:new((
            map:entry("type", "object"),
            map:entry("properties",
              map:entry(fn:tokenize(map:get($property,"$ref"),"/")[fn:last()], $property)
            )
          ))
        )
      else if ($property-items instance of map:map and $property-items => map:contains("$ref")) then
        map:put($property, "items",
          map:new((
            map:entry("type", "object"),
            map:entry("properties",
              map:entry(fn:tokenize(map:get($property-items,"$ref"),"/")[fn:last()], $property-items)
            )
          ))
        )
      else ()
  let $_set-info := (
    $uber-model => map:put("properties", map:entry($entity-title, map:entry("$ref", "#/definitions/"||$entity-title)))
  )
  return xdmp:to-json($uber-model)
};


eXist builtin functions - update atomic.exist-db.org/static-context/xquery

xquery version "1.0";
(:~
 : eXist 'atomic' default static context
 :
 : @see http://
 :)

declare default element namespace "";
declare default function namespace "http://www.w3.org/2005/xpath-functions"; (: = 'fn:' :)

(: XQuery 1.0 :)
declare namespace xml = "http://www.w3.org/XML/1998/namespace";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace xsi = "http://www.w3.org/2001/XMLSchema-instance";
declare namespace fn = "http://www.w3.org/2005/xpath-functions";
declare namespace local = "http://www.w3.org/2005/xquery-local-functions";

(: XQuery 3.0 :)
declare namespace math = "http://www.w3.org/2005/xpath-functions/math";

(: XQuery 3.1 :)
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";
declare namespace array = "http://www.w3.org/2005/xpath-functions/array";

(: eXist :)
declare namespace html2wiki = "http://atomic.exist-db.org/xquery/html2wiki";
declare namespace ext = "http://atomic.exist-db.org/xquery/extensions";
declare namespace dates = "http://atomic.exist-db.org/xquery/dates";
declare namespace cleanup = "http://atomic.exist-db.org/xquery/cleanup";
declare namespace theme = "http://atomic.exist-db.org/xquery/atomic/theme";
declare namespace search = "http://atomic.exist-db.org/xquery/atomic/search";

()

xquery version "1.0";
(:~
 : eXist 'atomic' default static context
 :
 : @see http://
 :)

declare default element namespace "";
declare default function namespace "http://www.w3.org/2005/xpath-functions"; (: = 'fn:' :)

(: XQuery 1.0 :)
declare namespace xml = "http://www.w3.org/XML/1998/namespace";
declare namespace xs = "http://www.w3.org/2001/XMLSchema";
declare namespace xsi = "http://www.w3.org/2001/XMLSchema-instance";
declare namespace fn = "http://www.w3.org/2005/xpath-functions";
declare namespace local = "http://www.w3.org/2005/xquery-local-functions";

(: XQuery 3.0 :)
declare namespace math = "http://www.w3.org/2005/xpath-functions/math";

(: XQuery 3.1 :)
declare namespace map = "http://www.w3.org/2005/xpath-functions/map";
declare namespace array = "http://www.w3.org/2005/xpath-functions/array";

(: eXist :)
declare namespace html2wiki = "http://atomic.exist-db.org/xquery/html2wiki";
declare namespace ext = "http://atomic.exist-db.org/xquery/extensions";
declare namespace dates = "http://atomic.exist-db.org/xquery/dates";
declare namespace cleanup = "http://atomic.exist-db.org/xquery/cleanup";
declare namespace theme = "http://atomic.exist-db.org/xquery/atomic/theme";
()


Issue #319, instance-get-attachments returns no JSON

(:
 Copyright 2002-2017 MarkLogic Corporation.  All Rights Reserved.

 Licensed under the Apache License, Version 2.0 (the "License");
 you may not use this file except in compliance with the License.
 You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

 Unless required by applicable law or agreed to in writing, software
 distributed under the License is distributed on an "AS IS" BASIS,
 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 See the License for the specific language governing permissions and
 limitations under the License.
:)
xquery version "1.0-ml";

module namespace inst = "http://marklogic.com/entity-services-instance";
declare namespace es = "http://marklogic.com/entity-services";
declare namespace tde = "http://marklogic.com/xdmp/tde";
declare namespace xq = "http://www.w3.org/2012/xquery";

import module namespace sem = "http://marklogic.com/semantics" at "/MarkLogic/semantics.xqy";

declare default function namespace "http://www.w3.org/2005/xpath-functions";

(: declare option xdmp:mapping "false"; :)
declare option xq:require-feature "xdmp:three-one";

declare function inst:instance-from-document(
    $document as document-node()
) as map:map*
{
    let $xml-from-document := inst:instance-xml-from-document($document)
    for $root-instance in $xml-from-document
        return inst:child-instance($root-instance)
};

declare function inst:child-instance(
    $element as element()
) as map:map*
{
    if (empty($element/*) and exists($element/text()))
    then json:object()
            =>map:with("$type", local-name($element))
            =>map:with("$ref", $element/data())
    else
        let $child := json:object()=>map:with("$type", local-name($element))
        let $_ :=
            for $property in $element/*
            return
                if (map:contains($child, local-name($property)))
                then
                    if (map:get($child, local-name($property)) instance of json:array)
                    then json:array-push(map:get($child, local-name($property)),
                            if ($property/element())
                            then inst:child-instance($property/*)
                            else data($property))
                    else
                        let $new-array := json:array()
                        return (
                            json:array-push($new-array, map:get($child, local-name($property))),
                            json:array-push($new-array, inst:child-instance($property/*)),
                            map:put($child, local-name($property), $new-array)
                        )
                else
                    if ($property[@datatype eq "array"])
                    then
                        map:put($child, local-name($property),
                            json:array()
                            =>json:array-with(
                                if ($property/element())
                                then inst:child-instance($property/element())
                                else data($property))
                            )
                    else
                        map:put($child, local-name($property),
                            if ($property/element())
                            then inst:child-instance($property/element())
                            else data($property))
        return $child
};

declare function inst:instance-xml-from-document(
    $document as document-node()
) as element()*
{
    $document//es:instance/(* except es:info)
};

declare private function inst:wrap-instance(
    $instance as json:object
) as json:object
{
    let $type := map:get($instance, "$type")
    let $remove-it := map:delete($instance, "$type")
    return json:object()
        =>map:with($type,
            if (map:contains($instance, "$ref"))
            then map:get($instance, "$ref")
            else
                let $value-map := json:object()
                let $_ :=
                    for $k in map:keys($instance)
                    let $v := map:get($instance, $k)
                    return
                    typeswitch ($v)
                    case json:array return

                        if (json:array-size($v) eq 0)
                        then json:object()=>map:with($k, $v)
                        else if ($v[1] instance of json:object)
                        then map:put($value-map, $k, (json:to-array(json:array-values($v) ! inst:wrap-instance(.))))
                        else map:put($value-map, $k, $v)
                    case json:object return
                        map:put($value-map, $k, inst:wrap-instance($v))
                    default return map:put($value-map, $k, $v)
                return $value-map)
};

declare function inst:instance-json-from-document(
    $document as document-node()
) as object-node()*
{
    (inst:instance-from-document($document) !
        (inst:wrap-instance(.)=>xdmp:to-json()))/node()
};

declare function inst:instance-get-attachments(
    $document as document-node()
) as item()*
{
    if (exists($document//*:attachments/*))
    then $document//*:attachments/*
    else $document//*:attachments/text()
};

(:
 Copyright 2002-2017 MarkLogic Corporation.  All Rights Reserved.

 Licensed under the Apache License, Version 2.0 (the "License");
 you may not use this file except in compliance with the License.
 You may obtain a copy of the License at

     http://www.apache.org/licenses/LICENSE-2.0

 Unless required by applicable law or agreed to in writing, software
 distributed under the License is distributed on an "AS IS" BASIS,
 WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
 See the License for the specific language governing permissions and
 limitations under the License.
:)
xquery version "1.0-ml";

module namespace inst = "http://marklogic.com/entity-services-instance";
declare namespace es = "http://marklogic.com/entity-services";
declare namespace tde = "http://marklogic.com/xdmp/tde";
declare namespace xq = "http://www.w3.org/2012/xquery";

import module namespace sem = "http://marklogic.com/semantics" at "/MarkLogic/semantics.xqy";

declare default function namespace "http://www.w3.org/2005/xpath-functions";

(: declare option xdmp:mapping "false"; :)
declare option xq:require-feature "xdmp:three-one";

declare function inst:instance-from-document(
    $document as document-node()
) as map:map*
{
    let $xml-from-document := inst:instance-xml-from-document($document)
    for $root-instance in $xml-from-document
        return inst:child-instance($root-instance)
};

declare function inst:child-instance(
    $element as element()
) as map:map*
{
    if (empty($element/*) and exists($element/text()))
    then json:object()
            =>map:with("$type", local-name($element))
            =>map:with("$ref", $element/data())
    else
        let $child := json:object()=>map:with("$type", local-name($element))
        let $_ :=
            for $property in $element/*
            return
                if (map:contains($child, local-name($property)))
                then
                    if (map:get($child, local-name($property)) instance of json:array)
                    then json:array-push(map:get($child, local-name($property)),
                            if ($property/element())
                            then inst:child-instance($property/*)
                            else data($property))
                    else
                        let $new-array := json:array()
                        return (
                            json:array-push($new-array, map:get($child, local-name($property))),
                            json:array-push($new-array, inst:child-instance($property/*)),
                            map:put($child, local-name($property), $new-array)
                        )
                else
                    if ($property[@datatype eq "array"])
                    then
                        map:put($child, local-name($property),
                            json:array()
                            =>json:array-with(
                                if ($property/element())
                                then inst:child-instance($property/element())
                                else data($property))
                            )
                    else
                        map:put($child, local-name($property),
                            if ($property/element())
                            then inst:child-instance($property/element())
                            else data($property))
        return $child
};

declare function inst:instance-xml-from-document(
    $document as document-node()
) as element()*
{
    $document//es:instance/(* except es:info)
};

declare private function inst:wrap-instance(
    $instance as json:object
) as json:object
{
    let $type := map:get($instance, "$type")
    let $remove-it := map:delete($instance, "$type")
    return json:object()
        =>map:with($type,
            if (map:contains($instance, "$ref"))
            then map:get($instance, "$ref")
            else
                let $value-map := json:object()
                let $_ :=
                    for $k in map:keys($instance)
                    let $v := map:get($instance, $k)
                    return
                    typeswitch ($v)
                    case json:array return

                        if (json:array-size($v) eq 0)
                        then json:object()=>map:with($k, $v)
                        else if ($v[1] instance of json:object)
                        then map:put($value-map, $k, (json:to-array(json:array-values($v) ! inst:wrap-instance(.))))
                        else map:put($value-map, $k, $v)
                    case json:object return
                        map:put($value-map, $k, inst:wrap-instance($v))
                    default return map:put($value-map, $k, $v)
                return $value-map)
};

declare function inst:instance-json-from-document(
    $document as document-node()
) as object-node()*
{
    (inst:instance-from-document($document) !
        (inst:wrap-instance(.)=>xdmp:to-json()))/node()
};

declare function inst:instance-get-attachments(
    $document as document-node()
) as item()*
{
    if (exists($document//es:attachments/*))
    then $document//es:attachments/*
    else $document//es:attachments/text()
};


adhoc queries not using serialize

adhoc queries not using serialize

(:~
: This is the Care Services Discovery RESTful document processor
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csr_proc = "https://github.com/his-interop/openinfoman/csr_proc";

import module namespace csd_webconf = "https://github.com/his-interop/openinfoman/csd_webconf" at "csd_webapp_config.xqm";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";

declare function csr_proc:process_CSR($careServicesRequest, $doc)
{
let $func :=$careServicesRequest//csd:function
let $adhoc :=$careServicesRequest//csd:expression
return if (exists($func))
then
 csr_proc:process_CSR_stored($func,$doc)
else if (exists($adhoc))
then
  csr_proc:process_CSR_adhoc($adhoc,$doc)
else
  <rest:response>
    <http:response status="400" message="Invalid care services request.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>

};

declare function csr_proc:process_CSR_adhoc($expression,$doc)
{

let $expr :=string($expression)
return if ($expr) then
  let $result := xquery:eval($expr,map{"":=$doc})
  return(
   <rest:response>
   <http:response status="200" >
      <http:header name="Content-Type" value="{$expression/@content-type}"/>
    </http:response>
  </rest:response>
  ,$result
 )
else
   <rest:response>
     <http:response status="400" message="No ad-hoc expression" />
  </rest:response>
};

declare function csr_proc:process_CSR_stored($function,$doc)
{
if (csd_webconf:has_stored_query($function/@uuid))
then
  let $result := csd_webconf:execute_stored_query($doc,$function/@uuid,$function/requestParams)
  let $content_type := csd_webconf:lookup_stored_content_type($function/@uuid)
  return if ($function/@encapsulated)
  then
         csr_proc:wrap_result($result,$content_type)
  else
	 (<rest:response>
	   <http:response status="200" >
	     <http:header name="Content-Type" value="{$content_type}"/>
	   </http:response>
	 </rest:response>,
	 $result
	 )
else
    <rest:response>
     <http:response status="404" message="No registered function with UUID='{$function/@uuid}.'">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
     </http:response>
    </rest:response>

};

declare function csr_proc:wrap_result($result,$content-type) {
 <careServicesResponse content-type="{$content-type}"><result>{$result}</result></careServicesResponse>
};

declare function csr_proc:create_adhoc_doc($adhoc_query,$content_type) {
let $content := if ($content_type) then $content_type else "application/xml"
return
 <csd:careServicesRequest xmlns:csd='urn:ihe:iti:csd:2013'>
  <csd:expression content-type='{$content}'>
  {$adhoc_query}
  </csd:expression>
</csd:careServicesRequest>

};

declare updating function csr_proc:process_updating_CSR($careServicesRequest, $doc)
{
(:not allowing ad-hoc updates:)
let $func :=$careServicesRequest//csd:function
let $method :=
  if (exists($func) and csd_webconf:has_updating_stored_query($func/@uuid))
    then csd_webconf:get_updating_stored_query($func/@uuid) else ()
return
  if (exists($method)) then
    (:Assumes called method handles db:output.  Nothing is encapsulated :)
    db:output(
      $method($careServicesRequest//csd:function/requestParams,$doc)
       )
  else
  db:output(<rest:response>
    <http:response status="404" message="No registered updating function with UUID='{$func/@uuid}.'">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
     )
};

(:~
: This is the Care Services Discovery RESTful document processor
: @version 1.0
: @see https://github.com/his-interop/openinfoman
:
:)
module namespace csr_proc = "https://github.com/his-interop/openinfoman/csr_proc";

import module namespace csd_webconf = "https://github.com/his-interop/openinfoman/csd_webconf" at "csd_webapp_config.xqm";

declare   namespace   csd = "urn:ihe:iti:csd:2013";
declare default element  namespace   "urn:ihe:iti:csd:2013";

declare function csr_proc:process_CSR($careServicesRequest, $doc)
{
let $func :=$careServicesRequest//csd:function
let $adhoc :=$careServicesRequest//csd:expression
return if (exists($func))
then
 csr_proc:process_CSR_stored($func,$doc)
else if (exists($adhoc))
then
  csr_proc:process_CSR_adhoc($adhoc,$doc)
else
  <rest:response>
    <http:response status="400" message="Invalid care services request.">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>

};

declare function csr_proc:process_CSR_adhoc($expression,$doc)
{

let $expr :=serialize($expression/*)
return if ($expr) then
  let $result := xquery:eval($expr,map{"":=$doc})
  return(
   <rest:response>
   <http:response status="200" >
      <http:header name="Content-Type" value="{$expression/@content-type}"/>
    </http:response>
  </rest:response>
  ,$result
 )
else
   <rest:response>
     <http:response status="400" message="No ad-hoc expression" />
  </rest:response>
};

declare function csr_proc:process_CSR_stored($function,$doc)
{
if (csd_webconf:has_stored_query($function/@uuid))
then
  let $result := csd_webconf:execute_stored_query($doc,$function/@uuid,$function/requestParams)
  let $content_type := csd_webconf:lookup_stored_content_type($function/@uuid)
  return if ($function/@encapsulated)
  then
         csr_proc:wrap_result($result,$content_type)
  else
	 (<rest:response>
	   <http:response status="200" >
	     <http:header name="Content-Type" value="{$content_type}"/>
	   </http:response>
	 </rest:response>,
	 $result
	 )
else
    <rest:response>
     <http:response status="404" message="No registered function with UUID='{$function/@uuid}.'">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
     </http:response>
    </rest:response>

};

declare function csr_proc:wrap_result($result,$content-type) {
 <careServicesResponse content-type="{$content-type}"><result>{$result}</result></careServicesResponse>
};

declare function csr_proc:create_adhoc_doc($adhoc_query,$content_type) {
let $content := if ($content_type) then $content_type else "application/xml"
return
 <csd:careServicesRequest xmlns:csd='urn:ihe:iti:csd:2013'>
  <csd:expression content-type='{$content}'>
  {$adhoc_query}
  </csd:expression>
</csd:careServicesRequest>

};

declare updating function csr_proc:process_updating_CSR($careServicesRequest, $doc)
{
(:not allowing ad-hoc updates:)
let $func :=$careServicesRequest//csd:function
let $method :=
  if (exists($func) and csd_webconf:has_updating_stored_query($func/@uuid))
    then csd_webconf:get_updating_stored_query($func/@uuid) else ()
return
  if (exists($method)) then
    (:Assumes called method handles db:output.  Nothing is encapsulated :)
    db:output(
      $method($careServicesRequest//csd:function/requestParams,$doc)
       )
  else
  db:output(<rest:response>
    <http:response status="404" message="No registered updating function with UUID='{$func/@uuid}.'">
      <http:header name="Content-Language" value="en"/>
      <http:header name="Content-Type" value="text/html; charset=utf-8"/>
    </http:response>
  </rest:response>
     )
};