diff --git a/src/Clients.hs b/src/Clients.hs new file mode 100644 index 0000000..74aee34 --- /dev/null +++ b/src/Clients.hs @@ -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 diff --git a/src/Helpers.hs b/src/Helpers.hs new file mode 100644 index 0000000..8d9de32 --- /dev/null +++ b/src/Helpers.hs @@ -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 diff --git a/src/Main.hs b/src/Main.hs index 4cfff44..91add33 100644 --- a/src/Main.hs +++ b/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 diff --git a/src/Templates/Index.hs b/src/Templates/Index.hs index 2c84063..856e1dc 100644 --- a/src/Templates/Index.hs +++ b/src/Templates/Index.hs @@ -18,7 +18,7 @@ indexPage = [r|

viddl

Download videos from sources such as youtube, twitter, vimeo and more!

- +

Video download

diff --git a/viddl.cabal b/viddl.cabal index 4268255..71e11a0 100644 --- a/viddl.cabal +++ b/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