basic client logic is working.

module Main (main) where

import Options.Applicative

import Data.Semigroup ((<>))

import Control.Monad (guard, when, unless, forM_)

import System.Directory (createDirectoryIfMissing

                        , doesFileExist

                        , removeDirectoryRecursive)

import Control.Exception

import System.IO.Error

import System.Exit

import System.Environment (lookupEnv)

import Data.List (isPrefixOf)

import System.FilePath ((</>))

import Data.Text.Encoding (decodeUtf8)

import qualified Data.Text as T

import qualified Data.ByteString as B

import qualified Data.ByteString.Lazy as LB

import qualified Data.ByteString.Lazy.Char8 as L8

import qualified Data.ByteString.Char8 as Char8

import qualified Data.HashMap.Strict as M

import Data.Aeson (Value(..))

import Network.HTTP.Simple

import Network.HTTP.Client (path)

import Formatting

import RD.Lib (sha1sumOnBytes, guessFilename)

import Type

data RDOptions = RDOptions

  { blockMaxRetry :: Int

  , keepBlockData :: Bool

  , tempDir :: FilePath

  , outputDir :: FilePath

  , verbose :: Bool

  , urls :: [T.Text] } deriving (Show)

argParser :: Parser RDOptions

argParser = RDOptions

  <$> option auto

      (  long "block-max-retry"

      <> short 'r'

      <> help "max retry for each block"

      <> showDefault

      <> value 30

      <> metavar "INT" )

  <*> switch

      (  long "keep"

      <> short 'k'

      <> help "keep block data when download has finished and combined"

      <> showDefault )

  <*> strOption

      (  long "temp-dir"

      <> short 'd'

      <> help "the dir to keep block download data"

      <> showDefault

      <> value ".blocks"

      <> metavar "TEMP_DIR" )

  <*> strOption

      (  long "output-dir"

      <> short 'o'

      <> help "the dir to keep the final combined file"

      <> showDefault

      <> value "."

      <> metavar "OUTPUT_DIR" )

  <*> switch

      (  long "verbose"

      <> short 'v'

      <> help "show more debug message"

      <> showDefault )

  <*> some (argument str (metavar "URL..."))

debug :: Show a => RDOptions -> a -> IO ()

debug opts msg = when (verbose opts) $ print msg

-- | convert byte number to MiB. small number will become 0.

humanReadableSize :: Integer -> String

humanReadableSize bytes = show (bytes `div` 1048576) <> " MiB"

-- | best padding for this many blocks

bestPadding :: Integer -> Int

bestPadding = length . show

data FetchBlockParam = FetchBlockParam {

      fbpUrl :: T.Text

    , fbpFilename :: FilePath

    , fbpBlockWithChecksum :: BlockWithChecksum

    , fbpBlockTargetFile :: FilePath }

-- | try fetch block data from http, if fetched data matches sha1sum, write it

-- to blockTargetFile and return IO True. Otherwise, return IO False.

fetchBlockFromHttp :: RDOptions -> FetchBlockParam -> IO Bool

fetchBlockFromHttp opts fbp = do

  let (blockId, start, end, sha1sum) = fbpBlockWithChecksum fbp

      filename = fbpFilename fbp

      rangeHeader = "bytes=" <> Char8.pack (show start) <> "-"

                             <> Char8.pack (show end)

  -- TODO capture http error. implement retry here.

  debug opts $ "downloading " <> filename <> " block " <> show blockId

  req <- parseRequest $ T.unpack $ fbpUrl fbp

  response <- httpLBS $ addRequestHeader "Range" rangeHeader req

  let bodyLBS = getResponseBody response

  if (decodeUtf8 . LB.toStrict . sha1sumOnBytes) bodyLBS == sha1sum then do

      let blockTargetFile = fbpBlockTargetFile fbp

      debug opts $ "writing block data to " <> blockTargetFile

      LB.writeFile blockTargetFile bodyLBS

      return True

  else do

      putStrLn $ "sha1sum verification failed for " <> filename <> " block " <> show blockId

      return False

-- | return block target file name (just base filename, no dir info)

getBlockFilename :: RDResponse -> BlockWithChecksum -> FilePath

