diff options
| -rw-r--r-- | third_party/overlays/haskell/default.nix | 1 | ||||
| -rw-r--r-- | third_party/overlays/haskell/extra-pkgs/pa-run-command-0.1.0.0.nix | 25 | ||||
| -rw-r--r-- | users/Profpatsch/shell.nix | 1 | ||||
| -rw-r--r-- | users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs | 29 | ||||
| -rw-r--r-- | users/Profpatsch/whatcd-resolver/whatcd-resolver.cabal | 1 |
5 files changed, 57 insertions, 0 deletions
diff --git a/third_party/overlays/haskell/default.nix b/third_party/overlays/haskell/default.nix index 9282d63414..09b256bbb9 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 0000000000..b12eb5efbf --- /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 ea88c423cb..789f991ffa 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 6fe8f8c77f..0628b9b9ea 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 6d8fd5bd52..b52ee0b15a 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, |