create YTDL module

src/Main.hs

@@ -5,6 +5,7 @@ module Main where
 import Templates.Index
 import Templates.Loading
 import Templates.Error
+import YTDL
 
 import Control.Monad.IO.Class
 import qualified Database.Redis as R
@@ -12,18 +13,6 @@ import qualified Data.Text.Lazy as TL
 import Web.Scotty
 import Network.URI (URI, parseURI)
 
-data Resolution
-  = P144
-  | P240
-  | P360
-  | P480
-  | P720
-  | P1080
-  | PMAX
-  | PMIN
-  | Audio
-  deriving (Eq, Show)
-
 getRes :: String -> Maybe Resolution
 getRes ("144p")  = Just P144
 getRes ("240p")  = Just P240
@@ -31,8 +20,7 @@ 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 ("max")   = Just PMAX
 getRes ("audio") = Just Audio
 getRes ("max")   = Nothing
 
@@ -58,14 +46,6 @@ acceptingClients = do
   clients <- getClients
   pure $ clients < maxClients
 
-downloadVideo :: String -> Resolution -> IO FilePath
-downloadVideo url res = do
-  undefined
-
-downloadAudio :: String -> IO FilePath
-downloadAudio url = do
-  undefined
-
 app :: R.Connection -> ScottyM ()
 app rConn = do
   get "/" $ do

src/Templates/Index.hs

@@ -26,7 +26,6 @@ indexPage = [r|
 						<input required name="url" type="text" placeholder="Enter url here"><br>
 						<label for="resolution">res</label>
 						<select required name="resolution">
-							<option value="min">Smallest Possible</option>
 							<option value="144p">144p</option>
 							<option value="240p">240p</option>
 							<option value="360p">360p</option>

src/YTDL.hs

@@ -0,0 +1,67 @@
+module YTDL (downloadVideo, downloadAudio, Resolution(..), ytdl) where
+
+import System.Directory
+import System.Exit
+import System.Process
+import System.IO
+
+data Resolution
+  = P144
+  | P240
+  | P360
+  | P480
+  | P720
+  | P1080
+  | PMAX
+  | Audio
+  deriving (Eq, Show)
+
+wrapResString :: String -> [String]
+wrapResString str = ["-f", concat ["bestvideo[ext=mp4,height<=", str,
+  "]+bestaudio[ext=m4a]/mp4[height<=", str, "]"]]
+
+resToArgs :: Resolution -> [String]
+resToArgs (P144)  = wrapResString "144"
+resToArgs (P240)  = wrapResString "240"
+resToArgs (P360)  = wrapResString "360"
+resToArgs (P480)  = wrapResString "480"
+resToArgs (P720)  = wrapResString "720"
+resToArgs (P1080) = wrapResString "1080"
+resToArgs (PMAX)  = ["-f", "bestvideo[ext=mp4]+bestaudio[ext=m4a]/mp4"]
+resToArgs (Audio) = ["-x", "--audio-format", "mp3"]
+
+downloadVideo :: String -> String -> Resolution -> IO (Either String FilePath)
+downloadVideo client url res = ytdl client url res
+
+downloadAudio :: String -> String -> IO (Either String FilePath)
+downloadAudio client url = ytdl client url Audio
+
+ytdl :: String -> String -> Resolution -> IO (Either String FilePath)
+ytdl client url res = do
+  let ext = case res of { Audio -> ".mp3"; _ -> ".mp4" }
+  -- todo: config for path
+  tmpdir <- getTemporaryDirectory
+  let dir = concat [tmpdir, "/viddl/", client]
+  let fileName = concat [dir, "/", client, ext]
+  createDirectoryIfMissing True dir
+
+  ytdlProc <- createProcess (proc "youtube-dl" (resToArgs res <> ["-o", fileName, url]))
+    { std_out = CreatePipe
+    , std_err = CreatePipe }
+
+  case ytdlProc of
+    (_, _, Just herr, ph) -> do
+      err <- hGetContents herr
+      exitCode <- waitForProcess ph
+      case exitCode of
+        ExitSuccess -> do
+          exists <- doesFileExist fileName
+          if exists
+            then pure (Right fileName)
+            else do 
+              removeDirectory dir
+              pure (Left "An unknown error prevented the output file from being created")
+
+        (ExitFailure status) -> pure (Left (concat ["execution failed with status ", show status, ": ", err]))
+
+    _ -> pure (Left "Unable to create ytdlProcess for downloading video")

viddl.cabal

@@ -12,12 +12,11 @@ maintainer:         depsterr@protonmail.com
 category:           Web
 build-type:         Simple
 
-executable viddl
-    main-is:          Main.hs
-    other-modules:    Templates.Index
+library
+    exposed-modules:  Templates.Index
                     , Templates.Loading
                     , Templates.Error
-    -- other-extensions:
+                    , YTDL
     ghc-options:      -Wall -O2
     build-depends:    base ^>=4.14.1.0
                     , scotty
@@ -27,5 +26,23 @@ executable viddl
                     , unix
                     , raw-strings-qq
                     , network-uri
+                    , directory
+                    , process
+    hs-source-dirs:   src
+    default-language: Haskell2010
+
+executable viddl
+    main-is:          Main.hs
+    ghc-options:      -Wall -O2
+    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