made download directory configurable

src/Config.hs

@@ -0,0 +1,10 @@
+module Config where
+
+import System.Directory
+
+data ViddlConfig = ViddlConfig
+  { webPort :: Int
+  , dlDir   :: FilePath }
+
+defConfig :: IO ViddlConfig
+defConfig = getTemporaryDirectory >>= pure . ViddlConfig 3000 . (<> "viddl")

src/Helpers.hs

@@ -3,8 +3,26 @@
 module Helpers where
 
 import YTDL
+import Config
+
+import Text.Read (readMaybe)
 import qualified Data.Text.Lazy as TL
 import Network.URI
+import System.Exit
+
+parseArgs :: ViddlConfig -> [String] -> IO ViddlConfig
+parseArgs _ ("-h":_) = exitHelp
+parseArgs _ ("--help":_) = exitHelp
+parseArgs cfg@(ViddlConfig _ d) ("-p":p':xs) = case (readMaybe p' :: Maybe Int) of
+  (Just p) -> parseArgs (ViddlConfig p d) xs
+  Nothing  -> parseArgs cfg (p':xs)
+parseArgs (ViddlConfig p _) ("-d":d:xs) = parseArgs (ViddlConfig p d) xs
+parseArgs cfg (_:xs) = parseArgs cfg xs
+parseArgs cfg [] = pure cfg
+
+
+exitHelp :: IO a
+exitHelp = putStrLn "viddl [-p port] [-d dir]" >> exitSuccess
 
 getRes :: TL.Text -> Maybe Resolution
 getRes ("144p")  = Just P144

src/Main.hs

@@ -6,22 +6,28 @@ import Templates.Index
 import Templates.Error
 import YTDL
 import Helpers
+import Config
 
-import Control.Monad.IO.Class
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Class
 import qualified Data.Text.Lazy as TL
-import Web.Scotty
+import System.Environment
+import Web.Scotty.Trans
 
-safeDownloadAction :: ActionM ()
+type Scotty = ScottyT TL.Text (ReaderT ViddlConfig IO)
+type Action = ActionT TL.Text (ReaderT ViddlConfig IO)
+
+safeDownloadAction :: Action ()
 safeDownloadAction = downloadAction `rescue` (html . errorPage)
 
-downloadAction :: ActionM ()
+downloadAction :: Action ()
 downloadAction = do
     url <- param "url"
     res <- param "resolution"
     if (isURL url) && (isRes res)
       then do
         let (Just res') = getRes res -- safe cause we checked with isRes
-        ytdlRes <- liftIO $ ytdl (TL.unpack url) res'
+        ytdlRes <- lift $ ytdl (TL.unpack url) res'
         case ytdlRes of
           (Right filePath) -> do
             setHeader "content-type" "video/mp4"
@@ -31,11 +37,15 @@ downloadAction = do
         html $ errorPage "Invalid input!"
 
 -- todo ReaderT
-app :: ScottyM ()
+app :: Scotty ()
 app = do
   get "/" $ html indexPage
   get "/video.mp4" safeDownloadAction
   get "/audio.mp3" safeDownloadAction
 
 main :: IO ()
-main = scotty 3000 app
+main = do
+  args <- getArgs
+  defCfg <- defConfig
+  cfg <- parseArgs defCfg args
+  scottyT (webPort cfg) (\(ReaderT ma) -> ma cfg) app

src/YTDL.hs

@@ -1,12 +1,15 @@
 module YTDL (Resolution(..), ytdl) where
 
+import Config
+
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.Class
 import Control.Concurrent (forkIO, threadDelay)
 import Data.Digest.Pure.MD5
 import qualified Data.ByteString.Lazy.UTF8 as BCU
 import System.Directory
 import System.Exit
 import System.Process
-import System.IO
 
 data Resolution
   = P144
@@ -33,43 +36,41 @@ resToArgs (P1080) = wrapResString "1080"
 resToArgs (PMAX)  = ["-f", "bestvideo[ext=mp4]+bestaudio[ext=m4a]/mp4", "--merge-output-format", "mp4"]
 resToArgs (Audio) = ["-x", "--audio-format", "mp3"]
 
-ytdl :: String -> Resolution -> IO (Either String FilePath)
+ytdl :: String -> Resolution -> ReaderT ViddlConfig IO (Either String FilePath)
 ytdl url res = do
+  cfg <- ask
+
   let ext = case res of { Audio -> ".mp3"; _ -> ".mp4" }
 
   let ident = show . md5 . BCU.fromString $ url <> show res
 
-  -- todo: config for path
-  tmpdir <- getTemporaryDirectory
-  let dir = concat [tmpdir, "/viddl/", ident]
+  let dir = concat [dlDir cfg, "/", ident]
   let fileName = concat [dir, "/", ident, ext]
 
-  -- todo: implement file locking for deleting and uploading file
-  processed <- doesFileExist fileName
+  processed <- lift $ doesFileExist fileName
   if processed
     then do
-      putStrLn $ "Returning existing ident " <> ident
+      lift $ putStrLn $ "Returning existing ident " <> ident
       pure (Right fileName)
     else do
-      putStrLn $ "Processing new ident " <> ident
+      lift $ putStrLn $ "Processing new ident " <> ident
 
-      createDirectoryIfMissing True dir
+      lift $ createDirectoryIfMissing True dir
 
-      print (resToArgs res <> ["-o", fileName, url])
+      lift $ print (resToArgs res <> ["-o", fileName, url])
 
-      ytdlProc <- createProcess (proc "youtube-dl" (resToArgs res <> ["-o", fileName, url]))
+      ytdlProc <- lift $ createProcess (proc "youtube-dl" (resToArgs res <> ["-o", fileName, url]))
 
       case ytdlProc of
         (_, _, _, ph) -> do
-          exitCode <- waitForProcess ph
+          exitCode <- lift $ waitForProcess ph
           case exitCode of
             ExitSuccess -> do
-              exists <- doesFileExist fileName
+              exists <- lift $ doesFileExist fileName
               if exists
                 then do
                   -- wait 5 minutes and then delete the directory
-                  -- todo: implement file locking for deleting and uploading file
-                  _ <- forkIO $ threadDelay 300000000 >> removeDirectoryRecursive dir
+                  _ <- lift $ forkIO $ threadDelay 300000000 >> removeDirectoryRecursive dir
                   pure (Right fileName)
                 else do 
                   -- removeDirectoryRecursive dir

todo

@@ -1,2 +1,3 @@
-configuration for scotty
-cache results somehow
+better config options (file?)
+safer file deletion
+queue system?

viddl.cabal

@@ -17,6 +17,7 @@ library
                     , Templates.Error
                     , YTDL
                     , Helpers
+                    , Config
     ghc-options:      -Wall -O2 -threaded
     build-depends:    base ^>=4.14.1.0
                     , scotty
@@ -28,6 +29,7 @@ library
                     , bytestring
                     , pureMD5
                     , utf8-string
+                    , transformers
     hs-source-dirs:   src
     default-language: Haskell2010
 
@@ -37,6 +39,7 @@ executable viddl
                     , Templates.Error
                     , Helpers
                     , YTDL
+                    , Config
     ghc-options:      -Wall -O2 -threaded
     build-depends:    base ^>=4.14.1.0
                     , scotty
@@ -48,5 +51,6 @@ executable viddl
                     , bytestring
                     , pureMD5
                     , utf8-string
+                    , transformers
     hs-source-dirs:   src
     default-language: Haskell2010