getBlockFilename rdResp blockWithChecksum =

  let padding = bestPadding $ respBlockCount rdResp

      (blockId, _, _, sha1sum) = blockWithChecksum in

  formatToString ("block" % left padding '0' % "_" % stext) blockId sha1sum

-- | fetch a single block, return IO True on success

fetchBlock :: RDOptions -> T.Text -> RDResponse -> BlockID -> IO Bool

fetchBlock opts url rdResp blockId = do

  let blockWithChecksum = respBlocks rdResp !! fromIntegral blockId

      filename = guessFilename url

      blockFileDir = tempDir opts </> filename

      blockFilename = getBlockFilename rdResp blockWithChecksum

      blockTargetFile = blockFileDir </> blockFilename

  result <- catchJust (guard . isPermissionError)

            (do

              createDirectoryIfMissing True blockFileDir

              return True)

            (\_ -> do

               putStrLn $ "Create temp dir " <> blockFileDir <> " failed. Make sure you have correct permission."

               return False)

  if not result then

      return False

  else do

    fileExist <- doesFileExist blockTargetFile

    if fileExist then

        return True

    else

        fetchBlockFromHttp opts (FetchBlockParam url filename blockWithChecksum blockTargetFile)

-- | return block target file names in correct order.

getBlockTargetFilenames :: RDOptions -> RDResponse -> [FilePath]

getBlockTargetFilenames opts rdResp =

  let blockFileDir = tempDir opts </> guessFilename (respPath rdResp)

      getBlockTargetFile blockWithChecksum = blockFileDir </> getBlockFilename rdResp blockWithChecksum in

  map getBlockTargetFile (respBlocks rdResp)

-- | combine downloaded blocks to the final file. Return IO True on success.

combineBlocks :: RDOptions -> RDResponse -> IO Bool

combineBlocks opts rdResp = do

  let outDir = outputDir opts

      filename = guessFilename $ respPath rdResp

      targetFilename = outDir </> filename

  putStrLn $ "combining blocks to create " <> targetFilename

  forM_ (getBlockTargetFilenames opts rdResp) $ \blockFilename -> do

    debug opts $ "appending block file " <> blockFilename

    content <- LB.readFile blockFilename

    LB.appendFile targetFilename content

  putStrLn $ "file downloaded to " <> targetFilename

  unless (keepBlockData opts) $ do

    let tempdir = tempDir opts </> filename

    debug opts $ "delete temporary block data dir " <> tempdir

    removeDirectoryRecursive tempdir

  return True

-- | download file at given URL using reliable download API and block based

-- downloading.

downloadFile :: RDOptions -> T.Text -> IO Bool

downloadFile opts url = do

  req <- parseRequest $ T.unpack url

  resp <- httpJSON $ req { path="/rd" <> path req }

  let rdResp = getResponseBody resp :: RDResponse

  if not $ respOk rdResp then do

      putStrLn $ "GET /rd/ api failed: " <> show (respMsg rdResp)

      return False

  else do

      putStrLn "GET /rd/ api ok"

      putStrLn $ "Downloading file: " <> show (respPath rdResp) <> ", "

               <> humanReadableSize (respFileSize rdResp)

               <> ", " <> show (respBlockCount rdResp) <> " blocks"

      results <- mapM (fetchBlock opts url rdResp) [0..respBlockCount rdResp - 1]

      if and results then

          combineBlocks opts rdResp

      else do

          putStrLn $ (show . length . filter id) results <> " blocks failed."

          return False

cliApp :: RDOptions -> IO ()

cliApp opts = do

  debug opts $ "command line options: " <> show opts

  let dir = tempDir opts

  catchJust (guard . isPermissionError)

            (createDirectoryIfMissing True dir)

            (\_ -> die $ "Create temp dir " <> dir <> " failed. Make sure you have correct permission.")

  debug opts $ "using temp dir: " <> dir

  results <- mapM (downloadFile opts) (urls opts)

  if and results then

      putStrLn "all urls downloaded."

  else do

      die $ (show . length . filter id) results <> " urls failed."

main :: IO ()

