diff --git a/src/Main.hs b/src/Main.hs
index df9a3fa..40900d0 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -2,10 +2,15 @@
module Main where
+import Templates.Index
+import Templates.Loading
+import Templates.Error
+
+import Control.Monad.IO.Class
import qualified Database.Redis as R
import qualified Data.Text.Lazy as TL
import Web.Scotty
-import System.Posix.Process (executeFile)
+import Network.URI (URI, parseURI)
data Resolution
= P144
@@ -16,46 +21,76 @@ data Resolution
| P1080
| PMAX
| PMIN
+ | Audio
deriving (Eq, Show)
getRes :: String -> Maybe Resolution
-getRes ("144p") = P144
-getRes ("240p") = P240
-getRes ("360p") = P360
-getRes ("480p") = P480
-getRes ("720p") = P720
-getRes ("1080p") = P1080
-getRes ("min") = PMAX
-getRes ("max") = PMIN
+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 ("min") = Just PMAX
+getRes ("max") = Just PMIN
+getRes ("audio") = Just Audio
+getRes ("max") = Nothing
-downloadVideo :: String -> Resolution -> IO Filepath
+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
+
+downloadVideo :: String -> Resolution -> IO FilePath
downloadVideo url res = do
undefined
-downloadAudio :: String -> IO Filepath
+downloadAudio :: String -> IO FilePath
downloadAudio url = do
undefined
-getIndex :: IO String
-getIndex = readFile "views/index.html"
-
app :: R.Connection -> ScottyM ()
app rConn = do
get "/" $ do
- setHeader "Content-Type" "text/html;charset=utf-8"
- file "views/index.html"
+ html indexPage
post "/" $ do
- setHeader "Content-Type" "text/html;charset=utf-8"
- file "views/loading.html"
url <- param "url"
res <- param "resolution"
- -- set redis stuff and id here
- redirect '/':id
+ if (isURL url) && (isRes res)
+ then do
+ queueOK <- liftIO acceptingClients
+ if queueOK
+ then do
+ html loadingPage
+ -- set redis stuff and id here
+ -- redirect $ TL.pack $ '/':id
+ else
+ html $ errorPage "Too many clients right now. Try again later!"
+ else
+ html $ errorPage "Invalid input!"
get "/:id" $ do
-- grab id and process video if not already done
id <- param "id"
+ html id
main :: IO ()
main = do
diff --git a/src/Templates/Error.hs b/src/Templates/Error.hs
new file mode 100644
index 0000000..64d36d5
--- /dev/null
+++ b/src/Templates/Error.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Templates.Error (errorPage) where
+
+import qualified Data.Text.Lazy as TL
+import Text.RawString.QQ
+
+errorPage :: TL.Text -> TL.Text
+errorPage msg = [r|
+
+
+
+
+ viddl
+
+
+
+ viddl
+ |] <> msg <> [r|
+
+ viddl is free open source software and is powered by youtube-dl.
+
+
+|]
diff --git a/views/index.html b/src/Templates/Index.hs
similarity index 84%
rename from views/index.html
rename to src/Templates/Index.hs
index 9b1e71e..f14a0c5 100644
--- a/views/index.html
+++ b/src/Templates/Index.hs
@@ -1,3 +1,13 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Templates.Index (indexPage) where
+
+import qualified Data.Text.Lazy as TL
+import Text.RawString.QQ
+
+indexPage :: TL.Text
+indexPage = [r|
@@ -32,6 +42,7 @@
Audio only download
@@ -41,3 +52,4 @@
viddl is free open source software and is powered by youtube-dl.
+|]
diff --git a/views/loading.html b/src/Templates/Loading.hs
similarity index 65%
rename from views/loading.html
rename to src/Templates/Loading.hs
index 1a39321..cea05ca 100644
--- a/views/loading.html
+++ b/src/Templates/Loading.hs
@@ -1,3 +1,13 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Templates.Loading (loadingPage) where
+
+import qualified Data.Text.Lazy as TL
+import Text.RawString.QQ
+
+loadingPage :: TL.Text
+loadingPage = [r|
@@ -12,3 +22,4 @@
viddl is free open source software and is powered by youtube-dl.
+|]
diff --git a/viddl.cabal b/viddl.cabal
index 96f9b45..87ce586 100644
--- a/viddl.cabal
+++ b/viddl.cabal
@@ -15,7 +15,9 @@ extra-source-files: CHANGELOG.md
executable viddl
main-is: Main.hs
- -- other-modules:
+ other-modules: Templates.Index
+ , Templates.Loading
+ , Templates.Error
-- other-extensions:
ghc-options: -Wall -O2
build-depends: base ^>=4.14.1.0
@@ -24,5 +26,7 @@ executable viddl
, transformers
, text
, unix
+ , raw-strings-qq
+ , network-uri
hs-source-dirs: src
default-language: Haskell2010