下载 Bilibili 音频

biliaudio.hs

#!/usr/bin/env cabal
{- cabal:
build-depends: base, relude, aeson, microlens-aeson, microlens-platform, http-conduit, conduit, conduit-extra, async
-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Main where

import Control.Concurrent.Async
import qualified Data.Aeson as A
import Data.Conduit
import Data.Conduit.Binary
import Lens.Micro.Aeson
import Lens.Micro.Platform
import Network.HTTP.Simple
import Relude

main = do
  let audioID = "832257"
  concurrently_ (downloadCover audioID) (downloadAudio audioID)
  where
    downloadCover audioID = do
      info <- getJSON "https://www.bilibili.com/audio/music-service-c/web/song/info" audioID
      let Just coverURL = info ^? key "data" . key "cover" . _String
      download coverURL "/tmp/cover.jpg"
      putTextLn "Cover downloaded!"

    downloadAudio audioID = do
      info <- getJSON "https://www.bilibili.com/audio/music-service-c/web/url" audioID
      let Just audioURL = info ^? key "data" . key "cdns" . _Array . ix 0 . _String
      download audioURL "/tmp/audio.m4a"
      putTextLn "Audio downloaded!"

getJSON :: Text -> Text -> IO A.Value
getJSON url audioID = do
  req <- parseRequestThrow (toString (url <> "?sid=" <> audioID))
  res <- httpJSON req
  pure $ getResponseBody res

download :: Text -> Text -> IO ()
download url path = do
  req <- parseRequestThrow (toString url)
  let addHeaders =
        setRequestHeaders
          [ ("User-Agent", "Mozilla/5.0 (Macintosh; Intel Mac OS X 10.15; rv:99.0) Gecko/20100101 Firefox/99.0"),
            ("Accept-Encoding", "identity"),
            ("Referer", "https://www.bilibili.com")
          ]
  runConduitRes $
    httpSource (addHeaders req) getResponseBody
      .| sinkFile (toString path)