tricu

A lazy functional language based on Tree Calculus
Log | Files | Refs | README | LICENSE

artifact-service.tri (3021B)

      1 !import base as B
      2 !import io as IO
      3 !import handlers as H
      4 !import handler_artifacts as A
      5 !export prepare
      6 !export publish
      7 !export load
      8 !export rawLoad
      9 !export rawPublish
     10 !export routed
     11 !export captured
     12 !export forwarded
     13 !export rejectedView
     14 !import arboricx_handlers as Registry
     15 !import handler_log as Log
     16 !export route
     17 !export routeFailedLog
     18 !export capturedPackage
     19 !export routeStdout
     20 !export routeCancelledLog
     21 !import io_artifacts as Stream
     22 !export streamPublish
     23 
     24 prepare root = IO.io (H.runIO (A.prepareFilesystem root))
     25 publish root limit bytes = IO.io (H.runIO (A.withFilesystem root limit (A.publish bytes)))
     26 load root limit digest = IO.io (H.runIO (A.withFilesystem root limit (A.load digest)))
     27 rawLoad root limit digest = IO.io (H.runIO (A.withFilesystem root limit (H.request "artifacts" "load" digest)))
     28 rawPublish root limit bytes = IO.io (H.runIO (A.withFilesystem root limit (H.request "artifacts" "publish" bytes)))
     29 routed outer inner limit bytes = IO.io (H.runIO
     30   (A.withFilesystem outer limit (A.withFilesystem inner limit (A.publish bytes))))
     31 captured outer inner limit bytes = IO.io (H.runIO
     32   (A.withFilesystemFor "captured" outer limit
     33     (A.withFilesystem inner limit (A.publishTo "captured" bytes))))
     34 forwarded root = IO.io (H.runIO
     35   (H.handle "artifacts" (operation payload : H.pure [operation payload])
     36     (A.withFilesystem root 0 (H.request "artifacts" "other" 42))))
     37 
     38 rejectedView root limit bytes = H.view (A.withFilesystem root limit (H.request "artifacts" "publish" bytes))
     39 
     40 silent _ = H.pure (B.ok t t)
     41 failedLog _ = H.pure (B.err "private logger diagnostic" t)
     42 route root limit method target body = IO.io (Registry.router root limit silent method target [] body)
     43 routeFailedLog root limit body = IO.io (Registry.router root limit failedLog "POST" "/_arboricx/bundle" [] body)
     44 capturedPackage root other limit target = IO.io (H.runIO
     45   (Registry.request (Registry.packageLookup root limit) "GET" target [] []
     46     |> A.withFilesystem other limit
     47     |> Log.withSink silent))
     48 cancelledLog _ = H.liftIO (IO.cancelled "logger stopped")
     49 routeStdout root limit = IO.io (Registry.router root limit Registry.stdoutLog "GET" "/_arboricx/health" [] [])
     50 routeCancelledLog root limit body = IO.io (IO.scope (_ : do IO.require
     51   spawned <- IO.spawn 1 1 [] (_ : Registry.router root limit cancelledLog "POST" "/_arboricx/bundle" [] body)
     52   case spawned of
     53     [task ticket] = IO.require (IO.join ticket) IO.pure
     54     _ = IO.fail "Invalid test spawn reply"))
     55 pump reader = H.bind (H.liftIO (IO.readSome reader 4096)) (reply : case reply of
     56   ((t t), (("eof", t), t)) = H.pure (B.ok t t)
     57   ((t t), (("data", bytes), t)) = H.bind (Stream.write bytes) (written : case written of
     58     ((t t), (t, t)) = pump reader
     59     _ = H.pure written)
     60   (t, (_, t)) = H.pure reply
     61   _ = H.fail "invalid-response" "reader" "read" "Invalid read reply")
     62 streamPublish root source expected = IO.io (IO.scope (owner : IO.require
     63   (IO.openReader owner source) (reader : H.runIO (A.publishStream root expected (pump reader)))))