Commit a46df275 authored by Yuanle Song's avatar Yuanle Song
Browse files

v1.1.3.0 rework rd-api logging 

- switched to tinylog, it supports log level
- reorganize files to minimize code recompilation
- added --verbose for rd-api
- make FileStatus a data type
- update doc
parent 5a847d7b

README.md

+4 −3
Original line number Diff line number Diff line
@@ -14,11 +14,11 @@ rd-api - reliable download server 


Usage: rd-api [-h|--host HOST] [-p|--port PORT] [--redis-host REDIS_HOST]

              [--redis-port REDIS_PORT] [-d|--web-root DIR] [-w|--worker INT]

              [-V|--version]

              [-v|--verbose] [-V|--version]

  rd-api is an HTTP file server that provides static file hosting and reliable

  download api for rd client.

  

  rd-api serves files under web-root. You can use it like python3 -m http.server

  rd-api serves files under web-root. You can use it like ```python3 -m http.server```

  

  In addition, if rd command line tool is used to do the download, it will

  download in a reliable way by downloading in 2MiB blocks and verify checksum
@@ -54,6 +54,7 @@ Available options: 
  -d,--web-root DIR        web root directory (default: ".")

  -w,--worker INT          how many concurrent workers to calculator sha1sum for

                           file (default: 2)

  -v,--verbose             show more debug message

  -V,--version             show program version and exit

  -h,--help                Show this help text
@@ -61,7 +62,7 @@ Available options: 


