package MlFront_Exec

  1. Overview
  2. Docs
package MlFront_Exec
Legend:
Page
Library
Module
Module type
Parameter
Class
Class type
Source

Source file BuildTaskAsset.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
open BuildCore

let get_asset_path_exn : Alacarte_3_2_apparatus.K.t -> _ = function
  | {
      key_datum =
        ModuleKey
          {
            module_kind = UserAssetKind { asset_path };
            module_id = _;
            module_semver = _;
          };
      debug_reference = _;
    } ->
      asset_path
  | k ->
      Printf.ksprintf failwith "The key %s does not have a asset path"
        (Alacarte_3_2_apparatus.K.show k)

let get_asset_value ~config ~fetch ~values_file_sha256 ~k_user_asset () :
    ( Alacarte_3_2_apparatus.V.asset Alacarte_3_2_apparatus.V.persistent,
      unit )
    result
    Alacarte_6_4_test.CSuspending.t =
  let open Alacarte_3_2_apparatus in
  let open BuildInstance.Syntax in
  let asset_id = K.module_version_exn k_user_asset in
  let asset_path = get_asset_path_exn k_user_asset in
  let cant_do = Printf.sprintf "find asset `%s`" (K.show k_user_asset) in
  let build =
    MlFront_Thunk.ThunkSemver64.build
      (asset_id : MlFront_Thunk.ThunkCommand.module_version).version
  in
  (* Add dependency to parsed values, and extract the asset from its index *)
  let* asset_result =
    BuildTask.depend_on_values_ast ~fetch ~error_locations:[]
      ~values_file_sha256 (fun ast ->
        match MlFront_Thunk.ThunkAst.find_asset ast asset_id asset_path with
        | None ->
            Error
              (Printf.sprintf "AST did not contain the asset `%s` at path `%s`"
                 (MlFront_Thunk.ThunkCommand.show_module_version asset_id)
                 asset_path)
        | Some asset -> Ok asset)
  in
  match asset_result with
  | `Failure_is_pending -> return (Error ())
  | `FoundInValues
      {
        answer =
          ( {
              file_canonical_id;
              file_origin = _;
              file_path;
              file_checksum;
              file_sz;
            },
            { origin_name = _; origin_mirrors },
            asset_range );
        answer_values_file = values_file;
        answer_values_file_sha256 = values_file_sha256;
        answer_values_canonical_id = asset_values_canonical_id;
      } -> (
      (* Extract from [asset_result] *)
      let value_id =
        BuildTask.value_id_asset ~cid:file_canonical_id ~build ()
      in

      (* Download *)
      let on_fail ~location_if_checksum_error ~error_code ~because
          ~recommendations () =
        let* error_locations =
          let range =
            match location_if_checksum_error with
            | Some range -> range
            | None -> asset_range
          in
          BuildTaskForm.range_into_problem_location ~source:values_file range
        in
        fail ~error_code ~cant_do ~because ~recommendations ~error_locations
          ~exitcode_posix:2 ~exitcode_windows:2 ()
      in
      let* download_result =
        BuildInstance.ValueStore.download_value
          ~valuestore:(BuildConfig.valuestore config)
          ~download:
            ((BuildConfig.download config)
               ~on_fail ~file_path ~file_checksum ~file_sz:(Some file_sz)
               ~origin_mirrors)
          ~on_error:(fun msg ->
            let* () = fail ~error_code:"d273d2f4" ~cant_do ~because:msg () in
            return `Failed)
          ~value_id
          (fun (`Sha256 (value_sha256, _value_size)) ->
            ({
               value_id;
               value_sha256;
               value =
                 Some
                   {
                     asset_id;
                     asset_range;
                     asset_values_canonical_id;
                     asset_values_file_sha256 = values_file_sha256;
                     asset_path;
                     asset_mirrors = origin_mirrors;
                     asset_checksum = file_checksum;
                   };
             }
              : V.asset V.persistent))
      in
      match download_result with
      | `Failed -> return (Error ())
      | `Success v -> return (Ok v))

let make_userassetkind_task_of_asset ~config ~k_user_asset ~values_file_sha256 :
    (Alacarte_3_2_apparatus.O.t ->
    Alacarte_3_2_apparatus.K.t ->
    Alacarte_3_2_apparatus.V.t Alacarte_6_4_test.CSuspending.t) ->
    Alacarte_3_2_apparatus.V.t Alacarte_6_4_test.CSuspending.t =
  let open Alacarte_3_2_apparatus in
  let open BuildInstance.Syntax in
  let asset_id = K.module_version_exn k_user_asset in

  (* Provide the task definition *)
  let task
      (fetch :
        Alacarte_3_2_apparatus.O.t ->
        Alacarte_3_2_apparatus.K.t ->
        Alacarte_3_2_apparatus.V.t Alacarte_6_4_test.CSuspending.t) =
    (* Add dependency to distribution *)
    let* dist_result =
      BuildTask.depend_on_distribution ~config ~fetch ~error_locations:[]
        ~module_version:asset_id
    in
    match dist_result with
    | `Failure_is_pending -> return V.Failure_is_pending
    | `Ok -> (
        let* av =
          get_asset_value ~config ~fetch ~values_file_sha256 ~k_user_asset ()
        in
        match av with
        | Ok av -> return (V.Asset av)
        | Error () -> return V.Failure_is_pending)
  in
  task