Merge branch 'dev' into contract/hashlock

.gitlab-ci.yml

@@ -80,9 +80,9 @@ dont-merge-to-master:
       - public
 
 .docker: &docker
-  image: docker:19
+  image: docker:19.03.5
   services:
-    - docker:19-dind
+    - docker:19.03.5-dind
 
 
 .before_script: &before_script

src/main/run/of_michelson.ml

@@ -97,7 +97,7 @@ let fetch_lambda_types (contract_ty:ex_ty) =
   | _ -> simple_fail "failed to fetch lambda types"
 
 let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Michelson.t) : run_res result =
-  let open! Tezos_raw_protocol_005_PsBabyM1 in
+  let open! Tezos_raw_protocol_006_PsCARTHA in
   let%bind (Ex_ty input_ty, Ex_ty output_ty) = fetch_lambda_types exp_type in
   let%bind input =
     Trace.trace_tzresult_lwt (simple_error "error parsing input") @@
@@ -127,7 +127,7 @@ let run_contract ?options (exp:Michelson.t) (exp_type:ex_ty) (input_michelson:Mi
     | _              -> fail @@ Errors.unknown_failwith_type () )
 
 let run_expression ?options (exp:Michelson.t) (exp_type:ex_ty) : run_res result =
-  let open! Tezos_raw_protocol_005_PsBabyM1 in
+  let open! Tezos_raw_protocol_006_PsCARTHA in
   let (Ex_ty exp_type') = exp_type in
   let exp = Michelson.strip_annots exp in
   let top_level = Script_ir_translator.Lambda

src/stages/common/PP.ml

@@ -166,7 +166,7 @@ let literal ppf (l : literal) =
   | Literal_string s ->
       fprintf ppf "%S" s
   | Literal_bytes b ->
-      fprintf ppf "0x%s" @@ Bytes.to_string @@ Bytes.escaped b
+      fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
   | Literal_address s ->
       fprintf ppf "@%S" s
   | Literal_operation _ ->

src/stages/common/test.ml

@@ -0,0 +1,5 @@
+open PP
+
+let%expect_test _ =
+  Format.printf "%a" literal (Literal_bytes (Bytes.of_string "foo")) ;
+  [%expect{| 0x666f6f |}]

tools/webide/packages/client/public/index.html

@@ -6,7 +6,6 @@
     <meta name="viewport" content="width=device-width, initial-scale=1" />
     <meta name="theme-color" content="#000000" />
     <meta name="description" content="The LIGO Playground for learning LIGO" />
-    <link rel="apple-touch-icon" href="logo192.png" />
     <!--
       manifest.json provides metadata used when your web app is installed on a
       user's mobile device or desktop. See https://developers.google.com/web/fundamentals/web-app-manifest/

tools/webide/packages/client/src/App.tsx

@@ -7,6 +7,7 @@ import { Examples } from './components/examples';
 import { FloatButtonComponent } from './components/float-button';
 import { HeaderComponent } from './components/header';
 import { TabsPanelComponent } from './components/tabs-panel';
+import { TooltipContainer } from './components/tooltip';
 import configureStore from './configure-store';
 
 const store = configureStore();
@@ -48,6 +49,7 @@ const App: React.FC = () => {
           href="https://discord.gg/9rhYaEt"
         ></FloatButtonComponent>
       </FeedbackContainer>
+      <TooltipContainer></TooltipContainer>
     </Provider>
   );
 };

tools/webide/packages/client/src/components/compile-pane.tsx

@@ -3,16 +3,25 @@ import { useDispatch, useSelector } from 'react-redux';
 import styled from 'styled-components';
 
 import { AppState } from '../redux/app';
-import { ChangeEntrypointAction, CompileState } from '../redux/compile';
-import { Group, Input, Label } from './inputs';
+import { ChangeEntrypointAction, ChangeMichelsonFormatAction, CompileState, MichelsonFormat } from '../redux/compile';
+import { CheckboxComponent } from './checkbox';
+import { Group, HGroup, Input, Label } from './inputs';
 
 const Container = styled.div``;
 
+const Checkbox = styled(CheckboxComponent)`
+  margin-right: 0.3em;
+`;
+
 export const CompilePaneComponent = () => {
   const dispatch = useDispatch();
   const entrypoint = useSelector<AppState, CompileState['entrypoint']>(
     state => state.compile.entrypoint
   );
+  const michelsonFormat = useSelector<
+    AppState,
+    CompileState['michelsonFormat']
+  >(state => state.compile.michelsonFormat);
 
   return (
     <Container>
@@ -26,6 +35,19 @@ export const CompilePaneComponent = () => {
           }
         ></Input>
       </Group>
+      <HGroup>
+        <Checkbox
+          checked={michelsonFormat === MichelsonFormat.Json}
+          onChanged={value =>
+            dispatch({
+              ...new ChangeMichelsonFormatAction(
+                value ? MichelsonFormat.Json : MichelsonFormat.Text
+              )
+            })
+          }
+        ></Checkbox>
+        <Label htmlFor="michelsonFormat">Output michelson in JSON format</Label>
+      </HGroup>
     </Container>
   );
 };

tools/webide/packages/client/src/components/float-button.tsx

@@ -1,5 +1,7 @@
-import React, { useState } from 'react';
-import styled, { css } from 'styled-components';
+import React from 'react';
+import styled from 'styled-components';
+
+import { Tooltip } from './tooltip';
 
 const Container = styled.div`
   display: flex;
@@ -36,46 +38,16 @@ const Button = styled.a`
   }
 `;
 
-const Tooltip = styled.div<{ visible?: boolean }>`
-  position: absolute;
-  pointer-events: none;
-  z-index: 3;
-  white-space: nowrap;
-  transform: translateX(-6.5em);
-
-  font-size: var(--font_sub_size);
-  color: var(--tooltip_foreground);
-  background-color: var(--tooltip_background);
-  border-radius: 6px;
-  padding: 5px 10px;
-  opacity: 0;
-  transition: opacity 0.2s ease 0.2s;
-
-  ${props =>
-    props.visible &&
-    css`
-      opacity: 1;
-    `}
-`;
-
 export const FloatButtonComponent = (props: {
   tooltip: string;
   text: string;
   href: string;
   className?: string;
 }) => {
-  const [isTooltipShowing, setShowTooltip] = useState(false);
-
   return (
     <Container className={props.className}>
-      <Tooltip visible={isTooltipShowing}>{props.tooltip}</Tooltip>
-      <Button
-        onMouseOver={() => setShowTooltip(true)}
-        onMouseOut={() => setShowTooltip(false)}
-        href={props.href}
-        target="_blank"
-        rel="noopener noreferrer"
-      >
+      <Tooltip position="left">{props.tooltip}</Tooltip>
+      <Button href={props.href} target="_blank" rel="noopener noreferrer">
         {props.text}
       </Button>
     </Container>

tools/webide/packages/client/src/components/output-tab.tsx

@@ -7,6 +7,7 @@ import { AppState } from '../redux/app';
 import { CommandState } from '../redux/command';
 import { DoneLoadingAction, LoadingState } from '../redux/loading';
 import { ResultState } from '../redux/result';
+import { OutputToolbarComponent } from './output-toolbar';
 
 const Container = styled.div<{ visible?: boolean }>`
   position: absolute;
@@ -15,8 +16,8 @@ const Container = styled.div<{ visible?: boolean }>`
   height: 100%;
 
   font-family: Menlo, Monaco, 'Courier New', monospace;
-  overflow: scroll;
   display: flex;
+  flex-direction: column;
 
   transform: translateX(100%);
   transition: transform 0.2s ease-in;
@@ -42,9 +43,9 @@ const CancelButton = styled.div`
 
 const Output = styled.div`
   flex: 1;
-  padding: 0.8em;
+  padding: 0 0.5em 0.5em 0.5em;
   display: flex;
-
+  overflow: scroll;
   /* This font size is used to calcuate spinner size */
   font-size: 1em;
 `;
@@ -65,6 +66,37 @@ const Pre = styled.pre`
   margin: 0;
 `;
 
+function copyOutput(el: HTMLElement | null) {
+  if (el) {
+    const range = document.createRange();
+    range.selectNodeContents(el);
+
+    const selection = window.getSelection();
+
+    if (selection) {
+      selection.removeAllRanges();
+      selection.addRange(range);
+      document.execCommand('copy');
+    }
+  }
+}
+
+function downloadOutput(el: HTMLElement | null) {
+  if (el) {
+    const anchor = document.createElement('a');
+    anchor.setAttribute(
+      'href',
+      'data:text/plain;charset=utf-8,' + encodeURIComponent(el.innerHTML)
+    );
+    anchor.setAttribute('download', 'output.txt');
+
+    anchor.style.display = 'none';
+    document.body.appendChild(anchor);
+    anchor.click();
+    document.body.removeChild(anchor);
+  }
+}
+
 export const OutputTabComponent = (props: {
   selected?: boolean;
   onCancel?: () => void;
@@ -85,13 +117,14 @@ export const OutputTabComponent = (props: {
 
   const dispatch = useDispatch();
 
-  const outputRef = useRef(null);
+  const outputRef = useRef<HTMLDivElement>(null);
+  const preRef = useRef<HTMLPreElement>(null);
   const [spinnerSize, setSpinnerSize] = useState(50);
 
   useEffect(() => {
-    const htmlElement = (outputRef.current as unknown) as HTMLElement;
+    const outputEl = (outputRef.current as unknown) as HTMLElement;
     const fontSize = window
-      .getComputedStyle(htmlElement, null)
+      .getComputedStyle(outputEl, null)
       .getPropertyValue('font-size');
 
     setSpinnerSize(parseFloat(fontSize) * 3);
@@ -99,6 +132,12 @@ export const OutputTabComponent = (props: {
 
   return (
     <Container visible={props.selected}>
+      {output.length !== 0 && (
+        <OutputToolbarComponent
+          onCopy={() => copyOutput(preRef.current)}
+          onDownload={() => downloadOutput(preRef.current)}
+        ></OutputToolbarComponent>
+      )}
       <Output id="output" ref={outputRef}>
         {loading.loading && (
           <LoadingContainer>
@@ -122,7 +161,7 @@ export const OutputTabComponent = (props: {
           </LoadingContainer>
         )}
         {!loading.loading &&
-          ((output.length !== 0 && <Pre>{output}</Pre>) ||
+          ((output.length !== 0 && <Pre ref={preRef}>{output}</Pre>) ||
             (contract.length !== 0 && (
               <span>
                 The contract was successfully deployed to the babylonnet test

tools/webide/packages/client/src/components/output-toolbar.tsx

@@ -0,0 +1,78 @@
+import { faCopy, faDownload } from '@fortawesome/free-solid-svg-icons';
+import { FontAwesomeIcon } from '@fortawesome/react-fontawesome';
+import React from 'react';
+import styled from 'styled-components';
+
+import { Tooltip } from './tooltip';
+
+const Container = styled.div`
+  display: flex;
+  justify-content: flex-start;
+  padding: 0.2em 0.5em;
+  z-index: 3;
+`;
+
+const Action = styled.div`
+  z-index: 3;
+  position: relative;
+  margin: 4px 6px;
+  cursor: pointer;
+
+  opacity: 0.5;
+  color: #444;
+
+  ::before {
+    content: '';
+    display: block;
+    position: absolute;
+    z-index: -1;
+    bottom: -4px;
+    left: -4px;
+    right: -4px;
+    top: -4px;
+    border-radius: 4px;
+    background: none;
+    box-sizing: border-box;
+    opacity: 0;
+    transform: scale(0);
+    transition-property: transform, opacity;
+    transition-duration: 0.15s;
+    transition-timing-function: cubic-bezier(0.4, 0, 0.2, 1);
+  }
+
+  :hover::before {
+    background-color: rgba(32, 33, 36, 0.059);
+    opacity: 1;
+    transform: scale(1);
+  }
+
+  :hover {
+    opacity: 1;
+  }
+
+  &:first-child {
+    margin-left: 0;
+  }
+
+  &:last-child {
+    margin-right: 0;
+  }
+`;
+
+export const OutputToolbarComponent = (props: {
+  onCopy?: () => void;
+  onDownload?: () => void;
+}) => {
+  return (
+    <Container>
+      <Action onClick={() => props.onCopy && props.onCopy()}>
+        <FontAwesomeIcon icon={faCopy}></FontAwesomeIcon>
+        <Tooltip>Copy</Tooltip>
+      </Action>
+      <Action onClick={() => props.onDownload && props.onDownload()}>
+        <FontAwesomeIcon icon={faDownload}></FontAwesomeIcon>
+        <Tooltip>Download</Tooltip>
+      </Action>
+    </Container>
+  );
+};

tools/webide/packages/client/src/components/share.tsx

@@ -8,6 +8,7 @@ import styled, { css } from 'styled-components';
 import { AppState } from '../redux/app';
 import { ChangeShareLinkAction, ShareState } from '../redux/share';
 import { share } from '../services/api';
+import { Tooltip } from './tooltip';
 
 const Container = styled.div`
   display: flex;
@@ -96,26 +97,6 @@ const Input = styled.input<{ visible?: boolean }>`
     `}
 `;
 
-const Tooltip = styled.div<{ visible?: boolean }>`
-  position: absolute;
-  pointer-events: none;
-  z-index: 3;
-  transform: translateY(2.5em);
-  font-size: var(--font_sub_size);
-  color: var(--tooltip_foreground);
-  background-color: var(--tooltip_background);
-  border-radius: 6px;
-  padding: 5px 10px;
-  opacity: 0;
-  transition: opacity 0.2s ease 0.2s;
-
-  ${props =>
-    props.visible &&
-    css`
-      opacity: 1;
-    `}
-`;
-
 const shareAction = () => {
   return async function(dispatch: Dispatch, getState: () => AppState) {
     try {
@@ -138,7 +119,6 @@ export const ShareComponent = () => {
     state => state.share.link
   );
   const [clicked, setClicked] = useState(false);
-  const [isTooltipShowing, setShowTooltip] = useState(false);
 
   const SHARE_TOOLTIP = 'Share code';
   const COPY_TOOLTIP = 'Copy link';
@@ -149,14 +129,12 @@ export const ShareComponent = () => {
     if (shareLink) {
       if (inputEl.current && copy(inputEl.current)) {
         setTooltipMessage(COPIED_TOOLTIP);
-        setShowTooltip(true);
       } else {
         setClicked(true);
         setTooltipMessage(COPY_TOOLTIP);
       }
     } else {
       setClicked(false);
-      setShowTooltip(false);
       setTooltipMessage(SHARE_TOOLTIP);
     }
   }, [shareLink]);
@@ -177,9 +155,7 @@ export const ShareComponent = () => {
           if (tooltipMessage === COPIED_TOOLTIP) {
             setTooltipMessage(COPY_TOOLTIP);
           }
-          setShowTooltip(true);
         }}
-        onMouseOut={() => setShowTooltip(false)}
         onClick={() => {
           if (!shareLink) {
             dispatch(shareAction());
@@ -193,7 +169,7 @@ export const ShareComponent = () => {
       >
         <Label visible={!clicked}>Share</Label>
         <Copy visible={clicked}></Copy>
-        <Tooltip visible={isTooltipShowing}>{tooltipMessage}</Tooltip>
+        <Tooltip>{tooltipMessage}</Tooltip>
       </Button>
     </Container>
   );

tools/webide/packages/client/src/components/tabs-panel.tsx

@@ -69,7 +69,11 @@ export const TabsPanelComponent = () => {
     <Container>
       <Header>
         {TABS.map(tab => (
-          <Tab id={tab.id} selected={selectedTab.index === tab.index}>
+          <Tab
+            key={tab.id}
+            id={tab.id}
+            selected={selectedTab.index === tab.index}
+          >
             <Label onClick={() => selectTab(tab)}>{tab.label}</Label>
           </Tab>
         ))}

tools/webide/packages/client/src/components/tooltip.tsx

@@ -0,0 +1,104 @@
+import React, { createElement, useEffect, useRef, useState } from 'react';
+import { render } from 'react-dom';
+import styled from 'styled-components';
+
+const Container = styled.div`
+  position: fixed;
+  z-index: 1000;
+  top: 0;
+  left: 0;
+  height: 100%;
+  width: 100%;
+  pointer-events: none;
+`;
+
+export const StyledTooltip = styled.div<{
+  visible: boolean;
+  x: string;
+  y: string;
+}>`
+  position: fixed;
+  pointer-events: none;
+  z-index: 1001;
+  font-size: var(--font_sub_size);
+  color: var(--tooltip_foreground);
+  background-color: var(--tooltip_background);
+  border-radius: 6px;
+  padding: 5px 10px;
+  opacity: 0;
+  transition: opacity 0.2s ease 0.2s;
+  transform-origin: center;
+
+  ${({ x, y }) => `transform: translate(calc(${x}), calc(${y}));`}
+  ${({ visible }) => visible && `opacity: 1;`}
+`;
+
+const TOOLTIP_CONTAINER_ID = 'tooltip-container';
+type Position = 'top' | 'bottom' | 'left' | 'right';
+
+export const TooltipContainer = () => {
+  return <Container id={TOOLTIP_CONTAINER_ID}></Container>;
+};
+
+function calcX(triggerRect: ClientRect, position?: Position) {
+  if ('left' === position) {
+    return `${triggerRect.left - 10}px - 100%`;
+  } else if ('right' === position) {
+    return `${triggerRect.right + 10}px`;
+  }
+
+  return `${triggerRect.left + triggerRect.width / 2}px - 50%`;
+}
+
+function calcY(triggerRect: ClientRect, position?: string) {
+  if ('top' === position) {
+    return `${triggerRect.top - 10}px - 100%`;
+  } else if (!position || 'bottom' === position) {
+    return `${triggerRect.bottom + 10}px`;
+  }
+
+  return `${triggerRect.top + triggerRect.height / 2}px - 50%`;
+}
+
+export const Tooltip = (props: { position?: Position; children: any }) => {
+  const ref = useRef<HTMLDivElement>(null);
+  const [isTooltipVisible, setTooltipVisible] = useState(false);
+
+  const renderTooltip = (visible: boolean, triggerRect: ClientRect) => {
+    const tooltip = createElement(
+      StyledTooltip,
+      {
+        visible,
+        x: calcX(triggerRect, props.position),
+        y: calcY(triggerRect, props.position)
+      },
+      props.children
+    );
+
+    render(tooltip, document.getElementById(TOOLTIP_CONTAINER_ID));
+  };
+
+  useEffect(() => {
+    if (ref.current) {
+      const trigger = (ref.current as HTMLElement).parentElement;
+
+      if (trigger) {
+        if (isTooltipVisible) {
+          renderTooltip(true, trigger.getBoundingClientRect());
+        }
+
+        trigger.onmouseenter = _ => {
+          renderTooltip(true, trigger.getBoundingClientRect());
+          setTooltipVisible(true);
+        };
+
+        trigger.onmouseleave = _ => {
+          renderTooltip(false, trigger.getBoundingClientRect());
+          setTooltipVisible(false);
+        };
+      }
+    }
+  });
+
+  return <div ref={ref}></div>;
+};

tools/webide/packages/client/src/index.css

@@ -50,6 +50,7 @@
 
   --tooltip_foreground: white;
   --tooltip_background: rgba(0, 0, 0, 0.75) /*#404040*/;
+  --label_foreground: rgba(153, 153, 153, 1);
 }
 
 body {

tools/webide/packages/client/src/redux/actions/compile.ts

@@ -16,7 +16,8 @@ export class CompileAction extends CancellableAction {
         const michelsonCode = await compileContract(
           editor.language,
           editor.code,
-          compileState.entrypoint
+          compileState.entrypoint,
+          compileState.michelsonFormat
         );
 
         if (this.isCancelled()) {

tools/webide/packages/client/src/redux/compile.ts

@@ -6,11 +6,13 @@ export enum MichelsonFormat {
 }
 
 export enum ActionType {
-  ChangeEntrypoint = 'compile-change-entrypoint'
+  ChangeEntrypoint = 'compile-change-entrypoint',
+  ChangeMichelsonFormat = 'compile-change-michelson-format'
 }
 
 export interface CompileState {
   entrypoint: string;
+  michelsonFormat: MichelsonFormat;
 }
 
 export class ChangeEntrypointAction {
@@ -18,10 +20,19 @@ export class ChangeEntrypointAction {
   constructor(public payload: CompileState['entrypoint']) {}
 }
 
-type Action = ChangeEntrypointAction | ChangeSelectedExampleAction;
+export class ChangeMichelsonFormatAction {
+  public readonly type = ActionType.ChangeMichelsonFormat;
+  constructor(public payload: CompileState['michelsonFormat']) {}
+}
+
+type Action =
+  | ChangeEntrypointAction
+  | ChangeMichelsonFormatAction
+  | ChangeSelectedExampleAction;
 
 const DEFAULT_STATE: CompileState = {
-  entrypoint: ''
+  entrypoint: '',
+  michelsonFormat: MichelsonFormat.Text
 };
 
 export default (state = DEFAULT_STATE, action: Action): CompileState => {
@@ -36,6 +47,12 @@ export default (state = DEFAULT_STATE, action: Action): CompileState => {
         ...state,
         entrypoint: action.payload
       };
+    case ActionType.ChangeMichelsonFormat:
+      return {
+        ...state,
+        michelsonFormat: action.payload
+      };
+    default:
+      return state;
   }
-  return state;
 };

tools/webide/packages/client/src/redux/share.ts

@@ -1,4 +1,8 @@
-import { ActionType as CompileActionType, ChangeEntrypointAction as ChangeCompileEntrypointAction } from './compile';
+import {
+  ActionType as CompileActionType,
+  ChangeEntrypointAction as ChangeCompileEntrypointAction,
+  ChangeMichelsonFormatAction,
+} from './compile';
 import {
   ActionType as DeployActionType,
   ChangeEntrypointAction as ChangeDeployEntrypointAction,
@@ -40,6 +44,7 @@ type Action =
   | ChangeCodeAction
   | ChangeLanguageAction
   | ChangeCompileEntrypointAction
+  | ChangeMichelsonFormatAction
   | ChangeDeployEntrypointAction
   | ChangeDeployStorageAction
   | UseTezBridgeAction
@@ -61,7 +66,6 @@ export default (state = DEFAULT_STATE, action: Action): ShareState => {
     case CompileActionType.ChangeEntrypoint:
     case DeployActionType.ChangeEntrypoint:
     case DeployActionType.ChangeStorage:
-    case DeployActionType.UseTezBridge:
     case DryRunActionType.ChangeEntrypoint:
     case DryRunActionType.ChangeParameters:
     case DryRunActionType.ChangeStorage:

tools/webide/packages/client/src/services/api.ts

@@ -30,7 +30,7 @@ export async function compileExpression(
 ) {
   const response = await axios.post('/api/compile-expression', {
     syntax,
-    expression,
+    expression: `${expression}`,
     format
   });
   return response.data;
@@ -64,14 +64,24 @@ export async function share({
   evaluateValue,
   evaluateFunction
 }: Partial<AppState>) {
-  const response = await axios.post('/api/share', {
+  const params = {
     editor,
     compile,
     dryRun,
     deploy,
     evaluateValue,
     evaluateFunction
-  });
+  };
+
+  // We don't want to store the following configuration
+  if (params.compile) {
+    delete params.compile.michelsonFormat;
+  }
+  if (params.deploy) {
+    delete params.deploy.useTezBridge;
+  }
+
+  const response = await axios.post('/api/share', params);
   return response.data;
 }
 

tools/webide/packages/server/src/handlers/shared-link.ts

@@ -1,12 +1,12 @@
 import { Request, Response } from 'express';
 
 import { loadDefaultState } from '../load-state';
+import { logger } from '../logger';
 import latestSchema from '../schemas/share-latest';
 import { storage } from '../storage';
 import { FileNotFoundError } from '../storage/interface';
-import { logger } from '../logger';
 
-export function createSharedLinkHandler(
+export function sharedLinkHandler(
   appBundleDirectory: string,
   template: (state: string) => string
 ) {

tools/webide/packages/server/src/index.ts

@@ -9,9 +9,9 @@ import { dryRunHandler } from './handlers/dry-run';
 import { evaluateValueHandler } from './handlers/evaluate-value';
 import { runFunctionHandler } from './handlers/run-function';
 import { shareHandler } from './handlers/share';
-import { createSharedLinkHandler } from './handlers/shared-link';
+import { sharedLinkHandler } from './handlers/shared-link';
 import { loadDefaultState } from './load-state';
-import { loggerMiddleware, errorLoggerMiddleware } from './logger';
+import { errorLoggerMiddleware, loggerMiddleware } from './logger';
 
 var bodyParser = require('body-parser');
 var escape = require('escape-html');
@@ -47,7 +47,7 @@ app.use('^/$', async (_, res) =>
 app.use(express.static(appBundleDirectory));
 app.get(
   `/p/:hash([0-9a-zA-Z\-\_]+)`,
-  createSharedLinkHandler(appBundleDirectory, template)
+  sharedLinkHandler(appBundleDirectory, template)
 );
 app.post('/api/compile-contract', compileContractHandler);
 app.post('/api/compile-expression', compileExpressionHandler);

tools/webide/packages/server/src/load-state.ts

@@ -37,12 +37,30 @@ export async function loadDefaultState(appBundleDirectory: string) {
     );
     const defaultExample = JSON.parse(example);
 
-    defaultState.compile = defaultExample.compile;
-    defaultState.dryRun = defaultExample.dryRun;
-    defaultState.deploy = defaultExample.deploy;
-    defaultState.evaluateValue = defaultExample.evaluateValue;
-    defaultState.evaluateFunction = defaultExample.evaluateFunction;
-    defaultState.editor = defaultExample.editor;
+    defaultState.compile = {
+      ...defaultState.compile,
+      ...defaultExample.compile
+    };
+    defaultState.dryRun = {
+      ...defaultState.dryRun,
+      ...defaultExample.dryRun
+    };
+    defaultState.deploy = {
+      ...defaultState.deploy,
+      ...defaultExample.deploy
+    };
+    defaultState.evaluateValue = {
+      ...defaultState.evaluateValue,
+      ...defaultExample.evaluateValue
+    };
+    defaultState.evaluateFunction = {
+      ...defaultState.evaluateFunction,
+      ...defaultExample.evaluateFunction
+    };
+    defaultState.editor = {
+      ...defaultState.editor,
+      ...defaultExample.editor
+    };
     defaultState.examples.selected = defaultExample;
   }
 

tools/webide/packages/server/src/schemas/migration.ts

@@ -18,7 +18,9 @@ export abstract class Migration {
       }
 
       throw new Error(
-        `Unable to migrate ${data}. Reached the end of the migration chain.`
+        `Unable to migrate ${JSON.stringify(
+          data
+        )}. Reached the end of the migration chain.`
       );
     }
     return value;

vendors/ligo-utils/memory-proto-alpha/dune

@@ -3,6 +3,6 @@
   (public_name tezos-memory-proto-alpha)
   (libraries
     tezos-protocol-environment
-    tezos-protocol-005-PsBabyM1
+    tezos-protocol-006-PsCARTHA
   )
 )

vendors/ligo-utils/memory-proto-alpha/memory_proto_alpha.ml

@@ -1,9 +1,9 @@
 module Name = struct let name = "alpha" end
-module Alpha_environment = Tezos_protocol_005_PsBabyM1.Protocol.Environment
+module Alpha_environment = Tezos_protocol_006_PsCARTHA.Protocol.Environment
 
 
 type alpha_error = Alpha_environment.Error_monad.error
 type 'a alpha_tzresult = 'a Alpha_environment.Error_monad.tzresult
 module Alpha_error_monad = Alpha_environment.Error_monad
-module Proto = Tezos_protocol_005_PsBabyM1
+module Proto = Tezos_protocol_006_PsCARTHA
 include Proto

vendors/ligo-utils/memory-proto-alpha/tezos-memory-proto-alpha.opam

@@ -10,7 +10,7 @@ bug-reports: "https://gitlab.com/ligolang/tezos/issues"
 depends: [
   "dune"
   "tezos-protocol-environment"
-  "tezos-protocol-005-PsBabyM1"
+  "tezos-protocol-006-PsCARTHA"
 ]
 build: [
   ["dune" "build" "-p" name]

vendors/ligo-utils/proto-alpha-utils/dune

@@ -4,10 +4,10 @@
   (libraries
     tezos-error-monad
     tezos-stdlib-unix
-    tezos-protocol-005-PsBabyM1-parameters
+    tezos-protocol-006-PsCARTHA-parameters
     tezos-memory-proto-alpha
     simple-utils
     tezos-utils
   )
- (flags (:standard -open Simple_utils ))
+ (flags (:standard -open Simple_utils))
 )

vendors/ligo-utils/proto-alpha-utils/init_proto_alpha.ml

@@ -105,7 +105,7 @@ module Context_init = struct
       Pervasives.failwith "Must have one account with a roll to bake";
 
     (* Check there is at least one roll *)
-    let constants : Constants_repr.parametric = Tezos_protocol_005_PsBabyM1_parameters.Default_parameters.constants_test in
+    let constants : Constants_repr.parametric = Tezos_protocol_006_PsCARTHA_parameters.Default_parameters.constants_test in
     check_constants_consistency constants >>=? fun () ->
 
     let hash =

vendors/ligo-utils/proto-alpha-utils/proto-alpha-utils.opam

@@ -41,7 +41,7 @@ depends: [
   "tezos-data-encoding"
   "tezos-protocol-environment"
   "tezos-protocol-alpha"
-  "tezos-protocol-005-PsBabyM1-parameters"
+  "tezos-protocol-006-PsCARTHA"
   "michelson-parser"
   "simple-utils"
   "tezos-utils"

vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.ml

@@ -25,90 +25,98 @@
 
 open Protocol
 
-let constants_mainnet = Constants_repr.{
-    preserved_cycles = 5 ;
-    blocks_per_cycle = 4096l ;
-    blocks_per_commitment = 32l ;
-    blocks_per_roll_snapshot = 256l ;
-    blocks_per_voting_period = 32768l ;
-    time_between_blocks =
-      List.map Period_repr.of_seconds_exn [ 60L ; 40L ] ;
-    endorsers_per_block = 32 ;
-    hard_gas_limit_per_operation = Z.of_int 800_000 ;
-    hard_gas_limit_per_block = Z.of_int 8_000_000 ;
-    proof_of_work_threshold =
-      Int64.(sub (shift_left 1L 46) 1L) ;
-    tokens_per_roll = Tez_repr.(mul_exn one 8_000) ;
-    michelson_maximum_type_size = 1000 ;
-    seed_nonce_revelation_tip = begin
-      match Tez_repr.(one /? 8L) with
-      | Ok c -> c
-      | Error _ -> assert false
-    end ;
-    origination_size = 257 ;
-    block_security_deposit = Tez_repr.(mul_exn one 512) ;
-    endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;
-    block_reward = Tez_repr.(mul_exn one 16) ;
-    endorsement_reward = Tez_repr.(mul_exn one 2) ;
-    hard_storage_limit_per_operation = Z.of_int 60_000 ;
-    cost_per_byte = Tez_repr.of_mutez_exn 1_000L ;
-    test_chain_duration = Int64.mul 32768L 60L ;
-    quorum_min = 20_00l ; (* quorum is in centile of a percentage *)
-    quorum_max = 70_00l ;
-    min_proposal_quorum = 5_00l ;
-    initial_endorsers = 24 ;
-    delay_per_missing_endorsement = Period_repr.of_seconds_exn 8L ;
-  }
+let constants_mainnet =
+  Constants_repr.
+    {
+      preserved_cycles = 5;
+      blocks_per_cycle = 4096l;
+      blocks_per_commitment = 32l;
+      blocks_per_roll_snapshot = 256l;
+      blocks_per_voting_period = 32768l;
+      time_between_blocks = List.map Period_repr.of_seconds_exn [60L; 40L];
+      endorsers_per_block = 32;
+      hard_gas_limit_per_operation = Z.of_int 1_040_000;
+      hard_gas_limit_per_block = Z.of_int 10_400_000;
+      proof_of_work_threshold = Int64.(sub (shift_left 1L 46) 1L);
+      tokens_per_roll = Tez_repr.(mul_exn one 8_000);
+      michelson_maximum_type_size = 1000;
+      seed_nonce_revelation_tip =
+        (match Tez_repr.(one /? 8L) with Ok c -> c | Error _ -> assert false);
+      origination_size = 257;
+      block_security_deposit = Tez_repr.(mul_exn one 512);
+      endorsement_security_deposit = Tez_repr.(mul_exn one 64);
+      baking_reward_per_endorsement =
+        Tez_repr.[of_mutez_exn 1_250_000L; of_mutez_exn 187_500L];
+      endorsement_reward =
+        Tez_repr.[of_mutez_exn 1_250_000L; of_mutez_exn 833_333L];
+      hard_storage_limit_per_operation = Z.of_int 60_000;
+      cost_per_byte = Tez_repr.of_mutez_exn 1_000L;
+      test_chain_duration = Int64.mul 32768L 60L;
+      quorum_min = 20_00l;
+      (* quorum is in centile of a percentage *)
+      quorum_max = 70_00l;
+      min_proposal_quorum = 5_00l;
+      initial_endorsers = 24;
+      delay_per_missing_endorsement = Period_repr.of_seconds_exn 8L;
+    }
 
-let constants_sandbox = Constants_repr.{
-    constants_mainnet with
-    preserved_cycles = 2 ;
-    blocks_per_cycle = 8l ;
-    blocks_per_commitment = 4l ;
-    blocks_per_roll_snapshot = 4l ;
-    blocks_per_voting_period = 64l ;
-    time_between_blocks =
-      List.map Period_repr.of_seconds_exn [ 1L ; 0L ] ;
-    proof_of_work_threshold = Int64.of_int (-1) ;
-    initial_endorsers = 1 ;
-    delay_per_missing_endorsement = Period_repr.of_seconds_exn 1L ;
-  }
+let constants_sandbox =
+  Constants_repr.
+    {
+      constants_mainnet with
+      preserved_cycles = 2;
+      blocks_per_cycle = 8l;
+      blocks_per_commitment = 4l;
+      blocks_per_roll_snapshot = 4l;
+      blocks_per_voting_period = 64l;
+      time_between_blocks = List.map Period_repr.of_seconds_exn [1L; 0L];
+      proof_of_work_threshold = Int64.of_int (-1);
+      initial_endorsers = 1;
+      delay_per_missing_endorsement = Period_repr.of_seconds_exn 1L;
+    }
 
-let constants_test = Constants_repr.{
-    constants_mainnet with
-    blocks_per_cycle = 128l ;
-    blocks_per_commitment = 4l ;
-    blocks_per_roll_snapshot = 32l ;
-    blocks_per_voting_period = 256l ;
-    time_between_blocks =
-      List.map Period_repr.of_seconds_exn [ 1L ; 0L ] ;
-    proof_of_work_threshold = Int64.of_int (-1) ;
-    initial_endorsers = 1 ;
-    delay_per_missing_endorsement = Period_repr.of_seconds_exn 1L ;
-  }
+let constants_test =
+  Constants_repr.
+    {
+      constants_mainnet with
+      blocks_per_cycle = 128l;
+      blocks_per_commitment = 4l;
+      blocks_per_roll_snapshot = 32l;
+      blocks_per_voting_period = 256l;
+      time_between_blocks = List.map Period_repr.of_seconds_exn [1L; 0L];
+      proof_of_work_threshold = Int64.of_int (-1);
+      initial_endorsers = 1;
+      delay_per_missing_endorsement = Period_repr.of_seconds_exn 1L;
+    }
+
+let bootstrap_accounts_strings =
+  [ "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav";
+    "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9";
+    "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV";
+    "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU";
+    "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" ]
 
-let bootstrap_accounts_strings = [
-  "edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav" ;
-  "edpktzNbDAUjUk697W7gYg2CRuBQjyPxbEg8dLccYYwKSKvkPvjtV9" ;
-  "edpkuTXkJDGcFd5nh6VvMz8phXxU3Bi7h6hqgywNFi1vZTfQNnS1RV" ;
-  "edpkuFrRoDSEbJYgxRtLx2ps82UdaYc1WwfS9sE11yhauZt5DgCHbU" ;
-  "edpkv8EUUH68jmo3f7Um5PezmfGrRF24gnfLpH3sVNwJnV5bVCxL2n" ;
-]
 let boostrap_balance = Tez_repr.of_mutez_exn 4_000_000_000_000L
-let bootstrap_accounts = List.map (fun s ->
-    let public_key = Signature.Public_key.of_b58check_exn s in
-    let public_key_hash = Signature.Public_key.hash public_key in
-    Parameters_repr.{
-      public_key_hash ;
-      public_key = Some public_key ;
-      amount = boostrap_balance ;
-    })
+
+let bootstrap_accounts =
+  List.map
+    (fun s ->
+      let public_key = Signature.Public_key.of_b58check_exn s in
+      let public_key_hash = Signature.Public_key.hash public_key in
+      Parameters_repr.
+        {
+          public_key_hash;
+          public_key = Some public_key;
+          amount = boostrap_balance;
+        })
     bootstrap_accounts_strings
 
 (* TODO this could be generated from OCaml together with the faucet
    for now these are harcoded values in the tests *)
 let commitments =
-  let json_result = Data_encoding.Json.from_string {json|
+  let json_result =
+    Data_encoding.Json.from_string
+      {json|
   [
     [ "btz1bRL4X5BWo2Fj4EsBdUwexXqgTf75uf1qa", "23932454669343" ],
     [ "btz1SxjV1syBgftgKy721czKi3arVkVwYUFSv", "72954577464032" ],
@@ -123,27 +131,28 @@ let commitments =
   ]|json}
   in
   match json_result with
-  | Error err -> raise (Failure err)
-  | Ok json -> Data_encoding.Json.destruct
-                 (Data_encoding.list Commitment_repr.encoding) json
+  | Error err ->
+      raise (Failure err)
+  | Ok json ->
+      Data_encoding.Json.destruct
+        (Data_encoding.list Commitment_repr.encoding)
+        json
 
 let make_bootstrap_account (pkh, pk, amount) =
-  Parameters_repr.{ public_key_hash = pkh ; public_key = Some pk ; amount }
+  Parameters_repr.{public_key_hash = pkh; public_key = Some pk; amount}
 
-let parameters_of_constants
-    ?(bootstrap_accounts = bootstrap_accounts)
-    ?(bootstrap_contracts = [])
-    ?(with_commitments = false)
-    constants =
+let parameters_of_constants ?(bootstrap_accounts = bootstrap_accounts)
+    ?(bootstrap_contracts = []) ?(with_commitments = false) constants =
   let commitments = if with_commitments then commitments else [] in
-  Parameters_repr.{
-    bootstrap_accounts ;
-    bootstrap_contracts ;
-    commitments ;
-    constants ;
-    security_deposit_ramp_up_cycles = None ;
-    no_reward_cycles = None ;
-  }
+  Parameters_repr.
+    {
+      bootstrap_accounts;
+      bootstrap_contracts;
+      commitments;
+      constants;
+      security_deposit_ramp_up_cycles = None;
+      no_reward_cycles = None;
+    }
 
 let json_of_parameters parameters =
   Data_encoding.Json.construct Parameters_repr.encoding parameters

vendors/ligo-utils/tezos-protocol-alpha-parameters/default_parameters.mli

@@ -25,18 +25,21 @@
 
 open Protocol
 
-val constants_mainnet: Constants_repr.parametric
-val constants_sandbox: Constants_repr.parametric
-val constants_test: Constants_repr.parametric
+val constants_mainnet : Constants_repr.parametric
 
-val make_bootstrap_account:
+val constants_sandbox : Constants_repr.parametric
+
+val constants_test : Constants_repr.parametric
+
+val make_bootstrap_account :
   Signature.public_key_hash * Signature.public_key * Tez_repr.t ->
   Parameters_repr.bootstrap_account
 
-val parameters_of_constants:
+val parameters_of_constants :
   ?bootstrap_accounts:Parameters_repr.bootstrap_account list ->
   ?bootstrap_contracts:Parameters_repr.bootstrap_contract list ->
   ?with_commitments:bool ->
-  Constants_repr.parametric -> Parameters_repr.t
+  Constants_repr.parametric ->
+  Parameters_repr.t
 
-val json_of_parameters: Parameters_repr.t -> Data_encoding.json
+val json_of_parameters : Parameters_repr.t -> Data_encoding.json

vendors/ligo-utils/tezos-protocol-alpha-parameters/dune

@@ -1,22 +1,22 @@
 (library
- (name tezos_protocol_005_PsBabyM1_parameters)
- (public_name tezos-protocol-005-PsBabyM1-parameters)
+ (name tezos_protocol_006_PsCARTHA_parameters)
+ (public_name tezos-protocol-006-PsCARTHA-parameters)
  (modules :standard \ gen)
  (libraries tezos-base
             tezos-protocol-environment
-            tezos-protocol-005-PsBabyM1)
+            tezos-protocol-006-PsCARTHA)
  (flags (:standard -open Tezos_base__TzPervasives
-                   -open Tezos_protocol_005_PsBabyM1
+                   -open Tezos_protocol_006_PsCARTHA
                    -linkall))
 )
 
 (executable
  (name gen)
  (libraries tezos-base
-            tezos-protocol-005-PsBabyM1-parameters)
+            tezos-protocol-006-PsCARTHA-parameters)
  (modules gen)
  (flags (:standard -open Tezos_base__TzPervasives
-                   -open Tezos_protocol_005_PsBabyM1_parameters
+                   -open Tezos_protocol_006_PsCARTHA_parameters
                    -linkall)))
 
 (rule

vendors/ligo-utils/tezos-protocol-alpha-parameters/dune-project

@@ -1,2 +1,2 @@
 (lang dune 1.11)
-(name tezos-protocol-005-PsBabyM1-parameters)
+(name tezos-protocol-006-PsCARTHA-parameters)

vendors/ligo-utils/tezos-protocol-alpha-parameters/gen.ml

@@ -29,18 +29,19 @@
 
 let () =
   let print_usage_and_fail s =
-    Printf.eprintf "Usage: %s [ --sandbox | --test | --mainnet ]"
-      Sys.argv.(0) ;
+    Printf.eprintf "Usage: %s [ --sandbox | --test | --mainnet ]" Sys.argv.(0) ;
     raise (Invalid_argument s)
   in
   let dump parameters file =
-    let str = Data_encoding.Json.to_string
-        (Default_parameters.json_of_parameters parameters) in
+    let str =
+      Data_encoding.Json.to_string
+        (Default_parameters.json_of_parameters parameters)
+    in
     let fd = open_out file in
-    output_string fd str ;
-    close_out fd
+    output_string fd str ; close_out fd
   in
-  if Array.length Sys.argv < 2 then print_usage_and_fail "" else
+  if Array.length Sys.argv < 2 then print_usage_and_fail ""
+  else
     match Sys.argv.(1) with
     | "--sandbox" ->
         dump
@@ -48,10 +49,13 @@ let () =
           "sandbox-parameters.json"
     | "--test" ->
         dump
-          Default_parameters.(parameters_of_constants ~with_commitments:true constants_sandbox)
+          Default_parameters.(
+            parameters_of_constants ~with_commitments:true constants_sandbox)
           "test-parameters.json"
     | "--mainnet" ->
         dump
-          Default_parameters.(parameters_of_constants ~with_commitments:true constants_mainnet)
+          Default_parameters.(
+            parameters_of_constants ~with_commitments:true constants_mainnet)
           "mainnet-parameters.json"
-    | s -> print_usage_and_fail s
+    | s ->
+        print_usage_and_fail s

vendors/ligo-utils/tezos-protocol-alpha-parameters/tezos-protocol-006-PsCARTHA-parameters.opam

@@ -8,12 +8,13 @@ license: "MIT"
 depends: [
   "tezos-tooling" { with-test }
   "ocamlfind" { build }
-  "dune" { build & >= "1.7" }
+  "dune" { >= "1.7" }
   "tezos-base"
   "tezos-protocol-environment"
-  "tezos-protocol-005-PsBabyM1"
+  "tezos-protocol-006-PsCARTHA"
 ]
 build: [
-  [ "dune" "build" "-p" name "-j" jobs ]
+  ["dune" "build" "-p" name "-j" jobs]
+  ["dune" "runtest" "-p" name "-j" jobs] {with-test}
 ]
 synopsis: "Tezos/Protocol: parameters"

vendors/ligo-utils/tezos-protocol-alpha/TEZOS_PROTOCOL

@@ -1,5 +1,5 @@
 {
-    "hash": "PsBabyM1eUXZseaJdmXFApDSBqj8YBfwELoxZHHW77EMcAbbwAS",
+    "hash": "PsCARTHAGazKbHtnKfLzQg3kms52kSRpgnDY982a9oYsSXRLQEb",
     "modules": [
         "Misc",
         "Storage_description",

vendors/ligo-utils/tezos-protocol-alpha/alpha_context.ml

@@ -24,13 +24,17 @@
 (*****************************************************************************)
 
 type t = Raw_context.t
+
 type context = t
 
 module type BASIC_DATA = sig
   type t
+
   include Compare.S with type t := t
-  val encoding: t Data_encoding.t
-  val pp: Format.formatter -> t -> unit
+
+  val encoding : t Data_encoding.t
+
+  val pp : Format.formatter -> t -> unit
 end
 
 module Tez = Tez_repr
@@ -38,61 +42,77 @@ module Period = Period_repr
 
 module Timestamp = struct
   include Time_repr
+
   let current = Raw_context.current_timestamp
 end
 
 include Operation_repr
+
 module Operation = struct
   type 'kind t = 'kind operation = {
-    shell: Operation.shell_header ;
-    protocol_data: 'kind protocol_data ;
+    shell : Operation.shell_header;
+    protocol_data : 'kind protocol_data;
   }
+
   type packed = packed_operation
+
   let unsigned_encoding = unsigned_operation_encoding
+
   include Operation_repr
 end
+
 module Block_header = Block_header_repr
+
 module Vote = struct
   include Vote_repr
   include Vote_storage
 end
+
 module Raw_level = Raw_level_repr
 module Cycle = Cycle_repr
 module Script_int = Script_int_repr
+
 module Script_timestamp = struct
   include Script_timestamp_repr
+
   let now ctxt =
-    let { Constants_repr.time_between_blocks ; _ } =
-      Raw_context.constants ctxt in
+    let {Constants_repr.time_between_blocks; _} = Raw_context.constants ctxt in
     match time_between_blocks with
-    | [] -> failwith "Internal error: 'time_between_block' constants \
-                      is an empty list."
+    | [] ->
+        failwith
+          "Internal error: 'time_between_block' constants is an empty list."
     | first_delay :: _ ->
         let current_timestamp = Raw_context.predecessor_timestamp ctxt in
         Time.add current_timestamp (Period_repr.to_seconds first_delay)
-        |> Timestamp.to_seconds
-        |> of_int64
+        |> Timestamp.to_seconds |> of_int64
 end
+
 module Script = struct
   include Michelson_v1_primitives
   include Script_repr
+
   let force_decode ctxt lexpr =
     Lwt.return
-      (Script_repr.force_decode lexpr >>? fun (v, cost) ->
-       Raw_context.consume_gas ctxt cost >|? fun ctxt ->
-       (v, ctxt))
+      ( Script_repr.force_decode lexpr
+      >>? fun (v, cost) ->
+      Raw_context.consume_gas ctxt cost >|? fun ctxt -> (v, ctxt) )
+
   let force_bytes ctxt lexpr =
     Lwt.return
-      (Script_repr.force_bytes lexpr >>? fun (b, cost) ->
-       Raw_context.consume_gas ctxt cost >|? fun ctxt ->
-       (b, ctxt))
+      ( Script_repr.force_bytes lexpr
+      >>? fun (b, cost) ->
+      Raw_context.consume_gas ctxt cost >|? fun ctxt -> (b, ctxt) )
+
   module Legacy_support = Legacy_script_support_repr
 end
+
 module Fees = Fees_storage
 
 type public_key = Signature.Public_key.t
+
 type public_key_hash = Signature.Public_key_hash.t
-type signature  = Signature.t
+
+type signature = Signature.t
 
 module Constants = struct
   include Constants_repr
@@ -103,66 +123,95 @@ module Voting_period = Voting_period_repr
 
 module Gas = struct
   include Gas_limit_repr
+
   type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high
+
   let check_limit = Raw_context.check_gas_limit
+
   let set_limit = Raw_context.set_gas_limit
+
   let set_unlimited = Raw_context.set_gas_unlimited
+
   let consume = Raw_context.consume_gas
+
   let check_enough = Raw_context.check_enough_gas
+
   let level = Raw_context.gas_level
+
   let consumed = Raw_context.gas_consumed
+
   let block_level = Raw_context.block_gas_level
 end
+
 module Level = struct
   include Level_repr
   include Level_storage
 end
+
 module Contract = struct
   include Contract_repr
   include Contract_storage
 
   let originate c contract ~balance ~script ~delegate =
     originate c contract ~balance ~script ~delegate
+
   let init_origination_nonce = Raw_context.init_origination_nonce
+
   let unset_origination_nonce = Raw_context.unset_origination_nonce
 end
+
 module Big_map = struct
   type id = Z.t
+
   let fresh = Storage.Big_map.Next.incr
+
   let fresh_temporary = Raw_context.fresh_temporary_big_map
+
   let mem c m k = Storage.Big_map.Contents.mem (c, m) k
+
   let get_opt c m k = Storage.Big_map.Contents.get_option (c, m) k
+
   let rpc_arg = Storage.Big_map.rpc_arg
+
   let cleanup_temporary c =
-    Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c >>= fun c ->
-    Lwt.return (Raw_context.reset_temporary_big_map c)
+    Raw_context.temporary_big_maps c Storage.Big_map.remove_rec c
+    >>= fun c -> Lwt.return (Raw_context.reset_temporary_big_map c)
+
   let exists c id =
-    Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero)) >>=? fun c ->
-    Storage.Big_map.Key_type.get_option c id >>=? fun kt ->
+    Lwt.return
+      (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))
+    >>=? fun c ->
+    Storage.Big_map.Key_type.get_option c id
+    >>=? fun kt ->
     match kt with
-    | None -> return (c, None)
+    | None ->
+        return (c, None)
     | Some kt ->
-        Storage.Big_map.Value_type.get c id >>=? fun kv ->
-        return (c, Some (kt, kv))
+        Storage.Big_map.Value_type.get c id
+        >>=? fun kv -> return (c, Some (kt, kv))
 end
+
 module Delegate = Delegate_storage
+
 module Roll = struct
   include Roll_repr
   include Roll_storage
 end
+
 module Nonce = Nonce_storage
+
 module Seed = struct
   include Seed_repr
   include Seed_storage
 end
 
 module Fitness = struct
-
   include Fitness_repr
   include Fitness
-  type fitness = t
-  include Fitness_storage
 
+  type fitness = t
+
+  include Fitness_storage
 end
 
 module Bootstrap = Bootstrap_storage
@@ -174,39 +223,57 @@ end
 
 module Global = struct
   let get_block_priority = Storage.Block_priority.get
+
   let set_block_priority = Storage.Block_priority.set
 end
 
 let prepare_first_block = Init_storage.prepare_first_block
+
 let prepare = Init_storage.prepare
 
 let finalize ?commit_message:message c =
   let fitness = Fitness.from_int64 (Fitness.current c) in
   let context = Raw_context.recover c in
-  { Updater.context ; fitness ; message ; max_operations_ttl = 60 ;
+  {
+    Updater.context;
+    fitness;
+    message;
+    max_operations_ttl = 60;
     last_allowed_fork_level =
       Raw_level.to_int32 @@ Level.last_allowed_fork_level c;
   }
 
 let activate = Raw_context.activate
+
 let fork_test_chain = Raw_context.fork_test_chain
 
 let record_endorsement = Raw_context.record_endorsement
+
 let allowed_endorsements = Raw_context.allowed_endorsements
+
 let init_endorsements = Raw_context.init_endorsements
+
 let included_endorsements = Raw_context.included_endorsements
 
 let reset_internal_nonce = Raw_context.reset_internal_nonce
+
 let fresh_internal_nonce = Raw_context.fresh_internal_nonce
+
 let record_internal_nonce = Raw_context.record_internal_nonce
-let internal_nonce_already_recorded = Raw_context.internal_nonce_already_recorded
+
+let internal_nonce_already_recorded =
+  Raw_context.internal_nonce_already_recorded
 
 let add_deposit = Raw_context.add_deposit
+
 let add_fees = Raw_context.add_fees
+
 let add_rewards = Raw_context.add_rewards
 
 let get_deposits = Raw_context.get_deposits
+
 let get_fees = Raw_context.get_fees
+
 let get_rewards = Raw_context.get_rewards
 
 let description = Raw_context.description

vendors/ligo-utils/tezos-protocol-alpha/alpha_services.ml

@@ -28,86 +28,76 @@ open Alpha_context
 let custom_root = RPC_path.open_root
 
 module Seed = struct
-
   module S = struct
-
     open Data_encoding
 
     let seed =
       RPC_service.post_service
-        ~description: "Seed of the cycle to which the block belongs."
-        ~query: RPC_query.empty
-        ~input: empty
-        ~output: Seed.seed_encoding
+        ~description:"Seed of the cycle to which the block belongs."
+        ~query:RPC_query.empty
+        ~input:empty
+        ~output:Seed.seed_encoding
         RPC_path.(custom_root / "context" / "seed")
-
   end
 
   let () =
     let open Services_registration in
-    register0 S.seed begin fun ctxt () () ->
-      let l = Level.current ctxt in
-      Seed.for_cycle ctxt l.cycle
-    end
-
-
-  let get ctxt block =
-    RPC_context.make_call0 S.seed ctxt block () ()
+    register0 S.seed (fun ctxt () () ->
+        let l = Level.current ctxt in
+        Seed.for_cycle ctxt l.cycle)
 
+  let get ctxt block = RPC_context.make_call0 S.seed ctxt block () ()
 end
 
 module Nonce = struct
-
-  type info =
-    | Revealed of Nonce.t
-    | Missing of Nonce_hash.t
-    | Forgotten
+  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten
 
   let info_encoding =
     let open Data_encoding in
-    union [
-      case (Tag 0)
-        ~title:"Revealed"
-        (obj1 (req "nonce" Nonce.encoding))
-        (function Revealed nonce -> Some nonce | _ -> None)
-        (fun nonce -> Revealed nonce) ;
-      case (Tag 1)
-        ~title:"Missing"
-        (obj1 (req "hash" Nonce_hash.encoding))
-        (function Missing nonce -> Some nonce | _ -> None)
-        (fun nonce -> Missing nonce) ;
-      case (Tag 2)
-        ~title:"Forgotten"
-        empty
-        (function Forgotten -> Some () | _ -> None)
-        (fun () -> Forgotten) ;
-    ]
+    union
+      [ case
+          (Tag 0)
+          ~title:"Revealed"
+          (obj1 (req "nonce" Nonce.encoding))
+          (function Revealed nonce -> Some nonce | _ -> None)
+          (fun nonce -> Revealed nonce);
+        case
+          (Tag 1)
+          ~title:"Missing"
+          (obj1 (req "hash" Nonce_hash.encoding))
+          (function Missing nonce -> Some nonce | _ -> None)
+          (fun nonce -> Missing nonce);
+        case
+          (Tag 2)
+          ~title:"Forgotten"
+          empty
+          (function Forgotten -> Some () | _ -> None)
+          (fun () -> Forgotten) ]
 
   module S = struct
-
     let get =
       RPC_service.get_service
-        ~description: "Info about the nonce of a previous block."
-        ~query: RPC_query.empty
-        ~output: info_encoding
+        ~description:"Info about the nonce of a previous block."
+        ~query:RPC_query.empty
+        ~output:info_encoding
         RPC_path.(custom_root / "context" / "nonces" /: Raw_level.rpc_arg)
-
   end
 
   let register () =
     let open Services_registration in
-    register1 S.get begin fun ctxt raw_level () () ->
-      let level = Level.from_raw ctxt raw_level in
-      Nonce.get ctxt level >>= function
-      | Ok (Revealed nonce) -> return (Revealed nonce)
-      | Ok (Unrevealed { nonce_hash ; _ }) ->
-          return (Missing nonce_hash)
-      | Error _ -> return Forgotten
-    end
+    register1 S.get (fun ctxt raw_level () () ->
+        let level = Level.from_raw ctxt raw_level in
+        Nonce.get ctxt level
+        >>= function
+        | Ok (Revealed nonce) ->
+            return (Revealed nonce)
+        | Ok (Unrevealed {nonce_hash; _}) ->
+            return (Missing nonce_hash)
+        | Error _ ->
+            return Forgotten)
 
   let get ctxt block level =
     RPC_context.make_call1 S.get ctxt block level () ()
-
 end
 
 module Contract = Contract_services

vendors/ligo-utils/tezos-protocol-alpha/alpha_services.mli

@@ -26,22 +26,14 @@
 open Alpha_context
 
 module Seed : sig
-
-  val get: 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t
-
+  val get : 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t
 end
 
 module Nonce : sig
+  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten
 
-  type info =
-    | Revealed of Nonce.t
-    | Missing of Nonce_hash.t
-    | Forgotten
-
-  val get:
-    'a #RPC_context.simple ->
-    'a -> Raw_level.t -> info shell_tzresult Lwt.t
-
+  val get :
+    'a #RPC_context.simple -> 'a -> Raw_level.t -> info shell_tzresult Lwt.t
 end
 
 module Contract = Contract_services
@@ -52,4 +44,4 @@ module Forge = Helpers_services.Forge
 module Parse = Helpers_services.Parse
 module Voting = Voting_services
 
-val register: unit -> unit
+val register : unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/amendment.ml

@@ -29,29 +29,32 @@ open Alpha_context
     Returns None in case of a tie, if proposal quorum is below required
     minimum or if there are no proposals. *)
 let select_winning_proposal ctxt =
-  Vote.get_proposals ctxt >>=? fun proposals ->
+  Vote.get_proposals ctxt
+  >>=? fun proposals ->
   let merge proposal vote winners =
     match winners with
-    | None -> Some ([proposal], vote)
+    | None ->
+        Some ([proposal], vote)
     | Some (winners, winners_vote) as previous ->
         if Compare.Int32.(vote = winners_vote) then
           Some (proposal :: winners, winners_vote)
-        else if Compare.Int32.(vote > winners_vote) then
-          Some ([proposal], vote)
-        else
-          previous in
+        else if Compare.Int32.(vote > winners_vote) then Some ([proposal], vote)
+        else previous
+  in
   match Protocol_hash.Map.fold merge proposals None with
   | Some ([proposal], vote) ->
-      Vote.listing_size ctxt >>=? fun max_vote ->
+      Vote.listing_size ctxt
+      >>=? fun max_vote ->
       let min_proposal_quorum = Constants.min_proposal_quorum ctxt in
       let min_vote_to_pass =
-        Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l in
-      if Compare.Int32.(vote >= min_vote_to_pass) then
-        return_some proposal
-      else
-        return_none
+        Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l
+      in
+      if Compare.Int32.(vote >= min_vote_to_pass) then return_some proposal
+      else return_none
   | _ ->
-      return_none (* in case of a tie, let's do nothing. *)
+      return_none
+
+(* in case of a tie, let's do nothing. *)
 
 (** A proposal is approved if it has supermajority and the participation reaches
     the current quorum.
@@ -63,10 +66,14 @@ let select_winning_proposal ctxt =
     The expected quorum is calculated using the last participation EMA, capped
     by the min/max quorum protocol constants. *)
 let check_approval_and_update_participation_ema ctxt =
-  Vote.get_ballots ctxt >>=? fun ballots ->
-  Vote.listing_size ctxt >>=? fun maximum_vote ->
-  Vote.get_participation_ema ctxt >>=? fun participation_ema ->
-  Vote.get_current_quorum ctxt >>=? fun expected_quorum ->
+  Vote.get_ballots ctxt
+  >>=? fun ballots ->
+  Vote.listing_size ctxt
+  >>=? fun maximum_vote ->
+  Vote.get_participation_ema ctxt
+  >>=? fun participation_ema ->
+  Vote.get_current_quorum ctxt
+  >>=? fun expected_quorum ->
   (* Note overflows: considering a maximum of 8e8 tokens, with roll size as
      small as 1e3, there is a maximum of 8e5 rolls and thus votes.
      In 'participation' an Int64 is used because in the worst case 'all_votes is
@@ -75,80 +82,96 @@ let check_approval_and_update_participation_ema ctxt =
   let casted_votes = Int32.add ballots.yay ballots.nay in
   let all_votes = Int32.add casted_votes ballots.pass in
   let supermajority = Int32.div (Int32.mul 8l casted_votes) 10l in
-  let participation = (* in centile of percentage *)
-    Int64.(to_int32
-             (div
-                (mul (of_int32 all_votes) 100_00L)
-                (of_int32 maximum_vote))) in
-  let outcome = Compare.Int32.(participation >= expected_quorum &&
-                               ballots.yay >= supermajority) in
+  let participation =
+    (* in centile of percentage *)
+    Int64.(
+      to_int32 (div (mul (of_int32 all_votes) 100_00L) (of_int32 maximum_vote)))
+  in
+  let outcome =
+    Compare.Int32.(
+      participation >= expected_quorum && ballots.yay >= supermajority)
+  in
   let new_participation_ema =
-    Int32.(div (add
-                  (mul 8l participation_ema)
-                  (mul 2l participation))
-             10l) in
-  Vote.set_participation_ema ctxt new_participation_ema >>=? fun ctxt ->
-  return (ctxt, outcome)
+    Int32.(div (add (mul 8l participation_ema) (mul 2l participation)) 10l)
+  in
+  Vote.set_participation_ema ctxt new_participation_ema
+  >>=? fun ctxt -> return (ctxt, outcome)
 
 (** Implements the state machine of the amendment procedure.
     Note that [freeze_listings], that computes the vote weight of each delegate,
     is run at the beginning of each voting period.
 *)
 let start_new_voting_period ctxt =
-  Vote.get_current_period_kind ctxt >>=? function
-  | Proposal -> begin
-      select_winning_proposal ctxt >>=? fun proposal ->
-      Vote.clear_proposals ctxt >>= fun ctxt ->
-      Vote.clear_listings ctxt >>=? fun ctxt ->
+  Vote.get_current_period_kind ctxt
+  >>=? function
+  | Proposal -> (
+      select_winning_proposal ctxt
+      >>=? fun proposal ->
+      Vote.clear_proposals ctxt
+      >>= fun ctxt ->
+      Vote.clear_listings ctxt
+      >>=? fun ctxt ->
       match proposal with
       | None ->
-          Vote.freeze_listings ctxt >>=? fun ctxt ->
-          return ctxt
+          Vote.freeze_listings ctxt >>=? fun ctxt -> return ctxt
       | Some proposal ->
-          Vote.init_current_proposal ctxt proposal >>=? fun ctxt ->
-          Vote.freeze_listings ctxt >>=? fun ctxt ->
-          Vote.set_current_period_kind ctxt Testing_vote >>=? fun ctxt ->
-          return ctxt
-    end
+          Vote.init_current_proposal ctxt proposal
+          >>=? fun ctxt ->
+          Vote.freeze_listings ctxt
+          >>=? fun ctxt ->
+          Vote.set_current_period_kind ctxt Testing_vote
+          >>=? fun ctxt -> return ctxt )
   | Testing_vote ->
-      check_approval_and_update_participation_ema ctxt >>=? fun (ctxt, approved) ->
-      Vote.clear_ballots ctxt >>= fun ctxt ->
-      Vote.clear_listings ctxt >>=? fun ctxt ->
+      check_approval_and_update_participation_ema ctxt
+      >>=? fun (ctxt, approved) ->
+      Vote.clear_ballots ctxt
+      >>= fun ctxt ->
+      Vote.clear_listings ctxt
+      >>=? fun ctxt ->
       if approved then
-        let expiration = (* in two days maximum... *)
-          Time.add (Timestamp.current ctxt) (Constants.test_chain_duration ctxt) in
-        Vote.get_current_proposal ctxt >>=? fun proposal ->
-        fork_test_chain ctxt proposal expiration >>= fun ctxt ->
-        Vote.set_current_period_kind ctxt Testing >>=? fun ctxt ->
-        return ctxt
+        let expiration =
+          (* in two days maximum... *)
+          Time.add
+            (Timestamp.current ctxt)
+            (Constants.test_chain_duration ctxt)
+        in
+        Vote.get_current_proposal ctxt
+        >>=? fun proposal ->
+        fork_test_chain ctxt proposal expiration
+        >>= fun ctxt ->
+        Vote.set_current_period_kind ctxt Testing >>=? fun ctxt -> return ctxt
       else
-        Vote.clear_current_proposal ctxt >>=? fun ctxt ->
-        Vote.freeze_listings ctxt >>=? fun ctxt ->
-        Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt ->
-        return ctxt
+        Vote.clear_current_proposal ctxt
+        >>=? fun ctxt ->
+        Vote.freeze_listings ctxt
+        >>=? fun ctxt ->
+        Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt
   | Testing ->
-      Vote.freeze_listings ctxt >>=? fun ctxt ->
-      Vote.set_current_period_kind ctxt Promotion_vote >>=? fun ctxt ->
-      return ctxt
+      Vote.freeze_listings ctxt
+      >>=? fun ctxt ->
+      Vote.set_current_period_kind ctxt Promotion_vote
+      >>=? fun ctxt -> return ctxt
   | Promotion_vote ->
-      check_approval_and_update_participation_ema ctxt >>=? fun (ctxt, approved) ->
-      begin
-        if approved then
-          Vote.get_current_proposal ctxt >>=? fun proposal ->
-          activate ctxt proposal >>= fun ctxt ->
-          return ctxt
-        else
-          return ctxt
-      end >>=? fun ctxt ->
-      Vote.clear_ballots ctxt >>= fun ctxt ->
-      Vote.clear_listings ctxt >>=? fun ctxt ->
-      Vote.clear_current_proposal ctxt >>=? fun ctxt ->
-      Vote.freeze_listings ctxt >>=? fun ctxt ->
-      Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt ->
-      return ctxt
+      check_approval_and_update_participation_ema ctxt
+      >>=? fun (ctxt, approved) ->
+      ( if approved then
+        Vote.get_current_proposal ctxt
+        >>=? fun proposal -> activate ctxt proposal >>= fun ctxt -> return ctxt
+      else return ctxt )
+      >>=? fun ctxt ->
+      Vote.clear_ballots ctxt
+      >>= fun ctxt ->
+      Vote.clear_listings ctxt
+      >>=? fun ctxt ->
+      Vote.clear_current_proposal ctxt
+      >>=? fun ctxt ->
+      Vote.freeze_listings ctxt
+      >>=? fun ctxt ->
+      Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt -> return ctxt
 
-type error += (* `Branch *)
-  | Invalid_proposal
+type error +=
+  | (* `Branch *)
+      Invalid_proposal
   | Unexpected_proposal
   | Unauthorized_proposal
   | Too_many_proposals
@@ -183,7 +206,8 @@ let () =
     `Branch
     ~id:"unauthorized_proposal"
     ~title:"Unauthorized proposal"
-    ~description:"The delegate provided for the proposal is not in the voting listings."
+    ~description:
+      "The delegate provided for the proposal is not in the voting listings."
     ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized proposal")
     empty
     (function Unauthorized_proposal -> Some () | _ -> None)
@@ -203,7 +227,8 @@ let () =
     `Branch
     ~id:"unauthorized_ballot"
     ~title:"Unauthorized ballot"
-    ~description:"The delegate provided for the ballot is not in the voting listings."
+    ~description:
+      "The delegate provided for the ballot is not in the voting listings."
     ~pp:(fun ppf () -> Format.fprintf ppf "Unauthorized ballot")
     empty
     (function Unauthorized_ballot -> Some () | _ -> None)
@@ -213,7 +238,8 @@ let () =
     `Branch
     ~id:"too_many_proposals"
     ~title:"Too many proposals"
-    ~description:"The delegate reached the maximum number of allowed proposals."
+    ~description:
+      "The delegate reached the maximum number of allowed proposals."
     ~pp:(fun ppf () -> Format.fprintf ppf "Too many proposals")
     empty
     (function Too_many_proposals -> Some () | _ -> None)
@@ -231,60 +257,67 @@ let () =
 
 (* @return [true] if [List.length l] > [n] w/o computing length *)
 let rec longer_than l n =
-  if Compare.Int.(n < 0) then assert false else
+  if Compare.Int.(n < 0) then assert false
+  else
     match l with
-    | [] -> false
+    | [] ->
+        false
     | _ :: rest ->
         if Compare.Int.(n = 0) then true
         else (* n > 0 *)
-          longer_than rest (n-1)
+          longer_than rest (n - 1)
 
 let record_proposals ctxt delegate proposals =
-  begin match proposals with
-    | [] -> fail Empty_proposal
-    | _ :: _ -> return_unit
-  end >>=? fun () ->
-  Vote.get_current_period_kind ctxt >>=? function
+  (match proposals with [] -> fail Empty_proposal | _ :: _ -> return_unit)
+  >>=? fun () ->
+  Vote.get_current_period_kind ctxt
+  >>=? function
   | Proposal ->
-      Vote.in_listings ctxt delegate >>= fun in_listings ->
+      Vote.in_listings ctxt delegate
+      >>= fun in_listings ->
       if in_listings then
-        Vote.recorded_proposal_count_for_delegate ctxt delegate >>=? fun count ->
+        Vote.recorded_proposal_count_for_delegate ctxt delegate
+        >>=? fun count ->
         fail_when
           (longer_than proposals (Constants.max_proposals_per_delegate - count))
-          Too_many_proposals >>=? fun () ->
+          Too_many_proposals
+        >>=? fun () ->
         fold_left_s
-          (fun ctxt proposal ->
-             Vote.record_proposal ctxt proposal delegate)
-          ctxt proposals >>=? fun ctxt ->
-        return ctxt
-      else
-        fail Unauthorized_proposal
+          (fun ctxt proposal -> Vote.record_proposal ctxt proposal delegate)
+          ctxt
+          proposals
+        >>=? fun ctxt -> return ctxt
+      else fail Unauthorized_proposal
   | Testing_vote | Testing | Promotion_vote ->
       fail Unexpected_proposal
 
 let record_ballot ctxt delegate proposal ballot =
-  Vote.get_current_period_kind ctxt >>=? function
+  Vote.get_current_period_kind ctxt
+  >>=? function
   | Testing_vote | Promotion_vote ->
-      Vote.get_current_proposal ctxt >>=? fun current_proposal ->
-      fail_unless (Protocol_hash.equal proposal current_proposal)
-        Invalid_proposal >>=? fun () ->
-      Vote.has_recorded_ballot ctxt delegate >>= fun has_ballot ->
-      fail_when has_ballot Unauthorized_ballot >>=? fun () ->
-      Vote.in_listings ctxt delegate >>= fun in_listings ->
-      if in_listings then
-        Vote.record_ballot ctxt delegate ballot
-      else
-        fail Unauthorized_ballot
+      Vote.get_current_proposal ctxt
+      >>=? fun current_proposal ->
+      fail_unless
+        (Protocol_hash.equal proposal current_proposal)
+        Invalid_proposal
+      >>=? fun () ->
+      Vote.has_recorded_ballot ctxt delegate
+      >>= fun has_ballot ->
+      fail_when has_ballot Unauthorized_ballot
+      >>=? fun () ->
+      Vote.in_listings ctxt delegate
+      >>= fun in_listings ->
+      if in_listings then Vote.record_ballot ctxt delegate ballot
+      else fail Unauthorized_ballot
   | Testing | Proposal ->
       fail Unexpected_ballot
 
 let last_of_a_voting_period ctxt l =
-  Compare.Int32.(Int32.succ l.Level.voting_period_position =
-                 Constants.blocks_per_voting_period ctxt )
+  Compare.Int32.(
+    Int32.succ l.Level.voting_period_position
+    = Constants.blocks_per_voting_period ctxt)
 
 let may_start_new_voting_period ctxt =
   let level = Level.current ctxt in
-  if last_of_a_voting_period ctxt level then
-    start_new_voting_period ctxt
-  else
-    return ctxt
+  if last_of_a_voting_period ctxt level then start_new_voting_period ctxt
+  else return ctxt

vendors/ligo-utils/tezos-protocol-alpha/amendment.mli

@@ -51,8 +51,7 @@ open Alpha_context
 
 (** If at the end of a voting period, moves to the next one following
     the state machine of the amendment procedure. *)
-val may_start_new_voting_period:
-  context -> context tzresult Lwt.t
+val may_start_new_voting_period : context -> context tzresult Lwt.t
 
 type error +=
   | Unexpected_proposal
@@ -63,17 +62,14 @@ type error +=
 (** Records a list of proposals for a delegate.
     @raise Unexpected_proposal if [ctxt] is not in a proposal period.
     @raise Unauthorized_proposal if [delegate] is not in the listing. *)
-val record_proposals:
-  context ->
-  public_key_hash -> Protocol_hash.t list ->
-  context tzresult Lwt.t
+val record_proposals :
+  context -> public_key_hash -> Protocol_hash.t list -> context tzresult Lwt.t
 
-type error +=
-  | Invalid_proposal
-  | Unexpected_ballot
-  | Unauthorized_ballot
+type error += Invalid_proposal | Unexpected_ballot | Unauthorized_ballot
 
-val record_ballot:
+val record_ballot :
   context ->
-  public_key_hash -> Protocol_hash.t -> Vote.ballot ->
+  public_key_hash ->
+  Protocol_hash.t ->
+  Vote.ballot ->
   context tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/apply_results.mli

@@ -31,9 +31,7 @@
 open Alpha_context
 
 (** Result of applying a {!Operation.t}. Follows the same structure. *)
-type 'kind operation_metadata = {
-  contents: 'kind contents_result_list ;
-}
+type 'kind operation_metadata = {contents : 'kind contents_result_list}
 
 and packed_operation_metadata =
   | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata
@@ -43,34 +41,43 @@ and packed_operation_metadata =
 and 'kind contents_result_list =
   | Single_result : 'kind contents_result -> 'kind contents_result_list
   | Cons_result :
-      'kind Kind.manager contents_result * 'rest Kind.manager contents_result_list ->
-    (('kind * 'rest) Kind.manager ) contents_result_list
+      'kind Kind.manager contents_result
+      * 'rest Kind.manager contents_result_list
+      -> ('kind * 'rest) Kind.manager contents_result_list
 
 and packed_contents_result_list =
-  | Contents_result_list : 'kind contents_result_list -> packed_contents_result_list
+  | Contents_result_list :
+      'kind contents_result_list
+      -> packed_contents_result_list
 
 (** Result of applying an {!Operation.contents}. Follows the same structure. *)
 and 'kind contents_result =
-  | Endorsement_result :
-      { balance_updates : Delegate.balance_updates ;
-        delegate : Signature.Public_key_hash.t ;
-        slots: int list ;
-      } -> Kind.endorsement contents_result
+  | Endorsement_result : {
+      balance_updates : Delegate.balance_updates;
+      delegate : Signature.Public_key_hash.t;
+      slots : int list;
+    }
+      -> Kind.endorsement contents_result
   | Seed_nonce_revelation_result :
-      Delegate.balance_updates -> Kind.seed_nonce_revelation contents_result
+      Delegate.balance_updates
+      -> Kind.seed_nonce_revelation contents_result
   | Double_endorsement_evidence_result :
-      Delegate.balance_updates -> Kind.double_endorsement_evidence contents_result
+      Delegate.balance_updates
+      -> Kind.double_endorsement_evidence contents_result
   | Double_baking_evidence_result :
-      Delegate.balance_updates -> Kind.double_baking_evidence contents_result
+      Delegate.balance_updates
+      -> Kind.double_baking_evidence contents_result
   | Activate_account_result :
-      Delegate.balance_updates -> Kind.activate_account contents_result
+      Delegate.balance_updates
+      -> Kind.activate_account contents_result
   | Proposals_result : Kind.proposals contents_result
   | Ballot_result : Kind.ballot contents_result
-  | Manager_operation_result :
-      { balance_updates : Delegate.balance_updates ;
-        operation_result : 'kind manager_operation_result ;
-        internal_operation_results : packed_internal_operation_result list ;
-      } -> 'kind Kind.manager contents_result
+  | Manager_operation_result : {
+      balance_updates : Delegate.balance_updates;
+      operation_result : 'kind manager_operation_result;
+      internal_operation_results : packed_internal_operation_result list;
+    }
+      -> 'kind Kind.manager contents_result
 
 and packed_contents_result =
   | Contents_result : 'kind contents_result -> packed_contents_result
@@ -79,90 +86,105 @@ and packed_contents_result =
     always be at the tail, and after a single [Failed]. *)
 and 'kind manager_operation_result =
   | Applied of 'kind successful_manager_operation_result
-  | Backtracked of 'kind successful_manager_operation_result * error list option
+  | Backtracked of
+      'kind successful_manager_operation_result * error list option
   | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result
   | Skipped : 'kind Kind.manager -> 'kind manager_operation_result
 
 (** Result of applying a {!manager_operation_content}, either internal
     or external. *)
 and _ successful_manager_operation_result =
-  | Reveal_result :
-      { consumed_gas : Z.t
-      } -> Kind.reveal successful_manager_operation_result
-  | Transaction_result :
-      { storage : Script.expr option ;
-        big_map_diff : Contract.big_map_diff option ;
-        balance_updates : Delegate.balance_updates ;
-        originated_contracts : Contract.t list ;
-        consumed_gas : Z.t ;
-        storage_size : Z.t ;
-        paid_storage_size_diff : Z.t ;
-        allocated_destination_contract : bool ;
-      } -> Kind.transaction successful_manager_operation_result
-  | Origination_result :
-      { big_map_diff : Contract.big_map_diff option ;
-        balance_updates : Delegate.balance_updates ;
-        originated_contracts : Contract.t list ;
-        consumed_gas : Z.t ;
-        storage_size : Z.t ;
-        paid_storage_size_diff : Z.t ;
-      } -> Kind.origination successful_manager_operation_result
-  | Delegation_result :
-      { consumed_gas : Z.t
-      } -> Kind.delegation successful_manager_operation_result
+  | Reveal_result : {
+      consumed_gas : Z.t;
+    }
+      -> Kind.reveal successful_manager_operation_result
+  | Transaction_result : {
+      storage : Script.expr option;
+      big_map_diff : Contract.big_map_diff option;
+      balance_updates : Delegate.balance_updates;
+      originated_contracts : Contract.t list;
+      consumed_gas : Z.t;
+      storage_size : Z.t;
+      paid_storage_size_diff : Z.t;
+      allocated_destination_contract : bool;
+    }
+      -> Kind.transaction successful_manager_operation_result
+  | Origination_result : {
+      big_map_diff : Contract.big_map_diff option;
+      balance_updates : Delegate.balance_updates;
+      originated_contracts : Contract.t list;
+      consumed_gas : Z.t;
+      storage_size : Z.t;
+      paid_storage_size_diff : Z.t;
+    }
+      -> Kind.origination successful_manager_operation_result
+  | Delegation_result : {
+      consumed_gas : Z.t;
+    }
+      -> Kind.delegation successful_manager_operation_result
 
 and packed_successful_manager_operation_result =
   | Successful_manager_result :
-      'kind successful_manager_operation_result -> packed_successful_manager_operation_result
+      'kind successful_manager_operation_result
+      -> packed_successful_manager_operation_result
 
 and packed_internal_operation_result =
   | Internal_operation_result :
-      'kind internal_operation * 'kind manager_operation_result ->
-    packed_internal_operation_result
+      'kind internal_operation * 'kind manager_operation_result
+      -> packed_internal_operation_result
 
 (** Serializer for {!packed_operation_result}. *)
 val operation_metadata_encoding : packed_operation_metadata Data_encoding.t
 
-val operation_data_and_metadata_encoding
-  : (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t
-
-
+val operation_data_and_metadata_encoding :
+  (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t
 
 type 'kind contents_and_result_list =
-  | Single_and_result : 'kind Alpha_context.contents * 'kind contents_result -> 'kind contents_and_result_list
-  | Cons_and_result : 'kind Kind.manager Alpha_context.contents * 'kind Kind.manager contents_result * 'rest Kind.manager contents_and_result_list -> ('kind * 'rest) Kind.manager contents_and_result_list
+  | Single_and_result :
+      'kind Alpha_context.contents * 'kind contents_result
+      -> 'kind contents_and_result_list
+  | Cons_and_result :
+      'kind Kind.manager Alpha_context.contents
+      * 'kind Kind.manager contents_result
+      * 'rest Kind.manager contents_and_result_list
+      -> ('kind * 'rest) Kind.manager contents_and_result_list
 
 type packed_contents_and_result_list =
-  | Contents_and_result_list : 'kind contents_and_result_list -> packed_contents_and_result_list
+  | Contents_and_result_list :
+      'kind contents_and_result_list
+      -> packed_contents_and_result_list
 
 val contents_and_result_list_encoding :
   packed_contents_and_result_list Data_encoding.t
 
 val pack_contents_list :
-  'kind contents_list -> 'kind contents_result_list ->
+  'kind contents_list ->
+  'kind contents_result_list ->
   'kind contents_and_result_list
 
 val unpack_contents_list :
   'kind contents_and_result_list ->
   'kind contents_list * 'kind contents_result_list
 
-val to_list :
-  packed_contents_result_list -> packed_contents_result list
+val to_list : packed_contents_result_list -> packed_contents_result list
 
-val of_list :
-  packed_contents_result list -> packed_contents_result_list
+val of_list : packed_contents_result list -> packed_contents_result_list
 
 type ('a, 'b) eq = Eq : ('a, 'a) eq
+
 val kind_equal_list :
-  'kind contents_list -> 'kind2 contents_result_list -> ('kind, 'kind2) eq option
+  'kind contents_list ->
+  'kind2 contents_result_list ->
+  ('kind, 'kind2) eq option
 
 type block_metadata = {
-  baker: Signature.Public_key_hash.t ;
-  level: Level.t ;
-  voting_period_kind: Voting_period.kind ;
-  nonce_hash: Nonce_hash.t option ;
-  consumed_gas: Z.t ;
-  deactivated: Signature.Public_key_hash.t list ;
-  balance_updates: Delegate.balance_updates ;
+  baker : Signature.Public_key_hash.t;
+  level : Level.t;
+  voting_period_kind : Voting_period.kind;
+  nonce_hash : Nonce_hash.t option;
+  consumed_gas : Z.t;
+  deactivated : Signature.Public_key_hash.t list;
+  balance_updates : Delegate.balance_updates;
 }
-val block_metadata_encoding: block_metadata Data_encoding.encoding
+
+val block_metadata_encoding : block_metadata Data_encoding.encoding

vendors/ligo-utils/tezos-protocol-alpha/baking.ml

@@ -23,31 +23,45 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-
 open Alpha_context
 open Misc
 
 type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
-type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
+
+type error += Timestamp_too_early of Timestamp.t * Timestamp.t
+
+(* `Permanent *)
+
 type error += Unexpected_endorsement (* `Permanent *)
-type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
-type error += Invalid_signature  (* `Permanent *)
-type error += Invalid_stamp  (* `Permanent *)
+
+type error +=
+  | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t
+
+(* `Permanent *)
+
+type error += Invalid_signature (* `Permanent *)
+
+type error += Invalid_stamp (* `Permanent *)
 
 let () =
   register_error_kind
     `Permanent
     ~id:"baking.timestamp_too_early"
     ~title:"Block forged too early"
-    ~description:"The block timestamp is before the first slot \
-                  for this baker at this level"
+    ~description:
+      "The block timestamp is before the first slot for this baker at this \
+       level"
     ~pp:(fun ppf (r, p) ->
-        Format.fprintf ppf "Block forged too early (%a is before %a)"
-          Time.pp_hum p Time.pp_hum r)
-    Data_encoding.(obj2
-                     (req "minimum" Time.encoding)
-                     (req "provided" Time.encoding))
-    (function Timestamp_too_early (r, p)   -> Some (r, p) | _ -> None)
+      Format.fprintf
+        ppf
+        "Block forged too early (%a is before %a)"
+        Time.pp_hum
+        p
+        Time.pp_hum
+        r)
+    Data_encoding.(
+      obj2 (req "minimum" Time.encoding) (req "provided" Time.encoding))
+    (function Timestamp_too_early (r, p) -> Some (r, p) | _ -> None)
     (fun (r, p) -> Timestamp_too_early (r, p)) ;
   register_error_kind
     `Permanent
@@ -55,35 +69,36 @@ let () =
     ~title:"Invalid fitness gap"
     ~description:"The gap of fitness is out of bounds"
     ~pp:(fun ppf (m, g) ->
-        Format.fprintf ppf
-          "The gap of fitness %Ld is not between 0 and %Ld" g m)
-    Data_encoding.(obj2
-                     (req "maximum" int64)
-                     (req "provided" int64))
-    (function Invalid_fitness_gap (m, g)   -> Some (m, g) | _ -> None)
+      Format.fprintf ppf "The gap of fitness %Ld is not between 0 and %Ld" g m)
+    Data_encoding.(obj2 (req "maximum" int64) (req "provided" int64))
+    (function Invalid_fitness_gap (m, g) -> Some (m, g) | _ -> None)
     (fun (m, g) -> Invalid_fitness_gap (m, g)) ;
   register_error_kind
     `Permanent
     ~id:"baking.invalid_block_signature"
     ~title:"Invalid block signature"
-    ~description:
-      "A block was not signed with the expected private key."
+    ~description:"A block was not signed with the expected private key."
     ~pp:(fun ppf (block, pkh) ->
-        Format.fprintf ppf "Invalid signature for block %a. Expected: %a."
-          Block_hash.pp_short block
-          Signature.Public_key_hash.pp_short pkh)
-    Data_encoding.(obj2
-                     (req "block" Block_hash.encoding)
-                     (req "expected" Signature.Public_key_hash.encoding))
-    (function Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None)
-    (fun (block, pkh) -> Invalid_block_signature (block, pkh));
+      Format.fprintf
+        ppf
+        "Invalid signature for block %a. Expected: %a."
+        Block_hash.pp_short
+        block
+        Signature.Public_key_hash.pp_short
+        pkh)
+    Data_encoding.(
+      obj2
+        (req "block" Block_hash.encoding)
+        (req "expected" Signature.Public_key_hash.encoding))
+    (function
+      | Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None)
+    (fun (block, pkh) -> Invalid_block_signature (block, pkh)) ;
   register_error_kind
     `Permanent
     ~id:"baking.invalid_signature"
     ~title:"Invalid block signature"
     ~description:"The block's signature is invalid"
-    ~pp:(fun ppf () ->
-        Format.fprintf ppf "Invalid block signature")
+    ~pp:(fun ppf () -> Format.fprintf ppf "Invalid block signature")
     Data_encoding.empty
     (function Invalid_signature -> Some () | _ -> None)
     (fun () -> Invalid_signature) ;
@@ -92,8 +107,7 @@ let () =
     ~id:"baking.insufficient_proof_of_work"
     ~title:"Insufficient block proof-of-work stamp"
     ~description:"The block's proof-of-work stamp is insufficient"
-    ~pp:(fun ppf () ->
-        Format.fprintf ppf "Insufficient proof-of-work stamp")
+    ~pp:(fun ppf () -> Format.fprintf ppf "Insufficient proof-of-work stamp")
     Data_encoding.empty
     (function Invalid_stamp -> Some () | _ -> None)
     (fun () -> Invalid_stamp) ;
@@ -101,10 +115,12 @@ let () =
     `Permanent
     ~id:"baking.unexpected_endorsement"
     ~title:"Endorsement from unexpected delegate"
-    ~description:"The operation is signed by a delegate without endorsement rights."
+    ~description:
+      "The operation is signed by a delegate without endorsement rights."
     ~pp:(fun ppf () ->
-        Format.fprintf ppf
-          "The endorsement is signed by a delegate without endorsement rights.")
+      Format.fprintf
+        ppf
+        "The endorsement is signed by a delegate without endorsement rights.")
     Data_encoding.unit
     (function Unexpected_endorsement -> Some () | _ -> None)
     (fun () -> Unexpected_endorsement)
@@ -112,20 +128,24 @@ let () =
 let minimal_time c priority pred_timestamp =
   let priority = Int32.of_int priority in
   let rec cumsum_time_between_blocks acc durations p =
-    if Compare.Int32.(<=) p 0l then
-      ok acc
-    else match durations with
-      | [] -> cumsum_time_between_blocks acc [ Period.one_minute ] p
-      | [ last ] ->
-          Period.mult p last >>? fun period ->
-          Timestamp.(acc +? period)
+    if Compare.Int32.( <= ) p 0l then ok acc
+    else
+      match durations with
+      | [] ->
+          cumsum_time_between_blocks acc [Period.one_minute] p
+      | [last] ->
+          Period.mult p last >>? fun period -> Timestamp.(acc +? period)
       | first :: durations ->
-          Timestamp.(acc +? first) >>? fun acc ->
+          Timestamp.(acc +? first)
+          >>? fun acc ->
           let p = Int32.pred p in
-          cumsum_time_between_blocks acc durations p in
+          cumsum_time_between_blocks acc durations p
+  in
   Lwt.return
     (cumsum_time_between_blocks
-       pred_timestamp (Constants.time_between_blocks c) (Int32.succ priority))
+       pred_timestamp
+       (Constants.time_between_blocks c)
+       (Int32.succ priority))
 
 let earlier_predecessor_timestamp ctxt level =
   let current = Level.current ctxt in
@@ -135,25 +155,29 @@ let earlier_predecessor_timestamp ctxt level =
   if Compare.Int32.(gap < 1l) then
     failwith "Baking.earlier_block_timestamp: past block."
   else
-    Lwt.return (Period.mult (Int32.pred gap) step) >>=? fun delay ->
-    Lwt.return Timestamp.(current_timestamp +? delay) >>=? fun result ->
-    return result
+    Lwt.return (Period.mult (Int32.pred gap) step)
+    >>=? fun delay ->
+    Lwt.return Timestamp.(current_timestamp +? delay)
+    >>=? fun result -> return result
 
 let check_timestamp c priority pred_timestamp =
-  minimal_time c priority pred_timestamp >>=? fun minimal_time ->
+  minimal_time c priority pred_timestamp
+  >>=? fun minimal_time ->
   let timestamp = Alpha_context.Timestamp.current c in
   Lwt.return
-    (record_trace (Timestamp_too_early (minimal_time, timestamp))
+    (record_trace
+       (Timestamp_too_early (minimal_time, timestamp))
        Timestamp.(timestamp -? minimal_time))
 
-let check_baking_rights c { Block_header.priority ; _ }
-    pred_timestamp =
+let check_baking_rights c {Block_header.priority; _} pred_timestamp =
   let level = Level.current c in
-  Roll.baking_rights_owner c level ~priority >>=? fun delegate ->
-  check_timestamp c priority pred_timestamp >>=? fun block_delay ->
-  return (delegate, block_delay)
+  Roll.baking_rights_owner c level ~priority
+  >>=? fun delegate ->
+  check_timestamp c priority pred_timestamp
+  >>=? fun block_delay -> return (delegate, block_delay)
 
 type error += Incorrect_priority (* `Permanent *)
+
 type error += Incorrect_number_of_endorsements (* `Permanent *)
 
 let () =
@@ -163,14 +187,16 @@ let () =
     ~title:"Incorrect priority"
     ~description:"Block priority must be non-negative."
     ~pp:(fun ppf () ->
-        Format.fprintf ppf "The block priority must be non-negative.")
+      Format.fprintf ppf "The block priority must be non-negative.")
     Data_encoding.unit
     (function Incorrect_priority -> Some () | _ -> None)
     (fun () -> Incorrect_priority)
 
 let () =
-  let description = "The number of endorsements must be non-negative and \
-                     at most the endosers_per_block constant." in
+  let description =
+    "The number of endorsements must be non-negative and at most the \
+     endosers_per_block constant."
+  in
   register_error_kind
     `Permanent
     ~id:"incorrect_number_of_endorsements"
@@ -181,89 +207,109 @@ let () =
     (function Incorrect_number_of_endorsements -> Some () | _ -> None)
     (fun () -> Incorrect_number_of_endorsements)
 
-let baking_reward ctxt ~block_priority:prio ~included_endorsements:num_endo =
-  fail_unless Compare.Int.(prio >= 0) Incorrect_priority >>=? fun () ->
-  let max_endorsements = Constants.endorsers_per_block ctxt in
-  fail_unless Compare.Int.(num_endo >= 0 && num_endo <= max_endorsements)
-    Incorrect_number_of_endorsements >>=? fun () ->
-  let prio_factor_denominator = Int64.(succ (of_int prio)) in
-  let endo_factor_numerator = Int64.of_int (8 + 2 * num_endo / max_endorsements) in
-  let endo_factor_denominator = 10L in
-  Lwt.return
-    Tez.(
-      Constants.block_reward ctxt *? endo_factor_numerator >>? fun val1 ->
-      val1 /? endo_factor_denominator >>? fun val2 ->
-      val2 /? prio_factor_denominator)
+let rec reward_for_priority reward_per_prio prio =
+  match reward_per_prio with
+  | [] ->
+      (* Empty reward list in parameters means no rewards *)
+      Tez.zero
+  | [last] ->
+      last
+  | first :: rest ->
+      if Compare.Int.(prio <= 0) then first
+      else reward_for_priority rest (pred prio)
 
-let endorsing_reward ctxt ~block_priority:prio n =
-  if Compare.Int.(prio >= 0)
-  then
-    Lwt.return
-      Tez.(Constants.endorsement_reward ctxt /? (Int64.(succ (of_int prio)))) >>=? fun tez ->
-    Lwt.return Tez.(tez *? Int64.of_int n)
-  else fail Incorrect_priority
+let baking_reward ctxt ~block_priority ~included_endorsements =
+  fail_unless Compare.Int.(block_priority >= 0) Incorrect_priority
+  >>=? fun () ->
+  fail_unless
+    Compare.Int.(
+      included_endorsements >= 0
+      && included_endorsements <= Constants.endorsers_per_block ctxt)
+    Incorrect_number_of_endorsements
+  >>=? fun () ->
+  let reward_per_endorsement =
+    reward_for_priority
+      (Constants.baking_reward_per_endorsement ctxt)
+      block_priority
+  in
+  Lwt.return Tez.(reward_per_endorsement *? Int64.of_int included_endorsements)
+
+let endorsing_reward ctxt ~block_priority num_slots =
+  fail_unless Compare.Int.(block_priority >= 0) Incorrect_priority
+  >>=? fun () ->
+  let reward_per_endorsement =
+    reward_for_priority (Constants.endorsement_reward ctxt) block_priority
+  in
+  Lwt.return Tez.(reward_per_endorsement *? Int64.of_int num_slots)
 
 let baking_priorities c level =
   let rec f priority =
-    Roll.baking_rights_owner c level ~priority >>=? fun delegate ->
-    return (LCons (delegate, (fun () -> f (succ priority))))
+    Roll.baking_rights_owner c level ~priority
+    >>=? fun delegate -> return (LCons (delegate, fun () -> f (succ priority)))
   in
   f 0
 
-let endorsement_rights c level =
+let endorsement_rights ctxt level =
   fold_left_s
     (fun acc slot ->
-       Roll.endorsement_rights_owner c level ~slot >>=? fun pk ->
-       let pkh = Signature.Public_key.hash pk in
-       let right =
-         match Signature.Public_key_hash.Map.find_opt pkh acc with
-         | None -> (pk, [slot], false)
-         | Some (pk, slots, used) -> (pk, slot :: slots, used) in
-       return (Signature.Public_key_hash.Map.add pkh right acc))
+      Roll.endorsement_rights_owner ctxt level ~slot
+      >>=? fun pk ->
+      let pkh = Signature.Public_key.hash pk in
+      let right =
+        match Signature.Public_key_hash.Map.find_opt pkh acc with
+        | None ->
+            (pk, [slot], false)
+        | Some (pk, slots, used) ->
+            (pk, slot :: slots, used)
+      in
+      return (Signature.Public_key_hash.Map.add pkh right acc))
     Signature.Public_key_hash.Map.empty
-    (0 --> (Constants.endorsers_per_block c - 1))
+    (0 --> (Constants.endorsers_per_block ctxt - 1))
 
-let check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t) =
+let check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t)
+    =
   let current_level = Level.current ctxt in
-  let Single (Endorsement { level ; _ }) = op.protocol_data.contents in
-  begin
-    if Raw_level.(succ level = current_level.level) then
-      return (Alpha_context.allowed_endorsements ctxt)
-    else
-      endorsement_rights ctxt (Level.from_raw ctxt level)
-  end >>=? fun endorsements ->
+  let (Single (Endorsement {level; _})) = op.protocol_data.contents in
+  ( if Raw_level.(succ level = current_level.level) then
+    return (Alpha_context.allowed_endorsements ctxt)
+  else endorsement_rights ctxt (Level.from_raw ctxt level) )
+  >>=? fun endorsements ->
   match
     Signature.Public_key_hash.Map.fold (* no find_first *)
       (fun pkh (pk, slots, used) acc ->
-         match Operation.check_signature_sync pk chain_id op with
-         | Error _ -> acc
-         | Ok () -> Some (pkh, slots, used))
-      endorsements None
+        match Operation.check_signature_sync pk chain_id op with
+        | Error _ ->
+            acc
+        | Ok () ->
+            Some (pkh, slots, used))
+      endorsements
+      None
   with
-  | None -> fail Unexpected_endorsement
-  | Some v -> return v
+  | None ->
+      fail Unexpected_endorsement
+  | Some v ->
+      return v
 
 let select_delegate delegate delegate_list max_priority =
   let rec loop acc l n =
-    if Compare.Int.(n >= max_priority)
-    then return (List.rev acc)
+    if Compare.Int.(n >= max_priority) then return (List.rev acc)
     else
-      let LCons (pk, t) = l in
+      let (LCons (pk, t)) = l in
       let acc =
-        if Signature.Public_key_hash.equal delegate (Signature.Public_key.hash pk)
+        if
+          Signature.Public_key_hash.equal
+            delegate
+            (Signature.Public_key.hash pk)
         then n :: acc
-        else acc in
-      t () >>=? fun t ->
-      loop acc t (succ n)
+        else acc
+      in
+      t () >>=? fun t -> loop acc t (succ n)
   in
   loop [] delegate_list 0
 
-let first_baking_priorities
-    ctxt
-    ?(max_priority = 32)
-    delegate level =
-  baking_priorities ctxt level >>=? fun delegate_list ->
-  select_delegate delegate delegate_list max_priority
+let first_baking_priorities ctxt ?(max_priority = 32) delegate level =
+  baking_priorities ctxt level
+  >>=? fun delegate_list -> select_delegate delegate delegate_list max_priority
 
 let check_hash hash stamp_threshold =
   let bytes = Block_hash.to_bytes hash in
@@ -273,84 +319,89 @@ let check_hash hash stamp_threshold =
 let check_header_proof_of_work_stamp shell contents stamp_threshold =
   let hash =
     Block_header.hash
-      { shell ; protocol_data = { contents ; signature = Signature.zero } } in
+      {shell; protocol_data = {contents; signature = Signature.zero}}
+  in
   check_hash hash stamp_threshold
 
 let check_proof_of_work_stamp ctxt block =
   let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in
-  if check_header_proof_of_work_stamp
+  if
+    check_header_proof_of_work_stamp
       block.Block_header.shell
       block.protocol_data.contents
-      proof_of_work_threshold then
-    return_unit
-  else
-    fail Invalid_stamp
+      proof_of_work_threshold
+  then return_unit
+  else fail Invalid_stamp
 
 let check_signature block chain_id key =
   let check_signature key
-      { Block_header.shell ; protocol_data = { contents ; signature } } =
+      {Block_header.shell; protocol_data = {contents; signature}} =
     let unsigned_header =
       Data_encoding.Binary.to_bytes_exn
         Block_header.unsigned_encoding
-        (shell, contents) in
-    Signature.check ~watermark:(Block_header chain_id) key signature unsigned_header in
-  if check_signature key block then
-    return_unit
+        (shell, contents)
+    in
+    Signature.check
+      ~watermark:(Block_header chain_id)
+      key
+      signature
+      unsigned_header
+  in
+  if check_signature key block then return_unit
   else
-    fail (Invalid_block_signature (Block_header.hash block,
-                                   Signature.Public_key.hash key))
+    fail
+      (Invalid_block_signature
+         (Block_header.hash block, Signature.Public_key.hash key))
 
 let max_fitness_gap _ctxt = 1L
 
 let check_fitness_gap ctxt (block : Block_header.t) =
   let current_fitness = Fitness.current ctxt in
-  Lwt.return (Fitness.to_int64 block.shell.fitness) >>=? fun announced_fitness ->
+  Lwt.return (Fitness.to_int64 block.shell.fitness)
+  >>=? fun announced_fitness ->
   let gap = Int64.sub announced_fitness current_fitness in
   if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then
     fail (Invalid_fitness_gap (max_fitness_gap ctxt, gap))
-  else
-    return_unit
+  else return_unit
 
 let last_of_a_cycle ctxt l =
-  Compare.Int32.(Int32.succ l.Level.cycle_position =
-                 Constants.blocks_per_cycle ctxt)
+  Compare.Int32.(
+    Int32.succ l.Level.cycle_position = Constants.blocks_per_cycle ctxt)
 
 let dawn_of_a_new_cycle ctxt =
   let level = Level.current ctxt in
-  if last_of_a_cycle ctxt level then
-    return_some level.cycle
-  else
-    return_none
+  if last_of_a_cycle ctxt level then return_some level.cycle else return_none
 
 let minimum_allowed_endorsements ctxt ~block_delay =
   let minimum = Constants.initial_endorsers ctxt in
   let delay_per_missing_endorsement =
     Int64.to_int
-      (Period.to_seconds
-         (Constants.delay_per_missing_endorsement ctxt))
+      (Period.to_seconds (Constants.delay_per_missing_endorsement ctxt))
   in
   let reduced_time_constraint =
     let delay = Int64.to_int (Period.to_seconds block_delay) in
-    if Compare.Int.(delay_per_missing_endorsement = 0) then
-      delay
-    else
-      delay / delay_per_missing_endorsement
+    if Compare.Int.(delay_per_missing_endorsement = 0) then delay
+    else delay / delay_per_missing_endorsement
   in
   Compare.Int.max 0 (minimum - reduced_time_constraint)
 
 let minimal_valid_time ctxt ~priority ~endorsing_power =
   let predecessor_timestamp = Timestamp.current ctxt in
-  minimal_time ctxt
-    priority predecessor_timestamp >>=? fun minimal_time ->
+  minimal_time ctxt priority predecessor_timestamp
+  >>=? fun minimal_time ->
   let minimal_required_endorsements = Constants.initial_endorsers ctxt in
   let delay_per_missing_endorsement =
     Constants.delay_per_missing_endorsement ctxt
   in
   let missing_endorsements =
-    Compare.Int.max 0 (minimal_required_endorsements - endorsing_power) in
-  match Period.mult
-          (Int32.of_int missing_endorsements)
-          delay_per_missing_endorsement with
+    Compare.Int.max 0 (minimal_required_endorsements - endorsing_power)
+  in
+  match
+    Period.mult
+      (Int32.of_int missing_endorsements)
+      delay_per_missing_endorsement
+  with
   | Ok delay ->
       return (Time.add minimal_time (Period.to_seconds delay))
-  | Error _ as err -> Lwt.return err
+  | Error _ as err ->
+      Lwt.return err

vendors/ligo-utils/tezos-protocol-alpha/baking.mli

@@ -23,67 +23,81 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-
 open Alpha_context
 open Misc
 
 type error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)
-type error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)
-type error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)
+
+type error += Timestamp_too_early of Timestamp.t * Timestamp.t
+
+(* `Permanent *)
+
+type error +=
+  | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t
+
+(* `Permanent *)
+
 type error += Unexpected_endorsement
-type error += Invalid_signature  (* `Permanent *)
-type error += Invalid_stamp  (* `Permanent *)
+
+type error += Invalid_signature (* `Permanent *)
+
+type error += Invalid_stamp (* `Permanent *)
 
 (** [minimal_time ctxt priority pred_block_time] returns the minimal
     time, given the predecessor block timestamp [pred_block_time],
     after which a baker with priority [priority] is allowed to
     bake. Fail with [Invalid_time_between_blocks_constant] if the minimal
     time cannot be computed. *)
-val minimal_time: context -> int -> Time.t -> Time.t tzresult Lwt.t
+val minimal_time : context -> int -> Time.t -> Time.t tzresult Lwt.t
 
 (** [check_baking_rights ctxt block pred_timestamp] verifies that:
     * the contract that owned the roll at cycle start has the block signer as delegate.
     * the timestamp is coherent with the announced slot.
 *)
-val check_baking_rights:
-  context -> Block_header.contents -> Time.t ->
+val check_baking_rights :
+  context ->
+  Block_header.contents ->
+  Time.t ->
   (public_key * Period.t) tzresult Lwt.t
 
 (** For a given level computes who has the right to
     include an endorsement in the next block.
     The result can be stored in Alpha_context.allowed_endorsements *)
-val endorsement_rights:
+val endorsement_rights :
   context ->
   Level.t ->
   (public_key * int list * bool) Signature.Public_key_hash.Map.t tzresult Lwt.t
 
 (** Check that the operation was signed by a delegate allowed
     to endorse at the level specified by the endorsement. *)
-val check_endorsement_rights:
-  context -> Chain_id.t -> Kind.endorsement Operation.t ->
+val check_endorsement_rights :
+  context ->
+  Chain_id.t ->
+  Kind.endorsement Operation.t ->
   (public_key_hash * int list * bool) tzresult Lwt.t
 
 (** Returns the baking reward calculated w.r.t a given priority [p] and a
-    number [e] of included endorsements as follows:
-      (block_reward / (p+1)) * (0.8 + 0.2 * e / endorsers_per_block)
-*)
-val baking_reward: context ->
-  block_priority:int -> included_endorsements:int -> Tez.t tzresult Lwt.t
+    number [e] of included endorsements *)
+val baking_reward :
+  context ->
+  block_priority:int ->
+  included_endorsements:int ->
+  Tez.t tzresult Lwt.t
 
 (** Returns the endorsing reward calculated w.r.t a given priority.  *)
-val endorsing_reward: context -> block_priority:int -> int -> Tez.t tzresult Lwt.t
+val endorsing_reward :
+  context -> block_priority:int -> int -> Tez.t tzresult Lwt.t
 
 (** [baking_priorities ctxt level] is the lazy list of contract's
     public key hashes that are allowed to bake for [level]. *)
-val baking_priorities:
-  context -> Level.t -> public_key lazy_list
+val baking_priorities : context -> Level.t -> public_key lazy_list
 
 (** [first_baking_priorities ctxt ?max_priority contract_hash level]
     is a list of priorities of max [?max_priority] elements, where the
     delegate of [contract_hash] is allowed to bake for [level]. If
     [?max_priority] is [None], a sensible number of priorities is
     returned. *)
-val first_baking_priorities:
+val first_baking_priorities :
   context ->
   ?max_priority:int ->
   public_key_hash ->
@@ -92,27 +106,28 @@ val first_baking_priorities:
 
 (** [check_signature ctxt chain_id block id] check if the block is
     signed with the given key, and belongs to the given [chain_id] *)
-val check_signature: Block_header.t -> Chain_id.t -> public_key -> unit tzresult Lwt.t
+val check_signature :
+  Block_header.t -> Chain_id.t -> public_key -> unit tzresult Lwt.t
 
 (** Checks if the header that would be built from the given components
     is valid for the given diffculty. The signature is not passed as it
     is does not impact the proof-of-work stamp. The stamp is checked on
     the hash of a block header whose signature has been zeroed-out. *)
-val check_header_proof_of_work_stamp:
+val check_header_proof_of_work_stamp :
   Block_header.shell_header -> Block_header.contents -> int64 -> bool
 
 (** verify if the proof of work stamp is valid *)
-val check_proof_of_work_stamp:
+val check_proof_of_work_stamp :
   context -> Block_header.t -> unit tzresult Lwt.t
 
 (** check if the gap between the fitness of the current context
     and the given block is within the protocol parameters *)
-val check_fitness_gap:
-  context -> Block_header.t -> unit tzresult Lwt.t
+val check_fitness_gap : context -> Block_header.t -> unit tzresult Lwt.t
 
-val dawn_of_a_new_cycle: context -> Cycle.t option tzresult Lwt.t
+val dawn_of_a_new_cycle : context -> Cycle.t option tzresult Lwt.t
 
-val earlier_predecessor_timestamp: context -> Level.t -> Timestamp.t tzresult Lwt.t
+val earlier_predecessor_timestamp :
+  context -> Level.t -> Timestamp.t tzresult Lwt.t
 
 (** Since Emmy+
 
@@ -138,14 +153,11 @@ val earlier_predecessor_timestamp: context -> Level.t -> Timestamp.t tzresult Lw
     time to bake at the block's priority (as returned by
     `minimum_time`), it returns the minimum number of endorsements that
     the block has to contain *)
-val minimum_allowed_endorsements: context -> block_delay:Period.t -> int
+val minimum_allowed_endorsements : context -> block_delay:Period.t -> int
 
 (** This is the somehow the dual of the previous function. Given a
     block priority and a number of endorsement slots (given by the
     `endorsing_power` argument), it returns the minimum time at which
     the next block can be baked. *)
-val minimal_valid_time:
-  context ->
-  priority:int ->
-  endorsing_power: int ->
-  Time.t tzresult Lwt.t
+val minimal_valid_time :
+  context -> priority:int -> endorsing_power:int -> Time.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/blinded_public_key_hash.ml

@@ -23,24 +23,30 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-module H = Blake2B.Make(Base58)(struct
-    let name = "Blinded public key hash"
-    let title = "A blinded public key hash"
-    let b58check_prefix = "\001\002\049\223"
-    let size = Some Ed25519.Public_key_hash.size
-  end)
+module H =
+  Blake2B.Make
+    (Base58)
+    (struct
+      let name = "Blinded public key hash"
+
+      let title = "A blinded public key hash"
+
+      let b58check_prefix = "\001\002\049\223"
+
+      let size = Some Ed25519.Public_key_hash.size
+    end)
 
 include H
 
-let () =
-  Base58.check_encoded_prefix b58check_encoding "btz1" 37
+let () = Base58.check_encoded_prefix b58check_encoding "btz1" 37
 
 let of_ed25519_pkh activation_code pkh =
-  hash_bytes ~key:activation_code [ Ed25519.Public_key_hash.to_bytes pkh ]
+  hash_bytes ~key:activation_code [Ed25519.Public_key_hash.to_bytes pkh]
 
 type activation_code = MBytes.t
 
 let activation_code_size = Ed25519.Public_key_hash.size
+
 let activation_code_encoding = Data_encoding.Fixed.bytes activation_code_size
 
 let activation_code_of_hex h =

vendors/ligo-utils/tezos-protocol-alpha/blinded_public_key_hash.mli

@@ -26,9 +26,11 @@
 include S.HASH
 
 val encoding : t Data_encoding.t
+
 val rpc_arg : t RPC_arg.t
 
 type activation_code
+
 val activation_code_encoding : activation_code Data_encoding.t
 
 val of_ed25519_pkh : activation_code -> Ed25519.Public_key_hash.t -> t

vendors/ligo-utils/tezos-protocol-alpha/block_header_repr.ml

@@ -25,114 +25,106 @@
 
 (** Block header *)
 
-type t = {
-  shell: Block_header.shell_header ;
-  protocol_data: protocol_data ;
-}
+type t = {shell : Block_header.shell_header; protocol_data : protocol_data}
 
-and protocol_data = {
-  contents: contents ;
-  signature: Signature.t ;
-}
+and protocol_data = {contents : contents; signature : Signature.t}
 
 and contents = {
-  priority: int ;
-  seed_nonce_hash: Nonce_hash.t option ;
-  proof_of_work_nonce: MBytes.t ;
+  priority : int;
+  seed_nonce_hash : Nonce_hash.t option;
+  proof_of_work_nonce : MBytes.t;
 }
 
 type block_header = t
 
 type raw = Block_header.t
+
 type shell_header = Block_header.shell_header
 
 let raw_encoding = Block_header.encoding
+
 let shell_header_encoding = Block_header.shell_header_encoding
 
 let contents_encoding =
   let open Data_encoding in
-  def "block_header.alpha.unsigned_contents" @@
-  conv
-    (fun { priority ; seed_nonce_hash ; proof_of_work_nonce } ->
-       (priority, proof_of_work_nonce, seed_nonce_hash))
-    (fun (priority, proof_of_work_nonce, seed_nonce_hash) ->
-       { priority ; seed_nonce_hash ; proof_of_work_nonce })
-    (obj3
-       (req "priority" uint16)
-       (req "proof_of_work_nonce"
-          (Fixed.bytes Constants_repr.proof_of_work_nonce_size))
-       (opt "seed_nonce_hash" Nonce_hash.encoding))
+  def "block_header.alpha.unsigned_contents"
+  @@ conv
+       (fun {priority; seed_nonce_hash; proof_of_work_nonce} ->
+         (priority, proof_of_work_nonce, seed_nonce_hash))
+       (fun (priority, proof_of_work_nonce, seed_nonce_hash) ->
+         {priority; seed_nonce_hash; proof_of_work_nonce})
+       (obj3
+          (req "priority" uint16)
+          (req
+             "proof_of_work_nonce"
+             (Fixed.bytes Constants_repr.proof_of_work_nonce_size))
+          (opt "seed_nonce_hash" Nonce_hash.encoding))
 
 let protocol_data_encoding =
   let open Data_encoding in
-  def "block_header.alpha.signed_contents" @@
-  conv
-    (fun { contents ; signature } -> (contents, signature))
-    (fun (contents, signature) -> { contents ; signature })
-    (merge_objs
-       contents_encoding
-       (obj1 (req "signature" Signature.encoding)))
+  def "block_header.alpha.signed_contents"
+  @@ conv
+       (fun {contents; signature} -> (contents, signature))
+       (fun (contents, signature) -> {contents; signature})
+       (merge_objs
+          contents_encoding
+          (obj1 (req "signature" Signature.encoding)))
 
-let raw { shell ; protocol_data ; } =
+let raw {shell; protocol_data} =
   let protocol_data =
-    Data_encoding.Binary.to_bytes_exn
-      protocol_data_encoding
-      protocol_data in
-  { Block_header.shell ; protocol_data }
+    Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data
+  in
+  {Block_header.shell; protocol_data}
 
 let unsigned_encoding =
   let open Data_encoding in
-  merge_objs
-    Block_header.shell_header_encoding
-    contents_encoding
+  merge_objs Block_header.shell_header_encoding contents_encoding
 
 let encoding =
   let open Data_encoding in
-  def "block_header.alpha.full_header" @@
-  conv
-    (fun { shell ; protocol_data } ->
-       (shell, protocol_data))
-    (fun (shell, protocol_data) ->
-       { shell ; protocol_data })
-    (merge_objs
-       Block_header.shell_header_encoding
-       protocol_data_encoding)
+  def "block_header.alpha.full_header"
+  @@ conv
+       (fun {shell; protocol_data} -> (shell, protocol_data))
+       (fun (shell, protocol_data) -> {shell; protocol_data})
+       (merge_objs Block_header.shell_header_encoding protocol_data_encoding)
 
 (** Constants *)
 
 let max_header_length =
-  let fake_shell = {
-    Block_header.level = 0l ;
-    proto_level = 0 ;
-    predecessor = Block_hash.zero ;
-    timestamp = Time.of_seconds 0L ;
-    validation_passes = 0 ;
-    operations_hash = Operation_list_list_hash.zero ;
-    fitness = Fitness_repr.from_int64 0L ;
-    context = Context_hash.zero ;
-  }
+  let fake_shell =
+    {
+      Block_header.level = 0l;
+      proto_level = 0;
+      predecessor = Block_hash.zero;
+      timestamp = Time.of_seconds 0L;
+      validation_passes = 0;
+      operations_hash = Operation_list_list_hash.zero;
+      fitness = Fitness_repr.from_int64 0L;
+      context = Context_hash.zero;
+    }
   and fake_contents =
-    { priority = 0 ;
+    {
+      priority = 0;
       proof_of_work_nonce =
-        MBytes.create Constants_repr.proof_of_work_nonce_size ;
-      seed_nonce_hash = Some Nonce_hash.zero
-    } in
+        MBytes.create Constants_repr.proof_of_work_nonce_size;
+      seed_nonce_hash = Some Nonce_hash.zero;
+    }
+  in
   Data_encoding.Binary.length
     encoding
-    { shell = fake_shell ;
-      protocol_data = {
-        contents = fake_contents ;
-        signature = Signature.zero ;
-      }
+    {
+      shell = fake_shell;
+      protocol_data = {contents = fake_contents; signature = Signature.zero};
     }
 
 (** Header parsing entry point  *)
 
 let hash_raw = Block_header.hash
-let hash { shell ; protocol_data } =
+
+let hash {shell; protocol_data} =
   Block_header.hash
-    { shell ;
+    {
+      shell;
       protocol_data =
-        Data_encoding.Binary.to_bytes_exn
-          protocol_data_encoding
-          protocol_data }
+        Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data;
+    }

vendors/ligo-utils/tezos-protocol-alpha/block_header_repr.mli

@@ -23,38 +23,39 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-type t = {
-  shell: Block_header.shell_header ;
-  protocol_data: protocol_data ;
-}
+type t = {shell : Block_header.shell_header; protocol_data : protocol_data}
 
-and protocol_data = {
-  contents: contents ;
-  signature: Signature.t ;
-}
+and protocol_data = {contents : contents; signature : Signature.t}
 
 and contents = {
-  priority: int ;
-  seed_nonce_hash: Nonce_hash.t option ;
-  proof_of_work_nonce: MBytes.t ;
+  priority : int;
+  seed_nonce_hash : Nonce_hash.t option;
+  proof_of_work_nonce : MBytes.t;
 }
 
 type block_header = t
 
 type raw = Block_header.t
+
 type shell_header = Block_header.shell_header
 
-val raw: block_header -> raw
+val raw : block_header -> raw
 
-val encoding: block_header Data_encoding.encoding
-val raw_encoding: raw Data_encoding.t
-val contents_encoding: contents Data_encoding.t
-val unsigned_encoding: (Block_header.shell_header * contents) Data_encoding.t
-val protocol_data_encoding: protocol_data Data_encoding.encoding
-val shell_header_encoding: shell_header Data_encoding.encoding
+val encoding : block_header Data_encoding.encoding
+
+val raw_encoding : raw Data_encoding.t
+
+val contents_encoding : contents Data_encoding.t
+
+val unsigned_encoding : (Block_header.shell_header * contents) Data_encoding.t
+
+val protocol_data_encoding : protocol_data Data_encoding.encoding
+
+val shell_header_encoding : shell_header Data_encoding.encoding
 
-val max_header_length: int
 (** The maximum size of block headers in bytes *)
+val max_header_length : int
 
-val hash: block_header -> Block_hash.t
-val hash_raw: raw -> Block_hash.t
+val hash : block_header -> Block_hash.t
+
+val hash_raw : raw -> Block_hash.t

vendors/ligo-utils/tezos-protocol-alpha/bootstrap_storage.ml

@@ -26,100 +26,128 @@
 open Misc
 
 let init_account ctxt
-    ({ public_key_hash ; public_key ; amount }: Parameters_repr.bootstrap_account) =
+    ({public_key_hash; public_key; amount} : Parameters_repr.bootstrap_account)
+    =
   let contract = Contract_repr.implicit_contract public_key_hash in
-  Contract_storage.credit ctxt contract amount >>=? fun ctxt ->
+  Contract_storage.credit ctxt contract amount
+  >>=? fun ctxt ->
   match public_key with
   | Some public_key ->
-      Contract_storage.reveal_manager_key ctxt public_key_hash public_key >>=? fun ctxt ->
-      Delegate_storage.set ctxt contract (Some public_key_hash) >>=? fun ctxt ->
+      Contract_storage.reveal_manager_key ctxt public_key_hash public_key
+      >>=? fun ctxt ->
+      Delegate_storage.set ctxt contract (Some public_key_hash)
+      >>=? fun ctxt -> return ctxt
+  | None ->
       return ctxt
-  | None -> return ctxt
 
 let init_contract ~typecheck ctxt
-    ({ delegate ; amount ; script }: Parameters_repr.bootstrap_contract) =
-  Contract_storage.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
-  typecheck ctxt script >>=? fun (script, ctxt) ->
-  Contract_storage.originate ctxt contract
+    ({delegate; amount; script} : Parameters_repr.bootstrap_contract) =
+  Contract_storage.fresh_contract_from_current_nonce ctxt
+  >>=? fun (ctxt, contract) ->
+  typecheck ctxt script
+  >>=? fun (script, ctxt) ->
+  Contract_storage.originate
+    ctxt
+    contract
     ~balance:amount
     ~prepaid_bootstrap_storage:true
     ~script
-    ~delegate:(Some delegate) >>=? fun ctxt ->
-  return ctxt
+    ~delegate:(Some delegate)
+  >>=? fun ctxt -> return ctxt
 
 let init ctxt ~typecheck ?ramp_up_cycles ?no_reward_cycles accounts contracts =
   let nonce =
-    Operation_hash.hash_bytes
-      [ MBytes.of_string "Un festival de GADT." ] in
+    Operation_hash.hash_bytes [MBytes.of_string "Un festival de GADT."]
+  in
   let ctxt = Raw_context.init_origination_nonce ctxt nonce in
-  fold_left_s init_account ctxt accounts >>=? fun ctxt ->
-  fold_left_s (init_contract ~typecheck) ctxt contracts >>=? fun ctxt ->
-  begin
-    match no_reward_cycles with
-    | None -> return ctxt
-    | Some cycles ->
-        (* Store pending ramp ups. *)
-        let constants = Raw_context.constants ctxt in
-        (* Start without reward *)
-        Raw_context.patch_constants ctxt
-          (fun c ->
-             { c with
-               block_reward = Tez_repr.zero ;
-               endorsement_reward = Tez_repr.zero  }) >>= fun ctxt ->
-        (* Store the final reward. *)
-        Storage.Ramp_up.Rewards.init ctxt
-          (Cycle_repr.of_int32_exn (Int32.of_int cycles))
-          (constants.block_reward,
-           constants.endorsement_reward)
-  end >>=? fun ctxt ->
-  match ramp_up_cycles with
-  | None -> return ctxt
+  fold_left_s init_account ctxt accounts
+  >>=? fun ctxt ->
+  fold_left_s (init_contract ~typecheck) ctxt contracts
+  >>=? fun ctxt ->
+  ( match no_reward_cycles with
+  | None ->
+      return ctxt
   | Some cycles ->
       (* Store pending ramp ups. *)
       let constants = Raw_context.constants ctxt in
-      Lwt.return Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles) >>=? fun block_step ->
-      Lwt.return Tez_repr.(constants.endorsement_security_deposit /? Int64.of_int cycles) >>=? fun endorsement_step ->
+      (* Start without rewards *)
+      Raw_context.patch_constants ctxt (fun c ->
+          {
+            c with
+            baking_reward_per_endorsement = [Tez_repr.zero];
+            endorsement_reward = [Tez_repr.zero];
+          })
+      >>= fun ctxt ->
+      (* Store the final reward. *)
+      Storage.Ramp_up.Rewards.init
+        ctxt
+        (Cycle_repr.of_int32_exn (Int32.of_int cycles))
+        (constants.baking_reward_per_endorsement, constants.endorsement_reward)
+  )
+  >>=? fun ctxt ->
+  match ramp_up_cycles with
+  | None ->
+      return ctxt
+  | Some cycles ->
+      (* Store pending ramp ups. *)
+      let constants = Raw_context.constants ctxt in
+      Lwt.return
+        Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles)
+      >>=? fun block_step ->
+      Lwt.return
+        Tez_repr.(
+          constants.endorsement_security_deposit /? Int64.of_int cycles)
+      >>=? fun endorsement_step ->
       (* Start without security_deposit *)
-      Raw_context.patch_constants ctxt
-        (fun c ->
-           { c with
-             block_security_deposit = Tez_repr.zero ;
-             endorsement_security_deposit = Tez_repr.zero  }) >>= fun ctxt ->
+      Raw_context.patch_constants ctxt (fun c ->
+          {
+            c with
+            block_security_deposit = Tez_repr.zero;
+            endorsement_security_deposit = Tez_repr.zero;
+          })
+      >>= fun ctxt ->
       fold_left_s
         (fun ctxt cycle ->
-           Lwt.return Tez_repr.(block_step *? Int64.of_int cycle) >>=? fun block_security_deposit ->
-           Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle) >>=? fun endorsement_security_deposit ->
-           let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in
-           Storage.Ramp_up.Security_deposits.init ctxt cycle
-             (block_security_deposit, endorsement_security_deposit))
+          Lwt.return Tez_repr.(block_step *? Int64.of_int cycle)
+          >>=? fun block_security_deposit ->
+          Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle)
+          >>=? fun endorsement_security_deposit ->
+          let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in
+          Storage.Ramp_up.Security_deposits.init
+            ctxt
+            cycle
+            (block_security_deposit, endorsement_security_deposit))
         ctxt
-        (1 --> (cycles - 1)) >>=? fun ctxt ->
+        (1 --> (cycles - 1))
+      >>=? fun ctxt ->
       (* Store the final security deposits. *)
-      Storage.Ramp_up.Security_deposits.init ctxt
+      Storage.Ramp_up.Security_deposits.init
+        ctxt
         (Cycle_repr.of_int32_exn (Int32.of_int cycles))
-        (constants.block_security_deposit,
-         constants.endorsement_security_deposit) >>=? fun ctxt ->
-      return ctxt
+        ( constants.block_security_deposit,
+          constants.endorsement_security_deposit )
+      >>=? fun ctxt -> return ctxt
 
 let cycle_end ctxt last_cycle =
   let next_cycle = Cycle_repr.succ last_cycle in
-  begin
-    Storage.Ramp_up.Rewards.get_option ctxt next_cycle >>=? function
-    | None -> return ctxt
-    | Some (block_reward, endorsement_reward) ->
-        Storage.Ramp_up.Rewards.delete ctxt next_cycle >>=? fun ctxt ->
-        Raw_context.patch_constants ctxt
-          (fun c ->
-             { c with block_reward ;
-                      endorsement_reward }) >>= fun ctxt ->
-        return ctxt
-  end >>=? fun ctxt ->
-  Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle >>=? function
-  | None -> return ctxt
-  | Some (block_security_deposit, endorsement_security_deposit) ->
-      Storage.Ramp_up.Security_deposits.delete ctxt next_cycle >>=? fun ctxt ->
-      Raw_context.patch_constants ctxt
-        (fun c ->
-           { c with block_security_deposit ;
-                    endorsement_security_deposit }) >>= fun ctxt ->
+  Storage.Ramp_up.Rewards.get_option ctxt next_cycle
+  >>=? (function
+         | None ->
+             return ctxt
+         | Some (baking_reward_per_endorsement, endorsement_reward) ->
+             Storage.Ramp_up.Rewards.delete ctxt next_cycle
+             >>=? fun ctxt ->
+             Raw_context.patch_constants ctxt (fun c ->
+                 {c with baking_reward_per_endorsement; endorsement_reward})
+             >>= fun ctxt -> return ctxt)
+  >>=? fun ctxt ->
+  Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle
+  >>=? function
+  | None ->
       return ctxt
+  | Some (block_security_deposit, endorsement_security_deposit) ->
+      Storage.Ramp_up.Security_deposits.delete ctxt next_cycle
+      >>=? fun ctxt ->
+      Raw_context.patch_constants ctxt (fun c ->
+          {c with block_security_deposit; endorsement_security_deposit})
+      >>= fun ctxt -> return ctxt

vendors/ligo-utils/tezos-protocol-alpha/bootstrap_storage.mli

@@ -23,18 +23,18 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-val init:
+val init :
   Raw_context.t ->
-  typecheck:(Raw_context.t -> Script_repr.t ->
-             ((Script_repr.t * Contract_storage.big_map_diff option) * Raw_context.t)
-               tzresult Lwt.t) ->
+  typecheck:(Raw_context.t ->
+            Script_repr.t ->
+            ( (Script_repr.t * Contract_storage.big_map_diff option)
+            * Raw_context.t )
+            tzresult
+            Lwt.t) ->
   ?ramp_up_cycles:int ->
   ?no_reward_cycles:int ->
   Parameters_repr.bootstrap_account list ->
   Parameters_repr.bootstrap_contract list ->
   Raw_context.t tzresult Lwt.t
 
-val cycle_end:
-  Raw_context.t ->
-  Cycle_repr.t ->
-  Raw_context.t tzresult Lwt.t
+val cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/commitment_repr.ml

@@ -24,17 +24,15 @@
 (*****************************************************************************)
 
 type t = {
-  blinded_public_key_hash : Blinded_public_key_hash.t ;
-  amount : Tez_repr.t
+  blinded_public_key_hash : Blinded_public_key_hash.t;
+  amount : Tez_repr.t;
 }
 
 let encoding =
   let open Data_encoding in
   conv
-    (fun { blinded_public_key_hash ; amount } ->
-       ( blinded_public_key_hash, amount ))
-    (fun ( blinded_public_key_hash, amount) ->
-       { blinded_public_key_hash ; amount })
-    (tup2
-       Blinded_public_key_hash.encoding
-       Tez_repr.encoding)
+    (fun {blinded_public_key_hash; amount} ->
+      (blinded_public_key_hash, amount))
+    (fun (blinded_public_key_hash, amount) ->
+      {blinded_public_key_hash; amount})
+    (tup2 Blinded_public_key_hash.encoding Tez_repr.encoding)

vendors/ligo-utils/tezos-protocol-alpha/commitment_repr.mli

@@ -24,8 +24,8 @@
 (*****************************************************************************)
 
 type t = {
-  blinded_public_key_hash : Blinded_public_key_hash.t ;
-  amount : Tez_repr.t ;
+  blinded_public_key_hash : Blinded_public_key_hash.t;
+  amount : Tez_repr.t;
 }
 
 val encoding : t Data_encoding.t

vendors/ligo-utils/tezos-protocol-alpha/commitment_storage.ml

@@ -24,10 +24,11 @@
 (*****************************************************************************)
 
 let get_opt = Storage.Commitments.get_option
+
 let delete = Storage.Commitments.delete
 
-let init ctxt commitments  =
-  let init_commitment ctxt Commitment_repr.{ blinded_public_key_hash ; amount } =
-    Storage.Commitments.init ctxt blinded_public_key_hash amount in
-  fold_left_s init_commitment ctxt commitments >>=? fun ctxt ->
-  return ctxt
+let init ctxt commitments =
+  let init_commitment ctxt Commitment_repr.{blinded_public_key_hash; amount} =
+    Storage.Commitments.init ctxt blinded_public_key_hash amount
+  in
+  fold_left_s init_commitment ctxt commitments >>=? fun ctxt -> return ctxt

vendors/ligo-utils/tezos-protocol-alpha/commitment_storage.mli

@@ -23,15 +23,13 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-val init:
-  Raw_context.t ->
-  Commitment_repr.t list ->
-  Raw_context.t tzresult Lwt.t
+val init :
+  Raw_context.t -> Commitment_repr.t list -> Raw_context.t tzresult Lwt.t
 
-val get_opt:
-  Raw_context.t -> Blinded_public_key_hash.t ->
+val get_opt :
+  Raw_context.t ->
+  Blinded_public_key_hash.t ->
   Tez_repr.t option tzresult Lwt.t
 
-val delete:
-  Raw_context.t -> Blinded_public_key_hash.t ->
-  Raw_context.t tzresult Lwt.t
+val delete :
+  Raw_context.t -> Blinded_public_key_hash.t -> Raw_context.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/constants_repr.ml

@@ -24,41 +24,48 @@
 (*****************************************************************************)
 
 let version_number_004 = "\000"
+
 let version_number = "\001"
+
 let proof_of_work_nonce_size = 8
+
 let nonce_length = 32
+
 let max_revelations_per_block = 32
+
 let max_proposals_per_delegate = 20
+
 let max_operation_data_length = 16 * 1024 (* 16kB *)
 
 type fixed = {
-  proof_of_work_nonce_size : int ;
-  nonce_length : int ;
-  max_revelations_per_block : int ;
-  max_operation_data_length : int ;
-  max_proposals_per_delegate : int ;
+  proof_of_work_nonce_size : int;
+  nonce_length : int;
+  max_revelations_per_block : int;
+  max_operation_data_length : int;
+  max_proposals_per_delegate : int;
 }
 
 let fixed_encoding =
   let open Data_encoding in
   conv
     (fun c ->
-       (c.proof_of_work_nonce_size,
+      ( c.proof_of_work_nonce_size,
         c.nonce_length,
         c.max_revelations_per_block,
         c.max_operation_data_length,
-        c.max_proposals_per_delegate))
-    (fun (proof_of_work_nonce_size,
-          nonce_length,
-          max_revelations_per_block,
-          max_operation_data_length,
-          max_proposals_per_delegate) ->
-      { proof_of_work_nonce_size ;
-        nonce_length ;
-        max_revelations_per_block ;
-        max_operation_data_length ;
-        max_proposals_per_delegate ;
-      } )
+        c.max_proposals_per_delegate ))
+    (fun ( proof_of_work_nonce_size,
+           nonce_length,
+           max_revelations_per_block,
+           max_operation_data_length,
+           max_proposals_per_delegate ) ->
+      {
+        proof_of_work_nonce_size;
+        nonce_length;
+        max_revelations_per_block;
+        max_operation_data_length;
+        max_proposals_per_delegate;
+      })
     (obj5
        (req "proof_of_work_nonce_size" uint8)
        (req "nonce_length" uint8)
@@ -66,48 +73,50 @@ let fixed_encoding =
        (req "max_operation_data_length" int31)
        (req "max_proposals_per_delegate" uint8))
 
-let fixed = {
-  proof_of_work_nonce_size ;
-  nonce_length ;
-  max_revelations_per_block ;
-  max_operation_data_length ;
-  max_proposals_per_delegate ;
-}
+let fixed =
+  {
+    proof_of_work_nonce_size;
+    nonce_length;
+    max_revelations_per_block;
+    max_operation_data_length;
+    max_proposals_per_delegate;
+  }
 
 type parametric = {
-  preserved_cycles: int ;
-  blocks_per_cycle: int32 ;
-  blocks_per_commitment: int32 ;
-  blocks_per_roll_snapshot: int32 ;
-  blocks_per_voting_period: int32 ;
-  time_between_blocks: Period_repr.t list ;
-  endorsers_per_block: int ;
-  hard_gas_limit_per_operation: Z.t ;
-  hard_gas_limit_per_block: Z.t ;
-  proof_of_work_threshold: int64 ;
-  tokens_per_roll: Tez_repr.t ;
-  michelson_maximum_type_size: int;
-  seed_nonce_revelation_tip: Tez_repr.t ;
-  origination_size: int ;
-  block_security_deposit: Tez_repr.t ;
-  endorsement_security_deposit: Tez_repr.t ;
-  block_reward: Tez_repr.t ;
-  endorsement_reward: Tez_repr.t ;
-  cost_per_byte: Tez_repr.t ;
-  hard_storage_limit_per_operation: Z.t ;
-  test_chain_duration: int64 ;  (* in seconds *)
-  quorum_min: int32 ;
-  quorum_max: int32 ;
-  min_proposal_quorum: int32 ;
-  initial_endorsers: int ;
-  delay_per_missing_endorsement: Period_repr.t ;
+  preserved_cycles : int;
+  blocks_per_cycle : int32;
+  blocks_per_commitment : int32;
+  blocks_per_roll_snapshot : int32;
+  blocks_per_voting_period : int32;
+  time_between_blocks : Period_repr.t list;
+  endorsers_per_block : int;
+  hard_gas_limit_per_operation : Z.t;
+  hard_gas_limit_per_block : Z.t;
+  proof_of_work_threshold : int64;
+  tokens_per_roll : Tez_repr.t;
+  michelson_maximum_type_size : int;
+  seed_nonce_revelation_tip : Tez_repr.t;
+  origination_size : int;
+  block_security_deposit : Tez_repr.t;
+  endorsement_security_deposit : Tez_repr.t;
+  baking_reward_per_endorsement : Tez_repr.t list;
+  endorsement_reward : Tez_repr.t list;
+  cost_per_byte : Tez_repr.t;
+  hard_storage_limit_per_operation : Z.t;
+  test_chain_duration : int64;
+  (* in seconds *)
+  quorum_min : int32;
+  quorum_max : int32;
+  min_proposal_quorum : int32;
+  initial_endorsers : int;
+  delay_per_missing_endorsement : Period_repr.t;
 }
 
 let parametric_encoding =
   let open Data_encoding in
   conv
     (fun c ->
-       (( c.preserved_cycles,
+      ( ( c.preserved_cycles,
           c.blocks_per_cycle,
           c.blocks_per_commitment,
           c.blocks_per_roll_snapshot,
@@ -115,78 +124,78 @@ let parametric_encoding =
           c.time_between_blocks,
           c.endorsers_per_block,
           c.hard_gas_limit_per_operation,
-          c.hard_gas_limit_per_block),
-        ((c.proof_of_work_threshold,
-          c.tokens_per_roll,
-          c.michelson_maximum_type_size,
-          c.seed_nonce_revelation_tip,
-          c.origination_size,
-          c.block_security_deposit,
-          c.endorsement_security_deposit,
-          c.block_reward),
-         (c.endorsement_reward,
-          c.cost_per_byte,
-          c.hard_storage_limit_per_operation,
-          c.test_chain_duration,
-          c.quorum_min,
-          c.quorum_max,
-          c.min_proposal_quorum,
-          c.initial_endorsers,
-          c.delay_per_missing_endorsement
-         ))) )
-    (fun (( preserved_cycles,
-            blocks_per_cycle,
-            blocks_per_commitment,
-            blocks_per_roll_snapshot,
-            blocks_per_voting_period,
-            time_between_blocks,
-            endorsers_per_block,
-            hard_gas_limit_per_operation,
-            hard_gas_limit_per_block),
-          ((proof_of_work_threshold,
-            tokens_per_roll,
-            michelson_maximum_type_size,
-            seed_nonce_revelation_tip,
-            origination_size,
-            block_security_deposit,
-            endorsement_security_deposit,
-            block_reward),
-           (endorsement_reward,
-            cost_per_byte,
-            hard_storage_limit_per_operation,
-            test_chain_duration,
-            quorum_min,
-            quorum_max,
-            min_proposal_quorum,
-            initial_endorsers,
-            delay_per_missing_endorsement))) ->
-      { preserved_cycles ;
-        blocks_per_cycle ;
-        blocks_per_commitment ;
-        blocks_per_roll_snapshot ;
-        blocks_per_voting_period ;
-        time_between_blocks ;
-        endorsers_per_block ;
-        hard_gas_limit_per_operation ;
-        hard_gas_limit_per_block ;
-        proof_of_work_threshold ;
-        tokens_per_roll ;
-        michelson_maximum_type_size ;
-        seed_nonce_revelation_tip ;
-        origination_size ;
-        block_security_deposit ;
-        endorsement_security_deposit ;
-        block_reward ;
-        endorsement_reward ;
-        cost_per_byte ;
-        hard_storage_limit_per_operation ;
-        test_chain_duration ;
-        quorum_min ;
-        quorum_max ;
-        min_proposal_quorum ;
-        initial_endorsers ;
-        delay_per_missing_endorsement ;
-      } )
+          c.hard_gas_limit_per_block ),
+        ( ( c.proof_of_work_threshold,
+            c.tokens_per_roll,
+            c.michelson_maximum_type_size,
+            c.seed_nonce_revelation_tip,
+            c.origination_size,
+            c.block_security_deposit,
+            c.endorsement_security_deposit,
+            c.baking_reward_per_endorsement ),
+          ( c.endorsement_reward,
+            c.cost_per_byte,
+            c.hard_storage_limit_per_operation,
+            c.test_chain_duration,
+            c.quorum_min,
+            c.quorum_max,
+            c.min_proposal_quorum,
+            c.initial_endorsers,
+            c.delay_per_missing_endorsement ) ) ))
+    (fun ( ( preserved_cycles,
+             blocks_per_cycle,
+             blocks_per_commitment,
+             blocks_per_roll_snapshot,
+             blocks_per_voting_period,
+             time_between_blocks,
+             endorsers_per_block,
+             hard_gas_limit_per_operation,
+             hard_gas_limit_per_block ),
+           ( ( proof_of_work_threshold,
+               tokens_per_roll,
+               michelson_maximum_type_size,
+               seed_nonce_revelation_tip,
+               origination_size,
+               block_security_deposit,
+               endorsement_security_deposit,
+               baking_reward_per_endorsement ),
+             ( endorsement_reward,
+               cost_per_byte,
+               hard_storage_limit_per_operation,
+               test_chain_duration,
+               quorum_min,
+               quorum_max,
+               min_proposal_quorum,
+               initial_endorsers,
+               delay_per_missing_endorsement ) ) ) ->
+      {
+        preserved_cycles;
+        blocks_per_cycle;
+        blocks_per_commitment;
+        blocks_per_roll_snapshot;
+        blocks_per_voting_period;
+        time_between_blocks;
+        endorsers_per_block;
+        hard_gas_limit_per_operation;
+        hard_gas_limit_per_block;
+        proof_of_work_threshold;
+        tokens_per_roll;
+        michelson_maximum_type_size;
+        seed_nonce_revelation_tip;
+        origination_size;
+        block_security_deposit;
+        endorsement_security_deposit;
+        baking_reward_per_endorsement;
+        endorsement_reward;
+        cost_per_byte;
+        hard_storage_limit_per_operation;
+        test_chain_duration;
+        quorum_min;
+        quorum_max;
+        min_proposal_quorum;
+        initial_endorsers;
+        delay_per_missing_endorsement;
+      })
     (merge_objs
        (obj9
           (req "preserved_cycles" uint8)
@@ -207,9 +216,9 @@ let parametric_encoding =
              (req "origination_size" int31)
              (req "block_security_deposit" Tez_repr.encoding)
              (req "endorsement_security_deposit" Tez_repr.encoding)
-             (req "block_reward" Tez_repr.encoding))
+             (req "baking_reward_per_endorsement" (list Tez_repr.encoding)))
           (obj9
-             (req "endorsement_reward" Tez_repr.encoding)
+             (req "endorsement_reward" (list Tez_repr.encoding))
              (req "cost_per_byte" Tez_repr.encoding)
              (req "hard_storage_limit_per_operation" z)
              (req "test_chain_duration" int64)
@@ -217,17 +226,161 @@ let parametric_encoding =
              (req "quorum_max" int32)
              (req "min_proposal_quorum" int32)
              (req "initial_endorsers" uint16)
-             (req "delay_per_missing_endorsement" Period_repr.encoding)
-          )))
+             (req "delay_per_missing_endorsement" Period_repr.encoding))))
 
-type t = {
-  fixed : fixed ;
-  parametric : parametric ;
-}
+type t = {fixed : fixed; parametric : parametric}
 
 let encoding =
   let open Data_encoding in
   conv
-    (fun { fixed ; parametric } -> (fixed, parametric))
-    (fun (fixed , parametric) -> { fixed ; parametric })
+    (fun {fixed; parametric} -> (fixed, parametric))
+    (fun (fixed, parametric) -> {fixed; parametric})
     (merge_objs fixed_encoding parametric_encoding)
+
+module Proto_005 = struct
+  type parametric = {
+    preserved_cycles : int;
+    blocks_per_cycle : int32;
+    blocks_per_commitment : int32;
+    blocks_per_roll_snapshot : int32;
+    blocks_per_voting_period : int32;
+    time_between_blocks : Period_repr.t list;
+    endorsers_per_block : int;
+    hard_gas_limit_per_operation : Z.t;
+    hard_gas_limit_per_block : Z.t;
+    proof_of_work_threshold : int64;
+    tokens_per_roll : Tez_repr.t;
+    michelson_maximum_type_size : int;
+    seed_nonce_revelation_tip : Tez_repr.t;
+    origination_size : int;
+    block_security_deposit : Tez_repr.t;
+    endorsement_security_deposit : Tez_repr.t;
+    block_reward : Tez_repr.t;
+    endorsement_reward : Tez_repr.t;
+    cost_per_byte : Tez_repr.t;
+    hard_storage_limit_per_operation : Z.t;
+    test_chain_duration : int64;
+    (* in seconds *)
+    quorum_min : int32;
+    quorum_max : int32;
+    min_proposal_quorum : int32;
+    initial_endorsers : int;
+    delay_per_missing_endorsement : Period_repr.t;
+  }
+
+  let parametric_encoding =
+    let open Data_encoding in
+    conv
+      (fun c ->
+        ( ( c.preserved_cycles,
+            c.blocks_per_cycle,
+            c.blocks_per_commitment,
+            c.blocks_per_roll_snapshot,
+            c.blocks_per_voting_period,
+            c.time_between_blocks,
+            c.endorsers_per_block,
+            c.hard_gas_limit_per_operation,
+            c.hard_gas_limit_per_block ),
+          ( ( c.proof_of_work_threshold,
+              c.tokens_per_roll,
+              c.michelson_maximum_type_size,
+              c.seed_nonce_revelation_tip,
+              c.origination_size,
+              c.block_security_deposit,
+              c.endorsement_security_deposit,
+              c.block_reward ),
+            ( c.endorsement_reward,
+              c.cost_per_byte,
+              c.hard_storage_limit_per_operation,
+              c.test_chain_duration,
+              c.quorum_min,
+              c.quorum_max,
+              c.min_proposal_quorum,
+              c.initial_endorsers,
+              c.delay_per_missing_endorsement ) ) ))
+      (fun ( ( preserved_cycles,
+               blocks_per_cycle,
+               blocks_per_commitment,
+               blocks_per_roll_snapshot,
+               blocks_per_voting_period,
+               time_between_blocks,
+               endorsers_per_block,
+               hard_gas_limit_per_operation,
+               hard_gas_limit_per_block ),
+             ( ( proof_of_work_threshold,
+                 tokens_per_roll,
+                 michelson_maximum_type_size,
+                 seed_nonce_revelation_tip,
+                 origination_size,
+                 block_security_deposit,
+                 endorsement_security_deposit,
+                 block_reward ),
+               ( endorsement_reward,
+                 cost_per_byte,
+                 hard_storage_limit_per_operation,
+                 test_chain_duration,
+                 quorum_min,
+                 quorum_max,
+                 min_proposal_quorum,
+                 initial_endorsers,
+                 delay_per_missing_endorsement ) ) ) ->
+        {
+          preserved_cycles;
+          blocks_per_cycle;
+          blocks_per_commitment;
+          blocks_per_roll_snapshot;
+          blocks_per_voting_period;
+          time_between_blocks;
+          endorsers_per_block;
+          hard_gas_limit_per_operation;
+          hard_gas_limit_per_block;
+          proof_of_work_threshold;
+          tokens_per_roll;
+          michelson_maximum_type_size;
+          seed_nonce_revelation_tip;
+          origination_size;
+          block_security_deposit;
+          endorsement_security_deposit;
+          block_reward;
+          endorsement_reward;
+          cost_per_byte;
+          hard_storage_limit_per_operation;
+          test_chain_duration;
+          quorum_min;
+          quorum_max;
+          min_proposal_quorum;
+          initial_endorsers;
+          delay_per_missing_endorsement;
+        })
+      (merge_objs
+         (obj9
+            (req "preserved_cycles" uint8)
+            (req "blocks_per_cycle" int32)
+            (req "blocks_per_commitment" int32)
+            (req "blocks_per_roll_snapshot" int32)
+            (req "blocks_per_voting_period" int32)
+            (req "time_between_blocks" (list Period_repr.encoding))
+            (req "endorsers_per_block" uint16)
+            (req "hard_gas_limit_per_operation" z)
+            (req "hard_gas_limit_per_block" z))
+         (merge_objs
+            (obj8
+               (req "proof_of_work_threshold" int64)
+               (req "tokens_per_roll" Tez_repr.encoding)
+               (req "michelson_maximum_type_size" uint16)
+               (req "seed_nonce_revelation_tip" Tez_repr.encoding)
+               (req "origination_size" int31)
+               (req "block_security_deposit" Tez_repr.encoding)
+               (req "endorsement_security_deposit" Tez_repr.encoding)
+               (req "block_reward" Tez_repr.encoding))
+            (obj9
+               (req "endorsement_reward" Tez_repr.encoding)
+               (req "cost_per_byte" Tez_repr.encoding)
+               (req "hard_storage_limit_per_operation" z)
+               (req "test_chain_duration" int64)
+               (req "quorum_min" int32)
+               (req "quorum_max" int32)
+               (req "min_proposal_quorum" int32)
+               (req "initial_endorsers" uint16)
+               (req "delay_per_missing_endorsement" Period_repr.encoding))))
+end

vendors/ligo-utils/tezos-protocol-alpha/constants_services.ml

@@ -26,40 +26,35 @@
 open Alpha_context
 
 let custom_root =
-  (RPC_path.(open_root / "context" / "constants") : RPC_context.t RPC_path.context)
+  ( RPC_path.(open_root / "context" / "constants")
+    : RPC_context.t RPC_path.context )
 
 module S = struct
-
   open Data_encoding
 
   let errors =
     RPC_service.get_service
-      ~description: "Schema for all the RPC errors from this protocol version"
-      ~query: RPC_query.empty
-      ~output: json_schema
+      ~description:"Schema for all the RPC errors from this protocol version"
+      ~query:RPC_query.empty
+      ~output:json_schema
       RPC_path.(custom_root / "errors")
 
   let all =
     RPC_service.get_service
-      ~description: "All constants"
-      ~query: RPC_query.empty
-      ~output: Alpha_context.Constants.encoding
+      ~description:"All constants"
+      ~query:RPC_query.empty
+      ~output:Alpha_context.Constants.encoding
       custom_root
-
 end
 
 let register () =
   let open Services_registration in
-  register0_noctxt S.errors begin fun () () ->
-    return (Data_encoding.Json.(schema error_encoding))
-  end ;
-  register0 S.all begin fun ctxt () () ->
-    let open Constants in
-    return { fixed = fixed ;
-             parametric = parametric ctxt }
-  end
+  register0_noctxt S.errors (fun () () ->
+      return Data_encoding.Json.(schema error_encoding)) ;
+  register0 S.all (fun ctxt () () ->
+      let open Constants in
+      return {fixed; parametric = parametric ctxt})
 
-let errors ctxt block =
-  RPC_context.make_call0 S.errors ctxt block () ()
-let all ctxt block =
-  RPC_context.make_call0 S.all ctxt block () ()
+let errors ctxt block = RPC_context.make_call0 S.errors ctxt block () ()
+
+let all ctxt block = RPC_context.make_call0 S.all ctxt block () ()

vendors/ligo-utils/tezos-protocol-alpha/constants_services.mli

@@ -25,11 +25,12 @@
 
 open Alpha_context
 
-val errors:
-  'a #RPC_context.simple -> 'a -> Data_encoding.json_schema shell_tzresult Lwt.t
+val errors :
+  'a #RPC_context.simple ->
+  'a ->
+  Data_encoding.json_schema shell_tzresult Lwt.t
 
 (** Returns all the constants of the protocol *)
-val all:
-  'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t
+val all : 'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t
 
-val register: unit -> unit
+val register : unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/constants_storage.ml

@@ -26,80 +26,105 @@
 let preserved_cycles c =
   let constants = Raw_context.constants c in
   constants.preserved_cycles
+
 let blocks_per_cycle c =
   let constants = Raw_context.constants c in
   constants.blocks_per_cycle
+
 let blocks_per_commitment c =
   let constants = Raw_context.constants c in
   constants.blocks_per_commitment
+
 let blocks_per_roll_snapshot c =
   let constants = Raw_context.constants c in
   constants.blocks_per_roll_snapshot
+
 let blocks_per_voting_period c =
   let constants = Raw_context.constants c in
   constants.blocks_per_voting_period
+
 let time_between_blocks c =
   let constants = Raw_context.constants c in
   constants.time_between_blocks
+
 let endorsers_per_block c =
   let constants = Raw_context.constants c in
   constants.endorsers_per_block
+
 let initial_endorsers c =
   let constants = Raw_context.constants c in
   constants.initial_endorsers
+
 let delay_per_missing_endorsement c =
   let constants = Raw_context.constants c in
   constants.delay_per_missing_endorsement
+
 let hard_gas_limit_per_operation c =
   let constants = Raw_context.constants c in
   constants.hard_gas_limit_per_operation
+
 let hard_gas_limit_per_block c =
   let constants = Raw_context.constants c in
   constants.hard_gas_limit_per_block
+
 let cost_per_byte c =
   let constants = Raw_context.constants c in
   constants.cost_per_byte
+
 let hard_storage_limit_per_operation c =
   let constants = Raw_context.constants c in
   constants.hard_storage_limit_per_operation
+
 let proof_of_work_threshold c =
   let constants = Raw_context.constants c in
   constants.proof_of_work_threshold
+
 let tokens_per_roll c =
   let constants = Raw_context.constants c in
   constants.tokens_per_roll
+
 let michelson_maximum_type_size c =
   let constants = Raw_context.constants c in
   constants.michelson_maximum_type_size
+
 let seed_nonce_revelation_tip c =
   let constants = Raw_context.constants c in
   constants.seed_nonce_revelation_tip
+
 let origination_size c =
   let constants = Raw_context.constants c in
   constants.origination_size
+
 let block_security_deposit c =
   let constants = Raw_context.constants c in
   constants.block_security_deposit
+
 let endorsement_security_deposit c =
   let constants = Raw_context.constants c in
   constants.endorsement_security_deposit
-let block_reward c =
+
+let baking_reward_per_endorsement c =
   let constants = Raw_context.constants c in
-  constants.block_reward
+  constants.baking_reward_per_endorsement
+
 let endorsement_reward c =
   let constants = Raw_context.constants c in
   constants.endorsement_reward
+
 let test_chain_duration c =
   let constants = Raw_context.constants c in
   constants.test_chain_duration
+
 let quorum_min c =
   let constants = Raw_context.constants c in
   constants.quorum_min
+
 let quorum_max c =
   let constants = Raw_context.constants c in
   constants.quorum_max
+
 let min_proposal_quorum c =
   let constants = Raw_context.constants c in
   constants.min_proposal_quorum
-let parametric c =
-  Raw_context.constants c
+
+let parametric c = Raw_context.constants c

vendors/ligo-utils/tezos-protocol-alpha/contract_hash.ml

@@ -26,12 +26,16 @@
 (* 20 *)
 let contract_hash = "\002\090\121" (* KT1(36) *)
 
-include Blake2B.Make(Base58)(struct
-    let name = "Contract_hash"
-    let title = "A contract ID"
-    let b58check_prefix = contract_hash
-    let size = Some 20
-  end)
+include Blake2B.Make
+          (Base58)
+          (struct
+            let name = "Contract_hash"
 
-let () =
-  Base58.check_encoded_prefix b58check_encoding "KT1" 36
+            let title = "A contract ID"
+
+            let b58check_prefix = contract_hash
+
+            let size = Some 20
+          end)
+
+let () = Base58.check_encoded_prefix b58check_encoding "KT1" 36

vendors/ligo-utils/tezos-protocol-alpha/contract_repr.ml

@@ -27,80 +27,98 @@ type t =
   | Implicit of Signature.Public_key_hash.t
   | Originated of Contract_hash.t
 
-include Compare.Make(struct
-    type nonrec t = t
-    let compare l1 l2 =
-      match l1, l2 with
-      | Implicit pkh1, Implicit pkh2 ->
-          Signature.Public_key_hash.compare pkh1 pkh2
-      | Originated h1, Originated h2 ->
-          Contract_hash.compare h1 h2
-      | Implicit _, Originated _ -> -1
-      | Originated _, Implicit _ -> 1
-  end)
+include Compare.Make (struct
+  type nonrec t = t
+
+  let compare l1 l2 =
+    match (l1, l2) with
+    | (Implicit pkh1, Implicit pkh2) ->
+        Signature.Public_key_hash.compare pkh1 pkh2
+    | (Originated h1, Originated h2) ->
+        Contract_hash.compare h1 h2
+    | (Implicit _, Originated _) ->
+        -1
+    | (Originated _, Implicit _) ->
+        1
+end)
 
 type contract = t
 
 type error += Invalid_contract_notation of string (* `Permanent *)
 
 let to_b58check = function
-  | Implicit pbk -> Signature.Public_key_hash.to_b58check pbk
-  | Originated h -> Contract_hash.to_b58check h
+  | Implicit pbk ->
+      Signature.Public_key_hash.to_b58check pbk
+  | Originated h ->
+      Contract_hash.to_b58check h
 
 let of_b58check s =
   match Base58.decode s with
-  | Some (Ed25519.Public_key_hash.Data h) -> ok (Implicit (Signature.Ed25519 h))
-  | Some (Secp256k1.Public_key_hash.Data h) -> ok (Implicit (Signature.Secp256k1 h))
-  | Some (P256.Public_key_hash.Data h) -> ok (Implicit (Signature.P256 h))
-  | Some (Contract_hash.Data h) -> ok (Originated h)
-  | _ -> error (Invalid_contract_notation s)
+  | Some (Ed25519.Public_key_hash.Data h) ->
+      ok (Implicit (Signature.Ed25519 h))
+  | Some (Secp256k1.Public_key_hash.Data h) ->
+      ok (Implicit (Signature.Secp256k1 h))
+  | Some (P256.Public_key_hash.Data h) ->
+      ok (Implicit (Signature.P256 h))
+  | Some (Contract_hash.Data h) ->
+      ok (Originated h)
+  | _ ->
+      error (Invalid_contract_notation s)
 
 let pp ppf = function
-  | Implicit pbk -> Signature.Public_key_hash.pp ppf pbk
-  | Originated h -> Contract_hash.pp ppf h
+  | Implicit pbk ->
+      Signature.Public_key_hash.pp ppf pbk
+  | Originated h ->
+      Contract_hash.pp ppf h
 
 let pp_short ppf = function
-  | Implicit pbk -> Signature.Public_key_hash.pp_short ppf pbk
-  | Originated h -> Contract_hash.pp_short ppf h
+  | Implicit pbk ->
+      Signature.Public_key_hash.pp_short ppf pbk
+  | Originated h ->
+      Contract_hash.pp_short ppf h
 
 let encoding =
   let open Data_encoding in
-  def "contract_id"
-    ~title:
-      "A contract handle"
+  def
+    "contract_id"
+    ~title:"A contract handle"
     ~description:
-      "A contract notation as given to an RPC or inside scripts. \
-       Can be a base58 implicit contract hash \
-       or a base58 originated contract hash." @@
-  splitted
-    ~binary:
-      (union ~tag_size:`Uint8 [
-          case (Tag 0)
-            ~title:"Implicit"
-            Signature.Public_key_hash.encoding
-            (function Implicit k -> Some k | _ -> None)
-            (fun k -> Implicit k) ;
-          case (Tag 1) (Fixed.add_padding Contract_hash.encoding 1)
-            ~title:"Originated"
-            (function Originated k -> Some k | _ -> None)
-            (fun k -> Originated k) ;
-        ])
-    ~json:
-      (conv
-         to_b58check
-         (fun s ->
-            match of_b58check s with
-            | Ok s -> s
-            | Error _ -> Json.cannot_destruct "Invalid contract notation.")
-         string)
+      "A contract notation as given to an RPC or inside scripts. Can be a \
+       base58 implicit contract hash or a base58 originated contract hash."
+  @@ splitted
+       ~binary:
+         (union
+            ~tag_size:`Uint8
+            [ case
+                (Tag 0)
+                ~title:"Implicit"
+                Signature.Public_key_hash.encoding
+                (function Implicit k -> Some k | _ -> None)
+                (fun k -> Implicit k);
+              case
+                (Tag 1)
+                (Fixed.add_padding Contract_hash.encoding 1)
+                ~title:"Originated"
+                (function Originated k -> Some k | _ -> None)
+                (fun k -> Originated k) ])
+       ~json:
+         (conv
+            to_b58check
+            (fun s ->
+              match of_b58check s with
+              | Ok s ->
+                  s
+              | Error _ ->
+                  Json.cannot_destruct "Invalid contract notation.")
+            string)
 
 let () =
   let open Data_encoding in
   register_error_kind
     `Permanent
     ~id:"contract.invalid_contract_notation"
-    ~title: "Invalid contract notation"
-    ~pp: (fun ppf x -> Format.fprintf ppf "Invalid contract notation %S" x)
+    ~title:"Invalid contract notation"
+    ~pp:(fun ppf x -> Format.fprintf ppf "Invalid contract notation %S" x)
     ~description:
       "A malformed contract notation was given to an RPC or in a script."
     (obj1 (req "notation" string))
@@ -109,106 +127,104 @@ let () =
 
 let implicit_contract id = Implicit id
 
-let originated_contract_004 id = Originated id
+let is_implicit = function Implicit m -> Some m | Originated _ -> None
 
-let is_implicit = function
-  | Implicit m -> Some m
-  | Originated _ -> None
+let is_originated = function Implicit _ -> None | Originated h -> Some h
 
-let is_originated = function
-  | Implicit _ -> None
-  | Originated h -> Some h
-
-type origination_nonce =
-  { operation_hash: Operation_hash.t ;
-    origination_index: int32 }
+type origination_nonce = {
+  operation_hash : Operation_hash.t;
+  origination_index : int32;
+}
 
 let origination_nonce_encoding =
   let open Data_encoding in
   conv
-    (fun { operation_hash ; origination_index } ->
-       (operation_hash, origination_index))
+    (fun {operation_hash; origination_index} ->
+      (operation_hash, origination_index))
     (fun (operation_hash, origination_index) ->
-       { operation_hash ; origination_index }) @@
-  obj2
-    (req "operation" Operation_hash.encoding)
-    (dft "index" int32 0l)
+      {operation_hash; origination_index})
+  @@ obj2 (req "operation" Operation_hash.encoding) (dft "index" int32 0l)
 
 let originated_contract nonce =
   let data =
-    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce in
+    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce
+  in
   Originated (Contract_hash.hash_bytes [data])
 
 let originated_contracts
-    ~since: { origination_index = first ; operation_hash = first_hash }
-    ~until: ({ origination_index = last ; operation_hash = last_hash } as origination_nonce) =
+    ~since:{origination_index = first; operation_hash = first_hash}
+    ~until:( {origination_index = last; operation_hash = last_hash} as
+           origination_nonce ) =
   assert (Operation_hash.equal first_hash last_hash) ;
   let rec contracts acc origination_index =
-    if Compare.Int32.(origination_index < first) then
-      acc
+    if Compare.Int32.(origination_index < first) then acc
     else
-      let origination_nonce =
-        { origination_nonce with origination_index } in
+      let origination_nonce = {origination_nonce with origination_index} in
       let acc = originated_contract origination_nonce :: acc in
-      contracts acc (Int32.pred origination_index) in
+      contracts acc (Int32.pred origination_index)
+  in
   contracts [] (Int32.pred last)
 
 let initial_origination_nonce operation_hash =
-  { operation_hash ; origination_index = 0l }
+  {operation_hash; origination_index = 0l}
 
 let incr_origination_nonce nonce =
   let origination_index = Int32.succ nonce.origination_index in
-  { nonce with origination_index }
+  {nonce with origination_index}
 
 let rpc_arg =
   let construct = to_b58check in
   let destruct hash =
     match of_b58check hash with
-    | Error _ -> Error "Cannot parse contract id"
-    | Ok contract -> Ok contract in
+    | Error _ ->
+        Error "Cannot parse contract id"
+    | Ok contract ->
+        Ok contract
+  in
   RPC_arg.make
-    ~descr: "A contract identifier encoded in b58check."
-    ~name: "contract_id"
+    ~descr:"A contract identifier encoded in b58check."
+    ~name:"contract_id"
     ~construct
     ~destruct
     ()
 
 module Index = struct
-
   type t = contract
 
   let path_length = 7
 
   let to_path c l =
     let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in
-    let `Hex key = MBytes.to_hex raw_key in
-    let `Hex index_key = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
-    String.sub index_key 0 2 ::
-    String.sub index_key 2 2 ::
-    String.sub index_key 4 2 ::
-    String.sub index_key 6 2 ::
-    String.sub index_key 8 2 ::
-    String.sub index_key 10 2 ::
-    key ::
-    l
+    let (`Hex key) = MBytes.to_hex raw_key in
+    let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
+    String.sub index_key 0 2 :: String.sub index_key 2 2
+    :: String.sub index_key 4 2 :: String.sub index_key 6 2
+    :: String.sub index_key 8 2 :: String.sub index_key 10 2 :: key :: l
 
   let of_path = function
-    | [] | [_] | [_;_] | [_;_;_] | [_;_;_;_] | [_;_;_;_;_] | [_;_;_;_;_;_]
-    | _::_::_::_::_::_::_::_::_ ->
+    | []
+    | [_]
+    | [_; _]
+    | [_; _; _]
+    | [_; _; _; _]
+    | [_; _; _; _; _]
+    | [_; _; _; _; _; _]
+    | _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ :: _ ->
         None
-    | [ index1 ; index2 ; index3 ; index4 ; index5 ; index6 ; key ] ->
+    | [index1; index2; index3; index4; index5; index6; key] ->
         let raw_key = MBytes.of_hex (`Hex key) in
-        let `Hex index_key = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
-        assert Compare.String.(String.sub index_key 0 2 = index1) ;
-        assert Compare.String.(String.sub index_key 2 2 = index2) ;
-        assert Compare.String.(String.sub index_key 4 2 = index3) ;
-        assert Compare.String.(String.sub index_key 6 2 = index4) ;
-        assert Compare.String.(String.sub index_key 8 2 = index5) ;
-        assert Compare.String.(String.sub index_key 10 2 = index6) ;
+        let (`Hex index_key) = MBytes.to_hex (Raw_hashes.blake2b raw_key) in
+        assert (Compare.String.(String.sub index_key 0 2 = index1)) ;
+        assert (Compare.String.(String.sub index_key 2 2 = index2)) ;
+        assert (Compare.String.(String.sub index_key 4 2 = index3)) ;
+        assert (Compare.String.(String.sub index_key 6 2 = index4)) ;
+        assert (Compare.String.(String.sub index_key 8 2 = index5)) ;
+        assert (Compare.String.(String.sub index_key 10 2 = index6)) ;
         Data_encoding.Binary.of_bytes encoding raw_key
 
   let rpc_arg = rpc_arg
-  let encoding = encoding
-  let compare = compare
 
+  let encoding = encoding
+
+  let compare = compare
 end

vendors/ligo-utils/tezos-protocol-alpha/contract_repr.mli

@@ -26,6 +26,7 @@
 type t = private
   | Implicit of Signature.Public_key_hash.t
   | Originated of Contract_hash.t
+
 type contract = t
 
 include Compare.S with type t := contract
@@ -34,9 +35,6 @@ include Compare.S with type t := contract
 
 val implicit_contract : Signature.Public_key_hash.t -> contract
 
-(** Only for migration from proto_004  *)
-val originated_contract_004 : Contract_hash.t -> contract
-
 val is_implicit : contract -> Signature.Public_key_hash.t option
 
 (** {2 Originated contracts} *)
@@ -50,7 +48,8 @@ type origination_nonce
 
 val originated_contract : origination_nonce -> contract
 
-val originated_contracts : since: origination_nonce -> until: origination_nonce -> contract list
+val originated_contracts :
+  since:origination_nonce -> until:origination_nonce -> contract list
 
 val initial_origination_nonce : Operation_hash.t -> origination_nonce
 
@@ -58,18 +57,17 @@ val incr_origination_nonce : origination_nonce -> origination_nonce
 
 val is_originated : contract -> Contract_hash.t option
 
-
 (** {2 Human readable notation} *)
 
 type error += Invalid_contract_notation of string (* `Permanent *)
 
-val to_b58check: contract -> string
+val to_b58check : contract -> string
 
-val of_b58check: string -> contract tzresult
+val of_b58check : string -> contract tzresult
 
-val pp: Format.formatter -> contract -> unit
+val pp : Format.formatter -> contract -> unit
 
-val pp_short: Format.formatter -> contract -> unit
+val pp_short : Format.formatter -> contract -> unit
 
 (** {2 Serializers} *)
 

vendors/ligo-utils/tezos-protocol-alpha/contract_services.ml

@@ -26,282 +26,349 @@
 open Alpha_context
 
 let custom_root =
-  (RPC_path.(open_root / "context" / "contracts") : RPC_context.t RPC_path.context)
+  ( RPC_path.(open_root / "context" / "contracts")
+    : RPC_context.t RPC_path.context )
 
 let big_map_root =
-  (RPC_path.(open_root / "context" / "big_maps") : RPC_context.t RPC_path.context)
+  ( RPC_path.(open_root / "context" / "big_maps")
+    : RPC_context.t RPC_path.context )
 
 type info = {
-  balance: Tez.t ;
-  delegate: public_key_hash option ;
-  counter: counter option ;
-  script: Script.t option ;
+  balance : Tez.t;
+  delegate : public_key_hash option;
+  counter : counter option;
+  script : Script.t option;
 }
 
 let info_encoding =
   let open Data_encoding in
   conv
-    (fun {balance ; delegate ; script ; counter } ->
+    (fun {balance; delegate; script; counter} ->
       (balance, delegate, script, counter))
     (fun (balance, delegate, script, counter) ->
-      {balance ; delegate ; script ; counter}) @@
-  obj4
-    (req "balance" Tez.encoding)
-    (opt "delegate" Signature.Public_key_hash.encoding)
-    (opt "script" Script.encoding)
-    (opt "counter" n)
+      {balance; delegate; script; counter})
+  @@ obj4
+       (req "balance" Tez.encoding)
+       (opt "delegate" Signature.Public_key_hash.encoding)
+       (opt "script" Script.encoding)
+       (opt "counter" n)
 
 module S = struct
-
   open Data_encoding
 
   let balance =
     RPC_service.get_service
-      ~description: "Access the balance of a contract."
-      ~query: RPC_query.empty
-      ~output: Tez.encoding
+      ~description:"Access the balance of a contract."
+      ~query:RPC_query.empty
+      ~output:Tez.encoding
       RPC_path.(custom_root /: Contract.rpc_arg / "balance")
 
   let manager_key =
     RPC_service.get_service
-      ~description: "Access the manager of a contract."
-      ~query: RPC_query.empty
-      ~output: (option Signature.Public_key.encoding)
+      ~description:"Access the manager of a contract."
+      ~query:RPC_query.empty
+      ~output:(option Signature.Public_key.encoding)
       RPC_path.(custom_root /: Contract.rpc_arg / "manager_key")
 
   let delegate =
     RPC_service.get_service
-      ~description: "Access the delegate of a contract, if any."
-      ~query: RPC_query.empty
-      ~output: Signature.Public_key_hash.encoding
+      ~description:"Access the delegate of a contract, if any."
+      ~query:RPC_query.empty
+      ~output:Signature.Public_key_hash.encoding
       RPC_path.(custom_root /: Contract.rpc_arg / "delegate")
 
   let counter =
     RPC_service.get_service
-      ~description: "Access the counter of a contract, if any."
-      ~query: RPC_query.empty
-      ~output: z
+      ~description:"Access the counter of a contract, if any."
+      ~query:RPC_query.empty
+      ~output:z
       RPC_path.(custom_root /: Contract.rpc_arg / "counter")
 
   let script =
     RPC_service.get_service
-      ~description: "Access the code and data of the contract."
-      ~query: RPC_query.empty
-      ~output: Script.encoding
+      ~description:"Access the code and data of the contract."
+      ~query:RPC_query.empty
+      ~output:Script.encoding
       RPC_path.(custom_root /: Contract.rpc_arg / "script")
 
   let storage =
     RPC_service.get_service
-      ~description: "Access the data of the contract."
-      ~query: RPC_query.empty
-      ~output: Script.expr_encoding
+      ~description:"Access the data of the contract."
+      ~query:RPC_query.empty
+      ~output:Script.expr_encoding
       RPC_path.(custom_root /: Contract.rpc_arg / "storage")
 
   let entrypoint_type =
     RPC_service.get_service
-      ~description: "Return the type of the given entrypoint of the contract"
-      ~query: RPC_query.empty
-      ~output: Script.expr_encoding
-      RPC_path.(custom_root /: Contract.rpc_arg / "entrypoints" /: RPC_arg.string)
-
+      ~description:"Return the type of the given entrypoint of the contract"
+      ~query:RPC_query.empty
+      ~output:Script.expr_encoding
+      RPC_path.(
+        custom_root /: Contract.rpc_arg / "entrypoints" /: RPC_arg.string)
 
   let list_entrypoints =
     RPC_service.get_service
-      ~description: "Return the list of entrypoints of the contract"
-      ~query: RPC_query.empty
-      ~output: (obj2
-                  (dft "unreachable"
-                     (Data_encoding.list
-                        (obj1 (req "path" (Data_encoding.list Michelson_v1_primitives.prim_encoding))))
-                     [])
-                  (req "entrypoints"
-                     (assoc Script.expr_encoding)))
+      ~description:"Return the list of entrypoints of the contract"
+      ~query:RPC_query.empty
+      ~output:
+        (obj2
+           (dft
+              "unreachable"
+              (Data_encoding.list
+                 (obj1
+                    (req
+                       "path"
+                       (Data_encoding.list
+                          Michelson_v1_primitives.prim_encoding))))
+              [])
+           (req "entrypoints" (assoc Script.expr_encoding)))
       RPC_path.(custom_root /: Contract.rpc_arg / "entrypoints")
 
   let contract_big_map_get_opt =
-     RPC_service.post_service
-       ~description: "Access the value associated with a key in a big map of the contract (deprecated)."
-       ~query: RPC_query.empty
-       ~input: (obj2
-                  (req "key" Script.expr_encoding)
-                  (req "type" Script.expr_encoding))
-       ~output: (option Script.expr_encoding)
-       RPC_path.(custom_root /: Contract.rpc_arg / "big_map_get")
+    RPC_service.post_service
+      ~description:
+        "Access the value associated with a key in a big map of the contract \
+         (deprecated)."
+      ~query:RPC_query.empty
+      ~input:
+        (obj2
+           (req "key" Script.expr_encoding)
+           (req "type" Script.expr_encoding))
+      ~output:(option Script.expr_encoding)
+      RPC_path.(custom_root /: Contract.rpc_arg / "big_map_get")
 
   let big_map_get =
     RPC_service.get_service
-      ~description: "Access the value associated with a key in a big map."
-      ~query: RPC_query.empty
-      ~output: Script.expr_encoding
+      ~description:"Access the value associated with a key in a big map."
+      ~query:RPC_query.empty
+      ~output:Script.expr_encoding
       RPC_path.(big_map_root /: Big_map.rpc_arg /: Script_expr_hash.rpc_arg)
 
   let info =
     RPC_service.get_service
-      ~description: "Access the complete status of a contract."
-      ~query: RPC_query.empty
-      ~output: info_encoding
+      ~description:"Access the complete status of a contract."
+      ~query:RPC_query.empty
+      ~output:info_encoding
       RPC_path.(custom_root /: Contract.rpc_arg)
 
   let list =
     RPC_service.get_service
       ~description:
         "All existing contracts (including non-empty default contracts)."
-      ~query: RPC_query.empty
-      ~output: (list Contract.encoding)
+      ~query:RPC_query.empty
+      ~output:(list Contract.encoding)
       custom_root
-
 end
 
 let register () =
   let open Services_registration in
-  register0 S.list begin fun ctxt () () ->
-    Contract.list ctxt >>= return
-  end ;
+  register0 S.list (fun ctxt () () -> Contract.list ctxt >>= return) ;
   let register_field s f =
     register1 s (fun ctxt contract () () ->
-        Contract.exists ctxt contract >>=? function
-        | true -> f ctxt contract
-        | false -> raise Not_found) in
+        Contract.exists ctxt contract
+        >>=? function true -> f ctxt contract | false -> raise Not_found)
+  in
   let register_opt_field s f =
-    register_field s
-      (fun ctxt a1 ->
-         f ctxt a1 >>=? function
-         | None -> raise Not_found
-         | Some v -> return v) in
+    register_field s (fun ctxt a1 ->
+        f ctxt a1 >>=? function None -> raise Not_found | Some v -> return v)
+  in
   let do_big_map_get ctxt id key =
     let open Script_ir_translator in
     let ctxt = Gas.set_unlimited ctxt in
-    Big_map.exists ctxt id >>=? fun (ctxt, types) ->
+    Big_map.exists ctxt id
+    >>=? fun (ctxt, types) ->
     match types with
-    | None -> raise Not_found
-    | Some (_, value_type) ->
-        Lwt.return (parse_ty ctxt
-                      ~legacy:true ~allow_big_map:false ~allow_operation:false ~allow_contract:true
-                      (Micheline.root value_type))
+    | None ->
+        raise Not_found
+    | Some (_, value_type) -> (
+        Lwt.return
+          (parse_ty
+             ctxt
+             ~legacy:true
+             ~allow_big_map:false
+             ~allow_operation:false
+             ~allow_contract:true
+             (Micheline.root value_type))
         >>=? fun (Ex_ty value_type, ctxt) ->
-        Big_map.get_opt ctxt id key >>=? fun (_ctxt, value) ->
+        Big_map.get_opt ctxt id key
+        >>=? fun (_ctxt, value) ->
         match value with
-        | None -> raise Not_found
+        | None ->
+            raise Not_found
         | Some value ->
-            parse_data ctxt ~legacy:true value_type (Micheline.root value) >>=? fun (value, ctxt) ->
-            unparse_data ctxt Readable value_type value >>=? fun (value, _ctxt) ->
-            return (Micheline.strip_locations value) in
+            parse_data ctxt ~legacy:true value_type (Micheline.root value)
+            >>=? fun (value, ctxt) ->
+            unparse_data ctxt Readable value_type value
+            >>=? fun (value, _ctxt) -> return (Micheline.strip_locations value)
+        )
+  in
   register_field S.balance Contract.get_balance ;
-  register1 S.manager_key
-    (fun ctxt contract () () ->
-       match Contract.is_implicit contract with
-       | None -> raise Not_found
-       | Some mgr ->
-           Contract.is_manager_key_revealed ctxt mgr >>=? function
-           | false -> return_none
-           | true -> Contract.get_manager_key ctxt mgr >>=? return_some) ;
+  register1 S.manager_key (fun ctxt contract () () ->
+      match Contract.is_implicit contract with
+      | None ->
+          raise Not_found
+      | Some mgr -> (
+          Contract.is_manager_key_revealed ctxt mgr
+          >>=? function
+          | false ->
+              return_none
+          | true ->
+              Contract.get_manager_key ctxt mgr >>=? return_some )) ;
   register_opt_field S.delegate Delegate.get ;
-  register1 S.counter
-    (fun ctxt contract () () ->
-       match Contract.is_implicit contract with
-       | None -> raise Not_found
-       | Some mgr -> Contract.get_counter ctxt mgr) ;
-  register_opt_field S.script
-    (fun c v -> Contract.get_script c v >>=? fun (_, v) -> return v) ;
+  register1 S.counter (fun ctxt contract () () ->
+      match Contract.is_implicit contract with
+      | None ->
+          raise Not_found
+      | Some mgr ->
+          Contract.get_counter ctxt mgr) ;
+  register_opt_field S.script (fun c v ->
+      Contract.get_script c v >>=? fun (_, v) -> return v) ;
   register_opt_field S.storage (fun ctxt contract ->
-      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
+      Contract.get_script ctxt contract
+      >>=? fun (ctxt, script) ->
       match script with
-      | None -> return_none
+      | None ->
+          return_none
       | Some script ->
           let ctxt = Gas.set_unlimited ctxt in
           let open Script_ir_translator in
-          parse_script ctxt ~legacy:true script >>=? fun (Ex_script script, ctxt) ->
-          unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
-          Script.force_decode ctxt script.storage >>=? fun (storage, _ctxt) ->
-          return_some storage) ;
-  register2 S.entrypoint_type
-    (fun ctxt v entrypoint () () -> Contract.get_script_code ctxt v >>=? fun (_, expr) ->
+          parse_script ctxt ~legacy:true script
+          >>=? fun (Ex_script script, ctxt) ->
+          unparse_script ctxt Readable script
+          >>=? fun (script, ctxt) ->
+          Script.force_decode ctxt script.storage
+          >>=? fun (storage, _ctxt) -> return_some storage) ;
+  register2 S.entrypoint_type (fun ctxt v entrypoint () () ->
+      Contract.get_script_code ctxt v
+      >>=? fun (_, expr) ->
       match expr with
-      | None -> raise Not_found
-      | Some expr ->
+      | None ->
+          raise Not_found
+      | Some expr -> (
           let ctxt = Gas.set_unlimited ctxt in
           let legacy = true in
           let open Script_ir_translator in
-          Script.force_decode ctxt expr >>=? fun (expr, _) ->
+          Script.force_decode ctxt expr
+          >>=? fun (expr, _) ->
           Lwt.return
-            begin
-              parse_toplevel ~legacy expr >>? fun (arg_type, _, _, root_name) ->
-              parse_ty ctxt ~legacy
-                ~allow_big_map:true ~allow_operation:false
-                ~allow_contract:true arg_type >>? fun (Ex_ty arg_type, _) ->
-              Script_ir_translator.find_entrypoint ~root_name arg_type
-                entrypoint
-            end >>= function
-            Ok (_f , Ex_ty ty)->
-              unparse_ty ctxt ty >>=? fun (ty_node, _) ->
+            ( parse_toplevel ~legacy expr
+            >>? fun (arg_type, _, _, root_name) ->
+            parse_ty
+              ctxt
+              ~legacy
+              ~allow_big_map:true
+              ~allow_operation:false
+              ~allow_contract:true
+              arg_type
+            >>? fun (Ex_ty arg_type, _) ->
+            Script_ir_translator.find_entrypoint ~root_name arg_type entrypoint
+            )
+          >>= function
+          | Ok (_f, Ex_ty ty) ->
+              unparse_ty ctxt ty
+              >>=? fun (ty_node, _) ->
               return (Micheline.strip_locations ty_node)
-          | Error _ -> raise Not_found) ;
-  register1 S.list_entrypoints
-    (fun ctxt v () () -> Contract.get_script_code ctxt v >>=? fun (_, expr) ->
+          | Error _ ->
+              raise Not_found )) ;
+  register1 S.list_entrypoints (fun ctxt v () () ->
+      Contract.get_script_code ctxt v
+      >>=? fun (_, expr) ->
       match expr with
-      | None -> raise Not_found
+      | None ->
+          raise Not_found
       | Some expr ->
           let ctxt = Gas.set_unlimited ctxt in
           let legacy = true in
           let open Script_ir_translator in
-          Script.force_decode ctxt expr >>=? fun (expr, _) ->
+          Script.force_decode ctxt expr
+          >>=? fun (expr, _) ->
           Lwt.return
-            begin
-              parse_toplevel ~legacy expr >>? fun (arg_type, _, _, root_name) ->
-              parse_ty ctxt ~legacy
-                ~allow_big_map:true ~allow_operation:false
-                ~allow_contract:true arg_type >>? fun (Ex_ty arg_type, _) ->
-              Script_ir_translator.list_entrypoints ~root_name arg_type ctxt
-            end >>=? fun (unreachable_entrypoint,map) ->
+            ( parse_toplevel ~legacy expr
+            >>? fun (arg_type, _, _, root_name) ->
+            parse_ty
+              ctxt
+              ~legacy
+              ~allow_big_map:true
+              ~allow_operation:false
+              ~allow_contract:true
+              arg_type
+            >>? fun (Ex_ty arg_type, _) ->
+            Script_ir_translator.list_entrypoints ~root_name arg_type ctxt )
+          >>=? fun (unreachable_entrypoint, map) ->
           return
-            (unreachable_entrypoint,
-             Entrypoints_map.fold
-               begin fun entry (_,ty) acc ->
-                 (entry , Micheline.strip_locations ty) ::acc end
-               map [])
-    ) ;
+            ( unreachable_entrypoint,
+              Entrypoints_map.fold
+                (fun entry (_, ty) acc ->
+                  (entry, Micheline.strip_locations ty) :: acc)
+                map
+                [] )) ;
   register1 S.contract_big_map_get_opt (fun ctxt contract () (key, key_type) ->
-      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
-      Lwt.return (Script_ir_translator.parse_packable_ty ctxt ~legacy:true (Micheline.root key_type)) >>=? fun (Ex_ty key_type, ctxt) ->
-      Script_ir_translator.parse_data ctxt ~legacy:true key_type (Micheline.root key) >>=? fun (key, ctxt) ->
-      Script_ir_translator.hash_data ctxt key_type key >>=? fun (key, ctxt) ->
+      Contract.get_script ctxt contract
+      >>=? fun (ctxt, script) ->
+      Lwt.return
+        (Script_ir_translator.parse_packable_ty
+           ctxt
+           ~legacy:true
+           (Micheline.root key_type))
+      >>=? fun (Ex_ty key_type, ctxt) ->
+      Script_ir_translator.parse_data
+        ctxt
+        ~legacy:true
+        key_type
+        (Micheline.root key)
+      >>=? fun (key, ctxt) ->
+      Script_ir_translator.hash_data ctxt key_type key
+      >>=? fun (key, ctxt) ->
       match script with
-      | None -> raise Not_found
+      | None ->
+          raise Not_found
       | Some script ->
           let ctxt = Gas.set_unlimited ctxt in
           let open Script_ir_translator in
-          parse_script ctxt ~legacy:true script >>=? fun (Ex_script script, ctxt) ->
-          Script_ir_translator.collect_big_maps ctxt script.storage_type script.storage >>=? fun (ids, _ctxt) ->
+          parse_script ctxt ~legacy:true script
+          >>=? fun (Ex_script script, ctxt) ->
+          Script_ir_translator.collect_big_maps
+            ctxt
+            script.storage_type
+            script.storage
+          >>=? fun (ids, _ctxt) ->
           let ids = Script_ir_translator.list_of_big_map_ids ids in
           let rec find = function
-            | [] -> return_none
-            | (id : Z.t) :: ids -> try do_big_map_get ctxt id key >>=? return_some with Not_found -> find ids in
+            | [] ->
+                return_none
+            | (id : Z.t) :: ids -> (
+              try do_big_map_get ctxt id key >>=? return_some
+              with Not_found -> find ids )
+          in
           find ids) ;
-  register2 S.big_map_get (fun ctxt id key () () ->
-      do_big_map_get ctxt id key) ;
+  register2 S.big_map_get (fun ctxt id key () () -> do_big_map_get ctxt id key) ;
   register_field S.info (fun ctxt contract ->
-      Contract.get_balance ctxt contract >>=? fun balance ->
-      Delegate.get ctxt contract >>=? fun delegate ->
-      begin match Contract.is_implicit contract with
-        | Some manager ->
-            Contract.get_counter ctxt manager >>=? fun counter ->
-            return_some counter
-        | None -> return None
-      end >>=? fun counter ->
-      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->
-      begin match script with
-        | None -> return (None, ctxt)
-        | Some script ->
-            let ctxt = Gas.set_unlimited ctxt in
-            let open Script_ir_translator in
-            parse_script ctxt ~legacy:true script >>=? fun (Ex_script script, ctxt) ->
-            unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
-            return (Some script, ctxt)
-      end >>=? fun (script, _ctxt) ->
-      return { balance ; delegate ; script ; counter })
+      Contract.get_balance ctxt contract
+      >>=? fun balance ->
+      Delegate.get ctxt contract
+      >>=? fun delegate ->
+      ( match Contract.is_implicit contract with
+      | Some manager ->
+          Contract.get_counter ctxt manager
+          >>=? fun counter -> return_some counter
+      | None ->
+          return None )
+      >>=? fun counter ->
+      Contract.get_script ctxt contract
+      >>=? fun (ctxt, script) ->
+      ( match script with
+      | None ->
+          return (None, ctxt)
+      | Some script ->
+          let ctxt = Gas.set_unlimited ctxt in
+          let open Script_ir_translator in
+          parse_script ctxt ~legacy:true script
+          >>=? fun (Ex_script script, ctxt) ->
+          unparse_script ctxt Readable script
+          >>=? fun (script, ctxt) -> return (Some script, ctxt) )
+      >>=? fun (script, _ctxt) -> return {balance; delegate; script; counter})
 
-let list ctxt block =
-  RPC_context.make_call0 S.list ctxt block () ()
+let list ctxt block = RPC_context.make_call0 S.list ctxt block () ()
 
 let info ctxt block contract =
   RPC_context.make_call1 S.info ctxt block contract () ()
@@ -310,7 +377,13 @@ let balance ctxt block contract =
   RPC_context.make_call1 S.balance ctxt block contract () ()
 
 let manager_key ctxt block mgr =
-  RPC_context.make_call1 S.manager_key ctxt block (Contract.implicit_contract mgr) () ()
+  RPC_context.make_call1
+    S.manager_key
+    ctxt
+    block
+    (Contract.implicit_contract mgr)
+    ()
+    ()
 
 let delegate ctxt block contract =
   RPC_context.make_call1 S.delegate ctxt block contract () ()
@@ -319,7 +392,13 @@ let delegate_opt ctxt block contract =
   RPC_context.make_opt_call1 S.delegate ctxt block contract () ()
 
 let counter ctxt block mgr =
-  RPC_context.make_call1 S.counter ctxt block (Contract.implicit_contract mgr) () ()
+  RPC_context.make_call1
+    S.counter
+    ctxt
+    block
+    (Contract.implicit_contract mgr)
+    ()
+    ()
 
 let script ctxt block contract =
   RPC_context.make_call1 S.script ctxt block contract () ()

vendors/ligo-utils/tezos-protocol-alpha/contract_services.mli

@@ -25,61 +25,95 @@
 
 open Alpha_context
 
-val list:
-  'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t
+val list : 'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t
 
 type info = {
-  balance: Tez.t ;
-  delegate: public_key_hash option ;
-  counter: counter option ;
-  script: Script.t option ;
+  balance : Tez.t;
+  delegate : public_key_hash option;
+  counter : counter option;
+  script : Script.t option;
 }
 
-val info_encoding: info Data_encoding.t
+val info_encoding : info Data_encoding.t
 
-val info:
+val info :
   'a #RPC_context.simple -> 'a -> Contract.t -> info shell_tzresult Lwt.t
 
-val balance:
+val balance :
   'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t
 
-val manager_key:
-  'a #RPC_context.simple -> 'a -> public_key_hash -> public_key option shell_tzresult Lwt.t
+val manager_key :
+  'a #RPC_context.simple ->
+  'a ->
+  public_key_hash ->
+  public_key option shell_tzresult Lwt.t
 
-val delegate:
-  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash shell_tzresult Lwt.t
+val delegate :
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  public_key_hash shell_tzresult Lwt.t
 
-val delegate_opt:
-  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash option shell_tzresult Lwt.t
+val delegate_opt :
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  public_key_hash option shell_tzresult Lwt.t
 
-val counter:
-  'a #RPC_context.simple -> 'a -> public_key_hash -> counter shell_tzresult Lwt.t
+val counter :
+  'a #RPC_context.simple ->
+  'a ->
+  public_key_hash ->
+  counter shell_tzresult Lwt.t
 
-val script:
+val script :
   'a #RPC_context.simple -> 'a -> Contract.t -> Script.t shell_tzresult Lwt.t
 
-val script_opt:
-  'a #RPC_context.simple -> 'a -> Contract.t -> Script.t option shell_tzresult Lwt.t
+val script_opt :
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  Script.t option shell_tzresult Lwt.t
 
-val storage:
-  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr shell_tzresult Lwt.t
-
-val entrypoint_type:
-  'a #RPC_context.simple -> 'a -> Contract.t -> string -> Script.expr shell_tzresult Lwt.t
-
-val list_entrypoints:
-  'a #RPC_context.simple -> 'a -> Contract.t ->
-  (Michelson_v1_primitives.prim list list *
-   (string * Script.expr) list) shell_tzresult Lwt.t
-
-val storage_opt:
-  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr option shell_tzresult Lwt.t
-
-val big_map_get:
-  'a #RPC_context.simple -> 'a -> Z.t -> Script_expr_hash.t ->
+val storage :
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
   Script.expr shell_tzresult Lwt.t
 
-val contract_big_map_get_opt:
-  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr * Script.expr -> Script.expr option shell_tzresult Lwt.t
+val entrypoint_type :
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  string ->
+  Script.expr shell_tzresult Lwt.t
 
-val register: unit -> unit
+val list_entrypoints :
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  (Michelson_v1_primitives.prim list list * (string * Script.expr) list)
+  shell_tzresult
+  Lwt.t
+
+val storage_opt :
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  Script.expr option shell_tzresult Lwt.t
+
+val big_map_get :
+  'a #RPC_context.simple ->
+  'a ->
+  Z.t ->
+  Script_expr_hash.t ->
+  Script.expr shell_tzresult Lwt.t
+
+val contract_big_map_get_opt :
+  'a #RPC_context.simple ->
+  'a ->
+  Contract.t ->
+  Script.expr * Script.expr ->
+  Script.expr option shell_tzresult Lwt.t
+
+val register : unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/contract_storage.mli

@@ -24,60 +24,89 @@
 (*****************************************************************************)
 
 type error +=
-  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)
-  | Counter_in_the_past of Contract_repr.contract * Z.t * Z.t (* `Branch *)
-  | Counter_in_the_future of Contract_repr.contract * Z.t * Z.t (* `Temporary *)
-  | Unspendable_contract of Contract_repr.contract (* `Permanent *)
-  | Non_existing_contract of Contract_repr.contract (* `Temporary *)
-  | Empty_implicit_contract of Signature.Public_key_hash.t (* `Temporary *)
-  | Empty_transaction of Contract_repr.t (* `Temporary *)
-  | Inconsistent_hash of Signature.Public_key.t * Signature.Public_key_hash.t * Signature.Public_key_hash.t (* `Permanent *)
-  | Inconsistent_public_key of Signature.Public_key.t * Signature.Public_key.t (* `Permanent *)
-  | Failure of string (* `Permanent *)
+  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t
+  | (* `Temporary *)
+      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t
+  | (* `Branch *)
+      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t
+  | (* `Temporary *)
+      Unspendable_contract of Contract_repr.contract
+  | (* `Permanent *)
+      Non_existing_contract of Contract_repr.contract
+  | (* `Temporary *)
+      Empty_implicit_contract of Signature.Public_key_hash.t
+  | (* `Temporary *)
+      Empty_implicit_delegated_contract of
+      Signature.Public_key_hash.t
+  | (* `Temporary *)
+      Empty_transaction of Contract_repr.t (* `Temporary *)
+  | Inconsistent_hash of
+      Signature.Public_key.t
+      * Signature.Public_key_hash.t
+      * Signature.Public_key_hash.t
+  | (* `Permanent *)
+      Inconsistent_public_key of
+      Signature.Public_key.t * Signature.Public_key.t
+  | (* `Permanent *)
+      Failure of string (* `Permanent *)
   | Previously_revealed_key of Contract_repr.t (* `Permanent *)
-  | Unrevealed_manager_key of Contract_repr.t (* `Permanent *)
+  | Unrevealed_manager_key of Contract_repr.t
 
-val exists: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
-val must_exist: Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
+(* `Permanent *)
 
-val allocated: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
-val must_be_allocated: Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
+val exists : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
 
+val must_exist : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
 
-val list: Raw_context.t -> Contract_repr.t list Lwt.t
+val allocated : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t
 
-val check_counter_increment:
+val must_be_allocated : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t
+
+val list : Raw_context.t -> Contract_repr.t list Lwt.t
+
+val check_counter_increment :
   Raw_context.t -> Signature.Public_key_hash.t -> Z.t -> unit tzresult Lwt.t
 
-val increment_counter:
+val increment_counter :
   Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t
 
-val get_manager_004:
-  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t tzresult Lwt.t
+val get_manager_key :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Signature.Public_key.t tzresult Lwt.t
 
-val get_manager_key:
-  Raw_context.t -> Signature.Public_key_hash.t -> Signature.Public_key.t tzresult Lwt.t
-val is_manager_key_revealed:
+val is_manager_key_revealed :
   Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
 
-val reveal_manager_key:
-  Raw_context.t -> Signature.Public_key_hash.t -> Signature.Public_key.t  ->
+val reveal_manager_key :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Signature.Public_key.t ->
   Raw_context.t tzresult Lwt.t
 
-val get_balance: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
-val get_counter: Raw_context.t -> Signature.Public_key_hash.t -> Z.t tzresult Lwt.t
+val get_balance : Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t
 
-val get_script_code:
-  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.lazy_expr option) tzresult Lwt.t
-val get_script:
-  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.t option) tzresult Lwt.t
-val get_storage:
-  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
+val get_counter :
+  Raw_context.t -> Signature.Public_key_hash.t -> Z.t tzresult Lwt.t
 
+val get_script_code :
+  Raw_context.t ->
+  Contract_repr.t ->
+  (Raw_context.t * Script_repr.lazy_expr option) tzresult Lwt.t
+
+val get_script :
+  Raw_context.t ->
+  Contract_repr.t ->
+  (Raw_context.t * Script_repr.t option) tzresult Lwt.t
+
+val get_storage :
+  Raw_context.t ->
+  Contract_repr.t ->
+  (Raw_context.t * Script_repr.expr option) tzresult Lwt.t
 
 type big_map_diff_item =
   | Update of {
-      big_map : Z.t ;
+      big_map : Z.t;
       diff_key : Script_repr.expr;
       diff_key_hash : Script_expr_hash.t;
       diff_value : Script_repr.expr option;
@@ -94,38 +123,50 @@ type big_map_diff = big_map_diff_item list
 
 val big_map_diff_encoding : big_map_diff Data_encoding.t
 
-val update_script_storage:
-  Raw_context.t -> Contract_repr.t ->
-  Script_repr.expr -> big_map_diff option ->
+val update_script_storage :
+  Raw_context.t ->
+  Contract_repr.t ->
+  Script_repr.expr ->
+  big_map_diff option ->
   Raw_context.t tzresult Lwt.t
 
-val credit:
-  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
+val credit :
+  Raw_context.t ->
+  Contract_repr.t ->
+  Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
-val spend:
-  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->
+val spend :
+  Raw_context.t ->
+  Contract_repr.t ->
+  Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
-val originate:
+val originate :
   Raw_context.t ->
   ?prepaid_bootstrap_storage:bool ->
   Contract_repr.t ->
   balance:Tez_repr.t ->
-  script:(Script_repr.t * big_map_diff option) ->
+  script:Script_repr.t * big_map_diff option ->
   delegate:Signature.Public_key_hash.t option ->
   Raw_context.t tzresult Lwt.t
 
 val fresh_contract_from_current_nonce :
   Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult Lwt.t
+
 val originated_from_current_nonce :
-  since: Raw_context.t ->
-  until: Raw_context.t ->
+  since:Raw_context.t ->
+  until:Raw_context.t ->
   Contract_repr.t list tzresult Lwt.t
 
-val init:
-  Raw_context.t -> Raw_context.t tzresult Lwt.t
+val init : Raw_context.t -> Raw_context.t tzresult Lwt.t
 
-val used_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
-val paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
-val set_paid_storage_space_and_return_fees_to_pay: Raw_context.t -> Contract_repr.t -> Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t
+val used_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
+
+val paid_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t
+
+val set_paid_storage_space_and_return_fees_to_pay :
+  Raw_context.t ->
+  Contract_repr.t ->
+  Z.t ->
+  (Z.t * Raw_context.t) tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/cycle_repr.ml

@@ -24,18 +24,23 @@
 (*****************************************************************************)
 
 type t = int32
+
 type cycle = t
 
 let encoding = Data_encoding.int32
+
 let rpc_arg =
   let construct = Int32.to_string in
   let destruct str =
     match Int32.of_string str with
-    | exception _ -> Error "Cannot parse cycle"
-    | cycle -> Ok cycle in
+    | exception _ ->
+        Error "Cannot parse cycle"
+    | cycle ->
+        Ok cycle
+  in
   RPC_arg.make
     ~descr:"A cycle integer"
-    ~name: "block_cycle"
+    ~name:"block_cycle"
     ~construct
     ~destruct
     ()
@@ -44,42 +49,45 @@ let pp ppf cycle = Format.fprintf ppf "%ld" cycle
 
 include (Compare.Int32 : Compare.S with type t := t)
 
-module Map = Map.Make(Compare.Int32)
+module Map = Map.Make (Compare.Int32)
 
 let root = 0l
+
 let succ = Int32.succ
-let pred = function
-  | 0l -> None
-  | i -> Some (Int32.pred i)
+
+let pred = function 0l -> None | i -> Some (Int32.pred i)
 
 let add c i =
-  assert Compare.Int.(i > 0) ;
+  assert (Compare.Int.(i > 0)) ;
   Int32.add c (Int32.of_int i)
 
 let sub c i =
-  assert Compare.Int.(i > 0) ;
+  assert (Compare.Int.(i > 0)) ;
   let r = Int32.sub c (Int32.of_int i) in
   if Compare.Int32.(r < 0l) then None else Some r
 
 let to_int32 i = i
 
 let of_int32_exn l =
-  if Compare.Int32.(l >= 0l)
-  then l
+  if Compare.Int32.(l >= 0l) then l
   else invalid_arg "Level_repr.Cycle.of_int32"
 
 module Index = struct
   type t = cycle
+
   let path_length = 1
-  let to_path c l =
-    Int32.to_string (to_int32 c) :: l
+
+  let to_path c l = Int32.to_string (to_int32 c) :: l
+
   let of_path = function
-    | [s] -> begin
-        try Some (Int32.of_string s)
-        with _ -> None
-      end
-    | _ -> None
+    | [s] -> (
+      try Some (Int32.of_string s) with _ -> None )
+    | _ ->
+        None
+
   let rpc_arg = rpc_arg
+
   let encoding = encoding
+
   let compare = compare
 end

vendors/ligo-utils/tezos-protocol-alpha/cycle_repr.mli

@@ -24,20 +24,30 @@
 (*****************************************************************************)
 
 type t
+
 type cycle = t
+
 include Compare.S with type t := t
-val encoding: cycle Data_encoding.t
-val rpc_arg: cycle RPC_arg.arg
-val pp: Format.formatter -> cycle -> unit
 
-val root: cycle
-val pred: cycle -> cycle option
-val add: cycle -> int -> cycle
-val sub: cycle -> int -> cycle option
-val succ: cycle -> cycle
+val encoding : cycle Data_encoding.t
 
-val to_int32: cycle -> int32
-val of_int32_exn: int32 -> cycle
+val rpc_arg : cycle RPC_arg.arg
+
+val pp : Format.formatter -> cycle -> unit
+
+val root : cycle
+
+val pred : cycle -> cycle option
+
+val add : cycle -> int -> cycle
+
+val sub : cycle -> int -> cycle option
+
+val succ : cycle -> cycle
+
+val to_int32 : cycle -> int32
+
+val of_int32_exn : int32 -> cycle
 
 module Map : S.MAP with type key = cycle
 

vendors/ligo-utils/tezos-protocol-alpha/delegate_services.ml

@@ -26,31 +26,53 @@
 open Alpha_context
 
 type info = {
-  balance: Tez.t ;
-  frozen_balance: Tez.t ;
-  frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;
-  staking_balance: Tez.t ;
-  delegated_contracts: Contract_repr.t list ;
-  delegated_balance: Tez.t ;
-  deactivated: bool ;
-  grace_period: Cycle.t ;
+  balance : Tez.t;
+  frozen_balance : Tez.t;
+  frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t;
+  staking_balance : Tez.t;
+  delegated_contracts : Contract_repr.t list;
+  delegated_balance : Tez.t;
+  deactivated : bool;
+  grace_period : Cycle.t;
 }
 
 let info_encoding =
   let open Data_encoding in
   conv
-    (fun { balance ; frozen_balance ; frozen_balance_by_cycle ;
-           staking_balance ; delegated_contracts ;  delegated_balance ;
-           deactivated ; grace_period } ->
-      (balance, frozen_balance, frozen_balance_by_cycle,
-       staking_balance, delegated_contracts, delegated_balance,
-       deactivated, grace_period))
-    (fun (balance, frozen_balance, frozen_balance_by_cycle,
-          staking_balance, delegated_contracts, delegated_balance,
-          deactivated, grace_period) ->
-      { balance ; frozen_balance ; frozen_balance_by_cycle ;
-        staking_balance ; delegated_contracts ;  delegated_balance ;
-        deactivated ; grace_period })
+    (fun { balance;
+           frozen_balance;
+           frozen_balance_by_cycle;
+           staking_balance;
+           delegated_contracts;
+           delegated_balance;
+           deactivated;
+           grace_period } ->
+      ( balance,
+        frozen_balance,
+        frozen_balance_by_cycle,
+        staking_balance,
+        delegated_contracts,
+        delegated_balance,
+        deactivated,
+        grace_period ))
+    (fun ( balance,
+           frozen_balance,
+           frozen_balance_by_cycle,
+           staking_balance,
+           delegated_contracts,
+           delegated_balance,
+           deactivated,
+           grace_period ) ->
+      {
+        balance;
+        frozen_balance;
+        frozen_balance_by_cycle;
+        staking_balance;
+        delegated_contracts;
+        delegated_balance;
+        deactivated;
+        grace_period;
+      })
     (obj8
        (req "balance" Tez.encoding)
        (req "frozen_balance" Tez.encoding)
@@ -62,188 +84,180 @@ let info_encoding =
        (req "grace_period" Cycle.encoding))
 
 module S = struct
-
   let path = RPC_path.(open_root / "context" / "delegates")
 
   open Data_encoding
 
-  type list_query = {
-    active: bool ;
-    inactive: bool ;
-  }
-  let list_query :list_query RPC_query.t =
+  type list_query = {active : bool; inactive : bool}
+
+  let list_query : list_query RPC_query.t =
     let open RPC_query in
-    query (fun active inactive -> { active ; inactive })
+    query (fun active inactive -> {active; inactive})
     |+ flag "active" (fun t -> t.active)
     |+ flag "inactive" (fun t -> t.inactive)
     |> seal
 
   let list_delegate =
     RPC_service.get_service
-      ~description:
-        "Lists all registered delegates."
-      ~query: list_query
-      ~output: (list Signature.Public_key_hash.encoding)
+      ~description:"Lists all registered delegates."
+      ~query:list_query
+      ~output:(list Signature.Public_key_hash.encoding)
       path
 
   let path = RPC_path.(path /: Signature.Public_key_hash.rpc_arg)
 
   let info =
     RPC_service.get_service
-      ~description:
-        "Everything about a delegate."
-      ~query: RPC_query.empty
-      ~output: info_encoding
+      ~description:"Everything about a delegate."
+      ~query:RPC_query.empty
+      ~output:info_encoding
       path
 
   let balance =
     RPC_service.get_service
       ~description:
-        "Returns the full balance of a given delegate, \
-         including the frozen balances."
-      ~query: RPC_query.empty
-      ~output: Tez.encoding
+        "Returns the full balance of a given delegate, including the frozen \
+         balances."
+      ~query:RPC_query.empty
+      ~output:Tez.encoding
       RPC_path.(path / "balance")
 
   let frozen_balance =
     RPC_service.get_service
       ~description:
-        "Returns the total frozen balances of a given delegate, \
-         this includes the frozen deposits, rewards and fees."
-      ~query: RPC_query.empty
-      ~output: Tez.encoding
+        "Returns the total frozen balances of a given delegate, this includes \
+         the frozen deposits, rewards and fees."
+      ~query:RPC_query.empty
+      ~output:Tez.encoding
       RPC_path.(path / "frozen_balance")
 
   let frozen_balance_by_cycle =
     RPC_service.get_service
       ~description:
-        "Returns the frozen balances of a given delegate, \
-         indexed by the cycle by which it will be unfrozen"
-      ~query: RPC_query.empty
-      ~output: Delegate.frozen_balance_by_cycle_encoding
+        "Returns the frozen balances of a given delegate, indexed by the \
+         cycle by which it will be unfrozen"
+      ~query:RPC_query.empty
+      ~output:Delegate.frozen_balance_by_cycle_encoding
       RPC_path.(path / "frozen_balance_by_cycle")
 
   let staking_balance =
     RPC_service.get_service
       ~description:
         "Returns the total amount of tokens delegated to a given delegate. \
-         This includes the balances of all the contracts that delegate \
-         to it, but also the balance of the delegate itself and its frozen \
-         fees and deposits. The rewards do not count in the delegated balance \
-         until they are unfrozen."
-      ~query: RPC_query.empty
-      ~output: Tez.encoding
+         This includes the balances of all the contracts that delegate to it, \
+         but also the balance of the delegate itself and its frozen fees and \
+         deposits. The rewards do not count in the delegated balance until \
+         they are unfrozen."
+      ~query:RPC_query.empty
+      ~output:Tez.encoding
       RPC_path.(path / "staking_balance")
 
   let delegated_contracts =
     RPC_service.get_service
       ~description:
         "Returns the list of contracts that delegate to a given delegate."
-      ~query: RPC_query.empty
-      ~output: (list Contract_repr.encoding)
+      ~query:RPC_query.empty
+      ~output:(list Contract_repr.encoding)
       RPC_path.(path / "delegated_contracts")
 
   let delegated_balance =
     RPC_service.get_service
       ~description:
-        "Returns the balances of all the contracts that delegate to a \
-         given delegate. This excludes the delegate's own balance and \
-         its frozen balances."
-      ~query: RPC_query.empty
-      ~output: Tez.encoding
+        "Returns the balances of all the contracts that delegate to a given \
+         delegate. This excludes the delegate's own balance and its frozen \
+         balances."
+      ~query:RPC_query.empty
+      ~output:Tez.encoding
       RPC_path.(path / "delegated_balance")
 
   let deactivated =
     RPC_service.get_service
       ~description:
         "Tells whether the delegate is currently tagged as deactivated or not."
-      ~query: RPC_query.empty
-      ~output: bool
+      ~query:RPC_query.empty
+      ~output:bool
       RPC_path.(path / "deactivated")
 
   let grace_period =
     RPC_service.get_service
       ~description:
         "Returns the cycle by the end of which the delegate might be \
-         deactivated if she fails to execute any delegate action. \
-         A deactivated delegate might be reactivated \
-         (without loosing any rolls) by simply re-registering as a delegate. \
-         For deactivated delegates, this value contains the cycle by which \
-         they were deactivated."
-      ~query: RPC_query.empty
-      ~output: Cycle.encoding
+         deactivated if she fails to execute any delegate action. A \
+         deactivated delegate might be reactivated (without loosing any \
+         rolls) by simply re-registering as a delegate. For deactivated \
+         delegates, this value contains the cycle by which they were \
+         deactivated."
+      ~query:RPC_query.empty
+      ~output:Cycle.encoding
       RPC_path.(path / "grace_period")
-
 end
 
 let register () =
   let open Services_registration in
-  register0 S.list_delegate begin fun ctxt q () ->
-    Delegate.list ctxt >>= fun delegates ->
-    if q.active && q.inactive then
-      return delegates
-    else if q.active then
-      filter_map_s
-        (fun pkh ->
-           Delegate.deactivated ctxt pkh >>=? function
-           | true -> return_none
-           | false -> return_some pkh)
-        delegates
-    else if q.inactive then
-      filter_map_s
-        (fun pkh ->
-           Delegate.deactivated ctxt pkh >>=? function
-           | false -> return_none
-           | true -> return_some pkh)
-        delegates
-    else
-      return_nil
-  end ;
-  register1 S.info begin fun ctxt pkh () () ->
-    Delegate.full_balance ctxt pkh >>=? fun balance ->
-    Delegate.frozen_balance ctxt pkh >>=? fun frozen_balance ->
-    Delegate.frozen_balance_by_cycle ctxt pkh >>= fun frozen_balance_by_cycle ->
-    Delegate.staking_balance ctxt pkh >>=? fun staking_balance ->
-    Delegate.delegated_contracts ctxt pkh >>= fun delegated_contracts ->
-    Delegate.delegated_balance ctxt pkh >>=? fun delegated_balance ->
-    Delegate.deactivated ctxt pkh >>=? fun deactivated ->
-    Delegate.grace_period ctxt pkh >>=? fun grace_period ->
-    return {
-      balance ; frozen_balance ; frozen_balance_by_cycle ;
-      staking_balance ; delegated_contracts ; delegated_balance ;
-      deactivated ; grace_period
-    }
-  end ;
-  register1 S.balance begin fun ctxt pkh () () ->
-    Delegate.full_balance ctxt pkh
-  end ;
-  register1 S.frozen_balance begin fun ctxt pkh () () ->
-    Delegate.frozen_balance ctxt pkh
-  end ;
-  register1 S.frozen_balance_by_cycle begin fun ctxt pkh () () ->
-    Delegate.frozen_balance_by_cycle ctxt pkh >>= return
-  end ;
-  register1 S.staking_balance begin fun ctxt pkh () () ->
-    Delegate.staking_balance ctxt pkh
-  end ;
-  register1 S.delegated_contracts begin fun ctxt pkh () () ->
-    Delegate.delegated_contracts ctxt pkh >>= return
-  end ;
-  register1 S.delegated_balance begin fun ctxt pkh () () ->
-    Delegate.delegated_balance ctxt pkh
-  end ;
-  register1 S.deactivated begin fun ctxt pkh () () ->
-    Delegate.deactivated ctxt pkh
-  end ;
-  register1 S.grace_period begin fun ctxt pkh () () ->
-    Delegate.grace_period ctxt pkh
-  end
+  register0 S.list_delegate (fun ctxt q () ->
+      Delegate.list ctxt
+      >>= fun delegates ->
+      if q.active && q.inactive then return delegates
+      else if q.active then
+        filter_map_s
+          (fun pkh ->
+            Delegate.deactivated ctxt pkh
+            >>=? function true -> return_none | false -> return_some pkh)
+          delegates
+      else if q.inactive then
+        filter_map_s
+          (fun pkh ->
+            Delegate.deactivated ctxt pkh
+            >>=? function false -> return_none | true -> return_some pkh)
+          delegates
+      else return_nil) ;
+  register1 S.info (fun ctxt pkh () () ->
+      Delegate.full_balance ctxt pkh
+      >>=? fun balance ->
+      Delegate.frozen_balance ctxt pkh
+      >>=? fun frozen_balance ->
+      Delegate.frozen_balance_by_cycle ctxt pkh
+      >>= fun frozen_balance_by_cycle ->
+      Delegate.staking_balance ctxt pkh
+      >>=? fun staking_balance ->
+      Delegate.delegated_contracts ctxt pkh
+      >>= fun delegated_contracts ->
+      Delegate.delegated_balance ctxt pkh
+      >>=? fun delegated_balance ->
+      Delegate.deactivated ctxt pkh
+      >>=? fun deactivated ->
+      Delegate.grace_period ctxt pkh
+      >>=? fun grace_period ->
+      return
+        {
+          balance;
+          frozen_balance;
+          frozen_balance_by_cycle;
+          staking_balance;
+          delegated_contracts;
+          delegated_balance;
+          deactivated;
+          grace_period;
+        }) ;
+  register1 S.balance (fun ctxt pkh () () -> Delegate.full_balance ctxt pkh) ;
+  register1 S.frozen_balance (fun ctxt pkh () () ->
+      Delegate.frozen_balance ctxt pkh) ;
+  register1 S.frozen_balance_by_cycle (fun ctxt pkh () () ->
+      Delegate.frozen_balance_by_cycle ctxt pkh >>= return) ;
+  register1 S.staking_balance (fun ctxt pkh () () ->
+      Delegate.staking_balance ctxt pkh) ;
+  register1 S.delegated_contracts (fun ctxt pkh () () ->
+      Delegate.delegated_contracts ctxt pkh >>= return) ;
+  register1 S.delegated_balance (fun ctxt pkh () () ->
+      Delegate.delegated_balance ctxt pkh) ;
+  register1 S.deactivated (fun ctxt pkh () () -> Delegate.deactivated ctxt pkh) ;
+  register1 S.grace_period (fun ctxt pkh () () ->
+      Delegate.grace_period ctxt pkh)
 
 let list ctxt block ?(active = true) ?(inactive = false) () =
-  RPC_context.make_call0 S.list_delegate ctxt block { active ; inactive } ()
+  RPC_context.make_call0 S.list_delegate ctxt block {active; inactive} ()
 
-let info ctxt block pkh =
-  RPC_context.make_call1 S.info ctxt block pkh () ()
+let info ctxt block pkh = RPC_context.make_call1 S.info ctxt block pkh () ()
 
 let balance ctxt block pkh =
   RPC_context.make_call1 S.balance ctxt block pkh () ()
@@ -270,44 +284,43 @@ let grace_period ctxt block pkh =
   RPC_context.make_call1 S.grace_period ctxt block pkh () ()
 
 let requested_levels ~default ctxt cycles levels =
-  match levels, cycles with
-  | [], [] ->
+  match (levels, cycles) with
+  | ([], []) ->
       return [default]
-  | levels, cycles ->
+  | (levels, cycles) ->
       (* explicitly fail when requested levels or cycle are in the past...
          or too far in the future... *)
       let levels =
         List.sort_uniq
           Level.compare
-          (List.concat (List.map (Level.from_raw ctxt) levels ::
-                        List.map (Level.levels_in_cycle ctxt) cycles)) in
+          (List.concat
+             ( List.map (Level.from_raw ctxt) levels
+             :: List.map (Level.levels_in_cycle ctxt) cycles ))
+      in
       map_s
         (fun level ->
-           let current_level = Level.current ctxt in
-           if Level.(level <= current_level) then
-             return (level, None)
-           else
-             Baking.earlier_predecessor_timestamp
-               ctxt level >>=? fun timestamp ->
-             return (level, Some timestamp))
+          let current_level = Level.current ctxt in
+          if Level.(level <= current_level) then return (level, None)
+          else
+            Baking.earlier_predecessor_timestamp ctxt level
+            >>=? fun timestamp -> return (level, Some timestamp))
         levels
 
 module Baking_rights = struct
-
   type t = {
-    level: Raw_level.t ;
-    delegate: Signature.Public_key_hash.t ;
-    priority: int ;
-    timestamp: Timestamp.t option ;
+    level : Raw_level.t;
+    delegate : Signature.Public_key_hash.t;
+    priority : int;
+    timestamp : Timestamp.t option;
   }
 
   let encoding =
     let open Data_encoding in
     conv
-      (fun { level ; delegate ; priority ; timestamp } ->
-         (level, delegate, priority, timestamp))
+      (fun {level; delegate; priority; timestamp} ->
+        (level, delegate, priority, timestamp))
       (fun (level, delegate, priority, timestamp) ->
-         { level ; delegate ; priority ; timestamp })
+        {level; delegate; priority; timestamp})
       (obj4
          (req "level" Raw_level.encoding)
          (req "delegate" Signature.Public_key_hash.encoding)
@@ -315,27 +328,26 @@ module Baking_rights = struct
          (opt "estimated_time" Timestamp.encoding))
 
   module S = struct
-
     open Data_encoding
 
-    let custom_root =
-      RPC_path.(open_root / "helpers" / "baking_rights")
+    let custom_root = RPC_path.(open_root / "helpers" / "baking_rights")
 
     type baking_rights_query = {
-      levels: Raw_level.t list ;
-      cycles: Cycle.t list ;
-      delegates: Signature.Public_key_hash.t list ;
-      max_priority: int option ;
-      all: bool ;
+      levels : Raw_level.t list;
+      cycles : Cycle.t list;
+      delegates : Signature.Public_key_hash.t list;
+      max_priority : int option;
+      all : bool;
     }
 
     let baking_rights_query =
       let open RPC_query in
       query (fun levels cycles delegates max_priority all ->
-          { levels ; cycles ; delegates ; max_priority ; all })
+          {levels; cycles; delegates; max_priority; all})
       |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
       |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
-      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t -> t.delegates)
+      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t ->
+             t.delegates)
       |+ opt_field "max_priority" RPC_arg.int (fun t -> t.max_priority)
       |+ flag "all" (fun t -> t.all)
       |> seal
@@ -344,112 +356,114 @@ module Baking_rights = struct
       RPC_service.get_service
         ~description:
           "Retrieves the list of delegates allowed to bake a block.\n\
-           By default, it gives the best baking priorities for bakers \
-           that have at least one opportunity below the 64th priority \
-           for the next block.\n\
-           Parameters `level` and `cycle` can be used to specify the \
-           (valid) level(s) in the past or future at which the baking \
-           rights have to be returned. Parameter `delegate` can be \
-           used to restrict the results to the given delegates. If \
-           parameter `all` is set, all the baking opportunities for \
-           each baker at each level are returned, instead of just the \
-           first one.\n\
+           By default, it gives the best baking priorities for bakers that \
+           have at least one opportunity below the 64th priority for the next \
+           block.\n\
+           Parameters `level` and `cycle` can be used to specify the (valid) \
+           level(s) in the past or future at which the baking rights have to \
+           be returned. Parameter `delegate` can be used to restrict the \
+           results to the given delegates. If parameter `all` is set, all the \
+           baking opportunities for each baker at each level are returned, \
+           instead of just the first one.\n\
            Returns the list of baking slots. Also returns the minimal \
-           timestamps that correspond to these slots. The timestamps \
-           are omitted for levels in the past, and are only estimates \
-           for levels later that the next block, based on the \
-           hypothesis that all predecessor blocks were baked at the \
-           first priority."
-        ~query: baking_rights_query
-        ~output: (list encoding)
+           timestamps that correspond to these slots. The timestamps are \
+           omitted for levels in the past, and are only estimates for levels \
+           later that the next block, based on the hypothesis that all \
+           predecessor blocks were baked at the first priority."
+        ~query:baking_rights_query
+        ~output:(list encoding)
         custom_root
-
   end
 
   let baking_priorities ctxt max_prio (level, pred_timestamp) =
-    Baking.baking_priorities ctxt level >>=? fun contract_list ->
+    Baking.baking_priorities ctxt level
+    >>=? fun contract_list ->
     let rec loop l acc priority =
-      if Compare.Int.(priority >= max_prio) then
-        return (List.rev acc)
+      if Compare.Int.(priority > max_prio) then return (List.rev acc)
       else
-        let Misc.LCons (pk, next) = l in
+        let (Misc.LCons (pk, next)) = l in
         let delegate = Signature.Public_key.hash pk in
-        begin
-          match pred_timestamp with
-          | None -> return_none
-          | Some pred_timestamp ->
-              Baking.minimal_time ctxt priority pred_timestamp >>=? fun t ->
-              return_some t
-        end>>=? fun timestamp ->
+        ( match pred_timestamp with
+        | None ->
+            return_none
+        | Some pred_timestamp ->
+            Baking.minimal_time ctxt priority pred_timestamp
+            >>=? fun t -> return_some t )
+        >>=? fun timestamp ->
         let acc =
-          { level = level.level ; delegate ; priority ; timestamp } :: acc in
-        next () >>=? fun l ->
-        loop l acc (priority+1) in
+          {level = level.level; delegate; priority; timestamp} :: acc
+        in
+        next () >>=? fun l -> loop l acc (priority + 1)
+    in
     loop contract_list [] 0
 
   let remove_duplicated_delegates rights =
-    List.rev @@ fst @@
-    List.fold_left
-      (fun (acc, previous) r ->
-         if Signature.Public_key_hash.Set.mem r.delegate previous then
-           (acc, previous)
-         else
-           (r :: acc,
-            Signature.Public_key_hash.Set.add r.delegate previous))
-      ([], Signature.Public_key_hash.Set.empty)
-      rights
+    List.rev @@ fst
+    @@ List.fold_left
+         (fun (acc, previous) r ->
+           if Signature.Public_key_hash.Set.mem r.delegate previous then
+             (acc, previous)
+           else
+             (r :: acc, Signature.Public_key_hash.Set.add r.delegate previous))
+         ([], Signature.Public_key_hash.Set.empty)
+         rights
 
   let register () =
     let open Services_registration in
-    register0 S.baking_rights begin fun ctxt q () ->
-      requested_levels
-        ~default:
-          (Level.succ ctxt (Level.current ctxt), Some (Timestamp.current ctxt))
-        ctxt q.cycles q.levels >>=? fun levels ->
-      let max_priority =
-        match q.max_priority with
-        | None -> 64
-        | Some max -> max in
-      map_s (baking_priorities ctxt max_priority) levels >>=? fun rights ->
-      let rights =
-        if q.all then
-          rights
-        else
-          List.map remove_duplicated_delegates rights in
-      let rights = List.concat rights in
-      match q.delegates with
-      | [] -> return rights
-      | _ :: _ as delegates ->
-          let is_requested p =
-            List.exists (Signature.Public_key_hash.equal p.delegate) delegates in
-          return (List.filter is_requested rights)
-    end
+    register0 S.baking_rights (fun ctxt q () ->
+        requested_levels
+          ~default:
+            ( Level.succ ctxt (Level.current ctxt),
+              Some (Timestamp.current ctxt) )
+          ctxt
+          q.cycles
+          q.levels
+        >>=? fun levels ->
+        let max_priority =
+          match q.max_priority with None -> 64 | Some max -> max
+        in
+        map_s (baking_priorities ctxt max_priority) levels
+        >>=? fun rights ->
+        let rights =
+          if q.all then rights else List.map remove_duplicated_delegates rights
+        in
+        let rights = List.concat rights in
+        match q.delegates with
+        | [] ->
+            return rights
+        | _ :: _ as delegates ->
+            let is_requested p =
+              List.exists
+                (Signature.Public_key_hash.equal p.delegate)
+                delegates
+            in
+            return (List.filter is_requested rights))
 
-  let get ctxt
-      ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false)
+  let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false)
       ?max_priority block =
-    RPC_context.make_call0 S.baking_rights ctxt block
-      { levels ; cycles ; delegates ; max_priority ; all }
+    RPC_context.make_call0
+      S.baking_rights
+      ctxt
+      block
+      {levels; cycles; delegates; max_priority; all}
       ()
-
 end
 
 module Endorsing_rights = struct
-
   type t = {
-    level: Raw_level.t ;
-    delegate: Signature.Public_key_hash.t ;
-    slots: int list ;
-    estimated_time: Time.t option ;
+    level : Raw_level.t;
+    delegate : Signature.Public_key_hash.t;
+    slots : int list;
+    estimated_time : Time.t option;
   }
 
   let encoding =
     let open Data_encoding in
     conv
-      (fun { level ; delegate ; slots ; estimated_time } ->
-         (level, delegate, slots, estimated_time))
+      (fun {level; delegate; slots; estimated_time} ->
+        (level, delegate, slots, estimated_time))
       (fun (level, delegate, slots, estimated_time) ->
-         { level ; delegate ; slots ; estimated_time })
+        {level; delegate; slots; estimated_time})
       (obj4
          (req "level" Raw_level.encoding)
          (req "delegate" Signature.Public_key_hash.encoding)
@@ -457,94 +471,97 @@ module Endorsing_rights = struct
          (opt "estimated_time" Timestamp.encoding))
 
   module S = struct
-
     open Data_encoding
 
-    let custom_root =
-      RPC_path.(open_root / "helpers" / "endorsing_rights")
+    let custom_root = RPC_path.(open_root / "helpers" / "endorsing_rights")
 
     type endorsing_rights_query = {
-      levels: Raw_level.t list ;
-      cycles: Cycle.t list ;
-      delegates: Signature.Public_key_hash.t list ;
+      levels : Raw_level.t list;
+      cycles : Cycle.t list;
+      delegates : Signature.Public_key_hash.t list;
     }
 
     let endorsing_rights_query =
       let open RPC_query in
-      query (fun levels cycles delegates ->
-          { levels ; cycles ; delegates })
+      query (fun levels cycles delegates -> {levels; cycles; delegates})
       |+ multi_field "level" Raw_level.rpc_arg (fun t -> t.levels)
       |+ multi_field "cycle" Cycle.rpc_arg (fun t -> t.cycles)
-      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t -> t.delegates)
+      |+ multi_field "delegate" Signature.Public_key_hash.rpc_arg (fun t ->
+             t.delegates)
       |> seal
 
     let endorsing_rights =
       RPC_service.get_service
         ~description:
           "Retrieves the delegates allowed to endorse a block.\n\
-           By default, it gives the endorsement slots for delegates that \
-           have at least one in the next block.\n\
-           Parameters `level` and `cycle` can be used to specify the \
-           (valid) level(s) in the past or future at which the \
-           endorsement rights have to be returned. Parameter \
-           `delegate` can be used to restrict the results to the given \
-           delegates.\n\
-           Returns the list of endorsement slots. Also returns the \
-           minimal timestamps that correspond to these slots. The \
-           timestamps are omitted for levels in the past, and are only \
-           estimates for levels later that the next block, based on \
-           the hypothesis that all predecessor blocks were baked at \
-           the first priority."
-        ~query: endorsing_rights_query
-        ~output: (list encoding)
+           By default, it gives the endorsement slots for delegates that have \
+           at least one in the next block.\n\
+           Parameters `level` and `cycle` can be used to specify the (valid) \
+           level(s) in the past or future at which the endorsement rights \
+           have to be returned. Parameter `delegate` can be used to restrict \
+           the results to the given delegates.\n\
+           Returns the list of endorsement slots. Also returns the minimal \
+           timestamps that correspond to these slots. The timestamps are \
+           omitted for levels in the past, and are only estimates for levels \
+           later that the next block, based on the hypothesis that all \
+           predecessor blocks were baked at the first priority."
+        ~query:endorsing_rights_query
+        ~output:(list encoding)
         custom_root
-
   end
 
   let endorsement_slots ctxt (level, estimated_time) =
-    Baking.endorsement_rights ctxt level >>=? fun rights ->
+    Baking.endorsement_rights ctxt level
+    >>=? fun rights ->
     return
       (Signature.Public_key_hash.Map.fold
-         (fun delegate (_, slots, _) acc -> {
-              level = level.level ; delegate ; slots ; estimated_time
-            } :: acc)
-         rights [])
+         (fun delegate (_, slots, _) acc ->
+           {level = level.level; delegate; slots; estimated_time} :: acc)
+         rights
+         [])
 
   let register () =
     let open Services_registration in
-    register0 S.endorsing_rights begin fun ctxt q () ->
-      requested_levels
-        ~default: (Level.current ctxt, Some (Timestamp.current ctxt))
-        ctxt q.cycles q.levels >>=? fun levels ->
-      map_s (endorsement_slots ctxt) levels >>=? fun rights ->
-      let rights = List.concat rights in
-      match q.delegates with
-      | [] -> return rights
-      | _ :: _ as delegates ->
-          let is_requested p =
-            List.exists (Signature.Public_key_hash.equal p.delegate) delegates in
-          return (List.filter is_requested rights)
-    end
+    register0 S.endorsing_rights (fun ctxt q () ->
+        requested_levels
+          ~default:(Level.current ctxt, Some (Timestamp.current ctxt))
+          ctxt
+          q.cycles
+          q.levels
+        >>=? fun levels ->
+        map_s (endorsement_slots ctxt) levels
+        >>=? fun rights ->
+        let rights = List.concat rights in
+        match q.delegates with
+        | [] ->
+            return rights
+        | _ :: _ as delegates ->
+            let is_requested p =
+              List.exists
+                (Signature.Public_key_hash.equal p.delegate)
+                delegates
+            in
+            return (List.filter is_requested rights))
 
-  let get ctxt
-      ?(levels = []) ?(cycles = []) ?(delegates = []) block =
-    RPC_context.make_call0 S.endorsing_rights ctxt block
-      { levels ; cycles ; delegates }
+  let get ctxt ?(levels = []) ?(cycles = []) ?(delegates = []) block =
+    RPC_context.make_call0
+      S.endorsing_rights
+      ctxt
+      block
+      {levels; cycles; delegates}
       ()
-
 end
 
 module Endorsing_power = struct
-
   let endorsing_power ctxt (operation, chain_id) =
-    let Operation_data data = operation.protocol_data in
+    let (Operation_data data) = operation.protocol_data in
     match data.contents with
-    | Single Endorsement _ ->
-        Baking.check_endorsement_rights ctxt chain_id {
-          shell = operation.shell ;
-          protocol_data = data ;
-        } >>=? fun (_, slots, _) ->
-        return (List.length slots)
+    | Single (Endorsement _) ->
+        Baking.check_endorsement_rights
+          ctxt
+          chain_id
+          {shell = operation.shell; protocol_data = data}
+        >>=? fun (_, slots, _) -> return (List.length slots)
     | _ ->
         failwith "Operation is not an endorsement"
 
@@ -552,101 +569,98 @@ module Endorsing_power = struct
     let endorsing_power =
       let open Data_encoding in
       RPC_service.post_service
-        ~description:"Get the endorsing power of an endorsement, that is, \
-                      the number of slots that the endorser has"
-        ~query: RPC_query.empty
-        ~input: (obj2
-                   (req "endorsement_operation" Operation.encoding)
-                   (req "chain_id" Chain_id.encoding))
-        ~output: int31
+        ~description:
+          "Get the endorsing power of an endorsement, that is, the number of \
+           slots that the endorser has"
+        ~query:RPC_query.empty
+        ~input:
+          (obj2
+             (req "endorsement_operation" Operation.encoding)
+             (req "chain_id" Chain_id.encoding))
+        ~output:int31
         RPC_path.(open_root / "endorsing_power")
   end
 
   let register () =
     let open Services_registration in
-    register0 S.endorsing_power begin fun ctxt () (op, chain_id) ->
-      endorsing_power ctxt (op, chain_id)
-    end
+    register0 S.endorsing_power (fun ctxt () (op, chain_id) ->
+        endorsing_power ctxt (op, chain_id))
 
   let get ctxt block op chain_id =
     RPC_context.make_call0 S.endorsing_power ctxt block () (op, chain_id)
-
 end
 
 module Required_endorsements = struct
-
   let required_endorsements ctxt block_delay =
     return (Baking.minimum_allowed_endorsements ctxt ~block_delay)
 
   module S = struct
-
-    type t = { block_delay : Period.t }
+    type t = {block_delay : Period.t}
 
     let required_endorsements_query =
       let open RPC_query in
-      query (fun block_delay -> { block_delay })
-      |+ field "block_delay" Period.rpc_arg Period.zero (fun t -> t.block_delay)
+      query (fun block_delay -> {block_delay})
+      |+ field "block_delay" Period.rpc_arg Period.zero (fun t ->
+             t.block_delay)
       |> seal
 
     let required_endorsements =
       let open Data_encoding in
       RPC_service.get_service
-        ~description:"Minimum number of endorsements for a block to be \
-                      valid, given a delay of the block's timestamp with \
-                      respect to the minimum time to bake at the \
-                      block's priority"
-        ~query: required_endorsements_query
-        ~output: int31
+        ~description:
+          "Minimum number of endorsements for a block to be valid, given a \
+           delay of the block's timestamp with respect to the minimum time to \
+           bake at the block's priority"
+        ~query:required_endorsements_query
+        ~output:int31
         RPC_path.(open_root / "required_endorsements")
   end
 
   let register () =
     let open Services_registration in
-    register0 S.required_endorsements begin fun ctxt ({ block_delay }) () ->
-      required_endorsements ctxt block_delay
-    end
+    register0 S.required_endorsements (fun ctxt {block_delay} () ->
+        required_endorsements ctxt block_delay)
 
   let get ctxt block block_delay =
-    RPC_context.make_call0 S.required_endorsements ctxt block { block_delay } ()
-
+    RPC_context.make_call0 S.required_endorsements ctxt block {block_delay} ()
 end
 
 module Minimal_valid_time = struct
-
   let minimal_valid_time ctxt ~priority ~endorsing_power =
-    Baking.minimal_valid_time ctxt
-      ~priority ~endorsing_power
+    Baking.minimal_valid_time ctxt ~priority ~endorsing_power
 
   module S = struct
-
-    type t = { priority : int ;
-               endorsing_power : int }
+    type t = {priority : int; endorsing_power : int}
 
     let minimal_valid_time_query =
       let open RPC_query in
-      query (fun priority endorsing_power ->
-          {  priority ; endorsing_power })
+      query (fun priority endorsing_power -> {priority; endorsing_power})
       |+ field "priority" RPC_arg.int 0 (fun t -> t.priority)
       |+ field "endorsing_power" RPC_arg.int 0 (fun t -> t.endorsing_power)
       |> seal
 
     let minimal_valid_time =
       RPC_service.get_service
-        ~description: "Minimal valid time for a block given a priority \
-                       and an endorsing power."
-        ~query: minimal_valid_time_query
-        ~output: Time.encoding
+        ~description:
+          "Minimal valid time for a block given a priority and an endorsing \
+           power."
+        ~query:minimal_valid_time_query
+        ~output:Time.encoding
         RPC_path.(open_root / "minimal_valid_time")
   end
 
   let register () =
     let open Services_registration in
-    register0 S.minimal_valid_time begin fun ctxt { priority ; endorsing_power } () ->
-      minimal_valid_time ctxt ~priority ~endorsing_power
-    end
+    register0 S.minimal_valid_time (fun ctxt {priority; endorsing_power} () ->
+        minimal_valid_time ctxt ~priority ~endorsing_power)
 
   let get ctxt block priority endorsing_power =
-    RPC_context.make_call0 S.minimal_valid_time ctxt block { priority ; endorsing_power } ()
+    RPC_context.make_call0
+      S.minimal_valid_time
+      ctxt
+      block
+      {priority; endorsing_power}
+      ()
 end
 
 let register () =
@@ -658,17 +672,20 @@ let register () =
   Minimal_valid_time.register ()
 
 let endorsement_rights ctxt level =
-  Endorsing_rights.endorsement_slots ctxt (level, None) >>=? fun l ->
-  return (List.map (fun { Endorsing_rights.delegate ; _ } -> delegate) l)
+  Endorsing_rights.endorsement_slots ctxt (level, None)
+  >>=? fun l ->
+  return (List.map (fun {Endorsing_rights.delegate; _} -> delegate) l)
 
 let baking_rights ctxt max_priority =
   let max = match max_priority with None -> 64 | Some m -> m in
   let level = Level.current ctxt in
-  Baking_rights.baking_priorities ctxt max (level, None) >>=? fun l ->
-  return (level.level,
-          List.map
-            (fun { Baking_rights.delegate ; timestamp ; _ } ->
-               (delegate, timestamp)) l)
+  Baking_rights.baking_priorities ctxt max (level, None)
+  >>=? fun l ->
+  return
+    ( level.level,
+      List.map
+        (fun {Baking_rights.delegate; timestamp; _} -> (delegate, timestamp))
+        l )
 
 let endorsing_power ctxt operation =
   Endorsing_power.endorsing_power ctxt operation

vendors/ligo-utils/tezos-protocol-alpha/delegate_services.mli

@@ -25,78 +25,87 @@
 
 open Alpha_context
 
-val list:
-  'a #RPC_context.simple -> 'a ->
+val list :
+  'a #RPC_context.simple ->
+  'a ->
   ?active:bool ->
   ?inactive:bool ->
-  unit -> Signature.Public_key_hash.t list shell_tzresult Lwt.t
+  unit ->
+  Signature.Public_key_hash.t list shell_tzresult Lwt.t
 
 type info = {
-  balance: Tez.t ;
-  frozen_balance: Tez.t ;
-  frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;
-  staking_balance: Tez.t ;
-  delegated_contracts: Contract_repr.t list ;
-  delegated_balance: Tez.t ;
-  deactivated: bool ;
-  grace_period: Cycle.t ;
+  balance : Tez.t;
+  frozen_balance : Tez.t;
+  frozen_balance_by_cycle : Delegate.frozen_balance Cycle.Map.t;
+  staking_balance : Tez.t;
+  delegated_contracts : Contract_repr.t list;
+  delegated_balance : Tez.t;
+  deactivated : bool;
+  grace_period : Cycle.t;
 }
 
-val info_encoding: info Data_encoding.t
+val info_encoding : info Data_encoding.t
 
-val info:
-  'a #RPC_context.simple -> 'a ->
+val info :
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   info shell_tzresult Lwt.t
 
-val balance:
-  'a #RPC_context.simple -> 'a ->
+val balance :
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Tez.t shell_tzresult Lwt.t
 
-val frozen_balance:
-  'a #RPC_context.simple -> 'a ->
+val frozen_balance :
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Tez.t shell_tzresult Lwt.t
 
-val frozen_balance_by_cycle:
-  'a #RPC_context.simple -> 'a ->
+val frozen_balance_by_cycle :
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Delegate.frozen_balance Cycle.Map.t shell_tzresult Lwt.t
 
-val staking_balance:
-  'a #RPC_context.simple -> 'a ->
+val staking_balance :
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Tez.t shell_tzresult Lwt.t
 
-val delegated_contracts:
-  'a #RPC_context.simple -> 'a ->
+val delegated_contracts :
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Contract_repr.t list shell_tzresult Lwt.t
 
-val delegated_balance:
-  'a #RPC_context.simple -> 'a ->
+val delegated_balance :
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Tez.t shell_tzresult Lwt.t
 
-val deactivated:
-  'a #RPC_context.simple -> 'a ->
+val deactivated :
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   bool shell_tzresult Lwt.t
 
-val grace_period:
-  'a #RPC_context.simple -> 'a ->
+val grace_period :
+  'a #RPC_context.simple ->
+  'a ->
   Signature.Public_key_hash.t ->
   Cycle.t shell_tzresult Lwt.t
 
-
 module Baking_rights : sig
-
   type t = {
-    level: Raw_level.t ;
-    delegate: Signature.Public_key_hash.t ;
-    priority: int ;
-    timestamp: Timestamp.t option ;
+    level : Raw_level.t;
+    delegate : Signature.Public_key_hash.t;
+    priority : int;
+    timestamp : Timestamp.t option;
   }
 
   (** Retrieves the list of delegates allowed to bake a block.
@@ -117,24 +126,23 @@ module Baking_rights : sig
       omitted for levels in the past, and are only estimates for levels
       later that the next block, based on the hypothesis that all
       predecessor blocks were baked at the first priority. *)
-  val get:
+  val get :
     'a #RPC_context.simple ->
-    ?levels: Raw_level.t list ->
-    ?cycles: Cycle.t list ->
-    ?delegates: Signature.public_key_hash list ->
-    ?all: bool ->
-    ?max_priority: int ->
-    'a -> t list shell_tzresult Lwt.t
-
+    ?levels:Raw_level.t list ->
+    ?cycles:Cycle.t list ->
+    ?delegates:Signature.public_key_hash list ->
+    ?all:bool ->
+    ?max_priority:int ->
+    'a ->
+    t list shell_tzresult Lwt.t
 end
 
 module Endorsing_rights : sig
-
   type t = {
-    level: Raw_level.t ;
-    delegate: Signature.Public_key_hash.t ;
-    slots: int list ;
-    estimated_time: Timestamp.t option ;
+    level : Raw_level.t;
+    delegate : Signature.Public_key_hash.t;
+    slots : int list;
+    estimated_time : Timestamp.t option;
   }
 
   (** Retrieves the delegates allowed to endorse a block.
@@ -153,66 +161,51 @@ module Endorsing_rights : sig
       estimates for levels later that the next block, based on the
       hypothesis that all predecessor blocks were baked at the first
       priority. *)
-  val get:
+  val get :
     'a #RPC_context.simple ->
-    ?levels: Raw_level.t list ->
-    ?cycles: Cycle.t list ->
-    ?delegates: Signature.public_key_hash list ->
-    'a -> t list shell_tzresult Lwt.t
-
+    ?levels:Raw_level.t list ->
+    ?cycles:Cycle.t list ->
+    ?delegates:Signature.public_key_hash list ->
+    'a ->
+    t list shell_tzresult Lwt.t
 end
 
 module Endorsing_power : sig
-
-  val get:
-    'a #RPC_context.simple -> 'a ->
+  val get :
+    'a #RPC_context.simple ->
+    'a ->
     Alpha_context.packed_operation ->
     Chain_id.t ->
     int shell_tzresult Lwt.t
-
 end
 
 module Required_endorsements : sig
-
-  val get:
-    'a #RPC_context.simple -> 'a ->
-    Period.t -> int shell_tzresult Lwt.t
-
+  val get :
+    'a #RPC_context.simple -> 'a -> Period.t -> int shell_tzresult Lwt.t
 end
 
 module Minimal_valid_time : sig
-
-  val get:
-    'a #RPC_context.simple -> 'a ->
-    int -> int -> Time.t shell_tzresult Lwt.t
-
+  val get :
+    'a #RPC_context.simple -> 'a -> int -> int -> Time.t shell_tzresult Lwt.t
 end
 
 (* temporary export for deprecated unit test *)
-val endorsement_rights:
-  Alpha_context.t ->
-  Level.t ->
-  public_key_hash list tzresult Lwt.t
+val endorsement_rights :
+  Alpha_context.t -> Level.t -> public_key_hash list tzresult Lwt.t
 
-val baking_rights:
+val baking_rights :
   Alpha_context.t ->
   int option ->
   (Raw_level.t * (public_key_hash * Time.t option) list) tzresult Lwt.t
 
-val endorsing_power:
+val endorsing_power :
   Alpha_context.t ->
-  (Alpha_context.packed_operation * Chain_id.t) ->
+  Alpha_context.packed_operation * Chain_id.t ->
   int tzresult Lwt.t
 
-val required_endorsements:
-  Alpha_context.t ->
-  Alpha_context.Period.t ->
-  int tzresult Lwt.t
+val required_endorsements :
+  Alpha_context.t -> Alpha_context.Period.t -> int tzresult Lwt.t
 
-val minimal_valid_time:
-  Alpha_context.t ->
-  int ->
-  int ->
-  Time.t tzresult Lwt.t
+val minimal_valid_time : Alpha_context.t -> int -> int -> Time.t tzresult Lwt.t
 
-val register: unit -> unit
+val register : unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/delegate_storage.mli

@@ -31,9 +31,7 @@ type balance =
   | Deposits of Signature.Public_key_hash.t * Cycle_repr.t
 
 (** A credit or debit of tezzies to a balance. *)
-type balance_update =
-  | Debited of Tez_repr.t
-  | Credited of Tez_repr.t
+type balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t
 
 (** A list of balance updates. Duplicates may happen. *)
 type balance_updates = (balance * balance_update) list
@@ -44,26 +42,29 @@ val balance_updates_encoding : balance_updates Data_encoding.t
 val cleanup_balance_updates : balance_updates -> balance_updates
 
 type frozen_balance = {
-  deposit : Tez_repr.t ;
-  fees : Tez_repr.t ;
-  rewards : Tez_repr.t ;
+  deposit : Tez_repr.t;
+  fees : Tez_repr.t;
+  rewards : Tez_repr.t;
 }
 
 (** Allow to register a delegate when creating an account. *)
-val init:
-  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t ->
+val init :
+  Raw_context.t ->
+  Contract_repr.t ->
+  Signature.Public_key_hash.t ->
   Raw_context.t tzresult Lwt.t
 
 (** Cleanup delegation when deleting a contract. *)
-val remove:
-  Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
+val remove : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t
 
 (** Reading the current delegate of a contract. *)
-val get:
-  Raw_context.t -> Contract_repr.t ->
+val get :
+  Raw_context.t ->
+  Contract_repr.t ->
   Signature.Public_key_hash.t option tzresult Lwt.t
 
-val registered: Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
+val registered :
+  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
 
 (** Updating the delegate of a contract.
 
@@ -71,8 +72,10 @@ val registered: Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lw
     the delegate to the contract manager registers it as a delegate. One
     cannot unregister a delegate for now. The associate contract is now
     'undeletable'. *)
-val set:
-  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option ->
+val set :
+  Raw_context.t ->
+  Contract_repr.t ->
+  Signature.Public_key_hash.t option ->
   Raw_context.t tzresult Lwt.t
 
 type error +=
@@ -80,34 +83,44 @@ type error +=
   | Active_delegate (* `Temporary *)
   | Current_delegate (* `Temporary *)
   | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)
-  | Balance_too_low_for_deposit of
-      { delegate : Signature.Public_key_hash.t ;
-        deposit : Tez_repr.t ;
-        balance : Tez_repr.t } (* `Temporary *)
+  | Balance_too_low_for_deposit of {
+      delegate : Signature.Public_key_hash.t;
+      deposit : Tez_repr.t;
+      balance : Tez_repr.t;
+    }
+
+(* `Temporary *)
 
 (** Iterate on all registered delegates. *)
-val fold:
+val fold :
   Raw_context.t ->
   init:'a ->
-  f:(Signature.Public_key_hash.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t
+  f:(Signature.Public_key_hash.t -> 'a -> 'a Lwt.t) ->
+  'a Lwt.t
 
 (** List all registered delegates. *)
-val list: Raw_context.t -> Signature.Public_key_hash.t list Lwt.t
+val list : Raw_context.t -> Signature.Public_key_hash.t list Lwt.t
 
 (** Various functions to 'freeze' tokens.  A frozen 'deposit' keeps its
     associated rolls. When frozen, 'fees' may trigger new rolls
     allocation. Rewards won't trigger new rolls allocation until
     unfrozen. *)
-val freeze_deposit:
-  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->
+val freeze_deposit :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
-val freeze_fees:
-  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->
+val freeze_fees :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
-val freeze_rewards:
-  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->
+val freeze_rewards :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Tez_repr.t ->
   Raw_context.t tzresult Lwt.t
 
 (** Trigger the context maintenance at the end of cycle 'n', i.e.:
@@ -115,62 +128,64 @@ val freeze_rewards:
     provided unrevealed seeds (tipically seed from cycle 'n - 1').
     Returns a list of account with the amount that was unfrozen for each
     and the list of deactivated delegates. *)
-val cycle_end:
-  Raw_context.t -> Cycle_repr.t -> Nonce_storage.unrevealed list ->
-  (Raw_context.t * balance_updates * Signature.Public_key_hash.t list) tzresult Lwt.t
+val cycle_end :
+  Raw_context.t ->
+  Cycle_repr.t ->
+  Nonce_storage.unrevealed list ->
+  (Raw_context.t * balance_updates * Signature.Public_key_hash.t list) tzresult
+  Lwt.t
 
 (** Burn all then frozen deposit/fees/rewards for a delegate at a given
     cycle. Returns the burned amounts. *)
-val punish:
-  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t ->
+val punish :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Cycle_repr.t ->
   (Raw_context.t * frozen_balance) tzresult Lwt.t
 
 (** Has the given key some frozen tokens in its implicit contract? *)
-val has_frozen_balance:
-  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t ->
+val has_frozen_balance :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
+  Cycle_repr.t ->
   bool tzresult Lwt.t
 
 (** Returns the amount of frozen deposit, fees and rewards associated
     to a given delegate. *)
-val frozen_balance:
-  Raw_context.t -> Signature.Public_key_hash.t ->
-  Tez_repr.t tzresult Lwt.t
+val frozen_balance :
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t
 
-val frozen_balance_encoding: frozen_balance Data_encoding.t
-val frozen_balance_by_cycle_encoding:
+val frozen_balance_encoding : frozen_balance Data_encoding.t
+
+val frozen_balance_by_cycle_encoding :
   frozen_balance Cycle_repr.Map.t Data_encoding.t
 
 (** Returns the amount of frozen deposit, fees and rewards associated
     to a given delegate, indexed by the cycle by which at the end the
     balance will be unfrozen. *)
-val frozen_balance_by_cycle:
-  Raw_context.t -> Signature.Public_key_hash.t ->
+val frozen_balance_by_cycle :
+  Raw_context.t ->
+  Signature.Public_key_hash.t ->
   frozen_balance Cycle_repr.Map.t Lwt.t
 
 (** Returns the full 'balance' of the implicit contract associated to
     a given key, i.e. the sum of the spendable balance and of the
     frozen balance. *)
-val full_balance:
-  Raw_context.t -> Signature.Public_key_hash.t ->
-  Tez_repr.t tzresult Lwt.t
+val full_balance :
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t
 
-val staking_balance:
-  Raw_context.t -> Signature.Public_key_hash.t ->
-  Tez_repr.t tzresult Lwt.t
+val staking_balance :
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t
 
 (** Returns the list of contracts (implicit or originated) that delegated towards a given delegate *)
-val delegated_contracts:
-  Raw_context.t -> Signature.Public_key_hash.t ->
-  Contract_repr.t list Lwt.t
+val delegated_contracts :
+  Raw_context.t -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t
 
-val delegated_balance:
-  Raw_context.t -> Signature.Public_key_hash.t ->
-  Tez_repr.t tzresult Lwt.t
+val delegated_balance :
+  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t
 
-val deactivated:
-  Raw_context.t -> Signature.Public_key_hash.t ->
-  bool tzresult Lwt.t
+val deactivated :
+  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t
 
-val grace_period:
-  Raw_context.t -> Signature.Public_key_hash.t ->
-  Cycle_repr.t tzresult Lwt.t
+val grace_period :
+  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/dune-project

@@ -1,2 +1,2 @@
 (lang dune 1.11)
-(name tezos-embedded-protocol-005-PsBabyM1)
+(name tezos-embedded-protocol-006-PsCARTHA)

vendors/ligo-utils/tezos-protocol-alpha/dune.inc

@@ -11,7 +11,7 @@
  (targets environment.ml)
  (action
   (write-file %{targets}
-              "module Name = struct let name = \"005-PsBabyM1\" end
+              "module Name = struct let name = \"006-PsCARTHA\" end
 include Tezos_protocol_environment.MakeV1(Name)()
 module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end
 ")))
@@ -22,7 +22,7 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end
        (:src_dir TEZOS_PROTOCOL))
  (action
   (with-stdout-to %{targets}
-                  (chdir %{workspace_root} (run %{bin:tezos-embedded-protocol-packer} "%{src_dir}" "005_PsBabyM1")))))
+                  (chdir %{workspace_root} (run %{bin:tezos-embedded-protocol-packer} "%{src_dir}" "006_PsCARTHA")))))
 
 (rule
  (targets functor.ml)
@@ -37,67 +37,67 @@ module CamlinternalFormatBasics = struct include CamlinternalFormatBasics end
  (deps misc.mli misc.ml storage_description.mli storage_description.ml state_hash.ml nonce_hash.ml script_expr_hash.ml contract_hash.ml blinded_public_key_hash.mli blinded_public_key_hash.ml qty_repr.ml tez_repr.mli tez_repr.ml period_repr.mli period_repr.ml time_repr.mli time_repr.ml constants_repr.ml fitness_repr.ml raw_level_repr.mli raw_level_repr.ml voting_period_repr.mli voting_period_repr.ml cycle_repr.mli cycle_repr.ml level_repr.mli level_repr.ml seed_repr.mli seed_repr.ml gas_limit_repr.mli gas_limit_repr.ml script_int_repr.mli script_int_repr.ml script_timestamp_repr.mli script_timestamp_repr.ml michelson_v1_primitives.mli michelson_v1_primitives.ml script_repr.mli script_repr.ml legacy_script_support_repr.mli legacy_script_support_repr.ml contract_repr.mli contract_repr.ml roll_repr.mli roll_repr.ml vote_repr.mli vote_repr.ml block_header_repr.mli block_header_repr.ml operation_repr.mli operation_repr.ml manager_repr.mli manager_repr.ml commitment_repr.mli commitment_repr.ml parameters_repr.mli parameters_repr.ml raw_context.mli raw_context.ml storage_sigs.ml storage_functors.mli storage_functors.ml storage.mli storage.ml constants_storage.ml level_storage.mli level_storage.ml nonce_storage.mli nonce_storage.ml seed_storage.mli seed_storage.ml roll_storage.mli roll_storage.ml delegate_storage.mli delegate_storage.ml contract_storage.mli contract_storage.ml bootstrap_storage.mli bootstrap_storage.ml fitness_storage.ml vote_storage.mli vote_storage.ml commitment_storage.mli commitment_storage.ml init_storage.ml fees_storage.mli fees_storage.ml alpha_context.mli alpha_context.ml script_typed_ir.ml script_tc_errors.ml michelson_v1_gas.mli michelson_v1_gas.ml script_ir_annot.mli script_ir_annot.ml script_ir_translator.mli script_ir_translator.ml script_tc_errors_registration.ml script_interpreter.mli script_interpreter.ml baking.mli baking.ml amendment.mli amendment.ml apply_results.mli apply_results.ml apply.ml services_registration.ml constants_services.mli constants_services.ml contract_services.mli contract_services.ml delegate_services.mli delegate_services.ml helpers_services.mli helpers_services.ml voting_services.mli voting_services.ml alpha_services.mli alpha_services.ml main.mli main.ml)
  (action
   (write-file %{targets}
-    "module Environment = Tezos_protocol_environment_005_PsBabyM1.Environment
-let hash = Tezos_crypto.Protocol_hash.of_b58check_exn \"PsBabyM1eUXZseaJdmXFApDSBqj8YBfwELoxZHHW77EMcAbbwAS\"
+    "module Environment = Tezos_protocol_environment_006_PsCARTHA.Environment
+let hash = Tezos_crypto.Protocol_hash.of_b58check_exn \"PsCARTHAGazKbHtnKfLzQg3kms52kSRpgnDY982a9oYsSXRLQEb\"
 let name = Environment.Name.name
-include Tezos_raw_protocol_005_PsBabyM1
-include Tezos_raw_protocol_005_PsBabyM1.Main
+include Tezos_raw_protocol_006_PsCARTHA
+include Tezos_raw_protocol_006_PsCARTHA.Main
 ")))
 
 (library
- (name tezos_protocol_environment_005_PsBabyM1)
- (public_name tezos-protocol-005-PsBabyM1.environment)
+ (name tezos_protocol_environment_006_PsCARTHA)
+ (public_name tezos-protocol-006-PsCARTHA.environment)
  (library_flags (:standard -linkall))
  (libraries tezos-protocol-environment)
  (modules Environment))
 
 (library
- (name tezos_raw_protocol_005_PsBabyM1)
- (public_name tezos-protocol-005-PsBabyM1.raw)
- (libraries tezos_protocol_environment_005_PsBabyM1)
+ (name tezos_raw_protocol_006_PsCARTHA)
+ (public_name tezos-protocol-006-PsCARTHA.raw)
+ (libraries tezos_protocol_environment_006_PsCARTHA)
  (library_flags (:standard -linkall))
  (flags (:standard -nopervasives -nostdlib
                    -w +a-4-6-7-9-29-32-40..42-44-45-48
                    -warn-error -a+8
-                   -open Tezos_protocol_environment_005_PsBabyM1__Environment
+                   -open Tezos_protocol_environment_006_PsCARTHA__Environment
                    -open Pervasives
                    -open Error_monad))
  (modules Misc Storage_description State_hash Nonce_hash Script_expr_hash Contract_hash Blinded_public_key_hash Qty_repr Tez_repr Period_repr Time_repr Constants_repr Fitness_repr Raw_level_repr Voting_period_repr Cycle_repr Level_repr Seed_repr Gas_limit_repr Script_int_repr Script_timestamp_repr Michelson_v1_primitives Script_repr Legacy_script_support_repr Contract_repr Roll_repr Vote_repr Block_header_repr Operation_repr Manager_repr Commitment_repr Parameters_repr Raw_context Storage_sigs Storage_functors Storage Constants_storage Level_storage Nonce_storage Seed_storage Roll_storage Delegate_storage Contract_storage Bootstrap_storage Fitness_storage Vote_storage Commitment_storage Init_storage Fees_storage Alpha_context Script_typed_ir Script_tc_errors Michelson_v1_gas Script_ir_annot Script_ir_translator Script_tc_errors_registration Script_interpreter Baking Amendment Apply_results Apply Services_registration Constants_services Contract_services Delegate_services Helpers_services Voting_services Alpha_services Main))
 
 (install
  (section lib)
- (package tezos-protocol-005-PsBabyM1)
+ (package tezos-protocol-006-PsCARTHA)
  (files (TEZOS_PROTOCOL as raw/TEZOS_PROTOCOL)))
 
 (library
- (name tezos_protocol_005_PsBabyM1)
- (public_name tezos-protocol-005-PsBabyM1)
+ (name tezos_protocol_006_PsCARTHA)
+ (public_name tezos-protocol-006-PsCARTHA)
  (libraries
       tezos-protocol-environment
       tezos-protocol-environment-sigs
-      tezos_raw_protocol_005_PsBabyM1)
+      tezos_raw_protocol_006_PsCARTHA)
  (flags -w "+a-4-6-7-9-29-40..42-44-45-48"
         -warn-error "-a+8"
         -nopervasives)
  (modules Protocol))
 
 (library
- (name tezos_protocol_005_PsBabyM1_functor)
- (public_name tezos-protocol-005-PsBabyM1.functor)
+ (name tezos_protocol_006_PsCARTHA_functor)
+ (public_name tezos-protocol-006-PsCARTHA.functor)
  (libraries
       tezos-protocol-environment
       tezos-protocol-environment-sigs
-      tezos_raw_protocol_005_PsBabyM1)
+      tezos_raw_protocol_006_PsCARTHA)
  (flags -w "+a-4-6-7-9-29-40..42-44-45-48"
         -warn-error "-a+8"
         -nopervasives)
  (modules Functor))
 
 (library
- (name tezos_embedded_protocol_005_PsBabyM1)
- (public_name tezos-embedded-protocol-005-PsBabyM1)
+ (name tezos_embedded_protocol_006_PsCARTHA)
+ (public_name tezos-embedded-protocol-006-PsCARTHA)
  (library_flags (:standard -linkall))
- (libraries tezos-protocol-005-PsBabyM1
+ (libraries tezos-protocol-006-PsCARTHA
             tezos-protocol-updater
             tezos-protocol-environment)
  (flags (:standard -w +a-4-6-7-9-29-32-40..42-44-45-48
@@ -106,4 +106,4 @@ include Tezos_raw_protocol_005_PsBabyM1.Main
 
 (alias
  (name runtest_sandbox)
- (deps .tezos_protocol_005_PsBabyM1.objs/native/tezos_protocol_005_PsBabyM1.cmx))
+ (deps .tezos_protocol_006_PsCARTHA.objs/native/tezos_protocol_006_PsCARTHA.cmx))

vendors/ligo-utils/tezos-protocol-alpha/fees_storage.ml

@@ -24,7 +24,9 @@
 (*****************************************************************************)
 
 type error += Cannot_pay_storage_fee (* `Temporary *)
+
 type error += Operation_quota_exceeded (* `Temporary *)
+
 type error += Storage_limit_too_high (* `Permanent *)
 
 let () =
@@ -41,19 +43,18 @@ let () =
   register_error_kind
     `Temporary
     ~id:"storage_exhausted.operation"
-    ~title: "Storage quota exceeded for the operation"
+    ~title:"Storage quota exceeded for the operation"
     ~description:
-      "A script or one of its callee wrote more \
-       bytes than the operation said it would"
+      "A script or one of its callee wrote more bytes than the operation said \
+       it would"
     Data_encoding.empty
     (function Operation_quota_exceeded -> Some () | _ -> None)
     (fun () -> Operation_quota_exceeded) ;
   register_error_kind
     `Permanent
     ~id:"storage_limit_too_high"
-    ~title: "Storage limit out of protocol hard bounds"
-    ~description:
-      "A transaction tried to exceed the hard limit on storage"
+    ~title:"Storage limit out of protocol hard bounds"
+    ~description:"A transaction tried to exceed the hard limit on storage"
     empty
     (function Storage_limit_too_high -> Some () | _ -> None)
     (fun () -> Storage_limit_too_high)
@@ -62,50 +63,59 @@ let origination_burn c =
   let origination_size = Constants_storage.origination_size c in
   let cost_per_byte = Constants_storage.cost_per_byte c in
   (* the origination burn, measured in bytes *)
-  Lwt.return
-    Tez_repr.(cost_per_byte *? (Int64.of_int origination_size)) >>=? fun to_be_paid ->
-  return (Raw_context.update_allocated_contracts_count c,
-          to_be_paid)
+  Lwt.return Tez_repr.(cost_per_byte *? Int64.of_int origination_size)
+  >>=? fun to_be_paid ->
+  return (Raw_context.update_allocated_contracts_count c, to_be_paid)
 
 let record_paid_storage_space c contract =
-  Contract_storage.used_storage_space c contract >>=? fun size ->
-  Contract_storage.set_paid_storage_space_and_return_fees_to_pay c contract size >>=? fun (to_be_paid, c) ->
+  Contract_storage.used_storage_space c contract
+  >>=? fun size ->
+  Contract_storage.set_paid_storage_space_and_return_fees_to_pay
+    c
+    contract
+    size
+  >>=? fun (to_be_paid, c) ->
   let c = Raw_context.update_storage_space_to_pay c to_be_paid in
   let cost_per_byte = Constants_storage.cost_per_byte c in
-  Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 to_be_paid))) >>=? fun to_burn ->
-  return (c, size, to_be_paid, to_burn)
+  Lwt.return Tez_repr.(cost_per_byte *? Z.to_int64 to_be_paid)
+  >>=? fun to_burn -> return (c, size, to_be_paid, to_burn)
 
 let burn_storage_fees c ~storage_limit ~payer =
   let origination_size = Constants_storage.origination_size c in
-  let c, storage_space_to_pay, allocated_contracts =
-    Raw_context.clear_storage_space_to_pay c in
+  let (c, storage_space_to_pay, allocated_contracts) =
+    Raw_context.clear_storage_space_to_pay c
+  in
   let storage_space_for_allocated_contracts =
-    Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size) in
+    Z.mul (Z.of_int allocated_contracts) (Z.of_int origination_size)
+  in
   let consumed =
-    Z.add storage_space_to_pay storage_space_for_allocated_contracts in
+    Z.add storage_space_to_pay storage_space_for_allocated_contracts
+  in
   let remaining = Z.sub storage_limit consumed in
-  if Compare.Z.(remaining < Z.zero) then
-    fail Operation_quota_exceeded
+  if Compare.Z.(remaining < Z.zero) then fail Operation_quota_exceeded
   else
     let cost_per_byte = Constants_storage.cost_per_byte c in
-    Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 consumed))) >>=? fun to_burn ->
+    Lwt.return Tez_repr.(cost_per_byte *? Z.to_int64 consumed)
+    >>=? fun to_burn ->
     (* Burning the fees... *)
     if Tez_repr.(to_burn = Tez_repr.zero) then
       (* If the payer was was deleted by transfering all its balance, and no space was used,
          burning zero would fail *)
       return c
     else
-      trace Cannot_pay_storage_fee
-        (Contract_storage.must_exist c payer >>=? fun () ->
-         Contract_storage.spend c payer to_burn) >>=? fun c ->
-      return c
+      trace
+        Cannot_pay_storage_fee
+        ( Contract_storage.must_exist c payer
+        >>=? fun () -> Contract_storage.spend c payer to_burn )
+      >>=? fun c -> return c
 
 let check_storage_limit c ~storage_limit =
-  if Compare.Z.(storage_limit > (Raw_context.constants c).hard_storage_limit_per_operation)
-  || Compare.Z.(storage_limit < Z.zero)then
-    error Storage_limit_too_high
-  else
-    ok ()
+  if
+    Compare.Z.(
+      storage_limit
+      > (Raw_context.constants c).hard_storage_limit_per_operation)
+    || Compare.Z.(storage_limit < Z.zero)
+  then error Storage_limit_too_high
+  else ok ()
 
-let start_counting_storage_fees c =
-  Raw_context.init_storage_space_to_pay c
+let start_counting_storage_fees c = Raw_context.init_storage_space_to_pay c

vendors/ligo-utils/tezos-protocol-alpha/fees_storage.mli

@@ -24,23 +24,27 @@
 (*****************************************************************************)
 
 type error += Cannot_pay_storage_fee (* `Temporary *)
+
 type error += Operation_quota_exceeded (* `Temporary *)
+
 type error += Storage_limit_too_high (* `Permanent *)
 
 (** Does not burn, only adds the burn to storage space to be paid *)
-val origination_burn:
+val origination_burn :
   Raw_context.t -> (Raw_context.t * Tez_repr.t) tzresult Lwt.t
 
 (** The returned Tez quantity is for logging purpose only *)
-val record_paid_storage_space:
-  Raw_context.t -> Contract_repr.t ->
+val record_paid_storage_space :
+  Raw_context.t ->
+  Contract_repr.t ->
   (Raw_context.t * Z.t * Z.t * Tez_repr.t) tzresult Lwt.t
 
-val check_storage_limit:
-  Raw_context.t -> storage_limit:Z.t -> unit tzresult
+val check_storage_limit : Raw_context.t -> storage_limit:Z.t -> unit tzresult
 
-val start_counting_storage_fees :
-  Raw_context.t -> Raw_context.t
+val start_counting_storage_fees : Raw_context.t -> Raw_context.t
 
-val burn_storage_fees:
-  Raw_context.t -> storage_limit:Z.t -> payer:Contract_repr.t -> Raw_context.t tzresult Lwt.t
+val burn_storage_fees :
+  Raw_context.t ->
+  storage_limit:Z.t ->
+  payer:Contract_repr.t ->
+  Raw_context.t tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/fitness_repr.ml

@@ -38,29 +38,25 @@ let () =
 
 let int64_to_bytes i =
   let b = MBytes.create 8 in
-  MBytes.set_int64 b 0 i;
-  b
+  MBytes.set_int64 b 0 i ; b
 
 let int64_of_bytes b =
-  if Compare.Int.(MBytes.length b <> 8) then
-    error Invalid_fitness
-  else
-    ok (MBytes.get_int64 b 0)
+  if Compare.Int.(MBytes.length b <> 8) then error Invalid_fitness
+  else ok (MBytes.get_int64 b 0)
 
 let from_int64 fitness =
-  [ MBytes.of_string Constants_repr.version_number ;
-    int64_to_bytes fitness ]
+  [MBytes.of_string Constants_repr.version_number; int64_to_bytes fitness]
 
 let to_int64 = function
-  | [ version ;
-      fitness ]
-    when Compare.String.
-           (MBytes.to_string version = Constants_repr.version_number) ->
+  | [version; fitness]
+    when Compare.String.(
+           MBytes.to_string version = Constants_repr.version_number) ->
       int64_of_bytes fitness
-  | [ version ;
-      _fitness (* ignored since higher version takes priority *) ]
-    when Compare.String.
-           (MBytes.to_string version = Constants_repr.version_number_004) ->
+  | [version; _fitness (* ignored since higher version takes priority *)]
+    when Compare.String.(
+           MBytes.to_string version = Constants_repr.version_number_004) ->
       ok 0L
-  | [] -> ok 0L
-  | _ -> error Invalid_fitness
+  | [] ->
+      ok 0L
+  | _ ->
+      error Invalid_fitness

vendors/ligo-utils/tezos-protocol-alpha/fitness_storage.ml

@@ -24,6 +24,7 @@
 (*****************************************************************************)
 
 let current = Raw_context.current_fitness
+
 let increase ?(gap = 1) ctxt =
   let fitness = current ctxt in
   Raw_context.set_current_fitness ctxt (Int64.add (Int64.of_int gap) fitness)

vendors/ligo-utils/tezos-protocol-alpha/gas_limit_repr.ml

@@ -23,29 +23,30 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-type t =
-  | Unaccounted
-  | Limited of { remaining : Z.t }
+type t = Unaccounted | Limited of {remaining : Z.t}
 
 type internal_gas = Z.t
 
-type cost =
-  { allocations : Z.t ;
-    steps : Z.t ;
-    reads : Z.t ;
-    writes : Z.t  ;
-    bytes_read : Z.t ;
-    bytes_written : Z.t }
+type cost = {
+  allocations : Z.t;
+  steps : Z.t;
+  reads : Z.t;
+  writes : Z.t;
+  bytes_read : Z.t;
+  bytes_written : Z.t;
+}
 
 let encoding =
   let open Data_encoding in
   union
-    [ case (Tag 0)
+    [ case
+        (Tag 0)
         ~title:"Limited"
         z
-        (function Limited { remaining } -> Some remaining | _ -> None)
-        (fun remaining -> Limited { remaining }) ;
-      case (Tag 1)
+        (function Limited {remaining} -> Some remaining | _ -> None)
+        (fun remaining -> Limited {remaining});
+      case
+        (Tag 1)
         ~title:"Unaccounted"
         (constant "unaccounted")
         (function Unaccounted -> Some () | _ -> None)
@@ -54,16 +55,16 @@ let encoding =
 let pp ppf = function
   | Unaccounted ->
       Format.fprintf ppf "unaccounted"
-  | Limited { remaining } ->
+  | Limited {remaining} ->
       Format.fprintf ppf "%s units remaining" (Z.to_string remaining)
 
 let cost_encoding =
   let open Data_encoding in
   conv
-    (fun { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } ->
-       (allocations, steps, reads, writes, bytes_read, bytes_written))
+    (fun {allocations; steps; reads; writes; bytes_read; bytes_written} ->
+      (allocations, steps, reads, writes, bytes_read, bytes_written))
     (fun (allocations, steps, reads, writes, bytes_read, bytes_written) ->
-       { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written })
+      {allocations; steps; reads; writes; bytes_read; bytes_written})
     (obj6
        (req "allocations" z)
        (req "steps" z)
@@ -72,8 +73,10 @@ let cost_encoding =
        (req "bytes_read" z)
        (req "bytes_written" z))
 
-let pp_cost ppf { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } =
-  Format.fprintf ppf
+let pp_cost ppf {allocations; steps; reads; writes; bytes_read; bytes_written}
+    =
+  Format.fprintf
+    ppf
     "(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))"
     (Z.to_string steps)
     (Z.to_string allocations)
@@ -83,20 +86,27 @@ let pp_cost ppf { allocations ; steps ; reads ; writes ; bytes_read ; bytes_writ
     (Z.to_string bytes_written)
 
 type error += Block_quota_exceeded (* `Temporary *)
+
 type error += Operation_quota_exceeded (* `Temporary *)
 
 let allocation_weight = Z.of_int 2
+
 let step_weight = Z.of_int 1
+
 let read_base_weight = Z.of_int 100
+
 let write_base_weight = Z.of_int 160
+
 let byte_read_weight = Z.of_int 10
+
 let byte_written_weight = Z.of_int 15
 
 let rescaling_bits = 7
-let rescaling_mask =
-  Z.sub (Z.shift_left Z.one rescaling_bits) Z.one
+
+let rescaling_mask = Z.sub (Z.shift_left Z.one rescaling_bits) Z.one
 
 let scale (z : Z.t) = Z.shift_left z rescaling_bits
+
 let rescale (z : Z.t) = Z.shift_right z rescaling_bits
 
 let cost_to_internal_gas (cost : cost) : internal_gas =
@@ -113,30 +123,26 @@ let cost_to_internal_gas (cost : cost) : internal_gas =
           (Z.mul cost.bytes_written byte_written_weight)))
 
 let internal_gas_to_gas internal_gas : Z.t * internal_gas =
-  let gas  = rescale internal_gas in
+  let gas = rescale internal_gas in
   let rest = Z.logand internal_gas rescaling_mask in
   (gas, rest)
 
 let consume block_gas operation_gas internal_gas cost =
   match operation_gas with
-  | Unaccounted -> ok (block_gas, Unaccounted, internal_gas)
-  | Limited { remaining } ->
-      let cost_internal_gas  = cost_to_internal_gas cost in
-      let total_internal_gas =
-        Z.add cost_internal_gas internal_gas in
-      let gas, rest = internal_gas_to_gas total_internal_gas in
+  | Unaccounted ->
+      ok (block_gas, Unaccounted, internal_gas)
+  | Limited {remaining} ->
+      let cost_internal_gas = cost_to_internal_gas cost in
+      let total_internal_gas = Z.add cost_internal_gas internal_gas in
+      let (gas, rest) = internal_gas_to_gas total_internal_gas in
       if Compare.Z.(gas > Z.zero) then
-        let remaining =
-          Z.sub remaining gas in
-        let block_remaining =
-          Z.sub block_gas gas in
-        if Compare.Z.(remaining < Z.zero)
-        then error Operation_quota_exceeded
-        else if Compare.Z.(block_remaining < Z.zero)
-        then error Block_quota_exceeded
-        else ok (block_remaining, Limited { remaining }, rest)
-      else
-        ok (block_gas, operation_gas, total_internal_gas)
+        let remaining = Z.sub remaining gas in
+        let block_remaining = Z.sub block_gas gas in
+        if Compare.Z.(remaining < Z.zero) then error Operation_quota_exceeded
+        else if Compare.Z.(block_remaining < Z.zero) then
+          error Block_quota_exceeded
+        else ok (block_remaining, Limited {remaining}, rest)
+      else ok (block_gas, operation_gas, total_internal_gas)
 
 let check_enough block_gas operation_gas internal_gas cost =
   consume block_gas operation_gas internal_gas cost
@@ -145,97 +151,110 @@ let check_enough block_gas operation_gas internal_gas cost =
 let internal_gas_zero : internal_gas = Z.zero
 
 let alloc_cost n =
-  { allocations = scale (Z.of_int (n + 1)) ;
-    steps = Z.zero ;
-    reads = Z.zero ;
-    writes = Z.zero ;
-    bytes_read = Z.zero ;
-    bytes_written = Z.zero }
+  {
+    allocations = scale (Z.of_int (n + 1));
+    steps = Z.zero;
+    reads = Z.zero;
+    writes = Z.zero;
+    bytes_read = Z.zero;
+    bytes_written = Z.zero;
+  }
 
-let alloc_bytes_cost n =
-  alloc_cost ((n + 7) / 8)
+let alloc_bytes_cost n = alloc_cost ((n + 7) / 8)
 
-let alloc_bits_cost n =
-  alloc_cost ((n + 63) / 64)
+let alloc_bits_cost n = alloc_cost ((n + 63) / 64)
 
 let atomic_step_cost n =
-  { allocations = Z.zero ;
-    steps = Z.of_int (2 * n) ;
-    reads = Z.zero ;
-    writes = Z.zero ;
-    bytes_read = Z.zero ;
-    bytes_written = Z.zero }
+  {
+    allocations = Z.zero;
+    steps = Z.of_int (2 * n);
+    reads = Z.zero;
+    writes = Z.zero;
+    bytes_read = Z.zero;
+    bytes_written = Z.zero;
+  }
 
 let step_cost n =
-  { allocations = Z.zero ;
-    steps = scale (Z.of_int n) ;
-    reads = Z.zero ;
-    writes = Z.zero ;
-    bytes_read = Z.zero ;
-    bytes_written = Z.zero }
+  {
+    allocations = Z.zero;
+    steps = scale (Z.of_int n);
+    reads = Z.zero;
+    writes = Z.zero;
+    bytes_read = Z.zero;
+    bytes_written = Z.zero;
+  }
 
 let free =
-  { allocations = Z.zero ;
-    steps = Z.zero ;
-    reads = Z.zero ;
-    writes = Z.zero ;
-    bytes_read = Z.zero ;
-    bytes_written = Z.zero }
+  {
+    allocations = Z.zero;
+    steps = Z.zero;
+    reads = Z.zero;
+    writes = Z.zero;
+    bytes_read = Z.zero;
+    bytes_written = Z.zero;
+  }
 
 let read_bytes_cost n =
-  { allocations = Z.zero ;
-    steps = Z.zero ;
-    reads = scale Z.one ;
-    writes = Z.zero ;
-    bytes_read = scale n ;
-    bytes_written = Z.zero }
+  {
+    allocations = Z.zero;
+    steps = Z.zero;
+    reads = scale Z.one;
+    writes = Z.zero;
+    bytes_read = scale n;
+    bytes_written = Z.zero;
+  }
 
 let write_bytes_cost n =
-  { allocations = Z.zero ;
-    steps = Z.zero ;
-    reads = Z.zero ;
-    writes = Z.one ;
-    bytes_read = Z.zero ;
-    bytes_written = scale n }
+  {
+    allocations = Z.zero;
+    steps = Z.zero;
+    reads = Z.zero;
+    writes = Z.one;
+    bytes_read = Z.zero;
+    bytes_written = scale n;
+  }
 
 let ( +@ ) x y =
-  { allocations = Z.add x.allocations y.allocations ;
-    steps = Z.add x.steps y.steps ;
-    reads = Z.add x.reads y.reads ;
-    writes = Z.add x.writes y.writes ;
-    bytes_read = Z.add x.bytes_read y.bytes_read ;
-    bytes_written = Z.add x.bytes_written y.bytes_written }
+  {
+    allocations = Z.add x.allocations y.allocations;
+    steps = Z.add x.steps y.steps;
+    reads = Z.add x.reads y.reads;
+    writes = Z.add x.writes y.writes;
+    bytes_read = Z.add x.bytes_read y.bytes_read;
+    bytes_written = Z.add x.bytes_written y.bytes_written;
+  }
 
 let ( *@ ) x y =
-  { allocations = Z.mul (Z.of_int x) y.allocations ;
-    steps = Z.mul (Z.of_int x) y.steps ;
-    reads = Z.mul (Z.of_int x) y.reads ;
-    writes = Z.mul (Z.of_int x) y.writes ;
-    bytes_read = Z.mul (Z.of_int x) y.bytes_read ;
-    bytes_written = Z.mul (Z.of_int x) y.bytes_written }
+  {
+    allocations = Z.mul (Z.of_int x) y.allocations;
+    steps = Z.mul (Z.of_int x) y.steps;
+    reads = Z.mul (Z.of_int x) y.reads;
+    writes = Z.mul (Z.of_int x) y.writes;
+    bytes_read = Z.mul (Z.of_int x) y.bytes_read;
+    bytes_written = Z.mul (Z.of_int x) y.bytes_written;
+  }
 
-let alloc_mbytes_cost n =
-  alloc_cost 12 +@ alloc_bytes_cost n
+let alloc_mbytes_cost n = alloc_cost 12 +@ alloc_bytes_cost n
 
 let () =
   let open Data_encoding in
   register_error_kind
     `Temporary
     ~id:"gas_exhausted.operation"
-    ~title: "Gas quota exceeded for the operation"
+    ~title:"Gas quota exceeded for the operation"
     ~description:
-      "A script or one of its callee took more \
-       time than the operation said it would"
+      "A script or one of its callee took more time than the operation said \
+       it would"
     empty
     (function Operation_quota_exceeded -> Some () | _ -> None)
     (fun () -> Operation_quota_exceeded) ;
   register_error_kind
     `Temporary
     ~id:"gas_exhausted.block"
-    ~title: "Gas quota exceeded for the block"
+    ~title:"Gas quota exceeded for the block"
     ~description:
-      "The sum of gas consumed by all the operations in the block \
-       exceeds the hard gas limit per block"
+      "The sum of gas consumed by all the operations in the block exceeds the \
+       hard gas limit per block"
     empty
     (function Block_quota_exceeded -> Some () | _ -> None)
-    (fun () -> Block_quota_exceeded) ;
+    (fun () -> Block_quota_exceeded)

vendors/ligo-utils/tezos-protocol-alpha/gas_limit_repr.mli

@@ -23,37 +23,49 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-type t =
-  | Unaccounted
-  | Limited of { remaining : Z.t }
+type t = Unaccounted | Limited of {remaining : Z.t}
 
 type internal_gas
 
 val encoding : t Data_encoding.encoding
+
 val pp : Format.formatter -> t -> unit
 
 type cost
 
 val cost_encoding : cost Data_encoding.encoding
+
 val pp_cost : Format.formatter -> cost -> unit
 
 type error += Block_quota_exceeded (* `Temporary *)
+
 type error += Operation_quota_exceeded (* `Temporary *)
 
-val consume : Z.t -> t -> internal_gas -> cost -> (Z.t * t * internal_gas) tzresult
+val consume :
+  Z.t -> t -> internal_gas -> cost -> (Z.t * t * internal_gas) tzresult
+
 val check_enough : Z.t -> t -> internal_gas -> cost -> unit tzresult
 
 val internal_gas_zero : internal_gas
 
 val free : cost
+
 val atomic_step_cost : int -> cost
+
 val step_cost : int -> cost
+
 val alloc_cost : int -> cost
+
 val alloc_bytes_cost : int -> cost
+
 val alloc_mbytes_cost : int -> cost
+
 val alloc_bits_cost : int -> cost
+
 val read_bytes_cost : Z.t -> cost
+
 val write_bytes_cost : Z.t -> cost
 
 val ( *@ ) : int -> cost -> cost
+
 val ( +@ ) : cost -> cost -> cost

vendors/ligo-utils/tezos-protocol-alpha/helpers_services.mli

@@ -27,69 +27,99 @@ open Alpha_context
 
 type error += Cannot_parse_operation (* `Branch *)
 
-val current_level:
-  'a #RPC_context.simple ->
-  ?offset:int32 -> 'a -> Level.t shell_tzresult Lwt.t
+val current_level :
+  'a #RPC_context.simple -> ?offset:int32 -> 'a -> Level.t shell_tzresult Lwt.t
 
-val levels_in_current_cycle:
+val levels_in_current_cycle :
   'a #RPC_context.simple ->
-  ?offset:int32 -> 'a -> (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t
+  ?offset:int32 ->
+  'a ->
+  (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t
 
 module Scripts : sig
-
-  val run_code:
+  val run_code :
     'a #RPC_context.simple ->
-    'a -> Script.expr ->
-    (Script.expr * Script.expr * Tez.t * Chain_id.t * Contract.t option * Contract.t option * Z.t option * string) ->
-    (Script.expr *
-     packed_internal_operation list *
-     Contract.big_map_diff option) shell_tzresult Lwt.t
+    'a ->
+    Script.expr ->
+    Script.expr
+    * Script.expr
+    * Tez.t
+    * Chain_id.t
+    * Contract.t option
+    * Contract.t option
+    * Z.t option
+    * string ->
+    ( Script.expr
+    * packed_internal_operation list
+    * Contract.big_map_diff option )
+    shell_tzresult
+    Lwt.t
 
-  val trace_code:
+  val trace_code :
     'a #RPC_context.simple ->
-    'a -> Script.expr ->
-    (Script.expr * Script.expr * Tez.t * Chain_id.t * Contract.t option * Contract.t option * Z.t option * string) ->
-    (Script.expr *
-     packed_internal_operation list *
-     Script_interpreter.execution_trace *
-     Contract.big_map_diff option) shell_tzresult Lwt.t
+    'a ->
+    Script.expr ->
+    Script.expr
+    * Script.expr
+    * Tez.t
+    * Chain_id.t
+    * Contract.t option
+    * Contract.t option
+    * Z.t option
+    * string ->
+    ( Script.expr
+    * packed_internal_operation list
+    * Script_interpreter.execution_trace
+    * Contract.big_map_diff option )
+    shell_tzresult
+    Lwt.t
 
-  val typecheck_code:
+  val typecheck_code :
     'a #RPC_context.simple ->
-    'a -> (Script.expr * Z.t option) ->
+    'a ->
+    Script.expr * Z.t option ->
     (Script_tc_errors.type_map * Gas.t) shell_tzresult Lwt.t
 
-  val typecheck_data:
+  val typecheck_data :
     'a #RPC_context.simple ->
-    'a -> Script.expr * Script.expr * Z.t option -> Gas.t shell_tzresult Lwt.t
+    'a ->
+    Script.expr * Script.expr * Z.t option ->
+    Gas.t shell_tzresult Lwt.t
 
-  val pack_data:
+  val pack_data :
     'a #RPC_context.simple ->
-    'a -> Script.expr * Script.expr * Z.t option -> (MBytes.t * Gas.t) shell_tzresult Lwt.t
+    'a ->
+    Script.expr * Script.expr * Z.t option ->
+    (MBytes.t * Gas.t) shell_tzresult Lwt.t
 
-  val run_operation:
+  val run_operation :
     'a #RPC_context.simple ->
-    'a -> packed_operation * Chain_id.t ->
-    (packed_protocol_data * Apply_results.packed_operation_metadata) shell_tzresult Lwt.t
+    'a ->
+    packed_operation * Chain_id.t ->
+    (packed_protocol_data * Apply_results.packed_operation_metadata)
+    shell_tzresult
+    Lwt.t
 
-  val entrypoint_type:
+  val entrypoint_type :
     'a #RPC_context.simple ->
-    'a -> Script.expr * string -> Script.expr shell_tzresult Lwt.t
+    'a ->
+    Script.expr * string ->
+    Script.expr shell_tzresult Lwt.t
 
-  val list_entrypoints:
+  val list_entrypoints :
     'a #RPC_context.simple ->
-    'a -> Script.expr ->
-    (Michelson_v1_primitives.prim list list *
-     (string * Script.expr) list) shell_tzresult Lwt.t
-
+    'a ->
+    Script.expr ->
+    (Michelson_v1_primitives.prim list list * (string * Script.expr) list)
+    shell_tzresult
+    Lwt.t
 end
 
 module Forge : sig
-
   module Manager : sig
-
-    val operations:
-      'a #RPC_context.simple -> 'a ->
+    val operations :
+      'a #RPC_context.simple ->
+      'a ->
       branch:Block_hash.t ->
       source:public_key_hash ->
       ?sourcePubKey:public_key ->
@@ -97,19 +127,23 @@ module Forge : sig
       fee:Tez.t ->
       gas_limit:Z.t ->
       storage_limit:Z.t ->
-      packed_manager_operation list -> MBytes.t shell_tzresult Lwt.t
+      packed_manager_operation list ->
+      MBytes.t shell_tzresult Lwt.t
 
-    val reveal:
-      'a #RPC_context.simple -> 'a ->
+    val reveal :
+      'a #RPC_context.simple ->
+      'a ->
       branch:Block_hash.t ->
       source:public_key_hash ->
       sourcePubKey:public_key ->
       counter:counter ->
       fee:Tez.t ->
-      unit -> MBytes.t shell_tzresult Lwt.t
+      unit ->
+      MBytes.t shell_tzresult Lwt.t
 
-    val transaction:
-      'a #RPC_context.simple -> 'a ->
+    val transaction :
+      'a #RPC_context.simple ->
+      'a ->
       branch:Block_hash.t ->
       source:public_key_hash ->
       ?sourcePubKey:public_key ->
@@ -121,24 +155,28 @@ module Forge : sig
       gas_limit:Z.t ->
       storage_limit:Z.t ->
       fee:Tez.t ->
-      unit -> MBytes.t shell_tzresult Lwt.t
+      unit ->
+      MBytes.t shell_tzresult Lwt.t
 
-    val origination:
-      'a #RPC_context.simple -> 'a ->
+    val origination :
+      'a #RPC_context.simple ->
+      'a ->
       branch:Block_hash.t ->
       source:public_key_hash ->
       ?sourcePubKey:public_key ->
       counter:counter ->
       balance:Tez.t ->
-      ?delegatePubKey: public_key_hash ->
+      ?delegatePubKey:public_key_hash ->
       script:Script.t ->
       gas_limit:Z.t ->
       storage_limit:Z.t ->
-      fee:Tez.t->
-      unit -> MBytes.t shell_tzresult Lwt.t
+      fee:Tez.t ->
+      unit ->
+      MBytes.t shell_tzresult Lwt.t
 
-    val delegation:
-      'a #RPC_context.simple -> 'a ->
+    val delegation :
+      'a #RPC_context.simple ->
+      'a ->
       branch:Block_hash.t ->
       source:public_key_hash ->
       ?sourcePubKey:public_key ->
@@ -146,74 +184,88 @@ module Forge : sig
       fee:Tez.t ->
       public_key_hash option ->
       MBytes.t shell_tzresult Lwt.t
-
   end
 
-  val endorsement:
-    'a #RPC_context.simple -> 'a ->
+  val endorsement :
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
     level:Raw_level.t ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
-  val proposals:
-    'a #RPC_context.simple -> 'a ->
+  val proposals :
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
     source:public_key_hash ->
     period:Voting_period.t ->
     proposals:Protocol_hash.t list ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
-  val ballot:
-    'a #RPC_context.simple -> 'a ->
+  val ballot :
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
     source:public_key_hash ->
     period:Voting_period.t ->
     proposal:Protocol_hash.t ->
     ballot:Vote.ballot ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
-  val seed_nonce_revelation:
-    'a #RPC_context.simple -> 'a ->
+  val seed_nonce_revelation :
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
     level:Raw_level.t ->
     nonce:Nonce.t ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
-  val double_baking_evidence:
-    'a #RPC_context.simple -> 'a ->
+  val double_baking_evidence :
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
-    bh1: Block_header.t ->
-    bh2: Block_header.t ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    bh1:Block_header.t ->
+    bh2:Block_header.t ->
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
-  val double_endorsement_evidence:
-    'a #RPC_context.simple -> 'a ->
+  val double_endorsement_evidence :
+    'a #RPC_context.simple ->
+    'a ->
     branch:Block_hash.t ->
-    op1: Kind.endorsement operation ->
-    op2: Kind.endorsement operation ->
-    unit -> MBytes.t shell_tzresult Lwt.t
-
-  val protocol_data:
-    'a #RPC_context.simple -> 'a ->
-    priority: int ->
-    ?seed_nonce_hash: Nonce_hash.t ->
-    ?proof_of_work_nonce: MBytes.t ->
-    unit -> MBytes.t shell_tzresult Lwt.t
+    op1:Kind.endorsement operation ->
+    op2:Kind.endorsement operation ->
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 
+  val protocol_data :
+    'a #RPC_context.simple ->
+    'a ->
+    priority:int ->
+    ?seed_nonce_hash:Nonce_hash.t ->
+    ?proof_of_work_nonce:MBytes.t ->
+    unit ->
+    MBytes.t shell_tzresult Lwt.t
 end
 
 module Parse : sig
-
-  val operations:
-    'a #RPC_context.simple -> 'a ->
-    ?check:bool -> Operation.raw list ->
+  val operations :
+    'a #RPC_context.simple ->
+    'a ->
+    ?check:bool ->
+    Operation.raw list ->
     Operation.packed list shell_tzresult Lwt.t
 
-  val block:
-    'a #RPC_context.simple -> 'a ->
-    Block_header.shell_header -> MBytes.t ->
+  val block :
+    'a #RPC_context.simple ->
+    'a ->
+    Block_header.shell_header ->
+    MBytes.t ->
     Block_header.protocol_data shell_tzresult Lwt.t
-
 end
 
-val register: unit -> unit
+val register : unit -> unit

vendors/ligo-utils/tezos-protocol-alpha/init_storage.ml

@@ -2,7 +2,6 @@
 (*                                                                           *)
 (* Open Source License                                                       *)
 (* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)
-(* Copyright (c) 2019 Nomadic Labs <contact@nomadic-labs.com>                *)
 (*                                                                           *)
 (* Permission is hereby granted, free of charge, to any person obtaining a   *)
 (* copy of this software and associated documentation files (the "Software"),*)
@@ -24,355 +23,36 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-(* Delegated storage changed type of value from Contract_hash to
-   Contract_repr. Move all 'delegated' data into a storage with
-   the original type, then copy over into the new storage. *)
-let migrate_delegated ctxt contract =
-  let path = "contracts" :: (* module Contract *)
-             "index" :: (* module Indexed_context *)
-             Contract_repr.Index.to_path contract [
-               "delegated" ; (* module Delegated *)
-             ] in
-  let path_tmp = "contracts" :: (* module Contract *)
-                 "index" :: (* module Indexed_context *)
-                 Contract_repr.Index.to_path contract [
-                   "delegated_004" ; (* module Delegated *)
-                 ] in
-  Raw_context.dir_mem ctxt path >>= fun exists ->
-  if exists then
-    Raw_context.copy ctxt path path_tmp >>=? fun ctxt ->
-    Raw_context.remove_rec ctxt path >>= fun ctxt ->
-    Storage.Contract.Delegated_004.fold (ctxt, contract) ~init:(Ok ctxt) ~f:(fun delegated ctxt ->
-        Lwt.return ctxt >>=? fun ctxt ->
-        let originated = Contract_repr.originated_contract_004 delegated in
-        Storage.Contract.Delegated.add (ctxt, contract) originated >>= fun ctxt ->
-        return ctxt
-      ) >>=? fun ctxt ->
-    Raw_context.remove_rec ctxt path_tmp >>= fun ctxt ->
-    return ctxt
-  else
-    return ctxt
-
-let transform_script:
-  (manager_pkh: Signature.Public_key_hash.t ->
-   script_code: Script_repr.lazy_expr ->
-   script_storage: Script_repr.lazy_expr ->
-   (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t) ->
-  manager_pkh: Signature.Public_key_hash.t ->
-  Raw_context.t ->
-  Contract_repr.t ->
-  Script_repr.lazy_expr ->
-  Raw_context.t tzresult Lwt.t =
-  fun transformation ~manager_pkh ctxt contract code ->
-  Storage.Contract.Storage.get ctxt contract >>=? fun (_ctxt, storage) ->
-  transformation manager_pkh code storage >>=? fun (migrated_code, migrated_storage) ->
-  (* Set the migrated script code for free *)
-  Storage.Contract.Code.set_free ctxt contract migrated_code >>=? fun (ctxt, code_size_diff) ->
-  (* Set the migrated script storage for free *)
-  Storage.Contract.Storage.set_free ctxt contract migrated_storage >>=? fun (ctxt, storage_size_diff) ->
-  Storage.Contract.Used_storage_space.get ctxt contract >>=? fun used_space ->
-  let total_size = Z.(add (of_int code_size_diff) (add (of_int storage_size_diff) used_space)) in
-  (* Free storage space for migrated contracts *)
-  Storage.Contract.Used_storage_space.set ctxt contract total_size >>=? fun ctxt ->
-  Storage.Contract.Paid_storage_space.get ctxt contract >>=? fun paid_space ->
-  if Compare.Z.(paid_space < total_size) then
-    Storage.Contract.Paid_storage_space.set ctxt contract total_size >>=? fun ctxt ->
-    return ctxt
-  else
-    return ctxt
-
-let manager_script_storage: Signature.Public_key_hash.t -> Script_repr.lazy_expr =
-  fun manager_pkh ->
-  let open Micheline in
-  Script_repr.lazy_expr @@ strip_locations @@
-  (* store in optimized binary representation - as unparsed with [Optimized]. *)
-  let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding manager_pkh in
-  Bytes (0, bytes)
-
-(* If the given contract is not allocated, we'll allocate it with 1 mutez,
-   so that the migrated contracts' managers don't have to pay origination burn *)
-let allocate_contract ctxt contract =
-  Contract_storage.allocated ctxt contract >>=? function
-  | true ->
-      return ctxt
-  | false ->
-      Contract_storage.credit ctxt contract Tez_repr.one_mutez
-
-(* Process an individual contract *)
-let process_contract_add_manager contract ctxt =
-  let open Legacy_script_support_repr in
-  match Contract_repr.is_originated contract with
-  | None -> return ctxt (* Only process originated contracts *)
-  | Some _ -> begin
-      Storage.Contract.Counter.remove ctxt contract >>= fun ctxt ->
-      Storage.Contract.Spendable_004.mem ctxt contract >>= fun is_spendable ->
-      Storage.Contract.Delegatable_004.mem ctxt contract >>= fun is_delegatable ->
-      Storage.Contract.Spendable_004.del ctxt contract >>= fun ctxt ->
-      Storage.Contract.Delegatable_004.del ctxt contract >>= fun ctxt ->
-      (* Try to get script code (ignore ctxt update to discard the initialization) *)
-      Storage.Contract.Code.get_option ctxt contract >>=? fun (_ctxt, code) ->
-      (* Get the manager of the originated contract *)
-      Contract_storage.get_manager_004 ctxt contract >>=? fun manager_pkh ->
-      let manager = Contract_repr.implicit_contract manager_pkh in
-      Storage.Contract.Manager.remove ctxt contract >>= fun ctxt ->
-      match code with
-      | Some code ->
-          (*
-          | spendable | delegatable | template         |
-          |-----------+-------------+------------------|
-          | true      | true        | add_do           |
-          | true      | false       | add_do           |
-          | false     | true        | add_set_delegate |
-          | false     | false       | nothing          |
-          *)
-          if is_spendable then
-            transform_script add_do ~manager_pkh ctxt contract code >>=? fun ctxt ->
-            allocate_contract ctxt manager
-          else if is_delegatable then
-            transform_script add_set_delegate ~manager_pkh ctxt contract code >>=? fun ctxt ->
-            allocate_contract ctxt manager
-          else if has_default_entrypoint code then
-            transform_script
-              (fun ~manager_pkh:_ ~script_code  ~script_storage ->
-                 add_root_entrypoint script_code >>=? fun script_code ->
-                 return (script_code, script_storage))
-              ~manager_pkh ctxt contract code
-          else
-            return ctxt
-      | None -> begin
-          (* Initialize the script code for free *)
-          Storage.Contract.Code.init_free ctxt contract manager_script_code >>=? fun (ctxt, code_size) ->
-          let storage = manager_script_storage manager_pkh in
-          (* Initialize the script storage for free *)
-          Storage.Contract.Storage.init_free ctxt contract storage >>=? fun (ctxt, storage_size) ->
-          let total_size = Z.(add (of_int code_size) (of_int storage_size)) in
-          (* Free storage space for migrated contracts *)
-          Storage.Contract.Paid_storage_space.init_set ctxt contract total_size >>= fun ctxt ->
-          Storage.Contract.Used_storage_space.init_set ctxt contract total_size >>= fun ctxt ->
-          allocate_contract ctxt manager
-        end
-    end
-
-(* The [[update_contract_script]] function returns a copy of its
-   argument (the Micheline AST of a contract script) with "ADDRESS"
-   replaced by "ADDRESS; CHAIN_ID; PAIR".
-
-   [[Micheline.strip_locations]] should be called on the resulting
-   Micheline AST to get meaningful locations. *)
-
-let rec update_contract_script : ('l, 'p) Micheline.node -> ('l, 'p) Micheline.node
-  = function
-    | Micheline.Seq (_,
-                     Micheline.Prim (_, Michelson_v1_primitives.I_ADDRESS, [], []) ::
-                     l) ->
-        Micheline.Seq (0,
-                       Micheline.Prim (0, Michelson_v1_primitives.I_ADDRESS, [], []) ::
-                       Micheline.Prim (0, Michelson_v1_primitives.I_CHAIN_ID, [], []) ::
-                       Micheline.Prim (0, Michelson_v1_primitives.I_PAIR, [], []) :: l)
-    | Micheline.Seq (_, a :: l) ->
-        let a' = update_contract_script a in
-        let b = Micheline.Seq (0, l) in
-        let b' = update_contract_script b in
-        begin match b' with
-          | Micheline.Seq (_, l') ->
-              Micheline.Seq (0, a' :: l')
-          | _ -> assert false
-        end
-    | Micheline.Prim (_, p, l, annot) ->
-        Micheline.Prim (0, p, List.map update_contract_script l, annot)
-    | script -> script
-
-let migrate_multisig_script (ctxt : Raw_context.t) (contract : Contract_repr.t)
-    (code : Script_repr.expr) : Raw_context.t tzresult Lwt.t =
-  let migrated_code =
-    Script_repr.lazy_expr @@ Micheline.strip_locations @@
-    update_contract_script @@ Micheline.root code
-  in
-  Storage.Contract.Code.set_free ctxt contract migrated_code >>=? fun (ctxt, _code_size_diff) ->
-  (* Set the spendable and delegatable flags to false so that no entrypoint gets added by
-     the [[process_contract_add_manager]] function. *)
-  Storage.Contract.Spendable_004.set ctxt contract false >>= fun ctxt ->
-  Storage.Contract.Delegatable_004.set ctxt contract false >>= fun ctxt ->
-  return ctxt
-
-(* The hash of the multisig contract; only contracts with this exact
-   hash are going to be updated by the [[update_contract_script]]
-   function. *)
-let multisig_hash : Script_expr_hash.t =
-  Script_expr_hash.of_bytes_exn @@
-  MBytes.of_hex @@
-  `Hex "475e37a6386d0b85890eb446db1faad67f85fc814724ad07473cac8c0a124b31"
-
-let process_contract_multisig (contract : Contract_repr.t) (ctxt : Raw_context.t) =
-  Contract_storage.get_script ctxt contract >>=? fun (ctxt, script_opt) ->
-  match script_opt with
-  | None ->
-      (* Do nothing on scriptless contracts *)
-      return ctxt
-  | Some { Script_repr.code = code ; Script_repr.storage = _storage } ->
-      (* The contract has some script, only try to modify it if it has
-         the hash of the multisig contract *)
-      Lwt.return (Script_repr.force_decode code) >>=? fun (code, _gas_cost) ->
-      let bytes =
-        Data_encoding.Binary.to_bytes_exn Script_repr.expr_encoding code
-      in
-      let hash = Script_expr_hash.hash_bytes [ bytes ] in
-      if Script_expr_hash.(hash = multisig_hash) then
-        migrate_multisig_script ctxt contract code
-      else
-        return ctxt
-
-(* Process an individual contract *)
-let process_contract contract ctxt =
-  process_contract_multisig contract ctxt >>=? fun ctxt ->
-  process_contract_add_manager contract ctxt >>=? fun ctxt ->
-  return ctxt
-
-let invoice_contract ctxt kt1_addr amount =
-  let amount = Tez_repr.of_mutez_exn (Int64.(mul 1_000_000L (of_int amount))) in
-  match Contract_repr.of_b58check kt1_addr with
-  | Ok recipient -> begin
-      Contract_storage.credit ctxt recipient amount >>= function
-      | Ok ctxt -> return ctxt
-      | Error _ -> return ctxt end
-  | Error _ -> return ctxt
-
-(* Extract Big_maps from their parent contract directory,
-   recompute their used space, and assign them an ID. *)
-let migrate_contract_big_map ctxt contract =
-  Storage.Contract.Code.get_option ctxt contract >>=? function
-  | ctxt, None -> return ctxt
-  | ctxt, Some code ->
-      Storage.Contract.Storage.get ctxt contract >>=? fun (ctxt, storage) ->
-      let extract_big_map_types expr =
-        let open Michelson_v1_primitives in
-        let open Micheline in
-        match Micheline.root expr with
-        | Seq (_, [ Prim (_, K_storage, [ expr ], _) ; _ ; _ ])
-        | Seq (_, [ _ ; Prim (_, K_storage, [ expr ], _) ; _ ])
-        | Seq (_, [ _ ; _ ; Prim (_, K_storage, [ expr ], _) ]) ->
-            begin match expr with
-              | Prim (_, T_pair, [ Prim (_, T_big_map, [ kt ; vt ], _ ) ; _ ], _) -> Some (kt, vt)
-              | _ -> None
-            end
-        | _ -> None in
-      let rewrite_big_map expr id =
-        let open Michelson_v1_primitives in
-        let open Micheline in
-        match Micheline.root expr with
-        | Prim (_, D_Pair, [ Seq (_, _ (* ignore_unused_origination_literal *)) ; pannot ], sannot) ->
-            Micheline.strip_locations (Prim (0, D_Pair, [ Int (0, id) ; pannot ], sannot))
-        | _ -> assert false in
-      Lwt.return (Script_repr.force_decode code) >>=? fun (code, _) ->
-      match extract_big_map_types code with
-      | None -> return ctxt
-      | Some (kt, vt) ->
-          Lwt.return (Script_repr.force_decode storage) >>=? fun (storage, _) ->
-          Storage.Big_map.Next.incr ctxt >>=? fun (ctxt, id) ->
-          let contract_path suffix =
-            "contracts" :: (* module Contract *)
-            "index" :: (* module Indexed_context *)
-            Contract_repr.Index.to_path contract suffix in
-          let old_path = contract_path [ "big_map" ] in
-          let storage = rewrite_big_map storage id in
-          Storage.Contract.Storage.set ctxt contract (Script_repr.lazy_expr storage) >>=? fun (ctxt, _) ->
-          let kt = Micheline.strip_locations (Script_repr.strip_annotations kt) in
-          let vt = Micheline.strip_locations (Script_repr.strip_annotations vt) in
-          Storage.Big_map.Key_type.init ctxt id kt >>=? fun ctxt ->
-          Storage.Big_map.Value_type.init ctxt id vt >>=? fun ctxt ->
-          Raw_context.dir_mem ctxt old_path >>= fun exists ->
-          if exists then
-            let read_size ctxt key =
-              Raw_context.get ctxt key >>=? fun len ->
-              match Data_encoding.(Binary.of_bytes int31) len with
-              | None -> assert false
-              | Some len -> return len in
-            let iter_sizes f (ctxt, acc) =
-              let rec dig i path (ctxt, acc) =
-                if Compare.Int.(i <= 0) then
-                  Raw_context.fold ctxt path ~init:(ok (ctxt, acc)) ~f:begin fun k acc ->
-                    Lwt.return acc >>=? fun (ctxt, acc) ->
-                    match k with
-                    | `Dir _ -> return (ctxt, acc)
-                    | `Key file ->
-                        match List.rev file with
-                        | last :: _ when Compare.String.(last = "data") ->
-                            return (ctxt, acc)
-                        | last :: _ when Compare.String.(last = "len") ->
-                            read_size ctxt file >>=? fun len ->
-                            return (ctxt, f len acc)
-                        | _ -> assert false
-                  end
-                else
-                  Raw_context.fold ctxt path ~init:(ok (ctxt, acc)) ~f:begin fun k acc ->
-                    Lwt.return acc >>=? fun (ctxt, acc) ->
-                    match k with
-                    | `Dir k -> dig (i-1) k (ctxt, acc)
-                    | `Key _ -> return (ctxt, acc)
-                  end in
-              dig Script_expr_hash.path_length old_path (ctxt, acc) in
-            iter_sizes
-              (fun s acc -> (acc |> Z.add (Z.of_int s) |> Z.add (Z.of_int 65)))
-              (ctxt, (Z.of_int 0)) >>=? fun (ctxt, total_bytes) ->
-            Storage.Big_map.Total_bytes.init ctxt id total_bytes >>=? fun ctxt ->
-            let new_path = "big_maps" :: (* module Big_map *)
-                           "index" :: (* module Indexed_context *)
-                           Storage.Big_map.Index.to_path id [
-                             "contents" ; (* module Delegated *)
-                           ] in
-            Raw_context.copy ctxt old_path new_path >>=? fun ctxt ->
-            Raw_context.remove_rec ctxt old_path >>= fun ctxt ->
-            read_size ctxt (contract_path [ "len" ; "code" ]) >>=? fun code_size ->
-            read_size ctxt (contract_path [ "len" ; "storage" ]) >>=? fun storage_size ->
-            let total_bytes =
-              total_bytes |>
-              Z.add (Z.of_int 33) |>
-              Z.add (Z.of_int code_size) |>
-              Z.add (Z.of_int storage_size) in
-            Storage.Contract.Used_storage_space.get ctxt contract >>=? fun previous_size ->
-            Storage.Contract.Paid_storage_space.get ctxt contract >>=? fun paid_bytes ->
-            let change = Z.sub paid_bytes previous_size in
-            Storage.Contract.Used_storage_space.set ctxt contract total_bytes >>=? fun ctxt ->
-            Storage.Contract.Paid_storage_space.set ctxt contract (Z.add total_bytes change)
-          else
-            Storage.Big_map.Total_bytes.init ctxt id Z.zero >>=? fun ctxt ->
-            return ctxt
-
+(* This is the genesis protocol: initialise the state *)
 let prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =
-  Raw_context.prepare_first_block
-    ~level ~timestamp ~fitness ctxt >>=? fun (previous_protocol, ctxt) ->
-  Storage.Big_map.Next.init ctxt >>=? fun ctxt ->
+  Raw_context.prepare_first_block ~level ~timestamp ~fitness ctxt
+  >>=? fun (previous_protocol, ctxt) ->
   match previous_protocol with
   | Genesis param ->
-      Commitment_storage.init ctxt param.commitments >>=? fun ctxt ->
-      Roll_storage.init ctxt >>=? fun ctxt ->
-      Seed_storage.init ctxt >>=? fun ctxt ->
-      Contract_storage.init ctxt >>=? fun ctxt ->
-      Bootstrap_storage.init ctxt
+      Commitment_storage.init ctxt param.commitments
+      >>=? fun ctxt ->
+      Roll_storage.init ctxt
+      >>=? fun ctxt ->
+      Seed_storage.init ctxt
+      >>=? fun ctxt ->
+      Contract_storage.init ctxt
+      >>=? fun ctxt ->
+      Bootstrap_storage.init
+        ctxt
         ~typecheck
         ?ramp_up_cycles:param.security_deposit_ramp_up_cycles
         ?no_reward_cycles:param.no_reward_cycles
         param.bootstrap_accounts
-        param.bootstrap_contracts >>=? fun ctxt ->
-      Roll_storage.init_first_cycles ctxt >>=? fun ctxt ->
-      Vote_storage.init ctxt >>=? fun ctxt ->
-      Storage.Block_priority.init ctxt 0 >>=? fun ctxt ->
-      Vote_storage.freeze_listings ctxt >>=? fun ctxt ->
-      return ctxt
-  | Athens_004 ->
-      Storage.Vote.Current_quorum_004.get ctxt >>=? fun quorum ->
-      Storage.Vote.Participation_ema.init ctxt quorum >>=? fun ctxt ->
-      Storage.Vote.Current_quorum_004.delete ctxt >>=? fun ctxt ->
-      Storage.Block_priority.init ctxt 0 >>=? fun ctxt ->
-      Storage.Last_block_priority.delete ctxt >>=? fun ctxt ->
-      Storage.Contract.fold ctxt ~init:(Ok ctxt)
-        ~f:(fun contract ctxt ->
-            Lwt.return ctxt >>=? fun ctxt ->
-            migrate_delegated ctxt contract >>=? fun ctxt ->
-            migrate_contract_big_map ctxt contract >>=? fun ctxt ->
-            process_contract contract ctxt)
+        param.bootstrap_contracts
       >>=? fun ctxt ->
-      invoice_contract ctxt "KT1DUfaMfTRZZkvZAYQT5b3byXnvqoAykc43" 500 >>=? fun ctxt ->
+      Roll_storage.init_first_cycles ctxt
+      >>=? fun ctxt ->
+      Vote_storage.init ctxt
+      >>=? fun ctxt ->
+      Storage.Block_priority.init ctxt 0
+      >>=? fun ctxt ->
+      Vote_storage.freeze_listings ctxt >>=? fun ctxt -> return ctxt
+  | Babylon_005 ->
       return ctxt
 
 let prepare ctxt ~level ~predecessor_timestamp ~timestamp ~fitness =

vendors/ligo-utils/tezos-protocol-alpha/legacy_script_support_repr.mli

@@ -31,7 +31,7 @@
     https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/manager.tz
     The formal proof is at:
     https://gitlab.com/nomadic-labs/mi-cho-coq/blob/a7603e12021166e15890f6d504feebec2f945502/src/contracts_coq/manager.v *)
-val manager_script_code: Script_repr.lazy_expr
+val manager_script_code : Script_repr.lazy_expr
 
 (** This code mimics the now defunct "spendable" flags of KT1s by
     adding a [do] entrypoint, preserving the original script's at
@@ -39,10 +39,10 @@ val manager_script_code: Script_repr.lazy_expr
 
     The pseudo-code for the applied transformations is from:
     https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/transform/add_do.tz *)
-val add_do:
-  manager_pkh: Signature.Public_key_hash.t ->
-  script_code: Script_repr.lazy_expr ->
-  script_storage: Script_repr.lazy_expr ->
+val add_do :
+  manager_pkh:Signature.Public_key_hash.t ->
+  script_code:Script_repr.lazy_expr ->
+  script_storage:Script_repr.lazy_expr ->
   (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t
 
 (** This code mimics the now defunct "spendable" flags of KT1s by
@@ -51,19 +51,17 @@ val add_do:
 
     The pseudo-code for the applied transformations is from:
     https://gitlab.com/nomadic-labs/mi-cho-coq/blob/7b42f2e970e1541af54f8a9b6820b4f18e847575/src/contracts/transform/add_set_delegate.tz *)
-val add_set_delegate:
-  manager_pkh: Signature.Public_key_hash.t ->
-  script_code: Script_repr.lazy_expr ->
-  script_storage: Script_repr.lazy_expr ->
+val add_set_delegate :
+  manager_pkh:Signature.Public_key_hash.t ->
+  script_code:Script_repr.lazy_expr ->
+  script_storage:Script_repr.lazy_expr ->
   (Script_repr.lazy_expr * Script_repr.lazy_expr) tzresult Lwt.t
 
 (** Checks if a contract was declaring a default entrypoint somewhere
    else than at the root, in which case its type changes when
    entrypoints are activated. *)
-val has_default_entrypoint:
-  Script_repr.lazy_expr -> bool
+val has_default_entrypoint : Script_repr.lazy_expr -> bool
 
 (** Adds a [%root] annotation on the toplevel parameter construct. *)
-val add_root_entrypoint:
-  script_code: Script_repr.lazy_expr ->
-  Script_repr.lazy_expr tzresult Lwt.t
+val add_root_entrypoint :
+  script_code:Script_repr.lazy_expr -> Script_repr.lazy_expr tzresult Lwt.t

vendors/ligo-utils/tezos-protocol-alpha/level_repr.ml

@@ -24,125 +24,162 @@
 (*****************************************************************************)
 
 type t = {
-  level: Raw_level_repr.t ;
-  level_position: int32 ;
-  cycle: Cycle_repr.t ;
-  cycle_position: int32 ;
-  voting_period: Voting_period_repr.t ;
-  voting_period_position: int32 ;
-  expected_commitment: bool ;
+  level : Raw_level_repr.t;
+  level_position : int32;
+  cycle : Cycle_repr.t;
+  cycle_position : int32;
+  voting_period : Voting_period_repr.t;
+  voting_period_position : int32;
+  expected_commitment : bool;
 }
 
-include Compare.Make(struct
-    type nonrec t = t
-    let compare { level = l1 } { level = l2 } = Raw_level_repr.compare l1 l2
-  end)
+include Compare.Make (struct
+  type nonrec t = t
+
+  let compare {level = l1} {level = l2} = Raw_level_repr.compare l1 l2
+end)
 
 type level = t
 
-let pp ppf { level } = Raw_level_repr.pp ppf level
+let pp ppf {level} = Raw_level_repr.pp ppf level
 
 let pp_full ppf l =
-  Format.fprintf ppf
+  Format.fprintf
+    ppf
     "%a.%ld (cycle %a.%ld) (vote %a.%ld)"
-    Raw_level_repr.pp l.level l.level_position
-    Cycle_repr.pp l.cycle l.cycle_position
-    Voting_period_repr.pp l.voting_period l.voting_period_position
+    Raw_level_repr.pp
+    l.level
+    l.level_position
+    Cycle_repr.pp
+    l.cycle
+    l.cycle_position
+    Voting_period_repr.pp
+    l.voting_period
+    l.voting_period_position
 
 let encoding =
   let open Data_encoding in
   conv
-    (fun { level ; level_position ;
-           cycle ; cycle_position ;
-           voting_period; voting_period_position ;
+    (fun { level;
+           level_position;
+           cycle;
+           cycle_position;
+           voting_period;
+           voting_period_position;
            expected_commitment } ->
-      (level, level_position,
-       cycle, cycle_position,
-       voting_period, voting_period_position,
-       expected_commitment))
-    (fun (level, level_position,
-          cycle, cycle_position,
-          voting_period, voting_period_position,
-          expected_commitment) ->
-      { level ; level_position ;
-        cycle ; cycle_position ;
-        voting_period ; voting_period_position ;
-        expected_commitment })
+      ( level,
+        level_position,
+        cycle,
+        cycle_position,
+        voting_period,
+        voting_period_position,
+        expected_commitment ))
+    (fun ( level,
+           level_position,
+           cycle,
+           cycle_position,
+           voting_period,
+           voting_period_position,
+           expected_commitment ) ->
+      {
+        level;
+        level_position;
+        cycle;
+        cycle_position;
+        voting_period;
+        voting_period_position;
+        expected_commitment;
+      })
     (obj7
-       (req "level"
+       (req
+          "level"
           ~description:
-            "The level of the block relative to genesis. This is also \
-             the Shell's notion of level"
+            "The level of the block relative to genesis. This is also the \
+             Shell's notion of level"
           Raw_level_repr.encoding)
-       (req "level_position"
+       (req
+          "level_position"
           ~description:
             "The level of the block relative to the block that starts \
-             protocol alpha. This is specific to the protocol \
-             alpha. Other protocols might or might not include a \
-             similar notion."
+             protocol alpha. This is specific to the protocol alpha. Other \
+             protocols might or might not include a similar notion."
           int32)
-       (req "cycle"
+       (req
+          "cycle"
           ~description:
             "The current cycle's number. Note that cycles are a \
-             protocol-specific notion. As a result, the cycle number starts at 0 \
-             with the first block of protocol alpha."
+             protocol-specific notion. As a result, the cycle number starts \
+             at 0 with the first block of protocol alpha."
           Cycle_repr.encoding)
-       (req "cycle_position"
+       (req
+          "cycle_position"
           ~description:
-            "The current level of the block relative to the first \
-             block of the current cycle."
+            "The current level of the block relative to the first block of \
+             the current cycle."
           int32)
-       (req "voting_period"
+       (req
+          "voting_period"
           ~description:
             "The current voting period's index. Note that cycles are a \
-             protocol-specific notion. As a result, the voting period \
-             index starts at 0 with the first block of protocol alpha."
+             protocol-specific notion. As a result, the voting period index \
+             starts at 0 with the first block of protocol alpha."
           Voting_period_repr.encoding)
-       (req "voting_period_position"
+       (req
+          "voting_period_position"
           ~description:
-            "The current level of the block relative to the first \
-             block of the current voting period."
+            "The current level of the block relative to the first block of \
+             the current voting period."
           int32)
-       (req "expected_commitment"
+       (req
+          "expected_commitment"
           ~description:
-            "Tells wether the baker of this block has to commit a seed \
-             nonce hash."
+            "Tells wether the baker of this block has to commit a seed nonce \
+             hash."
           bool))
 
 let root first_level =
-  { level = first_level ;
-    level_position = 0l ;
-    cycle = Cycle_repr.root ;
-    cycle_position = 0l ;
-    voting_period = Voting_period_repr.root ;
-    voting_period_position = 0l ;
-    expected_commitment = false ;
+  {
+    level = first_level;
+    level_position = 0l;
+    cycle = Cycle_repr.root;
+    cycle_position = 0l;
+    voting_period = Voting_period_repr.root;
+    voting_period_position = 0l;
+    expected_commitment = false;
   }
 
-let from_raw
-    ~first_level ~blocks_per_cycle ~blocks_per_voting_period
-    ~blocks_per_commitment
-    level =
+let from_raw ~first_level ~blocks_per_cycle ~blocks_per_voting_period
+    ~blocks_per_commitment level =
   let raw_level = Raw_level_repr.to_int32 level in
   let first_level = Raw_level_repr.to_int32 first_level in
   let level_position =
-    Compare.Int32.max 0l (Int32.sub raw_level first_level) in
+    Compare.Int32.max 0l (Int32.sub raw_level first_level)
+  in
   let cycle =
-    Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle) in
+    Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle)
+  in
   let cycle_position = Int32.rem level_position blocks_per_cycle in
   let voting_period =
     Voting_period_repr.of_int32_exn
-      (Int32.div level_position blocks_per_voting_period) in
+      (Int32.div level_position blocks_per_voting_period)
+  in
   let voting_period_position =
-    Int32.rem level_position blocks_per_voting_period in
+    Int32.rem level_position blocks_per_voting_period
+  in
   let expected_commitment =
-    Compare.Int32.(Int32.rem cycle_position blocks_per_commitment =
-                   Int32.pred blocks_per_commitment) in
-  { level ; level_position ;
-    cycle ; cycle_position ;
-    voting_period ; voting_period_position ;
-    expected_commitment }
+    Compare.Int32.(
+      Int32.rem cycle_position blocks_per_commitment
+      = Int32.pred blocks_per_commitment)
+  in
+  {
+    level;
+    level_position;
+    cycle;
+    cycle_position;
+    voting_period;
+    voting_period_position;
+    expected_commitment;
+  }
 
-let diff { level = l1 ; _ } { level = l2 ; _ } =
+let diff {level = l1; _} {level = l2; _} =
   Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2)
-

vendors/ligo-utils/tezos-protocol-alpha/level_repr.mli

@@ -24,21 +24,25 @@
 (*****************************************************************************)
 
 type t = private {
-  level: Raw_level_repr.t (** The level of the block relative to genesis. This
-                              is also the Shell's notion of level. *);
-  level_position: int32 (** The level of the block relative to the block that
+  level : Raw_level_repr.t;
+      (** The level of the block relative to genesis. This
+                              is also the Shell's notion of level. *)
+  level_position : int32;
+      (** The level of the block relative to the block that
                             starts protocol alpha. This is specific to the
                             protocol alpha. Other protocols might or might not
-                            include a similar notion. *);
-  cycle: Cycle_repr.t (** The current cycle's number. Note that cycles are a
+                            include a similar notion. *)
+  cycle : Cycle_repr.t;
+      (** The current cycle's number. Note that cycles are a
                           protocol-specific notion. As a result, the cycle
                           number starts at 0 with the first block of protocol
-                          alpha. *);
-  cycle_position: int32 (** The current level of the block relative to the first
-                            block of the current cycle. *);
-  voting_period: Voting_period_repr.t ;
-  voting_period_position: int32 ;
-  expected_commitment: bool ;
+                          alpha. *)
+  cycle_position : int32;
+      (** The current level of the block relative to the first
+                            block of the current cycle. *)
+  voting_period : Voting_period_repr.t;
+  voting_period_position : int32;
+  expected_commitment : bool;
 }
 
 (* Note that, the type `t` above must respect some invariants (hence the
@@ -47,23 +51,24 @@ type t = private {
    level_position = cycle * blocks_per_cycle + cycle_position
 *)
 
-
-
 type level = t
 
 include Compare.S with type t := level
 
-val encoding: level Data_encoding.t
-val pp: Format.formatter -> level -> unit
-val pp_full: Format.formatter -> level -> unit
+val encoding : level Data_encoding.t
 
-val root: Raw_level_repr.t -> level
+val pp : Format.formatter -> level -> unit
 
-val from_raw:
+val pp_full : Format.formatter -> level -> unit
+
+val root : Raw_level_repr.t -> level
+
+val from_raw :
   first_level:Raw_level_repr.t ->
   blocks_per_cycle:int32 ->
   blocks_per_voting_period:int32 ->
   blocks_per_commitment:int32 ->
-  Raw_level_repr.t -> level
+  Raw_level_repr.t ->
+  level
 
-val diff: level -> level -> int32
+val diff : level -> level -> int32

vendors/ligo-utils/tezos-protocol-alpha/level_storage.ml

@@ -28,8 +28,11 @@ open Level_repr
 let from_raw c ?offset l =
   let l =
     match offset with
-    | None -> l
-    | Some o -> Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o)) in
+    | None ->
+        l
+    | Some o ->
+        Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o))
+  in
   let constants = Raw_context.constants c in
   let first_level = Raw_context.first_level c in
   Level_repr.from_raw
@@ -39,27 +42,32 @@ let from_raw c ?offset l =
     ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment
     l
 
-let root c =
-  Level_repr.root (Raw_context.first_level c)
+let root c = Level_repr.root (Raw_context.first_level c)
 
 let succ c l = from_raw c (Raw_level_repr.succ l.level)
+
 let pred c l =
   match Raw_level_repr.pred l.Level_repr.level with
-  | None -> None
-  | Some l -> Some (from_raw c l)
+  | None ->
+      None
+  | Some l ->
+      Some (from_raw c l)
 
 let current ctxt = Raw_context.current_level ctxt
 
 let previous ctxt =
   let l = current ctxt in
   match pred ctxt l with
-  | None -> assert false (* We never validate the Genesis... *)
-  | Some p -> p
+  | None ->
+      assert false (* We never validate the Genesis... *)
+  | Some p ->
+      p
 
 let first_level_in_cycle ctxt c =
   let constants = Raw_context.constants ctxt in
   let first_level = Raw_context.first_level ctxt in
-  from_raw ctxt
+  from_raw
+    ctxt
     (Raw_level_repr.of_int32_exn
        (Int32.add
           (Raw_level_repr.to_int32 first_level)
@@ -69,14 +77,15 @@ let first_level_in_cycle ctxt c =
 
 let last_level_in_cycle ctxt c =
   match pred ctxt (first_level_in_cycle ctxt (Cycle_repr.succ c)) with
-  | None -> assert false
-  | Some x -> x
+  | None ->
+      assert false
+  | Some x ->
+      x
 
 let levels_in_cycle ctxt cycle =
   let first = first_level_in_cycle ctxt cycle in
   let rec loop n acc =
-    if Cycle_repr.(n.cycle = first.cycle)
-    then loop (succ ctxt n) (n :: acc)
+    if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc)
     else acc
   in
   loop first []
@@ -84,8 +93,7 @@ let levels_in_cycle ctxt cycle =
 let levels_in_current_cycle ctxt ?(offset = 0l) () =
   let current_cycle = Cycle_repr.to_int32 (current ctxt).cycle in
   let cycle = Int32.add current_cycle offset in
-  if Compare.Int32.(cycle < 0l) then
-    []
+  if Compare.Int32.(cycle < 0l) then []
   else
     let cycle = Cycle_repr.of_int32_exn cycle in
     levels_in_cycle ctxt cycle
@@ -93,20 +101,18 @@ let levels_in_current_cycle ctxt ?(offset = 0l) () =
 let levels_with_commitments_in_cycle ctxt c =
   let first = first_level_in_cycle ctxt c in
   let rec loop n acc =
-    if Cycle_repr.(n.cycle = first.cycle)
-    then
-      if n.expected_commitment then
-        loop (succ ctxt n) (n :: acc)
-      else
-        loop (succ ctxt n) acc
+    if Cycle_repr.(n.cycle = first.cycle) then
+      if n.expected_commitment then loop (succ ctxt n) (n :: acc)
+      else loop (succ ctxt n) acc
     else acc
   in
   loop first []
 
-
 let last_allowed_fork_level c =
   let level = Raw_context.current_level c in
   let preserved_cycles = Constants_storage.preserved_cycles c in
   match Cycle_repr.sub level.cycle preserved_cycles with
-  | None -> Raw_level_repr.root
-  | Some cycle -> (first_level_in_cycle c cycle).level
+  | None ->
+      Raw_level_repr.root
+  | Some cycle ->
+      (first_level_in_cycle c cycle).level

vendors/ligo-utils/tezos-protocol-alpha/level_storage.mli

@@ -23,22 +23,29 @@
 (*                                                                           *)
 (*****************************************************************************)
 
-val current: Raw_context.t -> Level_repr.t
-val previous: Raw_context.t -> Level_repr.t
+val current : Raw_context.t -> Level_repr.t
 
-val root: Raw_context.t -> Level_repr.t
+val previous : Raw_context.t -> Level_repr.t
 
-val from_raw: Raw_context.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t
-val pred: Raw_context.t -> Level_repr.t -> Level_repr.t option
-val succ: Raw_context.t -> Level_repr.t -> Level_repr.t
+val root : Raw_context.t -> Level_repr.t
 
-val first_level_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t
-val last_level_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t
-val levels_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t list
-val levels_in_current_cycle:
+val from_raw :
+  Raw_context.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t
+
+val pred : Raw_context.t -> Level_repr.t -> Level_repr.t option
+
+val succ : Raw_context.t -> Level_repr.t -> Level_repr.t
+
+val first_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t
+
+val last_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t
+
+val levels_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t list
+
+val levels_in_current_cycle :
   Raw_context.t -> ?offset:int32 -> unit -> Level_repr.t list
 
-val levels_with_commitments_in_cycle:
+val levels_with_commitments_in_cycle :
   Raw_context.t -> Cycle_repr.t -> Level_repr.t list
 
-val last_allowed_fork_level: Raw_context.t -> Raw_level_repr.t
+val last_allowed_fork_level : Raw_context.t -> Raw_level_repr.t

vendors/ligo-utils/tezos-protocol-alpha/main.ml

@@ -26,51 +26,66 @@
 (* Tezos Protocol Implementation - Protocol Signature Instance *)
 
 type block_header_data = Alpha_context.Block_header.protocol_data
+
 type block_header = Alpha_context.Block_header.t = {
-  shell: Block_header.shell_header ;
-  protocol_data: block_header_data ;
+  shell : Block_header.shell_header;
+  protocol_data : block_header_data;
 }
 
-let block_header_data_encoding = Alpha_context.Block_header.protocol_data_encoding
+let block_header_data_encoding =
+  Alpha_context.Block_header.protocol_data_encoding
 
 type block_header_metadata = Apply_results.block_metadata
+
 let block_header_metadata_encoding = Apply_results.block_metadata_encoding
 
 type operation_data = Alpha_context.packed_protocol_data =
-  | Operation_data : 'kind Alpha_context.Operation.protocol_data -> operation_data
+  | Operation_data :
+      'kind Alpha_context.Operation.protocol_data
+      -> operation_data
+
 let operation_data_encoding = Alpha_context.Operation.protocol_data_encoding
 
 type operation_receipt = Apply_results.packed_operation_metadata =
-  | Operation_metadata : 'kind Apply_results.operation_metadata -> operation_receipt
-  | No_operation_metadata: operation_receipt
-let operation_receipt_encoding =
-  Apply_results.operation_metadata_encoding
+  | Operation_metadata :
+      'kind Apply_results.operation_metadata
+      -> operation_receipt
+  | No_operation_metadata : operation_receipt
+
+let operation_receipt_encoding = Apply_results.operation_metadata_encoding
 
 let operation_data_and_receipt_encoding =
   Apply_results.operation_data_and_metadata_encoding
 
 type operation = Alpha_context.packed_operation = {
-  shell: Operation.shell_header ;
-  protocol_data: operation_data ;
+  shell : Operation.shell_header;
+  protocol_data : operation_data;
 }
 
 let acceptable_passes = Alpha_context.Operation.acceptable_passes
 
-let max_block_length =
-  Alpha_context.Block_header.max_header_length
+let max_block_length = Alpha_context.Block_header.max_header_length
 
 let max_operation_data_length =
   Alpha_context.Constants.max_operation_data_length
 
 let validation_passes =
   let max_anonymous_operations =
-    Alpha_context.Constants.max_revelations_per_block +
-    (* allow 100 wallet activations or denunciations per block *) 100 in
-  Updater.[ { max_size = 32 * 1024 ; max_op = Some 32 } ; (* 32 endorsements *)
-            { max_size = 32 * 1024 ; max_op = None } ; (* 32k of voting operations *)
-            { max_size = max_anonymous_operations * 1024 ;
-              max_op = Some max_anonymous_operations } ;
-            { max_size = 512 * 1024 ; max_op = None } ] (* 512kB *)
+    Alpha_context.Constants.max_revelations_per_block
+    + (* allow 100 wallet activations or denunciations per block *) 100
+  in
+  Updater.
+    [ {max_size = 32 * 1024; max_op = Some 32};
+      (* 32 endorsements *)
+      {max_size = 32 * 1024; max_op = None};
+      (* 32k of voting operations *)
+      {
+        max_size = max_anonymous_operations * 1024;
+        max_op = Some max_anonymous_operations;
+      };
+      {max_size = 512 * 1024; max_op = None} ]
+
+(* 512kB *)
 
 let rpc_services =
   Alpha_services.register () ;
@@ -78,168 +93,186 @@ let rpc_services =
 
 type validation_mode =
   | Application of {
-      block_header : Alpha_context.Block_header.t ;
-      baker : Alpha_context.public_key_hash ;
-      block_delay : Alpha_context.Period.t ;
+      block_header : Alpha_context.Block_header.t;
+      baker : Alpha_context.public_key_hash;
+      block_delay : Alpha_context.Period.t;
     }
   | Partial_application of {
-      block_header : Alpha_context.Block_header.t ;
-      baker : Alpha_context.public_key_hash ;
-      block_delay : Alpha_context.Period.t ;
-    }
-  | Partial_construction of {
-      predecessor : Block_hash.t ;
+      block_header : Alpha_context.Block_header.t;
+      baker : Alpha_context.public_key_hash;
+      block_delay : Alpha_context.Period.t;
     }
+  | Partial_construction of {predecessor : Block_hash.t}
   | Full_construction of {
-      predecessor : Block_hash.t ;
-      protocol_data : Alpha_context.Block_header.contents ;
-      baker : Alpha_context.public_key_hash ;
-      block_delay : Alpha_context.Period.t ;
+      predecessor : Block_hash.t;
+      protocol_data : Alpha_context.Block_header.contents;
+      baker : Alpha_context.public_key_hash;
+      block_delay : Alpha_context.Period.t;
     }
 
-type validation_state =
-  { mode : validation_mode ;
-    chain_id : Chain_id.t ;
-    ctxt : Alpha_context.t ;
-    op_count : int ;
-  }
+type validation_state = {
+  mode : validation_mode;
+  chain_id : Chain_id.t;
+  ctxt : Alpha_context.t;
+  op_count : int;
+}
 
-let current_context { ctxt ; _ } =
-  return (Alpha_context.finalize ctxt).context
+let current_context {ctxt; _} = return (Alpha_context.finalize ctxt).context
 
-let begin_partial_application
-    ~chain_id
-    ~ancestor_context:ctxt
-    ~predecessor_timestamp
-    ~predecessor_fitness
+let begin_partial_application ~chain_id ~ancestor_context:ctxt
+    ~predecessor_timestamp ~predecessor_fitness
     (block_header : Alpha_context.Block_header.t) =
   let level = block_header.shell.level in
   let fitness = predecessor_fitness in
   let timestamp = block_header.shell.timestamp in
-  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt ->
-  Apply.begin_application
-    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker, block_delay) ->
+  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
+  >>=? fun ctxt ->
+  Apply.begin_application ctxt chain_id block_header predecessor_timestamp
+  >>=? fun (ctxt, baker, block_delay) ->
   let mode =
     Partial_application
-      { block_header ; baker = Signature.Public_key.hash baker ; block_delay } in
-  return { mode ; chain_id ; ctxt ; op_count = 0 }
+      {block_header; baker = Signature.Public_key.hash baker; block_delay}
+  in
+  return {mode; chain_id; ctxt; op_count = 0}
 
-let begin_application
-    ~chain_id
-    ~predecessor_context:ctxt
-    ~predecessor_timestamp
-    ~predecessor_fitness
+let begin_application ~chain_id ~predecessor_context:ctxt
+    ~predecessor_timestamp ~predecessor_fitness
     (block_header : Alpha_context.Block_header.t) =
   let level = block_header.shell.level in
   let fitness = predecessor_fitness in
   let timestamp = block_header.shell.timestamp in
-  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt ->
-  Apply.begin_application
-    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker, block_delay) ->
+  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
+  >>=? fun ctxt ->
+  Apply.begin_application ctxt chain_id block_header predecessor_timestamp
+  >>=? fun (ctxt, baker, block_delay) ->
   let mode =
-    Application { block_header ; baker = Signature.Public_key.hash baker ; block_delay } in
-  return { mode ; chain_id ; ctxt ; op_count = 0 }
+    Application
+      {block_header; baker = Signature.Public_key.hash baker; block_delay}
+  in
+  return {mode; chain_id; ctxt; op_count = 0}
 
-let begin_construction
-    ~chain_id
-    ~predecessor_context:ctxt
-    ~predecessor_timestamp
-    ~predecessor_level:pred_level
-    ~predecessor_fitness:pred_fitness
-    ~predecessor
-    ~timestamp
-    ?(protocol_data : block_header_data option)
-    () =
+let begin_construction ~chain_id ~predecessor_context:ctxt
+    ~predecessor_timestamp ~predecessor_level:pred_level
+    ~predecessor_fitness:pred_fitness ~predecessor ~timestamp
+    ?(protocol_data : block_header_data option) () =
   let level = Int32.succ pred_level in
   let fitness = pred_fitness in
-  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt >>=? fun ctxt ->
-  begin
-    match protocol_data with
-    | None ->
-        Apply.begin_partial_construction ctxt >>=? fun ctxt ->
-        let mode = Partial_construction { predecessor } in
-        return (mode, ctxt)
-    | Some proto_header ->
-        Apply.begin_full_construction
-          ctxt predecessor_timestamp
-          proto_header.contents >>=? fun (ctxt, protocol_data, baker, block_delay) ->
-        let mode =
-          let baker = Signature.Public_key.hash baker in
-          Full_construction { predecessor ; baker ; protocol_data ; block_delay } in
-        return (mode, ctxt)
-  end >>=? fun (mode, ctxt) ->
-  return { mode ; chain_id ; ctxt ; op_count = 0 }
+  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ~fitness ctxt
+  >>=? fun ctxt ->
+  ( match protocol_data with
+  | None ->
+      Apply.begin_partial_construction ctxt
+      >>=? fun ctxt ->
+      let mode = Partial_construction {predecessor} in
+      return (mode, ctxt)
+  | Some proto_header ->
+      Apply.begin_full_construction
+        ctxt
+        predecessor_timestamp
+        proto_header.contents
+      >>=? fun (ctxt, protocol_data, baker, block_delay) ->
+      let mode =
+        let baker = Signature.Public_key.hash baker in
+        Full_construction {predecessor; baker; protocol_data; block_delay}
+      in
+      return (mode, ctxt) )
+  >>=? fun (mode, ctxt) -> return {mode; chain_id; ctxt; op_count = 0}
 
-let apply_operation
-    ({ mode ; chain_id ; ctxt ; op_count ; _ } as data)
+let apply_operation ({mode; chain_id; ctxt; op_count; _} as data)
     (operation : Alpha_context.packed_operation) =
   match mode with
-  | Partial_application _ when
-      not (List.exists
-             (Compare.Int.equal 0)
-             (Alpha_context.Operation.acceptable_passes operation)) ->
+  | Partial_application _
+    when not
+           (List.exists
+              (Compare.Int.equal 0)
+              (Alpha_context.Operation.acceptable_passes operation)) ->
       (* Multipass validation only considers operations in pass 0. *)
       let op_count = op_count + 1 in
-      return ({ data with ctxt ; op_count }, No_operation_metadata)
+      return ({data with ctxt; op_count}, No_operation_metadata)
   | _ ->
-      let { shell ; protocol_data = Operation_data protocol_data } = operation in
-      let operation : _ Alpha_context.operation = { shell ; protocol_data } in
-      let predecessor, baker =
+      let {shell; protocol_data = Operation_data protocol_data} = operation in
+      let operation : _ Alpha_context.operation = {shell; protocol_data} in
+      let (predecessor, baker) =
         match mode with
         | Partial_application
-            { block_header = { shell = { predecessor ; _ } ; _ } ; baker }
-        | Application
-            { block_header = { shell = { predecessor ; _ } ; _ } ; baker }
-        | Full_construction { predecessor ; baker ; _ }
-          -> predecessor, baker
-        | Partial_construction { predecessor }
-          -> predecessor, Signature.Public_key_hash.zero
+            {block_header = {shell = {predecessor; _}; _}; baker}
+        | Application {block_header = {shell = {predecessor; _}; _}; baker}
+        | Full_construction {predecessor; baker; _} ->
+            (predecessor, baker)
+        | Partial_construction {predecessor} ->
+            (predecessor, Signature.Public_key_hash.zero)
       in
-      Apply.apply_operation ctxt chain_id Optimized predecessor baker
+      Apply.apply_operation
+        ctxt
+        chain_id
+        Optimized
+        predecessor
+        baker
         (Alpha_context.Operation.hash operation)
-        operation >>=? fun (ctxt, result) ->
+        operation
+      >>=? fun (ctxt, result) ->
       let op_count = op_count + 1 in
-      return ({ data with ctxt ; op_count }, Operation_metadata result)
+      return ({data with ctxt; op_count}, Operation_metadata result)
 
-let finalize_block { mode ; ctxt ; op_count } =
+let finalize_block {mode; ctxt; op_count} =
   match mode with
   | Partial_construction _ ->
       let level = Alpha_context.Level.current ctxt in
-      Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
+      Alpha_context.Vote.get_current_period_kind ctxt
+      >>=? fun voting_period_kind ->
       let baker = Signature.Public_key_hash.zero in
       Signature.Public_key_hash.Map.fold
         (fun delegate deposit ctxt ->
-           ctxt >>=? fun ctxt ->
-           Alpha_context.Delegate.freeze_deposit ctxt delegate deposit)
+          ctxt
+          >>=? fun ctxt ->
+          Alpha_context.Delegate.freeze_deposit ctxt delegate deposit)
         (Alpha_context.get_deposits ctxt)
-        (return ctxt) >>=? fun ctxt ->
+        (return ctxt)
+      >>=? fun ctxt ->
       let ctxt = Alpha_context.finalize ctxt in
-      return (ctxt, Apply_results.{ baker ;
-                                    level ;
-                                    voting_period_kind ;
-                                    nonce_hash = None ;
-                                    consumed_gas = Z.zero ;
-                                    deactivated = [];
-                                    balance_updates = []})
-  | Partial_application { block_header ; baker ; block_delay } ->
+      return
+        ( ctxt,
+          Apply_results.
+            {
+              baker;
+              level;
+              voting_period_kind;
+              nonce_hash = None;
+              consumed_gas = Z.zero;
+              deactivated = [];
+              balance_updates = [];
+            } )
+  | Partial_application {block_header; baker; block_delay} ->
       let level = Alpha_context.Level.current ctxt in
       let included_endorsements = Alpha_context.included_endorsements ctxt in
-      Apply.check_minimum_endorsements ctxt
+      Apply.check_minimum_endorsements
+        ctxt
         block_header.protocol_data.contents
-        block_delay included_endorsements >>=? fun () ->
-      Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->
+        block_delay
+        included_endorsements
+      >>=? fun () ->
+      Alpha_context.Vote.get_current_period_kind ctxt
+      >>=? fun voting_period_kind ->
       let ctxt = Alpha_context.finalize ctxt in
-      return (ctxt, Apply_results.{ baker ;
-                                    level ;
-                                    voting_period_kind ;
-                                    nonce_hash = None ;
-                                    consumed_gas = Z.zero ;
-                                    deactivated = [];
-                                    balance_updates = []})
+      return
+        ( ctxt,
+          Apply_results.
+            {
+              baker;
+              level;
+              voting_period_kind;
+              nonce_hash = None;
+              consumed_gas = Z.zero;
+              deactivated = [];
+              balance_updates = [];
+            } )
   | Application
-      { baker ; block_delay ; block_header = { protocol_data = { contents = protocol_data ; _ } ; _ } }
-  | Full_construction { protocol_data ; baker ; block_delay ; _ } ->
-      Apply.finalize_application ctxt protocol_data baker ~block_delay >>=? fun (ctxt, receipt) ->
+      { baker;
+        block_delay;
+        block_header = {protocol_data = {contents = protocol_data; _}; _} }
+  | Full_construction {protocol_data; baker; block_delay; _} ->
+      Apply.finalize_application ctxt protocol_data baker ~block_delay
+      >>=? fun (ctxt, receipt) ->
       let level = Alpha_context.Level.current ctxt in
       let priority = protocol_data.priority in
       let raw_level = Alpha_context.Raw_level.to_int32 level.level in
@@ -247,69 +280,101 @@ let finalize_block { mode ; ctxt ; op_count } =
       let commit_message =
         Format.asprintf
           "lvl %ld, fit 1:%Ld, prio %d, %d ops"
-          raw_level fitness priority op_count in
+          raw_level
+          fitness
+          priority
+          op_count
+      in
       let ctxt = Alpha_context.finalize ~commit_message ctxt in
       return (ctxt, receipt)
 
 let compare_operations op1 op2 =
   let open Alpha_context in
-  let Operation_data op1 = op1.protocol_data in
-  let Operation_data op2 = op2.protocol_data in
-  match op1.contents, op2.contents with
-  | Single (Endorsement _), Single (Endorsement _) -> 0
-  | _, Single (Endorsement _) -> 1
-  | Single (Endorsement _), _ -> -1
-
-  | Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0
-  | _, Single (Seed_nonce_revelation _) -> 1
-  | Single (Seed_nonce_revelation _), _ -> -1
-
-  | Single (Double_endorsement_evidence _), Single (Double_endorsement_evidence _) -> 0
-  | _, Single (Double_endorsement_evidence _) -> 1
-  | Single (Double_endorsement_evidence _), _ -> -1
-
-  | Single (Double_baking_evidence _), Single (Double_baking_evidence _) -> 0
-  | _, Single (Double_baking_evidence _) -> 1
-  | Single (Double_baking_evidence _), _ -> -1
-
-  | Single (Activate_account _), Single (Activate_account _) -> 0
-  | _, Single (Activate_account _) -> 1
-  | Single (Activate_account _), _ -> -1
-
-  | Single (Proposals _), Single (Proposals _) -> 0
-  | _, Single (Proposals _) -> 1
-  | Single (Proposals _), _ -> -1
-
-  | Single (Ballot _), Single (Ballot _) -> 0
-  | _, Single (Ballot _) -> 1
-  | Single (Ballot _), _ -> -1
-
+  let (Operation_data op1) = op1.protocol_data in
+  let (Operation_data op2) = op2.protocol_data in
+  match (op1.contents, op2.contents) with
+  | (Single (Endorsement _), Single (Endorsement _)) ->
+      0
+  | (_, Single (Endorsement _)) ->
+      1
+  | (Single (Endorsement _), _) ->
+      -1
+  | (Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _)) ->
+      0
+  | (_, Single (Seed_nonce_revelation _)) ->
+      1
+  | (Single (Seed_nonce_revelation _), _) ->
+      -1
+  | ( Single (Double_endorsement_evidence _),
+      Single (Double_endorsement_evidence _) ) ->
+      0
+  | (_, Single (Double_endorsement_evidence _)) ->
+      1
+  | (Single (Double_endorsement_evidence _), _) ->
+      -1
+  | (Single (Double_baking_evidence _), Single (Double_baking_evidence _)) ->
+      0
+  | (_, Single (Double_baking_evidence _)) ->
+      1
+  | (Single (Double_baking_evidence _), _) ->
+      -1
+  | (Single (Activate_account _), Single (Activate_account _)) ->
+      0
+  | (_, Single (Activate_account _)) ->
+      1
+  | (Single (Activate_account _), _) ->
+      -1
+  | (Single (Proposals _), Single (Proposals _)) ->
+      0
+  | (_, Single (Proposals _)) ->
+      1
+  | (Single (Proposals _), _) ->
+      -1
+  | (Single (Ballot _), Single (Ballot _)) ->
+      0
+  | (_, Single (Ballot _)) ->
+      1
+  | (Single (Ballot _), _) ->
+      -1
   (* Manager operations with smaller counter are pre-validated first. *)
-  | Single (Manager_operation op1), Single (Manager_operation op2) ->
+  | (Single (Manager_operation op1), Single (Manager_operation op2)) ->
       Z.compare op1.counter op2.counter
-  | Cons (Manager_operation op1, _), Single (Manager_operation op2) ->
+  | (Cons (Manager_operation op1, _), Single (Manager_operation op2)) ->
       Z.compare op1.counter op2.counter
-  | Single (Manager_operation op1), Cons (Manager_operation op2, _) ->
+  | (Single (Manager_operation op1), Cons (Manager_operation op2, _)) ->
       Z.compare op1.counter op2.counter
-  | Cons (Manager_operation op1, _), Cons (Manager_operation op2, _) ->
+  | (Cons (Manager_operation op1, _), Cons (Manager_operation op2, _)) ->
       Z.compare op1.counter op2.counter
 
 let init ctxt block_header =
   let level = block_header.Block_header.level in
   let fitness = block_header.fitness in
   let timestamp = block_header.timestamp in
-  let typecheck (ctxt:Alpha_context.context) (script:Alpha_context.Script.t) =
-    Script_ir_translator.parse_script ctxt ~legacy:false script >>=? fun (Ex_script parsed_script, ctxt) ->
-    Script_ir_translator.extract_big_map_diff ctxt Optimized parsed_script.storage_type parsed_script.storage
-      ~to_duplicate: Script_ir_translator.no_big_map_id
-      ~to_update: Script_ir_translator.no_big_map_id
-      ~temporary:false >>=? fun (storage, big_map_diff, ctxt) ->
-    Script_ir_translator.unparse_data ctxt Optimized parsed_script.storage_type storage >>=? fun (storage, ctxt) ->
-    let storage = Alpha_context.Script.lazy_expr (Micheline.strip_locations storage) in
-    return (({ script with storage }, big_map_diff), ctxt)
+  let typecheck (ctxt : Alpha_context.context)
+      (script : Alpha_context.Script.t) =
+    Script_ir_translator.parse_script ctxt ~legacy:false script
+    >>=? fun (Ex_script parsed_script, ctxt) ->
+    Script_ir_translator.extract_big_map_diff
+      ctxt
+      Optimized
+      parsed_script.storage_type
+      parsed_script.storage
+      ~to_duplicate:Script_ir_translator.no_big_map_id
+      ~to_update:Script_ir_translator.no_big_map_id
+      ~temporary:false
+    >>=? fun (storage, big_map_diff, ctxt) ->
+    Script_ir_translator.unparse_data
+      ctxt
+      Optimized
+      parsed_script.storage_type
+      storage
+    >>=? fun (storage, ctxt) ->
+    let storage =
+      Alpha_context.Script.lazy_expr (Micheline.strip_locations storage)
+    in
+    return (({script with storage}, big_map_diff), ctxt)
   in
-  Alpha_context.prepare_first_block
-    ~typecheck
-    ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->
-  return (Alpha_context.finalize ctxt)
-(* Vanity nonce: 415767323 *)
+  Alpha_context.prepare_first_block ~typecheck ~level ~timestamp ~fitness ctxt
+  >>=? fun ctxt -> return (Alpha_context.finalize ctxt)
+
+(* Vanity nonce: 0050006865723388 *)

vendors/ligo-utils/tezos-protocol-alpha/main.mli

@@ -27,44 +27,43 @@
 
 type validation_mode =
   | Application of {
-      block_header : Alpha_context.Block_header.t ;
-      baker : Alpha_context.public_key_hash ;
-      block_delay : Alpha_context.Period.t ;
+      block_header : Alpha_context.Block_header.t;
+      baker : Alpha_context.public_key_hash;
+      block_delay : Alpha_context.Period.t;
     }
   | Partial_application of {
-      block_header : Alpha_context.Block_header.t ;
-      baker : Alpha_context.public_key_hash ;
-      block_delay : Alpha_context.Period.t ;
-    }
-  | Partial_construction of {
-      predecessor : Block_hash.t ;
+      block_header : Alpha_context.Block_header.t;
+      baker : Alpha_context.public_key_hash;
+      block_delay : Alpha_context.Period.t;
     }
+  | Partial_construction of {predecessor : Block_hash.t}
   | Full_construction of {
-      predecessor : Block_hash.t ;
-      protocol_data : Alpha_context.Block_header.contents ;
-      baker : Alpha_context.public_key_hash ;
-      block_delay : Alpha_context.Period.t ;
+      predecessor : Block_hash.t;
+      protocol_data : Alpha_context.Block_header.contents;
+      baker : Alpha_context.public_key_hash;
+      block_delay : Alpha_context.Period.t;
     }
 
-type validation_state =
-  { mode : validation_mode ;
-    chain_id : Chain_id.t ;
-    ctxt : Alpha_context.t ;
-    op_count : int ;
-  }
+type validation_state = {
+  mode : validation_mode;
+  chain_id : Chain_id.t;
+  ctxt : Alpha_context.t;
+  op_count : int;
+}
 
 type operation_data = Alpha_context.packed_protocol_data
 
 type operation = Alpha_context.packed_operation = {
-  shell: Operation.shell_header ;
-  protocol_data: operation_data ;
+  shell : Operation.shell_header;
+  protocol_data : operation_data;
 }
 
-include Updater.PROTOCOL
-  with type block_header_data = Alpha_context.Block_header.protocol_data
-   and type block_header_metadata = Apply_results.block_metadata
-   and type block_header = Alpha_context.Block_header.t
-   and type operation_data := operation_data
-   and type operation_receipt = Apply_results.packed_operation_metadata
-   and type operation := operation
-   and type validation_state := validation_state
+include
+  Updater.PROTOCOL
+    with type block_header_data = Alpha_context.Block_header.protocol_data
+     and type block_header_metadata = Apply_results.block_metadata
+     and type block_header = Alpha_context.Block_header.t
+     and type operation_data := operation_data
+     and type operation_receipt = Apply_results.packed_operation_metadata
+     and type operation := operation
+     and type validation_state := validation_state

vendors/ligo-utils/tezos-protocol-alpha/manager_repr.ml

@@ -34,27 +34,19 @@ type t = manager_key
 open Data_encoding
 
 let hash_case tag =
-  case tag
+  case
+    tag
     ~title:"Public_key_hash"
     Signature.Public_key_hash.encoding
-    (function
-      | Hash hash -> Some hash
-      | _ -> None)
+    (function Hash hash -> Some hash | _ -> None)
     (fun hash -> Hash hash)
 
 let pubkey_case tag =
-  case tag
+  case
+    tag
     ~title:"Public_key"
     Signature.Public_key.encoding
-    (function
-      | Public_key hash -> Some hash
-      | _ -> None)
+    (function Public_key hash -> Some hash | _ -> None)
     (fun hash -> Public_key hash)
 
-
-let encoding =
-  union [
-    hash_case (Tag 0) ;
-    pubkey_case (Tag 1) ;
-  ]
-
+let encoding = union [hash_case (Tag 0); pubkey_case (Tag 1)]

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_gas.ml

@@ -27,125 +27,147 @@ open Alpha_context
 open Gas
 
 module Cost_of = struct
-
   let log2 =
-    let rec help acc = function
-      | 0 -> acc
-      | n -> help (acc + 1) (n / 2)
-    in help 1
+    let rec help acc = function 0 -> acc | n -> help (acc + 1) (n / 2) in
+    help 1
 
   let z_bytes (z : Z.t) =
     let bits = Z.numbits z in
     (7 + bits) / 8
 
-  let int_bytes (z : 'a Script_int.num) =
-    z_bytes (Script_int.to_zint z)
+  let int_bytes (z : 'a Script_int.num) = z_bytes (Script_int.to_zint z)
 
   let timestamp_bytes (t : Script_timestamp.t) =
     let z = Script_timestamp.to_zint t in
     z_bytes z
 
   (* For now, returns size in bytes, but this could get more complicated... *)
-  let rec size_of_comparable : type a b. (a, b) Script_typed_ir.comparable_struct -> a -> int =
-    fun wit v ->
-      match wit with
-      | Int_key _ -> int_bytes v
-      | Nat_key _ -> int_bytes v
-      | String_key _ -> String.length v
-      | Bytes_key _ -> MBytes.length v
-      | Bool_key _ -> 8
-      | Key_hash_key _ -> Signature.Public_key_hash.size
-      | Timestamp_key _ -> timestamp_bytes v
-      | Address_key _ -> Signature.Public_key_hash.size
-      | Mutez_key _ -> 8
-      | Pair_key ((l, _), (r, _), _) ->
-          let (lval, rval) = v in
-          size_of_comparable l lval + size_of_comparable r rval
+  let rec size_of_comparable :
+      type a b. (a, b) Script_typed_ir.comparable_struct -> a -> int =
+   fun wit v ->
+    match wit with
+    | Int_key _ ->
+        int_bytes v
+    | Nat_key _ ->
+        int_bytes v
+    | String_key _ ->
+        String.length v
+    | Bytes_key _ ->
+        MBytes.length v
+    | Bool_key _ ->
+        8
+    | Key_hash_key _ ->
+        Signature.Public_key_hash.size
+    | Timestamp_key _ ->
+        timestamp_bytes v
+    | Address_key _ ->
+        Signature.Public_key_hash.size
+    | Mutez_key _ ->
+        8
+    | Pair_key ((l, _), (r, _), _) ->
+        let (lval, rval) = v in
+        size_of_comparable l lval + size_of_comparable r rval
 
-  let string length =
-    alloc_bytes_cost length
+  let string length = alloc_bytes_cost length
 
-  let bytes length =
-    alloc_mbytes_cost length
+  let bytes length = alloc_mbytes_cost length
 
   let manager_operation = step_cost 10_000
 
   module Legacy = struct
-    let zint z =
-      alloc_bits_cost (Z.numbits z)
+    let zint z = alloc_bits_cost (Z.numbits z)
 
-    let set_to_list : type item. item Script_typed_ir.set -> cost
-      = fun (module Box) ->
-        alloc_cost @@ Pervasives.(Box.size * 2)
+    let set_to_list : type item. item Script_typed_ir.set -> cost =
+     fun (module Box) -> alloc_cost @@ Pervasives.(Box.size * 2)
 
     let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
-      = fun (module Box) ->
-        let size = snd Box.boxed in
-        3 *@ alloc_cost size
+        =
+     fun (module Box) ->
+      let size = snd Box.boxed in
+      3 *@ alloc_cost size
 
     let z_to_int64 = step_cost 2 +@ alloc_cost 1
 
-    let hash data len = 10 *@ step_cost (MBytes.length data) +@ bytes len
+    let hash data len = (10 *@ step_cost (MBytes.length data)) +@ bytes len
 
-    let set_access : type elt. elt -> elt Script_typed_ir.set -> int
-      = fun _key (module Box) ->
-        log2 @@ Box.size
+    let set_access : type elt. elt -> elt Script_typed_ir.set -> int =
+     fun _key (module Box) -> log2 @@ Box.size
 
-    let set_update key _presence set =
-      set_access key set *@ alloc_cost 3
+    let set_update key _presence set = set_access key set *@ alloc_cost 3
   end
 
   module Interpreter = struct
     let cycle = atomic_step_cost 10
+
     let nop = free
+
     let stack_op = atomic_step_cost 10
+
     let push = atomic_step_cost 10
+
     let wrap = atomic_step_cost 10
+
     let variant_no_data = atomic_step_cost 10
+
     let branch = atomic_step_cost 10
+
     let pair = atomic_step_cost 10
+
     let pair_access = atomic_step_cost 10
+
     let cons = atomic_step_cost 10
+
     let loop_size = atomic_step_cost 5
+
     let loop_cycle = atomic_step_cost 10
+
     let loop_iter = atomic_step_cost 20
+
     let loop_map = atomic_step_cost 30
+
     let empty_set = atomic_step_cost 10
+
     let set_to_list : type elt. elt Script_typed_ir.set -> cost =
-      fun (module Box) ->
-        atomic_step_cost (Box.size * 20)
+     fun (module Box) -> atomic_step_cost (Box.size * 20)
 
     let set_mem : type elt. elt -> elt Script_typed_ir.set -> cost =
-      fun elt (module Box) ->
-        let elt_bytes = size_of_comparable Box.elt_ty elt in
-        atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)
+     fun elt (module Box) ->
+      let elt_bytes = size_of_comparable Box.elt_ty elt in
+      atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)
 
     let set_update : type elt. elt -> bool -> elt Script_typed_ir.set -> cost =
-      fun elt _ (module Box) ->
-        let elt_bytes = size_of_comparable Box.elt_ty elt in
-        atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)
+     fun elt _ (module Box) ->
+      let elt_bytes = size_of_comparable Box.elt_ty elt in
+      atomic_step_cost ((1 + (elt_bytes / 82)) * log2 Box.size)
 
     let set_size = atomic_step_cost 10
-    let empty_map = atomic_step_cost 10
-    let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost =
-      fun (module Box) ->
-        let size = snd Box.boxed in
-        atomic_step_cost (size * 20)
 
-    let map_access : type key value. key -> (key, value) Script_typed_ir.map -> cost
-      = fun key (module Box) ->
-        let map_card  = snd Box.boxed in
-        let key_bytes = size_of_comparable Box.key_ty key in
-        atomic_step_cost ((1 + (key_bytes / 70)) * log2 map_card)
+    let empty_map = atomic_step_cost 10
+
+    let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost
+        =
+     fun (module Box) ->
+      let size = snd Box.boxed in
+      atomic_step_cost (size * 20)
+
+    let map_access :
+        type key value. key -> (key, value) Script_typed_ir.map -> cost =
+     fun key (module Box) ->
+      let map_card = snd Box.boxed in
+      let key_bytes = size_of_comparable Box.key_ty key in
+      atomic_step_cost ((1 + (key_bytes / 70)) * log2 map_card)
 
     let map_mem = map_access
+
     let map_get = map_access
 
-    let map_update : type key value. key -> value option -> (key, value) Script_typed_ir.map -> cost
-      = fun key _value (module Box) ->
-        let map_card  = snd Box.boxed in
-        let key_bytes = size_of_comparable Box.key_ty key in
-        atomic_step_cost ((1 + (key_bytes / 38)) * log2 map_card)
+    let map_update :
+        type key value.
+        key -> value option -> (key, value) Script_typed_ir.map -> cost =
+     fun key _value (module Box) ->
+      let map_card = snd Box.boxed in
+      let key_bytes = size_of_comparable Box.key_ty key in
+      atomic_step_cost ((1 + (key_bytes / 38)) * log2 map_card)
 
     let map_size = atomic_step_cost 10
 
@@ -153,16 +175,16 @@ module Cost_of = struct
       let bytes1 = timestamp_bytes t1 in
       let bytes2 = int_bytes t2 in
       atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 62))
+
     let sub_timestamp = add_timestamp
+
     let diff_timestamps (t1 : Script_timestamp.t) (t2 : Script_timestamp.t) =
       let bytes1 = timestamp_bytes t1 in
       let bytes2 = timestamp_bytes t2 in
       atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 62))
 
     let rec concat_loop l acc =
-      match l with
-      | [] -> 30
-      | _ :: tl -> concat_loop tl (acc + 30)
+      match l with [] -> 30 | _ :: tl -> concat_loop tl (acc + 30)
 
     let concat_string string_list =
       atomic_step_cost (concat_loop string_list 0)
@@ -170,19 +192,28 @@ module Cost_of = struct
     let slice_string string_length =
       atomic_step_cost (40 + (string_length / 70))
 
-    let concat_bytes bytes_list =
-      atomic_step_cost (concat_loop bytes_list 0)
+    let concat_bytes bytes_list = atomic_step_cost (concat_loop bytes_list 0)
 
     let int64_op = atomic_step_cost 61
+
     let z_to_int64 = atomic_step_cost 20
+
     let int64_to_z = atomic_step_cost 20
+
     let bool_binop _ _ = atomic_step_cost 10
+
     let bool_unop _ = atomic_step_cost 10
 
-    let abs int = atomic_step_cost (61 + ((int_bytes int) / 70))
+    let abs int = atomic_step_cost (61 + (int_bytes int / 70))
+
     let int _int = free
+
     let neg = abs
-    let add i1 i2 = atomic_step_cost (51 + (Compare.Int.max (int_bytes i1) (int_bytes i2) / 62))
+
+    let add i1 i2 =
+      atomic_step_cost
+        (51 + (Compare.Int.max (int_bytes i1) (int_bytes i2) / 62))
+
     let sub = add
 
     let mul i1 i2 =
@@ -198,303 +229,537 @@ module Cost_of = struct
       atomic_step_cost (51 + (cost / 3151))
 
     let shift_left _i _shift_bits = atomic_step_cost 30
+
     let shift_right _i _shift_bits = atomic_step_cost 30
+
     let logor i1 i2 =
       let bytes1 = int_bytes i1 in
       let bytes2 = int_bytes i2 in
-      atomic_step_cost (51 + ((Compare.Int.max bytes1 bytes2) / 70))
+      atomic_step_cost (51 + (Compare.Int.max bytes1 bytes2 / 70))
+
     let logand i1 i2 =
       let bytes1 = int_bytes i1 in
       let bytes2 = int_bytes i2 in
-      atomic_step_cost (51 + ((Compare.Int.min bytes1 bytes2) / 70))
+      atomic_step_cost (51 + (Compare.Int.min bytes1 bytes2 / 70))
+
     let logxor = logor
-    let lognot i = atomic_step_cost (51 + ((int_bytes i) / 20))
+
+    let lognot i = atomic_step_cost (51 + (int_bytes i / 20))
+
     let exec = atomic_step_cost 10
+
     let compare_bool _ _ = atomic_step_cost 30
 
     let compare_string s1 s2 =
       let bytes1 = String.length s1 in
       let bytes2 = String.length s2 in
-      atomic_step_cost (30 + ((Compare.Int.min bytes1 bytes2) / 123))
+      atomic_step_cost (30 + (Compare.Int.min bytes1 bytes2 / 123))
+
     let compare_bytes b1 b2 =
       let bytes1 = MBytes.length b1 in
       let bytes2 = MBytes.length b2 in
-      atomic_step_cost (30 + ((Compare.Int.min bytes1 bytes2) / 123))
+      atomic_step_cost (30 + (Compare.Int.min bytes1 bytes2 / 123))
+
     let compare_tez _ _ = atomic_step_cost 30
+
     let compare_zint i1 i2 =
-      atomic_step_cost (51 + ((Compare.Int.min (int_bytes i1) (int_bytes i2)) / 82))
+      atomic_step_cost
+        (51 + (Compare.Int.min (int_bytes i1) (int_bytes i2) / 82))
+
     let compare_key_hash _ _ = atomic_step_cost 92
 
     let compare_timestamp t1 t2 =
       let bytes1 = timestamp_bytes t1 in
       let bytes2 = timestamp_bytes t2 in
-      atomic_step_cost (51 + ((Compare.Int.min bytes1 bytes2) / 82))
+      atomic_step_cost (51 + (Compare.Int.min bytes1 bytes2 / 82))
 
     let compare_address _ _ = atomic_step_cost 92
+
     let compare_res = atomic_step_cost 30
+
     let unpack_failed bytes =
       (* We cannot instrument failed deserialization,
          so we take worst case fees: a set of size 1 bytes values. *)
       let len = MBytes.length bytes in
-      (len *@ alloc_mbytes_cost 1) +@
-      (len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))
+      (len *@ alloc_mbytes_cost 1)
+      +@ (len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))
+
     let address = atomic_step_cost 10
+
     let contract = step_cost 10000
+
     let transfer = step_cost 10
+
     let create_account = step_cost 10
+
     let create_contract = step_cost 10
+
     let implicit_account = step_cost 10
+
     let set_delegate = step_cost 10 +@ write_bytes_cost (Z.of_int 32)
+
     let balance = atomic_step_cost 10
+
     let now = atomic_step_cost 10
+
     let check_signature_secp256k1 bytes = atomic_step_cost (10342 + (bytes / 5))
+
     let check_signature_ed25519 bytes = atomic_step_cost (36864 + (bytes / 5))
+
     let check_signature_p256 bytes = atomic_step_cost (36864 + (bytes / 5))
+
     let check_signature (pkey : Signature.public_key) bytes =
       match pkey with
-      | Ed25519 _ -> check_signature_ed25519 (MBytes.length bytes)
-      | Secp256k1 _ -> check_signature_secp256k1 (MBytes.length bytes)
-      | P256 _ ->  check_signature_p256 (MBytes.length bytes)
+      | Ed25519 _ ->
+          check_signature_ed25519 (MBytes.length bytes)
+      | Secp256k1 _ ->
+          check_signature_secp256k1 (MBytes.length bytes)
+      | P256 _ ->
+          check_signature_p256 (MBytes.length bytes)
+
     let hash_key = atomic_step_cost 30
-    let hash_blake2b b = atomic_step_cost (102 + ((MBytes.length b) / 5))
-    let hash_sha256 b = atomic_step_cost (409 + (MBytes.length b))
+
+    let hash_blake2b b = atomic_step_cost (102 + (MBytes.length b / 5))
+
+    let hash_sha256 b = atomic_step_cost (409 + MBytes.length b)
+
     let hash_sha512 b =
-      let bytes = MBytes.length b in atomic_step_cost (409 + ((bytes lsr 1) + (bytes lsr 4)))
+      let bytes = MBytes.length b in
+      atomic_step_cost (409 + ((bytes lsr 1) + (bytes lsr 4)))
+
     let steps_to_quota = atomic_step_cost 10
+
     let source = atomic_step_cost 10
+
     let self = atomic_step_cost 10
+
     let amount = atomic_step_cost 10
+
     let chain_id = step_cost 1
-    let stack_n_op n = atomic_step_cost (20 + (((n lsr 1) + (n lsr 2)) + (n lsr 4)))
+
+    let stack_n_op n =
+      atomic_step_cost (20 + ((n lsr 1) + (n lsr 2) + (n lsr 4)))
+
     let apply = alloc_cost 8 +@ step_cost 1
 
-    let rec compare : type a s. (a, s) Script_typed_ir.comparable_struct -> a -> a -> cost = fun ty x y ->
+    let rec compare :
+        type a s. (a, s) Script_typed_ir.comparable_struct -> a -> a -> cost =
+     fun ty x y ->
       match ty with
-      | Bool_key _ -> compare_bool x y
-      | String_key _ -> compare_string x y
-      | Bytes_key _ -> compare_bytes x y
-      | Mutez_key _ -> compare_tez x y
-      | Int_key _ -> compare_zint x y
-      | Nat_key _ -> compare_zint x y
-      | Key_hash_key _ -> compare_key_hash x y
-      | Timestamp_key _ -> compare_timestamp x y
-      | Address_key _ -> compare_address x y
+      | Bool_key _ ->
+          compare_bool x y
+      | String_key _ ->
+          compare_string x y
+      | Bytes_key _ ->
+          compare_bytes x y
+      | Mutez_key _ ->
+          compare_tez x y
+      | Int_key _ ->
+          compare_zint x y
+      | Nat_key _ ->
+          compare_zint x y
+      | Key_hash_key _ ->
+          compare_key_hash x y
+      | Timestamp_key _ ->
+          compare_timestamp x y
+      | Address_key _ ->
+          compare_address x y
       | Pair_key ((tl, _), (tr, _), _) ->
           (* Reasonable over-approximation of the cost of lexicographic comparison. *)
           let (xl, xr) = x and (yl, yr) = y in
           compare tl xl yl +@ compare tr xr yr
-
   end
 
   module Typechecking = struct
     let cycle = step_cost 1
+
     let bool = free
+
     let unit = free
+
     let string = string
+
     let bytes = bytes
+
     let z = Legacy.zint
+
     let int_of_string str =
-      alloc_cost @@ (Pervasives.(/) (String.length str) 5)
+      alloc_cost @@ Pervasives.( / ) (String.length str) 5
+
     let tez = step_cost 1 +@ alloc_cost 1
+
     let string_timestamp = step_cost 3 +@ alloc_cost 3
+
     let key = step_cost 3 +@ alloc_cost 3
+
     let key_hash = step_cost 1 +@ alloc_cost 1
+
     let signature = step_cost 1 +@ alloc_cost 1
+
     let chain_id = step_cost 1 +@ alloc_cost 1
+
     let contract = step_cost 5
+
     let get_script = step_cost 20 +@ alloc_cost 5
+
     let contract_exists = step_cost 15 +@ alloc_cost 5
+
     let pair = alloc_cost 2
+
     let union = alloc_cost 1
+
     let lambda = alloc_cost 5 +@ step_cost 3
+
     let some = alloc_cost 1
+
     let none = alloc_cost 0
+
     let list_element = alloc_cost 2 +@ step_cost 1
+
     let set_element size = log2 size *@ (alloc_cost 3 +@ step_cost 2)
+
     let map_element size = log2 size *@ (alloc_cost 4 +@ step_cost 2)
+
     let primitive_type = alloc_cost 1
+
     let one_arg_type = alloc_cost 2
+
     let two_arg_type = alloc_cost 3
+
     let operation b = bytes b
+
     let type_ nb_args = alloc_cost (nb_args + 1)
 
     (* Cost of parsing instruction, is cost of allocation of
        constructor + cost of contructor parameters + cost of
        allocation on the stack type *)
-    let instr
-      : type b a. (b, a) Script_typed_ir.instr -> cost
-      = fun i ->
-        let open Script_typed_ir in
-        alloc_cost 1 +@ (* cost of allocation of constructor *)
-        match i with
-        | Drop -> alloc_cost 0
-        | Dup -> alloc_cost 1
-        | Swap -> alloc_cost 0
-        | Const _ -> alloc_cost 1
-        | Cons_pair -> alloc_cost 2
-        | Car -> alloc_cost 1
-        | Cdr -> alloc_cost 1
-        | Cons_some -> alloc_cost 2
-        | Cons_none _ -> alloc_cost 3
-        | If_none _ -> alloc_cost 2
-        | Left -> alloc_cost 3
-        | Right -> alloc_cost 3
-        | If_left _ -> alloc_cost 2
-        | Cons_list -> alloc_cost 1
-        | Nil -> alloc_cost 1
-        | If_cons _ -> alloc_cost 2
-        | List_map _ -> alloc_cost 5
-        | List_iter _ -> alloc_cost 4
-        | List_size -> alloc_cost 1
-        | Empty_set _ -> alloc_cost 1
-        | Set_iter _ -> alloc_cost 4
-        | Set_mem -> alloc_cost 1
-        | Set_update -> alloc_cost 1
-        | Set_size -> alloc_cost 1
-        | Empty_map _ -> alloc_cost 2
-        | Map_map _ -> alloc_cost 5
-        | Map_iter _ -> alloc_cost 4
-        | Map_mem -> alloc_cost 1
-        | Map_get -> alloc_cost 1
-        | Map_update -> alloc_cost 1
-        | Map_size -> alloc_cost 1
-        | Empty_big_map _ -> alloc_cost 2
-        | Big_map_mem -> alloc_cost 1
-        | Big_map_get -> alloc_cost 1
-        | Big_map_update -> alloc_cost 1
-        | Concat_string -> alloc_cost 1
-        | Concat_string_pair -> alloc_cost 1
-        | Concat_bytes -> alloc_cost 1
-        | Concat_bytes_pair -> alloc_cost 1
-        | Slice_string -> alloc_cost 1
-        | Slice_bytes -> alloc_cost 1
-        | String_size -> alloc_cost 1
-        | Bytes_size -> alloc_cost 1
-        | Add_seconds_to_timestamp -> alloc_cost 1
-        | Add_timestamp_to_seconds -> alloc_cost 1
-        | Sub_timestamp_seconds -> alloc_cost 1
-        | Diff_timestamps -> alloc_cost 1
-        | Add_tez -> alloc_cost 1
-        | Sub_tez -> alloc_cost 1
-        | Mul_teznat -> alloc_cost 1
-        | Mul_nattez -> alloc_cost 1
-        | Ediv_teznat -> alloc_cost 1
-        | Ediv_tez -> alloc_cost 1
-        | Or -> alloc_cost 1
-        | And -> alloc_cost 1
-        | Xor -> alloc_cost 1
-        | Not -> alloc_cost 1
-        | Is_nat -> alloc_cost 1
-        | Neg_nat -> alloc_cost 1
-        | Neg_int -> alloc_cost 1
-        | Abs_int -> alloc_cost 1
-        | Int_nat -> alloc_cost 1
-        | Add_intint -> alloc_cost 1
-        | Add_intnat -> alloc_cost 1
-        | Add_natint -> alloc_cost 1
-        | Add_natnat -> alloc_cost 1
-        | Sub_int -> alloc_cost 1
-        | Mul_intint -> alloc_cost 1
-        | Mul_intnat -> alloc_cost 1
-        | Mul_natint -> alloc_cost 1
-        | Mul_natnat -> alloc_cost 1
-        | Ediv_intint -> alloc_cost 1
-        | Ediv_intnat -> alloc_cost 1
-        | Ediv_natint -> alloc_cost 1
-        | Ediv_natnat -> alloc_cost 1
-        | Lsl_nat -> alloc_cost 1
-        | Lsr_nat -> alloc_cost 1
-        | Or_nat -> alloc_cost 1
-        | And_nat -> alloc_cost 1
-        | And_int_nat -> alloc_cost 1
-        | Xor_nat -> alloc_cost 1
-        | Not_nat -> alloc_cost 1
-        | Not_int -> alloc_cost 1
-        | Seq _ -> alloc_cost 8
-        | If _ -> alloc_cost 8
-        | Loop _ -> alloc_cost 4
-        | Loop_left _ -> alloc_cost 5
-        | Dip _ -> alloc_cost 4
-        | Exec -> alloc_cost 1
-        | Apply _ -> alloc_cost 1
-        | Lambda _ -> alloc_cost 2
-        | Failwith _ -> alloc_cost 1
-        | Nop -> alloc_cost 0
-        | Compare _ -> alloc_cost 1
-        | Eq -> alloc_cost 1
-        | Neq -> alloc_cost 1
-        | Lt -> alloc_cost 1
-        | Gt -> alloc_cost 1
-        | Le -> alloc_cost 1
-        | Ge -> alloc_cost 1
-        | Address -> alloc_cost 1
-        | Contract _ -> alloc_cost 2
-        | Transfer_tokens -> alloc_cost 1
-        | Create_account -> alloc_cost 2
-        | Implicit_account -> alloc_cost 1
-        | Create_contract _ -> alloc_cost 8
-        (* Deducted the cost of removed arguments manager, spendable and delegatable:
+    let instr : type b a. (b, a) Script_typed_ir.instr -> cost =
+     fun i ->
+      let open Script_typed_ir in
+      alloc_cost 1
+      +@
+      (* cost of allocation of constructor *)
+      match i with
+      | Drop ->
+          alloc_cost 0
+      | Dup ->
+          alloc_cost 1
+      | Swap ->
+          alloc_cost 0
+      | Const _ ->
+          alloc_cost 1
+      | Cons_pair ->
+          alloc_cost 2
+      | Car ->
+          alloc_cost 1
+      | Cdr ->
+          alloc_cost 1
+      | Cons_some ->
+          alloc_cost 2
+      | Cons_none _ ->
+          alloc_cost 3
+      | If_none _ ->
+          alloc_cost 2
+      | Left ->
+          alloc_cost 3
+      | Right ->
+          alloc_cost 3
+      | If_left _ ->
+          alloc_cost 2
+      | Cons_list ->
+          alloc_cost 1
+      | Nil ->
+          alloc_cost 1
+      | If_cons _ ->
+          alloc_cost 2
+      | List_map _ ->
+          alloc_cost 5
+      | List_iter _ ->
+          alloc_cost 4
+      | List_size ->
+          alloc_cost 1
+      | Empty_set _ ->
+          alloc_cost 1
+      | Set_iter _ ->
+          alloc_cost 4
+      | Set_mem ->
+          alloc_cost 1
+      | Set_update ->
+          alloc_cost 1
+      | Set_size ->
+          alloc_cost 1
+      | Empty_map _ ->
+          alloc_cost 2
+      | Map_map _ ->
+          alloc_cost 5
+      | Map_iter _ ->
+          alloc_cost 4
+      | Map_mem ->
+          alloc_cost 1
+      | Map_get ->
+          alloc_cost 1
+      | Map_update ->
+          alloc_cost 1
+      | Map_size ->
+          alloc_cost 1
+      | Empty_big_map _ ->
+          alloc_cost 2
+      | Big_map_mem ->
+          alloc_cost 1
+      | Big_map_get ->
+          alloc_cost 1
+      | Big_map_update ->
+          alloc_cost 1
+      | Concat_string ->
+          alloc_cost 1
+      | Concat_string_pair ->
+          alloc_cost 1
+      | Concat_bytes ->
+          alloc_cost 1
+      | Concat_bytes_pair ->
+          alloc_cost 1
+      | Slice_string ->
+          alloc_cost 1
+      | Slice_bytes ->
+          alloc_cost 1
+      | String_size ->
+          alloc_cost 1
+      | Bytes_size ->
+          alloc_cost 1
+      | Add_seconds_to_timestamp ->
+          alloc_cost 1
+      | Add_timestamp_to_seconds ->
+          alloc_cost 1
+      | Sub_timestamp_seconds ->
+          alloc_cost 1
+      | Diff_timestamps ->
+          alloc_cost 1
+      | Add_tez ->
+          alloc_cost 1
+      | Sub_tez ->
+          alloc_cost 1
+      | Mul_teznat ->
+          alloc_cost 1
+      | Mul_nattez ->
+          alloc_cost 1
+      | Ediv_teznat ->
+          alloc_cost 1
+      | Ediv_tez ->
+          alloc_cost 1
+      | Or ->
+          alloc_cost 1
+      | And ->
+          alloc_cost 1
+      | Xor ->
+          alloc_cost 1
+      | Not ->
+          alloc_cost 1
+      | Is_nat ->
+          alloc_cost 1
+      | Neg_nat ->
+          alloc_cost 1
+      | Neg_int ->
+          alloc_cost 1
+      | Abs_int ->
+          alloc_cost 1
+      | Int_nat ->
+          alloc_cost 1
+      | Add_intint ->
+          alloc_cost 1
+      | Add_intnat ->
+          alloc_cost 1
+      | Add_natint ->
+          alloc_cost 1
+      | Add_natnat ->
+          alloc_cost 1
+      | Sub_int ->
+          alloc_cost 1
+      | Mul_intint ->
+          alloc_cost 1
+      | Mul_intnat ->
+          alloc_cost 1
+      | Mul_natint ->
+          alloc_cost 1
+      | Mul_natnat ->
+          alloc_cost 1
+      | Ediv_intint ->
+          alloc_cost 1
+      | Ediv_intnat ->
+          alloc_cost 1
+      | Ediv_natint ->
+          alloc_cost 1
+      | Ediv_natnat ->
+          alloc_cost 1
+      | Lsl_nat ->
+          alloc_cost 1
+      | Lsr_nat ->
+          alloc_cost 1
+      | Or_nat ->
+          alloc_cost 1
+      | And_nat ->
+          alloc_cost 1
+      | And_int_nat ->
+          alloc_cost 1
+      | Xor_nat ->
+          alloc_cost 1
+      | Not_nat ->
+          alloc_cost 1
+      | Not_int ->
+          alloc_cost 1
+      | Seq _ ->
+          alloc_cost 8
+      | If _ ->
+          alloc_cost 8
+      | Loop _ ->
+          alloc_cost 4
+      | Loop_left _ ->
+          alloc_cost 5
+      | Dip _ ->
+          alloc_cost 4
+      | Exec ->
+          alloc_cost 1
+      | Apply _ ->
+          alloc_cost 1
+      | Lambda _ ->
+          alloc_cost 2
+      | Failwith _ ->
+          alloc_cost 1
+      | Nop ->
+          alloc_cost 0
+      | Compare _ ->
+          alloc_cost 1
+      | Eq ->
+          alloc_cost 1
+      | Neq ->
+          alloc_cost 1
+      | Lt ->
+          alloc_cost 1
+      | Gt ->
+          alloc_cost 1
+      | Le ->
+          alloc_cost 1
+      | Ge ->
+          alloc_cost 1
+      | Address ->
+          alloc_cost 1
+      | Contract _ ->
+          alloc_cost 2
+      | Transfer_tokens ->
+          alloc_cost 1
+      | Create_account ->
+          alloc_cost 2
+      | Implicit_account ->
+          alloc_cost 1
+      | Create_contract _ ->
+          alloc_cost 8
+      (* Deducted the cost of removed arguments manager, spendable and delegatable:
            - manager: key_hash = 1
            - spendable: bool = 0
            - delegatable: bool = 0
         *)
-        | Create_contract_2 _ -> alloc_cost 7
-        | Set_delegate -> alloc_cost 1
-        | Now -> alloc_cost 1
-        | Balance -> alloc_cost 1
-        | Check_signature -> alloc_cost 1
-        | Hash_key -> alloc_cost 1
-        | Pack _ -> alloc_cost 2
-        | Unpack _ -> alloc_cost 2
-        | Blake2b -> alloc_cost 1
-        | Sha256 -> alloc_cost 1
-        | Sha512 -> alloc_cost 1
-        | Steps_to_quota -> alloc_cost 1
-        | Source -> alloc_cost 1
-        | Sender -> alloc_cost 1
-        | Self _ -> alloc_cost 2
-        | Amount -> alloc_cost 1
-        | Dig (n,_) -> n *@ alloc_cost 1 (* _ is a unary development of n *)
-        | Dug (n,_) -> n *@ alloc_cost 1
-        | Dipn (n,_,_) -> n *@ alloc_cost 1
-        | Dropn (n,_) -> n *@ alloc_cost 1
-        | ChainId -> alloc_cost 1
+      | Create_contract_2 _ ->
+          alloc_cost 7
+      | Set_delegate ->
+          alloc_cost 1
+      | Now ->
+          alloc_cost 1
+      | Balance ->
+          alloc_cost 1
+      | Check_signature ->
+          alloc_cost 1
+      | Hash_key ->
+          alloc_cost 1
+      | Pack _ ->
+          alloc_cost 2
+      | Unpack _ ->
+          alloc_cost 2
+      | Blake2b ->
+          alloc_cost 1
+      | Sha256 ->
+          alloc_cost 1
+      | Sha512 ->
+          alloc_cost 1
+      | Steps_to_quota ->
+          alloc_cost 1
+      | Source ->
+          alloc_cost 1
+      | Sender ->
+          alloc_cost 1
+      | Self _ ->
+          alloc_cost 2
+      | Amount ->
+          alloc_cost 1
+      | Dig (n, _) ->
+          n *@ alloc_cost 1 (* _ is a unary development of n *)
+      | Dug (n, _) ->
+          n *@ alloc_cost 1
+      | Dipn (n, _, _) ->
+          n *@ alloc_cost 1
+      | Dropn (n, _) ->
+          n *@ alloc_cost 1
+      | ChainId ->
+          alloc_cost 1
   end
 
   module Unparse = struct
     let prim_cost l annot = Script.prim_node_cost_nonrec_of_length l annot
+
     let seq_cost = Script.seq_node_cost_nonrec_of_length
+
     let string_cost length = Script.string_node_cost_of_length length
 
     let cycle = step_cost 1
+
     let bool = prim_cost 0 []
+
     let unit = prim_cost 0 []
+
     (* We count the length of strings and bytes to prevent hidden
        miscalculations due to non detectable expansion of sharing. *)
     let string s = Script.string_node_cost s
+
     let bytes s = Script.bytes_node_cost s
+
     let z i = Script.int_node_cost i
+
     let int i = Script.int_node_cost (Script_int.to_zint i)
+
     let tez = Script.int_node_cost_of_numbits 60 (* int64 bound *)
+
     let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int
+
     let operation bytes = Script.bytes_node_cost bytes
+
     let chain_id bytes = Script.bytes_node_cost bytes
+
     let key = string_cost 54
+
     let key_hash = string_cost 36
+
     let signature = string_cost 128
+
     let contract = string_cost 36
+
     let pair = prim_cost 2 []
+
     let union = prim_cost 1 []
+
     let some = prim_cost 1 []
+
     let none = prim_cost 0 []
+
     let list_element = alloc_cost 2
+
     let set_element = alloc_cost 2
+
     let map_element = alloc_cost 2
+
     let one_arg_type = prim_cost 1
+
     let two_arg_type = prim_cost 2
 
     let set_to_list = Legacy.set_to_list
+
     let map_to_list = Legacy.map_to_list
   end
-
 end

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_gas.mli

@@ -26,107 +26,194 @@
 open Alpha_context
 
 module Cost_of : sig
-
   val manager_operation : Gas.cost
 
   module Legacy : sig
     val z_to_int64 : Gas.cost
+
     val hash : MBytes.t -> int -> Gas.cost
-    val map_to_list :
-      ('b, 'c) Script_typed_ir.map -> Gas.cost
+
+    val map_to_list : ('b, 'c) Script_typed_ir.map -> Gas.cost
+
     val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost
   end
 
   module Interpreter : sig
     val cycle : Gas.cost
+
     val loop_cycle : Gas.cost
+
     val loop_size : Gas.cost
+
     val loop_iter : Gas.cost
+
     val loop_map : Gas.cost
+
     val nop : Gas.cost
+
     val stack_op : Gas.cost
+
     val stack_n_op : int -> Gas.cost
+
     val bool_binop : 'a -> 'b -> Gas.cost
+
     val bool_unop : 'a -> Gas.cost
+
     val pair : Gas.cost
+
     val pair_access : Gas.cost
+
     val cons : Gas.cost
+
     val variant_no_data : Gas.cost
+
     val branch : Gas.cost
+
     val concat_string : string list -> Gas.cost
+
     val concat_bytes : MBytes.t list -> Gas.cost
+
     val slice_string : int -> Gas.cost
-    val map_mem :  'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost
+
+    val map_mem : 'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost
+
     val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost
+
     val map_get : 'a -> ('a, 'b) Script_typed_ir.map -> Gas.cost
-    val map_update : 'a -> 'b option -> ('a, 'b) Script_typed_ir.map -> Gas.cost
+
+    val map_update :
+      'a -> 'b option -> ('a, 'b) Script_typed_ir.map -> Gas.cost
+
     val map_size : Gas.cost
+
     val set_to_list : 'a Script_typed_ir.set -> Gas.cost
+
     val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost
+
     val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost
+
     val mul : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val div : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val add : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val sub : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val abs : 'a Script_int.num -> Gas.cost
+
     val neg : 'a Script_int.num -> Gas.cost
+
     val int : 'a -> Gas.cost
+
     val add_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost
+
     val sub_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost
+
     val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost
+
     val empty_set : Gas.cost
+
     val set_size : Gas.cost
+
     val empty_map : Gas.cost
+
     val int64_op : Gas.cost
+
     val z_to_int64 : Gas.cost
+
     val int64_to_z : Gas.cost
+
     val logor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val logand : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val logxor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val lognot : 'a Script_int.num -> Gas.cost
+
     val shift_left : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val shift_right : 'a Script_int.num -> 'b Script_int.num -> Gas.cost
+
     val exec : Gas.cost
+
     val push : Gas.cost
+
     val compare_res : Gas.cost
+
     val unpack_failed : MBytes.t -> Gas.cost
+
     val address : Gas.cost
+
     val contract : Gas.cost
+
     val transfer : Gas.cost
+
     val create_account : Gas.cost
+
     val create_contract : Gas.cost
+
     val implicit_account : Gas.cost
+
     val set_delegate : Gas.cost
+
     val balance : Gas.cost
+
     val now : Gas.cost
+
     val check_signature : public_key -> MBytes.t -> Gas.cost
+
     val hash_key : Gas.cost
+
     val hash_blake2b : MBytes.t -> Gas.cost
+
     val hash_sha256 : MBytes.t -> Gas.cost
+
     val hash_sha512 : MBytes.t -> Gas.cost
+
     val steps_to_quota : Gas.cost
+
     val source : Gas.cost
+
     val self : Gas.cost
+
     val amount : Gas.cost
+
     val chain_id : Gas.cost
+
     val wrap : Gas.cost
+
     val compare : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> Gas.cost
+
     val apply : Gas.cost
   end
 
   module Typechecking : sig
     val cycle : Gas.cost
+
     val unit : Gas.cost
+
     val bool : Gas.cost
+
     val tez : Gas.cost
+
     val z : Z.t -> Gas.cost
+
     val string : int -> Gas.cost
+
     val bytes : int -> Gas.cost
+
     val int_of_string : string -> Gas.cost
+
     val string_timestamp : Gas.cost
+
     val key : Gas.cost
+
     val key_hash : Gas.cost
+
     val signature : Gas.cost
+
     val chain_id : Gas.cost
 
     val contract : Gas.cost
@@ -144,14 +231,19 @@ module Cost_of : sig
     val lambda : Gas.cost
 
     val some : Gas.cost
+
     val none : Gas.cost
 
     val list_element : Gas.cost
+
     val set_element : int -> Gas.cost
+
     val map_element : int -> Gas.cost
 
     val primitive_type : Gas.cost
+
     val one_arg_type : Gas.cost
+
     val two_arg_type : Gas.cost
 
     val operation : int -> Gas.cost
@@ -165,20 +257,35 @@ module Cost_of : sig
 
   module Unparse : sig
     val prim_cost : int -> Script.annot -> Gas.cost
+
     val seq_cost : int -> Gas.cost
+
     val cycle : Gas.cost
+
     val unit : Gas.cost
+
     val bool : Gas.cost
+
     val z : Z.t -> Gas.cost
+
     val int : 'a Script_int.num -> Gas.cost
+
     val tez : Gas.cost
+
     val string : string -> Gas.cost
+
     val bytes : MBytes.t -> Gas.cost
+
     val timestamp : Script_timestamp.t -> Gas.cost
+
     val key : Gas.cost
+
     val key_hash : Gas.cost
+
     val signature : Gas.cost
+
     val operation : MBytes.t -> Gas.cost
+
     val chain_id : MBytes.t -> Gas.cost
 
     val contract : Gas.cost
@@ -189,15 +296,21 @@ module Cost_of : sig
     val union : Gas.cost
 
     val some : Gas.cost
+
     val none : Gas.cost
 
     val list_element : Gas.cost
+
     val set_element : Gas.cost
+
     val map_element : Gas.cost
 
     val one_arg_type : Script.annot -> Gas.cost
+
     val two_arg_type : Script.annot -> Gas.cost
+
     val set_to_list : 'a Script_typed_ir.set -> Gas.cost
+
     val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost
   end
 end

vendors/ligo-utils/tezos-protocol-alpha/michelson_v1_primitives.mli

@@ -24,8 +24,14 @@
 (*****************************************************************************)
 
 type error += Unknown_primitive_name of string (* `Permanent *)
+
 type error += Invalid_case of string (* `Permanent *)
-type error += Invalid_primitive_name of string Micheline.canonical * Micheline.canonical_location (* `Permanent *)
+
+type error +=
+  | Invalid_primitive_name of
+      string Micheline.canonical * Micheline.canonical_location
+
+(* `Permanent *)
 
 type prim =
   | K_parameter
@@ -153,6 +159,7 @@ val string_of_prim : prim -> string
 
 val prim_of_string : string -> prim tzresult
 
-val prims_of_strings : string Micheline.canonical -> prim Micheline.canonical tzresult
+val prims_of_strings :
+  string Micheline.canonical -> prim Micheline.canonical tzresult
 
 val strings_of_prims : prim Micheline.canonical -> string Micheline.canonical

vendors/ligo-utils/tezos-protocol-alpha/misc.ml

@@ -24,61 +24,56 @@
 (*****************************************************************************)
 
 type 'a lazyt = unit -> 'a
-type 'a lazy_list_t = LCons of 'a * ('a lazy_list_t tzresult Lwt.t lazyt)
+
+type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt
+
 type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t
 
-let rec (-->) i j = (* [i; i+1; ...; j] *)
-  if Compare.Int.(i > j)
-  then []
-  else i :: (succ i --> j)
+let rec ( --> ) i j =
+  (* [i; i+1; ...; j] *)
+  if Compare.Int.(i > j) then [] else i :: (succ i --> j)
 
-let rec (--->) i j = (* [i; i+1; ...; j] *)
-  if Compare.Int32.(i > j)
-  then []
-  else i :: (Int32.succ i ---> j)
+let rec ( ---> ) i j =
+  (* [i; i+1; ...; j] *)
+  if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j)
 
 let split delim ?(limit = max_int) path =
   let l = String.length path in
   let rec do_slashes acc limit i =
-    if Compare.Int.(i >= l) then
-      List.rev acc
-    else if Compare.Char.(String.get path i = delim) then
-      do_slashes acc limit (i + 1)
-    else
-      do_split acc limit i
+    if Compare.Int.(i >= l) then List.rev acc
+    else if Compare.Char.(path.[i] = delim) then do_slashes acc limit (i + 1)
+    else do_split acc limit i
   and do_split acc limit i =
     if Compare.Int.(limit <= 0) then
-      if Compare.Int.(i = l) then
-        List.rev acc
-      else
-        List.rev (String.sub path i (l - i) :: acc)
-    else
-      do_component acc (pred limit) i i
+      if Compare.Int.(i = l) then List.rev acc
+      else List.rev (String.sub path i (l - i) :: acc)
+    else do_component acc (pred limit) i i
   and do_component acc limit i j =
     if Compare.Int.(j >= l) then
-      if Compare.Int.(i = j) then
-        List.rev acc
-      else
-        List.rev (String.sub path i (j - i) :: acc)
-    else if Compare.Char.(String.get path j = delim) then
+      if Compare.Int.(i = j) then List.rev acc
+      else List.rev (String.sub path i (j - i) :: acc)
+    else if Compare.Char.(path.[j] = delim) then
       do_slashes (String.sub path i (j - i) :: acc) limit j
-    else
-      do_component acc limit i (j + 1) in
-  if Compare.Int.(limit > 0) then
-    do_slashes [] limit 0
-  else
-    [ path ]
+    else do_component acc limit i (j + 1)
+  in
+  if Compare.Int.(limit > 0) then do_slashes [] limit 0 else [path]
 
 let pp_print_paragraph ppf description =
-  Format.fprintf ppf "@[%a@]"
+  Format.fprintf
+    ppf
+    "@[%a@]"
     Format.(pp_print_list ~pp_sep:pp_print_space pp_print_string)
     (split ' ' description)
 
 let take n l =
   let rec loop acc n = function
-    | xs when Compare.Int.(n <= 0) -> Some (List.rev acc, xs)
-    | [] -> None
-    | x :: xs -> loop (x :: acc) (n-1) xs in
+    | xs when Compare.Int.(n <= 0) ->
+        Some (List.rev acc, xs)
+    | [] ->
+        None
+    | x :: xs ->
+        loop (x :: acc) (n - 1) xs
+  in
   loop [] n l
 
 let remove_prefix ~prefix s =
@@ -86,10 +81,12 @@ let remove_prefix ~prefix s =
   let n = String.length s in
   if Compare.Int.(n >= x) && Compare.String.(String.sub s 0 x = prefix) then
     Some (String.sub s x (n - x))
-  else
-    None
+  else None
 
 let rec remove_elem_from_list nb = function
-  | [] -> []
-  | l when Compare.Int.(nb <= 0) -> l
-  | _ :: tl -> remove_elem_from_list (nb - 1) tl
+  | [] ->
+      []
+  | l when Compare.Int.(nb <= 0) ->
+      l
+  | _ :: tl ->
+      remove_elem_from_list (nb - 1) tl

vendors/ligo-utils/tezos-protocol-alpha/misc.mli

@@ -26,19 +26,22 @@
 (** {2 Helper functions} *)
 
 type 'a lazyt = unit -> 'a
-type 'a lazy_list_t = LCons of 'a * ('a lazy_list_t tzresult Lwt.t lazyt)
+
+type 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt
+
 type 'a lazy_list = 'a lazy_list_t tzresult Lwt.t
 
 (** Include bounds *)
-val (-->) : int -> int -> int list
-val (--->) : Int32.t -> Int32.t -> Int32.t list
+val ( --> ) : int -> int -> int list
+
+val ( ---> ) : Int32.t -> Int32.t -> Int32.t list
 
 val pp_print_paragraph : Format.formatter -> string -> unit
 
-val take: int -> 'a list -> ('a list * 'a list) option
+val take : int -> 'a list -> ('a list * 'a list) option
 
-(** Some (input with [prefix] removed), if string has [prefix], else [None] **)
-val remove_prefix: prefix:string -> string -> string option
+(** Some (input with [prefix] removed), if string has [prefix], else [None] *)
+val remove_prefix : prefix:string -> string -> string option
 
 (** [remove nb list] remove the first [nb] elements from the list [list]. *)
-val remove_elem_from_list: int -> 'a list -> 'a list
+val remove_elem_from_list : int -> 'a list -> 'a list

vendors/ligo-utils/tezos-protocol-alpha/nonce_hash.ml

@@ -26,12 +26,16 @@
 (* 32 *)
 let nonce_hash = "\069\220\169" (* nce(53) *)
 
-include Blake2B.Make(Base58)(struct
-    let name = "cycle_nonce"
-    let title = "A nonce hash"
-    let b58check_prefix = nonce_hash
-    let size = None
-  end)
+include Blake2B.Make
+          (Base58)
+          (struct
+            let name = "cycle_nonce"
 
-let () =
-  Base58.check_encoded_prefix b58check_encoding "nce" 53
+            let title = "A nonce hash"
+
+            let b58check_prefix = nonce_hash
+
+            let size = None
+          end)
+
+let () = Base58.check_encoded_prefix b58check_encoding "nce" 53