From 4852506b506bde9c32b1030bcf9a3e36b8253262 Mon Sep 17 00:00:00 2001 From: Smaug123 Date: Wed, 29 Nov 2023 23:49:35 +0000 Subject: [PATCH] Ta-da --- .config/dotnet-tools.json | 12 ++++ .editorconfig | 41 +++++++++++++ .gitignore | 3 +- Http/Errno.fs | 55 +++++++++++++++++ Http/Http.fsproj | 11 +++- Http/HttpRequest.fs | 70 +++++++++++++++++++++ Http/Printf.fs | 11 ++++ Http/Program.fs | 126 ++++++++++---------------------------- Http/Socket.fs | 98 +++++++++++++++++++++++++++++ Http/Syscall.fs | 65 ++++++++++++++++++++ flake.lock | 60 ++++++++++++++++++ flake.nix | 98 +++++++++++++++++++++++++++++ 12 files changed, 553 insertions(+), 97 deletions(-) create mode 100644 .config/dotnet-tools.json create mode 100644 .editorconfig create mode 100644 Http/Errno.fs create mode 100644 Http/HttpRequest.fs create mode 100644 Http/Printf.fs create mode 100644 Http/Socket.fs create mode 100644 Http/Syscall.fs create mode 100644 flake.lock create mode 100644 flake.nix diff --git a/.config/dotnet-tools.json b/.config/dotnet-tools.json new file mode 100644 index 0000000..be6f524 --- /dev/null +++ b/.config/dotnet-tools.json @@ -0,0 +1,12 @@ +{ + "version": 1, + "isRoot": true, + "tools": { + "fantomas": { + "version": "6.0.3", + "commands": [ + "fantomas" + ] + } + } +} diff --git a/.editorconfig b/.editorconfig new file mode 100644 index 0000000..9ef5fed --- /dev/null +++ b/.editorconfig @@ -0,0 +1,41 @@ +root=true + +[*] +charset=utf-8 +end_of_line=crlf +trim_trailing_whitespace=true +insert_final_newline=true +indent_style=space +indent_size=4 + +# ReSharper properties +resharper_xml_indent_size=2 +resharper_xml_max_line_length=100 +resharper_xml_tab_width=2 + +[*.{csproj,fsproj,sqlproj,targets,props,ts,tsx,css,json}] +indent_style=space +indent_size=2 + +[*.{fs,fsi}] +fsharp_bar_before_discriminated_union_declaration=true +fsharp_space_before_uppercase_invocation=true +fsharp_space_before_class_constructor=true +fsharp_space_before_member=true +fsharp_space_before_colon=true +fsharp_space_before_semicolon=true +fsharp_multiline_bracket_style=aligned +fsharp_newline_between_type_definition_and_members=true +fsharp_align_function_signature_to_indentation=true +fsharp_alternative_long_member_definitions=true +fsharp_multi_line_lambda_closing_newline=true +fsharp_experimental_keep_indent_in_branch=true +fsharp_max_value_binding_width=80 +fsharp_max_record_width=0 +max_line_length=120 +end_of_line=lf + +[*.{appxmanifest,build,dtd,nuspec,xaml,xamlx,xoml,xsd}] +indent_style=space +indent_size=2 +tab_width=2 diff --git a/.gitignore b/.gitignore index add57be..39c9242 100644 --- a/.gitignore +++ b/.gitignore @@ -2,4 +2,5 @@ bin/ obj/ /packages/ riderModule.iml -/_ReSharper.Caches/ \ No newline at end of file +/_ReSharper.Caches/ +.idea/ diff --git a/Http/Errno.fs b/Http/Errno.fs new file mode 100644 index 0000000..6fca91b --- /dev/null +++ b/Http/Errno.fs @@ -0,0 +1,55 @@ +namespace Http + +/// From errno.h on macOS, https://opensource.apple.com/source/xnu/xnu-201/bsd/sys/errno.h +type Errno = + | EPERM = 1 + | ENOENT = 2 + | ESRCH = 3 + | EINTR = 4 + | EIO = 5 + | ENXIO = 6 + | E2BIG = 7 + | ENOEXEC = 8 + | EBADF = 9 + | ECHILD = 10 + | EDEADLK = 11 + | EINVAL = 22 + | EFBIG = 27 + | ENOSPC = 28 + | ESPIPE = 29 + | EROFS = 30 + | EMLINK = 31 + | EPIPE = 32 + | EDOM = 33 + | ERANGE = 34 + | EAGAIN = 35 + | EINPROGRESS = 36 + | EALREADY = 37 + | ENOTSOCK = 38 + | EDESTADDRREQ = 39 + | EMSGSIZE = 40 + | EPROTOTYPE = 41 + | ENOPROTOOPT = 42 + | EPROTONOSUPPORT = 43 + | ESOCKTNOSUPPORT = 44 + | ENOTSUP = 45 + | EPFNOSUPPORT = 46 + | EAFNOSUPPORT = 47 + | EADDRINUSE = 48 + | EADDRNOTAVAIL = 49 + | ENETDOWN = 50 + | ENETUNREACH = 51 + | ENETRESET = 52 + | ECONNABORTED = 53 + | ECONNRESET = 54 + | ENOBUFS = 55 + | EISCONN = 56 + | ENOTCONN = 57 + | ESHUTDOWN = 58 + | ETOOMANYREFS = 59 + | ETIMEDOUT = 60 + | ECONNREFUSED = 61 + | ELOOP = 62 + | ENAMETOOLONG = 63 + | EHOSTDOWN = 64 + | EHOSTUNREACH = 65 diff --git a/Http/Http.fsproj b/Http/Http.fsproj index fed421b..21ea2a2 100644 --- a/Http/Http.fsproj +++ b/Http/Http.fsproj @@ -2,10 +2,19 @@ Exe - net7.0 + net8.0 + true + $(OtherFlags) --reflectionfree --strict-indentation + true + 3559 + + + + + diff --git a/Http/HttpRequest.fs b/Http/HttpRequest.fs new file mode 100644 index 0000000..573ff2e --- /dev/null +++ b/Http/HttpRequest.fs @@ -0,0 +1,70 @@ +namespace Http + +open System.Text + +// HTTP/1.1 is defined in https://www.rfc-editor.org/rfc/rfc9112.html + +type RequestLine = + | OriginForm of method : string * host : string * target : string + | AbsoluteForm of method : string * uri : string + | AuthorityForm of host : string * port : int + | AsteriskForm + + override this.ToString () = + match this with + | OriginForm (method, _host, target) -> sprintf "%s %s HTTP/1.1" method target + | AbsoluteForm (method, uri) -> sprintf "%s %s HTTP/1.1" method uri + | AuthorityForm (host, port) -> sprintf "CONNECT %s:%d HTTP/1.1" host port + | AsteriskForm -> "OPTIONS * HTTP/1.1" + + member this.AddToRequest (request : ResizeArray) : unit = + // obvious candidate to improve speed by allocating less + this.ToString () |> Encoding.ASCII.GetBytes |> request.AddRange + +type FieldLine = + { + Name : string + Value : string + } + + override this.ToString () = sprintf "%s: %s" this.Name this.Value + + member this.AddToRequest (request : ResizeArray) : unit = + // obvious candidate to improve speed by allocating less + this.ToString () |> Encoding.ASCII.GetBytes |> request.AddRange + +type HttpRequest = + { + Request : RequestLine + Headers : FieldLine list + Body : byte[] + } + + member this.ToBytes () : byte[] = + let builder = ResizeArray () + this.Request.AddToRequest builder + builder.Add (byte '\r') + builder.Add (byte '\n') + + let host = + match this.Request with + | OriginForm (_, host, _) -> host + | AbsoluteForm (method, uri) -> + failwith "I can't be bothered but here we would parse the host out of the URI" + | AuthorityForm (host, _) -> host + | AsteriskForm -> "" + + builder.AddRange (Encoding.ASCII.GetBytes "Host: ") + builder.AddRange (Encoding.ASCII.GetBytes host) + builder.Add (byte '\r') + builder.Add (byte '\n') + + for h in this.Headers do + h.AddToRequest builder + builder.Add (byte '\r') + builder.Add (byte '\n') + + builder.Add (byte '\r') + builder.Add (byte '\n') + + builder.ToArray () diff --git a/Http/Printf.fs b/Http/Printf.fs new file mode 100644 index 0000000..ac7561f --- /dev/null +++ b/Http/Printf.fs @@ -0,0 +1,11 @@ +namespace Http + +/// Random helpers for AOT-friendly printf +[] +module Printfn = + + let int (format : string) (value : int) = + System.Console.WriteLine (format + " " + value.ToString ()) + + let inline time (format : string) (ms : int64) = + System.Console.WriteLine (format + " " + ms.ToString () + "ms") diff --git a/Http/Program.fs b/Http/Program.fs index b342f6a..d6d23f1 100644 --- a/Http/Program.fs +++ b/Http/Program.fs @@ -1,123 +1,56 @@ -#nowarn "9" - -namespace Http +namespace Http open System -open System.Runtime.InteropServices open System.Diagnostics open System.Net -open System.Net.Sockets -open Microsoft.FSharp.NativeInterop - -type AddressFamily = - | INET = 2 - -type SocketType = - | STREAM = 1 - -module Syscall = - type byteptr = nativeptr - [] - extern int socket (int domain, int typ, int protocol) - - [] - extern int connect (int socket, byteptr addr, uint addrLen) - - [] - extern int close (int fd) - - [] - extern int read (int fd, byteptr buf, uint count) - - [] - extern int write (int fd, byteptr buf, uint count) - -type Sock = - private - { - FileDescriptor : int - } - - member this.Close () = - let result = Syscall.close this.FileDescriptor - if result < 0 then - failwith "failed to close" - -module Sock = - let create (af : AddressFamily) (sock : SocketType) = - let fd = Syscall.socket (int af, int sock, 0) - if fd < 0 then - failwith "failed to create" - { - FileDescriptor = fd - } - - let write (sock : Sock) (buffer : byte []) (offset : int) (count : uint) = - use buffer = fixed buffer - let result = Syscall.write (sock.FileDescriptor, buffer, count) - if result < 0 then - failwith "failed to write" - result - - let read (sock : Sock) (buffer : byte []) (offset : int) (count : uint) = - use buffer = fixed buffer - let result = Syscall.read (sock.FileDescriptor, buffer, count) - if result < 0 then - failwith "failed to read" - result - - let close (sock : Sock) = - sock.Close () - -type ConnectedSocket (sock : Socket, ep : IPEndPoint) = - do - sock.Connect ep - () - interface IDisposable with - member _.Dispose () = - sock.Shutdown SocketShutdown.Both - sock.Close () +open System.Text module Program = [] let main argv = let sw = Stopwatch.StartNew () + let ip = sw.Restart () let dns = Dns.GetHostEntry "example.com" sw.Stop () - printfn "DNS lookup: %ims" sw.ElapsedMilliseconds + Printfn.time "DNS lookup:" sw.ElapsedMilliseconds dns.AddressList.[0] - let ep = IPEndPoint (ip, 80) sw.Restart () - use client = new Socket (AddressFamily.InterNetwork, SocketType.Stream, ProtocolType.Tcp) + use sock = Sock.create AddressFamily.INET SocketType.STREAM sw.Stop () - printfn "Socket open: %ims" sw.ElapsedMilliseconds + Printfn.time "Socket create:" sw.ElapsedMilliseconds + let addr = SockAddrIPv4.Create ip 80s sw.Restart () - use _ = new ConnectedSocket (client, ep) + Sock.connect sock addr sw.Stop () - printfn "Socket connect: %ims" sw.ElapsedMilliseconds + Printfn.time "Socket connect:" sw.ElapsedMilliseconds let message = - [ - "GET / HTTP/1.1" - "Host: example.com" - "Connection: close" - "" - "" - ] - |> String.concat "\r\n" - |> System.Text.Encoding.ASCII.GetBytes + { + HttpRequest.Request = RequestLine.OriginForm ("GET", "example.com", "/") + Headers = + [ + { + Name = "Connection" + Value = "close" + } + ] + Body = Array.Empty<_> () + } + |> fun r -> r.ToBytes () do let mutable written = 0 + while written < message.Length do sw.Restart () - let write = client.Send (message, written, message.Length - written, SocketFlags.None) + let write = Sock.write sock message written (message.Length - written |> uint) sw.Stop () - printfn "Took %ims to write %i bytes (of %i total)" sw.ElapsedMilliseconds write message.Length + Printfn.time "Write:" sw.ElapsedMilliseconds + Printfn.int "Bytes written:" write written <- written + write let response = @@ -125,13 +58,16 @@ module Program = let mutable total = 0 let mutable isDone = false let result = ResizeArray () + while not isDone do sw.Restart () - let read = client.Receive buffer + let read = Sock.read sock buffer 0u (uint buffer.Length) sw.Stop () - printfn "Took %ims to read %i bytes" sw.ElapsedMilliseconds read + Printfn.time "Read:" sw.ElapsedMilliseconds + Printfn.int "Bytes read:" read total <- total + read - result.AddRange buffer.[0..read-1] + result.AddRange buffer.[0 .. read - 1] + if read = 0 then isDone <- true diff --git a/Http/Socket.fs b/Http/Socket.fs new file mode 100644 index 0000000..f65053f --- /dev/null +++ b/Http/Socket.fs @@ -0,0 +1,98 @@ +#nowarn "9" + +namespace Http + +open System +open System.Runtime.InteropServices +open Microsoft.FSharp.NativeInterop + +type Sock = + private + { + FileDescriptor : int + } + + member this.Close () = + let result = Syscall.close this.FileDescriptor + + if result < 0 then + let err = Marshal.GetLastWin32Error () + failwithf "failed to close: %i" err + + interface IDisposable with + member this.Dispose () = this.Close () + +[] +module Sock = + let create (af : AddressFamily) (sock : SocketType) : Sock = + let fd = Syscall.socket (AddressFamily.toInt af, SocketType.toInt sock, 0) + + if fd < 0 then + let err = Marshal.GetLastWin32Error () + failwithf "failed to create: %i" err + + { + FileDescriptor = fd + } + + let write (sock : Sock) (buffer : byte[]) (offset : int) (count : uint) = + use buffer = fixed buffer + let result = Syscall.write (sock.FileDescriptor, NativePtr.add buffer offset, count) + + if result < 0 then + let err = Marshal.GetLastWin32Error () |> enum + failwithf "failed to write: %O" err + + result + + let read (sock : Sock) (buffer : byte[]) (offset : uint) (count : uint) = + use buffer = fixed buffer + + let result = + Syscall.read (sock.FileDescriptor, NativePtr.add buffer (int offset), count) + + if result < 0 then + let err = Marshal.GetLastWin32Error () |> enum + failwithf "failed to read: %O" err + + result + + type private ConnectionState = + | NotStarted + | Done + | Interrupted + + let connect (sock : Sock) (addr : SockAddrIPv4) = + use addr = fixed &addr + let mutable isDone = ConnectionState.NotStarted + + while isDone <> ConnectionState.Done do + let result = + Syscall.connect (sock.FileDescriptor, addr, Marshal.SizeOf () |> uint32) + + if result = 0 then + isDone <- ConnectionState.Done + elif result > 0 then + failwithf "bad result from connect: %i" result + else + // Error case begins! + + let err = Marshal.GetLastWin32Error () |> enum + + match isDone with + | ConnectionState.Interrupted -> + // It's OK to get "already connected", we were previously interrupted and we can't tell + // how far the connection had got before we retried + if err = Errno.EISCONN then + isDone <- ConnectionState.Done + else + failwithf "failed to connect: %O" err + | _ -> + + if err = Errno.EINTR then + printfn "Retrying due to EINTR" + isDone <- ConnectionState.Interrupted + else + failwithf "failed to connect: %O" err + + let close (sock : Sock) = sock.Close () diff --git a/Http/Syscall.fs b/Http/Syscall.fs new file mode 100644 index 0000000..589720d --- /dev/null +++ b/Http/Syscall.fs @@ -0,0 +1,65 @@ +namespace Http + +open System +open System.Buffers.Binary +open System.Net +open System.Runtime.InteropServices + +type AddressFamily = + /// aka IPv4 + | INET = 2s + +[] +module AddressFamily = + let toInt (af : AddressFamily) = int af + +type SocketType = + | STREAM = 1 + +[] +module SocketType = + let toInt (s : SocketType) = int s + +[] +type SockAddrIPv4 = + private + { + SaFamily : AddressFamily + InPort : int16 + InAddr : uint32 + Padding : int64 + } + + static member Create (address : IPAddress) (port : int16) = + { + SaFamily = AddressFamily.INET + InPort = + if BitConverter.IsLittleEndian then + BinaryPrimitives.ReverseEndianness port + else + port + InAddr = + // TODO: my computer is little-endian; does this need to be endian-aware? + BitConverter.ToUInt32 (address.GetAddressBytes (), 0) + Padding = 0 + } + +[] +module Syscall = + type byteptr = nativeptr + type sockptr = nativeptr + + [] + extern int socket(int domain, int typ, int protocol) + + [] + extern int connect(int socket, sockptr addr, uint addrLen) + + [] + extern int close(int fd) + + [] + extern int read(int fd, byteptr buf, uint count) + + [] + extern int write(int fd, byteptr buf, uint count) diff --git a/flake.lock b/flake.lock new file mode 100644 index 0000000..de4ac66 --- /dev/null +++ b/flake.lock @@ -0,0 +1,60 @@ +{ + "nodes": { + "flake-utils": { + "inputs": { + "systems": "systems" + }, + "locked": { + "lastModified": 1694529238, + "narHash": "sha256-zsNZZGTGnMOf9YpHKJqMSsa0dXbfmxeoJ7xHlrt+xmY=", + "owner": "numtide", + "repo": "flake-utils", + "rev": "ff7b65b44d01cf9ba6a71320833626af21126384", + "type": "github" + }, + "original": { + "owner": "numtide", + "repo": "flake-utils", + "type": "github" + } + }, + "nixpkgs": { + "locked": { + "lastModified": 1701174899, + "narHash": "sha256-1W+FMe8mWsJKXoBc+QgKmEeRj33kTFnPq7XCjU+bfnA=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "010c7296f3b19a58b206fdf7d68d75a5b0a09e9e", + "type": "github" + }, + "original": { + "id": "nixpkgs", + "ref": "nixpkgs-unstable", + "type": "indirect" + } + }, + "root": { + "inputs": { + "flake-utils": "flake-utils", + "nixpkgs": "nixpkgs" + } + }, + "systems": { + "locked": { + "lastModified": 1681028828, + "narHash": "sha256-Vy1rq5AaRuLzOxct8nz4T6wlgyUR7zLU309k9mBC768=", + "owner": "nix-systems", + "repo": "default", + "rev": "da67096a3b9bf56a91d16901293e51ba5b49a27e", + "type": "github" + }, + "original": { + "owner": "nix-systems", + "repo": "default", + "type": "github" + } + } + }, + "root": "root", + "version": 7 +} diff --git a/flake.nix b/flake.nix new file mode 100644 index 0000000..e594c5b --- /dev/null +++ b/flake.nix @@ -0,0 +1,98 @@ +{ + description = "Declarative .NET Gitea configuration"; + + inputs = { + flake-utils.url = "github:numtide/flake-utils"; + nixpkgs.url = "nixpkgs/nixpkgs-unstable"; + }; + + outputs = { + self, + nixpkgs, + flake-utils, + ... + }: + flake-utils.lib.eachDefaultSystem (system: let + pkgs = nixpkgs.legacyPackages.${system}; + projectFile = "./Gitea.Declarative/Gitea.Declarative.fsproj"; + testProjectFile = "./Gitea.Declarative.Test/Gitea.Declarative.Test.fsproj"; + pname = "gitea-repo-config"; + dotnet-sdk = pkgs.dotnet-sdk_8; + dotnet-runtime = pkgs.dotnetCorePackages.runtime_8_0; + version = "0.1"; + dotnetTool = toolName: toolVersion: sha256: + pkgs.stdenvNoCC.mkDerivation rec { + name = toolName; + version = toolVersion; + nativeBuildInputs = [pkgs.makeWrapper]; + src = pkgs.fetchNuGet { + pname = name; + version = version; + sha256 = sha256; + installPhase = ''mkdir -p $out/bin && cp -r tools/net6.0/any/* $out/bin''; + }; + installPhase = '' + runHook preInstall + mkdir -p "$out/lib" + cp -r ./bin/* "$out/lib" + makeWrapper "${dotnet-runtime}/bin/dotnet" "$out/bin/${name}" --add-flags "$out/lib/${name}.dll" + runHook postInstall + ''; + }; + in { + packages = { + fantomas = dotnetTool "fantomas" (builtins.fromJSON (builtins.readFile ./.config/dotnet-tools.json)).tools.fantomas.version "sha256-zYSF53RPbGEQt1ZBcHVYqEPHrFlmI1Ty3GQPW1uxPWw="; + fetchDeps = let + flags = []; + runtimeIds = ["win-x64"] ++ map (system: pkgs.dotnetCorePackages.systemToDotnetRid system) dotnet-sdk.meta.platforms; + in + pkgs.writeShellScriptBin "fetch-${pname}-deps" (builtins.readFile (pkgs.substituteAll { + src = ./nix/fetchDeps.sh; + pname = pname; + binPath = pkgs.lib.makeBinPath [pkgs.coreutils dotnet-sdk (pkgs.nuget-to-nix.override {inherit dotnet-sdk;})]; + projectFiles = toString (pkgs.lib.toList projectFile); + testProjectFiles = toString (pkgs.lib.toList testProjectFile); + rids = pkgs.lib.concatStringsSep "\" \"" runtimeIds; + packages = dotnet-sdk.packages; + storeSrc = pkgs.srcOnly { + src = ./.; + pname = pname; + version = version; + }; + })); + default = pkgs.buildDotnetModule { + pname = pname; + name = "gitea-repo-config"; + version = version; + src = ./.; + projectFile = projectFile; + nugetDeps = ./nix/deps.nix; + doCheck = true; + dotnet-sdk = dotnet-sdk; + dotnet-runtime = dotnet-runtime; + }; + }; + apps = { + default = { + type = "app"; + program = "${self.packages.${system}.default}/bin/Gitea.Declarative"; + }; + }; + devShells = { + default = pkgs.mkShell { + buildInputs = with pkgs; [ + (with dotnetCorePackages; + combinePackages [ + dotnet-sdk_8 + dotnetPackages.Nuget + ]) + ] ++ [pkgs.swift darwin.apple_sdk.frameworks.Foundation darwin.apple_sdk.frameworks.CryptoKit darwin.apple_sdk.frameworks.GSS pkgs.zlib pkgs.zlib.dev pkgs.openssl pkgs.icu]; + packages = [ + pkgs.alejandra + pkgs.nodePackages.markdown-link-check + pkgs.shellcheck + ]; + }; + }; + }); +}