```

$ rd --help

rd - reliable download command line tool

rd - reliable download client



Usage: rd [-r|--block-max-retry INT] [-k|--keep] [-d|--temp-dir TEMP_DIR]

          [-o|--output-dir OUTPUT_DIR] [-w|--worker INT] [-f|--force]

api/Main.hs

+7 −7
Original line number Diff line number Diff line
@@ -19,7 +19,6 @@ import qualified Text.PrettyPrint.ANSI.Leijen as D 


import Config

import CliVersion (cliVersion)

import Utils

import Opts (argParser)

import OptsDoc (rdApiDescription)

import App (mkWaiApp)
@@ -68,7 +67,8 @@ runApiServer rdConfig = do 
  configE <- liftIO $ updateRDConfigFromEnv rdConfig

  configMaybe <- case configE of

    Left e -> do

      liftIO $ logl rc0 $ sformat ("Error: " % stext) e

      -- liftIO $ L.err (rcLogger rc0) $ L.msg $ sformat ("Error: " % stext) e

      liftIO $ errorl rc0 $ sformat ("Error: " % stext) e

      mzero    -- early exit

    Right config -> return $ Just config

  let config = fromJust configMaybe
@@ -79,10 +79,10 @@ runApiServer rdConfig = do 
  connMaybe <- case connEi of

    Left e -> do

      liftIO $ do

        logl rc0 $ sformat

        errorl rc0 $ sformat

          ("Connect to redis at " % string % ":" % int % " failed: " % stext)

          (redisHost config) (redisPort config) e

        logl rc0 $ sformat "No redis, GET /rd/ api disabled, acting as static file server"

        warnl rc0 $ sformat "No redis, GET /rd/ api disabled, acting as static file server"

      return Nothing

    Right conn ->

      return $ Just conn
@@ -96,9 +96,9 @@ runApiServer rdConfig = do 
    if rcHasRedis rc then

        startWorkers rc

    else

        logl rc $ sformat "No redis, not starting workers"

    logl rc $ sformat ("webRoot is " % string) (webRoot config)

    logl rc $ sformat ("will listen on " % string % ":" % int) (host config) (port config)

        warnl rc $ sformat "No redis, not starting workers"

    infol rc $ sformat ("webRoot is " % string) (webRoot config)

    infol rc $ sformat ("will listen on " % string % ":" % int) (host config) (port config)

    let warpSettings = ( setFdCacheDuration 10

                       . setFileInfoCacheDuration 10

                       . setPort (port config)

api/Opts.hs

+5 −0
Original line number Diff line number Diff line
@@ -46,6 +46,11 @@ argParser = RDConfig 
      <> showDefault

      <> value 2

      <> metavar "INT")

  <*> switch

      (  long "verbose"

      <> short 'v'

      <> help "show more debug message"

      <> showDefault )

  <*> switch

      (  long "version"

      <> short 'V'

src/App.hs→api/lib/App.hs

+16 −12
Original line number Diff line number Diff line
@@ -7,7 +7,7 @@ import Data.Either.Extra (fromRight') 
import Data.Text.Encoding (decodeUtf8)

import Control.Concurrent.Chan

import System.IO.Error (catchIOError)

import Control.Monad (when, unless)

import Control.Monad (unless)

import qualified Data.Text as T

import qualified Data.Text.Lazy as LT
@@ -33,11 +33,11 @@ fillSha1sum rc fbp = do 
  redisReply <- R.runRedis (rcRedisConn rc) $ R.hgetall hashKey

  case redisReply of

    Left reply -> do

      logl rc $ "redis hgetall " <> showt hashKey <> " failed: " <> showt reply

      errorl rc $ "redis hgetall " <> showt hashKey <> " failed: " <> showt reply

      return $ map fillBlock (fbpBlocks fbp) where

        fillBlock (blockId, start, end) = (blockId, start, end, "pending")

    Right blockIdSha1sumAlist -> do

      logl rc $ "fillSha1sum: redis hgetall " <> showt hashKey <> " ok"

      debugl rc $ "fillSha1sum: redis hgetall " <> showt hashKey <> " ok"

      return $ map fillBlock (fbpBlocks fbp) where

        blockIdSha1sumMap = M.fromList blockIdSha1sumAlist

        fillBlock :: Block -> BlockWithChecksum
@@ -49,26 +49,30 @@ processNewFileAsyncMaybe :: RDRuntimeConfig -> FillBlockParam -> ExceptT T.Text 
processNewFileAsyncMaybe rc fbp = do

  let strKey = fileStatusKey fbp

      filePath = fbpFilepath fbp

  resultE <- liftIO $ DB.insertIfNotExist rc strKey fileStatusWorking

  resultE <- liftIO $ DB.insertIfNotExist rc strKey $ fsBytes FileStatusWorking

  throwOnLeft resultE

  let insertOk = fromRight' resultE

  if insertOk then liftIO $ do

      logl rc $ showt filePath <> " is a new file, sending task to worker"

      infol rc $ showt filePath <> " is a new file, sending task to worker"

      writeChan (rcFileChan rc) fbp

      return ()

  else do

    oldStatusE <- liftIO $ do

      logl rc $ showt filePath <> " is not a new file"

      debugl rc $ showt filePath <> " is not a new file"

      -- if status is error, set it to working, then add task to fileChan

      DB.get rc strKey

    throwOnLeftMsg oldStatusE "get old file status failed"

    let oldStatus = fromRight' oldStatusE

    when (oldStatus == Just fileStatusError) $ do

    case fmap fsFromBytes oldStatus of

      Just FileStatusError -> do

        setResultE <- liftIO $ do

          logl rc $ showt strKey <> " was in " <> showt fileStatusError <> " status"

          DB.set rc strKey fileStatusWorking

        throwOnLeftMsg setResultE $ "set file status to " <> showt fileStatusWorking <> " failed"

          infol rc $ showt strKey <> " was in " <> showt FileStatusError <> " status"

          DB.set rc strKey $ fsBytes FileStatusWorking

        throwOnLeftMsg setResultE $ "set file status to " <> showt FileStatusWorking <> " failed"

        liftIO $ writeChan (rcFileChan rc) fbp

      Just FileStatusDone -> liftIO $ infol rc "file was processed before"

      Just FileStatusWorking -> liftIO $ infol rc "file is being processed by worker"

      _ -> liftIO $ errorl rc "Unexpected file status"



-- | GET /rd/.* handler

getRdHandler :: RDRuntimeConfig -> ExceptT T.Text ActionM ()
@@ -79,12 +83,12 @@ getRdHandler rc = do 


  let filepath = webRoot (rcConfig rc) </> T.unpack path

  fileStatusE <- lift $ do

    liftIO $ logl rc $ "user request " <> showt filepath

    liftIO $ infol rc $ "user request " <> showt filepath

    liftIO $ catchIOError

      (fmap Right (getFileStatus filepath))

      (\e -> do

         let msg = "getFileStatus on " <> T.pack filepath <> " failed"

         logl rc $ msg <> ":\n\t" <> T.pack (show e)

         errorl rc $ msg <> ":\n\t" <> T.pack (show e)

         return $ Left msg)

  throwOnLeft fileStatusE

  let fileStatus = fromRight' fileStatusE

src/Config.hs→api/lib/Config.hs

+36 −7
Original line number Diff line number Diff line
@@ -4,8 +4,10 @@ import qualified Database.Redis as R 
import Control.Concurrent.Chan

import qualified Data.ByteString as B

import qualified Data.ByteString.Char8 as Char8

import qualified Data.Text as T

import Control.Monad.IO.Class



import System.Log.FastLogger

import qualified System.Logger as L



import Type
@@ -17,6 +19,7 @@ data RDConfig = RDConfig { 
    , redisPort :: Int

    , webRoot :: FilePath

    , fileWorkerCount :: Int

    , verbose :: Bool

    , showVersion :: Bool } deriving (Show)



data RDRuntimeConfig = RDRuntimeConfig {
@@ -24,8 +27,31 @@ data RDRuntimeConfig = RDRuntimeConfig { 
    , rcRedisConn :: R.Connection

    , rcHasRedis :: Bool

    , rcFileChan :: Chan FillBlockParam

    , rcLoggerSet :: LoggerSet

    , rcLoggerTimeCache :: IO FormattedTime }

    , rcLogger :: L.Logger }



errorl :: MonadIO m => RDRuntimeConfig -> T.Text -> m ()

errorl rc msg = do

  let logger = rcLogger rc

  L.err logger $ L.msg msg

  L.flush logger



warnl :: MonadIO m => RDRuntimeConfig -> T.Text -> m ()

warnl rc msg = do

  let logger = rcLogger rc

  L.warn logger $ L.msg msg

  L.flush logger



infol :: MonadIO m => RDRuntimeConfig -> T.Text -> m ()

infol rc msg = do

  let logger = rcLogger rc

  L.info logger $ L.msg msg

  L.flush logger



debugl :: MonadIO m => RDRuntimeConfig -> T.Text -> m ()

debugl rc msg = L.debug (rcLogger rc) $ L.msg msg



flushl :: MonadIO m => RDRuntimeConfig -> m ()

flushl rc = L.flush (rcLogger rc)



defaultRDConfig :: RDConfig

defaultRDConfig = RDConfig {
@@ -35,6 +61,7 @@ defaultRDConfig = RDConfig { 
                  , redisPort = 6379

                  , webRoot = "/nonexistent"

                  , fileWorkerCount = 2

                  , verbose = False

                  , showVersion = False

                  }
@@ -42,15 +69,17 @@ defaultRDRuntimeConfig :: RDConfig -> IO RDRuntimeConfig 
defaultRDRuntimeConfig config = do

  conn <- R.connect R.defaultConnectInfo

  fileChan <- newChan

  loggerSet <- newStdoutLoggerSet defaultBufSize

  loggerTimeCache <- newTimeCache simpleTimeFormat

  let logLevel = if verbose config then L.Debug else L.Info

      logSettings = (L.setFormat (Just "%Y-%0m-%0dT%0H:%0M:%0S") .

                     L.setLogLevel logLevel .

                     L.setDelimiter "  ") L.defSettings

  logger <- L.new logSettings

  return RDRuntimeConfig {

               rcConfig=config

             , rcRedisConn=conn

             , rcHasRedis=True

             , rcFileChan=fileChan

             , rcLoggerSet=loggerSet

             , rcLoggerTimeCache=loggerTimeCache }

             , rcLogger=logger }



-- | the redis hash key used to store cached sha1sum for given FillBlockParam

blockSha1sumHashKey :: FillBlockParam -> B.ByteString