Commit 8630e878 authored by Yuanle Song's avatar Yuanle Song
Browse files

v1.2.1.0 minor adjust on logging msgs 

- rd-api, add version info in GET /rd/
- update doc
parent c935d3d3

api/Main.hs

+1 −0
Original line number Diff line number Diff line
@@ -97,6 +97,7 @@ runApiServer rdConfig = do 
        startWorkers rc

    else

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

    infol rc $ sformat ("rd-api " % string) cliVersion

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

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

    let warpSettings = ( setFdCacheDuration 10

api/lib/App.hs

+7 −5
Original line number Diff line number Diff line
@@ -20,6 +20,7 @@ import Control.Error 
import qualified Database.Redis as R

import qualified Data.HashMap.Strict as M



import CliVersion (cliVersion)

import Type

import Config

import Lib (sha1sum, genBlocks)
@@ -66,12 +67,12 @@ processNewFileAsyncMaybe rc fbp = do 
    case fmap fsFromBytes oldStatus of

      Just FileStatusError -> do

        setResultE <- liftIO $ do

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

          infol rc $ "file status was " <> showt FileStatusError <> ", retry now"

          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"

      Just FileStatusDone -> liftIO $ debugl rc $ "file status is " <> showt FileStatusDone

      Just FileStatusWorking -> liftIO $ debugl rc $ "file status is " <> showt FileStatusWorking

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



-- | GET /rd/.* handler
@@ -83,7 +84,7 @@ getRdHandler rc = do 


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

  fileStatusE <- lift $ do

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

    liftIO $ infol rc $ "user request rd metadata for " <> showt filepath

    liftIO $ catchIOError

      (fmap Right (getFileStatus filepath))

      (\e -> do
@@ -125,7 +126,8 @@ mkApp :: RDRuntimeConfig -> ScottyM () 
mkApp rc = do

  get (literal "/rd/") $ json $

      object ["ok" .= True

             ,"app" .= ("reliable-download api" :: T.Text)]

             ,"app" .= ("reliable-download api" :: T.Text)

             ,"version" .= T.pack cliVersion]



  get (regex "^/rd/(.*)") $ do

    result <- runExceptT $ getRdHandler rc

api/lib/Worker.hs

+5 −2
Original line number Diff line number Diff line
@@ -10,10 +10,11 @@ import qualified Data.ByteString.Lazy as LB 
import qualified Data.Text as T



import qualified Database.Redis as R

import Formatting



import Type

import Config

import Lib (sha1sumOnBytes)

import Lib (sha1sumOnBytes, humanReadableSize)

import Utils



-- | read file range data as LB.ByteString. handle must be a handle to an
@@ -55,7 +56,9 @@ fileWorker rc = forever $ do 
      errorl rc $ "Set file status failed: " <> showt reply

    Right _ -> do

      debugl rc $ "Set file status to " <> showt resultStatus <> " for " <> showt filepath

      infol rc $ "fileWorker done for " <> showt filepath

      infol rc $ sformat

        ("fileWorker done for " % string % ", " % stext % ", " % int % " blocks")

        filepath (humanReadableSize (fbpFileSize fbp)) (length (fbpBlocks fbp))

  return ()

    where

      -- | calculate sha1 for a single block. return IO True on success.

cli-version/CliVersion.hs

+2 −2
Original line number Diff line number Diff line 
module CliVersion where

module CliVersion (cliVersion) where



cliVersion :: String

cliVersion = "1.2.0.0"
 
cliVersion = "1.2.1.0"

client/Main.hs

+3 −2
Original line number Diff line number Diff line
@@ -263,10 +263,11 @@ loopUntilAllBlocksReady rc url rdResp oldReadyBlocks downloadTask = do 
      readyBlocks = filter blockIsReady blocks

      newReadyBlocks = filter ((`notElem` oldReadyBlocks) . getBlockId) readyBlocks

      allBlocksReady = all blockIsReady blocks

  infol rc $ (showt . length) newReadyBlocks <> " new block(s) ready on server side"

  debugl rc $ (showt . length) newReadyBlocks <> " new block(s) ready on server side"

  addTasks downloadTask $ map (fetchBlock rc url rdResp) newReadyBlocks

  if allBlocksReady then

  if allBlocksReady then do

    -- loop finished

    infol rc $ "all " <> (showt . length) blocks <> " block(s) ready on server side"

    return rdResp

  else do

    when (null newReadyBlocks) $ do