#r "System.Formats.Tar"
#r "/opt/fsi/packages/ZstdSharp.dll"

open System
open System.Collections.Generic
open System.Diagnostics
open System.Formats.Tar
open System.IO
open System.IO.Compression
open System.Net.Security
open System.Runtime.InteropServices
open System.Security.Cryptography
open System.Security.Cryptography.X509Certificates
open System.Text.Json
open System.Text.Json.Serialization
open System.Threading
open System.Threading.Tasks
open ZstdSharp
open ZstdSharp.Unsafe

[<CLIMutable>]
type Target =
    { [<JsonPropertyName("kind")>]
      Kind: string
      [<JsonPropertyName("repository")>]
      Repository: string }

[<CLIMutable>]
type Published =
    { [<JsonPropertyName("kind")>]
      Kind: string
      [<JsonPropertyName("repository")>]
      Repository: string
      [<JsonPropertyName("reference")>]
      Reference: string }

[<CLIMutable>]
type Delivery =
    { [<JsonPropertyName("sourceRevision")>]
      SourceRevision: string
      [<JsonPropertyName("targets")>]
      Targets: Published array }

type ProcessResult =
    { Code: int
      Error: string
      Output: string }

let json =
    JsonSerializerOptions(
        PropertyNamingPolicy = null,
        WriteIndented = false,
        DefaultIgnoreCondition = JsonIgnoreCondition.WhenWritingNull
    )

let private stopping = new CancellationTokenSource()
let mutable private signalExitCode = 143

let private registerSignal signal exitCode =
    PosixSignalRegistration.Create(
        signal,
        fun context ->
            context.Cancel <- true
            signalExitCode <- exitCode
            stopping.Cancel()
    )

let private interrupt = registerSignal PosixSignal.SIGINT 130
let private terminate = registerSignal PosixSignal.SIGTERM 143
let cancellationToken = stopping.Token

let private exitForSignal<'T> () =
    Environment.Exit signalExitCode
    Unchecked.defaultof<'T>

let fail message = invalidOp message

let require valid message =
    if not valid then
        fail message

let directory (path: string) =
    Directory.CreateDirectory path |> ignore
    path

let sha256 (path: string) =
    use input = File.OpenRead path
    Convert.ToHexString(SHA256.HashData input).ToLowerInvariant()

let hashText (value: string) =
    value
    |> Text.Encoding.UTF8.GetBytes
    |> SHA256.HashData
    |> Convert.ToHexString
    |> _.ToLowerInvariant()

let validRevision (value: string) =
    not <| isNull value
    && (value.Length = 40 || value.Length = 64)
    && value
       |> Seq.forall (fun character -> Char.IsAsciiHexDigit character && not <| Char.IsUpper character)

let validSha256 (value: string) =
    not <| isNull value
    && value.Length = 64
    && value
       |> Seq.forall (fun character -> Char.IsAsciiHexDigit character && not <| Char.IsUpper character)

let validDigest (value: string) =
    not <| isNull value
    && value.StartsWith("sha256:", StringComparison.Ordinal)
    && validSha256 value[7..]

let decode<'T> (value: string) =
    let result = JsonSerializer.Deserialize<'T>(value, json)
    require (not <| isNull (box result)) "JSON document is missing"
    result

let sleep (milliseconds: int) =
    try
        Task.Delay(milliseconds, cancellationToken).GetAwaiter().GetResult()
    with :? OperationCanceledException when cancellationToken.IsCancellationRequested ->
        exitForSignal ()

let run
    (executable: string)
    (arguments: string seq)
    (workingDirectory: string option)
    (environment: (string * string) seq)
    =
    let start = ProcessStartInfo executable
    start.UseShellExecute <- false
    start.RedirectStandardOutput <- true
    start.RedirectStandardError <- true

    workingDirectory |> Option.iter (fun path -> start.WorkingDirectory <- path)
    arguments |> Seq.iter start.ArgumentList.Add
    environment |> Seq.iter (fun (name, value) -> start.Environment[name] <- value)

    use child = Process.Start start
    let output = child.StandardOutput.ReadToEndAsync()
    let error = child.StandardError.ReadToEndAsync()

    try
        child.WaitForExitAsync(cancellationToken).GetAwaiter().GetResult()
    with :? OperationCanceledException when cancellationToken.IsCancellationRequested ->
        if not child.HasExited then
            child.Kill true
            child.WaitForExit()

        exitForSignal ()

    { Code = child.ExitCode
      Error = error.GetAwaiter().GetResult()
      Output = output.GetAwaiter().GetResult() }

let requireSuccess executable arguments workingDirectory environment =
    let result = run executable arguments workingDirectory environment
    require (result.Code = 0) $"{Path.GetFileName executable} failed: {result.Error.Trim()}"
    result.Output

let private descendants (root: string) =
    seq {
        let pending = Stack<string>(Directory.EnumerateFileSystemEntries root)

        while pending.Count > 0 do
            let path = pending.Pop()
            yield path

            let attributes = File.GetAttributes path

            if
                attributes.HasFlag FileAttributes.Directory
                && not (attributes.HasFlag FileAttributes.ReparsePoint)
            then
                Directory.EnumerateFileSystemEntries path |> Seq.iter pending.Push
    }

let private tree (root: string) =
    seq {
        yield root

        if Directory.Exists root then
            yield! descendants root
    }

let private safePath (root: string) (name: string) =
    require (not <| Path.IsPathFullyQualified name) "archive path is absolute"
    let path = Path.GetFullPath(Path.Combine(root, name))
    let prefix = root + string Path.DirectorySeparatorChar
    require (path = root || path.StartsWith(prefix, StringComparison.Ordinal)) "archive path escapes destination"
    path