main = putStrLn "rd command line tool"

main = cliApp =<< execParser opts

  where

    opts = info (argParser <**> helper)

      (  fullDesc

      <> progDesc "download large files across GFW reliably"

      <> header "rd - reliable download command line tool" )

* COMMENT -*- mode: org -*-

#+Date: 2018-05-04

Time-stamp: <2018-05-06>

Time-stamp: <2018-05-07>

#+STARTUP: content

* notes                                                               :entry:

** 2018-05-06 how to run rd-api in dev env

- how to run rd-api

  cd ~/projects/reliable-download/

  env WEB_ROOT=/home/sylecn/persist/cache stack exec rd-api

- Test it is working:

  static file hosting:

  curl -XGET http://localhost:8082/sdkman.sh

  rd api:

  curl -XGET http://localhost:8082/rd/ideaIC-2018.1.tar.gz

  curl -XGET http://localhost:8082/rd/ideaIC-2018.1.tar.gz | jq .

- client tool:

  cd ~/projects/reliable-download/

  curl http://localhost:8082/rd/ideaIC-2018.1.tar.gz

  stack exec rd -- -d ~/d/.blocks -o ~/d/ http://localhost:8082/ideaIC-2018.1.tar.gz

** 2018-05-05 write the main logic of creating block metadata.

then make it work with a thread pool with a single thread.

  - 

** 2018-05-06 how to run hlint

stack exec hlint -- src api

stack exec hlint -- src api client

** 2018-05-05 it's impossible to do logging easily in haskell.

two problems

  shouldContain

  etc

** 2018-05-05 Data.Aeson

http://hackage.haskell.org/package/aeson-1.3.1.0/docs/Data-Aeson.html

// this seems more readable than lts haskell's doc.

Aeson: the tutorial

https://artyom.me/aeson

** 2018-05-05 sol/hpack: hpack: An alternative format for Haskell packages

https://github.com/sol/hpack

** 2018-05-04 make hoogle work in current project

stack build hoogle

requires building 54 pkgs. lots of dependencies.

- info: file size

  53M	.stack-work/

** 2018-05-04 for project notes, see GTD.org id002

** 2018-05-05 API spec

- POST /rd

  json body

  {"path": "/path/to/resource"}

- 

* lib docs 							      :entry:

** 2018-05-06 http client docs

Making HTTP requests - http-client library

https://haskell-lang.org/library/http-client

Network.HTTP.Simple

https://www.stackage.org/haddock/lts-10.3/http-conduit-2.2.4/Network-HTTP-Simple.html

Network.HTTP.Client

https://www.stackage.org/haddock/lts-10.3/http-client-0.5.7.1/Network-HTTP-Client.html

** 2018-05-06 handle IO exceptions

- Control.Exception

  https://www.stackage.org/haddock/lts-10.3/base-4.10.1.0/Control-Exception.html

- System.IO.Error

  https://www.stackage.org/haddock/lts-10.3/base-4.10.1.0/System-IO-Error.html

** 2018-05-05 sol/hpack: hpack: An alternative format for Haskell packages

https://github.com/sol/hpack

** 2018-05-05 HUnit: A unit testing framework for Haskell

https://hackage.haskell.org/package/HUnit

** 2018-05-05 Web.Scotty

scotty/examples at master · scotty-web/scotty

https://github.com/scotty-web/scotty/tree/master/examples

** 2018-05-04 for project notes, see GTD.org id002

** 2018-05-05 API spec

- POST /rd

  json body

  {"path": "/path/to/resource"}

- 

** 2018-05-05 Data.Aeson

http://hackage.haskell.org/package/aeson-1.3.1.0/docs/Data-Aeson.html

// this seems more readable than lts haskell's doc.

Aeson: the tutorial

https://artyom.me/aeson

** 2018-05-06 optparse-applicative :: Stackage Server

https://www.stackage.org/lts-10.3/package/optparse-applicative-0.14.0.0

* later                                                               :entry:

** 2018-05-05 add logging support

- hslogger

* current                                                             :entry:

** 

** 2018-05-06 client design doc

