返回提交历史
Modified
docs/misc/sign/wbi.md
+127
-1
XFEstudio/bilibili-API-collect
feat(misc/sign/wbi.md): haskell demo
ad1d2dd
代码差异
1 个文件
+127
-1
@@ -121,7 +121,7 @@
121
121
122
122
## Demo
123
123
124
含 [Python](#Python)、[JavaScript](#JavaScript)、[Golang](#Golang)、[C#](#CSharp)、[Java](#Java)、[Kotlin](#Kotlin)、[Swift](#Swift)、[C++](#CPlusPlus)、[Rust](#Rust) 语言编写的 Demo 。
124
含 [Python](#python)、[JavaScript](#javascript)、[Golang](#golang)、[C#](#csharp)、[Java](#java)、[Kotlin](#kotlin)、[Swift](#swift)、[C++](#cplusplus)、[Rust](#rust)、[Haskell](#haskell) 语言编写的 Demo 。
125
125
126
126
### Python
127
127
@@ -1341,3 +1341,129 @@ int main() {
1341
1341
```text
1342
1342
avid=1755630705&cid=1574294582&fnval=4048&fnver=0&fourk=1&qn=32&wts=1717922933&w_rid=43571b838a1611fa121189083cfc1784
1343
1343
```
1344
1345
### Haskell
1346
1347
无第三方依赖: `base`, `Cabal-syntax`, `bytestring`, `containers`<br />
1348
注: 此处使用自写的 URI 编码模块, 实际可用别的第三方库替代
1349
1350
`Main.hs`:
1351
```hs
1352
module Main (wbi, main) where
1353
1354
import Data.ByteString.Char8 (pack)
1355
import qualified Data.Map.Strict as Map
1356
import Distribution.Utils.MD5 (md5, showMD5)
1357
import URIEncoder (encodeURIComponent)
1358
1359
mixinKeyEncTab :: [Int]
1360
mixinKeyEncTab = [
1361
46, 47, 18, 2, 53, 8, 23, 32, 15, 50, 10, 31, 58, 3, 45, 35, 27, 43, 5, 49,
1362
33, 9, 42, 19, 29, 28, 14, 39, 12, 38, 41, 13, 37, 48, 7, 16, 24, 55, 40,
1363
61, 26, 17, 0, 1, 60, 51, 30, 4, 22, 25, 54, 21, 56, 59, 6, 63, 57, 62, 11,
1364
36, 20, 34, 44, 52
1365
]
1366
1367
getMixinKey :: String -> String -> String
1368
getMixinKey imgKey subKey =
1369
let s = imgKey ++ subKey
1370
in map (\i -> s !! (mixinKeyEncTab !! i)) [0..31]
1371
1372
join :: [String] -> String -> String
1373
join arr ins = concatMap (++ ins) (init arr) ++ last arr
1374
1375
wbi :: String -> String -> Integer -> Map.Map String String -> String
1376
wbi imgKey subKey wts params =
1377
let orig = join (map (\(k, v) -> encodeURIComponent k ++ "=" ++ encodeURIComponent v) (Map.toList $ Map.insert "wts" (show wts) params)) "&"
1378
in orig ++ "&w_rid=" ++ showMD5 (md5 $ pack $ orig ++ getMixinKey imgKey subKey)
1379
1380
main :: IO ()
1381
main = -- hard encode for test
1382
let params = Map.fromList [("foo", "114")
1383
,("bar", "514")
1384
,("hello", "世 界")
1385
]
1386
wts = 1702204169
1387
imgKey = "7cd084941338484aae1ad9425b84077c"
1388
subKey = "4932caff0ff746eab6f01bf08b70ac45"
1389
in putStrLn $ wbi imgKey subKey wts params
1390
```
1391
1392
`URIEncoder.hs`<!--(by DS)-->:
1393
```hs
1394
module URIEncoder (encodeURIComponent) where
1395
1396
import Data.Char (ord, chr, intToDigit)
1397
import Data.Bits (shiftL, shiftR, (.&.))
1398
import Data.List (isInfixOf)
1399
1400
-- ES 19.2.6.4 encodeURIComponent ( uriComponent )
1401
encodeURIComponent :: String -> String
1402
encodeURIComponent input = case encode input "" of
1403
Right result -> result
1404
Left err -> error err
1405
1406
-- ES 19.2.6.5 Encode ( string, extraUnescaped )
1407
encode :: String -> String -> Either String String
1408
encode string extraUnescaped = loop 0 string
1409
where
1410
alwaysUnescaped = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-.!~*'()"
1411
unescapedSet = alwaysUnescaped ++ extraUnescaped
1412
1413
loop k str
1414
| k >= length str = Right []
1415
| otherwise = case codePointAt str k of
1416
(Nothing, _) -> Left "Unpaired surrogate"
1417
(Just (cp, _), newK) ->
1418
if [str !! k] `isInfixOf` unescapedSet
1419
then (str !! k :) <$> loop (k + 1) str
1420
else do
1421
bytes <- utf8Encode cp
1422
let escaped = concatMap percentEncode bytes
1423
rest <- loop newK str
1424
Right (escaped ++ rest)
1425
1426
codePointAt :: String -> Int -> (Maybe (Int, Int), Int)
1427
codePointAt s k
1428
| k >= length s = (Nothing, k)
1429
| otherwise =
1430
let c1 = ord (s !! k)
1431
in if 0xD800 <= c1 && c1 <= 0xDBFF && k+1 < length s
1432
then let c2 = ord (s !! (k+1))
1433
in if 0xDC00 <= c2 && c2 <= 0xDFFF
1434
then ( Just (0x10000 + ((c1 - 0xD800) `shiftL` 10) + (c2 - 0xDC00), 2)
1435
, k + 2 )
1436
else (Just (c1, 1), k + 1)
1437
else (Just (c1, 1), k + 1)
1438
1439
utf8Encode :: Int -> Either String [Int]
1440
utf8Encode cp
1441
| cp < 0 = Left "Invalid code point"
1442
| cp <= 0x007F = Right [cp]
1443
| cp <= 0x07FF = Right
1444
[ 0xC0 + (cp `shiftR` 6)
1445
, 0x80 + (cp .&. 0x3F) ]
1446
| cp <= 0xFFFF = Right
1447
[ 0xE0 + (cp `shiftR` 12)
1448
, 0x80 + ((cp `shiftR` 6) .&. 0x3F)
1449
, 0x80 + (cp .&. 0x3F) ]
1450
| cp <= 0x10FFFF = Right
1451
[ 0xF0 + (cp `shiftR` 18)
1452
, 0x80 + ((cp `shiftR` 12) .&. 0x3F)
1453
, 0x80 + ((cp `shiftR` 6) .&. 0x3F)
1454
, 0x80 + (cp .&. 0x3F) ]
1455
| otherwise = Left "Code point out of range"
1456
1457
percentEncode :: Int -> String
1458
percentEncode byte = '%' : toHex byte
1459
where
1460
toHex n = [hexDigit (n `div` 16), hexDigit (n `mod` 16)]
1461
hexDigit x
1462
| x < 10 = intToDigit x
1463
| otherwise = chr (x - 10 + ord 'A')
1464
```
1465
1466
输出:
1467
```text
1468
bar=514&foo=114&hello=%E4%B8%96%20%E7%95%8C&wts=1702204169&w_rid=89f9002a49e1d13c07a28054a1cc2614
1469
```