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.Error
|
||||
import YTDL
|
||||
import Clients
|
||||
import Helpers
|
||||
|
||||
import Control.Monad.IO.Class
|
||||
import qualified Database.Redis as R
|
||||
import qualified Data.Text.Lazy as TL
|
||||
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 rConn = do
|
||||
get "/" $ do
|
||||
|
|
|
@ -18,7 +18,7 @@ indexPage = [r|
|
|||
<center>
|
||||
<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>
|
||||
<table>
|
||||
<table cellspacing="25">
|
||||
<tr>
|
||||
<td valign="top">
|
||||
<h2>Video download</h2>
|
||||
|
|
11
viddl.cabal
11
viddl.cabal
|
@ -17,17 +17,20 @@ library
|
|||
, Templates.Loading
|
||||
, Templates.Error
|
||||
, YTDL
|
||||
, Clients
|
||||
, Helpers
|
||||
ghc-options: -Wall -O2
|
||||
build-depends: base ^>=4.14.1.0
|
||||
, scotty
|
||||
, hedis
|
||||
, transformers
|
||||
, text
|
||||
, unix
|
||||
, raw-strings-qq
|
||||
, network-uri
|
||||
, directory
|
||||
, process
|
||||
, bytestring
|
||||
, random
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
||||
|
@ -37,12 +40,6 @@ executable viddl
|
|||
build-depends: base ^>=4.14.1.0
|
||||
, scotty
|
||||
, hedis
|
||||
, transformers
|
||||
, text
|
||||
, unix
|
||||
, raw-strings-qq
|
||||
, network-uri
|
||||
, directory
|
||||
, process
|
||||
hs-source-dirs: src
|
||||
default-language: Haskell2010
|
||||
|
|
Loading…
Reference in New Issue
Block a user