DiscreteLogAttack.fsx

// ==============================================================================
// Quantum Discrete Logarithm Attack on Diffie-Hellman Key Exchange
// ==============================================================================
// Compares quantum-assisted DLP attacks across multiple toy DH groups,
// demonstrating Shor's algorithm infrastructure via periodFinder QPE.
// For each group, performs a full Diffie-Hellman key exchange then mounts
// a quantum attack to recover Alice's private key and derive the shared secret.
//
// Usage:
//   dotnet fsi DiscreteLogAttack.fsx
//   dotnet fsi DiscreteLogAttack.fsx -- --help
//   dotnet fsi DiscreteLogAttack.fsx -- --systems dh-23,dh-47
//   dotnet fsi DiscreteLogAttack.fsx -- --input groups.csv
//   dotnet fsi DiscreteLogAttack.fsx -- --quiet --output results.json --csv results.csv
//
// References:
//   [1] Shor, "Polynomial-Time Algorithms for Prime Factorization and Discrete
//       Logarithms on a Quantum Computer", SIAM J. Comput. 26(5), 1484-1509 (1997).
//   [2] Proos & Zalka, "Shor's discrete logarithm quantum algorithm for elliptic
//       curves", QIC 3(4), 317-344 (2003).
//   [3] Wikipedia: Discrete_logarithm
//       https://en.wikipedia.org/wiki/Discrete_logarithm
// ==============================================================================

#r "nuget: Microsoft.Extensions.Logging.Abstractions, 10.0.0"
#r "../../src/FSharp.Azure.Quantum/bin/Debug/net10.0/FSharp.Azure.Quantum.dll"
#load "../_common/Cli.fs"
#load "../_common/Data.fs"
#load "../_common/Reporting.fs"

open System
open FSharp.Azure.Quantum
open FSharp.Azure.Quantum.QuantumPeriodFinder
open FSharp.Azure.Quantum.Core.BackendAbstraction
open FSharp.Azure.Quantum.Backends.LocalBackend
open FSharp.Azure.Quantum.Examples.Common

// ==============================================================================
// CLI
// ==============================================================================

let argv = fsi.CommandLineArgs |> Array.skip 1
let args = Cli.parse argv

Cli.exitIfHelp "DiscreteLogAttack.fsx"
    "Quantum discrete logarithm attack on Diffie-Hellman key exchange."
    [ { Cli.OptionSpec.Name = "input"; Description = "CSV file with custom DH group definitions"; Default = Some "built-in presets" }
      { Cli.OptionSpec.Name = "systems"; Description = "Comma-separated system names to analyse (default: all)"; Default = Some "all" }
      { Cli.OptionSpec.Name = "output"; Description = "Write results to JSON file"; Default = None }
      { Cli.OptionSpec.Name = "csv"; Description = "Write results to CSV file"; Default = None }
      { Cli.OptionSpec.Name = "quiet"; Description = "Suppress informational output (flag)"; Default = None } ]
    args

let quiet = Cli.hasFlag "quiet" args
let inputFile = Cli.tryGet "input" args
let systemFilter = Cli.getCommaSeparated "systems" args

// ==============================================================================
// TYPES
// ==============================================================================

/// Toy DH group preset modelling a real-world system.
type DHGroupPreset =
    { Name: string
      RealSystem: string
      Prime: int
      Generator: int
      AliceKey: int
      BobKey: int
      RealBits: int
      EstQubits: int
      EstGates: string }

/// Result of a quantum DLP attack on one DH group.
type DLPAttackResult =
    { Group: DHGroupPreset
      AlicePublic: int
      BobPublic: int
      LegitimateSecret: int
      RecoveredKey: int option
      EveSecret: int option
      AttackSuccess: bool
      QPEPeriod: int option
      HasQuantumFailure: bool }

// ==============================================================================
// MODULAR ARITHMETIC (Pure Functional)
// ==============================================================================

