diff --git a/hadoop-tools.cabal b/hadoop-tools.cabal --- a/hadoop-tools.cabal +++ b/hadoop-tools.cabal @@ -1,14 +1,15 @@ -name: hadoop-tools -version: 0.2 -synopsis: Tools for working with Hadoop. -description: Tools for working with Hadoop. -license: Apache-2.0 -license-file: LICENSE -author: Jacob Stanley, Conrad Parker -maintainer: Jacob Stanley -category: Data -build-type: Simple -cabal-version: >= 1.10 +name: hadoop-tools +version: 0.3 +synopsis: Fast command line tools for working with Hadoop. +description: Fast command line tools for working with Hadoop. +homepage: http://github.com/jystic/hadoop-tools +license: Apache-2.0 +license-file: LICENSE +author: Jacob Stanley, Conrad Parker +maintainer: Jacob Stanley +category: Data +build-type: Simple +cabal-version: >= 1.10 executable hh default-language: Haskell2010 @@ -16,30 +17,26 @@ main-is: Main.hs hs-source-dirs: src + ghc-options: -funbox-strict-fields + ghc-prof-options: -auto-all -caf-all + other-modules: Paths_hadoop_tools build-depends: base >= 4.7 && < 5 + , attoparsec >= 0.12 , boxes >= 0.1 , bytestring >= 0.10 - , cereal >= 0.4 - , cereal-conduit >= 0.7 - , conduit >= 1.2 - , conduit-extra >= 1.1 , configurator >= 0.3 - , directory >= 1.2 + , exceptions >= 0.6 , filepath >= 1.3 - , network >= 2.5 - , network-simple >= 0.4 + , hadoop-rpc >= 0.1 , old-locale >= 1.0 , optparse-applicative >= 0.10 , protobuf >= 0.2.0.4 - , socks >= 0.5 , split >= 0.2 , text >= 1.1 , time >= 1.4 , transformers >= 0.4 - , unix >= 2.7 - , unordered-containers >= 0.2 - , xmlhtml >= 0.2.3.2 + , vector >= 0.10 diff --git a/src/Main.hs b/src/Main.hs --- a/src/Main.hs +++ b/src/Main.hs @@ -3,43 +3,38 @@ module Main (main) where -import Control.Exception (SomeException, handle, throwIO) +import Control.Exception (SomeException, bracket) import Control.Monad +import Control.Monad.Catch (handle, throwM) import Control.Monad.IO.Class (MonadIO, liftIO) - +import qualified Data.Attoparsec.ByteString.Char8 as Atto import Data.Bits ((.&.), shiftR) +import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B +import Data.Char (ord) import Data.Foldable (foldMap) -import qualified Data.HashMap.Lazy as H -import Data.List (intercalate) -import Data.List (isPrefixOf) -import Data.List.Split (splitOn) -import Data.Maybe (fromMaybe, maybeToList, mapMaybe, listToMaybe) -import Data.Text (Text) +import Data.Maybe (fromMaybe) import qualified Data.Text as T import qualified Data.Text.Encoding as T import qualified Data.Text.IO as T -import qualified Data.Text.Read as T import Data.Time import Data.Time.Clock.POSIX +import qualified Data.Vector as V import Data.Word (Word16, Word32, Word64) import qualified Data.Configurator as C import Data.Configurator.Types (Worth(..)) -import System.Environment (getEnv, lookupEnv) +import System.Environment (getEnv) import System.FilePath.Posix +import System.IO import System.IO.Unsafe (unsafePerformIO) import System.Locale (defaultTimeLocale) -import System.Posix.User (getEffectiveUserName) -import Text.PrettyPrint.Boxes hiding ((<>)) -import Text.XmlHtml - -import Data.Conduit (handleC) -import Data.ProtocolBuffers -import Data.ProtocolBuffers.Orphans () +import Text.PrettyPrint.Boxes hiding ((<>), (//)) -import Hadoop.Protobuf.Hdfs -import Hadoop.Rpc +import Data.Hadoop.Configuration (getHadoopConfig) +import Data.Hadoop.Types +import Network.Hadoop.Hdfs hiding (runHdfs) +import Network.Hadoop.Read import Options.Applicative hiding (Success) @@ -51,19 +46,31 @@ main :: IO () main = do cmd <- execParser optsParser - handle printError (runRemote cmd) + case cmd of + SubIO io -> io + SubHdfs hdfs -> handle printError (runHdfs hdfs) where optsParser = info (helper <*> options) (fullDesc <> header "hh - Blazing fast interaction with HDFS") -runRemote :: Remote a -> IO a -runRemote remote = do +runHdfs :: Hdfs a -> IO a +runHdfs hdfs = do + config <- getConfig + runHdfs' config hdfs + +getConfig :: IO HadoopConfig +getConfig = do hdfsUser <- getHdfsUser nameNode <- getNameNode socksProxy <- getSocksProxy - let run = maybe runTcp runSocks socksProxy - run nameNode hdfsUser remote + liftM ( set hdfsUser (\c x -> c { hcUser = x }) + . set nameNode (\c x -> c { hcNameNodes = [x] }) + . set socksProxy (\c x -> c { hcProxy = Just x }) + ) getHadoopConfig + where + set :: Maybe a -> (b -> a -> b) -> b -> b + set m f c = maybe c (f c) m ------------------------------------------------------------------------ @@ -73,33 +80,15 @@ return (home ".hh") {-# NOINLINE configPath #-} -getHdfsUser :: IO User -getHdfsUser = attempt [fromEnv, fromCfg] fromUnix - where - fromEnv :: IO (Maybe User) - fromEnv = fmap T.pack <$> lookupEnv "HADOOP_USER_NAME" - - fromCfg :: IO (Maybe User) - fromCfg = C.load [Optional configPath] >>= flip C.lookup "hdfs.user" - - fromUnix :: IO User - fromUnix = T.pack <$> getEffectiveUserName - -getNameNode :: IO NameNode -getNameNode = attempt [fromHadoopCfg, fromUserCfg] explode - where - fromHadoopCfg :: IO (Maybe NameNode) - fromHadoopCfg = listToMaybe . maybe [] id <$> readHadoopNameNodes - - fromUserCfg :: IO (Maybe NameNode) - fromUserCfg = do - cfg <- C.load [Optional configPath] - host <- C.lookup cfg "namenode.host" - port <- C.lookupDefault 8020 cfg "namenode.port" - return (Endpoint <$> host <*> pure port) +getHdfsUser :: IO (Maybe User) +getHdfsUser = C.load [Optional configPath] >>= flip C.lookup "hdfs.user" - explode :: IO a - explode = error $ "could not find namenode details in /etc/hadoop/conf/ or " <> configPath +getNameNode :: IO (Maybe NameNode) +getNameNode = do + cfg <- C.load [Optional configPath] + host <- C.lookup cfg "namenode.host" + port <- C.lookupDefault 8020 cfg "namenode.port" + return (Endpoint <$> host <*> pure port) getSocksProxy :: IO (Maybe SocksProxy) getSocksProxy = do @@ -109,100 +98,42 @@ Nothing -> return Nothing Just host -> Just . Endpoint host <$> C.lookupDefault 1080 cfg "proxy.port" -attempt :: Monad m => [m (Maybe a)] -> m a -> m a -attempt [] def = def -attempt (io:ios) def = io >>= \mx -> case mx of - Just x -> return x - Nothing -> attempt ios def - ------------------------------------------------------------------------ -type HadoopConfig = H.HashMap Text Text - -readHadoopNameNodes :: IO (Maybe [NameNode]) -readHadoopNameNodes = do - cfg <- H.union <$> readHadoopConfig "/etc/hadoop/conf/core-site.xml" - <*> readHadoopConfig "/etc/hadoop/conf/hdfs-site.xml" - return $ resolveNameNode cfg <$> (stripProto =<< H.lookup fsDefaultNameKey cfg) - where - proto = "hdfs://" - fsDefaultNameKey = "fs.defaultFS" - nameNodesPrefix = "dfs.ha.namenodes." - rpcAddressPrefix = "dfs.namenode.rpc-address." - - stripProto :: Text -> Maybe Text - stripProto uri | proto `T.isPrefixOf` uri = Just (T.drop (T.length proto) uri) - | otherwise = Nothing - - resolveNameNode :: HadoopConfig -> Text -> [NameNode] - resolveNameNode cfg name = case parseEndpoint name of - Just ep -> [ep] -- contains "host:port" directly - Nothing -> mapMaybe (\nn -> lookupAddress cfg $ name <> "." <> nn) - (lookupNameNodes cfg name) - - lookupNameNodes :: HadoopConfig -> Text -> [Text] - lookupNameNodes cfg name = maybe [] id - $ T.splitOn "," <$> H.lookup (nameNodesPrefix <> name) cfg - - lookupAddress :: HadoopConfig -> Text -> Maybe Endpoint - lookupAddress cfg name = parseEndpoint =<< H.lookup (rpcAddressPrefix <> name) cfg - - parseEndpoint :: Text -> Maybe Endpoint - parseEndpoint ep = Endpoint host <$> port - where - host = T.takeWhile (/= ':') ep - port = either (const Nothing) (Just . fst) - $ T.decimal $ T.drop (T.length host + 1) ep - -readHadoopConfig :: FilePath -> IO HadoopConfig -readHadoopConfig path = do - exml <- parseXML path <$> B.readFile path - case exml of - Left _ -> return H.empty - Right xml -> return (toHashMap (docContent xml)) - where - toHashMap = H.fromList . mapMaybe fromNode - . concatMap (descendantElementsTag "property") - - fromNode n = (,) <$> (nodeText <$> childElementTag "name" n) - <*> (nodeText <$> childElementTag "value" n) - ------------------------------------------------------------------------- - workingDirConfigPath :: FilePath workingDirConfigPath = unsafePerformIO $ do home <- getEnv "HOME" return (home ".hhwd") {-# NOINLINE workingDirConfigPath #-} -getDefaultWorkingDir :: MonadIO m => m FilePath -getDefaultWorkingDir = liftIO $ (("/user" ) . T.unpack) <$> getHdfsUser +getDefaultWorkingDir :: MonadIO m => m HdfsPath +getDefaultWorkingDir = liftIO $ (("/user" //) . T.encodeUtf8 . hcUser) <$> getConfig -getWorkingDir :: MonadIO m => m FilePath +getWorkingDir :: MonadIO m => m HdfsPath getWorkingDir = liftIO $ handle onError - $ T.unpack . T.takeWhile (/= '\n') - <$> T.readFile workingDirConfigPath + $ B.takeWhile (/= '\n') + <$> B.readFile workingDirConfigPath where - onError :: SomeException -> IO FilePath + onError :: SomeException -> IO HdfsPath onError = const getDefaultWorkingDir -setWorkingDir :: MonadIO m => FilePath -> m () -setWorkingDir path = liftIO $ T.writeFile workingDirConfigPath - $ T.pack path <> "\n" +setWorkingDir :: MonadIO m => HdfsPath -> m () +setWorkingDir path = liftIO $ B.writeFile workingDirConfigPath + $ path <> "\n" -getAbsolute :: MonadIO m => FilePath -> m FilePath +getAbsolute :: MonadIO m => HdfsPath -> m HdfsPath getAbsolute path = liftIO (normalizePath <$> getPath) where - getPath = if "/" `isPrefixOf` path + getPath = if "/" `B.isPrefixOf` path then return path - else getWorkingDir >>= \pwd -> return (pwd path) + else getWorkingDir >>= \pwd -> return (pwd // path) -normalizePath :: FilePath -> FilePath -normalizePath = intercalate "/" . dropAbsParentDir . splitOn "/" +normalizePath :: HdfsPath -> HdfsPath +normalizePath = B.intercalate "/" . dropAbsParentDir . B.split '/' -dropAbsParentDir :: [FilePath] -> [FilePath] +dropAbsParentDir :: [HdfsPath] -> [HdfsPath] dropAbsParentDir [] = error "dropAbsParentDir: not an absolute path" -dropAbsParentDir (p : ps) = p : (reverse $ fst $ go [] ps) +dropAbsParentDir (p : ps) = p : reverse (fst $ go [] ps) where go [] (".." : ys) = go [] ys go (_ : xs) (".." : ys) = go xs ys @@ -212,21 +143,28 @@ ------------------------------------------------------------------------ data SubCommand = SubCommand - { subName :: String + { subName :: String , subDescription :: String - , subMethod :: Parser (Remote ()) + , subMethod :: Parser SubMethod } -sub :: SubCommand -> Mod CommandFields (Remote ()) +data SubMethod = SubIO (IO ()) + | SubHdfs (Hdfs ()) + +sub :: SubCommand -> Mod CommandFields SubMethod sub SubCommand{..} = command subName (info subMethod $ progDesc subDescription) -options :: Parser (Remote ()) +options :: Parser SubMethod options = subparser (foldMap sub allSubCommands) allSubCommands :: [SubCommand] allSubCommands = - [ subChDir + [ subCat + , subChDir + , subChMod , subDiskUsage + -- , subFind + , subGet , subList , subMkDir , subPwd @@ -241,83 +179,151 @@ completeDir :: Mod ArgumentFields a completeDir = completer (fileCompletion (== Dir)) <> metavar "DIRECTORY" +bstr :: Monad m => String -> m ByteString +bstr x = B.pack `liftM` str x + +subCat :: SubCommand +subCat = SubCommand "cat" "Print the contents of a file to stdout" go + where + go = cat <$> many (argument bstr (completePath <> help "the file to cat")) + cat paths = SubHdfs $ mapM_ (hdfsCat <=< getAbsolute) paths + subChDir :: SubCommand subChDir = SubCommand "cd" "Change working directory" go where - go = cd <$> optional (argument str (completeDir <> help "the directory to change to")) - cd mpath = do + go = cd <$> optional (argument bstr (completeDir <> help "the directory to change to")) + cd mpath = SubHdfs $ do path <- getAbsolute =<< maybe getDefaultWorkingDir return mpath - mls <- getListing path - liftIO $ case mls of - Nothing -> putStrLn $ "Directory does not exist: " <> path - Just _ -> setWorkingDir path + _ <- getListingOrFail path + setWorkingDir path +subChMod :: SubCommand +subChMod = SubCommand "chmod" "Change permissions" go + where + go = chmod <$> argument bstr (help "permissions mode") + <*> argument bstr (completeDir <> help "the file/directory to chmod") + chmod modeS path = either + (\_ -> error $ "Unknown mode" ++ B.unpack modeS) + (\mode -> SubHdfs $ modifyPerms mode path) + (Atto.parseOnly parseMode modeS) + + parseMode = octal + + octal :: Atto.Parser Word16 + octal = B.foldl' step 0 `fmap` Atto.takeWhile1 isDig + where + isDig w = w >= '0' && w <= '7' + step a w = a * 8 + fromIntegral (ord w - 48) + + modifyPerms :: Word16 -> HdfsPath -> Hdfs () + modifyPerms mode path = do + absPath <- getAbsolute path + info <- getFileInfo absPath + case info of + Nothing -> fail $ unwords ["No such file", B.unpack absPath] + Just FileStatus{..} -> do + {- + liftIO . putStrLn . unwords $ ["Setting perms on", B.unpack absPath] + liftIO . putStrLn . unwords $ ["OLD:", formatMode fsFileType fsPermission] + liftIO . putStrLn . unwords $ ["NEW:", formatMode fsFileType mode] + -} + setPermissions (fromIntegral mode) absPath + subDiskUsage :: SubCommand subDiskUsage = SubCommand "du" "Show the amount of space used by file or directory" go where - go = du <$> optional (argument str (completePath <> help "the file/directory to check the usage of")) - du path = printDiskUsage =<< getAbsolute (maybe "" id path) + go = du <$> optional (argument bstr (completePath <> help "the file/directory to check the usage of")) + du path = SubHdfs $ printDiskUsage =<< getAbsolute (fromMaybe "" path) +subFind :: SubCommand +subFind = SubCommand "find" "Recursively search a directory tree" go + where + go = find <$> (argument bstr (completeDir <> help "the path to recursively search")) + <*> (optional (option bstr (long "name" <> metavar "FILENAME" + <> help "the file name to match exactly"))) + find path mexpr = SubHdfs $ do + absPath <- getAbsolute path + printFindResults absPath $ maybe (const True) feq mexpr + + feq expr FileStatus{..} = expr == fsPath + +subGet :: SubCommand +subGet = SubCommand "get" "Get a file" go + where + go = get <$> argument bstr (completePath <> help "source file") + <*> optional (argument str (completePath <> help "destination file")) + get src mdst = SubHdfs $ do + let dst = fromMaybe (takeFileName $ B.unpack src) mdst + absSrc <- getAbsolute src + mReadHandle <- openRead absSrc + let doRead readHandle = liftIO $ bracket + (openFile dst WriteMode) + (hClose) + (\writeHandle -> hdfsMapM_ (B.hPut writeHandle) readHandle) + maybe (return ()) doRead mReadHandle + subList :: SubCommand subList = SubCommand "ls" "List the contents of a directory" go where - go = ls <$> (optional (argument str (completeDir <> help "the directory to list"))) - ls path = printListing =<< getAbsolute (fromMaybe "" path) + go = ls <$> optional (argument bstr (completeDir <> help "the directory to list")) + ls path = SubHdfs $ printListing =<< getAbsolute (fromMaybe "" path) subMkDir :: SubCommand subMkDir = SubCommand "mkdir" "Create a directory in the specified location" go where - go = mkdir <$> argument str (completeDir <> help "the directory to create") - <*> switch (short 'p' <> help "create intermediate directories") - mkdir path parent = do + go = mkdir <$> argument bstr (completeDir <> help "the directory to create") + <*> switch (short 'p' <> help "create intermediate directories") + mkdir path parent = SubHdfs $ do absPath <- getAbsolute path - ok <- mkdirs absPath parent - unless ok $ liftIO . putStrLn $ "Failed to create: " <> absPath + ok <- mkdirs parent absPath + unless ok $ liftIO . B.putStrLn $ "Failed to create: " <> absPath subPwd :: SubCommand subPwd = SubCommand "pwd" "Print working directory" go where - go = pure pwd - pwd = liftIO . putStrLn =<< getWorkingDir + go = pure $ SubIO $ B.putStrLn =<< getWorkingDir subRemove :: SubCommand subRemove = SubCommand "rm" "Delete a file or directory" go where - go = rm <$> argument str (completePath <> help "the file/directory to remove") - <*> switch (short 'r' <> help "recursively remove the whole file hierarchy") - rm path recursive = do + go = rm <$> argument bstr (completePath <> help "the file/directory to remove") + <*> switch (short 'r' <> help "recursively remove the whole file hierarchy") + rm path recursive = SubHdfs $ do absPath <- getAbsolute path - ok <- delete absPath recursive - unless ok $ liftIO . putStrLn $ "Failed to remove: " <> absPath + ok <- delete recursive absPath + unless ok $ liftIO . B.putStrLn $ "Failed to remove: " <> absPath subRename :: SubCommand subRename = SubCommand "mv" "Rename a file or directory" go where - go = mv <$> argument str (completePath <> help "source file/directory") - <*> argument str (completePath <> help "destination file/directory") - <*> switch (short 'f' <> help "overwrite destination if it exists") - mv src dst force = do + go = mv <$> argument bstr (completePath <> help "source file/directory") + <*> argument bstr (completePath <> help "destination file/directory") + <*> switch (short 'f' <> help "overwrite destination if it exists") + mv src dst force = SubHdfs $ do absSrc <- getAbsolute src absDst <- getAbsolute dst - rename absSrc absDst force + rename force absSrc absDst subVersion :: SubCommand subVersion = SubCommand "version" "Show version information" go where - go = pure $ liftIO $ putStrLn $ "hh version " <> showVersion version + go = pure $ SubIO $ putStrLn $ "hh version " <> showVersion version ------------------------------------------------------------------------ fileCompletion :: (FileType -> Bool) -> Completer -fileCompletion p = mkCompleter $ \path -> handle ignore $ runRemote $ do - let (dir, _) = splitFileName' path - ls <- getListing =<< getAbsolute dir +fileCompletion p = mkCompleter $ \spath -> handle ignore $ runHdfs $ do + let dir = B.pack $ fst $ splitFileName' spath + path = B.pack spath - return $ filter (path `isPrefixOf`) - . map (displayPath dir) - . filter (p . get fsFileType) - . concatMap (get dlPartialListing) - . maybeToList $ ls + ls <- getListing' =<< getAbsolute dir + + return $ V.toList + . V.map B.unpack + . V.filter (path `B.isPrefixOf`) + . V.map (displayPath dir) + . V.filter (p . fsFileType) + $ ls where ignore (RemoteError _ _) = return [] @@ -325,69 +331,65 @@ ("./", f) -> ("", f) (d, f) -> (d, f) -displayPath :: FilePath -> FileStatus -> FilePath -displayPath parent file = parent B.unpack (get fsPath file) <> suffix +displayPath :: HdfsPath -> FileStatus -> HdfsPath +displayPath parent file = parent // fsPath file <> suffix where - suffix = case get fsFileType file of + suffix = case fsFileType file of Dir -> "/" _ -> "" ------------------------------------------------------------------------ -printDiskUsage :: FilePath -> Remote () +printDiskUsage :: HdfsPath -> Hdfs () printDiskUsage path = do - mls <- getListing path - case mls of - Nothing -> liftIO $ putStrLn $ "File/directory does not exist: " <> path - Just ls -> do - let files = map (displayPath path) (get dlPartialListing ls) - css <- zip files <$> mapM getDirSize files + ls <- getListingOrFail path - let col a f = vcat a (map (text . f) css) + let files = V.map (displayPath path) ls + css <- V.zip files <$> V.mapM getDirSize files - liftIO $ do - printBox $ col right snd - <+> col left fst + let col a f = vcat a (map (text . f) (V.toList css)) + + liftIO $ printBox $ col right snd + <+> col left (B.unpack . fst) where - getDirSize f = handleC (\e -> if isAccessDenied e then return "-" else liftIO (throwIO e)) - (formatSize . get csLength <$> getContentSummary f) + getDirSize f = handle (\e -> if isAccessDenied e then return "-" else throwM e) + (formatSize . csLength <$> getContentSummary f) -printListing :: FilePath -> Remote () +printListing :: HdfsPath -> Hdfs () printListing path = do - mls <- getListing path - case mls of - Nothing -> liftIO . putStrLn $ "Directory does not exist: " <> path - Just ls -> do - let getPerms = fromIntegral . get fpPerm . get fsPermission - getBlockRepl = fromMaybe 0 . get fsBlockReplication - - hdfs2utc ms = posixSecondsToUTCTime (fromIntegral ms / 1000) - getModTime = hdfs2utc . get fsModificationTime + ls <- getListingOrFail path - -- TODO: Fetch rest of partial listing - xs = get dlPartialListing ls - col a f = vcat a (map (text . f) xs) + let hdfs2utc ms = posixSecondsToUTCTime (fromIntegral ms / 1000) + getModTime = hdfs2utc . fsModificationTime - liftIO $ do - putStrLn $ "Found " <> show (length xs) <> " items" + col a f = vcat a (map (text . f) (V.toList ls)) - printBox $ col left (\x -> formatMode (get fsFileType x) (getPerms x)) - <+> col right (formatBlockRepl . getBlockRepl) - <+> col left (T.unpack . get fsOwner) - <+> col left (T.unpack . get fsGroup) - <+> col right (formatSize . get fsLength) - <+> col right (formatUTC . getModTime) - <+> col left (T.unpack . T.decodeUtf8 . get fsPath) + liftIO $ do + putStrLn $ "Found " <> show (V.length ls) <> " items" ------------------------------------------------------------------------- + printBox $ col left (\x -> formatMode (fsFileType x) (fsPermission x)) + <+> col right (formatBlockReplication . fsBlockReplication) + <+> col left (T.unpack . fsOwner) + <+> col left (T.unpack . fsGroup) + <+> col right (formatSize . fsLength) + <+> col right (formatUTC . getModTime) + <+> col left (T.unpack . T.decodeUtf8 . fsPath) -get :: HasField a => (t -> a) -> t -> FieldType a -get f x = getField (f x) +printFindResults :: HdfsPath -> (FileStatus -> Bool) -> Hdfs () +printFindResults path cond = handle (liftIO . printError) $ do + ls <- getListingOrFail path + V.mapM_ printMatch ls + where + printMatch :: FileStatus -> Hdfs () + printMatch fs@FileStatus{..} = do + let path' = displayPath path fs + when (cond fs) (liftIO $ B.putStrLn path') + case fsFileType of + Dir -> printFindResults path' cond + _ -> return () ------------------------------------------------------------------------ -type Perms = Word16 - formatSize :: Word64 -> String formatSize b | b <= 0 = "0" | b < 1000 = show b <> "B" @@ -396,22 +398,22 @@ | b < 1000000000000 = show (b `div` 1000000000) <> "G" | otherwise = show (b `div` 1000000000000) <> "T" -formatBlockRepl :: Word32 -> String -formatBlockRepl x | x == 0 = "-" - | otherwise = show x +formatBlockReplication :: Word16 -> String +formatBlockReplication x | x == 0 = "-" + | otherwise = show x formatUTC :: UTCTime -> String formatUTC = formatTime defaultTimeLocale "%Y-%m-%d %H:%M" -formatMode :: FileType -> Perms -> String -formatMode File = ("-" <>) . formatPerms -formatMode Dir = ("d" <>) . formatPerms -formatMode SymLink = ("l" <>) . formatPerms +formatMode :: FileType -> Permission -> String +formatMode File = ("-" <>) . formatPermission +formatMode Dir = ("d" <>) . formatPermission +formatMode SymLink = ("l" <>) . formatPermission -formatPerms :: Perms -> String -formatPerms perms = format (perms `shiftR` 6) - <> format (perms `shiftR` 3) - <> format perms +formatPermission :: Permission -> String +formatPermission perms = format (perms `shiftR` 6) + <> format (perms `shiftR` 3) + <> format perms where format p = conv 0x4 "r" p <> conv 0x2 "w" p @@ -424,8 +426,9 @@ printError :: RemoteError -> IO () printError (RemoteError subject body) - | oneLiner = T.putStrLn firstLine - | otherwise = T.putStrLn subject >> T.putStrLn body + | oneLiner = T.putStrLn firstLine + | T.null body = T.putStrLn subject + | otherwise = T.putStrLn subject >> T.putStrLn body where oneLiner = subject `elem` [ "org.apache.hadoop.security.AccessControlException" , "org.apache.hadoop.fs.FileAlreadyExistsException" @@ -434,3 +437,28 @@ isAccessDenied :: RemoteError -> Bool isAccessDenied (RemoteError s _) = s == "org.apache.hadoop.security.AccessControlException" + +------------------------------------------------------------------------ + +infixr 5 // + +(//) :: HdfsPath -> HdfsPath -> HdfsPath +(//) xs ys | B.null xs = ys + | B.null ys = xs + | B.head ys == '/' = ys + | B.last xs == '/' = xs <> ys + | otherwise = xs <> "/" <> ys + +trimEnd :: Char -> ByteString -> ByteString +trimEnd b bs | B.null bs = B.empty + | B.last bs == b = trimEnd b (B.init bs) + | otherwise = bs + +------------------------------------------------------------------------ + +getListingOrFail :: HdfsPath -> Hdfs (V.Vector FileStatus) +getListingOrFail path = do + mls <- getListing path + case mls of + Nothing -> throwM $ RemoteError ("File/directory does not exist: " <> T.decodeUtf8 path) T.empty + Just ls -> return ls