From 98e38339f2b753f5d19ec9ba84b095a189f97e84 Mon Sep 17 00:00:00 2001
From: Profpatsch <mail@profpatsch.de>
Date: Tue, 20 Jun 2023 00:22:14 +0200
Subject: feat(users/Profpatsch/whatcd-resolver): add initial redacted API

Change-Id: I3143a932646d61b7661df4e4da4edf24a360f6cc
Reviewed-on: https://cl.tvl.fyi/c/depot/+/8833
Reviewed-by: Profpatsch <mail@profpatsch.de>
Tested-by: BuildkiteCI
---
 third_party/overlays/haskell/default.nix           |  1 +
 .../haskell/extra-pkgs/pa-run-command-0.1.0.0.nix  | 25 +++++++++++++++++++
 users/Profpatsch/shell.nix                         |  1 +
 .../whatcd-resolver/src/WhatcdResolver.hs          | 29 ++++++++++++++++++++++
 .../whatcd-resolver/whatcd-resolver.cabal          |  1 +
 5 files changed, 57 insertions(+)
 create mode 100644 third_party/overlays/haskell/extra-pkgs/pa-run-command-0.1.0.0.nix

diff --git a/third_party/overlays/haskell/default.nix b/third_party/overlays/haskell/default.nix
index 9282d634143c..09b256bbb9ee 100644
--- a/third_party/overlays/haskell/default.nix
+++ b/third_party/overlays/haskell/default.nix
@@ -36,6 +36,7 @@ in
       pa-label = hsSelf.callPackage ./extra-pkgs/pa-label-0.1.0.1.nix { };
       pa-pretty = hsSelf.callPackage ./extra-pkgs/pa-pretty-0.1.1.0.nix { };
       pa-json = hsSelf.callPackage ./extra-pkgs/pa-json-0.2.0.0.nix { };
+      pa-run-command = hsSelf.callPackage ./extra-pkgs/pa-run-command-0.1.0.0.nix { };
     };
   };
 
diff --git a/third_party/overlays/haskell/extra-pkgs/pa-run-command-0.1.0.0.nix b/third_party/overlays/haskell/extra-pkgs/pa-run-command-0.1.0.0.nix
new file mode 100644
index 000000000000..b12eb5efbf5f
--- /dev/null
+++ b/third_party/overlays/haskell/extra-pkgs/pa-run-command-0.1.0.0.nix
@@ -0,0 +1,25 @@
+{ mkDerivation
+, base
+, bytestring
+, lib
+, monad-logger
+, pa-prelude
+, text
+, typed-process
+}:
+mkDerivation {
+  pname = "pa-run-command";
+  version = "0.1.0.0";
+  sha256 = "37837e0cddedc9b615063f0357115739c53b5dcb8af82ce86a95a3a5c88c29a3";
+  libraryHaskellDepends = [
+    base
+    bytestring
+    monad-logger
+    pa-prelude
+    text
+    typed-process
+  ];
+  homepage = "https://github.com/possehl-analytics/pa-hackage";
+  description = "Helper functions for spawning subprocesses";
+  license = lib.licenses.bsd3;
+}
diff --git a/users/Profpatsch/shell.nix b/users/Profpatsch/shell.nix
index ea88c423cb0f..789f991ffab8 100644
--- a/users/Profpatsch/shell.nix
+++ b/users/Profpatsch/shell.nix
@@ -20,6 +20,7 @@ pkgs.mkShell {
       h.pa-label
       h.pa-json
       h.pa-pretty
+      h.pa-run-command
       h.ihp-hsx
       h.PyF
       h.foldl
diff --git a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
index 6fe8f8c77f6c..0628b9b9ea81 100644
--- a/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
+++ b/users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs
@@ -16,6 +16,7 @@ import Data.Map.Strict qualified as Map
 import Data.Pool (Pool)
 import Data.Pool qualified as Pool
 import Data.Text qualified as Text
+import Data.Text.IO qualified as Text
 import Database.PostgreSQL.Simple qualified as Postgres
 import Database.PostgreSQL.Simple.Types qualified as Postgres
 import Database.Postgres.Temp qualified as TmpPg
@@ -24,12 +25,14 @@ import Json qualified
 import Json.Enc (Enc)
 import Json.Enc qualified as Enc
 import Label
+import Network.HTTP.Conduit qualified as Http
 import Network.HTTP.Simple qualified as Http
 import Network.HTTP.Types
 import PossehlAnalyticsPrelude
 import Postgres.Decoder qualified as Dec
 import Postgres.MonadPostgres
 import Pretty
+import RunCommand
 import System.Directory qualified as Dir
 import System.Directory qualified as Xdg
 import System.FilePath ((</>))
@@ -129,6 +132,32 @@ doTransmissionRequest dat req = do
           Left err -> appThrowTree err
     _ -> liftIO $ unwrapIOError $ Left [fmt|Non-200 response: {showPretty resp}|]
 
+redactedSearch advanced = redactedApiRequest (T2 (label @"action" "browse") (label @"actionArgs" ((advanced <&> second Just))))
+
+test =
+  runAppWith $
+    redactedSearch
+      [ ("artistname", "michael jackson"),
+        ("year", "1982"),
+        ("format", "MP3"),
+        ("releasetype", "album"),
+        ("order_by", "year")
+      ]
+      <&> (fmap $ fromMaybe undefined)
+      <&> (Http.getResponseBody)
+      <&> showPrettyJson
+      >>= liftIO . Text.putStrLn
+
+redactedApiRequest dat = do
+  authKey <- runCommandExpect0 "pass" ["internet/redacted/api-keys/whatcd-resolver"]
+  let req =
+        [fmt|https://redacted.ch/ajax.php|]
+          & Http.setRequestMethod "GET"
+          & Http.setQueryString (("action", Just dat.action) : dat.actionArgs)
+          & Http.setRequestHeader "Authorization" [authKey]
+  Http.httpBS req
+    <&> fmap (Json.decodeStrict' @Json.Value)
+
 runAppWith :: AppT IO a -> IO (Either TmpPg.StartError a)
 runAppWith appT = withDb $ \db -> do
   tools <- initMonadTools (label @"envvar" "WHATCD_RESOLVER_TOOLS")
diff --git a/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal b/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal
index 6d8fd5bd52f8..b52ee0b15a15 100644
--- a/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal
+++ b/users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal
@@ -71,6 +71,7 @@ library
         pa-label,
         pa-json,
         pa-field-parser,
+        pa-run-command,
         containers,
         pa-pretty,
         tmp-postgres,
-- 
cgit 1.4.1