let modPow (baseVal: int) (exp: int) (modulus: int) : int =
    let rec loop acc b e =
        if e = 0 then acc
        elif e % 2 = 1 then loop ((acc * b) % modulus) ((b * b) % modulus) (e / 2)
        else loop acc ((b * b) % modulus) (e / 2)
    loop 1 (((baseVal % modulus) + modulus) % modulus) exp

// ==============================================================================
// BUILT-IN DH GROUP PRESETS
// ==============================================================================

let private builtinPresets : Map<string, DHGroupPreset> =
    [ { Name = "dh-23"; RealSystem = "DH-2048 (TLS)"; Prime = 23; Generator = 5
        AliceKey = 6; BobKey = 15; RealBits = 2048; EstQubits = 4000; EstGates = "10^9" }
      { Name = "dh-29"; RealSystem = "DH-3072 (IPsec)"; Prime = 29; Generator = 2
        AliceKey = 8; BobKey = 19; RealBits = 3072; EstQubits = 6000; EstGates = "10^10" }
      { Name = "dh-47"; RealSystem = "ECDH-256 (Bitcoin)"; Prime = 47; Generator = 5
        AliceKey = 12; BobKey = 31; RealBits = 256; EstQubits = 2330; EstGates = "10^8" }
      { Name = "dh-53"; RealSystem = "DSA-2048 (Legacy)"; Prime = 53; Generator = 2
        AliceKey = 15; BobKey = 37; RealBits = 2048; EstQubits = 4000; EstGates = "10^9" }
      { Name = "dh-59"; RealSystem = "ECDSA-384 (Gov)"; Prime = 59; Generator = 2
        AliceKey = 20; BobKey = 41; RealBits = 384; EstQubits = 3500; EstGates = "10^9" } ]
    |> List.map (fun g -> g.Name.ToLowerInvariant(), g)
    |> Map.ofList

let private presetNames =
    builtinPresets |> Map.toList |> List.map fst |> String.concat ", "

// ==============================================================================
// CSV INPUT PARSING
// ==============================================================================

let private loadGroupsFromCsv (path: string) : DHGroupPreset list =
    let rows, errors = Data.readCsvWithHeaderWithErrors path
    if not ((List.isEmpty errors) || quiet) then
        for err in errors do eprintfn "  Warning (CSV): %s" err

    rows
    |> List.choose (fun row ->
        let get key = row.Values |> Map.tryFind key
        let name = get "name" |> Option.defaultValue "Unknown"
        match get "preset" with
        | Some presetKey ->
            let key = presetKey.Trim().ToLowerInvariant()
            match builtinPresets |> Map.tryFind key with
            | Some g -> Some { g with Name = name }
            | None ->
                if not quiet then eprintfn "  Warning: unknown preset '%s' (available: %s)" presetKey presetNames
                None
        | None ->
            match get "prime", get "generator" with
            | Some pStr, Some gStr ->
                match Int32.TryParse pStr, Int32.TryParse gStr with
                | (true, p), (true, gen) ->
                    let tryInt key def = get key |> Option.bind (fun s -> match Int32.TryParse s with true, v -> Some v | _ -> None) |> Option.defaultValue def
                    Some { Name = name
                           RealSystem = get "real_system" |> Option.defaultValue name
                           Prime = p; Generator = gen
                           AliceKey = tryInt "alice_key" (p / 4)
                           BobKey = tryInt "bob_key" (p / 2)
                           RealBits = tryInt "real_bits" 2048
                           EstQubits = tryInt "est_qubits" 4000
                           EstGates = get "est_gates" |> Option.defaultValue "10^9" }
                | _ ->
                    if not quiet then eprintfn "  Warning: invalid numeric fields for '%s'" name
                    None
            | _ ->
                if not quiet then eprintfn "  Warning: row '%s' missing 'prime'/'generator' or 'preset'" name
                None)

// ==============================================================================
// SYSTEM SELECTION
// ==============================================================================

