mirror of
https://github.com/leanprover/lean4.git
synced 2026-04-03 18:54:08 +00:00
Compare commits
22 Commits
sofia/open
...
joachim/ch
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
1430e218f2 | ||
|
|
67b6e815b9 | ||
|
|
33c3604b87 | ||
|
|
504e099c5d | ||
|
|
17795b02ee | ||
|
|
48800e438c | ||
|
|
f395593ffc | ||
|
|
a88f81bc28 | ||
|
|
313abdb49f | ||
|
|
f08983bf01 | ||
|
|
22308dbaaa | ||
|
|
51e87865c5 | ||
|
|
75ec8e42c8 | ||
|
|
9fc62b7042 | ||
|
|
583c223b16 | ||
|
|
ccc7157c08 | ||
|
|
05046dc3d7 | ||
|
|
43f18fd502 | ||
|
|
b06eb981a3 | ||
|
|
f72137f53a | ||
|
|
96dbc324f3 | ||
|
|
d6e69649b6 |
@@ -7,6 +7,11 @@ To build Lean you should use `make -j$(nproc) -C build/release`.
|
||||
The build uses `ccache`, and in a sandbox `ccache` may complain about read-only file systems.
|
||||
Use `CCACHE_READONLY` and `CCACHE_TEMPDIR` instead of disabling ccache completely.
|
||||
|
||||
To rebuild individual modules without a full build, use Lake directly:
|
||||
```
|
||||
cd src && lake build Init.Prelude
|
||||
```
|
||||
|
||||
## Running Tests
|
||||
|
||||
See `tests/README.md` for full documentation. Quick reference:
|
||||
@@ -56,6 +61,11 @@ make -C build/release/stage2 clean-stdlib
|
||||
```
|
||||
must be run manually before building.
|
||||
|
||||
To rebuild individual stage 2 modules without a full `make stage2`, use Lake directly:
|
||||
```
|
||||
cd build/release/stage2 && lake build Init.Prelude
|
||||
```
|
||||
|
||||
## New features
|
||||
|
||||
When asked to implement new features:
|
||||
|
||||
6
.github/workflows/build-template.yml
vendored
6
.github/workflows/build-template.yml
vendored
@@ -59,11 +59,11 @@ jobs:
|
||||
with:
|
||||
msystem: clang64
|
||||
# `:` means do not prefix with msystem
|
||||
pacboy: "make: python: cmake clang ccache gmp libuv openssl: git: zip: unzip: diffutils: binutils: tree: zstd tar:"
|
||||
pacboy: "make: python: cmake clang ccache gmp libuv git: zip: unzip: diffutils: binutils: tree: zstd tar:"
|
||||
if: runner.os == 'Windows'
|
||||
- name: Install Brew Packages
|
||||
run: |
|
||||
brew install ccache tree zstd coreutils gmp libuv openssl
|
||||
brew install ccache tree zstd coreutils gmp libuv
|
||||
if: runner.os == 'macOS'
|
||||
- name: Checkout
|
||||
uses: actions/checkout@v6
|
||||
@@ -92,7 +92,7 @@ jobs:
|
||||
run: |
|
||||
sudo dpkg --add-architecture i386
|
||||
sudo apt-get update
|
||||
sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386 libssl-dev:i386 pkgconf:i386
|
||||
sudo apt-get install -y gcc-multilib g++-multilib ccache libuv1-dev:i386 pkgconf:i386
|
||||
if: matrix.cmultilib
|
||||
- name: Restore Cache
|
||||
id: restore-cache
|
||||
|
||||
@@ -6,6 +6,6 @@ vscode:
|
||||
- leanprover.lean4
|
||||
|
||||
tasks:
|
||||
- name: Release build
|
||||
init: cmake --preset release
|
||||
- name: Build
|
||||
init: cmake --preset dev
|
||||
command: make -C build/release -j$(nproc || sysctl -n hw.logicalcpu)
|
||||
|
||||
@@ -8,16 +8,26 @@
|
||||
"configurePresets": [
|
||||
{
|
||||
"name": "release",
|
||||
"displayName": "Default development optimized build config",
|
||||
"displayName": "Release build config",
|
||||
"generator": "Unix Makefiles",
|
||||
"binaryDir": "${sourceDir}/build/release"
|
||||
},
|
||||
{
|
||||
"name": "dev",
|
||||
"displayName": "Default development optimized build config",
|
||||
"cacheVariables": {
|
||||
"STRIP_BINARIES": "OFF"
|
||||
},
|
||||
"generator": "Unix Makefiles",
|
||||
"binaryDir": "${sourceDir}/build/dev"
|
||||
},
|
||||
{
|
||||
"name": "debug",
|
||||
"displayName": "Debug build config",
|
||||
"cacheVariables": {
|
||||
"CMAKE_BUILD_TYPE": "Debug",
|
||||
"LEAN_EXTRA_CXX_FLAGS": "-DLEAN_DEFAULT_THREAD_STACK_SIZE=16*1024*1024",
|
||||
"CMAKE_BUILD_TYPE": "Debug"
|
||||
"STRIP_BINARIES": "OFF"
|
||||
},
|
||||
"generator": "Unix Makefiles",
|
||||
"binaryDir": "${sourceDir}/build/debug"
|
||||
@@ -26,7 +36,8 @@
|
||||
"name": "reldebug",
|
||||
"displayName": "Release with assertions enabled",
|
||||
"cacheVariables": {
|
||||
"CMAKE_BUILD_TYPE": "RelWithAssert"
|
||||
"CMAKE_BUILD_TYPE": "RelWithAssert",
|
||||
"STRIP_BINARIES": "OFF"
|
||||
},
|
||||
"generator": "Unix Makefiles",
|
||||
"binaryDir": "${sourceDir}/build/reldebug"
|
||||
@@ -38,6 +49,7 @@
|
||||
"LEAN_EXTRA_CXX_FLAGS": "-fsanitize=address,undefined -DLEAN_DEFAULT_THREAD_STACK_SIZE=16*1024*1024",
|
||||
"LEANC_EXTRA_CC_FLAGS": "-fsanitize=address,undefined",
|
||||
"LEAN_EXTRA_LINKER_FLAGS": "-fsanitize=address,undefined -fsanitize-link-c++-runtime",
|
||||
"STRIP_BINARIES": "OFF",
|
||||
"SMALL_ALLOCATOR": "OFF",
|
||||
"USE_MIMALLOC": "OFF",
|
||||
"BSYMBOLIC": "OFF",
|
||||
@@ -58,6 +70,10 @@
|
||||
"name": "release",
|
||||
"configurePreset": "release"
|
||||
},
|
||||
{
|
||||
"name": "dev",
|
||||
"configurePreset": "dev"
|
||||
},
|
||||
{
|
||||
"name": "debug",
|
||||
"configurePreset": "debug"
|
||||
@@ -81,6 +97,11 @@
|
||||
"configurePreset": "release",
|
||||
"output": {"outputOnFailure": true, "shortProgress": true}
|
||||
},
|
||||
{
|
||||
"name": "dev",
|
||||
"configurePreset": "dev",
|
||||
"output": {"outputOnFailure": true, "shortProgress": true}
|
||||
},
|
||||
{
|
||||
"name": "debug",
|
||||
"configurePreset": "debug",
|
||||
|
||||
@@ -9,7 +9,6 @@ Requirements
|
||||
- [CMake](http://www.cmake.org)
|
||||
- [GMP (GNU multiprecision library)](http://gmplib.org/)
|
||||
- [LibUV](https://libuv.org/)
|
||||
- [OpenSSL](https://www.openssl.org/)
|
||||
|
||||
Platform-Specific Setup
|
||||
-----------------------
|
||||
@@ -31,6 +30,9 @@ cd lean4
|
||||
cmake --preset release
|
||||
make -C build/release -j$(nproc || sysctl -n hw.logicalcpu)
|
||||
```
|
||||
|
||||
For development, `cmake --preset dev` is recommended instead.
|
||||
|
||||
You can replace `$(nproc || sysctl -n hw.logicalcpu)` with the desired parallelism amount.
|
||||
|
||||
The above commands will compile the Lean library and binaries into the
|
||||
|
||||
@@ -32,7 +32,7 @@ MSYS2 has a package management system, [pacman][pacman].
|
||||
Here are the commands to install all dependencies needed to compile Lean on your machine.
|
||||
|
||||
```bash
|
||||
pacman -S make python mingw-w64-clang-x86_64-cmake mingw-w64-clang-x86_64-clang mingw-w64-clang-x86_64-ccache mingw-w64-clang-x86_64-libuv mingw-w64-clang-x86_64-gmp mingw-w64-clang-x86_64-openssl git unzip diffutils binutils
|
||||
pacman -S make python mingw-w64-clang-x86_64-cmake mingw-w64-clang-x86_64-clang mingw-w64-clang-x86_64-ccache mingw-w64-clang-x86_64-libuv mingw-w64-clang-x86_64-gmp git unzip diffutils binutils
|
||||
```
|
||||
|
||||
You should now be able to run these commands:
|
||||
|
||||
@@ -32,13 +32,12 @@ following to use `g++`.
|
||||
cmake -DCMAKE_CXX_COMPILER=g++ ...
|
||||
```
|
||||
|
||||
## Required Packages: CMake, GMP, libuv, OpenSSL, pkgconf
|
||||
## Required Packages: CMake, GMP, libuv, pkgconf
|
||||
|
||||
```bash
|
||||
brew install cmake
|
||||
brew install gmp
|
||||
brew install libuv
|
||||
brew install openssl
|
||||
brew install pkgconf
|
||||
```
|
||||
|
||||
|
||||
@@ -8,5 +8,5 @@ follow the [generic build instructions](index.md).
|
||||
## Basic packages
|
||||
|
||||
```bash
|
||||
sudo apt-get install git libgmp-dev libuv1-dev libssl-dev cmake ccache clang pkgconf
|
||||
sudo apt-get install git libgmp-dev libuv1-dev cmake ccache clang pkgconf
|
||||
```
|
||||
|
||||
22
flake.nix
22
flake.nix
@@ -24,7 +24,7 @@
|
||||
stdenv = pkgs.overrideCC pkgs.stdenv llvmPackages.clang;
|
||||
} ({
|
||||
buildInputs = with pkgs; [
|
||||
cmake gmp libuv ccache pkg-config openssl openssl.dev
|
||||
cmake gmp libuv ccache pkg-config
|
||||
llvmPackages.bintools # wrapped lld
|
||||
llvmPackages.llvm # llvm-symbolizer for asan/lsan
|
||||
gdb
|
||||
@@ -34,21 +34,7 @@
|
||||
hardeningDisable = [ "all" ];
|
||||
# more convenient `ctest` output
|
||||
CTEST_OUTPUT_ON_FAILURE = 1;
|
||||
} // pkgs.lib.optionalAttrs pkgs.stdenv.isLinux (let
|
||||
# Build OpenSSL 3 statically using pkgsDist's old-glibc stdenv,
|
||||
# so the resulting static libs don't require newer glibc symbols.
|
||||
opensslForDist = pkgsDist.stdenv.mkDerivation {
|
||||
name = "openssl-static-${pkgs.lib.getVersion pkgs.openssl.name}";
|
||||
inherit (pkgs.openssl) src;
|
||||
nativeBuildInputs = [ pkgsDist.perl ];
|
||||
configurePhase = ''
|
||||
patchShebangs .
|
||||
./config --prefix=$out no-shared no-tests
|
||||
'';
|
||||
buildPhase = "make -j$NIX_BUILD_CORES";
|
||||
installPhase = "make install_sw";
|
||||
};
|
||||
in {
|
||||
} // pkgs.lib.optionalAttrs pkgs.stdenv.isLinux {
|
||||
GMP = (pkgsDist.gmp.override { withStatic = true; }).overrideAttrs (attrs:
|
||||
pkgs.lib.optionalAttrs (pkgs.stdenv.system == "aarch64-linux") {
|
||||
# would need additional linking setup on Linux aarch64, we don't use it anywhere else either
|
||||
@@ -67,15 +53,13 @@
|
||||
};
|
||||
doCheck = false;
|
||||
});
|
||||
OPENSSL = opensslForDist;
|
||||
OPENSSL_DEV = opensslForDist;
|
||||
GLIBC = pkgsDist.glibc;
|
||||
GLIBC_DEV = pkgsDist.glibc.dev;
|
||||
GCC_LIB = pkgsDist.gcc.cc.lib;
|
||||
ZLIB = pkgsDist.zlib;
|
||||
# for CI coredumps
|
||||
GDB = pkgsDist.gdb;
|
||||
}));
|
||||
});
|
||||
in {
|
||||
devShells.${system} = {
|
||||
# The default development shell for working on lean itself
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
#!/usr/bin/env bash
|
||||
set -euxo pipefail
|
||||
|
||||
# run from root build directory (from inside nix-shell or otherwise defining GLIBC/ZLIB/GMP/OPENSSL) as in
|
||||
# run from root build directory (from inside nix-shell or otherwise defining GLIBC/ZLIB/GMP) as in
|
||||
# ```
|
||||
# eval cmake ../.. $(../../script/prepare-llvm-linux.sh ~/Downloads/lean-llvm-x86_64-linux-gnu.tar.zst)
|
||||
# ```
|
||||
@@ -42,8 +42,6 @@ $CP $GLIBC/lib/*crt* stage1/lib/
|
||||
# runtime
|
||||
(cd llvm; $CP --parents lib/clang/*/lib/*/{clang_rt.*.o,libclang_rt.builtins*} ../stage1)
|
||||
$CP llvm/lib/*/lib{c++,c++abi,unwind}.* $GMP/lib/libgmp.a $LIBUV/lib/libuv.a stage1/lib/
|
||||
# bundle OpenSSL static libs
|
||||
cp $OPENSSL/lib/libssl.a $OPENSSL/lib/libcrypto.a stage1/lib/
|
||||
# LLVM 19 appears to ship the dependencies in 'llvm/lib/<target-triple>/' and 'llvm/include/<target-triple>/'
|
||||
# but clang-19 that we use to compile is linked against 'llvm/lib/' and 'llvm/include'
|
||||
# https://github.com/llvm/llvm-project/issues/54955
|
||||
@@ -59,7 +57,6 @@ for f in $GLIBC/lib/{ld,lib{c,dl,m,rt,pthread}}-*; do b=$(basename $f); cp $f st
|
||||
OPTIONS=()
|
||||
# We build cadical using the custom toolchain on Linux to avoid glibc versioning issues
|
||||
echo -n " -DLEAN_STANDALONE=ON -DCADICAL_USE_CUSTOM_CXX=ON"
|
||||
echo -n " -DOPENSSL_INCLUDE_DIR=$OPENSSL_DEV/include -DOPENSSL_SSL_LIBRARY=$OPENSSL/lib/libssl.a -DOPENSSL_CRYPTO_LIBRARY=$OPENSSL/lib/libcrypto.a"
|
||||
echo -n " -DCMAKE_CXX_COMPILER=$PWD/llvm-host/bin/clang++ -DLEAN_CXX_STDLIB='-Wl,-Bstatic -lc++ -lc++abi -Wl,-Bdynamic'"
|
||||
# these should also be used for cadical, so do not use `LEAN_EXTRA_CXX_FLAGS` here
|
||||
echo -n " -DCMAKE_CXX_FLAGS='--sysroot $PWD/llvm -idirafter $GLIBC_DEV/include ${EXTRA_FLAGS:-}'"
|
||||
@@ -77,8 +74,8 @@ fi
|
||||
echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang"
|
||||
# ld.so is usually included by the libc.so linker script but we discard those. Make sure it is linked to only after `libc.so` like in the original
|
||||
# linker script so that no libc symbols are bound to it instead.
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/glibc -lc -lc_nonshared -Wl,--as-needed -l:ld.so -Wl,--no-as-needed -lpthread_nonshared -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -lssl -lcrypto -Wl,-Bdynamic -Wl,--no-as-needed -Wl,--disable-new-dtags,-rpath,ROOT/lib -fuse-ld=lld'"
|
||||
# when not using the above flags, link GMP/libuv/OpenSSL dynamically/as usual
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -luv -Wl,-Bstatic -lssl -lcrypto -Wl,-Bdynamic -lpthread -ldl -lrt -Wl,--no-as-needed'"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -L ROOT/lib/glibc -lc -lc_nonshared -Wl,--as-needed -l:ld.so -Wl,--no-as-needed -lpthread_nonshared -Wl,--as-needed -Wl,-Bstatic -lgmp -lunwind -luv -Wl,-Bdynamic -Wl,--no-as-needed -fuse-ld=lld'"
|
||||
# when not using the above flags, link GMP dynamically/as usual
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-Wl,--as-needed -lgmp -luv -lpthread -ldl -lrt -Wl,--no-as-needed'"
|
||||
# do not set `LEAN_CC` for tests
|
||||
echo -n " -DLEAN_TEST_VARS=''"
|
||||
|
||||
@@ -10,7 +10,6 @@ set -uxo pipefail
|
||||
|
||||
GMP=${GMP:-$(brew --prefix)}
|
||||
LIBUV=${LIBUV:-$(brew --prefix)}
|
||||
OPENSSL=${OPENSSL:-$(brew --prefix openssl@3)}
|
||||
|
||||
[[ -d llvm ]] || (mkdir llvm; gtar xf $1 --strip-components 1 --directory llvm)
|
||||
[[ -d llvm-host ]] || if [[ "$#" -gt 1 ]]; then
|
||||
@@ -42,7 +41,6 @@ gcp llvm/lib/libc++.dylib stage1/lib/libc
|
||||
# and apparently since Sonoma does not do so implicitly either
|
||||
install_name_tool -id /usr/lib/libc++.dylib stage1/lib/libc/libc++.dylib
|
||||
echo -n " -DLEAN_STANDALONE=ON"
|
||||
echo -n " -DOPENSSL_INCLUDE_DIR=$OPENSSL/include -DOPENSSL_SSL_LIBRARY=$OPENSSL/lib/libssl.a -DOPENSSL_CRYPTO_LIBRARY=$OPENSSL/lib/libcrypto.a"
|
||||
# do not change C++ compiler; libc++ etc. being system libraries means there's no danger of conflicts,
|
||||
# and the custom clang++ outputs a myriad of warnings when consuming the SDK
|
||||
echo -n " -DLEAN_EXTRA_CXX_FLAGS='${EXTRA_FLAGS:-}'"
|
||||
@@ -50,7 +48,7 @@ if [[ -L llvm-host ]]; then
|
||||
echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang"
|
||||
gcp $GMP/lib/libgmp.a stage1/lib/
|
||||
gcp $LIBUV/lib/libuv.a stage1/lib/
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp -luv $OPENSSL/lib/libssl.a $OPENSSL/lib/libcrypto.a'"
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp -luv'"
|
||||
else
|
||||
echo -n " -DCMAKE_C_COMPILER=$PWD/llvm-host/bin/clang -DLEANC_OPTS='--sysroot $PWD/stage1 -resource-dir $PWD/stage1/lib/clang/15.0.1 ${EXTRA_FLAGS:-}'"
|
||||
fi
|
||||
|
||||
@@ -40,14 +40,14 @@ cp /clang64/lib/{crtbegin,crtend,crt2,dllcrt2}.o stage1/lib/
|
||||
# tells the compiler how to dynamically link against `bcrypt.dll` (which is located in the System32 folder).
|
||||
# This distinction is relevant specifically for `libicu.a`/`icu.dll` because there we want updates to the time zone database to
|
||||
# be delivered to users via Windows Update without having to recompile Lean or Lean programs.
|
||||
cp /clang64/lib/lib{m,bcrypt,mingw32,moldname,mingwex,msvcrt,pthread,advapi32,shell32,user32,kernel32,ucrtbase,psapi,iphlpapi,userenv,ws2_32,dbghelp,ole32,icu,crypt32,gdi32}.* /clang64/lib/libgmp.a /clang64/lib/libuv.a /clang64/lib/libssl.a /clang64/lib/libcrypto.a llvm/lib/lib{c++,c++abi,unwind}.a stage1/lib/
|
||||
cp /clang64/lib/lib{m,bcrypt,mingw32,moldname,mingwex,msvcrt,pthread,advapi32,shell32,user32,kernel32,ucrtbase,psapi,iphlpapi,userenv,ws2_32,dbghelp,ole32,icu}.* /clang64/lib/libgmp.a /clang64/lib/libuv.a llvm/lib/lib{c++,c++abi,unwind}.a stage1/lib/
|
||||
echo -n " -DLEAN_STANDALONE=ON"
|
||||
echo -n " -DCMAKE_C_COMPILER=$PWD/stage1/bin/clang.exe -DCMAKE_C_COMPILER_WORKS=1 -DCMAKE_CXX_COMPILER=$PWD/llvm/bin/clang++.exe -DCMAKE_CXX_COMPILER_WORKS=1 -DLEAN_CXX_STDLIB='-lc++ -lc++abi'"
|
||||
echo -n " -DSTAGE0_CMAKE_C_COMPILER=clang -DSTAGE0_CMAKE_CXX_COMPILER=clang++"
|
||||
echo -n " -DLEAN_EXTRA_CXX_FLAGS='--sysroot $PWD/llvm -idirafter /clang64/include/'"
|
||||
echo -n " -DLEANC_INTERNAL_FLAGS='--sysroot ROOT -nostdinc -isystem ROOT/include/clang' -DLEANC_CC=ROOT/bin/clang.exe"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -Wl,-Bstatic -lgmp $(pkg-config --static --libs libuv) -lssl -lcrypto -lunwind -Wl,-Bdynamic -lcrypt32 -lgdi32 -fuse-ld=lld'"
|
||||
# when not using the above flags, link GMP/libuv/OpenSSL dynamically/as usual. Always link ICU dynamically.
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp $(pkg-config --libs libuv) -lssl -lcrypto -lcrypt32 -lgdi32 -lucrtbase'"
|
||||
echo -n " -DLEANC_INTERNAL_LINKER_FLAGS='--sysroot ROOT -L ROOT/lib -Wl,-Bstatic -lgmp $(pkg-config --static --libs libuv) -lunwind -Wl,-Bdynamic -fuse-ld=lld'"
|
||||
# when not using the above flags, link GMP dynamically/as usual. Always link ICU dynamically.
|
||||
echo -n " -DLEAN_EXTRA_LINKER_FLAGS='-lgmp $(pkg-config --libs libuv) -lucrtbase'"
|
||||
# do not set `LEAN_CC` for tests
|
||||
echo -n " -DLEAN_TEST_VARS=''"
|
||||
|
||||
@@ -80,6 +80,7 @@ option(CCACHE "use ccache" ON)
|
||||
option(SPLIT_STACK "SPLIT_STACK" OFF)
|
||||
# When OFF we disable LLVM support
|
||||
option(LLVM "LLVM" OFF)
|
||||
option(STRIP_BINARIES "Strip produced binaries" ON)
|
||||
|
||||
# When ON we include githash in the version string
|
||||
option(USE_GITHASH "GIT_HASH" ON)
|
||||
@@ -356,48 +357,6 @@ if(NOT LEAN_STANDALONE)
|
||||
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${LIBUV_LDFLAGS}")
|
||||
endif()
|
||||
|
||||
# OpenSSL
|
||||
if("${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
|
||||
# Only on WebAssembly we compile OpenSSL ourselves
|
||||
set(OPENSSL_EMSCRIPTEN_FLAGS "${EMSCRIPTEN_SETTINGS}")
|
||||
|
||||
# OpenSSL needs to be configured for Emscripten using their configuration system
|
||||
ExternalProject_add(openssl
|
||||
PREFIX openssl
|
||||
GIT_REPOSITORY https://github.com/openssl/openssl
|
||||
# Sync version with flake.nix if applicable
|
||||
GIT_TAG openssl-3.0.15
|
||||
CONFIGURE_COMMAND <SOURCE_DIR>/Configure linux-generic32 no-shared no-dso no-engine no-tests --prefix=<INSTALL_DIR> CC=${CMAKE_C_COMPILER} CXX=${CMAKE_CXX_COMPILER} AR=${CMAKE_AR} CFLAGS=${OPENSSL_EMSCRIPTEN_FLAGS}
|
||||
BUILD_COMMAND emmake make -j
|
||||
INSTALL_COMMAND emmake make install_sw
|
||||
BUILD_IN_SOURCE ON)
|
||||
set(OPENSSL_INCLUDE_DIR "${CMAKE_BINARY_DIR}/openssl/include")
|
||||
set(OPENSSL_CRYPTO_LIBRARY "${CMAKE_BINARY_DIR}/openssl/lib/libcrypto.a")
|
||||
set(OPENSSL_SSL_LIBRARY "${CMAKE_BINARY_DIR}/openssl/lib/libssl.a")
|
||||
set(OPENSSL_LIBRARIES "${OPENSSL_SSL_LIBRARY} ${OPENSSL_CRYPTO_LIBRARY}")
|
||||
else()
|
||||
find_package(OpenSSL 3 REQUIRED)
|
||||
set(OPENSSL_LIBRARIES ${OPENSSL_SSL_LIBRARY} ${OPENSSL_CRYPTO_LIBRARY})
|
||||
endif()
|
||||
include_directories(${OPENSSL_INCLUDE_DIR})
|
||||
string(JOIN " " OPENSSL_LIBRARIES_STR ${OPENSSL_LIBRARIES})
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " ${OPENSSL_LIBRARIES_STR}")
|
||||
|
||||
if(NOT LEAN_STANDALONE)
|
||||
string(APPEND LEAN_EXTRA_LINKER_FLAGS " ${OPENSSL_LIBRARIES_STR}")
|
||||
endif()
|
||||
|
||||
if(CMAKE_SYSTEM_NAME MATCHES "Linux")
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -Wl,--disable-new-dtags,-rpath,$$ORIGIN")
|
||||
endif()
|
||||
|
||||
if(CMAKE_SYSTEM_NAME MATCHES "Windows")
|
||||
string(APPEND LEANSHARED_LINKER_FLAGS " -lcrypt32 -lgdi32")
|
||||
if(NOT LEAN_STANDALONE)
|
||||
string(APPEND LEAN_EXTRA_LINKER_FLAGS " -lcrypt32 -lgdi32")
|
||||
endif()
|
||||
endif()
|
||||
|
||||
# Windows SDK (for ICU)
|
||||
if(CMAKE_SYSTEM_NAME MATCHES "Windows")
|
||||
# Pass 'tools' to skip MSVC version check (as MSVC/Visual Studio is not necessarily installed)
|
||||
@@ -656,6 +615,38 @@ else()
|
||||
OUTPUT_VARIABLE GIT_SHA1
|
||||
OUTPUT_STRIP_TRAILING_WHITESPACE
|
||||
)
|
||||
# Fallback for jj workspaces where git cannot find .git directly.
|
||||
# Use `jj git root` to find the backing git repo, then `jj log` to
|
||||
# resolve the current workspace's commit (git HEAD points to the root
|
||||
# workspace, not the current one).
|
||||
if("${GIT_SHA1}" STREQUAL "")
|
||||
find_program(JJ_EXECUTABLE jj)
|
||||
if(JJ_EXECUTABLE)
|
||||
execute_process(
|
||||
COMMAND "${JJ_EXECUTABLE}" git root
|
||||
WORKING_DIRECTORY "${CMAKE_CURRENT_SOURCE_DIR}"
|
||||
OUTPUT_VARIABLE _jj_git_dir
|
||||
OUTPUT_STRIP_TRAILING_WHITESPACE
|
||||
ERROR_QUIET
|
||||
RESULT_VARIABLE _jj_git_root_result
|
||||
)
|
||||
execute_process(
|
||||
COMMAND "${JJ_EXECUTABLE}" log -r @ --no-graph -T "commit_id"
|
||||
WORKING_DIRECTORY "${CMAKE_CURRENT_SOURCE_DIR}"
|
||||
OUTPUT_VARIABLE _jj_commit
|
||||
OUTPUT_STRIP_TRAILING_WHITESPACE
|
||||
ERROR_QUIET
|
||||
RESULT_VARIABLE _jj_rev_result
|
||||
)
|
||||
if(_jj_git_root_result EQUAL 0 AND _jj_rev_result EQUAL 0)
|
||||
execute_process(
|
||||
COMMAND git --git-dir "${_jj_git_dir}" ls-tree "${_jj_commit}" stage0 --object-only
|
||||
OUTPUT_VARIABLE GIT_SHA1
|
||||
OUTPUT_STRIP_TRAILING_WHITESPACE
|
||||
)
|
||||
endif()
|
||||
endif()
|
||||
endif()
|
||||
message(STATUS "stage0 sha1: ${GIT_SHA1}")
|
||||
# Now that we've prepared the information for the next stage, we can forget that we will use
|
||||
# Lake in the future as we won't use it in this stage
|
||||
@@ -772,9 +763,9 @@ if(STAGE GREATER 1)
|
||||
endif()
|
||||
else()
|
||||
add_subdirectory(runtime)
|
||||
if("${CMAKE_SYSTEM_NAME}" MATCHES "Emscripten")
|
||||
add_dependencies(leanrt libuv openssl)
|
||||
add_dependencies(leanrt_initial-exec libuv openssl)
|
||||
if(CMAKE_SYSTEM_NAME MATCHES "Emscripten")
|
||||
add_dependencies(leanrt libuv)
|
||||
add_dependencies(leanrt_initial-exec libuv)
|
||||
endif()
|
||||
|
||||
add_subdirectory(util)
|
||||
@@ -839,7 +830,14 @@ if(LLVM AND STAGE GREATER 0)
|
||||
set(EXTRA_LEANMAKE_OPTS "LLVM=1")
|
||||
endif()
|
||||
|
||||
set(STDLIBS Init Std Lean Leanc LeanIR)
|
||||
set(
|
||||
STDLIBS
|
||||
Init
|
||||
Std
|
||||
Lean
|
||||
Leanc
|
||||
LeanIR
|
||||
)
|
||||
if(NOT CMAKE_SYSTEM_NAME MATCHES "Emscripten")
|
||||
list(APPEND STDLIBS Lake LeanChecker)
|
||||
endif()
|
||||
@@ -947,10 +945,7 @@ if(PREV_STAGE)
|
||||
endif()
|
||||
|
||||
if(NOT CMAKE_SYSTEM_NAME MATCHES "Emscripten")
|
||||
add_custom_target(leanir ALL
|
||||
DEPENDS leanshared
|
||||
COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make leanir
|
||||
VERBATIM)
|
||||
add_custom_target(leanir ALL DEPENDS leanshared COMMAND $(MAKE) -f ${CMAKE_BINARY_DIR}/stdlib.make leanir VERBATIM)
|
||||
endif()
|
||||
|
||||
# use Bash version for building, use Lean version in bin/ for tests & distribution
|
||||
|
||||
@@ -9,7 +9,7 @@ prelude
|
||||
public import Init.Data.Order.Ord
|
||||
public import Init.Data.String.Basic
|
||||
import Init.Data.Char.Lemmas
|
||||
import Init.Data.String.Lemmas
|
||||
import Init.Data.String.Lemmas.StringOrder
|
||||
|
||||
public section
|
||||
|
||||
|
||||
@@ -17,6 +17,7 @@ namespace Std
|
||||
/--
|
||||
Appends all the elements in the iterator, in order.
|
||||
-/
|
||||
@[inline]
|
||||
public def Iter.joinString {α β : Type} [Iterator α Id β] [ToString β]
|
||||
(it : Std.Iter (α := α) β) : String :=
|
||||
(it.map toString).fold (init := "") (· ++ ·)
|
||||
|
||||
@@ -20,49 +20,4 @@ public import Init.Data.String.Lemmas.Intercalate
|
||||
public import Init.Data.String.Lemmas.Iter
|
||||
public import Init.Data.String.Lemmas.Hashable
|
||||
public import Init.Data.String.Lemmas.TakeDrop
|
||||
import Init.Data.Order.Lemmas
|
||||
public import Init.Data.String.Basic
|
||||
import Init.Data.Char.Lemmas
|
||||
import Init.Data.Char.Order
|
||||
import Init.Data.List.Lex
|
||||
|
||||
public section
|
||||
|
||||
open Std
|
||||
|
||||
namespace String
|
||||
|
||||
@[deprecated toList_inj (since := "2025-10-30")]
|
||||
protected theorem data_eq_of_eq {a b : String} (h : a = b) : a.toList = b.toList :=
|
||||
h ▸ rfl
|
||||
@[deprecated toList_inj (since := "2025-10-30")]
|
||||
protected theorem ne_of_data_ne {a b : String} (h : a.toList ≠ b.toList) : a ≠ b := by
|
||||
simpa [← toList_inj]
|
||||
|
||||
@[simp] protected theorem not_le {a b : String} : ¬ a ≤ b ↔ b < a := Decidable.not_not
|
||||
@[simp] protected theorem not_lt {a b : String} : ¬ a < b ↔ b ≤ a := Iff.rfl
|
||||
@[simp] protected theorem le_refl (a : String) : a ≤ a := List.le_refl _
|
||||
@[simp] protected theorem lt_irrefl (a : String) : ¬ a < a := List.lt_irrefl _
|
||||
|
||||
attribute [local instance] Char.notLTTrans Char.ltTrichotomous Char.ltAsymm
|
||||
|
||||
protected theorem le_trans {a b c : String} : a ≤ b → b ≤ c → a ≤ c := List.le_trans
|
||||
protected theorem lt_trans {a b c : String} : a < b → b < c → a < c := List.lt_trans
|
||||
protected theorem le_total (a b : String) : a ≤ b ∨ b ≤ a := List.le_total _ _
|
||||
protected theorem le_antisymm {a b : String} : a ≤ b → b ≤ a → a = b := fun h₁ h₂ => String.ext (List.le_antisymm (as := a.toList) (bs := b.toList) h₁ h₂)
|
||||
protected theorem lt_asymm {a b : String} (h : a < b) : ¬ b < a := List.lt_asymm h
|
||||
protected theorem ne_of_lt {a b : String} (h : a < b) : a ≠ b := by
|
||||
have := String.lt_irrefl a
|
||||
intro h; subst h; contradiction
|
||||
|
||||
instance instIsLinearOrder : IsLinearOrder String := by
|
||||
apply IsLinearOrder.of_le
|
||||
case le_antisymm => constructor; apply String.le_antisymm
|
||||
case le_trans => constructor; apply String.le_trans
|
||||
case le_total => constructor; apply String.le_total
|
||||
|
||||
instance : LawfulOrderLT String where
|
||||
lt_iff a b := by
|
||||
simp [← String.not_le, Decidable.imp_iff_not_or, Std.Total.total]
|
||||
|
||||
end String
|
||||
public import Init.Data.String.Lemmas.StringOrder
|
||||
|
||||
@@ -40,7 +40,7 @@ framework.
|
||||
/--
|
||||
This data-carrying typeclass is used to give semantics to a pattern type that implements
|
||||
{name}`ForwardPattern` and/or {name}`ToForwardSearcher` by providing an abstract, not necessarily
|
||||
decidable {name}`PatternModel.Matches` predicate that implementates of {name}`ForwardPattern`
|
||||
decidable {name}`PatternModel.Matches` predicate that implementations of {name}`ForwardPattern`
|
||||
and {name}`ToForwardSearcher` can be validated against.
|
||||
|
||||
Correctness results for generic functions relying on the pattern infrastructure, for example the
|
||||
@@ -151,7 +151,7 @@ theorem IsLongestMatch.le_of_isMatch {pat : ρ} [PatternModel pat] {s : Slice} {
|
||||
|
||||
/--
|
||||
Predicate stating that the region between the start of the slice {name}`s` and the position
|
||||
{name}`pos` matches the patten {name}`pat`, and that there is no longer match starting at the
|
||||
{name}`pos` matches the pattern {name}`pat`, and that there is no longer match starting at the
|
||||
beginning of the slice. This is what a correct matcher should match.
|
||||
|
||||
In some cases, being a match and being a longest match will coincide, see
|
||||
@@ -228,7 +228,7 @@ theorem isLongestRevMatch_iff_isRevMatch {ρ : Type} (pat : ρ) [PatternModel pa
|
||||
exact ht₅ (NoSuffixPatternModel.eq_empty _ _ ht₂ (ht₅'' ▸ ht₂'))
|
||||
|
||||
/--
|
||||
Predicate stating that the slice formed by {name}`startPos` and {name}`endPos` contains is a match
|
||||
Predicate stating that the slice formed by {name}`startPos` and {name}`endPos` contains a match
|
||||
of {name}`pat` in {name}`s` and it is longest among matches starting at {name}`startPos`.
|
||||
-/
|
||||
structure IsLongestMatchAt (pat : ρ) [PatternModel pat] {s : Slice} (startPos endPos : s.Pos) : Prop where
|
||||
@@ -411,7 +411,7 @@ theorem not_revMatchesAt_startPos {pat : ρ} [PatternModel pat] {s : Slice} :
|
||||
intro h
|
||||
simpa [← Pos.ofSliceTo_inj] using h.ne_endPos
|
||||
|
||||
theorem revMatchesAt_iff_revMatchesAt_ofSliceto {pat : ρ} [PatternModel pat] {s : Slice} {base : s.Pos}
|
||||
theorem revMatchesAt_iff_revMatchesAt_ofSliceTo {pat : ρ} [PatternModel pat] {s : Slice} {base : s.Pos}
|
||||
{pos : (s.sliceTo base).Pos} : RevMatchesAt pat pos ↔ RevMatchesAt pat (Pos.ofSliceTo pos) := by
|
||||
simp only [revMatchesAt_iff_exists_isLongestRevMatchAt]
|
||||
constructor
|
||||
@@ -505,8 +505,8 @@ theorem LawfulForwardPatternModel.skipPrefix?_eq_none_iff {ρ : Type} {pat : ρ}
|
||||
/--
|
||||
Predicate stating compatibility between {name}`PatternModel` and {name}`BackwardPattern`.
|
||||
|
||||
This extends {name}`LawfulForwardPattern`, but it is much stronger because it forces the
|
||||
{name}`ForwardPattern` to match the longest prefix of the given slice that matches the property
|
||||
This extends {name}`LawfulBackwardPattern`, but it is much stronger because it forces the
|
||||
{name}`BackwardPattern` to match the longest prefix of the given slice that matches the property
|
||||
supplied by the {name}`PatternModel` instance.
|
||||
-/
|
||||
class LawfulBackwardPatternModel {ρ : Type} (pat : ρ) [BackwardPattern pat]
|
||||
|
||||
@@ -65,7 +65,7 @@ theorem startsWith_prop_eq_head? {P : Char → Prop} [DecidablePred P] {s : Slic
|
||||
s.startsWith P = s.copy.toList.head?.any (decide <| P ·) := by
|
||||
simp [startsWith_prop_eq_startsWith_decide, startsWith_bool_eq_head?]
|
||||
|
||||
theorem eq_append_of_dropPrefix_prop_eq_some {P : Char → Prop} [DecidablePred P] {s res : Slice} (h : s.dropPrefix? P = some res) :
|
||||
theorem eq_append_of_dropPrefix?_prop_eq_some {P : Char → Prop} [DecidablePred P] {s res : Slice} (h : s.dropPrefix? P = some res) :
|
||||
∃ c, s.copy = singleton c ++ res.copy ∧ P c := by
|
||||
rw [dropPrefix?_prop_eq_dropPrefix?_decide] at h
|
||||
simpa using eq_append_of_dropPrefix?_bool_eq_some h
|
||||
@@ -162,7 +162,7 @@ theorem startsWith_prop_eq_head? {P : Char → Prop} [DecidablePred P] {s : Stri
|
||||
theorem eq_append_of_dropPrefix?_prop_eq_some {P : Char → Prop} [DecidablePred P] {s : String} {res : Slice}
|
||||
(h : s.dropPrefix? P = some res) : ∃ c, s = singleton c ++ res.copy ∧ P c := by
|
||||
rw [dropPrefix?_eq_dropPrefix?_toSlice] at h
|
||||
simpa using Slice.eq_append_of_dropPrefix_prop_eq_some h
|
||||
simpa using Slice.eq_append_of_dropPrefix?_prop_eq_some h
|
||||
|
||||
theorem skipSuffix?_bool_eq_some_iff {p : Char → Bool} {s : String} {pos : s.Pos} :
|
||||
s.skipSuffix? p = some pos ↔ ∃ h, pos = s.endPos.prev h ∧ p ((s.endPos.prev h).get (by simp)) = true := by
|
||||
|
||||
49
src/Init/Data/String/Lemmas/StringOrder.lean
Normal file
49
src/Init/Data/String/Lemmas/StringOrder.lean
Normal file
@@ -0,0 +1,49 @@
|
||||
/-
|
||||
Copyright (c) 2024 Amazon.com, Inc. or its affiliates. All Rights Reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Leonardo de Moura
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.Data.String.Basic
|
||||
public import Init.Data.Order.Classes
|
||||
import Init.Data.List.Lex
|
||||
import Init.Data.Char.Lemmas
|
||||
import Init.Data.Char.Order
|
||||
import Init.Data.Order.Factories
|
||||
import Init.Data.Order.Lemmas
|
||||
|
||||
public section
|
||||
|
||||
open Std
|
||||
|
||||
namespace String
|
||||
|
||||
@[simp] protected theorem not_le {a b : String} : ¬ a ≤ b ↔ b < a := Decidable.not_not
|
||||
@[simp] protected theorem not_lt {a b : String} : ¬ a < b ↔ b ≤ a := Iff.rfl
|
||||
@[simp] protected theorem le_refl (a : String) : a ≤ a := List.le_refl _
|
||||
@[simp] protected theorem lt_irrefl (a : String) : ¬ a < a := List.lt_irrefl _
|
||||
|
||||
attribute [local instance] Char.notLTTrans Char.ltTrichotomous Char.ltAsymm
|
||||
|
||||
protected theorem le_trans {a b c : String} : a ≤ b → b ≤ c → a ≤ c := List.le_trans
|
||||
protected theorem lt_trans {a b c : String} : a < b → b < c → a < c := List.lt_trans
|
||||
protected theorem le_total (a b : String) : a ≤ b ∨ b ≤ a := List.le_total _ _
|
||||
protected theorem le_antisymm {a b : String} : a ≤ b → b ≤ a → a = b := fun h₁ h₂ => String.ext (List.le_antisymm (as := a.toList) (bs := b.toList) h₁ h₂)
|
||||
protected theorem lt_asymm {a b : String} (h : a < b) : ¬ b < a := List.lt_asymm h
|
||||
protected theorem ne_of_lt {a b : String} (h : a < b) : a ≠ b := by
|
||||
have := String.lt_irrefl a
|
||||
intro h; subst h; contradiction
|
||||
|
||||
instance instIsLinearOrder : IsLinearOrder String := by
|
||||
apply IsLinearOrder.of_le
|
||||
case le_antisymm => constructor; apply String.le_antisymm
|
||||
case le_trans => constructor; apply String.le_trans
|
||||
case le_total => constructor; apply String.le_total
|
||||
|
||||
instance : LawfulOrderLT String where
|
||||
lt_iff a b := by
|
||||
simp [← String.not_le, Decidable.imp_iff_not_or, Std.Total.total]
|
||||
|
||||
end String
|
||||
@@ -706,14 +706,14 @@ Returns {name}`none` otherwise.
|
||||
This function is generic over all currently supported patterns.
|
||||
-/
|
||||
@[inline]
|
||||
def Pos.revSkip? {s : Slice} (pos : s.Pos) (pat : ρ) [ForwardPattern pat] : Option s.Pos :=
|
||||
((s.sliceFrom pos).skipPrefix? pat).map Pos.ofSliceFrom
|
||||
def Pos.revSkip? {s : Slice} (pos : s.Pos) (pat : ρ) [BackwardPattern pat] : Option s.Pos :=
|
||||
((s.sliceFrom pos).skipSuffix? pat).map Pos.ofSliceFrom
|
||||
|
||||
/--
|
||||
If {name}`pat` matches a suffix of {name}`s`, returns the remainder. Returns {name}`none` otherwise.
|
||||
|
||||
Use {name (scope := "Init.Data.String.Slice")}`String.Slice.dropSuffix` to return the slice
|
||||
unchanged when {name}`pat` does not match a prefix.
|
||||
unchanged when {name}`pat` does not match a suffix.
|
||||
|
||||
This function is generic over all currently supported patterns.
|
||||
|
||||
@@ -775,7 +775,7 @@ def Pos.revSkipWhile {s : Slice} (pos : s.Pos) (pat : ρ) [BackwardPattern pat]
|
||||
termination_by pos.down
|
||||
|
||||
/--
|
||||
Returns the position a the start of the longest suffix of {name}`s` for which {name}`pat` matches
|
||||
Returns the position at the start of the longest suffix of {name}`s` for which {name}`pat` matches
|
||||
(potentially repeatedly).
|
||||
-/
|
||||
@[inline]
|
||||
|
||||
@@ -314,7 +314,7 @@ Returns {name}`none` otherwise.
|
||||
This function is generic over all currently supported patterns.
|
||||
-/
|
||||
@[inline]
|
||||
def Pos.revSkip? {s : String} (pos : s.Pos) (pat : ρ) [ForwardPattern pat] : Option s.Pos :=
|
||||
def Pos.revSkip? {s : String} (pos : s.Pos) (pat : ρ) [BackwardPattern pat] : Option s.Pos :=
|
||||
(pos.toSlice.revSkip? pat).map Pos.ofToSlice
|
||||
|
||||
/--
|
||||
@@ -461,7 +461,7 @@ def dropPrefix? (s : String) (pat : ρ) [ForwardPattern pat] : Option String.Sli
|
||||
If {name}`pat` matches a suffix of {name}`s`, returns the remainder. Returns {name}`none` otherwise.
|
||||
|
||||
Use {name (scope := "Init.Data.String.TakeDrop")}`String.dropSuffix` to return the slice
|
||||
unchanged when {name}`pat` does not match a prefix.
|
||||
unchanged when {name}`pat` does not match a suffix.
|
||||
|
||||
This is a cheap operation because it does not allocate a new string to hold the result.
|
||||
To convert the result into a string, use {name}`String.Slice.copy`.
|
||||
|
||||
@@ -30,13 +30,13 @@ simpMatchDiscrsOnly (match 0 with | 0 => true | _ => false) = true
|
||||
```
|
||||
using `eq_self`.
|
||||
-/
|
||||
def simpMatchDiscrsOnly {α : Sort u} (a : α) : α := a
|
||||
@[expose] def simpMatchDiscrsOnly {α : Sort u} (a : α) : α := a
|
||||
|
||||
/--
|
||||
Gadget for protecting lambda abstractions created by `abstractGroundMismatches?`
|
||||
from beta reduction during preprocessing. See `ProveEq.lean` for details.
|
||||
-/
|
||||
def abstractFn {α : Sort u} (a : α) : α := a
|
||||
@[expose] def abstractFn {α : Sort u} (a : α) : α := a
|
||||
|
||||
/-- Gadget for representing offsets `t+k` in patterns. -/
|
||||
def offset (a b : Nat) : Nat := a + b
|
||||
|
||||
@@ -624,6 +624,23 @@ existing code. It may be removed in a future version of the library.
|
||||
syntax (name := deprecated) "deprecated" (ppSpace ident)? (ppSpace str)?
|
||||
(" (" &"since" " := " str ")")? : attr
|
||||
|
||||
/--
|
||||
The attribute `@[deprecated_arg old new]` marks a named parameter as deprecated.
|
||||
|
||||
When a caller uses the old name with a replacement available, a deprecation warning is emitted
|
||||
and the argument is silently forwarded to the new parameter. When no replacement is provided,
|
||||
the parameter is treated as removed and using it produces an error.
|
||||
|
||||
* `@[deprecated_arg old new (since := "2026-03-18")]` marks `old` as a deprecated alias for `new`.
|
||||
* `@[deprecated_arg old new "use foo instead" (since := "2026-03-18")]` adds a custom message.
|
||||
* `@[deprecated_arg old (since := "2026-03-18")]` marks `old` as a removed parameter (no replacement).
|
||||
* `@[deprecated_arg old "no longer needed" (since := "2026-03-18")]` removed with a custom message.
|
||||
|
||||
A warning is emitted if `(since := "...")` is omitted.
|
||||
-/
|
||||
syntax (name := deprecated_arg) "deprecated_arg" ppSpace ident (ppSpace ident)? (ppSpace str)?
|
||||
(" (" &"since" " := " str ")")? : attr
|
||||
|
||||
/--
|
||||
The attribute `@[suggest_for ..]` on a declaration suggests likely ways in which
|
||||
someone might **incorrectly** refer to a definition.
|
||||
|
||||
@@ -36,9 +36,6 @@ private local instance : ToString Int where
|
||||
private local instance : Repr Int where
|
||||
reprPrec i prec := if i < 0 then Repr.addAppParen (toString i) prec else toString i
|
||||
|
||||
private local instance : Append String where
|
||||
append := String.Internal.append
|
||||
|
||||
/-- Internal representation of a linear combination of atoms, and a constant term. -/
|
||||
structure LinearCombo where
|
||||
/-- Constant term. -/
|
||||
|
||||
@@ -232,6 +232,7 @@ partial def checkCases (c : Cases .pure) : CheckM Unit := do
|
||||
withParams params do check k
|
||||
|
||||
partial def check (code : Code .pure) : CheckM Unit := do
|
||||
checkSystem "LCNF check"
|
||||
match code with
|
||||
| .let decl k => checkLetDecl decl; withFVarId decl.fvarId do check k
|
||||
| .fun decl k =>
|
||||
|
||||
@@ -21,7 +21,7 @@ Within a basic block, it is always safe to:
|
||||
until the later inc) and thus doing all relevant `inc` in the beginning doesn't change
|
||||
semantics.
|
||||
- Move all decrements on a variable to the last `dec` location (summing the counts). Because the
|
||||
value is guaranteed to stay alive until at least the last `dec` anyway so a similiar argument to
|
||||
value is guaranteed to stay alive until at least the last `dec` anyway so a similar argument to
|
||||
`inc` holds.
|
||||
|
||||
Crucially this pass must be placed after `expandResetReuse` as that one relies on `inc`s still being
|
||||
|
||||
@@ -69,8 +69,8 @@ open ImpureType
|
||||
abbrev Mask := Array (Option FVarId)
|
||||
|
||||
/--
|
||||
Try to erase `inc` instructions on projections of `targetId` occuring in the tail of `ds`.
|
||||
Return the updated `ds` and mask contianing the `FVarId`s whose `inc` was removed.
|
||||
Try to erase `inc` instructions on projections of `targetId` occurring in the tail of `ds`.
|
||||
Return the updated `ds` and mask containing the `FVarId`s whose `inc` was removed.
|
||||
-/
|
||||
partial def eraseProjIncFor (nFields : Nat) (targetId : FVarId) (ds : Array (CodeDecl .impure)) :
|
||||
CompilerM (Array (CodeDecl .impure) × Mask) := do
|
||||
|
||||
@@ -188,6 +188,7 @@ where
|
||||
profileitM Exception profilerName (← getOptions) do
|
||||
let mut state : (pu : Purity) × Array (Decl pu) := ⟨inPhase, decls⟩
|
||||
for pass in passes do
|
||||
checkSystem "LCNF compiler"
|
||||
state ← withTraceNode `Compiler (fun _ => return m!"compiler phase: {pass.phase}, pass: {pass.name}") do
|
||||
let decls ← withPhase pass.phase do
|
||||
state.fst.withAssertPurity pass.phase.toPurity fun h => do
|
||||
|
||||
@@ -453,6 +453,9 @@ Throws an internal interrupt exception if cancellation has been requested. The e
|
||||
caught by `try catch` but is intended to be caught by `Command.withLoggingExceptions` at the top
|
||||
level of elaboration. In particular, we want to skip producing further incremental snapshots after
|
||||
the exception has been thrown.
|
||||
|
||||
Like `checkSystem` but without the global heartbeat check, for callers that have their own
|
||||
heartbeat tracking (e.g. `SynthInstance`).
|
||||
-/
|
||||
@[inline] def checkInterrupted : CoreM Unit := do
|
||||
if let some tk := (← read).cancelTk? then
|
||||
|
||||
@@ -60,7 +60,7 @@ instance : EmptyCollection (Trie α) :=
|
||||
instance : Inhabited (Trie α) where
|
||||
default := empty
|
||||
|
||||
/-- Insert or update the value at a the given key `s`. -/
|
||||
/-- Insert or update the value at the given key `s`. -/
|
||||
partial def upsert (t : Trie α) (s : String) (f : Option α → α) : Trie α :=
|
||||
let rec insertEmpty (i : Nat) : Trie α :=
|
||||
if h : i < s.utf8ByteSize then
|
||||
@@ -100,7 +100,7 @@ partial def upsert (t : Trie α) (s : String) (f : Option α → α) : Trie α :
|
||||
node (f v) cs ts
|
||||
loop 0 t
|
||||
|
||||
/-- Inserts a value at a the given key `s`, overriding an existing value if present. -/
|
||||
/-- Inserts a value at the given key `s`, overriding an existing value if present. -/
|
||||
partial def insert (t : Trie α) (s : String) (val : α) : Trie α :=
|
||||
upsert t s (fun _ => val)
|
||||
|
||||
|
||||
@@ -39,6 +39,7 @@ public import Lean.Elab.Extra
|
||||
public import Lean.Elab.GenInjective
|
||||
public import Lean.Elab.BuiltinTerm
|
||||
public import Lean.Elab.Arg
|
||||
public import Lean.Elab.DeprecatedArg
|
||||
public import Lean.Elab.PatternVar
|
||||
public import Lean.Elab.ElabRules
|
||||
public import Lean.Elab.Macro
|
||||
|
||||
@@ -11,6 +11,7 @@ public import Lean.Elab.Binders
|
||||
public import Lean.Elab.RecAppSyntax
|
||||
public import Lean.IdentifierSuggestion
|
||||
import all Lean.Elab.ErrorUtils
|
||||
import Lean.Elab.DeprecatedArg
|
||||
import Init.Omega
|
||||
|
||||
public section
|
||||
@@ -88,6 +89,38 @@ def synthesizeAppInstMVars (instMVars : Array MVarId) (app : Expr) : TermElabM U
|
||||
private def findBinderName? (namedArgs : List NamedArg) (binderName : Name) : Option NamedArg :=
|
||||
namedArgs.find? fun namedArg => namedArg.name == binderName
|
||||
|
||||
/--
|
||||
If the function being applied is a constant, search `namedArgs` for an argument whose name is
|
||||
a deprecated alias of `binderName`. When `linter.deprecated.arg` is enabled (the default),
|
||||
returns `some namedArg` after emitting a deprecation warning with a code action hint. When the
|
||||
option is disabled, returns `none` (the old name falls through to the normal "invalid argument"
|
||||
error). The returned `namedArg` retains its original (old) name.
|
||||
-/
|
||||
private def findDeprecatedBinderName? (namedArgs : List NamedArg) (f : Expr) (binderName : Name) :
|
||||
TermElabM (Option NamedArg) := do
|
||||
unless linter.deprecated.arg.get <| ← getOptions do return .none
|
||||
unless f.getAppFn.isConst do return none
|
||||
let declName := f.getAppFn.constName!
|
||||
let env ← getEnv
|
||||
for namedArg in namedArgs do
|
||||
if let some entry := findDeprecatedArg? env declName namedArg.name then
|
||||
if entry.newArg? == some binderName then
|
||||
let msg := formatDeprecatedArgMsg entry
|
||||
let span? := namedArg.ref[1]
|
||||
let hint ←
|
||||
if span?.getHeadInfo matches .original .. then
|
||||
MessageData.hint "Rename this argument:" #[{
|
||||
suggestion := .string entry.newArg?.get!.toString
|
||||
span?
|
||||
toCodeActionTitle? := some fun s =>
|
||||
s!"Rename argument `{entry.oldArg}` to `{s}`"
|
||||
}]
|
||||
else
|
||||
pure .nil
|
||||
logWarningAt namedArg.ref <| .tagged ``deprecatedArgExt msg ++ hint
|
||||
return some namedArg
|
||||
return none
|
||||
|
||||
/-- Erase entry for `binderName` from `namedArgs`. -/
|
||||
def eraseNamedArg (namedArgs : List NamedArg) (binderName : Name) : List NamedArg :=
|
||||
namedArgs.filter (·.name != binderName)
|
||||
@@ -238,6 +271,23 @@ private def synthesizePendingAndNormalizeFunType : M Unit := do
|
||||
else
|
||||
for namedArg in s.namedArgs do
|
||||
let f := s.f.getAppFn
|
||||
if f.isConst then
|
||||
let env ← getEnv
|
||||
if linter.deprecated.arg.get (← getOptions) then
|
||||
if let some entry := findDeprecatedArg? env f.constName! namedArg.name then
|
||||
if entry.newArg?.isNone then
|
||||
let msg := formatDeprecatedArgMsg entry
|
||||
let hint ←
|
||||
if namedArg.ref.getHeadInfo matches .original .. then
|
||||
MessageData.hint "Delete this argument:" #[{
|
||||
suggestion := .string ""
|
||||
span? := namedArg.ref
|
||||
toCodeActionTitle? := some fun _ =>
|
||||
s!"Delete deprecated argument `{entry.oldArg}`"
|
||||
}]
|
||||
else
|
||||
pure .nil
|
||||
throwErrorAt namedArg.ref (msg ++ hint)
|
||||
let validNames ← getFoundNamedArgs
|
||||
let fnName? := if f.isConst then some f.constName! else none
|
||||
throwInvalidNamedArg namedArg fnName? validNames
|
||||
@@ -756,13 +806,16 @@ mutual
|
||||
let binderName := fType.bindingName!
|
||||
let binfo := fType.bindingInfo!
|
||||
let s ← get
|
||||
match findBinderName? s.namedArgs binderName with
|
||||
let namedArg? ← match findBinderName? s.namedArgs binderName with
|
||||
| some namedArg => pure (some namedArg)
|
||||
| none => findDeprecatedBinderName? s.namedArgs s.f binderName
|
||||
match namedArg? with
|
||||
| some namedArg =>
|
||||
propagateExpectedType namedArg.val
|
||||
eraseNamedArg binderName
|
||||
eraseNamedArg namedArg.name
|
||||
elabAndAddNewArg binderName namedArg.val
|
||||
main
|
||||
| none =>
|
||||
| none =>
|
||||
unless binderName.hasMacroScopes do
|
||||
pushFoundNamedArg binderName
|
||||
match binfo with
|
||||
|
||||
@@ -63,6 +63,6 @@ where
|
||||
doElabToSyntax "else branch of if with condition {cond}" (elabDiteBranch false) fun else_ => do
|
||||
let mγ ← mkMonadicType (← read).doBlockResultType
|
||||
match h with
|
||||
| `(_%$tk) => Term.elabTermEnsuringType (← `(if $(⟨tk⟩):hole : $cond then $then_ else $else_)) mγ
|
||||
| `(_%$tk) => Term.elabTermEnsuringType (← `(if _%$tk : $cond then $then_ else $else_)) mγ
|
||||
| `($h:ident) => Term.elabTermEnsuringType (← `(if $h:ident : $cond then $then_ else $else_)) mγ
|
||||
| _ => throwUnsupportedSyntax
|
||||
|
||||
@@ -43,7 +43,7 @@ builtin_initialize
|
||||
|
||||
Upon such rewrite, the code for adding flat inductives does not diverge much from the usual
|
||||
way its done for inductive declarations, but we omit applying attributes/modifiers and
|
||||
we do not set the syntax references to track those declarations (as this is auxillary piece of
|
||||
we do not set the syntax references to track those declarations (as this is auxiliary piece of
|
||||
data hidden from the user).
|
||||
|
||||
Then, upon adding such flat inductives for each definition in the mutual block to the environment,
|
||||
@@ -345,7 +345,7 @@ private def mkCasesOnCoinductive (infos : Array InductiveVal) : MetaM Unit := do
|
||||
| throwError "expected to be quantifier"
|
||||
let motiveMVar ← mkFreshExprMVar type
|
||||
/-
|
||||
We intro all the indices and the occurence of the coinductive predicate
|
||||
We intro all the indices and the occurrence of the coinductive predicate
|
||||
-/
|
||||
let (fvars, subgoal) ← motiveMVar.mvarId!.introN (info.numIndices + 1)
|
||||
subgoal.withContext do
|
||||
@@ -373,7 +373,7 @@ private def mkCasesOnCoinductive (infos : Array InductiveVal) : MetaM Unit := do
|
||||
-/
|
||||
let originalCasesOn := mkAppN originalCasesOn indices
|
||||
/-
|
||||
The next argument is the occurence of the coinductive predicate.
|
||||
The next argument is the occurrence of the coinductive predicate.
|
||||
The original `casesOn` of the flat inductive mentions it in
|
||||
unrolled form, so we need to rewrite it.
|
||||
-/
|
||||
@@ -447,7 +447,7 @@ public def elabCoinductive (coinductiveElabData : Array CoinductiveElabData) : T
|
||||
let consts := namesAndTypes.map fun (name, _) => (mkConst name levelParams)
|
||||
/-
|
||||
We create values of each of PreDefinitions, by taking existential (see `Meta.SumOfProducts`)
|
||||
form of the associated flat inductives and applying paramaters, as well as recursive calls
|
||||
form of the associated flat inductives and applying parameters, as well as recursive calls
|
||||
(with their parameters passed).
|
||||
-/
|
||||
let preDefVals ← forallBoundedTelescope infos[0]!.type originalNumParams fun params _ => do
|
||||
|
||||
97
src/Lean/Elab/DeprecatedArg.lean
Normal file
97
src/Lean/Elab/DeprecatedArg.lean
Normal file
@@ -0,0 +1,97 @@
|
||||
/-
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Wojciech Różowski
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Lean.EnvExtension
|
||||
public import Lean.Message
|
||||
import Lean.Elab.Term
|
||||
|
||||
public section
|
||||
|
||||
namespace Lean.Elab
|
||||
open Meta
|
||||
|
||||
register_builtin_option linter.deprecated.arg : Bool := {
|
||||
defValue := true
|
||||
descr := "if true, generate deprecation warnings and errors for deprecated parameters"
|
||||
}
|
||||
|
||||
/-- Entry mapping an old parameter name to a new (or no) parameter for a given declaration. -/
|
||||
structure DeprecatedArgEntry where
|
||||
declName : Name
|
||||
oldArg : Name
|
||||
newArg? : Option Name := none
|
||||
text? : Option String := none
|
||||
since? : Option String := none
|
||||
deriving Inhabited
|
||||
|
||||
/-- State: `declName → (oldArg → entry)` -/
|
||||
abbrev DeprecatedArgState := NameMap (NameMap DeprecatedArgEntry)
|
||||
|
||||
private def addDeprecatedArgEntry (s : DeprecatedArgState) (e : DeprecatedArgEntry) : DeprecatedArgState :=
|
||||
let inner := (s.find? e.declName).getD {} |>.insert e.oldArg e
|
||||
s.insert e.declName inner
|
||||
|
||||
builtin_initialize deprecatedArgExt :
|
||||
SimplePersistentEnvExtension DeprecatedArgEntry DeprecatedArgState ←
|
||||
registerSimplePersistentEnvExtension {
|
||||
addEntryFn := addDeprecatedArgEntry
|
||||
addImportedFn := mkStateFromImportedEntries addDeprecatedArgEntry {}
|
||||
}
|
||||
|
||||
/-- Look up a deprecated argument mapping for `(declName, argName)`. -/
|
||||
def findDeprecatedArg? (env : Environment) (declName : Name) (argName : Name) :
|
||||
Option DeprecatedArgEntry :=
|
||||
(deprecatedArgExt.getState env |>.find? declName) >>= (·.find? argName)
|
||||
|
||||
/-- Format the deprecation warning message for a deprecated argument. -/
|
||||
def formatDeprecatedArgMsg (entry : DeprecatedArgEntry) : MessageData :=
|
||||
let base := match entry.newArg? with
|
||||
| some newArg =>
|
||||
m!"parameter `{entry.oldArg}` of `{.ofConstName entry.declName}` has been deprecated, \
|
||||
use `{newArg}` instead"
|
||||
| none =>
|
||||
m!"parameter `{entry.oldArg}` of `{.ofConstName entry.declName}` has been deprecated"
|
||||
match entry.text? with
|
||||
| some text => base ++ m!": {text}"
|
||||
| none => base
|
||||
|
||||
builtin_initialize registerBuiltinAttribute {
|
||||
name := `deprecated_arg
|
||||
descr := "mark a parameter as deprecated"
|
||||
add := fun declName stx _kind => do
|
||||
let `(attr| deprecated_arg $oldId $[$newId?]? $[$text?]? $[(since := $since?)]?) := stx
|
||||
| throwError "Invalid `[deprecated_arg]` attribute syntax"
|
||||
let oldArg := oldId.getId
|
||||
let newArg? := newId?.map TSyntax.getId
|
||||
let text? := text?.map TSyntax.getString |>.filter (!·.isEmpty)
|
||||
let since? := since?.map TSyntax.getString
|
||||
let info ← getConstInfo declName
|
||||
let paramNames ← MetaM.run' do
|
||||
forallTelescopeReducing info.type fun xs _ =>
|
||||
xs.mapM fun x => return (← x.fvarId!.getDecl).userName
|
||||
if let some newArg := newArg? then
|
||||
-- We have a replacement provided
|
||||
unless Array.any paramNames (· == newArg) do
|
||||
throwError "`{newArg}` is not a parameter of `{declName}`"
|
||||
if Array.any paramNames (· == oldArg) then
|
||||
throwError "`{oldArg}` is still a parameter of `{declName}`; \
|
||||
rename it to `{newArg}` before adding `@[deprecated_arg]`"
|
||||
else
|
||||
-- We do not have a replacement provided
|
||||
if Array.any paramNames (· == oldArg) then
|
||||
throwError "`{oldArg}` is still a parameter of `{declName}`; \
|
||||
remove it before adding `@[deprecated_arg]`"
|
||||
if since?.isNone then
|
||||
logWarning "`[deprecated_arg]` attribute should specify the date or library version \
|
||||
at which the deprecation was introduced, using `(since := \"...\")`"
|
||||
modifyEnv fun env => deprecatedArgExt.addEntry env {
|
||||
declName, oldArg, newArg?, text?, since?
|
||||
}
|
||||
}
|
||||
|
||||
end Lean.Elab
|
||||
@@ -85,6 +85,10 @@ structure State where
|
||||
-/
|
||||
lctx : LocalContext
|
||||
/--
|
||||
The local instances.
|
||||
|
||||
The `MonadLift TermElabM DocM` instance runs the lifted action with these instances, so elaboration
|
||||
commands that mutate this state cause it to take effect in subsequent commands.
|
||||
-/
|
||||
localInstances : LocalInstances
|
||||
/--
|
||||
|
||||
@@ -582,6 +582,7 @@ mutual
|
||||
-- We use `filterRevM` instead of `filterM` to make sure we process the synthetic metavariables using the order they were created.
|
||||
-- It would not be incorrect to use `filterM`.
|
||||
let remainingPendingMVars ← pendingMVars.filterRevM fun mvarId => do
|
||||
checkSystem "synthesize pending MVars"
|
||||
-- We use `traceM` because we want to make sure the metavar local context is used to trace the message
|
||||
traceM `Elab.postpone (mvarId.withContext do addMessageContext m!"resuming {mkMVar mvarId}")
|
||||
let succeeded ← synthesizeSyntheticMVar mvarId postponeOnError runTactics
|
||||
|
||||
@@ -91,10 +91,10 @@ end FoldRelevantConstantsImpl
|
||||
@[implemented_by FoldRelevantConstantsImpl.foldUnsafe]
|
||||
public opaque foldRelevantConstants {α : Type} (e : Expr) (init : α) (f : Name → α → MetaM α) : MetaM α := pure init
|
||||
|
||||
/-- Collect the constants occuring in `e` (once each), skipping instance arguments and proofs. -/
|
||||
/-- Collect the constants occurring in `e` (once each), skipping instance arguments and proofs. -/
|
||||
public def relevantConstants (e : Expr) : MetaM (Array Name) := foldRelevantConstants e #[] (fun n ns => return ns.push n)
|
||||
|
||||
/-- Collect the constants occuring in `e` (once each), skipping instance arguments and proofs. -/
|
||||
/-- Collect the constants occurring in `e` (once each), skipping instance arguments and proofs. -/
|
||||
public def relevantConstantsAsSet (e : Expr) : MetaM NameSet := foldRelevantConstants e ∅ (fun n ns => return ns.insert n)
|
||||
|
||||
end Lean.Expr
|
||||
|
||||
@@ -112,15 +112,37 @@ builtin_initialize
|
||||
def lint (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
logLint linter.missingDocs stx m!"missing doc string for {msg}"
|
||||
|
||||
def lintEmpty (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
logLint linter.missingDocs stx m!"empty doc string for {msg}"
|
||||
|
||||
def lintNamed (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
lint stx s!"{msg} {stx.getId}"
|
||||
|
||||
def lintEmptyNamed (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
lintEmpty stx s!"{msg} {stx.getId}"
|
||||
|
||||
def lintField (parent stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
lint stx s!"{msg} {parent.getId}.{stx.getId}"
|
||||
|
||||
def lintEmptyField (parent stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
lintEmpty stx s!"{msg} {parent.getId}.{stx.getId}"
|
||||
|
||||
def lintStructField (parent stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
lint stx s!"{msg} {parent.getId}.{stx.getId}"
|
||||
|
||||
private def isEmptyDocString (docOpt : Syntax) : CommandElabM Bool := do
|
||||
if docOpt.isNone then return false
|
||||
let docStx : TSyntax `Lean.Parser.Command.docComment := ⟨docOpt[0]⟩
|
||||
-- Verso doc comments with interpolated content cannot be extracted as plain text,
|
||||
-- but they are clearly not empty.
|
||||
if let .node _ `Lean.Parser.Command.versoCommentBody _ := docStx.raw[1] then
|
||||
if !docStx.raw[1][0].isAtom then return false
|
||||
let text ← getDocStringText docStx
|
||||
return text.trimAscii.isEmpty
|
||||
|
||||
def isMissingDoc (docOpt : Syntax) : CommandElabM Bool := do
|
||||
return docOpt.isNone || (← isEmptyDocString docOpt)
|
||||
|
||||
def hasInheritDoc (attrs : Syntax) : Bool :=
|
||||
attrs[0][1].getSepArgs.any fun attr =>
|
||||
attr[1].isOfKind ``Parser.Attr.simple &&
|
||||
@@ -130,38 +152,68 @@ def hasTacticAlt (attrs : Syntax) : Bool :=
|
||||
attrs[0][1].getSepArgs.any fun attr =>
|
||||
attr[1].isOfKind ``Parser.Attr.tactic_alt
|
||||
|
||||
def declModifiersPubNoDoc (mods : Syntax) : CommandElabM Bool := do
|
||||
def declModifiersDocStatus (mods : Syntax) : CommandElabM (Option Bool) := do
|
||||
let isPublic := if (← getEnv).header.isModule && !(← getScope).isPublic then
|
||||
mods[2][0].getKind == ``Command.public else
|
||||
mods[2][0].getKind != ``Command.private
|
||||
return isPublic && mods[0].isNone && !hasInheritDoc mods[1]
|
||||
if !isPublic || hasInheritDoc mods[1] then return none
|
||||
if mods[0].isNone then return some false
|
||||
if (← isEmptyDocString mods[0]) then return some true
|
||||
return none
|
||||
|
||||
def lintDeclHead (k : SyntaxNodeKind) (id : Syntax) : CommandElabM Unit := do
|
||||
if k == ``«abbrev» then lintNamed id "public abbrev"
|
||||
else if k == ``definition then lintNamed id "public def"
|
||||
else if k == ``«opaque» then lintNamed id "public opaque"
|
||||
else if k == ``«axiom» then lintNamed id "public axiom"
|
||||
else if k == ``«inductive» then lintNamed id "public inductive"
|
||||
else if k == ``classInductive then lintNamed id "public inductive"
|
||||
else if k == ``«structure» then lintNamed id "public structure"
|
||||
def declModifiersPubNoDoc (mods : Syntax) : CommandElabM Bool := do
|
||||
return (← declModifiersDocStatus mods).isSome
|
||||
|
||||
private def lintDocStatus (isEmpty : Bool) (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
if isEmpty then lintEmpty stx msg else lint stx msg
|
||||
|
||||
private def lintDocStatusNamed (isEmpty : Bool) (stx : Syntax) (msg : String) : CommandElabM Unit :=
|
||||
if isEmpty then lintEmptyNamed stx msg else lintNamed stx msg
|
||||
|
||||
private def lintDocStatusField (isEmpty : Bool) (parent stx : Syntax) (msg : String) :
|
||||
CommandElabM Unit :=
|
||||
if isEmpty then lintEmptyField parent stx msg else lintField parent stx msg
|
||||
|
||||
def lintDeclHead (k : SyntaxNodeKind) (id : Syntax) (isEmpty : Bool := false) :
|
||||
CommandElabM Unit := do
|
||||
if k == ``«abbrev» then lintDocStatusNamed isEmpty id "public abbrev"
|
||||
else if k == ``definition then lintDocStatusNamed isEmpty id "public def"
|
||||
else if k == ``«opaque» then lintDocStatusNamed isEmpty id "public opaque"
|
||||
else if k == ``«axiom» then lintDocStatusNamed isEmpty id "public axiom"
|
||||
else if k == ``«inductive» then lintDocStatusNamed isEmpty id "public inductive"
|
||||
else if k == ``classInductive then lintDocStatusNamed isEmpty id "public inductive"
|
||||
else if k == ``«structure» then lintDocStatusNamed isEmpty id "public structure"
|
||||
|
||||
private def docOptStatus (docOpt attrs : Syntax) (checkTacticAlt := false) :
|
||||
CommandElabM (Option Bool) := do
|
||||
if hasInheritDoc attrs then return none
|
||||
if checkTacticAlt && hasTacticAlt attrs then return none
|
||||
if docOpt.isNone then return some false
|
||||
if (← isEmptyDocString docOpt) then return some true
|
||||
return none
|
||||
|
||||
@[builtin_missing_docs_handler declaration]
|
||||
def checkDecl : SimpleHandler := fun stx => do
|
||||
let head := stx[0]; let rest := stx[1]
|
||||
if head[2][0].getKind == ``Command.private then return -- not private
|
||||
let k := rest.getKind
|
||||
if (← declModifiersPubNoDoc head) then -- no doc string
|
||||
lintDeclHead k rest[1][0]
|
||||
if let some isEmpty ← declModifiersDocStatus head then
|
||||
lintDeclHead k rest[1][0] isEmpty
|
||||
if k == ``«inductive» || k == ``classInductive then
|
||||
for stx in rest[4].getArgs do
|
||||
let head := stx[2]
|
||||
if stx[0].isNone && (← declModifiersPubNoDoc head) then
|
||||
lintField rest[1][0] stx[3] "public constructor"
|
||||
-- Constructor has two doc comment positions: the leading one before `|` (stx[0])
|
||||
-- and the one inside declModifiers (head[0]). If either is non-empty, skip.
|
||||
let leadingEmpty ← isEmptyDocString stx[0]
|
||||
if !stx[0].isNone && !leadingEmpty then
|
||||
pure () -- constructor has a non-empty leading doc comment
|
||||
else if let some modsEmpty ← declModifiersDocStatus head then
|
||||
lintDocStatusField (leadingEmpty || modsEmpty) rest[1][0] stx[3] "public constructor"
|
||||
unless rest[5].isNone do
|
||||
for stx in rest[5][0][1].getArgs do
|
||||
let head := stx[0]
|
||||
if (← declModifiersPubNoDoc head) then -- no doc string
|
||||
lintField rest[1][0] stx[1] "computed field"
|
||||
if let some isEmpty ← declModifiersDocStatus head then
|
||||
lintDocStatusField isEmpty rest[1][0] stx[1] "computed field"
|
||||
else if rest.getKind == ``«structure» then
|
||||
unless rest[4][2].isNone do
|
||||
let redecls : Std.HashSet String.Pos.Raw :=
|
||||
@@ -173,45 +225,52 @@ def checkDecl : SimpleHandler := fun stx => do
|
||||
else s
|
||||
else s
|
||||
let parent := rest[1][0]
|
||||
let lint1 stx := do
|
||||
let lint1 isEmpty stx := do
|
||||
if let some range := stx.getRange? then
|
||||
if redecls.contains range.start then return
|
||||
lintField parent stx "public field"
|
||||
lintDocStatusField isEmpty parent stx "public field"
|
||||
for stx in rest[4][2][0].getArgs do
|
||||
let head := stx[0]
|
||||
if (← declModifiersPubNoDoc head) then
|
||||
if let some isEmpty ← declModifiersDocStatus head then
|
||||
if stx.getKind == ``structSimpleBinder then
|
||||
lint1 stx[1]
|
||||
lint1 isEmpty stx[1]
|
||||
else
|
||||
for stx in stx[2].getArgs do
|
||||
lint1 stx
|
||||
lint1 isEmpty stx
|
||||
|
||||
@[builtin_missing_docs_handler «initialize»]
|
||||
def checkInit : SimpleHandler := fun stx => do
|
||||
if !stx[2].isNone && (← declModifiersPubNoDoc stx[0]) then
|
||||
lintNamed stx[2][0] "initializer"
|
||||
if !stx[2].isNone then
|
||||
if let some isEmpty ← declModifiersDocStatus stx[0] then
|
||||
lintDocStatusNamed isEmpty stx[2][0] "initializer"
|
||||
|
||||
@[builtin_missing_docs_handler «notation»]
|
||||
def checkNotation : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] then
|
||||
if stx[5].isNone then lint stx[3] "notation"
|
||||
else lintNamed stx[5][0][3] "notation"
|
||||
if stx[2][0][0].getKind != ``«local» then
|
||||
if let some isEmpty ← docOptStatus stx[0] stx[1] then
|
||||
if stx[5].isNone then lintDocStatus isEmpty stx[3] "notation"
|
||||
else lintDocStatusNamed isEmpty stx[5][0][3] "notation"
|
||||
|
||||
@[builtin_missing_docs_handler «mixfix»]
|
||||
def checkMixfix : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] then
|
||||
if stx[5].isNone then lint stx[3] stx[3][0].getAtomVal
|
||||
else lintNamed stx[5][0][3] stx[3][0].getAtomVal
|
||||
if stx[2][0][0].getKind != ``«local» then
|
||||
if let some isEmpty ← docOptStatus stx[0] stx[1] then
|
||||
if stx[5].isNone then lintDocStatus isEmpty stx[3] stx[3][0].getAtomVal
|
||||
else lintDocStatusNamed isEmpty stx[5][0][3] stx[3][0].getAtomVal
|
||||
|
||||
@[builtin_missing_docs_handler «syntax»]
|
||||
def checkSyntax : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] && !hasTacticAlt stx[1] then
|
||||
if stx[5].isNone then lint stx[3] "syntax"
|
||||
else lintNamed stx[5][0][3] "syntax"
|
||||
if stx[2][0][0].getKind != ``«local» then
|
||||
if let some isEmpty ← docOptStatus stx[0] stx[1] (checkTacticAlt := true) then
|
||||
if stx[5].isNone then lintDocStatus isEmpty stx[3] "syntax"
|
||||
else lintDocStatusNamed isEmpty stx[5][0][3] "syntax"
|
||||
|
||||
def mkSimpleHandler (name : String) (declNameStxIdx := 2) : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone then
|
||||
lintNamed stx[declNameStxIdx] name
|
||||
if (← isMissingDoc stx[0]) then
|
||||
if (← isEmptyDocString stx[0]) then
|
||||
lintEmptyNamed stx[declNameStxIdx] name
|
||||
else
|
||||
lintNamed stx[declNameStxIdx] name
|
||||
|
||||
@[builtin_missing_docs_handler syntaxAbbrev]
|
||||
def checkSyntaxAbbrev : SimpleHandler := mkSimpleHandler "syntax"
|
||||
@@ -221,20 +280,22 @@ def checkSyntaxCat : SimpleHandler := mkSimpleHandler "syntax category"
|
||||
|
||||
@[builtin_missing_docs_handler «macro»]
|
||||
def checkMacro : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] && !hasTacticAlt stx[1] then
|
||||
if stx[5].isNone then lint stx[3] "macro"
|
||||
else lintNamed stx[5][0][3] "macro"
|
||||
if stx[2][0][0].getKind != ``«local» then
|
||||
if let some isEmpty ← docOptStatus stx[0] stx[1] (checkTacticAlt := true) then
|
||||
if stx[5].isNone then lintDocStatus isEmpty stx[3] "macro"
|
||||
else lintDocStatusNamed isEmpty stx[5][0][3] "macro"
|
||||
|
||||
@[builtin_missing_docs_handler «elab»]
|
||||
def checkElab : SimpleHandler := fun stx => do
|
||||
if stx[0].isNone && stx[2][0][0].getKind != ``«local» && !hasInheritDoc stx[1] && !hasTacticAlt stx[1] then
|
||||
if stx[5].isNone then lint stx[3] "elab"
|
||||
else lintNamed stx[5][0][3] "elab"
|
||||
if stx[2][0][0].getKind != ``«local» then
|
||||
if let some isEmpty ← docOptStatus stx[0] stx[1] (checkTacticAlt := true) then
|
||||
if stx[5].isNone then lintDocStatus isEmpty stx[3] "elab"
|
||||
else lintDocStatusNamed isEmpty stx[5][0][3] "elab"
|
||||
|
||||
@[builtin_missing_docs_handler classAbbrev]
|
||||
def checkClassAbbrev : SimpleHandler := fun stx => do
|
||||
if (← declModifiersPubNoDoc stx[0]) then
|
||||
lintNamed stx[3] "class abbrev"
|
||||
if let some isEmpty ← declModifiersDocStatus stx[0] then
|
||||
lintDocStatusNamed isEmpty stx[3] "class abbrev"
|
||||
|
||||
@[builtin_missing_docs_handler Parser.Tactic.declareSimpLikeTactic]
|
||||
def checkSimpLike : SimpleHandler := mkSimpleHandler "simp-like tactic"
|
||||
@@ -244,8 +305,8 @@ def checkRegisterBuiltinOption : SimpleHandler := mkSimpleHandler (declNameStxId
|
||||
|
||||
@[builtin_missing_docs_handler Option.registerOption]
|
||||
def checkRegisterOption : SimpleHandler := fun stx => do
|
||||
if (← declModifiersPubNoDoc stx[0]) then
|
||||
lintNamed stx[2] "option"
|
||||
if let some isEmpty ← declModifiersDocStatus stx[0] then
|
||||
lintDocStatusNamed isEmpty stx[2] "option"
|
||||
|
||||
@[builtin_missing_docs_handler registerSimpAttr]
|
||||
def checkRegisterSimpAttr : SimpleHandler := mkSimpleHandler "simp attr"
|
||||
|
||||
@@ -70,6 +70,7 @@ structure Context where
|
||||
abbrev M := ReaderT Context $ MonadCacheT ExprStructEq Expr MetaM
|
||||
|
||||
partial def visit (e : Expr) : M Expr := do
|
||||
checkSystem "abstract nested proofs"
|
||||
if e.isAtomic then
|
||||
pure e
|
||||
else
|
||||
|
||||
@@ -714,7 +714,6 @@ where
|
||||
set_option compiler.ignoreBorrowAnnotation true in
|
||||
@[export lean_simp]
|
||||
def simpImpl (e : Expr) : SimpM Result := withIncRecDepth do
|
||||
checkSystem "simp"
|
||||
if (← isProof e) then
|
||||
return { expr := e }
|
||||
trace[Meta.Tactic.simp.heads] "{repr e.toHeadIndex}"
|
||||
|
||||
@@ -99,7 +99,7 @@ where
|
||||
if (← withReducibleAndInstances <| isDefEq x val) then
|
||||
return true
|
||||
else
|
||||
trace[Meta.Tactic.simp.discharge] "{← ppOrigin thmId}, failed to assign instance{indentExpr type}\nsythesized value{indentExpr val}\nis not definitionally equal to{indentExpr x}"
|
||||
trace[Meta.Tactic.simp.discharge] "{← ppOrigin thmId}, failed to assign instance{indentExpr type}\nsynthesized value{indentExpr val}\nis not definitionally equal to{indentExpr x}"
|
||||
return false
|
||||
| _ =>
|
||||
trace[Meta.Tactic.simp.discharge] "{← ppOrigin thmId}, failed to synthesize instance{indentExpr type}"
|
||||
@@ -218,6 +218,7 @@ where
|
||||
else
|
||||
let candidates := candidates.insertionSort fun e₁ e₂ => e₁.1.priority > e₂.1.priority
|
||||
for (thm, numExtraArgs) in candidates do
|
||||
checkSystem "simp"
|
||||
if inErasedSet thm then continue
|
||||
if rflOnly then
|
||||
unless thm.rfl do
|
||||
@@ -245,6 +246,7 @@ where
|
||||
else
|
||||
let candidates := candidates.insertionSort fun e₁ e₂ => e₁.priority > e₂.priority
|
||||
for thm in candidates do
|
||||
checkSystem "simp"
|
||||
unless inErasedSet thm || (rflOnly && !thm.rfl) do
|
||||
let result? ← withNewMCtxDepth do
|
||||
let val ← thm.getValue
|
||||
|
||||
@@ -722,6 +722,7 @@ def simpAppUsingCongr (e : Expr) : SimpM Result := do
|
||||
if i == 0 then
|
||||
simp f
|
||||
else
|
||||
checkSystem "simp"
|
||||
let i := i - 1
|
||||
let .app f a := e | unreachable!
|
||||
let fr ← visit f i
|
||||
|
||||
@@ -50,6 +50,7 @@ partial def transform {m} [Monad m] [MonadLiftT CoreM m] [MonadControlT CoreM m]
|
||||
let _ : MonadLiftT (ST IO.RealWorld) m := { monadLift := fun x => liftM (m := CoreM) (liftM (m := ST IO.RealWorld) x) }
|
||||
let rec visit (e : Expr) : MonadCacheT ExprStructEq Expr m Expr :=
|
||||
checkCache { val := e : ExprStructEq } fun _ => Core.withIncRecDepth do
|
||||
Core.checkSystem "transform"
|
||||
let rec visitPost (e : Expr) : MonadCacheT ExprStructEq Expr m Expr := do
|
||||
match (← post e) with
|
||||
| .done e => pure e
|
||||
@@ -107,6 +108,7 @@ partial def transformWithCache {m} [Monad m] [MonadLiftT MetaM m] [MonadControlT
|
||||
let _ : MonadLiftT (ST IO.RealWorld) m := { monadLift := fun x => liftM (m := MetaM) (liftM (m := ST IO.RealWorld) x) }
|
||||
let rec visit (e : Expr) : MonadCacheT ExprStructEq Expr m Expr :=
|
||||
checkCache { val := e : ExprStructEq } fun _ => Meta.withIncRecDepth do
|
||||
(Core.checkSystem "transform" : MetaM Unit)
|
||||
let rec visitPost (e : Expr) : MonadCacheT ExprStructEq Expr m Expr := do
|
||||
match (← post e) with
|
||||
| .done e => pure e
|
||||
|
||||
@@ -650,7 +650,7 @@ expand let-expressions, expand assigned meta-variables, unfold aux declarations.
|
||||
partial def whnfCore (e : Expr) : MetaM Expr :=
|
||||
go e
|
||||
where
|
||||
go (e : Expr) : MetaM Expr :=
|
||||
go (e : Expr) : MetaM Expr := do
|
||||
whnfEasyCases e fun e => do
|
||||
trace[Meta.whnf] e
|
||||
match e with
|
||||
|
||||
@@ -21,9 +21,6 @@ opaque maxSmallNatFn : Unit → Nat
|
||||
@[extern "lean_libuv_version"]
|
||||
opaque libUVVersionFn : Unit → Nat
|
||||
|
||||
@[extern "lean_openssl_version"]
|
||||
opaque openSSLVersionFn : Unit → Nat
|
||||
|
||||
def closureMaxArgs : Nat :=
|
||||
closureMaxArgsFn ()
|
||||
|
||||
@@ -33,7 +30,4 @@ def maxSmallNat : Nat :=
|
||||
def libUVVersion : Nat :=
|
||||
libUVVersionFn ()
|
||||
|
||||
def openSSLVersion : Nat :=
|
||||
openSSLVersionFn ()
|
||||
|
||||
end Lean
|
||||
|
||||
@@ -46,7 +46,7 @@ structure LeanSemanticToken where
|
||||
stx : Syntax
|
||||
/-- Type of the semantic token. -/
|
||||
type : SemanticTokenType
|
||||
/-- In case of overlap, higher-priority tokens will take precendence -/
|
||||
/-- In case of overlap, higher-priority tokens will take precedence -/
|
||||
priority : Nat := 5
|
||||
|
||||
/-- Semantic token information with absolute LSP positions. -/
|
||||
@@ -57,7 +57,7 @@ structure AbsoluteLspSemanticToken where
|
||||
tailPos : Lsp.Position
|
||||
/-- Start position of the semantic token. -/
|
||||
type : SemanticTokenType
|
||||
/-- In case of overlap, higher-priority tokens will take precendence -/
|
||||
/-- In case of overlap, higher-priority tokens will take precedence -/
|
||||
priority : Nat := 5
|
||||
deriving BEq, Hashable, FromJson, ToJson
|
||||
|
||||
|
||||
@@ -183,7 +183,8 @@ public theorem toInt?_repr (a : Int) : a.repr.toInt? = some a := by
|
||||
rw [repr_eq_if]
|
||||
split <;> (simp; omega)
|
||||
|
||||
public theorem isInt?_repr (a : Int) : a.repr.isInt = true := by
|
||||
@[simp]
|
||||
public theorem isInt_repr (a : Int) : a.repr.isInt = true := by
|
||||
simp [← String.isSome_toInt?]
|
||||
|
||||
public theorem repr_injective {a b : Int} (h : Int.repr a = Int.repr b) : a = b := by
|
||||
|
||||
@@ -10,7 +10,6 @@ public import Std.Internal.Async
|
||||
public import Std.Internal.Http
|
||||
public import Std.Internal.Parsec
|
||||
public import Std.Internal.UV
|
||||
public import Std.Internal.SSL
|
||||
|
||||
@[expose] public section
|
||||
|
||||
|
||||
@@ -10,7 +10,6 @@ public import Std.Internal.Async.Basic
|
||||
public import Std.Internal.Async.ContextAsync
|
||||
public import Std.Internal.Async.Timer
|
||||
public import Std.Internal.Async.TCP
|
||||
public import Std.Internal.Async.TCP.SSL
|
||||
public import Std.Internal.Async.UDP
|
||||
public import Std.Internal.Async.DNS
|
||||
public import Std.Internal.Async.Select
|
||||
@@ -18,4 +17,3 @@ public import Std.Internal.Async.Process
|
||||
public import Std.Internal.Async.System
|
||||
public import Std.Internal.Async.Signal
|
||||
public import Std.Internal.Async.IO
|
||||
public import Std.Internal.SSL
|
||||
|
||||
@@ -8,7 +8,6 @@ module
|
||||
prelude
|
||||
public import Std.Time
|
||||
public import Std.Internal.UV.TCP
|
||||
public import Std.Internal.Async.IO
|
||||
public import Std.Internal.Async.Select
|
||||
|
||||
public section
|
||||
|
||||
@@ -1,442 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Time
|
||||
public import Std.Internal.UV.TCP
|
||||
public import Std.Internal.Async.Timer
|
||||
public import Std.Internal.Async.Select
|
||||
public import Std.Internal.SSL
|
||||
|
||||
public section
|
||||
|
||||
namespace Std.Internal.IO.Async.TCP.SSL
|
||||
|
||||
open Std.Internal.SSL
|
||||
open Std.Internal.UV.TCP
|
||||
open Std.Net
|
||||
|
||||
/--
|
||||
Default chunk size used by TLS I/O loops.
|
||||
-/
|
||||
def ioChunkSize : UInt64 := 16 * 1024
|
||||
|
||||
-- ## Private helpers: SSL ↔ TCP I/O bridge
|
||||
|
||||
/--
|
||||
Feeds an encrypted chunk into the SSL input BIO.
|
||||
Raises an error if OpenSSL consumed fewer bytes than supplied.
|
||||
-/
|
||||
@[inline]
|
||||
private def feedEncryptedChunk (ssl : Session r) (encrypted : ByteArray) : IO Unit := do
|
||||
if encrypted.size == 0 then return ()
|
||||
let consumed ← ssl.feedEncrypted encrypted
|
||||
if consumed.toNat != encrypted.size then
|
||||
throw <| IO.userError s!"TLS input short write: consumed {consumed} / {encrypted.size} bytes"
|
||||
|
||||
/--
|
||||
Drains all pending encrypted bytes from the SSL output BIO and sends them over TCP.
|
||||
-/
|
||||
private partial def flushEncrypted (native : Socket) (ssl : Session r) : Async Unit := do
|
||||
let out ← ssl.drainEncrypted
|
||||
if out.size == 0 then return ()
|
||||
Async.ofPromise <| native.send #[out]
|
||||
flushEncrypted native ssl
|
||||
|
||||
/--
|
||||
Runs the TLS handshake loop to completion, interleaving SSL state machine steps
|
||||
with TCP I/O.
|
||||
-/
|
||||
private partial def doHandshake (native : Socket) (ssl : Session r) (chunkSize : UInt64) : Async Unit := do
|
||||
let want ← ssl.handshake
|
||||
flushEncrypted native ssl
|
||||
match want with
|
||||
| none =>
|
||||
return ()
|
||||
| some .write =>
|
||||
doHandshake native ssl chunkSize
|
||||
| some .read =>
|
||||
let encrypted? ← Async.ofPromise <| native.recv? chunkSize
|
||||
match encrypted? with
|
||||
| none =>
|
||||
throw <| IO.userError "connection closed during TLS handshake"
|
||||
| some encrypted =>
|
||||
feedEncryptedChunk ssl encrypted
|
||||
doHandshake native ssl chunkSize
|
||||
|
||||
-- ## Types
|
||||
|
||||
/--
|
||||
Represents a TLS-enabled TCP server socket. Carries its own server context so
|
||||
that each accepted connection gets a session configured from the same context.
|
||||
-/
|
||||
structure Server where
|
||||
private ofNative ::
|
||||
native : Socket
|
||||
serverCtx : Context.Server
|
||||
|
||||
/--
|
||||
Represents a TLS-enabled TCP connection, parameterized by TLS role.
|
||||
Use `Client` for outgoing connections and `ServerConn` for server-accepted connections.
|
||||
-/
|
||||
structure Connection (r : Role) where
|
||||
private ofNative ::
|
||||
native : Socket
|
||||
ssl : Session r
|
||||
|
||||
/--
|
||||
An outgoing TLS client connection.
|
||||
-/
|
||||
abbrev Client := Connection .client
|
||||
|
||||
/--
|
||||
An incoming TLS connection accepted by a `Server`.
|
||||
-/
|
||||
abbrev ServerConn := Connection .server
|
||||
|
||||
namespace Server
|
||||
|
||||
/--
|
||||
Creates a new TLS-enabled TCP server socket using the given context.
|
||||
-/
|
||||
@[inline]
|
||||
def mk (serverCtx : Context.Server) : IO Server := do
|
||||
let native ← Socket.new
|
||||
return Server.ofNative native serverCtx
|
||||
|
||||
/--
|
||||
Configures the server context with a PEM certificate and private key.
|
||||
-/
|
||||
@[inline]
|
||||
def configureServer (s : Server) (certFile keyFile : String) : IO Unit :=
|
||||
s.serverCtx.configure certFile keyFile
|
||||
|
||||
/--
|
||||
Binds the server socket to the specified address.
|
||||
-/
|
||||
@[inline]
|
||||
def bind (s : Server) (addr : SocketAddress) : IO Unit :=
|
||||
s.native.bind addr
|
||||
|
||||
/--
|
||||
Listens for incoming connections with the given backlog.
|
||||
-/
|
||||
@[inline]
|
||||
def listen (s : Server) (backlog : UInt32) : IO Unit :=
|
||||
s.native.listen backlog
|
||||
|
||||
@[inline] private def mkServerConn (native : Socket) (ctx : Context.Server) : IO ServerConn := do
|
||||
let ssl ← Session.Server.mk ctx
|
||||
return ⟨native, ssl⟩
|
||||
|
||||
/--
|
||||
Accepts an incoming TLS connection and performs the TLS handshake.
|
||||
-/
|
||||
@[inline]
|
||||
def accept (s : Server) (chunkSize : UInt64 := ioChunkSize) : Async ServerConn := do
|
||||
let native ← Async.ofPromise <| s.native.accept
|
||||
let conn ← mkServerConn native s.serverCtx
|
||||
doHandshake conn.native conn.ssl chunkSize
|
||||
return conn
|
||||
|
||||
/--
|
||||
Creates a `Selector` that resolves once `s` has a connection available and the TLS handshake
|
||||
has completed.
|
||||
-/
|
||||
def acceptSelector (s : Server) : Selector ServerConn :=
|
||||
{
|
||||
tryFn := do
|
||||
let res ← s.native.tryAccept
|
||||
match ← IO.ofExcept res with
|
||||
| none => return none
|
||||
| some native =>
|
||||
let conn ← mkServerConn native s.serverCtx
|
||||
doHandshake conn.native conn.ssl ioChunkSize
|
||||
return some conn
|
||||
|
||||
registerFn waiter := do
|
||||
let connTask ← (do
|
||||
let native ← Async.ofPromise <| s.native.accept
|
||||
let ssl ← Session.Server.mk s.serverCtx
|
||||
let conn : ServerConn := ⟨native, ssl⟩
|
||||
doHandshake conn.native conn.ssl ioChunkSize
|
||||
return conn
|
||||
).asTask
|
||||
|
||||
-- If we get cancelled the promise will be dropped so prepare for that
|
||||
discard <| IO.mapTask (t := connTask) fun res => do
|
||||
let lose := return ()
|
||||
let win promise := do
|
||||
try
|
||||
let conn ← IO.ofExcept res
|
||||
promise.resolve (.ok conn)
|
||||
catch e =>
|
||||
promise.resolve (.error e)
|
||||
waiter.race lose win
|
||||
|
||||
unregisterFn := s.native.cancelAccept
|
||||
}
|
||||
|
||||
/--
|
||||
Gets the local address of the server socket.
|
||||
-/
|
||||
@[inline]
|
||||
def getSockName (s : Server) : IO SocketAddress :=
|
||||
s.native.getSockName
|
||||
|
||||
/--
|
||||
Disables the Nagle algorithm for all client sockets accepted by this server socket.
|
||||
-/
|
||||
@[inline]
|
||||
def noDelay (s : Server) : IO Unit :=
|
||||
s.native.noDelay
|
||||
|
||||
/--
|
||||
Enables TCP keep-alive for all client sockets accepted by this server socket.
|
||||
-/
|
||||
@[inline]
|
||||
def keepAlive (s : Server) (enable : Bool) (delay : Std.Time.Second.Offset) (_ : delay.val ≥ 1 := by decide) : IO Unit :=
|
||||
s.native.keepAlive enable.toInt8 delay.val.toNat.toUInt32
|
||||
|
||||
end Server
|
||||
|
||||
namespace Connection
|
||||
|
||||
/--
|
||||
Attempts to write plaintext data into TLS. Returns true when accepted.
|
||||
Any encrypted TLS output generated is flushed to the socket.
|
||||
-/
|
||||
@[inline]
|
||||
def write {r : Role} (s : Connection r) (data : ByteArray) : Async Bool := do
|
||||
match ← s.ssl.write data with
|
||||
| none =>
|
||||
flushEncrypted s.native s.ssl
|
||||
return true
|
||||
| some _ =>
|
||||
-- Data was queued internally; flush whatever the SSL engine produced.
|
||||
flushEncrypted s.native s.ssl
|
||||
return false
|
||||
|
||||
/--
|
||||
Sends data through a TLS-enabled socket.
|
||||
Fails if OpenSSL reports the write as pending additional I/O.
|
||||
-/
|
||||
@[inline]
|
||||
def send {r : Role} (s : Connection r) (data : ByteArray) : Async Unit := do
|
||||
if ← s.write data then
|
||||
return ()
|
||||
else
|
||||
throw <| IO.userError "TLS write is pending additional I/O; call `recv?` or retry later"
|
||||
|
||||
/--
|
||||
Sends multiple data buffers through the TLS-enabled socket.
|
||||
-/
|
||||
@[inline]
|
||||
def sendAll {r : Role} (s : Connection r) (data : Array ByteArray) : Async Unit :=
|
||||
data.forM (s.send ·)
|
||||
|
||||
/--
|
||||
Receives decrypted plaintext data from TLS.
|
||||
If no plaintext is immediately available, this function performs the required socket I/O
|
||||
(flush or receive) and retries until data arrives or the connection is closed.
|
||||
-/
|
||||
partial def recv? {r : Role} (s : Connection r) (size : UInt64) (chunkSize : UInt64 := ioChunkSize) : Async (Option ByteArray) := do
|
||||
match ← s.ssl.read? size with
|
||||
| .data plain =>
|
||||
flushEncrypted s.native s.ssl
|
||||
return some plain
|
||||
| .closed =>
|
||||
return none
|
||||
| .wantIO _ =>
|
||||
flushEncrypted s.native s.ssl
|
||||
let encrypted? ← Async.ofPromise <| s.native.recv? chunkSize
|
||||
match encrypted? with
|
||||
| none =>
|
||||
return none
|
||||
| some encrypted =>
|
||||
feedEncryptedChunk s.ssl encrypted
|
||||
recv? s size chunkSize
|
||||
|
||||
/--
|
||||
Tries to receive decrypted plaintext data without blocking.
|
||||
Returns `some (some data)` if plaintext is available, `some none` if the peer closed,
|
||||
or `none` if no data is ready yet.
|
||||
-/
|
||||
partial def tryRecv {r : Role} (s : Connection r) (size : UInt64) (chunkSize : UInt64 := ioChunkSize) : Async (Option (Option ByteArray)) := do
|
||||
let pending ← s.ssl.pendingPlaintext
|
||||
|
||||
if pending > 0 then
|
||||
return some (← s.recv? size)
|
||||
else
|
||||
let readableWaiter ← s.native.waitReadable
|
||||
|
||||
flushEncrypted s.native s.ssl
|
||||
|
||||
if ← readableWaiter.isResolved then
|
||||
let encrypted? ← Async.ofPromise <| s.native.recv? ioChunkSize
|
||||
match encrypted? with
|
||||
| none =>
|
||||
return none
|
||||
| some encrypted =>
|
||||
feedEncryptedChunk s.ssl encrypted
|
||||
tryRecv s size chunkSize
|
||||
else
|
||||
s.native.cancelRecv
|
||||
return none
|
||||
|
||||
/--
|
||||
Feeds encrypted socket data into SSL until plaintext is pending.
|
||||
Resolves the returned promise once plaintext is available.
|
||||
-/
|
||||
partial def waitReadable {r : Role} (s : Connection r) : Async Unit := do
|
||||
flushEncrypted s.native s.ssl
|
||||
|
||||
let pending ← s.ssl.pendingPlaintext
|
||||
if pending > 0 then
|
||||
return ()
|
||||
|
||||
if (← s.ssl.pendingPlaintext) > 0 then
|
||||
return ()
|
||||
|
||||
match ← s.ssl.read? 0 with
|
||||
| .data _ =>
|
||||
flushEncrypted s.native s.ssl
|
||||
return ()
|
||||
| .closed =>
|
||||
return ()
|
||||
| .wantIO _ =>
|
||||
flushEncrypted s.native s.ssl
|
||||
let encrypted? ← Async.ofPromise <| s.native.recv? ioChunkSize
|
||||
match encrypted? with
|
||||
| none => return ()
|
||||
| some encrypted =>
|
||||
feedEncryptedChunk s.ssl encrypted
|
||||
waitReadable s
|
||||
|
||||
/--
|
||||
Creates a `Selector` that resolves once `s` has plaintext data available.
|
||||
-/
|
||||
def recvSelector {r : Role} (s : Connection r) (size : UInt64) : Selector (Option ByteArray) :=
|
||||
{
|
||||
tryFn := s.tryRecv size
|
||||
|
||||
registerFn waiter := do
|
||||
let readableWaiter ← s.waitReadable.asTask
|
||||
|
||||
-- If we get cancelled the promise will be dropped so prepare for that
|
||||
discard <| IO.mapTask (t := readableWaiter) fun res => do
|
||||
match res with
|
||||
| .error _ => return ()
|
||||
| .ok _ =>
|
||||
let lose := return ()
|
||||
let win promise := do
|
||||
try
|
||||
-- We know that this read should not block.
|
||||
let result ← (s.recv? size).block
|
||||
promise.resolve (.ok result)
|
||||
catch e =>
|
||||
promise.resolve (.error e)
|
||||
waiter.race lose win
|
||||
|
||||
unregisterFn := s.native.cancelRecv
|
||||
}
|
||||
|
||||
/--
|
||||
Shuts down the write side of the socket.
|
||||
-/
|
||||
@[inline]
|
||||
def shutdown {r : Role} (s : Connection r) : Async Unit :=
|
||||
Async.ofPromise <| s.native.shutdown
|
||||
|
||||
/--
|
||||
Gets the remote address of the socket.
|
||||
-/
|
||||
@[inline]
|
||||
def getPeerName {r : Role} (s : Connection r) : IO SocketAddress :=
|
||||
s.native.getPeerName
|
||||
|
||||
/--
|
||||
Gets the local address of the socket.
|
||||
-/
|
||||
@[inline]
|
||||
def getSockName {r : Role} (s : Connection r) : IO SocketAddress :=
|
||||
s.native.getSockName
|
||||
|
||||
/--
|
||||
Returns the X.509 verification result code for this TLS session.
|
||||
-/
|
||||
@[inline]
|
||||
def verifyResult {r : Role} (s : Connection r) : IO UInt64 :=
|
||||
s.ssl.verifyResult
|
||||
|
||||
/--
|
||||
Disables the Nagle algorithm for the socket.
|
||||
-/
|
||||
@[inline]
|
||||
def noDelay {r : Role} (s : Connection r) : IO Unit :=
|
||||
s.native.noDelay
|
||||
|
||||
/--
|
||||
Enables TCP keep-alive with a specified delay for the socket.
|
||||
-/
|
||||
@[inline]
|
||||
def keepAlive {r : Role} (s : Connection r) (enable : Bool) (delay : Std.Time.Second.Offset) (_ : delay.val ≥ 0 := by decide) : IO Unit :=
|
||||
s.native.keepAlive enable.toInt8 delay.val.toNat.toUInt32
|
||||
|
||||
end Connection
|
||||
|
||||
-- ## Client (outgoing connection setup)
|
||||
|
||||
namespace Client
|
||||
|
||||
/--
|
||||
Creates a new outgoing TLS client connection using the given client context.
|
||||
-/
|
||||
@[inline]
|
||||
def mk (ctx : Context.Client) : IO Client := do
|
||||
let native ← Socket.new
|
||||
let ssl ← Session.Client.mk ctx
|
||||
return ⟨native, ssl⟩
|
||||
|
||||
/--
|
||||
Configures the given client context.
|
||||
`caFile` may be empty to use default trust settings.
|
||||
-/
|
||||
@[inline]
|
||||
def configureContext (ctx : Context.Client) (caFile := "") (verifyPeer := true) : IO Unit :=
|
||||
ctx.configure caFile verifyPeer
|
||||
|
||||
/--
|
||||
Binds the client socket to the specified address.
|
||||
-/
|
||||
@[inline]
|
||||
def bind (s : Client) (addr : SocketAddress) : IO Unit :=
|
||||
s.native.bind addr
|
||||
|
||||
/--
|
||||
Sets SNI server name used during the TLS handshake.
|
||||
-/
|
||||
@[inline]
|
||||
def setServerName (s : Client) (host : String) : IO Unit :=
|
||||
Session.Client.setServerName s.ssl host
|
||||
|
||||
/--
|
||||
Performs the TLS handshake on an established TCP connection.
|
||||
-/
|
||||
@[inline]
|
||||
def handshake (s : Client) (chunkSize : UInt64 := ioChunkSize) : Async Unit :=
|
||||
doHandshake (Connection.native s) (Connection.ssl s) chunkSize
|
||||
|
||||
/--
|
||||
Connects the client socket to the given address and performs the TLS handshake.
|
||||
-/
|
||||
@[inline]
|
||||
def connect (s : Client) (addr : SocketAddress) (chunkSize : UInt64 := ioChunkSize) : Async Unit := do
|
||||
Async.ofPromise <| (Connection.native s).connect addr
|
||||
s.handshake chunkSize
|
||||
|
||||
end Std.Internal.IO.Async.TCP.SSL.Client
|
||||
@@ -14,6 +14,7 @@ public import Std.Internal.Http.Data.Status
|
||||
public import Std.Internal.Http.Data.Chunk
|
||||
public import Std.Internal.Http.Data.Headers
|
||||
public import Std.Internal.Http.Data.URI
|
||||
public import Std.Internal.Http.Data.Body
|
||||
|
||||
/-!
|
||||
# HTTP Data Types
|
||||
|
||||
24
src/Std/Internal/Http/Data/Body.lean
Normal file
24
src/Std/Internal/Http/Data/Body.lean
Normal file
@@ -0,0 +1,24 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Internal.Http.Data.Body.Basic
|
||||
public import Std.Internal.Http.Data.Body.Length
|
||||
public import Std.Internal.Http.Data.Body.Any
|
||||
public import Std.Internal.Http.Data.Body.Stream
|
||||
public import Std.Internal.Http.Data.Body.Empty
|
||||
public import Std.Internal.Http.Data.Body.Full
|
||||
|
||||
public section
|
||||
|
||||
/-!
|
||||
# Body
|
||||
|
||||
This module re-exports all HTTP body types: `Body.Empty`, `Body.Full`, `Body.Stream`,
|
||||
`Body.Any`, and `Body.Length`, along with the `Http.Body` typeclass and conversion
|
||||
utilities (`ToByteArray`, `FromByteArray`).
|
||||
-/
|
||||
83
src/Std/Internal/Http/Data/Body/Any.lean
Normal file
83
src/Std/Internal/Http/Data/Body/Any.lean
Normal file
@@ -0,0 +1,83 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Internal.Http.Data.Body.Basic
|
||||
|
||||
public section
|
||||
|
||||
/-!
|
||||
# Body.Any
|
||||
|
||||
A type-erased body backed by closures. Implements `Http.Body` and can be constructed from any
|
||||
type that also implements `Http.Body`. Used as the default handler response body type.
|
||||
-/
|
||||
|
||||
namespace Std.Http.Body
|
||||
open Std Internal IO Async
|
||||
|
||||
set_option linter.all true
|
||||
|
||||
/--
|
||||
A type-erased body handle. Operations are stored as closures, making it open to any body type
|
||||
that implements `Http.Body`.
|
||||
-/
|
||||
structure Any where
|
||||
|
||||
/--
|
||||
Receives the next body chunk. Returns `none` at end-of-stream.
|
||||
-/
|
||||
recv : Async (Option Chunk)
|
||||
|
||||
/--
|
||||
Closes the body stream.
|
||||
-/
|
||||
close : Async Unit
|
||||
|
||||
/--
|
||||
Returns `true` when the body stream is closed.
|
||||
-/
|
||||
isClosed : Async Bool
|
||||
|
||||
/--
|
||||
Selector that resolves when a chunk is available or EOF is reached.
|
||||
-/
|
||||
recvSelector : Selector (Option Chunk)
|
||||
|
||||
/--
|
||||
Returns the declared size.
|
||||
-/
|
||||
getKnownSize : Async (Option Body.Length)
|
||||
|
||||
/--
|
||||
Sets the size of the body.
|
||||
-/
|
||||
setKnownSize : Option Body.Length → Async Unit
|
||||
namespace Any
|
||||
|
||||
/--
|
||||
Erases a body of any `Http.Body` instance into a `Body.Any`.
|
||||
-/
|
||||
def ofBody [Http.Body α] (body : α) : Any where
|
||||
recv := Http.Body.recv body
|
||||
close := Http.Body.close body
|
||||
isClosed := Http.Body.isClosed body
|
||||
recvSelector := Http.Body.recvSelector body
|
||||
getKnownSize := Http.Body.getKnownSize body
|
||||
setKnownSize := Http.Body.setKnownSize body
|
||||
|
||||
end Any
|
||||
|
||||
instance : Http.Body Any where
|
||||
recv := Any.recv
|
||||
close := Any.close
|
||||
isClosed := Any.isClosed
|
||||
recvSelector := Any.recvSelector
|
||||
getKnownSize := Any.getKnownSize
|
||||
setKnownSize := Any.setKnownSize
|
||||
|
||||
end Std.Http.Body
|
||||
102
src/Std/Internal/Http/Data/Body/Basic.lean
Normal file
102
src/Std/Internal/Http/Data/Body/Basic.lean
Normal file
@@ -0,0 +1,102 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Internal.Async
|
||||
public import Std.Internal.Async.ContextAsync
|
||||
public import Std.Internal.Http.Data.Chunk
|
||||
public import Std.Internal.Http.Data.Headers
|
||||
public import Std.Internal.Http.Data.Body.Length
|
||||
|
||||
public section
|
||||
|
||||
/-!
|
||||
# Body.Basic
|
||||
|
||||
This module defines the `Body` typeclass for HTTP body streams, and shared conversion types
|
||||
`ToByteArray` and `FromByteArray` used for encoding and decoding body content.
|
||||
-/
|
||||
|
||||
namespace Std.Http
|
||||
open Std Internal IO Async
|
||||
|
||||
set_option linter.all true
|
||||
|
||||
/--
|
||||
Typeclass for values that can be read as HTTP body streams.
|
||||
-/
|
||||
class Body (α : Type) where
|
||||
/--
|
||||
Receives the next body chunk. Returns `none` at end-of-stream.
|
||||
-/
|
||||
recv : α → Async (Option Chunk)
|
||||
|
||||
/--
|
||||
Closes the body stream.
|
||||
-/
|
||||
close : α → Async Unit
|
||||
|
||||
/--
|
||||
Returns `true` when the body stream is closed.
|
||||
-/
|
||||
isClosed : α → Async Bool
|
||||
|
||||
/--
|
||||
Selector that resolves when a chunk is available or EOF is reached.
|
||||
-/
|
||||
recvSelector : α → Selector (Option Chunk)
|
||||
|
||||
/--
|
||||
Gets the declared size of the body.
|
||||
-/
|
||||
getKnownSize : α → Async (Option Body.Length)
|
||||
|
||||
/--
|
||||
Sets the declared size of a body.
|
||||
-/
|
||||
setKnownSize : α → Option Body.Length → Async Unit
|
||||
end Std.Http
|
||||
|
||||
namespace Std.Http.Body
|
||||
|
||||
/--
|
||||
Typeclass for types that can be converted to a `ByteArray`.
|
||||
-/
|
||||
class ToByteArray (α : Type) where
|
||||
|
||||
/--
|
||||
Transforms into a `ByteArray`.
|
||||
-/
|
||||
toByteArray : α → ByteArray
|
||||
|
||||
instance : ToByteArray ByteArray where
|
||||
toByteArray := id
|
||||
|
||||
instance : ToByteArray String where
|
||||
toByteArray := String.toUTF8
|
||||
|
||||
/--
|
||||
Typeclass for types that can be decoded from a `ByteArray`. The conversion may fail with an error
|
||||
message if the bytes are not valid for the target type.
|
||||
-/
|
||||
class FromByteArray (α : Type) where
|
||||
|
||||
/--
|
||||
Attempts to decode a `ByteArray` into the target type, returning an error message on failure.
|
||||
-/
|
||||
fromByteArray : ByteArray → Except String α
|
||||
|
||||
instance : FromByteArray ByteArray where
|
||||
fromByteArray := .ok
|
||||
|
||||
instance : FromByteArray String where
|
||||
fromByteArray bs :=
|
||||
match String.fromUTF8? bs with
|
||||
| some s => .ok s
|
||||
| none => .error "invalid UTF-8 encoding"
|
||||
|
||||
end Std.Http.Body
|
||||
116
src/Std/Internal/Http/Data/Body/Empty.lean
Normal file
116
src/Std/Internal/Http/Data/Body/Empty.lean
Normal file
@@ -0,0 +1,116 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Internal.Http.Data.Request
|
||||
public import Std.Internal.Http.Data.Response
|
||||
public import Std.Internal.Http.Data.Body.Any
|
||||
|
||||
public section
|
||||
|
||||
/-!
|
||||
# Body.Empty
|
||||
|
||||
Represents an always-empty, already-closed body handle.
|
||||
-/
|
||||
|
||||
namespace Std.Http.Body
|
||||
open Std Internal IO Async
|
||||
|
||||
set_option linter.all true
|
||||
|
||||
/--
|
||||
An empty body handle.
|
||||
-/
|
||||
structure Empty where
|
||||
deriving Inhabited, BEq
|
||||
|
||||
namespace Empty
|
||||
|
||||
/--
|
||||
Receives from an empty body, always returning end-of-stream.
|
||||
-/
|
||||
@[inline]
|
||||
def recv (_ : Empty) : Async (Option Chunk) :=
|
||||
pure none
|
||||
|
||||
/--
|
||||
Closes an empty body (no-op).
|
||||
-/
|
||||
@[inline]
|
||||
def close (_ : Empty) : Async Unit :=
|
||||
pure ()
|
||||
|
||||
/--
|
||||
Empty bodies are always closed for reading.
|
||||
-/
|
||||
@[inline]
|
||||
def isClosed (_ : Empty) : Async Bool :=
|
||||
pure true
|
||||
|
||||
/--
|
||||
Selector that immediately resolves with end-of-stream for an empty body.
|
||||
-/
|
||||
@[inline]
|
||||
def recvSelector (_ : Empty) : Selector (Option Chunk) where
|
||||
tryFn := pure (some none)
|
||||
registerFn waiter := do
|
||||
let lose := pure ()
|
||||
let win promise := do
|
||||
promise.resolve (.ok none)
|
||||
waiter.race lose win
|
||||
unregisterFn := pure ()
|
||||
|
||||
end Empty
|
||||
|
||||
instance : Http.Body Empty where
|
||||
recv := Empty.recv
|
||||
close := Empty.close
|
||||
isClosed := Empty.isClosed
|
||||
recvSelector := Empty.recvSelector
|
||||
getKnownSize _ := pure (some <| .fixed 0)
|
||||
setKnownSize _ _ := pure ()
|
||||
|
||||
|
||||
instance : Coe Empty Any := ⟨Any.ofBody⟩
|
||||
|
||||
instance : Coe (Response Empty) (Response Any) where
|
||||
coe f := { f with }
|
||||
|
||||
instance : Coe (ContextAsync (Response Empty)) (ContextAsync (Response Any)) where
|
||||
coe action := do
|
||||
let response ← action
|
||||
pure (response : Response Any)
|
||||
|
||||
instance : Coe (Async (Response Empty)) (ContextAsync (Response Any)) where
|
||||
coe action := do
|
||||
let response ← action
|
||||
pure (response : Response Any)
|
||||
|
||||
end Body
|
||||
|
||||
namespace Request.Builder
|
||||
open Internal.IO.Async
|
||||
|
||||
/--
|
||||
Builds a request with no body.
|
||||
-/
|
||||
def empty (builder : Builder) : Async (Request Body.Empty) :=
|
||||
pure <| builder.body {}
|
||||
|
||||
end Request.Builder
|
||||
|
||||
namespace Response.Builder
|
||||
open Internal.IO.Async
|
||||
|
||||
/--
|
||||
Builds a response with no body.
|
||||
-/
|
||||
def empty (builder : Builder) : Async (Response Body.Empty) :=
|
||||
pure <| builder.body {}
|
||||
|
||||
end Response.Builder
|
||||
232
src/Std/Internal/Http/Data/Body/Full.lean
Normal file
232
src/Std/Internal/Http/Data/Body/Full.lean
Normal file
@@ -0,0 +1,232 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Sync
|
||||
public import Std.Internal.Http.Data.Request
|
||||
public import Std.Internal.Http.Data.Response
|
||||
public import Std.Internal.Http.Data.Body.Any
|
||||
public import Init.Data.ByteArray
|
||||
|
||||
public section
|
||||
|
||||
/-!
|
||||
# Body.Full
|
||||
|
||||
A body backed by a fixed `ByteArray` held in a `Mutex`.
|
||||
|
||||
The byte array is consumed at most once: the first call to `recv` atomically takes the data
|
||||
and returns it as a single chunk; subsequent calls return `none` (end-of-stream).
|
||||
Closing the body discards any unconsumed data.
|
||||
-/
|
||||
|
||||
namespace Std.Http.Body
|
||||
open Std Internal IO Async
|
||||
|
||||
set_option linter.all true
|
||||
|
||||
/--
|
||||
A body backed by a fixed, mutex-protected `ByteArray`.
|
||||
|
||||
The data is consumed on the first read. Once consumed (or explicitly closed), the body
|
||||
behaves as a closed, empty channel.
|
||||
-/
|
||||
structure Full where
|
||||
private mk ::
|
||||
private state : Mutex (Option ByteArray)
|
||||
deriving Nonempty
|
||||
|
||||
namespace Full
|
||||
|
||||
private def takeChunk : AtomicT (Option ByteArray) Async (Option Chunk) := do
|
||||
match ← get with
|
||||
| none =>
|
||||
pure none
|
||||
| some data =>
|
||||
set (none : Option ByteArray)
|
||||
if data.isEmpty then
|
||||
pure none
|
||||
else
|
||||
pure (some (Chunk.ofByteArray data))
|
||||
|
||||
/--
|
||||
Creates a `Full` body from a `ByteArray`.
|
||||
-/
|
||||
def ofByteArray (data : ByteArray) : Async Full := do
|
||||
let state ← Mutex.new (some data)
|
||||
return { state }
|
||||
|
||||
/--
|
||||
Creates a `Full` body from a `String`.
|
||||
-/
|
||||
def ofString (data : String) : Async Full := do
|
||||
let state ← Mutex.new (some data.toUTF8)
|
||||
return { state }
|
||||
|
||||
/--
|
||||
Receives the body data. Returns the full byte array on the first call as a single chunk,
|
||||
then `none` on all subsequent calls.
|
||||
-/
|
||||
def recv (full : Full) : Async (Option Chunk) :=
|
||||
full.state.atomically do
|
||||
takeChunk
|
||||
|
||||
/--
|
||||
Closes the body, discarding any unconsumed data.
|
||||
-/
|
||||
def close (full : Full) : Async Unit :=
|
||||
full.state.atomically do
|
||||
set (none : Option ByteArray)
|
||||
|
||||
/--
|
||||
Returns `true` when the data has been consumed or the body has been closed.
|
||||
-/
|
||||
def isClosed (full : Full) : Async Bool :=
|
||||
full.state.atomically do
|
||||
return (← get).isNone
|
||||
|
||||
/--
|
||||
Returns the known size of the remaining data.
|
||||
Returns `some (.fixed n)` with the current byte count, or `some (.fixed 0)` if the body has
|
||||
already been consumed or closed.
|
||||
-/
|
||||
def getKnownSize (full : Full) : Async (Option Body.Length) :=
|
||||
full.state.atomically do
|
||||
match ← get with
|
||||
| none => pure (some (.fixed 0))
|
||||
| some data => pure (some (.fixed data.size))
|
||||
|
||||
/--
|
||||
Selector that immediately resolves to the remaining chunk (or EOF).
|
||||
-/
|
||||
def recvSelector (full : Full) : Selector (Option Chunk) where
|
||||
tryFn := do
|
||||
let chunk ← full.state.atomically do
|
||||
takeChunk
|
||||
pure (some chunk)
|
||||
|
||||
registerFn waiter := do
|
||||
full.state.atomically do
|
||||
let lose := pure ()
|
||||
|
||||
let win promise := do
|
||||
let chunk ← takeChunk
|
||||
promise.resolve (.ok chunk)
|
||||
|
||||
waiter.race lose win
|
||||
|
||||
unregisterFn := pure ()
|
||||
|
||||
end Full
|
||||
|
||||
instance : Http.Body Full where
|
||||
recv := Full.recv
|
||||
close := Full.close
|
||||
isClosed := Full.isClosed
|
||||
recvSelector := Full.recvSelector
|
||||
getKnownSize := Full.getKnownSize
|
||||
setKnownSize _ _ := pure ()
|
||||
|
||||
instance : Coe Full Any := ⟨Any.ofBody⟩
|
||||
|
||||
instance : Coe (Response Full) (Response Any) where
|
||||
coe f := { f with }
|
||||
|
||||
instance : Coe (ContextAsync (Response Full)) (ContextAsync (Response Any)) where
|
||||
coe action := do
|
||||
let response ← action
|
||||
pure (response : Response Any)
|
||||
|
||||
instance : Coe (Async (Response Full)) (ContextAsync (Response Any)) where
|
||||
coe action := do
|
||||
let response ← action
|
||||
pure (response : Response Any)
|
||||
|
||||
end Body
|
||||
|
||||
namespace Request.Builder
|
||||
|
||||
open Internal.IO.Async
|
||||
|
||||
/--
|
||||
Builds a request body from raw bytes without setting any headers.
|
||||
Use `bytes` instead if you want `Content-Type: application/octet-stream` set automatically.
|
||||
-/
|
||||
def fromBytes (builder : Builder) (content : ByteArray) : Async (Request Body.Full) := do
|
||||
return builder.body (← Body.Full.ofByteArray content)
|
||||
|
||||
/--
|
||||
Builds a request with a binary body.
|
||||
Sets `Content-Type: application/octet-stream`.
|
||||
Use `fromBytes` instead if you need to set a different `Content-Type` or none at all.
|
||||
-/
|
||||
def bytes (builder : Builder) (content : ByteArray) : Async (Request Body.Full) :=
|
||||
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/octet-stream")) content
|
||||
|
||||
/--
|
||||
Builds a request with a text body.
|
||||
Sets `Content-Type: text/plain; charset=utf-8`.
|
||||
-/
|
||||
def text (builder : Builder) (content : String) : Async (Request Body.Full) :=
|
||||
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/plain; charset=utf-8")) content.toUTF8
|
||||
|
||||
/--
|
||||
Builds a request with a JSON body.
|
||||
Sets `Content-Type: application/json`.
|
||||
-/
|
||||
def json (builder : Builder) (content : String) : Async (Request Body.Full) :=
|
||||
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/json")) content.toUTF8
|
||||
|
||||
/--
|
||||
Builds a request with an HTML body.
|
||||
Sets `Content-Type: text/html; charset=utf-8`.
|
||||
-/
|
||||
def html (builder : Builder) (content : String) : Async (Request Body.Full) :=
|
||||
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/html; charset=utf-8")) content.toUTF8
|
||||
|
||||
end Request.Builder
|
||||
|
||||
namespace Response.Builder
|
||||
open Internal.IO.Async
|
||||
|
||||
/--
|
||||
Builds a response body from raw bytes without setting any headers.
|
||||
Use `bytes` instead if you want `Content-Type: application/octet-stream` set automatically.
|
||||
-/
|
||||
def fromBytes (builder : Builder) (content : ByteArray) : Async (Response Body.Full) := do
|
||||
return builder.body (← Body.Full.ofByteArray content)
|
||||
|
||||
/--
|
||||
Builds a response with a binary body.
|
||||
Sets `Content-Type: application/octet-stream`.
|
||||
Use `fromBytes` instead if you need to set a different `Content-Type` or none at all.
|
||||
-/
|
||||
def bytes (builder : Builder) (content : ByteArray) : Async (Response Body.Full) :=
|
||||
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/octet-stream")) content
|
||||
|
||||
/--
|
||||
Builds a response with a text body.
|
||||
Sets `Content-Type: text/plain; charset=utf-8`.
|
||||
-/
|
||||
def text (builder : Builder) (content : String) : Async (Response Body.Full) :=
|
||||
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/plain; charset=utf-8")) content.toUTF8
|
||||
|
||||
/--
|
||||
Builds a response with a JSON body.
|
||||
Sets `Content-Type: application/json`.
|
||||
-/
|
||||
def json (builder : Builder) (content : String) : Async (Response Body.Full) :=
|
||||
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "application/json")) content.toUTF8
|
||||
|
||||
/--
|
||||
Builds a response with an HTML body.
|
||||
Sets `Content-Type: text/html; charset=utf-8`.
|
||||
-/
|
||||
def html (builder : Builder) (content : String) : Async (Response Body.Full) :=
|
||||
fromBytes (builder.header Header.Name.contentType (Header.Value.ofString! "text/html; charset=utf-8")) content.toUTF8
|
||||
|
||||
end Response.Builder
|
||||
60
src/Std/Internal/Http/Data/Body/Length.lean
Normal file
60
src/Std/Internal/Http/Data/Body/Length.lean
Normal file
@@ -0,0 +1,60 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.Data.Repr
|
||||
|
||||
public section
|
||||
|
||||
/-!
|
||||
# Body.Length
|
||||
|
||||
This module defines the `Length` type, that represents the Content-Length or Transfer-Encoding
|
||||
of an HTTP request or response.
|
||||
-/
|
||||
|
||||
namespace Std.Http.Body
|
||||
|
||||
set_option linter.all true
|
||||
|
||||
/--
|
||||
Size of the body of a response or request.
|
||||
-/
|
||||
inductive Length
|
||||
/--
|
||||
Indicates that the HTTP message body uses **chunked transfer encoding**.
|
||||
-/
|
||||
| chunked
|
||||
|
||||
/--
|
||||
Indicates that the HTTP message body has a **fixed, known length**, as specified by the
|
||||
`Content-Length` header.
|
||||
-/
|
||||
| fixed (n : Nat)
|
||||
deriving Repr, BEq
|
||||
|
||||
namespace Length
|
||||
|
||||
/--
|
||||
Checks if the `Length` is chunked.
|
||||
-/
|
||||
@[inline]
|
||||
def isChunked : Length → Bool
|
||||
| .chunked => true
|
||||
| _ => false
|
||||
|
||||
/--
|
||||
Checks if the `Length` is a fixed size.
|
||||
-/
|
||||
@[inline]
|
||||
def isFixed : Length → Bool
|
||||
| .fixed _ => true
|
||||
| _ => false
|
||||
|
||||
end Length
|
||||
|
||||
end Std.Http.Body
|
||||
650
src/Std/Internal/Http/Data/Body/Stream.lean
Normal file
650
src/Std/Internal/Http/Data/Body/Stream.lean
Normal file
@@ -0,0 +1,650 @@
|
||||
/-
|
||||
Copyright (c) 2025 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Sync
|
||||
public import Std.Internal.Async
|
||||
public import Std.Internal.Http.Data.Request
|
||||
public import Std.Internal.Http.Data.Response
|
||||
public import Std.Internal.Http.Data.Chunk
|
||||
public import Std.Internal.Http.Data.Body.Basic
|
||||
public import Std.Internal.Http.Data.Body.Any
|
||||
public import Init.Data.ByteArray
|
||||
|
||||
public section
|
||||
|
||||
/-!
|
||||
# Body.Stream
|
||||
|
||||
This module defines a zero-buffer rendezvous body channel (`Body.Stream`) that supports
|
||||
both sending and receiving chunks.
|
||||
|
||||
There is no queue and no capacity. A send waits for a receiver and a receive waits for a sender.
|
||||
At most one blocked producer and one blocked consumer are supported.
|
||||
-/
|
||||
|
||||
namespace Std.Http
|
||||
|
||||
namespace Body
|
||||
|
||||
open Std Internal IO Async
|
||||
|
||||
set_option linter.all true
|
||||
|
||||
namespace Channel
|
||||
|
||||
open Internal.IO.Async in
|
||||
private inductive Consumer where
|
||||
| normal (promise : IO.Promise (Option Chunk))
|
||||
| select (finished : Waiter (Option Chunk))
|
||||
|
||||
private def Consumer.resolve (c : Consumer) (x : Option Chunk) : BaseIO Bool := do
|
||||
match c with
|
||||
| .normal promise =>
|
||||
promise.resolve x
|
||||
return true
|
||||
| .select waiter =>
|
||||
let lose := return false
|
||||
let win promise := do
|
||||
promise.resolve (.ok x)
|
||||
return true
|
||||
waiter.race lose win
|
||||
|
||||
private structure Producer where
|
||||
chunk : Chunk
|
||||
|
||||
/--
|
||||
Resolved with `true` when consumed by a receiver, `false` when the channel closes.
|
||||
-/
|
||||
done : IO.Promise Bool
|
||||
|
||||
open Internal.IO.Async in
|
||||
private def resolveInterestWaiter (waiter : Waiter Bool) (x : Bool) : BaseIO Bool := do
|
||||
let lose := return false
|
||||
let win promise := do
|
||||
promise.resolve (.ok x)
|
||||
return true
|
||||
waiter.race lose win
|
||||
|
||||
private structure State where
|
||||
/--
|
||||
A single blocked producer waiting for a receiver.
|
||||
-/
|
||||
pendingProducer : Option Producer
|
||||
|
||||
/--
|
||||
A single blocked consumer waiting for a producer.
|
||||
-/
|
||||
pendingConsumer : Option Consumer
|
||||
|
||||
/--
|
||||
A waiter for `Stream.interestSelector`.
|
||||
-/
|
||||
interestWaiter : Option (Internal.IO.Async.Waiter Bool)
|
||||
|
||||
/--
|
||||
Whether the channel is closed.
|
||||
-/
|
||||
closed : Bool
|
||||
|
||||
/--
|
||||
Known size of the stream if available.
|
||||
-/
|
||||
knownSize : Option Body.Length
|
||||
|
||||
/--
|
||||
Buffered partial chunk data accumulated from `Stream.send ... (incomplete := true)`.
|
||||
These partial pieces are collapsed and emitted as a single chunk on the next complete send.
|
||||
-/
|
||||
pendingIncompleteChunk : Option Chunk := none
|
||||
deriving Nonempty
|
||||
|
||||
end Channel
|
||||
|
||||
/--
|
||||
A zero-buffer rendezvous body channel that supports both sending and receiving chunks.
|
||||
-/
|
||||
structure Stream where
|
||||
private mk ::
|
||||
private state : Mutex Channel.State
|
||||
deriving Nonempty, TypeName
|
||||
|
||||
/--
|
||||
Creates a rendezvous body stream.
|
||||
-/
|
||||
def mkStream : Async Stream := do
|
||||
let state ← Mutex.new {
|
||||
pendingProducer := none
|
||||
pendingConsumer := none
|
||||
interestWaiter := none
|
||||
closed := false
|
||||
knownSize := none
|
||||
}
|
||||
return { state }
|
||||
|
||||
namespace Channel
|
||||
|
||||
private def decreaseKnownSize (knownSize : Option Body.Length) (chunk : Chunk) : Option Body.Length :=
|
||||
match knownSize with
|
||||
| some (.fixed res) => some (Body.Length.fixed (res - chunk.data.size))
|
||||
| _ => knownSize
|
||||
|
||||
private def pruneFinishedWaiters [Monad m] [MonadLiftT (ST IO.RealWorld) m] :
|
||||
AtomicT State m Unit := do
|
||||
let st ← get
|
||||
|
||||
let pendingConsumer ←
|
||||
match st.pendingConsumer with
|
||||
| some (.select waiter) =>
|
||||
if ← waiter.checkFinished then
|
||||
pure none
|
||||
else
|
||||
pure st.pendingConsumer
|
||||
| _ =>
|
||||
pure st.pendingConsumer
|
||||
|
||||
let interestWaiter ←
|
||||
match st.interestWaiter with
|
||||
| some waiter =>
|
||||
if ← waiter.checkFinished then
|
||||
pure none
|
||||
else
|
||||
pure st.interestWaiter
|
||||
| none =>
|
||||
pure none
|
||||
|
||||
set { st with pendingConsumer, interestWaiter }
|
||||
|
||||
private def signalInterest [Monad m] [MonadLiftT (ST IO.RealWorld) m] [MonadLiftT BaseIO m] :
|
||||
AtomicT State m Unit := do
|
||||
let st ← get
|
||||
if let some waiter := st.interestWaiter then
|
||||
discard <| resolveInterestWaiter waiter true
|
||||
set { st with interestWaiter := none }
|
||||
|
||||
private def recvReady' [Monad m] [MonadLiftT (ST IO.RealWorld) m] :
|
||||
AtomicT State m Bool := do
|
||||
let st ← get
|
||||
return st.pendingProducer.isSome || st.closed
|
||||
|
||||
private def hasInterest' [Monad m] [MonadLiftT (ST IO.RealWorld) m] :
|
||||
AtomicT State m Bool := do
|
||||
let st ← get
|
||||
return st.pendingConsumer.isSome
|
||||
|
||||
private def tryRecv' [Monad m] [MonadLiftT (ST IO.RealWorld) m] [MonadLiftT BaseIO m] :
|
||||
AtomicT State m (Option Chunk) := do
|
||||
let st ← get
|
||||
if let some producer := st.pendingProducer then
|
||||
set {
|
||||
st with
|
||||
pendingProducer := none
|
||||
knownSize := decreaseKnownSize st.knownSize producer.chunk
|
||||
}
|
||||
discard <| producer.done.resolve true
|
||||
return some producer.chunk
|
||||
else
|
||||
return none
|
||||
|
||||
private def close' [Monad m] [MonadLiftT (ST IO.RealWorld) m] [MonadLiftT BaseIO m] :
|
||||
AtomicT State m Unit := do
|
||||
let st ← get
|
||||
if st.closed then
|
||||
return ()
|
||||
|
||||
if let some consumer := st.pendingConsumer then
|
||||
discard <| consumer.resolve none
|
||||
|
||||
if let some waiter := st.interestWaiter then
|
||||
discard <| resolveInterestWaiter waiter false
|
||||
|
||||
if let some producer := st.pendingProducer then
|
||||
discard <| producer.done.resolve false
|
||||
|
||||
set {
|
||||
st with
|
||||
pendingProducer := none
|
||||
pendingConsumer := none
|
||||
interestWaiter := none
|
||||
pendingIncompleteChunk := none
|
||||
closed := true
|
||||
}
|
||||
|
||||
end Channel
|
||||
|
||||
namespace Stream
|
||||
|
||||
/--
|
||||
Attempts to receive a chunk from the channel without blocking.
|
||||
Returns `some chunk` only when a producer is already waiting.
|
||||
-/
|
||||
def tryRecv (stream : Stream) : Async (Option Chunk) :=
|
||||
stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
Channel.tryRecv'
|
||||
|
||||
private def recv' (stream : Stream) : BaseIO (AsyncTask (Option Chunk)) := do
|
||||
stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
|
||||
if let some chunk ← Channel.tryRecv' then
|
||||
return AsyncTask.pure (some chunk)
|
||||
|
||||
let st ← get
|
||||
if st.closed then
|
||||
return AsyncTask.pure none
|
||||
|
||||
if st.pendingConsumer.isSome then
|
||||
return Task.pure (.error (IO.Error.userError "only one blocked consumer is allowed"))
|
||||
|
||||
let promise ← IO.Promise.new
|
||||
set { st with pendingConsumer := some (.normal promise) }
|
||||
Channel.signalInterest
|
||||
return promise.result?.map (sync := true) fun
|
||||
| none => .error (IO.Error.userError "the promise linked to the consumer was dropped")
|
||||
| some res => .ok res
|
||||
|
||||
/--
|
||||
Receives a chunk from the channel. Blocks until a producer sends one.
|
||||
Returns `none` if the channel is closed and no producer is waiting.
|
||||
-/
|
||||
def recv (stream : Stream) : Async (Option Chunk) := do
|
||||
Async.ofAsyncTask (← recv' stream)
|
||||
|
||||
/--
|
||||
Closes the channel.
|
||||
-/
|
||||
def close (stream : Stream) : Async Unit :=
|
||||
stream.state.atomically do
|
||||
Channel.close'
|
||||
|
||||
/--
|
||||
Checks whether the channel is closed.
|
||||
-/
|
||||
@[always_inline, inline]
|
||||
def isClosed (stream : Stream) : Async Bool :=
|
||||
stream.state.atomically do
|
||||
return (← get).closed
|
||||
|
||||
/--
|
||||
Gets the known size if available.
|
||||
-/
|
||||
@[always_inline, inline]
|
||||
def getKnownSize (stream : Stream) : Async (Option Body.Length) :=
|
||||
stream.state.atomically do
|
||||
return (← get).knownSize
|
||||
|
||||
/--
|
||||
Sets known size metadata.
|
||||
-/
|
||||
@[always_inline, inline]
|
||||
def setKnownSize (stream : Stream) (size : Option Body.Length) : Async Unit :=
|
||||
stream.state.atomically do
|
||||
modify fun st => { st with knownSize := size }
|
||||
|
||||
open Internal.IO.Async in
|
||||
|
||||
/--
|
||||
Creates a selector that resolves when a producer is waiting (or the channel closes).
|
||||
-/
|
||||
def recvSelector (stream : Stream) : Selector (Option Chunk) where
|
||||
tryFn := do
|
||||
stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
if ← Channel.recvReady' then
|
||||
return some (← Channel.tryRecv')
|
||||
else
|
||||
return none
|
||||
|
||||
registerFn waiter := do
|
||||
stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
if ← Channel.recvReady' then
|
||||
let lose := return ()
|
||||
let win promise := do
|
||||
promise.resolve (.ok (← Channel.tryRecv'))
|
||||
waiter.race lose win
|
||||
else
|
||||
let st ← get
|
||||
if st.pendingConsumer.isSome then
|
||||
throw (.userError "only one blocked consumer is allowed")
|
||||
|
||||
set { st with pendingConsumer := some (.select waiter) }
|
||||
Channel.signalInterest
|
||||
|
||||
unregisterFn := do
|
||||
stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
|
||||
/--
|
||||
Iterates over chunks until the channel closes.
|
||||
-/
|
||||
@[inline]
|
||||
protected partial def forIn
|
||||
{β : Type} (stream : Stream) (acc : β)
|
||||
(step : Chunk → β → Async (ForInStep β)) : Async β := do
|
||||
|
||||
let rec @[specialize] loop (stream : Stream) (acc : β) : Async β := do
|
||||
if let some chunk ← stream.recv then
|
||||
match ← step chunk acc with
|
||||
| .done res => return res
|
||||
| .yield res => loop stream res
|
||||
else
|
||||
return acc
|
||||
|
||||
loop stream acc
|
||||
|
||||
/--
|
||||
Context-aware iteration over chunks until the channel closes.
|
||||
-/
|
||||
@[inline]
|
||||
protected partial def forIn'
|
||||
{β : Type} (stream : Stream) (acc : β)
|
||||
(step : Chunk → β → ContextAsync (ForInStep β)) : ContextAsync β := do
|
||||
|
||||
let rec @[specialize] loop (stream : Stream) (acc : β) : ContextAsync β := do
|
||||
let data ← Selectable.one #[
|
||||
.case stream.recvSelector pure,
|
||||
.case (← ContextAsync.doneSelector) (fun _ => pure none),
|
||||
]
|
||||
|
||||
if let some chunk := data then
|
||||
match ← step chunk acc with
|
||||
| .done res => return res
|
||||
| .yield res => loop stream res
|
||||
else
|
||||
return acc
|
||||
|
||||
loop stream acc
|
||||
|
||||
/--
|
||||
Abstracts over how the next chunk is received, allowing `readAll` to work in both `Async`
|
||||
(no cancellation) and `ContextAsync` (races with cancellation via `doneSelector`).
|
||||
-/
|
||||
class NextChunk (m : Type → Type) where
|
||||
/--
|
||||
Receives the next chunk, stopping at EOF or (in `ContextAsync`) when the context is cancelled.
|
||||
-/
|
||||
nextChunk : Stream → m (Option Chunk)
|
||||
|
||||
instance : NextChunk Async where
|
||||
nextChunk := Stream.recv
|
||||
|
||||
instance : NextChunk ContextAsync where
|
||||
nextChunk stream := do
|
||||
Selectable.one #[
|
||||
.case stream.recvSelector pure,
|
||||
.case (← ContextAsync.doneSelector) (fun _ => pure none),
|
||||
]
|
||||
|
||||
/--
|
||||
Reads all remaining chunks and decodes them into `α`.
|
||||
|
||||
Works in both `Async` (reads until EOF, no cancellation) and `ContextAsync` (also stops if the
|
||||
context is cancelled).
|
||||
-/
|
||||
partial def readAll
|
||||
[FromByteArray α]
|
||||
[Monad m] [MonadExceptOf IO.Error m] [NextChunk m]
|
||||
(stream : Stream)
|
||||
(maximumSize : Option UInt64 := none) :
|
||||
m α := do
|
||||
|
||||
let rec loop (result : ByteArray) : m ByteArray := do
|
||||
match ← NextChunk.nextChunk stream with
|
||||
| none => return result
|
||||
| some chunk =>
|
||||
let result := result ++ chunk.data
|
||||
if let some max := maximumSize then
|
||||
if result.size.toUInt64 > max then
|
||||
throw (.userError s!"body exceeded maximum size of {max} bytes")
|
||||
loop result
|
||||
|
||||
let result ← loop ByteArray.empty
|
||||
|
||||
match FromByteArray.fromByteArray result with
|
||||
| .ok a => return a
|
||||
| .error msg => throw (.userError msg)
|
||||
|
||||
private def collapseForSend
|
||||
(stream : Stream)
|
||||
(chunk : Chunk)
|
||||
(incomplete : Bool) : BaseIO (Except IO.Error (Option Chunk)) := do
|
||||
|
||||
stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
let st ← get
|
||||
|
||||
if st.closed then
|
||||
return .error (.userError "channel closed")
|
||||
|
||||
let merged := match st.pendingIncompleteChunk with
|
||||
| some pending =>
|
||||
{
|
||||
data := pending.data ++ chunk.data
|
||||
extensions := if pending.extensions.isEmpty then chunk.extensions else pending.extensions
|
||||
}
|
||||
| none => chunk
|
||||
|
||||
if incomplete then
|
||||
set { st with pendingIncompleteChunk := some merged }
|
||||
return .ok none
|
||||
else
|
||||
set { st with pendingIncompleteChunk := none }
|
||||
return .ok (some merged)
|
||||
|
||||
/--
|
||||
Sends a chunk, retrying if a select-mode consumer races and loses. If no consumer is ready,
|
||||
installs the chunk as a pending producer and awaits acknowledgement from the receiver.
|
||||
-/
|
||||
private partial def send' (stream : Stream) (chunk : Chunk) : Async Unit := do
|
||||
let done ← IO.Promise.new
|
||||
let result : Except IO.Error (Option Bool) ← stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
let st ← get
|
||||
|
||||
if st.closed then
|
||||
return .error (IO.Error.userError "channel closed")
|
||||
|
||||
if let some consumer := st.pendingConsumer then
|
||||
let success ← consumer.resolve (some chunk)
|
||||
|
||||
if success then
|
||||
set {
|
||||
st with
|
||||
pendingConsumer := none
|
||||
knownSize := Channel.decreaseKnownSize st.knownSize chunk
|
||||
}
|
||||
return .ok (some true)
|
||||
else
|
||||
set { st with pendingConsumer := none }
|
||||
return .ok (some false)
|
||||
else if st.pendingProducer.isSome then
|
||||
return .error (IO.Error.userError "only one blocked producer is allowed")
|
||||
else
|
||||
set { st with pendingProducer := some { chunk, done } }
|
||||
return .ok none
|
||||
|
||||
match result with
|
||||
| .error err =>
|
||||
throw err
|
||||
| .ok (some true) =>
|
||||
return ()
|
||||
| .ok (some false) =>
|
||||
-- The select-mode consumer raced and lost; recurse to allocate a fresh `done` promise.
|
||||
send' stream chunk
|
||||
| .ok none =>
|
||||
match ← await done.result? with
|
||||
| some true => return ()
|
||||
| _ => throw (IO.Error.userError "channel closed")
|
||||
|
||||
/--
|
||||
Sends a chunk.
|
||||
|
||||
If `incomplete := true`, the chunk is buffered and collapsed with subsequent chunks, and is not
|
||||
delivered to the receiver yet.
|
||||
If `incomplete := false`, any buffered incomplete pieces are collapsed with this chunk and the
|
||||
single merged chunk is sent.
|
||||
-/
|
||||
def send (stream : Stream) (chunk : Chunk) (incomplete : Bool := false) : Async Unit := do
|
||||
match (← collapseForSend stream chunk incomplete) with
|
||||
| .error err => throw err
|
||||
| .ok none => pure ()
|
||||
| .ok (some toSend) =>
|
||||
if toSend.data.isEmpty ∧ toSend.extensions.isEmpty then
|
||||
return ()
|
||||
|
||||
send' stream toSend
|
||||
|
||||
/--
|
||||
Returns `true` when a consumer is currently blocked waiting for data.
|
||||
-/
|
||||
def hasInterest (stream : Stream) : Async Bool :=
|
||||
stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
Channel.hasInterest'
|
||||
|
||||
open Internal.IO.Async in
|
||||
/--
|
||||
Creates a selector that resolves when consumer interest is present.
|
||||
Returns `true` when a consumer is waiting, `false` when the channel closes first.
|
||||
-/
|
||||
def interestSelector (stream : Stream) : Selector Bool where
|
||||
tryFn := do
|
||||
stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
let st ← get
|
||||
if st.pendingConsumer.isSome then
|
||||
return some true
|
||||
else if st.closed then
|
||||
return some false
|
||||
else
|
||||
return none
|
||||
|
||||
registerFn waiter := do
|
||||
stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
let st ← get
|
||||
|
||||
if st.pendingConsumer.isSome then
|
||||
let lose := return ()
|
||||
let win promise := do
|
||||
promise.resolve (.ok true)
|
||||
waiter.race lose win
|
||||
else if st.closed then
|
||||
let lose := return ()
|
||||
let win promise := do
|
||||
promise.resolve (.ok false)
|
||||
waiter.race lose win
|
||||
else if st.interestWaiter.isSome then
|
||||
throw (.userError "only one blocked interest selector is allowed")
|
||||
else
|
||||
set { st with interestWaiter := some waiter }
|
||||
|
||||
unregisterFn := do
|
||||
stream.state.atomically do
|
||||
Channel.pruneFinishedWaiters
|
||||
|
||||
end Stream
|
||||
|
||||
/--
|
||||
Creates a body from a producer function.
|
||||
Returns the stream immediately and runs `gen` in a detached task.
|
||||
The channel is always closed when `gen` returns or throws.
|
||||
Errors from `gen` are not rethrown here; consumers observe end-of-stream via `recv = none`.
|
||||
-/
|
||||
def stream (gen : Stream → Async Unit) : Async Stream := do
|
||||
let s ← mkStream
|
||||
background <| do
|
||||
try
|
||||
gen s
|
||||
finally
|
||||
s.close
|
||||
return s
|
||||
|
||||
/--
|
||||
Creates a body from a fixed byte array.
|
||||
-/
|
||||
def fromBytes (content : ByteArray) : Async Stream := do
|
||||
stream fun s => do
|
||||
s.setKnownSize (some (.fixed content.size))
|
||||
if content.size > 0 then
|
||||
s.send (Chunk.ofByteArray content)
|
||||
|
||||
/--
|
||||
Creates an empty `Stream` body channel (already closed, no data).
|
||||
|
||||
Prefer `Body.Empty` when you need a concrete zero-cost type. Use this when the calling
|
||||
context requires a `Stream` specifically.
|
||||
-/
|
||||
def empty : Async Stream := do
|
||||
let s ← mkStream
|
||||
s.setKnownSize (some (.fixed 0))
|
||||
s.close
|
||||
return s
|
||||
|
||||
instance : ForIn Async Stream Chunk where
|
||||
forIn := Stream.forIn
|
||||
|
||||
instance : ForIn ContextAsync Stream Chunk where
|
||||
forIn := Stream.forIn'
|
||||
|
||||
instance : Http.Body Stream where
|
||||
recv := Stream.recv
|
||||
close := Stream.close
|
||||
isClosed := Stream.isClosed
|
||||
recvSelector := Stream.recvSelector
|
||||
getKnownSize := Stream.getKnownSize
|
||||
setKnownSize := Stream.setKnownSize
|
||||
|
||||
instance : Coe Stream Any := ⟨Any.ofBody⟩
|
||||
|
||||
instance : Coe (Response Stream) (Response Any) where
|
||||
coe f := { f with }
|
||||
|
||||
instance : Coe (ContextAsync (Response Stream)) (ContextAsync (Response Any)) where
|
||||
coe action := do
|
||||
let response ← action
|
||||
pure (response : Response Any)
|
||||
|
||||
instance : Coe (Async (Response Stream)) (ContextAsync (Response Any)) where
|
||||
coe action := do
|
||||
let response ← action
|
||||
pure (response : Response Any)
|
||||
|
||||
end Body
|
||||
|
||||
namespace Request.Builder
|
||||
|
||||
open Internal.IO.Async
|
||||
|
||||
/--
|
||||
Builds a request with a streaming body generator.
|
||||
-/
|
||||
def stream
|
||||
(builder : Builder)
|
||||
(gen : Body.Stream → Async Unit) :
|
||||
Async (Request Body.Stream) := do
|
||||
let s ← Body.stream gen
|
||||
return Request.Builder.body builder s
|
||||
|
||||
end Request.Builder
|
||||
|
||||
namespace Response.Builder
|
||||
open Internal.IO.Async
|
||||
|
||||
/--
|
||||
Builds a response with a streaming body generator.
|
||||
-/
|
||||
def stream
|
||||
(builder : Builder)
|
||||
(gen : Body.Stream → Async Unit) :
|
||||
Async (Response Body.Stream) := do
|
||||
let s ← Body.stream gen
|
||||
return Response.Builder.body builder s
|
||||
|
||||
end Response.Builder
|
||||
@@ -124,12 +124,6 @@ def new : Builder := { }
|
||||
|
||||
namespace Builder
|
||||
|
||||
/--
|
||||
Creates a new HTTP request builder with the default head
|
||||
(method: GET, version: HTTP/1.1, target: `*`).
|
||||
-/
|
||||
def empty : Builder := { }
|
||||
|
||||
/--
|
||||
Sets the HTTP method for the request being built.
|
||||
-/
|
||||
|
||||
@@ -111,7 +111,7 @@ namespace Builder
|
||||
/--
|
||||
Creates a new HTTP Response builder with default head (status: 200 OK, version: HTTP/1.1).
|
||||
-/
|
||||
def empty : Builder := { }
|
||||
def new : Builder := { }
|
||||
|
||||
/--
|
||||
Sets the HTTP status code for the response being built.
|
||||
@@ -173,66 +173,66 @@ end Builder
|
||||
Creates a new HTTP Response builder with the 200 status code.
|
||||
-/
|
||||
def ok : Builder :=
|
||||
.empty |>.status .ok
|
||||
.new |>.status .ok
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the provided status.
|
||||
-/
|
||||
def withStatus (status : Status) : Builder :=
|
||||
.empty |>.status status
|
||||
.new |>.status status
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 404 status code.
|
||||
-/
|
||||
def notFound : Builder :=
|
||||
.empty |>.status .notFound
|
||||
.new |>.status .notFound
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 500 status code.
|
||||
-/
|
||||
def internalServerError : Builder :=
|
||||
.empty |>.status .internalServerError
|
||||
.new |>.status .internalServerError
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 400 status code.
|
||||
-/
|
||||
def badRequest : Builder :=
|
||||
.empty |>.status .badRequest
|
||||
.new |>.status .badRequest
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 201 status code.
|
||||
-/
|
||||
def created : Builder :=
|
||||
.empty |>.status .created
|
||||
.new |>.status .created
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 202 status code.
|
||||
-/
|
||||
def accepted : Builder :=
|
||||
.empty |>.status .accepted
|
||||
.new |>.status .accepted
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 401 status code.
|
||||
-/
|
||||
def unauthorized : Builder :=
|
||||
.empty |>.status .unauthorized
|
||||
.new |>.status .unauthorized
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 403 status code.
|
||||
-/
|
||||
def forbidden : Builder :=
|
||||
.empty |>.status .forbidden
|
||||
.new |>.status .forbidden
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 409 status code.
|
||||
-/
|
||||
def conflict : Builder :=
|
||||
.empty |>.status .conflict
|
||||
.new |>.status .conflict
|
||||
|
||||
/--
|
||||
Creates a new HTTP Response builder with the 503 status code.
|
||||
-/
|
||||
def serviceUnavailable : Builder :=
|
||||
.empty |>.status .serviceUnavailable
|
||||
.new |>.status .serviceUnavailable
|
||||
|
||||
end Response
|
||||
|
||||
@@ -94,4 +94,3 @@ def parseOrRoot (s : String) : Std.Http.URI.Path :=
|
||||
parse? s |>.getD { segments := #[], absolute := true }
|
||||
|
||||
end Std.Http.URI.Path
|
||||
|
||||
|
||||
@@ -1,10 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Internal.SSL.Context
|
||||
public import Std.Internal.SSL.Session
|
||||
@@ -1,75 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.System.Promise
|
||||
|
||||
public section
|
||||
|
||||
namespace Std.Internal.SSL
|
||||
|
||||
/--
|
||||
Distinguishes server-side from client-side TLS contexts and sessions at the type level.
|
||||
-/
|
||||
inductive Role where
|
||||
| server
|
||||
| client
|
||||
|
||||
private opaque ContextServerImpl : NonemptyType.{0}
|
||||
private opaque ContextClientImpl : NonemptyType.{0}
|
||||
|
||||
/--
|
||||
Server-side TLS context (`SSL_CTX` configured with `TLS_server_method`).
|
||||
-/
|
||||
def Context.Server : Type := ContextServerImpl.type
|
||||
|
||||
/--
|
||||
Client-side TLS context (`SSL_CTX` configured with `TLS_client_method`).
|
||||
-/
|
||||
def Context.Client : Type := ContextClientImpl.type
|
||||
|
||||
instance : Nonempty Context.Server := ContextServerImpl.property
|
||||
instance : Nonempty Context.Client := ContextClientImpl.property
|
||||
|
||||
namespace Context
|
||||
|
||||
namespace Server
|
||||
|
||||
/--
|
||||
Creates a new server-side TLS context using `TLS_server_method`.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_ctx_mk_server"]
|
||||
opaque mk : IO Context.Server
|
||||
|
||||
/--
|
||||
Loads a PEM certificate and private key into a server context.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_ctx_configure_server"]
|
||||
opaque configure (ctx : @& Context.Server) (certFile : @& String) (keyFile : @& String) : IO Unit
|
||||
|
||||
end Server
|
||||
|
||||
namespace Client
|
||||
|
||||
/--
|
||||
Creates a new client-side TLS context using `TLS_client_method`.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_ctx_mk_client"]
|
||||
opaque mk : IO Context.Client
|
||||
|
||||
/--
|
||||
Configures CA trust anchors and peer verification for a client context.
|
||||
`caFile` may be empty to use platform default trust anchors.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_ctx_configure_client"]
|
||||
opaque configure (ctx : @& Context.Client) (caFile : @& String) (verifyPeer : Bool) : IO Unit
|
||||
|
||||
end Client
|
||||
|
||||
end Context
|
||||
|
||||
end Std.Internal.SSL
|
||||
@@ -1,152 +0,0 @@
|
||||
/-
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Authors: Sofia Rodrigues
|
||||
-/
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Std.Internal.SSL.Context
|
||||
|
||||
public section
|
||||
|
||||
namespace Std.Internal.SSL
|
||||
|
||||
private opaque SessionImpl : Role → NonemptyType.{0}
|
||||
|
||||
/--
|
||||
Indicates what kind of socket I/O OpenSSL needs before the current operation can proceed.
|
||||
-/
|
||||
inductive IOWant where
|
||||
|
||||
/--
|
||||
OpenSSL needs more encrypted bytes from the socket (`SSL_ERROR_WANT_READ`).
|
||||
-/
|
||||
| read
|
||||
|
||||
/--
|
||||
OpenSSL needs to flush encrypted bytes to the socket (`SSL_ERROR_WANT_WRITE`).
|
||||
-/
|
||||
| write
|
||||
|
||||
/--
|
||||
Result of a `Session.read?` call.
|
||||
-/
|
||||
inductive ReadResult where
|
||||
|
||||
/--
|
||||
Plaintext data was successfully decrypted.
|
||||
-/
|
||||
| data (bytes : ByteArray)
|
||||
|
||||
/--
|
||||
OpenSSL needs socket I/O before it can produce plaintext.
|
||||
-/
|
||||
| wantIO (want : IOWant)
|
||||
|
||||
/--
|
||||
The peer closed the TLS session cleanly (`SSL_ERROR_ZERO_RETURN`).
|
||||
-/
|
||||
| closed
|
||||
|
||||
/--
|
||||
Represents an OpenSSL SSL session parameterized by role.
|
||||
Use `Session.Server` or `Session.Client` for the concrete aliases.
|
||||
-/
|
||||
def Session (r : Role) : Type := (SessionImpl r).type
|
||||
|
||||
/--
|
||||
Server-side TLS session.
|
||||
-/
|
||||
abbrev Session.Server := Session .server
|
||||
|
||||
/--
|
||||
Client-side TLS session.
|
||||
-/
|
||||
abbrev Session.Client := Session .client
|
||||
|
||||
instance (r : Role) : Nonempty (Session r) := (SessionImpl r).property
|
||||
|
||||
namespace Session
|
||||
|
||||
namespace Server
|
||||
|
||||
/--
|
||||
Creates a new server-side SSL session from the given context.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_mk_server"]
|
||||
opaque mk (ctx : @& Context.Server) : IO Session.Server
|
||||
|
||||
end Server
|
||||
|
||||
namespace Client
|
||||
|
||||
/--
|
||||
Creates a new client-side SSL session from the given context.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_mk_client"]
|
||||
opaque mk (ctx : @& Context.Client) : IO Session.Client
|
||||
|
||||
/--
|
||||
Sets the SNI host name for client-side handshakes.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_set_server_name"]
|
||||
opaque setServerName (ssl : @& Session.Client) (host : @& String) : IO Unit
|
||||
|
||||
end Client
|
||||
|
||||
/--
|
||||
Gets the X.509 verify result code after handshake.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_verify_result"]
|
||||
opaque verifyResult {r : Role} (ssl : @& Session r) : IO UInt64
|
||||
|
||||
/--
|
||||
Runs one handshake step.
|
||||
Returns `none` when the handshake is complete, or `some w` when OpenSSL needs socket I/O of
|
||||
kind `w` before the handshake can proceed.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_handshake"]
|
||||
opaque handshake {r : Role} (ssl : @& Session r) : IO (Option IOWant)
|
||||
|
||||
/--
|
||||
Attempts to write plaintext application data into SSL.
|
||||
Returns `none` when the data was accepted, or `some w` when OpenSSL needs socket I/O of kind
|
||||
`w` before the write can complete (the data is queued internally and retried after the next read).
|
||||
-/
|
||||
@[extern "lean_uv_ssl_write"]
|
||||
opaque write {r : Role} (ssl : @& Session r) (data : @& ByteArray) : IO (Option IOWant)
|
||||
|
||||
/--
|
||||
Attempts to read decrypted plaintext data.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_read"]
|
||||
opaque read? {r : Role} (ssl : @& Session r) (maxBytes : UInt64) : IO ReadResult
|
||||
|
||||
/--
|
||||
Feeds encrypted TLS bytes into the SSL input BIO.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_feed_encrypted"]
|
||||
opaque feedEncrypted {r : Role} (ssl : @& Session r) (data : @& ByteArray) : IO UInt64
|
||||
|
||||
/--
|
||||
Drains encrypted TLS bytes from the SSL output BIO.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_drain_encrypted"]
|
||||
opaque drainEncrypted {r : Role} (ssl : @& Session r) : IO ByteArray
|
||||
|
||||
/--
|
||||
Returns the amount of encrypted TLS bytes currently pending in the output BIO.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_pending_encrypted"]
|
||||
opaque pendingEncrypted {r : Role} (ssl : @& Session r) : IO UInt64
|
||||
|
||||
/--
|
||||
Returns the amount of decrypted plaintext bytes currently buffered inside the SSL object.
|
||||
-/
|
||||
@[extern "lean_uv_ssl_pending_plaintext"]
|
||||
opaque pendingPlaintext {r : Role} (ssl : @& Session r) : IO UInt64
|
||||
|
||||
end Session
|
||||
|
||||
end Std.Internal.SSL
|
||||
@@ -174,19 +174,19 @@ opaque osEnviron : IO (Array (String × String))
|
||||
Gets the value of an environment variable.
|
||||
-/
|
||||
@[extern "lean_uv_os_getenv"]
|
||||
opaque osGetenv : String → IO (Option String)
|
||||
opaque osGetenv : @& String → IO (Option String)
|
||||
|
||||
/--
|
||||
Sets the value of an environment variable.
|
||||
-/
|
||||
@[extern "lean_uv_os_setenv"]
|
||||
opaque osSetenv : String → String → IO Unit
|
||||
opaque osSetenv : @& String → @& String → IO Unit
|
||||
|
||||
/--
|
||||
Unsets an environment variable.
|
||||
-/
|
||||
@[extern "lean_uv_os_unsetenv"]
|
||||
opaque osUnsetenv : String → IO Unit
|
||||
opaque osUnsetenv : @& String → IO Unit
|
||||
|
||||
/--
|
||||
Gets the hostname of the machine.
|
||||
|
||||
@@ -239,7 +239,7 @@ def ofFin' {lo : Nat} (fin : Fin (Nat.succ hi)) (h : lo ≤ hi) : Bounded.LE lo
|
||||
else ofNat' lo (And.intro (Nat.le_refl lo) h)
|
||||
|
||||
/--
|
||||
Creates a new `Bounded.LE` using a the modulus of a number.
|
||||
Creates a new `Bounded.LE` using the modulus of a number.
|
||||
-/
|
||||
@[inline]
|
||||
def byEmod (b : Int) (i : Int) (hi : i > 0) : Bounded.LE 0 (i - 1) := by
|
||||
@@ -252,7 +252,7 @@ def byEmod (b : Int) (i : Int) (hi : i > 0) : Bounded.LE 0 (i - 1) := by
|
||||
exact Int.emod_lt_of_pos b hi
|
||||
|
||||
/--
|
||||
Creates a new `Bounded.LE` using a the Truncating modulus of a number.
|
||||
Creates a new `Bounded.LE` using the Truncating modulus of a number.
|
||||
-/
|
||||
@[inline]
|
||||
def byMod (b : Int) (i : Int) (hi : 0 < i) : Bounded.LE (- (i - 1)) (i - 1) := by
|
||||
|
||||
@@ -386,7 +386,7 @@ OPTIONS:
|
||||
--force-download redownload existing files
|
||||
|
||||
Downloads build outputs for packages in the workspace from a remote cache
|
||||
service. The cache service used can be specifed via the `--service` option.
|
||||
service. The cache service used can be specified via the `--service` option.
|
||||
Otherwise, Lake will the system default, or, if none is configured, Reservoir.
|
||||
See `lake cache services` for more information on how to configure services.
|
||||
|
||||
@@ -429,7 +429,7 @@ USAGE:
|
||||
|
||||
Uploads the input-to-output mappings contained in the specified file along
|
||||
with the corresponding output artifacts to a remote cache. The cache service
|
||||
used via be specified via `--service` option. If not specifed, Lake will used
|
||||
used can be specified via the `--service` option. If not specified, Lake will use
|
||||
the system default, or error if none is configured. See the help page of
|
||||
`lake cache services` for more information on how to configure services.
|
||||
|
||||
|
||||
@@ -446,7 +446,7 @@ protected def get : CliM PUnit := do
|
||||
logWarning endpointDeprecation
|
||||
if opts.mappingsOnly then
|
||||
error "`--mappings-only` requires services to be configured
|
||||
via the Lake system configuration (not enviroment variables)"
|
||||
via the Lake system configuration (not environment variables)"
|
||||
return .downloadService artifactEndpoint revisionEndpoint ws.lakeEnv.cacheService?
|
||||
| none, none =>
|
||||
return ws.defaultCacheService
|
||||
|
||||
@@ -765,12 +765,13 @@ where
|
||||
\n remote URL: {info.url}"
|
||||
match cfg.kind with
|
||||
| .get =>
|
||||
if let .ok size := out.getAs Nat "size_download" then
|
||||
if size > 0 then
|
||||
if let .ok contentType := out.getAs String "content_type" then
|
||||
if contentType != artifactContentType then
|
||||
if let .ok resp ← IO.FS.readFile info.path |>.toBaseIO then
|
||||
msg := s!"{msg}\nunexpected response:\n{resp}"
|
||||
unless code? matches .ok 404 do -- ignore response bodies on 404s
|
||||
if let .ok size := out.getAs Nat "size_download" then
|
||||
if size > 0 then
|
||||
if let .ok contentType := out.getAs String "content_type" then
|
||||
if contentType != artifactContentType then
|
||||
if let .ok resp ← IO.FS.readFile info.path |>.toBaseIO then
|
||||
msg := s!"{msg}\nunexpected response:\n{resp}"
|
||||
removeFileIfExists info.path
|
||||
| .put =>
|
||||
if let .ok size := out.getAs Nat "size_download" then
|
||||
@@ -787,7 +788,7 @@ private def transferArtifacts
|
||||
match cfg.kind with
|
||||
| .get =>
|
||||
cfg.infos.forM fun info => do
|
||||
h.putStrLn s!"url = {info.url}"
|
||||
h.putStrLn s!"url = {info.url.quote}"
|
||||
h.putStrLn s!"-o {info.path.toString.quote}"
|
||||
h.flush
|
||||
return #[
|
||||
@@ -798,7 +799,7 @@ private def transferArtifacts
|
||||
| .put =>
|
||||
cfg.infos.forM fun info => do
|
||||
h.putStrLn s!"-T {info.path.toString.quote}"
|
||||
h.putStrLn s!"url = {info.url}"
|
||||
h.putStrLn s!"url = {info.url.quote}"
|
||||
h.flush
|
||||
return #[
|
||||
"-Z", "-X", "PUT", "-L",
|
||||
@@ -827,6 +828,13 @@ private def transferArtifacts
|
||||
if s.didError then
|
||||
failure
|
||||
|
||||
private def reservoirArtifactsUrl (service : CacheService) (scope : CacheServiceScope) : String :=
|
||||
let endpoint :=
|
||||
match scope.impl with
|
||||
| .repo scope => appendScope s!"{service.impl.apiEndpoint}/repositories" scope
|
||||
| .str scope => appendScope s!"{service.impl.apiEndpoint}/packages" scope
|
||||
s!"{endpoint}/artifacts"
|
||||
|
||||
public def downloadArtifacts
|
||||
(descrs : Array ArtifactDescr) (cache : Cache)
|
||||
(service : CacheService) (scope : CacheServiceScope) (force := false)
|
||||
@@ -844,8 +852,68 @@ public def downloadArtifacts
|
||||
return s.push {url, path, descr}
|
||||
if infos.isEmpty then
|
||||
return
|
||||
let infos ← id do
|
||||
if service.isReservoir then
|
||||
-- Artifact cloud storage URLs are fetched in a single request
|
||||
-- to avoid hammering the Reservoir web host
|
||||
fetchUrls (service.reservoirArtifactsUrl scope) infos
|
||||
else return infos
|
||||
IO.FS.createDirAll cache.artifactDir
|
||||
transferArtifacts {scope, infos, kind := .get}
|
||||
where
|
||||
fetchUrls url infos := IO.FS.withTempFile fun h path => do
|
||||
let body := Json.arr <| infos.map (toJson ·.descr.hash)
|
||||
h.putStr body.compress
|
||||
h.flush
|
||||
let args := #[
|
||||
"-X", "POST", "-L", "-d", s!"@{path}",
|
||||
"--retry", "3", -- intermittent network errors can occur
|
||||
"-s", "-w", "%{stderr}%{json}\n",
|
||||
"-H", "Content-Type: application/json",
|
||||
]
|
||||
let args := Reservoir.lakeHeaders.foldl (· ++ #["-H", ·]) args
|
||||
let spawnArgs := {
|
||||
cmd := "curl", args := args.push url
|
||||
stdout := .piped, stderr := .piped
|
||||
}
|
||||
logVerbose (mkCmdLog spawnArgs)
|
||||
let {stdout, stderr, exitCode} ← IO.Process.output spawnArgs
|
||||
match Json.parse stdout >>= fromJson? with
|
||||
| .ok (resp : ReservoirResp (Array String)) =>
|
||||
match resp with
|
||||
| .data urls =>
|
||||
if h : infos.size = urls.size then
|
||||
let s := infos.size.fold (init := infos.toVector) fun i hi s =>
|
||||
s.set i {s[i] with url := urls[i]'(h ▸ hi)}
|
||||
return s.toArray
|
||||
else
|
||||
error s!"failed to fetch artifact URLs\
|
||||
\n POST {url}\
|
||||
\nIncorrect number of results: expected {infos.size}, got {urls.size}"
|
||||
| .error status message =>
|
||||
error s!"failed to fetch artifact URLs (status code: {status})\
|
||||
\n POST {url}\
|
||||
\nReservoir error: {message}"
|
||||
| .error _ =>
|
||||
match Json.parse stderr >>= fromJson? with
|
||||
| .ok (out : JsonObject) =>
|
||||
let mut msg := "failed to fetch artifact URLs"
|
||||
if let .ok code := out.getAs Nat "http_code" then
|
||||
msg := s!"{msg} (status code: {code})"
|
||||
msg := s!"{msg}\n POST {url}"
|
||||
if let .ok errMsg := out.getAs String "errormsg" then
|
||||
msg := s!"{msg}\n Transfer error: {errMsg}"
|
||||
unless stdout.isEmpty do
|
||||
msg := s!"{msg}\nstdout:\n{stdout.trimAsciiEnd}"
|
||||
logError msg
|
||||
logVerbose s!"curl JSON:\n{stderr.trimAsciiEnd}"
|
||||
| .error e =>
|
||||
logError s!"failed to fetch artifact URLs\
|
||||
\n POST {url}
|
||||
\nInvalid curl JSON: {e}; received: {stderr.trimAscii}"
|
||||
unless stdout.isEmpty do
|
||||
logWarning s!"curl produced unexpected output:\n{stdout.trimAsciiEnd}"
|
||||
error s!"curl exited with code {exitCode}"
|
||||
|
||||
@[deprecated "Deprecated without replacement." (since := "2026-02-27")]
|
||||
public def downloadOutputArtifacts
|
||||
|
||||
@@ -103,24 +103,6 @@ public instance : FromJson RegistryPkg := ⟨RegistryPkg.fromJson?⟩
|
||||
|
||||
end RegistryPkg
|
||||
|
||||
/-- A Reservoir API response object. -/
|
||||
public inductive ReservoirResp (α : Type u)
|
||||
| data (a : α)
|
||||
| error (status : Nat) (message : String)
|
||||
|
||||
public protected def ReservoirResp.fromJson? [FromJson α] (val : Json) : Except String (ReservoirResp α) := do
|
||||
let obj ← JsonObject.fromJson? val
|
||||
if let some (err : JsonObject) ← obj.get? "error" then
|
||||
let status ← err.get "status"
|
||||
let message ← err.get "message"
|
||||
return .error status message
|
||||
else if let some (val : Json) ← obj.get? "data" then
|
||||
.data <$> fromJson? val
|
||||
else
|
||||
.data <$> fromJson? val
|
||||
|
||||
public instance [FromJson α] : FromJson (ReservoirResp α) := ⟨ReservoirResp.fromJson?⟩
|
||||
|
||||
public def Reservoir.pkgApiUrl (lakeEnv : Lake.Env) (owner pkg : String) :=
|
||||
s!"{lakeEnv.reservoirApiUrl}/packages/{uriEncode owner}/{uriEncode pkg}"
|
||||
|
||||
|
||||
@@ -6,8 +6,9 @@ Authors: Mac Malone
|
||||
module
|
||||
|
||||
prelude
|
||||
public import Init.Prelude
|
||||
import Init.Data.Array.Basic
|
||||
public import Lake.Util.JsonObject
|
||||
|
||||
open Lean
|
||||
|
||||
namespace Lake
|
||||
|
||||
@@ -15,3 +16,23 @@ public def Reservoir.lakeHeaders : Array String := #[
|
||||
"X-Reservoir-Api-Version:1.0.0",
|
||||
"X-Lake-Registry-Api-Version:0.1.0"
|
||||
]
|
||||
|
||||
/-- A Reservoir API response object. -/
|
||||
public inductive ReservoirResp (α : Type u)
|
||||
| data (a : α)
|
||||
| error (status : Nat) (message : String)
|
||||
|
||||
public protected def ReservoirResp.fromJson? [FromJson α] (val : Json) : Except String (ReservoirResp α) := do
|
||||
if let .ok obj := JsonObject.fromJson? val then
|
||||
if let some (err : JsonObject) ← obj.get? "error" then
|
||||
let status ← err.get "status"
|
||||
let message ← err.get "message"
|
||||
return .error status message
|
||||
else if let some (val : Json) ← obj.get? "data" then
|
||||
.data <$> fromJson? val
|
||||
else
|
||||
.data <$> fromJson? val
|
||||
else
|
||||
.data <$> fromJson? val
|
||||
|
||||
public instance [FromJson α] : FromJson (ReservoirResp α) := ⟨ReservoirResp.fromJson?⟩
|
||||
|
||||
@@ -77,7 +77,7 @@ globs = ["Lake.*"]
|
||||
defaultFacets = ["static", "static.export"]
|
||||
# Load the previous stage's lake native code into lake's build process in order to prevent ABI
|
||||
# breakages from affecting bootstrapping.
|
||||
moreLeanArgs = ["--plugin", "${PREV_STAGE}/lib/lean/libLake_shared${CMAKE_SHARED_LIBRARY_SUFFIX}"]
|
||||
moreLeanArgs = ["--plugin", "${PREV_STAGE}/${CMAKE_RELATIVE_LIBRARY_OUTPUT_DIRECTORY}/libLake_shared${CMAKE_SHARED_LIBRARY_SUFFIX}"]
|
||||
|
||||
[[lean_lib]]
|
||||
name = "LakeMain"
|
||||
|
||||
@@ -33,9 +33,6 @@ set(
|
||||
uv/dns.cpp
|
||||
uv/system.cpp
|
||||
uv/signal.cpp
|
||||
openssl.cpp
|
||||
openssl/context.cpp
|
||||
openssl/session.cpp
|
||||
)
|
||||
if(USE_MIMALLOC)
|
||||
list(APPEND RUNTIME_OBJS ${LEAN_BINARY_DIR}/../mimalloc/src/mimalloc/src/static.c)
|
||||
|
||||
@@ -14,9 +14,6 @@ Author: Leonardo de Moura
|
||||
#include "runtime/mutex.h"
|
||||
#include "runtime/init_module.h"
|
||||
#include "runtime/libuv.h"
|
||||
#include "runtime/openssl.h"
|
||||
#include "runtime/openssl/context.h"
|
||||
#include "runtime/openssl/session.h"
|
||||
|
||||
namespace lean {
|
||||
extern "C" LEAN_EXPORT void lean_initialize_runtime_module() {
|
||||
@@ -28,9 +25,6 @@ extern "C" LEAN_EXPORT void lean_initialize_runtime_module() {
|
||||
initialize_mutex();
|
||||
initialize_process();
|
||||
initialize_stack_overflow();
|
||||
initialize_openssl();
|
||||
initialize_openssl_context();
|
||||
initialize_openssl_session();
|
||||
initialize_libuv();
|
||||
}
|
||||
void initialize_runtime_module() {
|
||||
@@ -38,7 +32,6 @@ void initialize_runtime_module() {
|
||||
}
|
||||
void finalize_runtime_module() {
|
||||
finalize_stack_overflow();
|
||||
finalize_openssl();
|
||||
finalize_process();
|
||||
finalize_mutex();
|
||||
finalize_thread();
|
||||
|
||||
@@ -1,43 +0,0 @@
|
||||
/*
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Author: Sofia Rodrigues
|
||||
*/
|
||||
#include "runtime/openssl.h"
|
||||
#include "runtime/io.h"
|
||||
|
||||
#ifndef LEAN_EMSCRIPTEN
|
||||
#include <openssl/opensslv.h>
|
||||
#include <openssl/ssl.h>
|
||||
#include <openssl/err.h>
|
||||
|
||||
namespace lean {
|
||||
|
||||
void initialize_openssl() {
|
||||
if (OPENSSL_init_ssl(0, nullptr) != 1) {
|
||||
lean_internal_panic("failed to initialize OpenSSL");
|
||||
}
|
||||
}
|
||||
|
||||
void finalize_openssl() {}
|
||||
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_openssl_version(lean_obj_arg o) {
|
||||
return lean_unsigned_to_nat(OPENSSL_VERSION_NUMBER);
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
namespace lean {
|
||||
|
||||
void initialize_openssl() {}
|
||||
void finalize_openssl() {}
|
||||
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_openssl_version(lean_obj_arg o) {
|
||||
return lean_box(0);
|
||||
}
|
||||
|
||||
#endif
|
||||
@@ -1,16 +0,0 @@
|
||||
/*
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Author: Sofia Rodrigues
|
||||
*/
|
||||
#pragma once
|
||||
#include <lean/lean.h>
|
||||
|
||||
namespace lean {
|
||||
|
||||
void initialize_openssl();
|
||||
void finalize_openssl();
|
||||
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_openssl_version(lean_obj_arg);
|
||||
@@ -1,148 +0,0 @@
|
||||
/*
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Author: Sofia Rodrigues
|
||||
*/
|
||||
|
||||
#include "runtime/openssl/context.h"
|
||||
|
||||
#ifndef LEAN_EMSCRIPTEN
|
||||
#include <openssl/err.h>
|
||||
#endif
|
||||
|
||||
namespace lean {
|
||||
|
||||
#ifndef LEAN_EMSCRIPTEN
|
||||
|
||||
static inline lean_obj_res mk_ssl_ctx_io_error(char const * where) {
|
||||
unsigned long err = ERR_get_error();
|
||||
char err_buf[256];
|
||||
err_buf[0] = '\0';
|
||||
|
||||
if (err != 0) {
|
||||
ERR_error_string_n(err, err_buf, sizeof(err_buf));
|
||||
}
|
||||
|
||||
ERR_clear_error();
|
||||
|
||||
std::string msg(where);
|
||||
if (err_buf[0] != '\0') {
|
||||
msg += ": ";
|
||||
msg += err_buf;
|
||||
}
|
||||
|
||||
return lean_io_result_mk_error(lean_mk_io_user_error(mk_string(msg.c_str())));
|
||||
}
|
||||
|
||||
static void configure_ctx_options(SSL_CTX * ctx) {
|
||||
SSL_CTX_clear_options(ctx, SSL_OP_NO_RENEGOTIATION);
|
||||
}
|
||||
|
||||
static void lean_ssl_context_finalizer(void * ptr) {
|
||||
lean_ssl_context_object * obj = (lean_ssl_context_object*)ptr;
|
||||
if (obj->ctx != nullptr) {
|
||||
SSL_CTX_free(obj->ctx);
|
||||
}
|
||||
free(obj);
|
||||
}
|
||||
|
||||
void initialize_openssl_context() {
|
||||
g_ssl_context_external_class = lean_register_external_class(lean_ssl_context_finalizer, [](void * obj, lean_object * f) {
|
||||
(void)obj;
|
||||
(void)f;
|
||||
});
|
||||
}
|
||||
|
||||
static lean_obj_res mk_ssl_context(const SSL_METHOD * method) {
|
||||
SSL_CTX * ctx = SSL_CTX_new(method);
|
||||
if (ctx == nullptr) {
|
||||
return mk_ssl_ctx_io_error("SSL_CTX_new failed");
|
||||
}
|
||||
|
||||
configure_ctx_options(ctx);
|
||||
|
||||
lean_ssl_context_object * obj = (lean_ssl_context_object*)malloc(sizeof(lean_ssl_context_object));
|
||||
if (obj == nullptr) {
|
||||
SSL_CTX_free(ctx);
|
||||
return mk_ssl_ctx_io_error("failed to allocate SSL context object");
|
||||
}
|
||||
|
||||
obj->ctx = ctx;
|
||||
lean_object * lean_obj = lean_ssl_context_object_new(obj);
|
||||
lean_mark_mt(lean_obj);
|
||||
return lean_io_result_mk_ok(lean_obj);
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Context.mkServer : IO Context */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_mk_server() {
|
||||
return mk_ssl_context(TLS_server_method());
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Context.mkClient : IO Context */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_mk_client() {
|
||||
return mk_ssl_context(TLS_client_method());
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Context.configureServer (ctx : @& Context) (certFile keyFile : @& String) : IO Unit */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_configure_server(b_obj_arg ctx_obj, b_obj_arg cert_file, b_obj_arg key_file) {
|
||||
lean_ssl_context_object * obj = lean_to_ssl_context_object(ctx_obj);
|
||||
const char * cert = lean_string_cstr(cert_file);
|
||||
const char * key = lean_string_cstr(key_file);
|
||||
|
||||
if (SSL_CTX_use_certificate_file(obj->ctx, cert, SSL_FILETYPE_PEM) <= 0) {
|
||||
return mk_ssl_ctx_io_error("SSL_CTX_use_certificate_file failed");
|
||||
}
|
||||
if (SSL_CTX_use_PrivateKey_file(obj->ctx, key, SSL_FILETYPE_PEM) <= 0) {
|
||||
return mk_ssl_ctx_io_error("SSL_CTX_use_PrivateKey_file failed");
|
||||
}
|
||||
if (SSL_CTX_check_private_key(obj->ctx) != 1) {
|
||||
return mk_ssl_ctx_io_error("SSL_CTX_check_private_key failed");
|
||||
}
|
||||
|
||||
return lean_io_result_mk_ok(lean_box(0));
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Context.configureClient (ctx : @& Context) (caFile : @& String) (verifyPeer : Bool) : IO Unit */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_configure_client(b_obj_arg ctx_obj, b_obj_arg ca_file, uint8_t verify_peer) {
|
||||
lean_ssl_context_object * obj = lean_to_ssl_context_object(ctx_obj);
|
||||
const char * ca = lean_string_cstr(ca_file);
|
||||
|
||||
if (ca != nullptr && ca[0] != '\0') {
|
||||
if (SSL_CTX_load_verify_locations(obj->ctx, ca, nullptr) != 1) {
|
||||
return mk_ssl_ctx_io_error("SSL_CTX_load_verify_locations failed");
|
||||
}
|
||||
} else if (verify_peer) {
|
||||
if (SSL_CTX_set_default_verify_paths(obj->ctx) != 1) {
|
||||
return mk_ssl_ctx_io_error("SSL_CTX_set_default_verify_paths failed");
|
||||
}
|
||||
}
|
||||
|
||||
SSL_CTX_set_verify(obj->ctx, verify_peer ? SSL_VERIFY_PEER : SSL_VERIFY_NONE, nullptr);
|
||||
return lean_io_result_mk_ok(lean_box(0));
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
void initialize_openssl_context() {}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_mk_server() {
|
||||
return io_result_mk_error("lean_uv_ssl_ctx_mk_server is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_mk_client() {
|
||||
return io_result_mk_error("lean_uv_ssl_ctx_mk_client is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_configure_server(b_obj_arg ctx_obj, b_obj_arg cert_file, b_obj_arg key_file) {
|
||||
(void)ctx_obj; (void)cert_file; (void)key_file;
|
||||
return io_result_mk_error("lean_uv_ssl_ctx_configure_server is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_configure_client(b_obj_arg ctx_obj, b_obj_arg ca_file, uint8_t verify_peer) {
|
||||
(void)ctx_obj; (void)ca_file; (void)verify_peer;
|
||||
return io_result_mk_error("lean_uv_ssl_ctx_configure_client is not supported");
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
}
|
||||
@@ -1,40 +0,0 @@
|
||||
/*
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Author: Sofia Rodrigues
|
||||
*/
|
||||
#pragma once
|
||||
|
||||
#include <lean/lean.h>
|
||||
#include "runtime/io.h"
|
||||
#include "runtime/object.h"
|
||||
#include "runtime/openssl.h"
|
||||
|
||||
#ifndef LEAN_EMSCRIPTEN
|
||||
#include <openssl/ssl.h>
|
||||
#endif
|
||||
|
||||
namespace lean {
|
||||
|
||||
static lean_external_class * g_ssl_context_external_class = nullptr;
|
||||
void initialize_openssl_context();
|
||||
|
||||
#ifndef LEAN_EMSCRIPTEN
|
||||
typedef struct {
|
||||
SSL_CTX * ctx;
|
||||
} lean_ssl_context_object;
|
||||
|
||||
static inline lean_object * lean_ssl_context_object_new(lean_ssl_context_object * c) {
|
||||
return lean_alloc_external(g_ssl_context_external_class, c);
|
||||
}
|
||||
static inline lean_ssl_context_object * lean_to_ssl_context_object(lean_object * o) {
|
||||
return (lean_ssl_context_object*)(lean_get_external_data(o));
|
||||
}
|
||||
#endif
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_mk_server();
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_mk_client();
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_configure_server(b_obj_arg ctx, b_obj_arg cert_file, b_obj_arg key_file);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_ctx_configure_client(b_obj_arg ctx, b_obj_arg ca_file, uint8_t verify_peer);
|
||||
|
||||
}
|
||||
@@ -1,501 +0,0 @@
|
||||
/*
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Author: Sofia Rodrigues
|
||||
*/
|
||||
|
||||
#include "runtime/openssl/session.h"
|
||||
|
||||
#include <climits>
|
||||
#include <new>
|
||||
#include <string>
|
||||
|
||||
#ifndef LEAN_EMSCRIPTEN
|
||||
#include <openssl/err.h>
|
||||
#endif
|
||||
|
||||
namespace lean {
|
||||
|
||||
#ifndef LEAN_EMSCRIPTEN
|
||||
|
||||
static inline lean_object * mk_ssl_error(char const * where, int ssl_err = 0) {
|
||||
unsigned long err = ERR_get_error();
|
||||
char err_buf[256];
|
||||
err_buf[0] = '\0';
|
||||
|
||||
if (err != 0) {
|
||||
ERR_error_string_n(err, err_buf, sizeof(err_buf));
|
||||
}
|
||||
|
||||
// Drain remaining errors so they don't pollute future calls.
|
||||
ERR_clear_error();
|
||||
|
||||
std::string msg(where);
|
||||
|
||||
if (ssl_err != 0) {
|
||||
msg += " (ssl_error=" + std::to_string(ssl_err) + ")";
|
||||
}
|
||||
if (err_buf[0] != '\0') {
|
||||
msg += ": ";
|
||||
msg += err_buf;
|
||||
}
|
||||
|
||||
return lean_mk_io_user_error(mk_string(msg.c_str()));
|
||||
}
|
||||
|
||||
static inline lean_obj_res mk_ssl_io_error(char const * where, int ssl_err = 0) {
|
||||
return lean_io_result_mk_error(mk_ssl_error(where, ssl_err));
|
||||
}
|
||||
|
||||
/*
|
||||
* Lean encoding for `Option IOWant`:
|
||||
* none = lean_box(0) (handshake done / write accepted)
|
||||
* some IOWant.read = ctor(1){ lean_box(0) } (SSL_ERROR_WANT_READ)
|
||||
* some IOWant.write = ctor(1){ lean_box(1) } (SSL_ERROR_WANT_WRITE)
|
||||
*
|
||||
* Lean encoding for `ReadResult`:
|
||||
* data bytes = ctor(0){ bytes } (non-nullary constructor 0)
|
||||
* wantIO .read = ctor(1){ lean_box(0) } (non-nullary constructor 1)
|
||||
* wantIO .write = ctor(1){ lean_box(1) }
|
||||
* closed = lean_box(0) (first nullary constructor)
|
||||
*/
|
||||
static inline lean_obj_res mk_option_io_want_none() {
|
||||
return lean_io_result_mk_ok(lean_box(0));
|
||||
}
|
||||
|
||||
static inline lean_obj_res mk_option_io_want_read() {
|
||||
lean_object * r = lean_alloc_ctor(1, 1, 0);
|
||||
lean_ctor_set(r, 0, lean_box(0));
|
||||
return lean_io_result_mk_ok(r);
|
||||
}
|
||||
|
||||
static inline lean_obj_res mk_option_io_want_write() {
|
||||
lean_object * r = lean_alloc_ctor(1, 1, 0);
|
||||
lean_ctor_set(r, 0, lean_box(1));
|
||||
return lean_io_result_mk_ok(r);
|
||||
}
|
||||
|
||||
static inline lean_obj_res mk_read_result_data(lean_object * bytes) {
|
||||
lean_object * r = lean_alloc_ctor(0, 1, 0);
|
||||
lean_ctor_set(r, 0, bytes);
|
||||
return lean_io_result_mk_ok(r);
|
||||
}
|
||||
|
||||
static inline lean_obj_res mk_read_result_want_read() {
|
||||
lean_object * r = lean_alloc_ctor(1, 1, 0);
|
||||
lean_ctor_set(r, 0, lean_box(0));
|
||||
return lean_io_result_mk_ok(r);
|
||||
}
|
||||
|
||||
static inline lean_obj_res mk_read_result_want_write() {
|
||||
lean_object * r = lean_alloc_ctor(1, 1, 0);
|
||||
lean_ctor_set(r, 0, lean_box(1));
|
||||
return lean_io_result_mk_ok(r);
|
||||
}
|
||||
|
||||
static inline lean_obj_res mk_read_result_closed() {
|
||||
return lean_io_result_mk_ok(lean_box(0));
|
||||
}
|
||||
|
||||
static inline lean_object * mk_empty_byte_array() {
|
||||
lean_object * arr = lean_alloc_sarray(1, 0, 0);
|
||||
lean_sarray_set_size(arr, 0);
|
||||
return arr;
|
||||
}
|
||||
|
||||
/*
|
||||
Return values:
|
||||
1 -> write completed
|
||||
0 -> write blocked (WANT_READ / WANT_WRITE / ZERO_RETURN)
|
||||
-1 -> fatal error
|
||||
*/
|
||||
static int ssl_write_step(lean_ssl_session_object * obj, char const * data, size_t size, int * out_err) {
|
||||
if (size > INT_MAX) {
|
||||
*out_err = SSL_ERROR_SSL;
|
||||
return -1;
|
||||
}
|
||||
|
||||
int rc = SSL_write(obj->ssl, data, (int)size);
|
||||
if (rc > 0) {
|
||||
return 1;
|
||||
}
|
||||
|
||||
int err = SSL_get_error(obj->ssl, rc);
|
||||
*out_err = err;
|
||||
if (err == SSL_ERROR_WANT_READ || err == SSL_ERROR_WANT_WRITE || err == SSL_ERROR_ZERO_RETURN) {
|
||||
return 0;
|
||||
}
|
||||
return -1;
|
||||
}
|
||||
|
||||
/*
|
||||
Return values:
|
||||
1 -> all pending writes flushed
|
||||
0 -> still blocked, *out_err filled with SSL_ERROR_WANT_READ or SSL_ERROR_WANT_WRITE
|
||||
-1 -> fatal error, *out_err filled
|
||||
*/
|
||||
static int try_flush_pending_writes(lean_ssl_session_object * obj, int * out_err) {
|
||||
while (!obj->pending_writes.empty()) {
|
||||
auto & pw = obj->pending_writes.front();
|
||||
int step = ssl_write_step(obj, pw.data(), pw.size(), out_err);
|
||||
if (step < 0) return -1;
|
||||
if (step == 0) return 0;
|
||||
obj->pending_writes.erase(obj->pending_writes.begin());
|
||||
}
|
||||
return 1;
|
||||
}
|
||||
|
||||
void lean_ssl_session_finalizer(void * ptr) {
|
||||
lean_ssl_session_object * obj = (lean_ssl_session_object*)ptr;
|
||||
if (obj->ssl != nullptr) SSL_free(obj->ssl);
|
||||
delete obj;
|
||||
}
|
||||
|
||||
void initialize_openssl_session() {
|
||||
g_ssl_session_external_class = lean_register_external_class(lean_ssl_session_finalizer, [](void * obj, lean_object * f) {
|
||||
(void)obj;
|
||||
(void)f;
|
||||
});
|
||||
}
|
||||
|
||||
static lean_obj_res mk_ssl_session(SSL_CTX * ctx, uint8_t is_server) {
|
||||
SSL * ssl = SSL_new(ctx);
|
||||
if (ssl == nullptr) {
|
||||
return mk_ssl_io_error("SSL_new failed");
|
||||
}
|
||||
|
||||
BIO * read_bio = BIO_new(BIO_s_mem());
|
||||
BIO * write_bio = BIO_new(BIO_s_mem());
|
||||
|
||||
if (read_bio == nullptr || write_bio == nullptr) {
|
||||
if (read_bio != nullptr) BIO_free(read_bio);
|
||||
if (write_bio != nullptr) BIO_free(write_bio);
|
||||
SSL_free(ssl);
|
||||
return mk_ssl_io_error("BIO_new failed");
|
||||
}
|
||||
|
||||
BIO_set_nbio(read_bio, 1);
|
||||
BIO_set_nbio(write_bio, 1);
|
||||
|
||||
SSL_set_bio(ssl, read_bio, write_bio);
|
||||
|
||||
if (is_server) {
|
||||
SSL_set_accept_state(ssl);
|
||||
} else {
|
||||
SSL_set_connect_state(ssl);
|
||||
}
|
||||
|
||||
lean_ssl_session_object * ssl_obj = new (std::nothrow) lean_ssl_session_object();
|
||||
if (ssl_obj == nullptr) {
|
||||
SSL_free(ssl);
|
||||
return mk_ssl_io_error("failed to allocate SSL session object");
|
||||
}
|
||||
|
||||
ssl_obj->ssl = ssl;
|
||||
ssl_obj->read_bio = read_bio;
|
||||
ssl_obj->write_bio = write_bio;
|
||||
|
||||
lean_object * obj = lean_ssl_session_object_new(ssl_obj);
|
||||
lean_mark_mt(obj);
|
||||
return lean_io_result_mk_ok(obj);
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.Server.mk (ctx : @& Context.Server) : IO Session.Server */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_mk_server(b_obj_arg ctx_obj) {
|
||||
lean_ssl_context_object * ctx = lean_to_ssl_context_object(ctx_obj);
|
||||
return mk_ssl_session(ctx->ctx, 1);
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.Client.mk (ctx : @& Context.Client) : IO Session.Client */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_mk_client(b_obj_arg ctx_obj) {
|
||||
lean_ssl_context_object * ctx = lean_to_ssl_context_object(ctx_obj);
|
||||
return mk_ssl_session(ctx->ctx, 0);
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.Client.setServerName (ssl : @& Session.Client) (host : @& String) : IO Unit */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_set_server_name(b_obj_arg ssl, b_obj_arg host) {
|
||||
lean_ssl_session_object * ssl_obj = lean_to_ssl_session_object(ssl);
|
||||
const char * server_name = lean_string_cstr(host);
|
||||
if (SSL_set_tlsext_host_name(ssl_obj->ssl, server_name) != 1) {
|
||||
return mk_ssl_io_error("SSL_set_tlsext_host_name failed");
|
||||
}
|
||||
return lean_io_result_mk_ok(lean_box(0));
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.verifyResult (ssl : @& Session) : IO UInt64 */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_verify_result(b_obj_arg _role, b_obj_arg ssl) {
|
||||
lean_ssl_session_object * ssl_obj = lean_to_ssl_session_object(ssl);
|
||||
long result = SSL_get_verify_result(ssl_obj->ssl);
|
||||
return lean_io_result_mk_ok(lean_box_uint64((uint64_t)result));
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.handshake (ssl : @& Session) : IO (Option IOWant) */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_handshake(b_obj_arg _role, b_obj_arg ssl) {
|
||||
lean_ssl_session_object * ssl_obj = lean_to_ssl_session_object(ssl);
|
||||
int rc = SSL_do_handshake(ssl_obj->ssl);
|
||||
|
||||
if (rc == 1) {
|
||||
return mk_option_io_want_none();
|
||||
}
|
||||
|
||||
int err = SSL_get_error(ssl_obj->ssl, rc);
|
||||
if (err == SSL_ERROR_WANT_READ || err == SSL_ERROR_ZERO_RETURN) {
|
||||
return mk_option_io_want_read();
|
||||
}
|
||||
if (err == SSL_ERROR_WANT_WRITE) {
|
||||
return mk_option_io_want_write();
|
||||
}
|
||||
|
||||
return mk_ssl_io_error("SSL_do_handshake failed", err);
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.write (ssl : @& Session) (data : @& ByteArray) : IO (Option IOWant) */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_write(b_obj_arg _role, b_obj_arg ssl, b_obj_arg data) {
|
||||
lean_ssl_session_object * ssl_obj = lean_to_ssl_session_object(ssl);
|
||||
size_t data_len = lean_sarray_size(data);
|
||||
char const * payload = (char const*)lean_sarray_cptr(data);
|
||||
|
||||
if (data_len == 0) {
|
||||
return mk_option_io_want_none();
|
||||
}
|
||||
|
||||
// If there are pending writes, try to flush them first to preserve write order.
|
||||
// Only attempt the new write directly if the queue fully drains.
|
||||
if (!ssl_obj->pending_writes.empty()) {
|
||||
int flush_err = 0;
|
||||
int flushed = try_flush_pending_writes(ssl_obj, &flush_err);
|
||||
|
||||
if (flushed < 0) {
|
||||
return mk_ssl_io_error("pending SSL write flush failed", flush_err);
|
||||
}
|
||||
|
||||
if (flushed == 0) {
|
||||
ssl_obj->pending_writes.emplace_back(payload, payload + data_len);
|
||||
if (flush_err == SSL_ERROR_WANT_READ) {
|
||||
return mk_option_io_want_read();
|
||||
}
|
||||
return mk_option_io_want_write();
|
||||
}
|
||||
// flushed == 1: queue is clear, fall through to attempt the new write
|
||||
}
|
||||
|
||||
int err = 0;
|
||||
int step = ssl_write_step(ssl_obj, payload, data_len, &err);
|
||||
|
||||
if (step == 1) {
|
||||
return mk_option_io_want_none();
|
||||
}
|
||||
|
||||
if (step == 0 && err == SSL_ERROR_ZERO_RETURN) {
|
||||
return mk_ssl_io_error("SSL_write failed: peer closed the TLS session", err);
|
||||
}
|
||||
|
||||
// Queue plaintext so it is retried after the required socket I/O completes.
|
||||
if (step == 0) {
|
||||
ssl_obj->pending_writes.emplace_back(payload, payload + data_len);
|
||||
if (err == SSL_ERROR_WANT_READ) {
|
||||
return mk_option_io_want_read();
|
||||
}
|
||||
return mk_option_io_want_write();
|
||||
}
|
||||
|
||||
return mk_ssl_io_error("SSL_write failed", err);
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.read? (ssl : @& Session) (maxBytes : UInt64) : IO ReadResult */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_read(b_obj_arg _role, b_obj_arg ssl, uint64_t max_bytes) {
|
||||
lean_ssl_session_object * ssl_obj = lean_to_ssl_session_object(ssl);
|
||||
|
||||
if (max_bytes == 0) {
|
||||
return mk_read_result_data(mk_empty_byte_array());
|
||||
}
|
||||
|
||||
if (max_bytes > INT_MAX) {
|
||||
max_bytes = INT_MAX;
|
||||
}
|
||||
|
||||
lean_object * out = lean_alloc_sarray(1, 0, max_bytes);
|
||||
int rc = SSL_read(ssl_obj->ssl, (void*)lean_sarray_cptr(out), (int)max_bytes);
|
||||
|
||||
if (rc > 0) {
|
||||
int flush_err = 0;
|
||||
if (try_flush_pending_writes(ssl_obj, &flush_err) < 0) {
|
||||
lean_dec(out);
|
||||
return mk_ssl_io_error("pending SSL write flush failed", flush_err);
|
||||
}
|
||||
lean_sarray_set_size(out, (size_t)rc);
|
||||
return mk_read_result_data(out);
|
||||
}
|
||||
|
||||
lean_dec(out);
|
||||
|
||||
int err = SSL_get_error(ssl_obj->ssl, rc);
|
||||
|
||||
if (err == SSL_ERROR_ZERO_RETURN) {
|
||||
int flush_err = 0;
|
||||
if (try_flush_pending_writes(ssl_obj, &flush_err) < 0) {
|
||||
return mk_ssl_io_error("pending SSL write flush failed", flush_err);
|
||||
}
|
||||
return mk_read_result_closed();
|
||||
}
|
||||
|
||||
if (err == SSL_ERROR_WANT_READ) {
|
||||
int flush_err = 0;
|
||||
int flushed = try_flush_pending_writes(ssl_obj, &flush_err);
|
||||
if (flushed < 0) {
|
||||
return mk_ssl_io_error("pending SSL write flush failed", flush_err);
|
||||
}
|
||||
if (flushed == 0 && flush_err == SSL_ERROR_WANT_WRITE) {
|
||||
return mk_read_result_want_write();
|
||||
}
|
||||
return mk_read_result_want_read();
|
||||
}
|
||||
|
||||
if (err == SSL_ERROR_WANT_WRITE) {
|
||||
int flush_err = 0;
|
||||
int flushed = try_flush_pending_writes(ssl_obj, &flush_err);
|
||||
if (flushed < 0) {
|
||||
return mk_ssl_io_error("pending SSL write flush failed", flush_err);
|
||||
}
|
||||
if (flushed == 0 && flush_err == SSL_ERROR_WANT_READ) {
|
||||
return mk_read_result_want_read();
|
||||
}
|
||||
return mk_read_result_want_write();
|
||||
}
|
||||
|
||||
return mk_ssl_io_error("SSL_read failed", err);
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.feedEncrypted (ssl : @& Session) (data : @& ByteArray) : IO UInt64 */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_feed_encrypted(b_obj_arg _role, b_obj_arg ssl, b_obj_arg data) {
|
||||
lean_ssl_session_object * ssl_obj = lean_to_ssl_session_object(ssl);
|
||||
size_t data_len = lean_sarray_size(data);
|
||||
|
||||
if (data_len == 0) {
|
||||
return lean_io_result_mk_ok(lean_box_uint64(0));
|
||||
}
|
||||
|
||||
if (data_len > INT_MAX) {
|
||||
return mk_ssl_io_error("BIO_write input too large");
|
||||
}
|
||||
|
||||
int rc = BIO_write(ssl_obj->read_bio, lean_sarray_cptr(data), (int)data_len);
|
||||
if (rc >= 0) {
|
||||
return lean_io_result_mk_ok(lean_box_uint64((uint64_t)rc));
|
||||
}
|
||||
|
||||
if (BIO_should_retry(ssl_obj->read_bio)) {
|
||||
return lean_io_result_mk_ok(lean_box_uint64(0));
|
||||
}
|
||||
|
||||
return mk_ssl_io_error("BIO_write failed");
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.drainEncrypted (ssl : @& Session) : IO ByteArray */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_drain_encrypted(b_obj_arg _role, b_obj_arg ssl) {
|
||||
lean_ssl_session_object * ssl_obj = lean_to_ssl_session_object(ssl);
|
||||
size_t pending = BIO_ctrl_pending(ssl_obj->write_bio);
|
||||
|
||||
if (pending == 0) {
|
||||
return lean_io_result_mk_ok(mk_empty_byte_array());
|
||||
}
|
||||
|
||||
if (pending > INT_MAX) {
|
||||
return mk_ssl_io_error("BIO_pending output too large");
|
||||
}
|
||||
|
||||
lean_object * out = lean_alloc_sarray(1, 0, pending);
|
||||
int rc = BIO_read(ssl_obj->write_bio, (void*)lean_sarray_cptr(out), (int)pending);
|
||||
|
||||
if (rc >= 0) {
|
||||
lean_sarray_set_size(out, (size_t)rc);
|
||||
return lean_io_result_mk_ok(out);
|
||||
}
|
||||
|
||||
lean_dec(out);
|
||||
|
||||
if (BIO_should_retry(ssl_obj->write_bio)) {
|
||||
return lean_io_result_mk_ok(mk_empty_byte_array());
|
||||
}
|
||||
|
||||
return mk_ssl_io_error("BIO_read failed");
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.pendingEncrypted (ssl : @& Session) : IO UInt64 */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_pending_encrypted(b_obj_arg _role, b_obj_arg ssl) {
|
||||
lean_ssl_session_object * ssl_obj = lean_to_ssl_session_object(ssl);
|
||||
return lean_io_result_mk_ok(lean_box_uint64((uint64_t)BIO_ctrl_pending(ssl_obj->write_bio)));
|
||||
}
|
||||
|
||||
/* Std.Internal.SSL.Session.pendingPlaintext (ssl : @& Session) : IO UInt64 */
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_pending_plaintext(b_obj_arg _role, b_obj_arg ssl) {
|
||||
lean_ssl_session_object * ssl_obj = lean_to_ssl_session_object(ssl);
|
||||
return lean_io_result_mk_ok(lean_box_uint64((uint64_t)SSL_pending(ssl_obj->ssl)));
|
||||
}
|
||||
|
||||
#else
|
||||
|
||||
void initialize_openssl_session() {}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_mk_server(b_obj_arg ctx_obj) {
|
||||
(void)ctx_obj;
|
||||
return io_result_mk_error("lean_uv_ssl_mk_server is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_mk_client(b_obj_arg ctx_obj) {
|
||||
(void)ctx_obj;
|
||||
return io_result_mk_error("lean_uv_ssl_mk_client is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_set_server_name(b_obj_arg ssl, b_obj_arg host) {
|
||||
(void)ssl;
|
||||
(void)host;
|
||||
return io_result_mk_error("lean_uv_ssl_set_server_name is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_verify_result(b_obj_arg _role, b_obj_arg ssl) {
|
||||
(void)ssl;
|
||||
return io_result_mk_error("lean_uv_ssl_verify_result is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_handshake(b_obj_arg _role, b_obj_arg ssl) {
|
||||
(void)ssl;
|
||||
return io_result_mk_error("lean_uv_ssl_handshake is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_write(b_obj_arg _role, b_obj_arg ssl, b_obj_arg data) {
|
||||
(void)ssl;
|
||||
(void)data;
|
||||
return io_result_mk_error("lean_uv_ssl_write is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_read(b_obj_arg _role, b_obj_arg ssl, uint64_t max_bytes) {
|
||||
(void)ssl;
|
||||
(void)max_bytes;
|
||||
return io_result_mk_error("lean_uv_ssl_read is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_feed_encrypted(b_obj_arg _role, b_obj_arg ssl, b_obj_arg data) {
|
||||
(void)ssl;
|
||||
(void)data;
|
||||
return io_result_mk_error("lean_uv_ssl_feed_encrypted is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_drain_encrypted(b_obj_arg _role, b_obj_arg ssl) {
|
||||
(void)ssl;
|
||||
return io_result_mk_error("lean_uv_ssl_drain_encrypted is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_pending_encrypted(b_obj_arg _role, b_obj_arg ssl) {
|
||||
(void)ssl;
|
||||
return io_result_mk_error("lean_uv_ssl_pending_encrypted is not supported");
|
||||
}
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_pending_plaintext(b_obj_arg _role, b_obj_arg ssl) {
|
||||
(void)ssl;
|
||||
return io_result_mk_error("lean_uv_ssl_pending_plaintext is not supported");
|
||||
}
|
||||
|
||||
#endif
|
||||
|
||||
}
|
||||
@@ -1,49 +0,0 @@
|
||||
/*
|
||||
Copyright (c) 2026 Lean FRO, LLC. All rights reserved.
|
||||
Released under Apache 2.0 license as described in the file LICENSE.
|
||||
Author: Sofia Rodrigues
|
||||
*/
|
||||
#pragma once
|
||||
|
||||
#include <lean/lean.h>
|
||||
#include "runtime/io.h"
|
||||
#include "runtime/object.h"
|
||||
#include "runtime/openssl/context.h"
|
||||
|
||||
#ifndef LEAN_EMSCRIPTEN
|
||||
#include <openssl/ssl.h>
|
||||
#include <openssl/bio.h>
|
||||
#endif
|
||||
|
||||
#include <vector>
|
||||
|
||||
namespace lean {
|
||||
|
||||
static lean_external_class * g_ssl_session_external_class = nullptr;
|
||||
void initialize_openssl_session();
|
||||
|
||||
#ifndef LEAN_EMSCRIPTEN
|
||||
struct lean_ssl_session_object {
|
||||
SSL * ssl;
|
||||
BIO * read_bio;
|
||||
BIO * write_bio;
|
||||
std::vector<std::vector<char>> pending_writes;
|
||||
};
|
||||
|
||||
static inline lean_object * lean_ssl_session_object_new(lean_ssl_session_object * s) { return lean_alloc_external(g_ssl_session_external_class, s); }
|
||||
static inline lean_ssl_session_object * lean_to_ssl_session_object(lean_object * o) { return (lean_ssl_session_object*)(lean_get_external_data(o)); }
|
||||
#endif
|
||||
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_mk_server(b_obj_arg ctx);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_mk_client(b_obj_arg ctx);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_set_server_name(b_obj_arg ssl, b_obj_arg host);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_verify_result(b_obj_arg _role, b_obj_arg ssl);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_handshake(b_obj_arg _role, b_obj_arg ssl);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_write(b_obj_arg _role, b_obj_arg ssl, b_obj_arg data);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_read(b_obj_arg _role, b_obj_arg ssl, uint64_t max_bytes);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_feed_encrypted(b_obj_arg _role, b_obj_arg ssl, b_obj_arg data);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_drain_encrypted(b_obj_arg _role, b_obj_arg ssl);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_pending_encrypted(b_obj_arg _role, b_obj_arg ssl);
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_ssl_pending_plaintext(b_obj_arg _role, b_obj_arg ssl);
|
||||
|
||||
}
|
||||
@@ -31,7 +31,7 @@ extern "C" LEAN_EXPORT lean_obj_res lean_uv_get_process_title() {
|
||||
return lean_io_result_mk_ok(lean_title);
|
||||
}
|
||||
|
||||
// Std.Internal.UV.System.setProcessTitle : String → IO Unit
|
||||
// Std.Internal.UV.System.setProcessTitle : @& String → IO Unit
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_set_process_title(b_obj_arg title) {
|
||||
const char* title_str = lean_string_cstr(title);
|
||||
if (strlen(title_str) != lean_string_size(title) - 1) {
|
||||
@@ -124,7 +124,7 @@ extern "C" LEAN_EXPORT lean_obj_res lean_uv_cwd() {
|
||||
return lean_io_result_mk_ok(lean_cwd);
|
||||
}
|
||||
|
||||
// Std.Internal.UV.System.chdir : String → IO Unit
|
||||
// Std.Internal.UV.System.chdir : @& String → IO Unit
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_chdir(b_obj_arg path) {
|
||||
const char* path_str = lean_string_cstr(path);
|
||||
if (strlen(path_str) != lean_string_size(path) - 1) {
|
||||
@@ -271,7 +271,7 @@ extern "C" LEAN_EXPORT lean_obj_res lean_uv_os_environ() {
|
||||
return lean_io_result_mk_ok(env_array);
|
||||
}
|
||||
|
||||
// Std.Internal.UV.System.osGetenv : String → IO (Option String)
|
||||
// Std.Internal.UV.System.osGetenv : @& String → IO (Option String)
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_os_getenv(b_obj_arg name) {
|
||||
const char* name_str = lean_string_cstr(name);
|
||||
if (strlen(name_str) != lean_string_size(name) - 1) {
|
||||
@@ -313,7 +313,7 @@ extern "C" LEAN_EXPORT lean_obj_res lean_uv_os_getenv(b_obj_arg name) {
|
||||
}
|
||||
|
||||
|
||||
// Std.Internal.UV.System.osSetenv : String → String → IO Unit
|
||||
// Std.Internal.UV.System.osSetenv : @& String → @& String → IO Unit
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_os_setenv(b_obj_arg name, b_obj_arg value) {
|
||||
const char* name_str = lean_string_cstr(name);
|
||||
const char* value_str = lean_string_cstr(value);
|
||||
@@ -333,7 +333,7 @@ extern "C" LEAN_EXPORT lean_obj_res lean_uv_os_setenv(b_obj_arg name, b_obj_arg
|
||||
return lean_io_result_mk_ok(lean_box(0));
|
||||
}
|
||||
|
||||
// Std.Internal.UV.System.osUnsetenv : String → IO Unit
|
||||
// Std.Internal.UV.System.osUnsetenv : @& String → IO Unit
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_os_unsetenv(b_obj_arg name) {
|
||||
const char* name_str = lean_string_cstr(name);
|
||||
if (strlen(name_str) != lean_string_size(name) - 1) {
|
||||
@@ -641,21 +641,21 @@ extern "C" LEAN_EXPORT lean_obj_res lean_uv_os_environ() {
|
||||
);
|
||||
}
|
||||
|
||||
// Std.Internal.UV.System.osGetenv : String → IO (Option String)
|
||||
// Std.Internal.UV.System.osGetenv : @& String → IO (Option String)
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_os_getenv(b_obj_arg name) {
|
||||
lean_always_assert(
|
||||
false && ("Please build a version of Lean4 with libuv to invoke this.")
|
||||
);
|
||||
}
|
||||
|
||||
// Std.Internal.UV.System.osSetenv : String → String → IO Unit
|
||||
// Std.Internal.UV.System.osSetenv : @& String → @& String → IO Unit
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_os_setenv(b_obj_arg name, b_obj_arg value) {
|
||||
lean_always_assert(
|
||||
false && ("Please build a version of Lean4 with libuv to invoke this.")
|
||||
);
|
||||
}
|
||||
|
||||
// Std.Internal.UV.System.osUnsetenv : String → IO Unit
|
||||
// Std.Internal.UV.System.osUnsetenv : @& String → IO Unit
|
||||
extern "C" LEAN_EXPORT lean_obj_res lean_uv_os_unsetenv(b_obj_arg name) {
|
||||
lean_always_assert(
|
||||
false && ("Please build a version of Lean4 with libuv to invoke this.")
|
||||
|
||||
@@ -162,7 +162,7 @@ else
|
||||
-Wl,--whole-archive ${LIB}/temp/Lean.*o.export ${LIB}/temp/libleanshell.a -Wl,--no-whole-archive -Wl,--start-group -lInit -lStd -lLean -lleancpp -Wl,--end-group ${CMAKE_BINARY_DIR}/runtime/libleanrt_initial-exec.a ${LEANSHARED_LINKER_FLAGS} ${TOOLCHAIN_SHARED_LINKER_FLAGS} ${LEANC_OPTS}
|
||||
endif
|
||||
endif
|
||||
ifeq "${CMAKE_BUILD_TYPE}" "Release"
|
||||
ifeq "${STRIP_BINARIES}" "ON"
|
||||
ifeq "${CMAKE_SYSTEM_NAME}" "Linux"
|
||||
# We only strip like this on Linux for now as our other platforms already seem to exclude the
|
||||
# unexported symbols by default
|
||||
|
||||
BIN
stage0/src/CMakeLists.txt
generated
BIN
stage0/src/CMakeLists.txt
generated
Binary file not shown.
BIN
stage0/stdlib/Lake/Config/Cache.c
generated
BIN
stage0/stdlib/Lake/Config/Cache.c
generated
Binary file not shown.
BIN
stage0/stdlib/Lake/Reservoir.c
generated
BIN
stage0/stdlib/Lake/Reservoir.c
generated
Binary file not shown.
BIN
stage0/stdlib/Lake/Util/Reservoir.c
generated
BIN
stage0/stdlib/Lake/Util/Reservoir.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Any.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Any.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Basic.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Basic.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Empty.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Empty.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Full.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Full.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Length.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Length.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Stream.c
generated
Normal file
BIN
stage0/stdlib/Std/Internal/Http/Data/Body/Stream.c
generated
Normal file
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Request.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Request.c
generated
Binary file not shown.
BIN
stage0/stdlib/Std/Internal/Http/Data/Response.c
generated
BIN
stage0/stdlib/Std/Internal/Http/Data/Response.c
generated
Binary file not shown.
@@ -3,6 +3,7 @@ import Cases.AddSubCancelDeep
|
||||
import Cases.AddSubCancelSimp
|
||||
import Cases.DiteSplit
|
||||
import Cases.GetThrowSet
|
||||
import Cases.LetBinding
|
||||
import Cases.MatchIota
|
||||
import Cases.MatchSplit
|
||||
import Cases.PurePrecond
|
||||
|
||||
@@ -6,6 +6,7 @@ open Lean Meta Elab Tactic Sym Std Do SpecAttr
|
||||
namespace GetThrowSet
|
||||
|
||||
set_option mvcgen.warning false
|
||||
set_option backward.do.legacy false -- exercises asymmetric bind depth from new do elaborator
|
||||
|
||||
abbrev M := ExceptT String <| StateM Nat
|
||||
|
||||
|
||||
Some files were not shown because too many files have changed in this diff Show More
Reference in New Issue
Block a user