From 835c01bfaad8f222c4e7ee4f7eae0607afadef04 Mon Sep 17 00:00:00 2001 From: Dmitry Zuikov Date: Wed, 25 Sep 2024 11:27:29 +0300 Subject: [PATCH] ghc-9.6.6 + updated db-pipe --- flake.lock | 395 +++++------------- flake.nix | 45 +- hbs2-core/lib/HBS2/Actors.hs | 4 - hbs2-core/lib/HBS2/Actors/Peer.hs | 12 +- hbs2-core/lib/HBS2/Actors/Peer/Types.hs | 5 - hbs2-core/lib/HBS2/Base58.hs | 2 - hbs2-core/lib/HBS2/Clock.hs | 8 +- hbs2-core/lib/HBS2/Data/Bundle.hs | 2 +- hbs2-core/lib/HBS2/Data/Detect.hs | 12 +- hbs2-core/lib/HBS2/Data/KeyRing.hs | 3 +- hbs2-core/lib/HBS2/Data/Types.hs | 1 - hbs2-core/lib/HBS2/Data/Types/Peer.hs | 2 - hbs2-core/lib/HBS2/Data/Types/Refs.hs | 2 +- hbs2-core/lib/HBS2/Hash.hs | 6 +- hbs2-core/lib/HBS2/Merkle.hs | 9 +- hbs2-core/lib/HBS2/Merkle/MetaData.hs | 2 +- hbs2-core/lib/HBS2/Net/Auth/Credentials.hs | 2 +- .../lib/HBS2/Net/Auth/Credentials/Sigil.hs | 1 - hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs | 15 +- hbs2-core/lib/HBS2/Net/Auth/Schema.hs | 2 - hbs2-core/lib/HBS2/Net/IP/Addr.hs | 12 +- .../HBS2/Net/Messaging/Encrypted/ByPass.hs | 4 +- .../Net/Messaging/Encrypted/RandomPrefix.hs | 8 +- hbs2-core/lib/HBS2/Net/Messaging/Fake.hs | 4 +- hbs2-core/lib/HBS2/Net/Messaging/Pipe.hs | 3 +- hbs2-core/lib/HBS2/Net/Messaging/Stream.hs | 4 +- hbs2-core/lib/HBS2/Net/Messaging/TCP.hs | 6 +- hbs2-core/lib/HBS2/Net/Messaging/UDP.hs | 7 +- hbs2-core/lib/HBS2/Net/Messaging/Unix.hs | 12 +- hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs | 1 + hbs2-core/lib/HBS2/Net/Proto/Notify.hs | 5 +- hbs2-core/lib/HBS2/Net/Proto/Service.hs | 3 +- hbs2-core/lib/HBS2/Net/Proto/Sessions.hs | 4 +- hbs2-core/lib/HBS2/Net/Proto/Types.hs | 8 +- hbs2-core/lib/HBS2/Polling.hs | 1 - hbs2-core/lib/HBS2/Prelude.hs | 4 + hbs2-core/lib/HBS2/Prelude/Plated.hs | 1 - hbs2-core/lib/HBS2/ScheduledAction.hs | 13 +- .../lib/HBS2/Storage/Operations/ByteString.hs | 3 +- .../lib/HBS2/Storage/Operations/Missed.hs | 4 +- hbs2-core/lib/HBS2/System/Logger/Simple.hs | 2 - .../HBS2/KeyMan/Keys/Direct.hs | 1 + hbs2-peer/app/PeerMain.hs | 3 +- hbs2-peer/hbs2-peer.cabal | 1 + .../HBS2/Peer/Proto/RefChan/RefChanUpdate.hs | 2 + hbs2-peer/lib/HBS2/Peer/RPC/Internal/Types.hs | 1 + .../lib/HBS2/Storage/Compact.hs | 2 + .../lib/HBS2/Storage/Simple.hs | 1 + 48 files changed, 242 insertions(+), 408 deletions(-) diff --git a/flake.lock b/flake.lock index 4b5088ab..777ca7b7 100644 --- a/flake.lock +++ b/flake.lock @@ -1,47 +1,87 @@ { "nodes": { + "bytestring-mmap": { + "flake": false, + "locked": { + "lastModified": 1727193872, + "narHash": "sha256-L39kMCMry/BNJngt0+yvSIMnJJzWR9ZoyXbEyniEfwU=", + "owner": "ivanovs-4", + "repo": "bytestring-mmap", + "rev": "f43e5e06718ed904487f17e7725c12098773c12f", + "type": "github" + }, + "original": { + "owner": "ivanovs-4", + "repo": "bytestring-mmap", + "type": "github" + } + }, "db-pipe": { "inputs": { - "haskell-flake-utils": "haskell-flake-utils", + "haskell-flake-utils": [ + "haskell-flake-utils" + ], "nixpkgs": [ "nixpkgs" ] }, "locked": { - "lastModified": 1713359411, - "narHash": "sha256-BzOZ6xU+Li5nIe71Wy4p+lOEQlYK/e94T0gBcP8IKgE=", - "ref": "generic-sql", - "rev": "03635c54b2e2bd809ec1196bc9082447279f6f24", + "lastModified": 1727252661, + "narHash": "sha256-8vmgF0Atw+m7a+2Wmlnwjjyw8nSYv0QMT+zN9R3DljQ=", + "ref": "refs/heads/master", + "rev": "8b614540a7f30f0227cb18ef2ad4c8d84db4a75c", "revCount": 9, "type": "git", "url": "https://git.hbs2.net/5xrwbTzzweS9yeJQnrrUY9gQJfhJf84pbyHhF2MMmSft" }, "original": { - "ref": "generic-sql", "type": "git", "url": "https://git.hbs2.net/5xrwbTzzweS9yeJQnrrUY9gQJfhJf84pbyHhF2MMmSft" } }, + "db-pipe_2": { + "inputs": { + "haskell-flake-utils": [ + "lsm", + "haskell-flake-utils" + ], + "nixpkgs": [ + "lsm", + "nixpkgs" + ] + }, + "locked": { + "lastModified": 1713519608, + "narHash": "sha256-MBBsIdK1am/usgdBYr6ZoKm1pwv7u9ujS/tiNRrn0m8=", + "ref": "refs/heads/master", + "rev": "b755977dd737ff367c7eb19efd9e273d1bd37ed7", + "revCount": 8, + "type": "git", + "url": "http://git.hbs2/5xrwbTzzweS9yeJQnrrUY9gQJfhJf84pbyHhF2MMmSft" + }, + "original": { + "type": "git", + "url": "http://git.hbs2/5xrwbTzzweS9yeJQnrrUY9gQJfhJf84pbyHhF2MMmSft" + } + }, "fixme": { "inputs": { "haskell-flake-utils": "haskell-flake-utils_2", - "nixpkgs": [ - "nixpkgs" - ], + "nixpkgs": "nixpkgs", "suckless-conf": "suckless-conf" }, "locked": { - "lastModified": 1697356303, - "narHash": "sha256-hJbJZtx7gdcXaKL8n5J8b/eVyoYe9VxM+037ZK7q8Gw=", - "ref": "refs/heads/master", - "rev": "e9b1dcfd78dc766a2255a8125c14b24f0d728c0e", - "revCount": 139, - "type": "git", - "url": "https://git.hbs2.net/Fujv1Uy4W5d9Z7REEArMxbXSJ8nLLn4dYuvaAs8b86hr" + "lastModified": 1714707469, + "narHash": "sha256-uL3j7NmCWADN0rIyVr3bv0JFMPgYgrnb1wiJW5tZ9jU=", + "owner": "voidlizard", + "repo": "fixme", + "rev": "51485aa169c7b2040b6e2b8d096f38ed77146482", + "type": "github" }, "original": { - "type": "git", - "url": "https://git.hbs2.net/Fujv1Uy4W5d9Z7REEArMxbXSJ8nLLn4dYuvaAs8b86hr" + "owner": "voidlizard", + "repo": "fixme", + "type": "github" } }, "flake-utils": { @@ -89,109 +129,21 @@ "type": "github" } }, - "flake-utils_4": { - "locked": { - "lastModified": 1644229661, - "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "flake-utils_5": { - "locked": { - "lastModified": 1644229661, - "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "flake-utils_6": { - "locked": { - "lastModified": 1644229661, - "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "flake-utils_7": { - "locked": { - "lastModified": 1644229661, - "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "flake-utils_8": { - "locked": { - "lastModified": 1644229661, - "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, - "flake-utils_9": { - "locked": { - "lastModified": 1644229661, - "narHash": "sha256-1YdnJAsNy69bpcjuoKdOYQX0YxZBiCYZo4Twxerqv7k=", - "owner": "numtide", - "repo": "flake-utils", - "rev": "3cecb5b042f7f209c56ffd8371b2711a290ec797", - "type": "github" - }, - "original": { - "owner": "numtide", - "repo": "flake-utils", - "type": "github" - } - }, "fuzzy": { "inputs": { - "haskell-flake-utils": "haskell-flake-utils_4", + "haskell-flake-utils": [ + "haskell-flake-utils" + ], "nixpkgs": [ "nixpkgs" ] }, "locked": { - "lastModified": 1715919110, - "narHash": "sha256-moioa3ixAZb0y/xxyxUVjSvXoSiDGXy/vAx6B70d2yM=", + "lastModified": 1727197542, + "narHash": "sha256-BF9Xd2fa8L5Xju9NTaoUjmzUEJfrRMMKULYQieBjbKo=", "ref": "refs/heads/master", - "rev": "5a55c22750589b357e50b759d2a754df058446d6", - "revCount": 40, + "rev": "a834b152e29d632c816eefe117036e5d9330bd03", + "revCount": 43, "type": "git", "url": "https://git.hbs2.net/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA" }, @@ -200,39 +152,21 @@ "url": "https://git.hbs2.net/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA" } }, - "fuzzy_2": { - "inputs": { - "haskell-flake-utils": "haskell-flake-utils_8", - "nixpkgs": "nixpkgs_2" - }, - "locked": { - "lastModified": 1715918584, - "narHash": "sha256-moioa3ixAZb0y/xxyxUVjSvXoSiDGXy/vAx6B70d2yM=", - "rev": "831879978213a1aed15ac70aa116c33bcbe964b8", - "revCount": 63, - "type": "git", - "url": "http://git.hbs2.net/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA?tag=0.1.3.1" - }, - "original": { - "rev": "831879978213a1aed15ac70aa116c33bcbe964b8", - "type": "git", - "url": "http://git.hbs2.net/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA?tag=0.1.3.1" - } - }, "haskell-flake-utils": { "inputs": { "flake-utils": "flake-utils" }, "locked": { - "lastModified": 1698938553, - "narHash": "sha256-oXpTKXioqFbl2mhhvpJIAvgNd+wYyv4ekI+YnJHEJ6s=", + "lastModified": 1707809372, + "narHash": "sha256-wfTL9PlCSOqSSyU4eenFFI7pHrV21gba4GEILnI4nAU=", "owner": "ivanovs-4", "repo": "haskell-flake-utils", - "rev": "19b273b5dc401a0a565e7f75cf50a593871b80c9", + "rev": "3cbdc5d6093e8b4464ae64097e0c8c61e4414ff2", "type": "github" }, "original": { "owner": "ivanovs-4", + "ref": "master", "repo": "haskell-flake-utils", "type": "github" } @@ -273,119 +207,11 @@ "type": "github" } }, - "haskell-flake-utils_4": { - "inputs": { - "flake-utils": "flake-utils_4" - }, - "locked": { - "lastModified": 1707809372, - "narHash": "sha256-wfTL9PlCSOqSSyU4eenFFI7pHrV21gba4GEILnI4nAU=", - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "rev": "3cbdc5d6093e8b4464ae64097e0c8c61e4414ff2", - "type": "github" - }, - "original": { - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "type": "github" - } - }, - "haskell-flake-utils_5": { - "inputs": { - "flake-utils": "flake-utils_5" - }, - "locked": { - "lastModified": 1698938553, - "narHash": "sha256-oXpTKXioqFbl2mhhvpJIAvgNd+wYyv4ekI+YnJHEJ6s=", - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "rev": "19b273b5dc401a0a565e7f75cf50a593871b80c9", - "type": "github" - }, - "original": { - "owner": "ivanovs-4", - "ref": "master", - "repo": "haskell-flake-utils", - "type": "github" - } - }, - "haskell-flake-utils_6": { - "inputs": { - "flake-utils": "flake-utils_6" - }, - "locked": { - "lastModified": 1672412555, - "narHash": "sha256-Kaa8F7nQFR3KuS6Y9WRUxeJeZlp6CCubyrRfmiEsW4k=", - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "rev": "896219e5bde6efac72198550454e9dd9b5ed9ac9", - "type": "github" - }, - "original": { - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "rev": "896219e5bde6efac72198550454e9dd9b5ed9ac9", - "type": "github" - } - }, - "haskell-flake-utils_7": { - "inputs": { - "flake-utils": "flake-utils_7" - }, - "locked": { - "lastModified": 1698938553, - "narHash": "sha256-oXpTKXioqFbl2mhhvpJIAvgNd+wYyv4ekI+YnJHEJ6s=", - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "rev": "19b273b5dc401a0a565e7f75cf50a593871b80c9", - "type": "github" - }, - "original": { - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "type": "github" - } - }, - "haskell-flake-utils_8": { - "inputs": { - "flake-utils": "flake-utils_8" - }, - "locked": { - "lastModified": 1707809372, - "narHash": "sha256-wfTL9PlCSOqSSyU4eenFFI7pHrV21gba4GEILnI4nAU=", - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "rev": "3cbdc5d6093e8b4464ae64097e0c8c61e4414ff2", - "type": "github" - }, - "original": { - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "type": "github" - } - }, - "haskell-flake-utils_9": { - "inputs": { - "flake-utils": "flake-utils_9" - }, - "locked": { - "lastModified": 1672412555, - "narHash": "sha256-Kaa8F7nQFR3KuS6Y9WRUxeJeZlp6CCubyrRfmiEsW4k=", - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "rev": "896219e5bde6efac72198550454e9dd9b5ed9ac9", - "type": "github" - }, - "original": { - "owner": "ivanovs-4", - "repo": "haskell-flake-utils", - "type": "github" - } - }, "hspup": { "inputs": { - "haskell-flake-utils": "haskell-flake-utils_6", + "haskell-flake-utils": [ + "haskell-flake-utils" + ], "nixpkgs": [ "nixpkgs" ] @@ -406,17 +232,21 @@ }, "lsm": { "inputs": { - "haskell-flake-utils": "haskell-flake-utils_7", + "db-pipe": "db-pipe_2", + "fixme": "fixme", + "haskell-flake-utils": [ + "haskell-flake-utils" + ], "nixpkgs": [ "nixpkgs" ] }, "locked": { - "lastModified": 1711033804, - "narHash": "sha256-z9cb5yuWfuZmGukxsZebXhc6KUZoPVT60oXxQ6j6ML8=", + "lastModified": 1715418443, + "narHash": "sha256-uhc9bf6myVz0Nx8Aoyc6/03FBQVyMqa78ByZzlrvKvY=", "ref": "refs/heads/master", - "rev": "0e8286a43da5b9e54c4f3ecdb994173fe77351db", - "revCount": 26, + "rev": "e9aab0bcb79f4c811b5fb795f878b38874218809", + "revCount": 57, "type": "git", "url": "https://git.hbs2.net/5BCaH95cWsVKBmWaDNLWQr2umxzzT5kqRRKNTm2J15Ls" }, @@ -427,11 +257,27 @@ }, "nixpkgs": { "locked": { - "lastModified": 1707451808, - "narHash": "sha256-UwDBUNHNRsYKFJzyTMVMTF5qS4xeJlWoeyJf+6vvamU=", + "lastModified": 1697009197, + "narHash": "sha256-viVRhBTFT8fPJTb1N3brQIpFZnttmwo3JVKNuWRVc3s=", + "owner": "NixOS", + "repo": "nixpkgs", + "rev": "01441e14af5e29c9d27ace398e6dd0b293e25a54", + "type": "github" + }, + "original": { + "owner": "NixOS", + "ref": "nixpkgs-unstable", + "repo": "nixpkgs", + "type": "github" + } + }, + "nixpkgs_2": { + "locked": { + "lastModified": 1727089097, + "narHash": "sha256-ZMHMThPsthhUREwDebXw7GX45bJnBCVbfnH1g5iuSPc=", "owner": "nixos", "repo": "nixpkgs", - "rev": "442d407992384ed9c0e6d352de75b69079904e4e", + "rev": "568bfef547c14ca438c56a0bece08b8bb2b71a9c", "type": "github" }, "original": { @@ -441,31 +287,15 @@ "type": "github" } }, - "nixpkgs_2": { - "locked": { - "lastModified": 1707451808, - "narHash": "sha256-UwDBUNHNRsYKFJzyTMVMTF5qS4xeJlWoeyJf+6vvamU=", - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "442d407992384ed9c0e6d352de75b69079904e4e", - "type": "github" - }, - "original": { - "owner": "NixOS", - "repo": "nixpkgs", - "rev": "442d407992384ed9c0e6d352de75b69079904e4e", - "type": "github" - } - }, "root": { "inputs": { + "bytestring-mmap": "bytestring-mmap", "db-pipe": "db-pipe", - "fixme": "fixme", "fuzzy": "fuzzy", - "haskell-flake-utils": "haskell-flake-utils_5", + "haskell-flake-utils": "haskell-flake-utils", "hspup": "hspup", "lsm": "lsm", - "nixpkgs": "nixpkgs", + "nixpkgs": "nixpkgs_2", "saltine": "saltine", "suckless-conf": "suckless-conf_2" } @@ -491,6 +321,7 @@ "inputs": { "haskell-flake-utils": "haskell-flake-utils_3", "nixpkgs": [ + "lsm", "fixme", "nixpkgs" ] @@ -511,22 +342,26 @@ }, "suckless-conf_2": { "inputs": { - "fuzzy": "fuzzy_2", - "haskell-flake-utils": "haskell-flake-utils_9", + "fuzzy": [ + "fuzzy" + ], + "haskell-flake-utils": [ + "haskell-flake-utils" + ], "nixpkgs": [ "nixpkgs" ] }, "locked": { - "lastModified": 1724740155, - "narHash": "sha256-dHAWLoQ0uZ2FckV/93qbXo6aYCTY+jARXiiTgUt6fcA=", - "rev": "b6c5087312e6c09e5c27082da47846f377f73756", - "revCount": 38, + "lastModified": 1727200798, + "narHash": "sha256-esabG5zoApNLbirx0mCj1+3ZPFU9Ckod9wSn9MHc0mo=", + "ref": "refs/heads/master", + "rev": "ff6f1a2e053005a52af5c7375fb66e8bb89bce2d", + "revCount": 40, "type": "git", "url": "https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ" }, "original": { - "rev": "b6c5087312e6c09e5c27082da47846f377f73756", "type": "git", "url": "https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ" } diff --git a/flake.nix b/flake.nix index cf709339..df5dd018 100644 --- a/flake.nix +++ b/flake.nix @@ -8,30 +8,37 @@ inputs = { haskell-flake-utils.url = "github:ivanovs-4/haskell-flake-utils/master"; hspup.url = "github:voidlizard/hspup"; hspup.inputs.nixpkgs.follows = "nixpkgs"; + hspup.inputs.haskell-flake-utils.follows = "haskell-flake-utils"; - fixme.url = "git+https://git.hbs2.net/Fujv1Uy4W5d9Z7REEArMxbXSJ8nLLn4dYuvaAs8b86hr"; - #fixme.url = "git+file:///home/dmz/w/fixme?ref=dev-0.2"; - fixme.inputs.nixpkgs.follows = "nixpkgs"; - - suckless-conf.url = - "git+https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ?rev=b6c5087312e6c09e5c27082da47846f377f73756"; + suckless-conf.url = "git+https://git.hbs2.net/JAuk1UJzZfbDGKVazSQU5yYQ3NGfk4gVeZzBCduf5TgQ"; suckless-conf.inputs.nixpkgs.follows = "nixpkgs"; + suckless-conf.inputs.fuzzy.follows = "fuzzy"; + suckless-conf.inputs.haskell-flake-utils.follows = "haskell-flake-utils"; - db-pipe.url = "git+https://git.hbs2.net/5xrwbTzzweS9yeJQnrrUY9gQJfhJf84pbyHhF2MMmSft?ref=generic-sql"; + db-pipe.url = "git+https://git.hbs2.net/5xrwbTzzweS9yeJQnrrUY9gQJfhJf84pbyHhF2MMmSft"; db-pipe.inputs.nixpkgs.follows = "nixpkgs"; + db-pipe.inputs.haskell-flake-utils.follows = "haskell-flake-utils"; lsm.url = "git+https://git.hbs2.net/5BCaH95cWsVKBmWaDNLWQr2umxzzT5kqRRKNTm2J15Ls"; lsm.inputs.nixpkgs.follows = "nixpkgs"; + lsm.inputs.haskell-flake-utils.follows = "haskell-flake-utils"; + # fuzzy.url = "git+file:/home/iv/haskell/p2p/hex-offgrid/fuzzy-parse"; # tmp fuzzy.url = "git+https://git.hbs2.net/GmcLB9gEPT4tbx9eyQiECwsu8oPyEh6qKEpQDtyBWVPA"; fuzzy.inputs.nixpkgs.follows = "nixpkgs"; + fuzzy.inputs.haskell-flake-utils.follows = "haskell-flake-utils"; saltine = { url = "github:tel/saltine/3d3a54cf46f78b71b4b55653482fb6f4cee6b77d"; flake = false; }; + bytestring-mmap = { + url = "github:ivanovs-4/bytestring-mmap"; + flake = false; + }; + }; outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs: @@ -78,10 +85,27 @@ outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs: "fixme-new" = "./fixme-new"; }; - hpPreOverrides = {pkgs, ...}: final: prev: with pkgs; { + hpPreOverrides = {pkgs, ...}: final: prev: ((with pkgs; { saltine = prev.callCabal2nix "saltine" inputs.saltine { inherit (pkgs) libsodium; }; scotty = final.callHackage "scotty" "0.21" { }; - }; + bytestring-mmap = prev.callCabal2nix "bytestring-mmap" inputs.bytestring-mmap {}; + skylighting-lucid = final.callHackage "skylighting-lucid" "1.0.4" { }; + # wai-app-file-cgi = final.callHackage "wai-app-file-cgi" "3.1.11" { }; + # htags = final.callHackage "htags" "1.0.1" { }; + }) // + (with haskell-flake-utils.lib; + with pkgs.haskell.lib; + let + donts = [ + (jailbreakUnbreak pkgs) + # dontBenchmark + dontCoverage + dontCheck + ]; + in tunePackages pkgs prev { + wai-app-file-cgi = donts; + } + )); packagePostOverrides = { pkgs }: with pkgs; with haskell.lib; [ disableExecutableProfiling @@ -115,7 +139,7 @@ outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs: cabal-install haskell-language-server hoogle - htags + # htags text-icu magic pkgs.icu72 @@ -125,7 +149,6 @@ outputs = { self, nixpkgs, haskell-flake-utils, ... }@inputs: ++ [ pkgs.pkg-config inputs.hspup.packages.${pkgs.system}.default - inputs.fixme.packages.${pkgs.system}.default ] ); diff --git a/hbs2-core/lib/HBS2/Actors.hs b/hbs2-core/lib/HBS2/Actors.hs index 0c303c7a..2f123711 100644 --- a/hbs2-core/lib/HBS2/Actors.hs +++ b/hbs2-core/lib/HBS2/Actors.hs @@ -7,16 +7,12 @@ module HBS2.Actors ) where import HBS2.Prelude -import HBS2.Clock import Control.Concurrent.STM import Control.Concurrent.STM.TBMQueue qualified as TBMQ import Control.Concurrent.STM.TBMQueue (TBMQueue) import Control.Concurrent.STM.TVar qualified as TVar -import Control.Monad -import Control.Concurrent.Async import Data.Function -import Data.Functor import Data.Kind import Control.Concurrent diff --git a/hbs2-core/lib/HBS2/Actors/Peer.hs b/hbs2-core/lib/HBS2/Actors/Peer.hs index 3f1af405..6efe8dcd 100644 --- a/hbs2-core/lib/HBS2/Actors/Peer.hs +++ b/hbs2-core/lib/HBS2/Actors/Peer.hs @@ -17,8 +17,6 @@ import HBS2.Events import HBS2.Net.Auth.Credentials import HBS2.Net.Messaging import HBS2.Net.PeerLocator -import HBS2.Net.PeerLocator.Static -import HBS2.Net.Proto import HBS2.Net.Proto.Sessions import HBS2.Prelude.Plated import HBS2.Storage @@ -26,6 +24,7 @@ import HBS2.System.Logger.Simple import Data.Config.Suckless.KeyValue (HasConf(..)) +import Control.Monad import Control.Monad.Trans.Maybe import Control.Concurrent.Async import Control.Monad.Reader @@ -33,7 +32,6 @@ import Data.ByteString.Lazy (ByteString) import Data.Cache (Cache) import Data.Cache qualified as Cache import Data.Dynamic -import Data.Foldable hiding (find) import Data.Map qualified as Map import Data.Maybe import GHC.TypeLits @@ -264,7 +262,7 @@ instance ( MonadIO m ) => Request e msg m where request peer_e msg = do let proto = protoId @e @msg (Proxy @msg) - pipe <- getFabriq @e + pip <- getFabriq @e me <- ownPeer @e -- TODO: check if a request were sent to peer and timeout is here @@ -281,7 +279,7 @@ instance ( MonadIO m trace $ "REQUEST: not allowed to send for proto" <+> viaShow proto when allowed do - sendTo pipe (To peer_e) (From me) (AnyMessage @(Encoded e) @e proto (encode msg)) + sendTo pip (To peer_e) (From me) (AnyMessage @(Encoded e) @e proto (encode msg)) -- trace $ "REQUEST: after sendTo" <+> viaShow peer_e @@ -431,7 +429,7 @@ runProto :: forall e m . ( MonadIO m runProto hh = do me <- ownPeer @e @m - pipe <- getFabriq @e + pipf <- getFabriq @e let resp = [ (pid, a) | a@AnyProtocol { myProtoId = pid } <- hh ] @@ -439,7 +437,7 @@ runProto hh = do forever $ do - messages <- receive @_ @e pipe (To me) + messages <- receive @_ @e pipf (To me) for_ messages $ \(From pip, AnyMessage n msg :: AnyMessage (Encoded e) e) -> do diff --git a/hbs2-core/lib/HBS2/Actors/Peer/Types.hs b/hbs2-core/lib/HBS2/Actors/Peer/Types.hs index c68ab28a..15c98f3c 100644 --- a/hbs2-core/lib/HBS2/Actors/Peer/Types.hs +++ b/hbs2-core/lib/HBS2/Actors/Peer/Types.hs @@ -2,15 +2,10 @@ module HBS2.Actors.Peer.Types where import HBS2.Prelude -import HBS2.Storage import HBS2.Net.Proto.Types import HBS2.Net.Messaging -import HBS2.Hash import Control.Monad.Trans.Class -import Data.ByteString.Lazy (ByteString) -import Control.Monad -import Codec.Serialise class HasProtocol e p => HasTimeLimits e p m where tryLockForPeriod :: Peer e -> p -> m Bool diff --git a/hbs2-core/lib/HBS2/Base58.hs b/hbs2-core/lib/HBS2/Base58.hs index db41a17b..468920a7 100644 --- a/hbs2-core/lib/HBS2/Base58.hs +++ b/hbs2-core/lib/HBS2/Base58.hs @@ -4,10 +4,8 @@ import Data.ByteString.Base58 (encodeBase58, bitcoinAlphabet, decodeBase58,Alpha import Data.ByteString qualified as BS import Data.ByteString.Char8 qualified as BS8 import Data.ByteString.Char8 (ByteString) -import Data.ByteString.Lazy.Char8 qualified as LBS8 import Data.ByteString.Lazy qualified as LBS import Data.Word -import Data.Char (ord) import Numeric import Prettyprinter diff --git a/hbs2-core/lib/HBS2/Clock.hs b/hbs2-core/lib/HBS2/Clock.hs index 4f9e1c5c..4b4a18d1 100644 --- a/hbs2-core/lib/HBS2/Clock.hs +++ b/hbs2-core/lib/HBS2/Clock.hs @@ -1,8 +1,9 @@ {-# LANGUAGE CPP #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module HBS2.Clock ( module HBS2.Clock , module System.Clock - , POSIXTime, getPOSIXTime, getEpoch + , POSIXTime, getPOSIXTime )where import Data.Functor @@ -14,7 +15,6 @@ import Data.Proxy import Data.Time import Prettyprinter import System.Clock -import Data.Time.Clock import Data.Time.Clock.POSIX (POSIXTime, getPOSIXTime) import Data.Word @@ -50,7 +50,7 @@ instance IsTimeout t => Expired (Timeout t) TimeSpec where -- expired timeout ts = False toNominalDiffTime :: IsTimeout t => Timeout t -> NominalDiffTime -toNominalDiffTime = fromRational . (/ (10^6)) . fromIntegral . toMicroSeconds +toNominalDiffTime = fromRational . (/ (10^(6 :: Integer))) . fromIntegral . toMicroSeconds class IsTimeout a => MonadPause a m where pause :: Timeout a -> m () @@ -97,7 +97,7 @@ instance IsTimeout 'Minutes where toNanoSeconds (TimeoutMin x) = round (x * 60 * 1e9) instance IsTimeout 'NomDiffTime where - toNanoSeconds (TimeoutNDT t) = round (realToFrac (nominalDiffTimeToSeconds t) * 1e9) + toNanoSeconds (TimeoutNDT t) = round (realToFrac (nominalDiffTimeToSeconds t) * (1e9 :: Double)) instance IsTimeout 'TS where toNanoSeconds (TimeoutTS s) = fromIntegral $ toNanoSecs s diff --git a/hbs2-core/lib/HBS2/Data/Bundle.hs b/hbs2-core/lib/HBS2/Data/Bundle.hs index a3bc2851..f7fd5ae5 100644 --- a/hbs2-core/lib/HBS2/Data/Bundle.hs +++ b/hbs2-core/lib/HBS2/Data/Bundle.hs @@ -178,7 +178,7 @@ instance MonadIO m => ImportBundle HashRef m where go hd bs | LBS.null bs = pure $ Right () | otherwise = do - let ss = bundleHeadSectionSize hd + let _ss = bundleHeadSectionSize hd let (bsh, allBsRest) = LBS.splitAt sectionHeadSize bs case deserialiseOrFail @BundleSection bsh of Left{} -> do diff --git a/hbs2-core/lib/HBS2/Data/Detect.hs b/hbs2-core/lib/HBS2/Data/Detect.hs index 01032ec9..259efe87 100644 --- a/hbs2-core/lib/HBS2/Data/Detect.hs +++ b/hbs2-core/lib/HBS2/Data/Detect.hs @@ -6,25 +6,25 @@ import HBS2.Data.Types import HBS2.Merkle import HBS2.Storage -import HBS2.System.Logger.Simple +-- import HBS2.System.Logger.Simple -import Data.Foldable (for_) +-- import Data.Foldable (for_) import Control.Monad.Trans.Maybe import Codec.Serialise (deserialiseOrFail) import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy qualified as LBS import Data.Either -import Data.Function -import Data.Functor +-- import Data.Function +-- import Data.Functor import Data.Maybe import Control.Concurrent.STM import Data.HashMap.Strict qualified as HashMap -import Data.HashMap.Strict (HashMap) +-- import Data.HashMap.Strict (HashMap) import Data.List qualified as List import Streaming.Prelude qualified as S -import Streaming qualified as S +-- import Streaming qualified as S data BlobType = Merkle (MTree [HashRef]) | MerkleAnn (MTreeAnn [HashRef]) diff --git a/hbs2-core/lib/HBS2/Data/KeyRing.hs b/hbs2-core/lib/HBS2/Data/KeyRing.hs index 5a797bef..5d83b2cb 100644 --- a/hbs2-core/lib/HBS2/Data/KeyRing.hs +++ b/hbs2-core/lib/HBS2/Data/KeyRing.hs @@ -9,7 +9,6 @@ import System.FilePath import System.Directory import Data.List as L import Data.Maybe -import Data.ByteString.Lazy qualified as LBS import Data.ByteString qualified as BS import Lens.Micro.Platform import UnliftIO @@ -23,7 +22,7 @@ splitPattern fp = (pref, flt) pref = joinPath pref' flt = case flt' of [] -> "*" - xs -> joinPath flt' + _xs -> joinPath flt' (pref', flt') = L.span isNotP (splitDirectories fp) isNotP s = isNothing (find isP s) isP c = c `elem` ("?*" :: [Char]) diff --git a/hbs2-core/lib/HBS2/Data/Types.hs b/hbs2-core/lib/HBS2/Data/Types.hs index 5bcf4798..c3fea402 100644 --- a/hbs2-core/lib/HBS2/Data/Types.hs +++ b/hbs2-core/lib/HBS2/Data/Types.hs @@ -2,7 +2,6 @@ module HBS2.Data.Types ( module X -- , module HBS2.Data.Types.Crypto , AsSyntax(..) - , LoadedRef(..) ) where diff --git a/hbs2-core/lib/HBS2/Data/Types/Peer.hs b/hbs2-core/lib/HBS2/Data/Types/Peer.hs index ebd28b62..45817fd6 100644 --- a/hbs2-core/lib/HBS2/Data/Types/Peer.hs +++ b/hbs2-core/lib/HBS2/Data/Types/Peer.hs @@ -1,14 +1,12 @@ {-# Language UndecidableInstances #-} module HBS2.Data.Types.Peer where -import Codec.Serialise import Data.ByteString qualified as BS import Data.Hashable import Lens.Micro.Platform import HBS2.Prelude import HBS2.Net.Auth.Credentials -import HBS2.Net.Proto.Types type PingSign e = Signature (Encryption e) diff --git a/hbs2-core/lib/HBS2/Data/Types/Refs.hs b/hbs2-core/lib/HBS2/Data/Types/Refs.hs index 969f4c30..4c399f38 100644 --- a/hbs2-core/lib/HBS2/Data/Types/Refs.hs +++ b/hbs2-core/lib/HBS2/Data/Types/Refs.hs @@ -4,7 +4,7 @@ module HBS2.Data.Types.Refs ( module HBS2.Data.Types.Refs , serialise - , pattern HashLike + -- , pattern HashLike ) where import HBS2.Base58 diff --git a/hbs2-core/lib/HBS2/Hash.hs b/hbs2-core/lib/HBS2/Hash.hs index 7b43310b..ca33e549 100644 --- a/hbs2-core/lib/HBS2/Hash.hs +++ b/hbs2-core/lib/HBS2/Hash.hs @@ -16,8 +16,8 @@ import Data.ByteArray qualified as BA import Data.ByteString (ByteString) import Data.ByteString.Char8 qualified as BS8 import Data.ByteString.Lazy qualified as LBS -import Data.ByteString.Short qualified as SB -import Data.ByteString.Short (ShortByteString) +-- import Data.ByteString.Short qualified as SB +-- import Data.ByteString.Short (ShortByteString) import Data.Data import Data.Hashable (Hashable) import Data.Kind @@ -26,7 +26,7 @@ import Data.Text qualified as Text import GHC.Generics import Prettyprinter import Text.InterpolatedString.Perl6 (qc) -import Control.DeepSeq (NFData,force) +import Control.DeepSeq (NFData) data HbSync = HbSync deriving stock (Data) diff --git a/hbs2-core/lib/HBS2/Merkle.hs b/hbs2-core/lib/HBS2/Merkle.hs index 2b851089..8dedf8c6 100644 --- a/hbs2-core/lib/HBS2/Merkle.hs +++ b/hbs2-core/lib/HBS2/Merkle.hs @@ -7,21 +7,18 @@ module HBS2.Merkle where import HBS2.Prelude import HBS2.Hash -import Control.Applicative import Codec.Serialise (serialise, deserialiseOrFail) import Data.ByteString (ByteString) import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS import Data.Data -import Data.Foldable (forM_, traverse_) +import Data.Foldable (traverse_) import Data.List qualified as List -import Data.Text (Text) import Data.Word -import GHC.Generics import Lens.Micro.Platform import Control.Monad.Trans.Maybe import Control.Monad -import Prettyprinter +-- import Prettyprinter @@ -210,7 +207,7 @@ walkMerkle' root flookup sink = go root either (const $ runWithAnnTree hash bs) runWithTree t1 - runWithAnnTree hash bs = do + runWithAnnTree _hash bs = do let t = deserialiseOrFail @(MTreeAnn a) bs case t of Left{} -> pure () diff --git a/hbs2-core/lib/HBS2/Merkle/MetaData.hs b/hbs2-core/lib/HBS2/Merkle/MetaData.hs index 59494f23..a935da13 100644 --- a/hbs2-core/lib/HBS2/Merkle/MetaData.hs +++ b/hbs2-core/lib/HBS2/Merkle/MetaData.hs @@ -16,7 +16,7 @@ import Data.Text.Encoding qualified as TE import Control.Monad.Except import Control.Monad.Trans.Maybe -import UnliftIO +-- import UnliftIO {- HLINT ignore "Functor law" -} diff --git a/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs b/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs index e2135c9d..a0a6ca81 100644 --- a/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs +++ b/hbs2-core/lib/HBS2/Net/Auth/Credentials.hs @@ -201,7 +201,7 @@ instance ( Serialise (PeerCredentials e) ) => Pretty (AsBase58 (PeerCredentials e)) where - pretty (AsBase58 c@(PeerCredentials s p _)) = pretty $ B8.unpack (toBase58 bs) + pretty (AsBase58 c@(PeerCredentials _s _p _)) = pretty $ B8.unpack (toBase58 bs) where bs = LBS.toStrict $ serialise c diff --git a/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs b/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs index 39926589..d7838f0b 100644 --- a/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs +++ b/hbs2-core/lib/HBS2/Net/Auth/Credentials/Sigil.hs @@ -14,7 +14,6 @@ import Crypto.Saltine.Class qualified as Crypto import Crypto.Saltine.Class (IsEncoding(..)) import Control.Monad.Identity import Control.Monad.Trans.Maybe -import Data.ByteString.Char8 (ByteString) import Data.ByteString.Char8 qualified as B8 import Data.ByteString.Lazy.Char8 qualified as LBS import Data.Maybe diff --git a/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs b/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs index d25eb1f1..5247cd8f 100644 --- a/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs +++ b/hbs2-core/lib/HBS2/Net/Auth/GroupKeySymm.hs @@ -23,7 +23,7 @@ import HBS2.Net.Proto.Types import HBS2.Storage hiding (Key) import HBS2.Storage.Operations.Class import HBS2.Storage.Operations.ByteString -import HBS2.Storage(Storage(..)) +-- import HBS2.Storage(Storage(..)) import HBS2.Defaults @@ -56,13 +56,14 @@ import Data.Word (Word64) import Data.ByteArray() import Network.ByteOrder qualified as N import Streaming.Prelude qualified as S -import Lens.Micro.Platform +-- import Lens.Micro.Platform import Data.Coerce -import Data.Typeable (TypeRep, typeRep) -import Type.Reflection (SomeTypeRep(..), someTypeRep) +-- import Data.Typeable (TypeRep, typeRep) +-- import Type.Reflection (SomeTypeRep(..), someTypeRep) +import Type.Reflection () -import Streaming qualified as S -import Streaming (Stream(..), Of(..)) +-- import Streaming qualified as S +import Streaming (Stream, Of(..)) import System.IO.Unsafe (unsafePerformIO) @@ -197,7 +198,7 @@ instance (ForGroupKeySymm s) => Serialise (GroupKey 'Symm s) where let compatEncoded = Serialise.encode compat let version = 2 let ext = (getGroupKeyIdScheme x, getGroupKeyId x, getGroupKeyTimestamp x) - compatEncoded <> Serialise.encode version <> Serialise.encode ext + compatEncoded <> Serialise.encode (version :: Integer) <> Serialise.encode ext decode = do GroupKeySymmV1{..} <- Serialise.decode @(GroupKeySymmV1 s) diff --git a/hbs2-core/lib/HBS2/Net/Auth/Schema.hs b/hbs2-core/lib/HBS2/Net/Auth/Schema.hs index 89c07138..4df89c06 100644 --- a/hbs2-core/lib/HBS2/Net/Auth/Schema.hs +++ b/hbs2-core/lib/HBS2/Net/Auth/Schema.hs @@ -12,8 +12,6 @@ import HBS2.Net.Proto.Types import HBS2.Hash import HBS2.Net.Messaging.Unix -import Data.Config.Suckless - import Data.Word import Crypto.Error import Crypto.PubKey.Ed25519 qualified as Ed diff --git a/hbs2-core/lib/HBS2/Net/IP/Addr.hs b/hbs2-core/lib/HBS2/Net/IP/Addr.hs index 082b71a7..5d9a6098 100644 --- a/hbs2-core/lib/HBS2/Net/IP/Addr.hs +++ b/hbs2-core/lib/HBS2/Net/IP/Addr.hs @@ -16,8 +16,6 @@ import Control.Monad import Control.Monad.Trans.Maybe import Data.Attoparsec.Text as Atto import Data.Char -import Data.Function -import Data.Functor import Data.IP import Data.Maybe import Data.Text qualified as Text @@ -75,9 +73,9 @@ instance FromStringMaybe (IPAddrPort e) where po = snd <$> hp getHostPort :: Text -> Maybe (String, PortNumber) -getHostPort s = parseOnly p s & either (const Nothing) Just +getHostPort s = parseOnly p' s & either (const Nothing) Just where - p = do + p' = do (h, p) <- pAddr <|> tcppAddr pure (Text.unpack h, read (Text.unpack p)) @@ -129,8 +127,8 @@ pIP4 = do hostAddr0 <- replicateM 3 $ do n <- Atto.takeWhile isDigit - dot <- string "." - pure ( n <> dot ) + cdot <- string "." + pure ( n <> cdot ) hostAddr1 <- Atto.takeWhile isDigit @@ -150,6 +148,6 @@ pHostName = do void $ char ':' port <- decimal let host = if Text.null host' then "localhost" else host' - pure (host, Text.pack (show port)) + pure (host, Text.pack (show (port :: Integer))) diff --git a/hbs2-core/lib/HBS2/Net/Messaging/Encrypted/ByPass.hs b/hbs2-core/lib/HBS2/Net/Messaging/Encrypted/ByPass.hs index bbaaa4da..384e2477 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/Encrypted/ByPass.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/Encrypted/ByPass.hs @@ -13,7 +13,6 @@ module HBS2.Net.Messaging.Encrypted.ByPass import HBS2.Prelude import HBS2.Hash -import HBS2.Clock hiding (sec) import HBS2.Net.Messaging import HBS2.Data.Types.SignedBox import HBS2.Net.Auth.Credentials() @@ -40,7 +39,6 @@ import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict qualified as HashMap import Data.HashSet qualified as HashSet import Data.Maybe -import Data.Time.Clock.POSIX import Data.Word import System.Random import System.IO.Unsafe (unsafePerformIO) @@ -317,7 +315,7 @@ instance (ForByPass e, Messaging w e ByteString) when (isNothing mbx) do debug $ "HEY: failed to unbox" <+> pretty heyNonceA <+> pretty orig - n <- toMPlus mbx + _n <- toMPlus mbx (pks, HEYBox t puk) <- toMPlus mbx diff --git a/hbs2-core/lib/HBS2/Net/Messaging/Encrypted/RandomPrefix.hs b/hbs2-core/lib/HBS2/Net/Messaging/Encrypted/RandomPrefix.hs index 682b5ac9..86a1f8bc 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/Encrypted/RandomPrefix.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/Encrypted/RandomPrefix.hs @@ -11,9 +11,9 @@ module HBS2.Net.Messaging.Encrypted.RandomPrefix import Data.Word import Data.Bits -- import Data.ByteString (ByteString) -import Data.ByteString qualified as BS import Data.ByteString.Lazy qualified as LBS import Data.ByteString.Lazy (ByteString) +import Control.Monad import Control.Monad.State import Control.Monad.Trans.Maybe import Data.ByteString.Builder @@ -52,7 +52,7 @@ instance Instruction a => Emittable (Proxy a) where emit _ = word8 . fromIntegral $ natVal (Proxy @(Opcode a)) instance Emittable OP where - emit (OP op arg) = emit op <> emit arg + emit (OP o arg) = emit o <> emit arg emit (BYTE w) = word8 w instance Emittable () where @@ -192,7 +192,7 @@ runCodeLazy s = runState (execStateT (runMaybeT (go s)) Nothing) s put (Just n) pure rest - repeatN bs = do + _repeatN bs = do (n, rest) <- next bs rest' <- replicateM (min 16 (fromIntegral n)) $ do @@ -223,7 +223,7 @@ instance MonadIO m => RandomPrefix PrefixMethod1 m where randomPrefix (PrefixMethod1 k a x) = liftIO do let nums = partsMethod1 k a x - me <- liftIO $ replicateM (length nums) $ randomRIO (0,2) + me <- liftIO $ replicateM (length nums) $ randomRIO (0,2 :: Integer) opcodes <- forM (zip me nums) $ \z@(_, n) -> case fst z of 1 -> do diff --git a/hbs2-core/lib/HBS2/Net/Messaging/Fake.hs b/hbs2-core/lib/HBS2/Net/Messaging/Fake.hs index 5048ad3a..90ddabf0 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/Fake.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/Fake.hs @@ -31,6 +31,8 @@ newFakeP2P :: (Eq (Peer peer), Hashable (Peer peer)) => Bool -> IO (FakeP2P peer newFakeP2P block = FakeP2P block <$> newTVarIO mempty +getChan :: (Hashable (Peer proto)) => + FakeP2P proto msg -> Peer proto -> IO (TChan (From proto, msg)) getChan bus whom = do ch <- newTChanIO atomically $ stateTVar t (alter ch) @@ -45,7 +47,7 @@ instance ( (HasPeer proto, Hashable (Peer proto)) ) => Messaging (FakeP2P proto msg) proto msg where sendTo bus (To whom) who msg = liftIO do - ch <- newTChanIO + _ch <- newTChanIO chan <- getChan bus whom atomically $ Chan.writeTChan chan (who, msg) diff --git a/hbs2-core/lib/HBS2/Net/Messaging/Pipe.hs b/hbs2-core/lib/HBS2/Net/Messaging/Pipe.hs index 4a132315..7f88aca8 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/Pipe.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/Pipe.hs @@ -10,6 +10,7 @@ import HBS2.Actors.Peer.Types import HBS2.Net.Messaging import Control.Concurrent.STM qualified as STM +import Control.Monad.Fix import Control.Monad.Reader import Data.ByteString.Builder qualified as B import Data.ByteString.Lazy (ByteString) @@ -49,7 +50,7 @@ newMessagingPipe (pIn,pOut) = do <$> newTQueueIO instance Hashable PipeAddr where - hashWithSalt salt (PipeAddr pip) = hashWithSalt salt ("pipe-addr", fd) + hashWithSalt salt (PipeAddr pip) = hashWithSalt salt ("pipe-addr" :: String, fd) where fd = unsafePerformIO (handleToFd pip <&> fromIntegral @_ @Word) diff --git a/hbs2-core/lib/HBS2/Net/Messaging/Stream.hs b/hbs2-core/lib/HBS2/Net/Messaging/Stream.hs index 1c12537c..e1e8a762 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/Stream.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/Stream.hs @@ -2,11 +2,9 @@ module HBS2.Net.Messaging.Stream where import HBS2.Prelude.Plated -import Data.Function -import Control.Exception (try,Exception,SomeException,throwIO) +import Control.Exception (Exception,throwIO) import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy qualified as LBS -import Data.Typeable import Network.Socket hiding (listen,connect) import Streaming.Prelude qualified as S import Data.ByteString qualified as BS diff --git a/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs b/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs index 4cbbd56a..2ad678b0 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs @@ -89,8 +89,8 @@ newMessagingTCP pa = liftIO do instance Messaging MessagingTCP L4Proto ByteString where - sendTo bus (To p) (From f) msg = liftIO do - let own = view tcpOwnPeer bus + sendTo bus (To p) (From _f) msg = liftIO do + let _own = view tcpOwnPeer bus co' <- atomically $ readTVar (view tcpPeerConn bus) <&> HashMap.lookup p @@ -369,7 +369,7 @@ runMessagingTCP env = liftIO do now <- getTimeCoarse -- FIXME: time-hardcode-again - let expire = filter (\e -> (realToFrac (toNanoSecs (now - fst e)) / 1e9) < 30) + let expire = filter (\e -> (realToFrac (toNanoSecs (now - fst e)) / (1e9 :: Double)) < 30) atomically $ modifyTVar defs $ HashMap.mapMaybe $ \es -> let rs = expire es diff --git a/hbs2-core/lib/HBS2/Net/Messaging/UDP.hs b/hbs2-core/lib/HBS2/Net/Messaging/UDP.hs index 1cb7f71c..0b7cd883 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/UDP.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/UDP.hs @@ -5,10 +5,10 @@ import HBS2.Clock import HBS2.Defaults import HBS2.Net.IP.Addr import HBS2.Net.Messaging -import HBS2.Net.Proto +-- import HBS2.Net.Proto import HBS2.Prelude.Plated -import HBS2.System.Logger.Simple +-- import HBS2.System.Logger.Simple import Data.Function import Control.Exception @@ -19,7 +19,6 @@ import Control.Concurrent.STM.TQueue qualified as Q0 import Control.Monad import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy qualified as LBS -import Data.Functor import Data.List qualified as L import Data.Maybe -- import Data.Text (Text) @@ -100,7 +99,7 @@ newMessagingUDP reuse saddr = ) where - sorted = L.sortBy ( compare `on` proto) + sorted = L.sortBy ( compare @Integer `on` proto) proto x = case addrAddress x of SockAddrInet{} -> 0 SockAddrInet6{} -> 1 diff --git a/hbs2-core/lib/HBS2/Net/Messaging/Unix.hs b/hbs2-core/lib/HBS2/Net/Messaging/Unix.hs index 7895f509..951c0931 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/Unix.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/Unix.hs @@ -12,11 +12,11 @@ import HBS2.Net.Proto.Types import HBS2.Actors.Peer.Types import HBS2.Net.Messaging import HBS2.Net.Messaging.Stream -import HBS2.Clock import HBS2.System.Logger.Simple import Control.Monad +import Control.Monad.Fix import Control.Monad.Reader hiding (reader) import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy qualified as LBS @@ -34,10 +34,6 @@ import Lens.Micro.Platform import Control.Monad.Trans.Cont import UnliftIO -import Streaming.Prelude qualified as S - -import Control.Concurrent (myThreadId) - data UNIX = UNIX deriving (Eq,Ord,Show,Generic) @@ -170,7 +166,7 @@ runMessagingUnix env = do liftIO $ listen sock 5 forever do - (so, sa) <- liftIO $ accept sock + (so, _sa) <- liftIO $ accept sock withSession $ flip runContT void do @@ -193,7 +189,7 @@ runMessagingUnix env = do msg <- liftIO . atomically $ readTQueue q let len = fromIntegral $ LBS.length msg :: Int - let bs = bytestring32 (fromIntegral len) + let _bs = bytestring32 (fromIntegral len) liftIO $ sendAll so $ bytestring32 (fromIntegral len) @@ -398,7 +394,7 @@ createQueues env who = liftIO do instance Messaging MessagingUnix UNIX ByteString where - sendTo bus (To who) (From me) msg = liftIO do + sendTo bus (To who) (From _me) msg = liftIO do -- createQueues bus who diff --git a/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs b/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs index c96939db..e576abc3 100644 --- a/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs +++ b/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs @@ -1,3 +1,4 @@ +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} module HBS2.Net.PeerLocator.Static ( StaticPeerLocator , newStaticPeerLocator diff --git a/hbs2-core/lib/HBS2/Net/Proto/Notify.hs b/hbs2-core/lib/HBS2/Net/Proto/Notify.hs index 2821c01e..6d73a13d 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Notify.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/Notify.hs @@ -23,7 +23,6 @@ import Control.Concurrent.STM (flushTQueue) import Data.Maybe import Data.Either import UnliftIO -import System.IO (hPrint) instance (HasProtocol UNIX (NotifyProto ev0 UNIX)) => HasTimeLimits UNIX (NotifyProto ev0 UNIX) IO where @@ -165,7 +164,7 @@ runNotifyWorkerServer env = do -- FIXNE: timeout-hardcode let tmo = 60 - let tnano = round $ realToFrac tmo * 1e9 + let tnano = round $ realToFrac tmo * (1e9 :: Double) cleanup <- async $ forever do @@ -324,7 +323,7 @@ makeNotifyClient sink what = do pure w forM_ waiter $ \wa -> do - r <- try @_ @SomeException $ atomically $ writeTQueue wa ha + _r <- try @_ @SomeException $ atomically $ writeTQueue wa ha debug $ "NOTIFY CLIENT SUBSCRIBED" <+> viaShow rn NotifyBye ha -> do diff --git a/hbs2-core/lib/HBS2/Net/Proto/Service.hs b/hbs2-core/lib/HBS2/Net/Proto/Service.hs index 893e68a0..cdd6e825 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Service.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/Service.hs @@ -13,13 +13,14 @@ import HBS2.Net.Proto.Types import HBS2.Prelude.Plated import Codec.Serialise +import Control.Monad import Control.Monad.Reader import Control.Monad.Trans.Resource import Data.ByteString.Lazy (ByteString) import Data.Kind import Data.List qualified as List import GHC.TypeLits -import Lens.Micro.Platform +-- import Lens.Micro.Platform import UnliftIO.Async import UnliftIO qualified as UIO import UnliftIO (TVar,TQueue,atomically) diff --git a/hbs2-core/lib/HBS2/Net/Proto/Sessions.hs b/hbs2-core/lib/HBS2/Net/Proto/Sessions.hs index ffc70fed..d1e1de4a 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Sessions.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/Sessions.hs @@ -1,7 +1,5 @@ module HBS2.Net.Proto.Sessions where -import HBS2.Net.Proto.Types - import Data.Typeable import Data.Dynamic import Data.Hashable @@ -27,7 +25,7 @@ instance Hashable SKey where instance Eq SKey where - (==) (SKey p1 ty1 a) (SKey p2 ty2 b) = ty1 == ty2 && unKey p1 a == unKey p1 b + (==) (SKey p1 ty1 a) (SKey _p2 ty2 b) = ty1 == ty2 && unKey p1 a == unKey p1 b data family SessionKey e p :: Type diff --git a/hbs2-core/lib/HBS2/Net/Proto/Types.hs b/hbs2-core/lib/HBS2/Net/Proto/Types.hs index 994fddbf..ef5f356b 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Types.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/Types.hs @@ -68,7 +68,7 @@ data L4Proto = UDP | TCP deriving stock (Enum,Bounded) instance Hashable L4Proto where - hashWithSalt s l = hashWithSalt s ("l4proto", fromEnum l) + hashWithSalt s l = hashWithSalt s ("l4proto" :: String, fromEnum l) instance Show L4Proto where show UDP = "udp" @@ -177,9 +177,9 @@ instance AddrPriority (Peer L4Proto) where instance Hashable (Peer L4Proto) where hashWithSalt salt p = case _sockAddr p of - SockAddrInet pn h -> hashWithSalt salt (4, fromEnum (_sockType p), fromIntegral pn, h) - SockAddrInet6 pn _ h _ -> hashWithSalt salt (6, fromEnum (_sockType p), fromIntegral pn, h) - SockAddrUnix s -> hashWithSalt salt ("unix", s) + SockAddrInet pn h -> hashWithSalt salt (4 :: Int, fromEnum (_sockType p), fromIntegral pn :: Integer, h) + SockAddrInet6 pn _ h _ -> hashWithSalt salt (6 :: Int, fromEnum (_sockType p), fromIntegral pn :: Integer, h) + SockAddrUnix s -> hashWithSalt salt ("unix" :: String, s) -- FIXME: support-udp-prefix instance Pretty (Peer L4Proto) where diff --git a/hbs2-core/lib/HBS2/Polling.hs b/hbs2-core/lib/HBS2/Polling.hs index a2f318ff..6da532e8 100644 --- a/hbs2-core/lib/HBS2/Polling.hs +++ b/hbs2-core/lib/HBS2/Polling.hs @@ -1,7 +1,6 @@ module HBS2.Polling where import HBS2.Prelude.Plated -import HBS2.Clock import Data.Heap (Entry(..)) import Data.Heap qualified as Heap diff --git a/hbs2-core/lib/HBS2/Prelude.hs b/hbs2-core/lib/HBS2/Prelude.hs index 606d4455..e70a84bc 100644 --- a/hbs2-core/lib/HBS2/Prelude.hs +++ b/hbs2-core/lib/HBS2/Prelude.hs @@ -1,6 +1,7 @@ {-# Language FunctionalDependencies #-} {-# Language PatternSynonyms #-} {-# Language ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} module HBS2.Prelude ( module Data.String , module Safe @@ -37,6 +38,9 @@ import GHC.Generics as X (Generic) import Data.ByteString (ByteString) import Data.String (IsString(..)) import Safe +import Control.Monad as X +import Control.Monad.Fix as X +import Control.Monad.Trans (lift) import Control.Monad.Trans.Maybe diff --git a/hbs2-core/lib/HBS2/Prelude/Plated.hs b/hbs2-core/lib/HBS2/Prelude/Plated.hs index c672a44a..4618c1af 100644 --- a/hbs2-core/lib/HBS2/Prelude/Plated.hs +++ b/hbs2-core/lib/HBS2/Prelude/Plated.hs @@ -3,7 +3,6 @@ module HBS2.Prelude.Plated , module HBS2.Prelude , module Data.Data , module Data.Generics.Uniplate.Operations - , Generic ) where import Data.Data diff --git a/hbs2-core/lib/HBS2/ScheduledAction.hs b/hbs2-core/lib/HBS2/ScheduledAction.hs index 66e275bb..91a180a1 100644 --- a/hbs2-core/lib/HBS2/ScheduledAction.hs +++ b/hbs2-core/lib/HBS2/ScheduledAction.hs @@ -8,7 +8,6 @@ module HBS2.ScheduledAction ) where import HBS2.Prelude.Plated -import HBS2.Clock import Prelude hiding (all) import Data.Word @@ -54,15 +53,15 @@ runScheduled :: MonadUnliftIO m => Scheduled -> m () runScheduled sch = forever do pause (view scheduleRunPeriod sch) - now <- getTimeCoarse <&> toNanoSecs <&> (/1e9) . realToFrac <&> round + now <- getTimeCoarse <&> toNanoSecs <&> (/ (1e9 :: Double)) . realToFrac <&> round - expired <- atomically do + expireds <- atomically do all <- readTVar (slots sch) <&> HashMap.toList - let (rest, expired) = List.partition ( (>now) . fst) all + let (rest, expireds) = List.partition ( (>now) . fst) all writeTVar (slots sch) (HashMap.fromList rest) - pure expired + pure expireds - for_ expired $ \(_, all) -> do + for_ expireds $ \(_, all) -> do for_ all $ \action -> do -- TODO: error-logging-maybe liftIO $ void $ action `E.catch` (\(_ :: E.ArithException) -> pure ()) @@ -71,7 +70,7 @@ runScheduled sch = forever do schedule :: forall a m . (MonadUnliftIO m, Integral a) => Scheduled -> a -> IO () -> m () schedule s ttl what = do - now <- getTimeCoarse <&> toNanoSecs <&> (/1e9) . realToFrac <&> round + now <- getTimeCoarse <&> toNanoSecs <&> (/ (1e9 :: Double)) . realToFrac <&> round let slot = now + fromIntegral ttl atomically $ modifyTVar (slots s) (HashMap.insertWith (<>) slot [what]) diff --git a/hbs2-core/lib/HBS2/Storage/Operations/ByteString.hs b/hbs2-core/lib/HBS2/Storage/Operations/ByteString.hs index 72499737..88ec467a 100644 --- a/hbs2-core/lib/HBS2/Storage/Operations/ByteString.hs +++ b/hbs2-core/lib/HBS2/Storage/Operations/ByteString.hs @@ -17,12 +17,11 @@ import HBS2.Storage.Operations.Class import HBS2.Defaults import Streaming.Prelude qualified as S -import Streaming qualified as S import Data.Function +import Control.Monad import Control.Monad.Except import Control.Exception -import Data.Bifunctor import Data.ByteString.Lazy (ByteString) import Data.ByteString.Lazy qualified as LBS -- hbs2-core/lib/HBS2/Net/Auth/Credentials.hs diff --git a/hbs2-core/lib/HBS2/Storage/Operations/Missed.hs b/hbs2-core/lib/HBS2/Storage/Operations/Missed.hs index 5a9899f1..b8fae40b 100644 --- a/hbs2-core/lib/HBS2/Storage/Operations/Missed.hs +++ b/hbs2-core/lib/HBS2/Storage/Operations/Missed.hs @@ -7,10 +7,10 @@ import HBS2.Hash import HBS2.Merkle import HBS2.Storage -import HBS2.System.Logger.Simple +-- import HBS2.System.Logger.Simple import Streaming.Prelude qualified as S -import Streaming.Prelude (Stream(..), Of(..)) +import Streaming.Prelude (Stream, Of(..)) import Control.Monad.Trans.Maybe import Control.Monad import Data.Maybe diff --git a/hbs2-core/lib/HBS2/System/Logger/Simple.hs b/hbs2-core/lib/HBS2/System/Logger/Simple.hs index a6c8623f..10268bc0 100644 --- a/hbs2-core/lib/HBS2/System/Logger/Simple.hs +++ b/hbs2-core/lib/HBS2/System/Logger/Simple.hs @@ -41,8 +41,6 @@ import Data.Map (Map) import Data.Map.Strict qualified as Map import Control.Concurrent.STM -import Prettyprinter.Render.Terminal - data LoggerType = LoggerStdout | LoggerStderr | LoggerFile FilePath diff --git a/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs b/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs index 9208e542..967074f5 100644 --- a/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs +++ b/hbs2-keyman/hbs2-keyman-direct-lib/HBS2/KeyMan/Keys/Direct.hs @@ -13,6 +13,7 @@ import HBS2.Net.Auth.GroupKeySymm as Symm import HBS2.System.Dir +import Control.Monad import Control.Monad.Cont import DBPipe.SQLite import Text.InterpolatedString.Perl6 (qc) diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index 7b12dfd4..29686bd1 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -122,6 +122,7 @@ import Control.Monad.Trans.Resource import Streaming.Prelude qualified as S import Graphics.Vty qualified as Vty +import Graphics.Vty.Platform.Unix qualified as Vty data GoAgainException = GoAgainException deriving (Eq,Ord,Show,Typeable) @@ -342,7 +343,7 @@ runCLI = do liftIO do when pro $ flip runContT pure do - cfg <- liftIO $ Vty.standardIOConfig + cfg <- pure $ Vty.defaultConfig vty <- ContT $ bracket (Vty.mkVty cfg) Vty.shutdown fix \next -> do diff --git a/hbs2-peer/hbs2-peer.cabal b/hbs2-peer/hbs2-peer.cabal index 01d83c2c..d23c9983 100644 --- a/hbs2-peer/hbs2-peer.cabal +++ b/hbs2-peer/hbs2-peer.cabal @@ -286,6 +286,7 @@ executable hbs2-peer -- other-extensions: build-depends: base, hbs2-peer, hbs2-keyman-direct-lib, vty + , vty-unix hs-source-dirs: app diff --git a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/RefChanUpdate.hs b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/RefChanUpdate.hs index b6d8cfb6..0d693a6a 100644 --- a/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/RefChanUpdate.hs +++ b/hbs2-peer/lib/HBS2/Peer/Proto/RefChan/RefChanUpdate.hs @@ -27,6 +27,8 @@ import HBS2.Peer.Proto.RefChan.Types import HBS2.System.Logger.Simple import Codec.Serialise +import Control.Monad +import Control.Monad.Fix import Control.Monad.Identity import Control.Monad.Trans.Maybe import Data.ByteString (ByteString) diff --git a/hbs2-peer/lib/HBS2/Peer/RPC/Internal/Types.hs b/hbs2-peer/lib/HBS2/Peer/RPC/Internal/Types.hs index d67e0608..f35a6cee 100644 --- a/hbs2-peer/lib/HBS2/Peer/RPC/Internal/Types.hs +++ b/hbs2-peer/lib/HBS2/Peer/RPC/Internal/Types.hs @@ -20,6 +20,7 @@ import Data.Config.Suckless.Syntax import Data.Config.Suckless.Parse import Data.Kind +import Control.Monad import Control.Monad.Reader import Data.ByteString ( ByteString ) import UnliftIO diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Compact.hs b/hbs2-storage-simple/lib/HBS2/Storage/Compact.hs index 049308f2..8411566e 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Compact.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Compact.hs @@ -51,7 +51,9 @@ import Data.Vector qualified as V import Codec.Serialise import GHC.Generics import Lens.Micro.Platform +import Control.Monad import Control.Monad.Except +import Control.Monad.Trans import Control.Monad.Trans.Maybe import UnliftIO diff --git a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs index 465ab86b..d3b68e0e 100644 --- a/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs +++ b/hbs2-storage-simple/lib/HBS2/Storage/Simple.hs @@ -19,6 +19,7 @@ import HBS2.System.Logger.Simple import Control.Concurrent.Async import Control.Exception import Control.Monad +import Control.Monad.Fix import Control.Monad.Except import Control.Monad.Trans.Maybe import Data.ByteString.Lazy qualified as LBS