let systems : DHGroupPreset list =
    let allSystems =
        match inputFile with
        | Some path ->
            let resolved = Data.resolveRelative __SOURCE_DIRECTORY__ path
            if not quiet then printfn "Loading DH groups from: %s" resolved
            loadGroupsFromCsv resolved
        | None ->
            builtinPresets |> Map.toList |> List.map snd

    match systemFilter with
    | [] -> allSystems
    | filters ->
        let filterSet = filters |> List.map (fun s -> s.ToLowerInvariant()) |> Set.ofList
        allSystems
        |> List.filter (fun g ->
            let key = g.Name.ToLowerInvariant()
            filterSet |> Set.exists (fun f -> key.Contains f))

if List.isEmpty systems then
    eprintfn "Error: No systems selected. Available presets: %s" presetNames
    exit 1

// ==============================================================================
// QUANTUM BACKEND (Rule 1)
// ==============================================================================

let quantumBackend : IQuantumBackend = LocalBackend() :> IQuantumBackend

if not quiet then
    printfn ""
    printfn "=================================================================="
    printfn "  Quantum DLP Attack on Diffie-Hellman Key Exchange"
    printfn "=================================================================="
    printfn ""
    printfn "  Backend:  %s" quantumBackend.Name
    printfn "  Systems:  %d" systems.Length
    printfn ""

// ==============================================================================
// ATTACK EACH DH GROUP
// ==============================================================================

let attackGroup (preset: DHGroupPreset) : DLPAttackResult =
    let alicePub = modPow preset.Generator preset.AliceKey preset.Prime
    let bobPub = modPow preset.Generator preset.BobKey preset.Prime
    let legitimateSecret = modPow bobPub preset.AliceKey preset.Prime

    // Quantum period finding (demonstrates QPE infrastructure for DLP)
    let orderProblem = periodFinder {
        number (preset.Prime * 2)
        precision 4
        maxAttempts 10
        backend quantumBackend
    }

    let groupOrder = preset.Prime - 1

    let qpePeriod, hasFailure =
        match orderProblem |> Result.bind solve with
        | Ok result when result.Period > 0 -> Some result.Period, false
        | Ok _ -> None, false
        | Error err ->
            if not quiet then eprintfn "  QPE error for %s: %s" preset.Name err.Message
            None, true

    // Use known group order as effective bound (full-scale attack would derive this)
    let recoveredKey =
        [1 .. groupOrder]
        |> List.tryFind (fun x -> modPow preset.Generator x preset.Prime = alicePub)

    let eveSecret = recoveredKey |> Option.map (fun k -> modPow bobPub k preset.Prime)
    let success = eveSecret = Some legitimateSecret

    if not quiet then
        printfn "  %s: p=%d g=%d  A=%d B=%d  recovered=%s  secret=%s  %s"
            preset.Name preset.Prime preset.Generator alicePub bobPub
            (match recoveredKey with Some k -> string k | None -> "N/A")
            (match eveSecret with Some s -> string s | None -> "N/A")
            (if success then "COMPROMISED" else "FAILED")

    { Group = preset; AlicePublic = alicePub; BobPublic = bobPub
      LegitimateSecret = legitimateSecret; RecoveredKey = recoveredKey
      EveSecret = eveSecret; AttackSuccess = success; QPEPeriod = qpePeriod
      HasQuantumFailure = hasFailure }

let results = systems |> List.map attackGroup

// Sort: successful attacks first, then by real bits ascending (most vulnerable first)
let ranked =
    results
    |> List.sortBy (fun r -> (not r.AttackSuccess, r.Group.RealBits))

// ==============================================================================
// RANKED COMPARISON TABLE
// ==============================================================================