- client side start downloading blocks using a thread pool or similar.

  block data is saved to .blocks/<fn>/blockN_<block_sha1sum> when it is

  fetched in whole and verified. block data is removed when all blocks are

  joined to the final file, unless user specify -k --keep-blocks on rd cli.

  show a nice progress bar.

  #+BEGIN_SRC sh

    downloading bigfile

    xxx blocks

    downloading block 1

    downloading block 2

    1/24 ready, X%

    downloading block 3

    downloading block 4

    2/24 ready, X%

    downloading block 5

    ...

    block N ready, 100%

    bigfile downloaded.

  #+END_SRC

  block download use HTTP/1.1 Range header to fetch that block.

  Range: bytes=0-499

  Range: bytes=500-999

- how to handle IO exception?

  make sure this show error msg and exit gracefully.

  stack exec rd -- -d /root/.ssh url

  this should work:

  stack exec rd -- url

  stack exec rd -- -d .tmp url

  Control.Exception

  https://www.stackage.org/haddock/lts-10.3/base-4.10.1.0/Control-Exception.html#g:3

- which http client to use?

  make sure I can add header easily and I can save bytestring to file easily.

  - http-client-0.5.7.1 An HTTP client engine, intended as a base layer for

    more user-friendly packages. Note that, if you want to make HTTPS secure

    connections, you should use http-client-tls in addition to this library.

  - http-conduit-2.2.4 HTTP client package with conduit interface and HTTPS

    support.

    Provides for making efficient HTTP/HTTPS requests, providing either a

    simple or streaming interface.  Full tutorial docs are available at:

    https://haskell-lang.org/library/http-client

    also support streaming.

  - http-streams-0.8.5.5

    An HTTP client library for Haskell using the Snap Framework's io-streams

    library to handle the streaming IO.

  - req-1.0.0

    Simple but powerful lens-based API

    built on reliable libraries like http-client and lens.

    Session handling includes connection keep-alive and pooling, and cookie

    persistence.

    Basic and OAuth2 bearer authentication

    // keep-alive will be useful for my cli tool.

    it has a doc section comment on other libs.

    Motivation and Req vs other libraries

  - req-conduit-1.0.0

  - wreq-0.5.2.0

  - let me just try http-conduit or req.

    stack exec rd -- -d ~/d/.blocks http://myip.emacsos.com/

    stack exec rd -- -d ~/d/.blocks https://myip.emacsos.com/

    both http and https are supported.

    try add range header.

    stack exec rd -- -d ~/d/.blocks http://localhost:8082/sdkman.sh

    it works.

- DONE if target file exists, skip downloading, just return True.

- DONE verify downloaded data before writing it to disk.

  TODO retry if verification failed.

- DONE combine all parts and put result file in download (default is current)

  dir. after combine delete block temp files.

- TODO use a thread pool to download blocks. print overall progress when some

  parts done or some time elapsed.

- problems

  - DONE sha1sum verification failed for ideaIC-2018.1.tar.gz block xxx

    try download using curl.

    curl -o ~/d/t1.out -r 0-2097151 http://localhost:8082/ideaIC-2018.1.tar.gz

    sha1sum ~/d/t1.out

    4690b050834d4059d40ad6f63bf91d6a4558bb71  /home/sylecn/d/t1.out

    curl http://localhost:8082/rd/ideaIC-2018.1.tar.gz | jq '.blocks[0]'

    #+BEGIN_SRC json

      [

        0,

        0,

        2097151,

        "a31a9a1d7d98e957ab8e615dc72b656f4896fa81"

      ]

    #+END_SRC

    In deed it is different.

    added a failing unit test.

    offby1 error. fixed.

    blockContent <- LB.hGet handle $ fromIntegral (end - start + 1)

  - DONE /home/sylecn/projects/reliable-download/src/RD/Lib.hs:10:1: error:

    Ambiguous module name ‘Crypto.Hash’:

      it was found in multiple packages:

      cryptohash-0.11.9 cryptonite-0.24Ambiguous module name ‘Crypto.Hash’:

      it was found in multiple packages:

      cryptohash-0.11.9 cryptonite-0.24

    this is a problem in ucompile. build was not using project scope stack

    build/test. fixed.

  - DONE how to reduce code duplication in fetchBlock and getBlockTargetFilenames.

  - DONE combineBlocks doesn't generate target file.

    appendFile doesn't create file if it doesn't exist?

    rewrite in do notation worked. fmap didn't work. probably related to

    laziness. value is created but never forced when written in fmap inside IO

    monad.

    old:

    #+BEGIN_SRC haskell

      \blockFilename ->

          fmap (LB.appendFile targetFilename) (LB.readFile blockFilename)

    #+END_SRC

    now:

    #+BEGIN_SRC haskell

      \blockFilename -> do

          content <- LB.readFile blockFilename

          LB.appendFile targetFilename content

    #+END_SRC

