feat(users/Profpatsch/whatcd-resolver): read redacted key from env

Change-Id: I5667710423aeeacfbb8dddf5b0b8750dc8f878aa
Reviewed-on: https://cl.tvl.fyi/c/depot/+/12055
Tested-by: BuildkiteCI
Reviewed-by: Profpatsch <mail@profpatsch.de>

users/Profpatsch/whatcd-resolver/src/AppT.hs

@@ -12,6 +12,8 @@ import Data.Pool (Pool)
 import Data.Text qualified as Text
 import Database.PostgreSQL.Simple qualified as Postgres
 import GHC.Stack qualified
+import Json.Enc
+import Json.Enc qualified as Enc
 import Label
 import OpenTelemetry.Trace qualified as Otel hiding (getTracer, inSpan, inSpan')
 import OpenTelemetry.Trace.Core qualified as Otel hiding (inSpan, inSpan')
@@ -27,7 +29,8 @@ data Context = Context
     tracer :: Otel.Tracer,
     pgFormat :: PgFormatPool,
     pgConnPool :: Pool Postgres.Connection,
-    transmissionSessionId :: IORef (Maybe ByteString)
+    transmissionSessionId :: IORef (Maybe ByteString),
+    redactedApiKey :: ByteString
   }
 
 newtype AppT m a = AppT {unAppT :: ReaderT Context m a}
@@ -67,6 +70,15 @@ addAttribute span key a = Otel.addAttribute span ("_." <> key) a
 addAttributes :: (MonadIO m) => Otel.Span -> HashMap Text Otel.Attribute -> m ()
 addAttributes span attrs = Otel.addAttributes span $ attrs & HashMap.mapKeys ("_." <>)
 
+-- | Create an otel attribute from a json encoder
+jsonAttribute :: Enc -> Otel.Attribute
+jsonAttribute e = e & Enc.encToTextPretty & Otel.toAttribute
+
+orThrowAppErrorNewSpan :: (MonadThrow m, MonadOtel m) => Text -> Either ErrorTree a -> m a
+orThrowAppErrorNewSpan msg = \case
+  Left err -> appThrowTreeNewSpan msg err
+  Right a -> pure a
+
 appThrowTreeNewSpan :: (MonadThrow m, MonadOtel m) => Text -> ErrorTree -> m a
 appThrowTreeNewSpan spanName exc = inSpan' spanName $ \span -> do
   let msg = prettyErrorTree exc
@@ -127,7 +139,7 @@ recordException span dat = liftIO $ do
           HashMap.fromList
             [ ("exception.type", Otel.toAttribute @Text dat.type_),
               ("exception.message", Otel.toAttribute @Text dat.message),
-              ("exception.stacktrace", Otel.toAttribute @Text $ Text.unlines $ map stringToText callStack)
+              ("exception.stacktrace", Otel.toAttribute @Text $ Text.unlines $ Prelude.map stringToText callStack)
             ],
         ..
       }

users/Profpatsch/whatcd-resolver/src/Redacted.hs

@@ -27,11 +27,16 @@ import Optional
 import Postgres.Decoder qualified as Dec
 import Postgres.MonadPostgres
 import Pretty
-import RunCommand (runCommandExpect0)
 import Prelude hiding (span)
 
+class MonadRedacted m where
+  getRedactedApiKey :: m ByteString
+
+instance (MonadIO m) => MonadRedacted (AppT m) where
+  getRedactedApiKey = AppT (asks (.redactedApiKey))
+
 redactedSearch ::
-  (MonadLogger m, MonadThrow m, MonadOtel m) =>
+  (MonadThrow m, MonadOtel m, MonadRedacted m) =>
   [(ByteString, ByteString)] ->
   Json.Parse ErrorTree a ->
   m a
@@ -48,7 +53,8 @@ redactedGetTorrentFile ::
   ( MonadLogger m,
     MonadThrow m,
     HasField "torrentId" dat Int,
-    MonadOtel m
+    MonadOtel m,
+    MonadRedacted m
   ) =>
   dat ->
   m ByteString
