summaryrefslogtreecommitdiff
path: root/Utility/Quvi.hs
blob: ff1ad854c511fa95407e98a1814fa4403935e033 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
{- querying quvi (import qualified)
 -
 - Copyright 2013 Joey Hess <id@joeyh.name>
 -
 - License: BSD-2-clause
 -}

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE FlexibleContexts #-}

module Utility.Quvi where

import Common
import Utility.Url

import Data.Aeson
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Map as M
import Network.URI (uriAuthority, uriRegName)
import Data.Char

data QuviVersion
	= Quvi04
	| Quvi09
	| NoQuvi
	deriving (Show)

data Page = Page
	{ pageTitle :: String
	, pageLinks :: [Link]
	} deriving (Show)

data Link = Link
	{ linkSuffix :: Maybe String
	, linkUrl :: URLString
	} deriving (Show)

{- JSON instances for quvi 0.4. -}
instance FromJSON Page where
	parseJSON (Object v) = Page
		<$> v .: "page_title"
		<*> v .: "link"
	parseJSON _ = mzero

instance FromJSON Link where
	parseJSON (Object v) = Link
		<$> v .:? "file_suffix"
		<*> v .: "url"
	parseJSON _ = mzero

{- "enum" format used by quvi 0.9 -}
parseEnum :: String -> Maybe Page
parseEnum s = Page
	<$> get "QUVI_MEDIA_PROPERTY_TITLE"
	<*> ((:[]) <$>
		( Link
			<$> Just <$> (get "QUVI_MEDIA_STREAM_PROPERTY_CONTAINER")
			<*> get "QUVI_MEDIA_STREAM_PROPERTY_URL"
		)
	    )
  where
	get = flip M.lookup m
	m = M.fromList $ map (separate (== '=')) $ lines s

probeVersion :: IO QuviVersion
probeVersion = catchDefaultIO NoQuvi $
	examine <$> processTranscript "quvi" ["--version"] Nothing
  where
	examine (s, True)
		| "quvi v0.4" `isInfixOf` s = Quvi04
		| otherwise = Quvi09
	examine _ = NoQuvi

type Query a = QuviVersion -> [CommandParam] -> URLString -> IO a

{- Throws an error when quvi is not installed. -}
forceQuery :: Query (Maybe Page)
forceQuery v ps url = query' v ps url `catchNonAsync` onerr
  where
	onerr e = ifM (inPath "quvi")
		( giveup ("quvi failed: " ++ show e)
		, giveup "quvi is not installed"
		)

{- Returns Nothing if the page is not a video page, or quvi is not
 - installed. -}
query :: Query (Maybe Page)
query v ps url = flip catchNonAsync (const $ return Nothing) (query' v ps url)

query' :: Query (Maybe Page)
query' Quvi09 ps url = parseEnum
	<$> readQuvi (toCommand $ [Param "dump", Param "-p", Param "enum"] ++ ps ++ [Param url])
query' Quvi04 ps url = do
	let p = proc "quvi" (toCommand $ ps ++ [Param url])
	decode . BL.fromStrict
		<$> withHandle StdoutHandle createProcessSuccess p B.hGetContents
query' NoQuvi _ _ = return Nothing

queryLinks :: Query [URLString]
queryLinks v ps url = maybe [] (map linkUrl . pageLinks) <$> query v ps url

{- Checks if quvi can still find a download link for an url.
 - If quvi is not installed, returns False. -}
check :: Query Bool
check v ps url = maybe False (not . null . pageLinks) <$> query v ps url

{- Checks if an url is supported by quvi, as quickly as possible
 - (without hitting it if possible), and without outputting
 - anything. Also returns False if quvi is not installed. -}
supported :: QuviVersion -> URLString -> IO Bool
supported NoQuvi _ = return False
supported Quvi04 url = boolSystem "quvi"
		[ Param "--verbosity", Param "mute"
		, Param "--support"
		, Param url
		]
{- Use quvi-info to see if the url's domain is supported.
 - If so, have to do a online verification of the url. -}
supported Quvi09 url = (firstlevel <&&> secondlevel)
		`catchNonAsync` (\_ -> return False)
  where
	firstlevel = case uriAuthority =<< parseURIRelaxed url of
		Nothing -> return False
		Just auth -> do
			let domain = map toLower $ uriRegName auth
			let basedomain = intercalate "." $ reverse $ take 2 $ reverse $ splitc '.' domain
			any (\h -> domain `isSuffixOf` h || basedomain `isSuffixOf` h) 
				. map (map toLower) <$> listdomains Quvi09
	secondlevel = snd <$> processTranscript "quvi"
		(toCommand [Param "dump", Param "-o", Param url]) Nothing

listdomains :: QuviVersion -> IO [String]
listdomains Quvi09 = concatMap (splitc ',') 
	. concatMap (drop 1 . words) 
	. filter ("domains: " `isPrefixOf`) . lines
	<$> readQuvi (toCommand [Param "info", Param "-p", Param "domains"])
listdomains _ = return []

type QuviParams = QuviVersion -> [CommandParam]

{- Disables progress, but not information output. -}
quiet :: QuviParams
-- Cannot use quiet as it now disables informational output.
-- No way to disable progress.
quiet Quvi09 = [Param "--verbosity", Param "verbose"]
quiet Quvi04 = [Param "--verbosity", Param "quiet"]
quiet NoQuvi = []

{- Only return http results, not streaming protocols. -}
httponly :: QuviParams
-- No way to do it with 0.9?
httponly Quvi04 = [Param "-c", Param "http"]
httponly _ = [] -- No way to do it with 0.9?

readQuvi :: [String] -> IO String
readQuvi ps = withHandle StdoutHandle createProcessSuccess p $ \h -> do
	r <- hGetContentsStrict h
	hClose h
	return r
  where
	p = proc "quvi" ps