let private extract (input: Stream) (destination: string) =
    let root = Path.GetFullPath destination
    directory root |> ignore
    let directoryModes = ResizeArray<string * UnixFileMode>()
    use reader = new TarReader(input, leaveOpen = false)

    for entry in
        Seq.initInfinite (fun _ -> reader.GetNextEntry())
        |> Seq.takeWhile (isNull >> not) do
        let path = safePath root entry.Name

        match entry.EntryType with
        | TarEntryType.Directory ->
            directory path |> ignore
            directoryModes.Add(path, entry.Mode)
        | TarEntryType.RegularFile
        | TarEntryType.V7RegularFile
        | TarEntryType.ContiguousFile ->
            directory (Path.GetDirectoryName path) |> ignore
            use output = File.Create path

            if not <| isNull entry.DataStream then
                entry.DataStream.CopyTo output

            output.Dispose()
            File.SetUnixFileMode(path, entry.Mode)
        | TarEntryType.SymbolicLink ->
            require (not <| Path.IsPathFullyQualified entry.LinkName) "archive link is absolute"

            let target =
                Path.GetFullPath(Path.Combine(Path.GetDirectoryName path, entry.LinkName))

            let prefix = root + string Path.DirectorySeparatorChar

            require
                (target = root || target.StartsWith(prefix, StringComparison.Ordinal))
                "archive link escapes destination"

            directory (Path.GetDirectoryName path) |> ignore
            File.CreateSymbolicLink(path, entry.LinkName) |> ignore
        | TarEntryType.GlobalExtendedAttributes -> ()
        | _ -> fail $"unsupported archive entry: {entry.Name}"

    directoryModes
    |> Seq.sortByDescending (fun (path, _) -> path.Length)
    |> Seq.iter File.SetUnixFileMode

let extractGzip (source: string) (destination: string) =
    use input = File.OpenRead source
    use gzip = new GZipStream(input, CompressionMode.Decompress)
    extract gzip destination

let extractZstd (source: string) (destination: string) =
    use input = File.OpenRead source
    use zstd = new DecompressionStream(input, 131072, false, false)
    extract zstd destination

let private relativeName (root: string) (path: string) =
    Path.GetRelativePath(root, path).Replace(Path.DirectorySeparatorChar, '/')

let private writeEntry (writer: TarWriter) (root: string) (path: string) =
    let name = relativeName root path
    let attributes = File.GetAttributes path

    if attributes.HasFlag FileAttributes.ReparsePoint then
        let item: FileSystemInfo =
            if attributes.HasFlag FileAttributes.Directory then
                DirectoryInfo path
            else
                FileInfo path

        require (not <| isNull item.LinkTarget) "invalid symbolic link"
        require (not <| Path.IsPathFullyQualified item.LinkTarget) "archive link is absolute"
        let entry = PaxTarEntry(TarEntryType.SymbolicLink, name)
        entry.LinkName <- item.LinkTarget
        entry.Mode <- File.GetUnixFileMode path
        entry.ModificationTime <- DateTimeOffset.UnixEpoch
        writer.WriteEntry entry
    elif attributes.HasFlag FileAttributes.Directory then
        let entry = PaxTarEntry(TarEntryType.Directory, name)
        entry.Mode <- File.GetUnixFileMode path
        entry.ModificationTime <- DateTimeOffset.UnixEpoch
        writer.WriteEntry entry
    else
        let entry = PaxTarEntry(TarEntryType.RegularFile, name)
        entry.Mode <- File.GetUnixFileMode path
        entry.ModificationTime <- DateTimeOffset.UnixEpoch
        entry.DataStream <- File.OpenRead path
        writer.WriteEntry entry
        entry.DataStream.Dispose()

let createZstd (root: string) (paths: string seq) (destination: string) =
    use algorithm = SHA256.Create()
    use output = File.Create destination
    use hashing = new CryptoStream(output, algorithm, CryptoStreamMode.Write, true)
    use zstd = new CompressionStream(hashing, 1, 131072, true)
    zstd.SetParameter(ZSTD_cParameter.ZSTD_c_nbWorkers, 2)
    use writer = new TarWriter(zstd, TarEntryFormat.Pax, leaveOpen = false)

    paths
    |> Seq.collect (fun path -> tree (Path.Combine(root, path)))
    |> Seq.distinct
    |> Seq.sortBy (relativeName root)
    |> Seq.iter (writeEntry writer root)

    writer.Dispose()
    zstd.Dispose()
    hashing.FlushFinalBlock()
    Convert.ToHexString(algorithm.Hash).ToLowerInvariant()

let validateCertificate
    (root: X509Certificate2)
    (certificate: X509Certificate)
    (providedChain: X509Chain)
    (errors: SslPolicyErrors)
    =
    not (isNull certificate)
    && not (isNull providedChain)
    && not (errors.HasFlag SslPolicyErrors.RemoteCertificateNameMismatch)
    && (use chain = new X509Chain()
        chain.ChainPolicy.TrustMode <- X509ChainTrustMode.CustomRootTrust
        chain.ChainPolicy.CustomTrustStore.Add root |> ignore
        chain.ChainPolicy.RevocationMode <- X509RevocationMode.NoCheck

        providedChain.ChainElements
        |> Seq.iter (fun item -> chain.ChainPolicy.ExtraStore.Add item.Certificate |> ignore)

        chain.Build(new X509Certificate2(certificate)))