@@ -71,7 +77,7 @@ redactedGetTorrentFile dat = inSpan' "Redacted Get Torrent File" $ \span -> do
 mkRedactedTorrentLink :: Arg "torrentGroupId" Int -> Text
 mkRedactedTorrentLink torrentId = [fmt|https://redacted.ch/torrents.php?id={torrentId.unArg}|]
 
-exampleSearch :: (MonadThrow m, MonadLogger m, MonadPostgres m, MonadOtel m) => m (Transaction m ())
+exampleSearch :: (MonadThrow m, MonadLogger m, MonadPostgres m, MonadOtel m, MonadRedacted m) => m (Transaction m ())
 exampleSearch = do
   t1 <-
     redactedSearchAndInsert
@@ -108,7 +114,8 @@ redactedSearchAndInsert ::
   ( MonadLogger m,
     MonadPostgres m,
     MonadThrow m,
-    MonadOtel m
+    MonadOtel m,
+    MonadRedacted m
   ) =>
   [(ByteString, ByteString)] ->
   m (Transaction m ())
@@ -289,12 +296,13 @@ redactedGetTorrentFileAndInsert ::
     MonadPostgres m,
     MonadThrow m,
     MonadLogger m,
-    MonadOtel m
+    MonadOtel m,
+    MonadRedacted m
   ) =>
   r ->
   Transaction m (Label "torrentFile" ByteString)
 redactedGetTorrentFileAndInsert dat = inSpan' "Redacted Get Torrent File and Insert" $ \span -> do
-  bytes <- redactedGetTorrentFile dat
+  bytes <- lift $ redactedGetTorrentFile dat
   execute
     [sql|
     UPDATE redacted.torrents_json
@@ -468,15 +476,14 @@ getBestTorrents opts = do
 -- | Do a request to the redacted API. If you know what that is, you know how to find the API docs.
 mkRedactedApiRequest ::
   ( MonadThrow m,
-    MonadIO m,
-    MonadLogger m,
     HasField "action" p ByteString,
-    HasField "actionArgs" p [(ByteString, Maybe ByteString)]
+    HasField "actionArgs" p [(ByteString, Maybe ByteString)],
+    MonadRedacted m
   ) =>
   p ->
   m Http.Request
 mkRedactedApiRequest dat = do
-  authKey <- runCommandExpect0 "pass" ["internet/redacted/api-keys/whatcd-resolver"]
+  authKey <- getRedactedApiKey
   pure $
     [fmt|https://redacted.ch/ajax.php|]
       & Http.setRequestMethod "GET"
@@ -558,10 +565,10 @@ httpJson opts parser req = inSpan' "HTTP Request (JSON)" $ \span -> do
 
 redactedApiRequestJson ::
   ( MonadThrow m,
-    MonadLogger m,
     HasField "action" p ByteString,
     HasField "actionArgs" p [(ByteString, Maybe ByteString)],
-    MonadOtel m
+    MonadOtel m,
+    MonadRedacted m
   ) =>
   p ->
   Json.Parse ErrorTree a ->

users/Profpatsch/whatcd-resolver/src/WhatcdResolver.hs

@@ -11,7 +11,7 @@ import Control.Monad.Reader
 import Data.Aeson qualified as Json
 import Data.Aeson.BetterErrors qualified as Json
 import Data.Aeson.KeyMap qualified as KeyMap
-import Data.Error.Tree (prettyErrorTree)
+import Data.Error.Tree
 import Data.HashMap.Strict qualified as HashMap
 import Data.List qualified as List
 import Data.Map.Strict qualified as Map
@@ -52,6 +52,7 @@ import Postgres.Decoder qualified as Dec
 import Postgres.MonadPostgres
 import Pretty
 import Redacted
+import RunCommand (runCommandExpect0)
 import System.Directory qualified as Dir
 import System.Directory qualified as Xdg
 import System.Environment qualified as Env
@@ -469,7 +470,8 @@ snipsRedactedSearch ::
     HasField "searchstr" r ByteString,
     MonadThrow m,
     MonadTransmission m,
-    MonadOtel m
+    MonadOtel m,
+    MonadRedacted m
   ) =>
   r ->
   m Html
@@ -758,6 +760,12 @@ runAppWith appT = withTracer $ \tracer -> withDb $ \db -> do
         {- unusedResourceOpenTime -} 10
         {- max resources across all stripes -} 20
   transmissionSessionId <- newIORef Nothing
+  redactedApiKey <-
+    Env.lookupEnv "WHATCD_RESOLVER_REDACTED_API_KEY" >>= \case
+      Just k -> pure (k & stringToBytesUtf8)
+      Nothing -> runStderrLoggingT $ do
+        logInfo "WHATCD_RESOLVER_REDACTED_API_KEY was not set, trying pass"
+        runCommandExpect0 "pass" ["internet/redacted/api-keys/whatcd-resolver"]
   let newAppT = do
         logInfo [fmt|Running with config: {showPretty config}|]
         logInfo [fmt|Connected to database at {db & TmpPg.toDataDirectory} on socket {db & TmpPg.toConnectionString}|]