slight refactor, some minor work on client handling done
This commit is contained in:
parent
cd6a898f01
commit
d5c2dc517e
33
src/Clients.hs
Normal file
33
src/Clients.hs
Normal file
|
@ -0,0 +1,33 @@
|
||||||
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
|
|
||||||
|
module Clients where
|
||||||
|
|
||||||
|
import Control.Monad (replicateM)
|
||||||
|
import System.Random (randomRIO)
|
||||||
|
import qualified Database.Redis as R
|
||||||
|
import qualified Data.ByteString.Char8 as BC
|
||||||
|
|
||||||
|
idIsFree :: BC.ByteString -> R.Connection -> IO Bool
|
||||||
|
idIsFree id rConn = do
|
||||||
|
response <- R.runRedis rConn (R.get id)
|
||||||
|
pure $ case response of
|
||||||
|
(Left _) -> False -- maybe error here? look into what causes this more
|
||||||
|
(Right x) ->
|
||||||
|
case x of
|
||||||
|
(Just _) -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
genClientId :: IO String
|
||||||
|
genClientId = replicateM 8 (randomRIO ('a', 'z'))
|
||||||
|
|
||||||
|
-- todo: config file
|
||||||
|
maxClients :: Int
|
||||||
|
maxClients = 100
|
||||||
|
|
||||||
|
getClients :: IO Int
|
||||||
|
getClients = undefined
|
||||||
|
|
||||||
|
acceptingClients :: IO Bool
|
||||||
|
acceptingClients = do
|
||||||
|
clients <- getClients
|
||||||
|
pure $ clients < maxClients
|
26
src/Helpers.hs
Normal file
26
src/Helpers.hs
Normal file
|
@ -0,0 +1,26 @@
|
||||||
|
module Helpers where
|
||||||
|
|
||||||
|
import YTDL
|
||||||
|
import qualified Data.Text.Lazy as TL
|
||||||
|
import Network.URI (parseURI)
|
||||||
|
|
||||||
|
getRes :: String -> Maybe Resolution
|
||||||
|
getRes ("144p") = Just P144
|
||||||
|
getRes ("240p") = Just P240
|
||||||
|
getRes ("360p") = Just P360
|
||||||
|
getRes ("480p") = Just P480
|
||||||
|
getRes ("720p") = Just P720
|
||||||
|
getRes ("1080p") = Just P1080
|
||||||
|
getRes ("max") = Just PMAX
|
||||||
|
getRes ("audio") = Just Audio
|
||||||
|
getRes _ = Nothing
|
||||||
|
|
||||||
|
isRes :: TL.Text -> Bool
|
||||||
|
isRes res = case getRes (TL.unpack res) of
|
||||||
|
(Just _) -> True
|
||||||
|
_ -> False
|
||||||
|
|
||||||
|
isURL :: TL.Text -> Bool
|
||||||
|
isURL uri = case parseURI (TL.unpack uri) of
|
||||||
|
(Just _) -> True
|
||||||
|
_ -> False
|
37
src/Main.hs
37
src/Main.hs
|
@ -6,46 +6,15 @@ import Templates.Index
|
||||||
import Templates.Loading
|
import Templates.Loading
|
||||||
import Templates.Error
|
import Templates.Error
|
||||||
import YTDL
|
import YTDL
|
||||||
|
import Clients
|
||||||
|
import Helpers
|
||||||
|
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import qualified Database.Redis as R
|
import qualified Database.Redis as R
|
||||||
import qualified Data.Text.Lazy as TL
|
import qualified Data.Text.Lazy as TL
|
||||||
import Web.Scotty
|
import Web.Scotty
|
||||||
import Network.URI (URI, parseURI)
|
|
||||||
|
|
||||||
getRes :: String -> Maybe Resolution
|
|
||||||
getRes ("144p") = Just P144
|
|
||||||
getRes ("240p") = Just P240
|
|
||||||
getRes ("360p") = Just P360
|
|
||||||
getRes ("480p") = Just P480
|
|
||||||
getRes ("720p") = Just P720
|
|
||||||
getRes ("1080p") = Just P1080
|
|
||||||
getRes ("max") = Just PMAX
|
|
||||||
getRes ("audio") = Just Audio
|
|
||||||
getRes ("max") = Nothing
|
|
||||||
|
|
||||||
isRes :: TL.Text -> Bool
|
|
||||||
isRes res = case getRes (TL.unpack res) of
|
|
||||||
(Just _) -> True
|
|
||||||
_ -> False
|
|
||||||
|
|
||||||
isURL :: TL.Text -> Bool
|
|
||||||
isURL uri = case parseURI (TL.unpack uri) of
|
|
||||||
(Just _) -> True
|
|
||||||
_ -> False
|
|
||||||
|
|
||||||
-- todo: config file
|
|
||||||
maxClients :: Int
|
|
||||||
maxClients = 100
|
|
||||||
|
|
||||||
getClients :: IO Int
|
|
||||||
getClients = undefined
|
|
||||||
|
|
||||||
acceptingClients :: IO Bool
|
|
||||||
acceptingClients = do
|
|
||||||
clients <- getClients
|
|
||||||
pure $ clients < maxClients
|
|
||||||
|
|
||||||
|
-- todo ReaderT
|
||||||
app :: R.Connection -> ScottyM ()
|
app :: R.Connection -> ScottyM ()
|
||||||
app rConn = do
|
app rConn = do
|
||||||
get "/" $ do
|
get "/" $ do
|
||||||
|
|
|
@ -18,7 +18,7 @@ indexPage = [r|
|
||||||
<center>
|
<center>
|
||||||
<h1>viddl</h1>
|
<h1>viddl</h1>
|
||||||
<p>Download videos from sources such as youtube, twitter, vimeo <a href="https://github.com/ytdl-org/youtube-dl/blob/master/docs/supportedsites.md">and more!</a></p>
|
<p>Download videos from sources such as youtube, twitter, vimeo <a href="https://github.com/ytdl-org/youtube-dl/blob/master/docs/supportedsites.md">and more!</a></p>
|
||||||
<table>
|
<table cellspacing="25">
|
||||||
<tr>
|
<tr>
|
||||||
<td valign="top">
|
<td valign="top">
|
||||||
<h2>Video download</h2>
|
<h2>Video download</h2>
|
||||||
|
|
11
viddl.cabal
11
viddl.cabal
|
@ -17,17 +17,20 @@ library
|
||||||
, Templates.Loading
|
, Templates.Loading
|
||||||
, Templates.Error
|
, Templates.Error
|
||||||
, YTDL
|
, YTDL
|
||||||
|
, Clients
|
||||||
|
, Helpers
|
||||||
ghc-options: -Wall -O2
|
ghc-options: -Wall -O2
|
||||||
build-depends: base ^>=4.14.1.0
|
build-depends: base ^>=4.14.1.0
|
||||||
, scotty
|
, scotty
|
||||||
, hedis
|
, hedis
|
||||||
, transformers
|
, transformers
|
||||||
, text
|
, text
|
||||||
, unix
|
|
||||||
, raw-strings-qq
|
, raw-strings-qq
|
||||||
, network-uri
|
, network-uri
|
||||||
, directory
|
, directory
|
||||||
, process
|
, process
|
||||||
|
, bytestring
|
||||||
|
, random
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
@ -37,12 +40,6 @@ executable viddl
|
||||||
build-depends: base ^>=4.14.1.0
|
build-depends: base ^>=4.14.1.0
|
||||||
, scotty
|
, scotty
|
||||||
, hedis
|
, hedis
|
||||||
, transformers
|
|
||||||
, text
|
, text
|
||||||
, unix
|
|
||||||
, raw-strings-qq
|
|
||||||
, network-uri
|
|
||||||
, directory
|
|
||||||
, process
|
|
||||||
hs-source-dirs: src
|
hs-source-dirs: src
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
Loading…
Reference in New Issue
Block a user