feat(users/Profpatsch/whatcd-resolver): serve torrent files

We want to be able to play the files directly from the web
browser (jukebox).

Luckily, transmission does not seem to change the filenames from the
ones given by the torrent file, so we can literally parse the torrent
file and construct a path to the media file, extraordinary.

Adjusts the caddy reverse proxy to serve the given transmission
directory (using my weird sshfs forwarding scheme in the shell.nix
preset lol), then redirect from a handler that maps from
torrentId/fileId to the actual file.

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

users/Profpatsch/my-prelude/src/MyPrelude.hs

@@ -120,6 +120,7 @@ module MyPrelude
     zipWith3NonEmpty,
     zip4NonEmpty,
     toList,
+    atMay,
     lengthNatural,
     maximum1,
     minimum1,
@@ -236,6 +237,7 @@ import Data.Text.Lazy.Encoding qualified
 import Data.These (These (That, These, This))
 import Data.Traversable (for)
 import Data.Vector (Vector)
+import Data.Vector qualified as Vector
 import Data.Void (Void, absurd)
 import Data.Word (Word8)
 import Divisive
@@ -452,13 +454,26 @@ zip4NonEmpty ~(a :| as) ~(b :| bs) ~(c :| cs) ~(d :| ds) = (a, b, c, d) :| zip4
 
 -- | We don’t want to use Foldable’s `length`, because it is too polymorphic and can lead to bugs.
 -- Only list-y things should have a length.
-class (Foldable f) => Lengthy f
+class (Foldable f) => Lengthy f where
+  atMay :: Natural -> f a -> Maybe a
+  atMay = atMayDefault (\idx' xs -> xs & toList & (!! idx'))
+  {-# INLINE atMay #-}
+
+atMayDefault :: (Lengthy f) => (Int -> f a -> a) -> Natural -> f a -> Maybe a
+atMayDefault lookupF idx f = do
+  let midx = integerToBounded @Int (idx & naturalToInteger)
+  if
+    | idx >= lengthNatural f -> Nothing
+    | Nothing <- midx -> Nothing
+    | Just idx' <- midx -> f & lookupF idx' & Just
+{-# INLINE atMayDefault #-}
 
 instance Lengthy []
 
 instance Lengthy NonEmpty
 
-instance Lengthy Vector
+instance Lengthy Vector where
+  atMay = atMayDefault (\idx' xs -> xs & (Vector.! idx'))
 
 lengthNatural :: (Lengthy f) => f a -> Natural
 lengthNatural xs =

users/Profpatsch/my-prelude/src/Postgres/Decoder.hs

@@ -12,6 +12,7 @@ import FieldParser (FieldParser)
 import FieldParser qualified as Field
 import Json qualified
 import Label
+import Parse (Parse, runParse)
 import PossehlAnalyticsPrelude
 
 -- | A Decoder of postgres values. Allows embedding more complex parsers (like a 'Json.ParseT').
@@ -36,21 +37,21 @@ textMay = fromField @(Maybe Text)
 
 -- | Parse a `text` field, and then use a 'FieldParser' to convert the result further.
 textParse :: (Typeable to) => FieldParser Text to -> Decoder to
-textParse = parse @Text
+textParse = parseField @Text
 
 -- | Parse a nullable `text` field, and then use a 'FieldParser' to convert the result further.
 textParseMay :: (Typeable to) => FieldParser Text to -> Decoder (Maybe to)
-textParseMay = parseMay @Text
+textParseMay = parseFieldMay @Text
 
 -- | Parse a type implementing 'FromField', and then use a 'FieldParser' to convert the result further.
-parse ::
+parseField ::
   forall from to.
   ( PG.FromField from,
     Typeable to
   ) =>
   FieldParser from to ->
   Decoder to
-parse parser = Decoder $ PG.fieldWith $ \field bytes -> do
+parseField parser = Decoder $ PG.fieldWith $ \field bytes -> do
   val <- PG.fromField @from field bytes
   case Field.runFieldParser parser val of
     Left err ->
@@ -61,14 +62,14 @@ parse parser = Decoder $ PG.fieldWith $ \field bytes -> do
     Right a -> pure a
 
 -- | Parse a nullable type implementing 'FromField', and then use a 'FieldParser' to convert the result further.
-parseMay ::
+parseFieldMay ::
   forall from to.
   ( PG.FromField from,
     Typeable to
   ) =>
   FieldParser from to ->
   Decoder (Maybe to)
-parseMay parser = Decoder $ PG.fieldWith $ \field bytes -> do
+parseFieldMay parser = Decoder $ PG.fieldWith $ \field bytes -> do
   val <- PG.fromField @(Maybe from) field bytes
   case Field.runFieldParser parser <$> val of
     Nothing -> pure Nothing
@@ -79,6 +80,43 @@ parseMay parser = Decoder $ PG.fieldWith $ \field bytes -> do
         (err & prettyError & textToString)
     Just (Right a) -> pure (Just a)
 
+-- | Parse a type implementing 'FromField', and then use a 'Parse' to convert the result further.
+parse ::
+  forall from to.
+  ( PG.FromField from,
+    Typeable to
+  ) =>
+  Parse from to ->
+  Decoder to
+parse parser = Decoder $ PG.fieldWith $ \field bytes -> do
+  val <- PG.fromField @from field bytes
+  case Parse.runParse "Cannot parse field" parser val of
+    Left err ->
+      PG.returnError
+        PG.ConversionFailed
+        field
+        (err & prettyErrorTree & textToString)
+    Right a -> pure a
+
+-- | Parse a nullable type implementing 'FromField', and then use a 'Parse' to convert the result further.
+parseMay ::
+  forall from to.
+  ( PG.FromField from,
+    Typeable to
+  ) =>
+  Parse from to ->
+  Decoder (Maybe to)
+parseMay parser = Decoder $ PG.fieldWith $ \field bytes -> do
+  val <- PG.fromField @(Maybe from) field bytes
+  case Parse.runParse "Cannot parse field" parser <$> val of
+    Nothing -> pure Nothing
+    Just (Left err) ->
+      PG.returnError
+        PG.ConversionFailed
+        field
+        (err & prettyErrorTree & textToString)
+    Just (Right a) -> pure (Just a)
+
 -- | Turn any type that implements 'PG.fromField' into a 'Decoder'. Use type applications to prevent accidental conversions:
 --
 -- @