** 2018-05-06 write client side tool to actually do the download.

- make this work:

  env WEB_ROOT=/home/sylecn/persist/cache stack exec rd-api

  rd http://localhost:8082/ideaIC-2018.1.tar.gz

  stack exec rd -- -d ~/d/.blocks http://localhost:8082/ideaIC-2018.1.tar.gz

- 

* done                                                                :entry:

  - filepath

  - unix

  - unordered-containers

  - split

library:

  source-dirs: src

  rd:

    source-dirs:      client

    main:             Main.hs

    dependencies:

    - reliable-download    # I only need the Type module

    - optparse-applicative

    - http-conduit

    - http-client

tests:

  api-test:

  all-tests:

    main: TestApi.hs

    source-dirs: test

    dependencies:

    - reliable-download

    - HUnit

    - hspec

    - hspec-wai

    - http-types

    - wai-extra

    - unordered-containers

    - binary

  lib-test:

    main: test.hs

    other-modules:

      - TestLib

    source-dirs: test

    dependencies:

    - reliable-download

    - HUnit

      object ["ok" .= True

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

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

    path :: LT.Text <- param "1"

    let filepath = combine (webRoot (config runtimeConfig)) (LT.unpack path)

    path :: T.Text <- param "1"

    let filepath = combine (webRoot (config runtimeConfig)) (T.unpack path)

    liftIO $ putStrLn $ "get block metadata for " <> filepath

    fileStatus <- liftIO $ getFileStatus filepath    -- TODO catch IO exception

    let fileSizeInByte = toInteger $ fileSize fileStatus

                 ,"msg" .= ("check file status in redis failed" :: T.Text)]

        jsonRespOk = do

          blocksWithSha1sum <- liftIO $ fillSha1sum runtimeConfig fbp

          json $ object ["ok" .= True

                        ,"block_size" .= ("2MiB" :: T.Text)

                        ,"file_size" .= fileSizeInByte

                        ,"block_count" .= blockCount

                        ,"blocks" .= blocksWithSha1sum

                        ,"path" .= path

                        ,"filepath" .= filepath]

          json $ RDResponse {

                        respOk=True

                      , respMsg=""

                      , respPath=path

                      , respFilePath=filepath

                      , respBlockSize="2MiB"

                      , respFileSize=fileSizeInByte

                      , respBlockCount=blockCount

                      , respBlocks=blocksWithSha1sum }

    -- if this file is new or has status "error", add task to fileChan.

    redisReply <- liftIO $ R.runRedis (redisConn runtimeConfig) $ R.setnx strKey "working"

module RD.Lib

    ( sha1sum

    , sha1sumOnBytes )

    , sha1sumOnBytes

    , guessFilename )

where

import qualified Data.Text as T

import qualified Data.Text.Lazy as LT

import qualified Data.Text.Lazy.Encoding as LTE

import qualified Data.ByteString.Lazy as LB

import Crypto.Hash

import Crypto.Hash (digestToHexByteString, hashlazy, Digest, SHA1)

-- | get sha1sum hex string for given bytes

sha1sumOnBytes :: LB.ByteString -> LB.ByteString

sha1sum filename = do

  bytes <- LB.readFile $ LT.unpack filename

  return $ LTE.decodeUtf8 $ sha1sumOnBytes bytes

-- | guess filename from URL or HTTP Path

guessFilename :: T.Text -> FilePath

guessFilename = T.unpack . last . T.splitOn "/"