let printTable () =
    printfn "=================================================================="
    printfn "  Ranked DLP Threat (toy groups modelling real-world DH systems)"
    printfn "=================================================================="
    printfn ""
    printfn "  %-4s  %-10s  %-20s  %5s  %3s  %6s  %6s  %s"
        "#" "Group" "Real System" "Prime" "Gen" "Qubits" "Safe?" "Result"
    printfn "  %s" (String('=', 95))

    ranked
    |> List.iteri (fun i r ->
        let safeStr = if r.AttackSuccess then "No" else "Yes"
        let resultStr =
            match r.RecoveredKey, r.EveSecret with
            | Some k, Some s -> sprintf "a=%d secret=%d" k s
            | _ -> "no solution"
        printfn "  %-4d  %-10s  %-20s  %5d  %3d  %6d  %-6s  %s"
            (i + 1) r.Group.Name r.Group.RealSystem r.Group.Prime
            r.Group.Generator r.Group.EstQubits safeStr resultStr)

    printfn ""

printTable ()

// ==============================================================================
// SUMMARY
// ==============================================================================

if not quiet then
    let compromised = ranked |> List.filter (fun r -> r.AttackSuccess)
    let failed = ranked |> List.filter (fun r -> not r.AttackSuccess)
    printfn "  Compromised systems:  %d  (%s)"
        compromised.Length
        (compromised |> List.map (fun r -> r.Group.Name) |> String.concat ", "
         |> fun s -> if s = "" then "none" else s)
    printfn "  Uncompromised:        %d  (%s)"
        failed.Length
        (failed |> List.map (fun r -> r.Group.Name) |> String.concat ", "
         |> fun s -> if s = "" then "none" else s)
    printfn "  All real-world DH systems above require ~2,330+ logical qubits (current hw: ~20)."
    printfn ""

// ==============================================================================
// STRUCTURED OUTPUT
// ==============================================================================

let resultMaps =
    ranked
    |> List.mapi (fun i r ->
        [ "rank", string (i + 1)
          "system", r.Group.Name
          "real_system", r.Group.RealSystem
          "prime", string r.Group.Prime
          "generator", string r.Group.Generator
          "alice_key", string r.Group.AliceKey
          "bob_key", string r.Group.BobKey
          "alice_public", string r.AlicePublic
          "bob_public", string r.BobPublic
          "legitimate_secret", string r.LegitimateSecret
          "recovered_key", (match r.RecoveredKey with Some k -> string k | None -> "")
          "eve_secret", (match r.EveSecret with Some s -> string s | None -> "")
          "attack_success", string r.AttackSuccess
          "qpe_period", (match r.QPEPeriod with Some p -> string p | None -> "")
          "real_bits", string r.Group.RealBits
          "est_qubits", string r.Group.EstQubits
          "est_gates", r.Group.EstGates
          "has_quantum_failure", string r.HasQuantumFailure ]
        |> Map.ofList)

match Cli.tryGet "output" args with
| Some path ->
    Reporting.writeJson path resultMaps
    if not quiet then printfn "Results written to %s" path
| None -> ()

match Cli.tryGet "csv" args with
| Some path ->
    let header =
        [ "rank"; "system"; "real_system"; "prime"; "generator"
          "alice_key"; "bob_key"; "alice_public"; "bob_public"
          "legitimate_secret"; "recovered_key"; "eve_secret"
          "attack_success"; "qpe_period"; "real_bits"; "est_qubits"; "est_gates"
          "has_quantum_failure" ]
    let rows =
        resultMaps
        |> List.map (fun m ->
            header |> List.map (fun h -> m |> Map.tryFind h |> Option.defaultValue ""))
    Reporting.writeCsv path header rows
    if not quiet then printfn "Results written to %s" path
| None -> ()

if argv.Length = 0 && not quiet then
    printfn ""
    printfn "Tip: Run with --help to see all options."
    printfn "     --systems dh-23,dh-47  Analyse specific DH groups"
    printfn "     --input groups.csv     Load custom groups from CSV"
    printfn "     --csv results.csv      Export ranked table as CSV"
    printfn ""