Reading from encrypted zips in Haskell using LibZip - haskell

I try to open encrypted zip file and then to write it again. Unfortunately I keep getting "Read error" and don't understand why. I find the documentation of LibZip for Haskell hard to follow so would be grateful for any explanation on how it works. Here is my code:
writeZip :: FilePath -> [(FilePath, ZipSource)] -> IO ()
writeZip zipName zipContent = withArchive [CreateFlag] zipName $ do
mapM_ (uncurry addFile) zipContent
readEncryptedZip :: FilePath -> Password -> IO [(FilePath, ZipSource)]
readEncryptedZip zipName passwd = withEncryptedArchive [CheckConsFlag]
passwd zipName $ do
nn <- fileNames []
ss <- mapM (\n -> sourceFile n 0 (-1)) nn
return $ zip nn ss
and main module:
main = readEncryptedZip "protected_file2.zip" "ll" >>= writeZip "unprotected.zip"
Using Codec.Archive.LibZip, ghci version 8.0.1, MacOs Sierra 10.12
Thanks in advance!

Related

Haskell Twitch (high level file watcher DSL) executing 2 times

I want to use Twitch package to copy any javascript files in the "central" directory to the "back" and "front" directories. This is the code:
{-# LANGUAGE OverloadedStrings #-}
module Main where
import Data.List
( isPrefixOf
, tails
, findIndex
)
import System.Directory
( createDirectoryIfMissing
, removeDirectoryRecursive
, copyFile
)
import System.Directory.Recursive
( getSubdirsRecursive
, getFilesRecursive
)
import Twitch
( defaultMain
, (|>)
)
main :: IO ()
main = do
putStrLn "Haskell works <(^u^)>"
-- Copy central folder to back and front, and setup recopy when central changes
copyCentral
defaultMain $ do
"./central/**/*.js" |> copyFileToBackAndFront
copyCentral :: IO ()
copyCentral = do
createDirectoryIfMissing False "./back/src/central/"
removeDirectoryRecursive "./back/src/central"
createDirectoryIfMissing False "./front/src/central/"
removeDirectoryRecursive "./front/src/central"
centralFiles <- getFilesRecursive "./central/"
centralDirs <- getSubdirsRecursive "./central/"
mapM_ (\d -> createDirectoryIfMissing True $ "./back/src" ++ tail d) centralDirs
mapM_ (\d -> createDirectoryIfMissing True $ "./front/src" ++ tail d) centralDirs
mapM_ (\f -> copyFile f $ "./back/src" ++ tail f) centralFiles
mapM_ (\f -> copyFile f $ "./front/src" ++ tail f) centralFiles
copyFileToBackAndFront :: FilePath -> IO ()
copyFileToBackAndFront absolutePath =
maybe
(putStrLn "Error in the file path")
getRelativePathAndCopy
(findIndex (isPrefixOf "central") (tails absolutePath))
where
getRelativePathAndCopy n = do
let relativePath = drop n absolutePath
copyFile relativePath $ "./back/src/" ++ relativePath
copyFile relativePath $ "./front/src/" ++ relativePath
putStrLn $ "Copied file " ++ relativePath ++ " to back and front"
And surprisingly it works! But i get the putStrLn output 2 times:
Copied file central\models\Board\Board.js to back and front
Copied file central\models\Board\Board.js to back and front
And I suspect it may be because of the program running in 2 threads, because sometimes I get interlaced output:
CCooppiieedd ffiillee cceennttrraall\\mmooddeellss\\BBooaarrdd\\BBooaarrdd..jjss ttoo bbaacckk aanndd ffrroonntt
CopiCeodp ifeidl ef icleen tcreanlt\rmaold\emlosd\eBlosa\rBdo\aBroda\rBdo.ajrsd .tjos btaoc kb aacnkd afnrdo nftr
ont
Also this happends when i run cabal v2-repl, i just tried cabal v2-run myprogram & and it does not work at all :(
Any help with both issues please?

GHCI Failed to load interface for ‘System.Time’

I am learning Haskell and trying to build an example from the book.
When I load the code using ":l BetterPredicate" command in GHCI, I am getting following error:
Prelude> :l BetterPredicate
[1 of 2] Compiling RecursiveContents ( RecursiveContents.hs, interpreted )
RecursiveContents.hs:12:32: warning: [-Wtabs]
Tab character found here.
Please use spaces instead.
[2 of 2] Compiling Main ( BetterPredicate.hs, interpreted )
BetterPredicate.hs:3:1: error:
Failed to load interface for ‘System.Time’
Perhaps you meant
System.CPUTime (from base-4.9.1.0)
System.Cmd (from process-1.4.3.0)
System.Mem (from base-4.9.1.0)
Use -v to see a list of the files searched for.
Failed, modules loaded: RecursiveContents.
Here is the code I am trying to compile:
import Control.Monad (filterM)
import System.Directory (Permissions (..), getModificationTime, getPermissions)
import System.Time (ClockTime(..))
import System.FilePath (takeExtension)
import Control.Exception (bracket, handle)
import System.IO (IOMode(..), hClose, hFileSize, openFile)
-- Our functions
import RecursiveContents (getRecursiveContents)
type Predicate = FilePath -- Path to directory entry
-> Permissions -- permissions
-> Maybe Integer -- file size (Nothing if not file)
-> ClockTime -- last modified
-> Bool
-- TBD
getFileSize :: FilePath -> IO (Maybe Integer)
betterFind :: Predicate -> FilePath -> IO [FilePath]
betterFind p path = getRecursiveContents >>= filterM check
where check name = do
perms <- getPermissions name
size <- getFileSize name
modified <- getModificationTime name
return (p name perms size modified)
simpleFileSize :: FilePath -> IO Integer
simpleFileSize path = do
h <- openFile path ReadMode
size <- hFileSize h
hClose
return size
saferFileSize :: FilePath -> IO (Maybe Integer)
saferFileSize path = handle (\_ -> return Nothing) $ do
h <- openFile path ReadMode
size <- hFileSize h
hClose
return (Just size)
getFileSize :: FilePath -> IO (Maybe Integer)
getFileSize path = handle (\_ -> return Nothing) $
bracket (openFile path ReadOnly) hClose $ \h -> do
size <- hFileSize h
hClose
return (Just size)
type InfoP a = FilePath -- path to directory entry
-> Permissions -- permissions
-> Maybe Integer -- file size (Nothing if not file)
-> ClockTime -- last modified
-> a
pathP :: InfoP FilePath
pathP path _ _ _ = path
sizeP :: InfoP Integer
sizeP _ _ (Just size) _ = size
sizeP _ _ Nothing _ = -1
equalP :: (Eq a) => InfoP a -> a -> InfoP Bool
--equalP f k = \w x y z -> f w x y z == k
equalP f k w x y z = f w x y z == k
According to the documentation: http://hackage.haskell.org/package/old-time-1.1.0.3/docs/System-Time.html this module is part of old-time library, so I suppose I need to import it somehow, but I am not sure how to do it if I am not building a package using Cabal (there is no *.cabal file) or something else, I just want to use my code in GHCI.
Just use cabal install to install a package globally
$ cabal install old-time
It will give you a warning, but that's ok if you are just using it for ghci support.
Also note the documentation warns:
This library is deprecated, please look at Data.Time in the time package instead.

No instance for (Show (FilePath -> IO [FilePath])) arising from a use of ‘print’

I am trying to fix and run every example on the Real World Haskell book and learn something in the process and I got stuck at chapter 9. By reading the comments I got the following code to compile:
FoldDir.hs:
import ControlledVisit
import Data.Char (toLower)
import Data.Time.Clock (UTCTime(..))
import System.Directory (Permissions(..))
import System.FilePath ((</>), takeExtension, takeFileName)
data Iterate seed
= Done { unwrap :: seed }
| Skip { unwrap :: seed }
| Continue { unwrap :: seed }
deriving (Show)
type Iterator seed = seed -> Info -> Iterate seed
foldTree :: Iterator a -> a -> FilePath -> IO a
foldTree iter initSeed path = do
endSeed <- fold initSeed path
return (unwrap endSeed)
where
fold seed subpath = getUsefulContents subpath >>= walk seed
walk seed (name : names) = do
let path' = path </> name
info <- getInfo path'
case iter seed info of
done # (Done _) -> return done
Skip seed' -> walk seed' names
Continue seed'
| isDirectory info -> do
next <- fold seed' path'
case next of
done # (Done _) -> return done
seed'' -> walk (unwrap seed'') names
| otherwise -> walk seed' names
walk seed _ = return (Continue seed)
atMostThreePictures :: Iterator [FilePath]
atMostThreePictures paths info
| length paths == 3
= Done paths
| isDirectory info && takeFileName path == ".svn"
= Skip paths
| extension `elem` [".jpg", ".png"]
= Continue (path : paths)
| otherwise
= Continue paths
where
extension = map toLower (takeExtension path)
path = infoPath info
countDirectories count info =
Continue (if isDirectory info then count + 1 else count)
ControlledVisit.hs:
module ControlledVisit where
import Control.Monad (forM, liftM)
import Data.Time.Clock (UTCTime(..))
import System.FilePath ((</>))
import System.Directory
( Permissions(..)
, getModificationTime
, getPermissions
, getDirectoryContents
)
import Control.Exception
( bracket
, handle
, SomeException(..)
)
import System.IO
( IOMode(..)
, hClose
, hFileSize
, openFile
)
data Info = Info
{ infoPath :: FilePath
, infoPerms :: Maybe Permissions
, infoSize :: Maybe Integer
, infoModTime :: Maybe UTCTime
} deriving (Eq, Ord, Show)
getInfo :: FilePath -> IO Info
getInfo path = do
perms <- maybeIO (getPermissions path)
size <- maybeIO (bracket (openFile path ReadMode) hClose hFileSize)
modified <- maybeIO (getModificationTime path)
return (Info path perms size modified)
traverseDirs :: ([Info] -> [Info]) -> FilePath -> IO [Info]
traverseDirs order path = do
names <- getUsefulContents path
contents <- mapM getInfo (path : map (path </>) names)
liftM concat $ forM (order contents) $ \ info -> do
if isDirectory info && infoPath info /= path
then traverseDirs order (infoPath info)
else return [info]
getUsefulContents :: FilePath -> IO [String]
getUsefulContents path = do
names <- getDirectoryContents path
return (filter (`notElem` [".", ".."]) names)
isDirectory :: Info -> Bool
isDirectory = maybe False searchable . infoPerms
maybeIO :: IO a -> IO (Maybe a)
maybeIO act = handle (\ (SomeException _) -> return Nothing) (Just `liftM` act)
traverseVerbose order path = do
names <- getDirectoryContents path
let usefulNames = filter (`notElem` [".", ".."]) names
contents <- mapM getEntryName ("" : usefulNames)
recursiveContents <- mapM recurse (order contents)
return (concat recursiveContents)
where
getEntryName name = getInfo (path </> name)
isDirectory info = case infoPerms info of
Nothing -> False
Just perms -> searchable perms
recurse info = do
if isDirectory info && infoPath info /= path
then traverseVerbose order (infoPath info)
else return [info]
But when I try to run it in GHCi as explained in the book it fails with a weird error that as far as I understand is about GHCi itself:
Prelude> :l FoldDir.hs
[1 of 2] Compiling ControlledVisit ( ControlledVisit.hs, interpreted )
[2 of 2] Compiling Main ( FoldDir.hs, interpreted )
Ok, two modules loaded.
*Main> foldTree atMostThreePictures []
<interactive>:2:1: error:
• No instance for (Show (FilePath -> IO [FilePath]))
arising from a use of ‘print’
(maybe you haven't applied a function to enough arguments?)
• In a stmt of an interactive GHCi command: print it
I think I understand the No instance for (Show (FilePath -> IO [FilePath])) part but I am clueless about the print it. I know it is a special variable in GHCi that stores the evaluation result of the last expression and I guess the code is trying to print a function or a monad, but I don't get where it is happening.
As simple as possible - signature of Your function foldTree is:
foldTree :: Iterator a -> a -> FilePath -> IO a
You are supplying it with two arguments, one of type Iterator [FilePath] and second of type FilePath. Due to default partial application such call returns function with signature:
FilePath -> IO [FilePath]
GHCI wants to display the result of Your call but it cannot, as this type has no defined instance of typeclass Show. And so, it gives You an error telling exactly this.

Find a given string in given path

As title states, I am trying to find a given string within a given path. Here is what I come up so far:
getRecursiveContents :: FilePath -> IO [FilePath]
getRecursiveContents topdir = do
names <- getDirectoryContents topdir
let properNames = filter (`notElem` [".", ".."]) names
paths <- forM properNames $ \name -> do
let path = topdir </> name
isDirectory <- doesDirectoryExist path
if isDirectory
then getRecursiveContents path
else return [path]
return (concat paths)
findInFile:: String -> FilePath -> IO Bool
findInFile needle filePath= do
content <- readFile filePath
return (needle `L.isInfixOf` content)
findInFolder:: (String -> Bool) -> FilePath -> String -> IO [IO Bool]
findInFolder p path needle = do
files <- getRecursiveContents path
return (map (findInFile needle) (filter p files))
find = findInFolder (\p -> takeExtension p `elem` [".py", ".xml", ".html"])
I can :
*Main> findInFile "search_string" "./path/to/a/file"
True
Which is perfect but I cannot do the same search for a folder:
*Main> find "./path/to/a/folder" "search_string"
*Main>
In my file system ./path/to/a/file is located under ./path/to/a/folder. Thus I was expecting the same result.
What am I doing wrong?
Note: getRecursiveContents is from real world haskell.
It does indeed work. The only issue is with how things are printed. When you type some expressions into ghci, it will call print on that expression. If the value has type IO x, it will execute the IO action and print x only if it has a Show instance; otherwise it prints no additional information.
find "./path/to/a/folder" "search_string" produces a list of IO actions, which have no Show instance. You can get the result of find, which is again a list of IO actions, and then execute them:
> x <- find "./path/to/a/folder" "search_string"
> sequence x
> [True, False ...
Likely you wanted to do this originally in your function. Simply make the following changes:
findInFolder:: (String -> Bool) -> FilePath -> String -> IO [Bool]
findInFolder p path needle = do
files <- getRecursiveContents path
mapM (findInFile needle) (filter p files)
Now findInFolder will work as you expect.

Listing a TAR archive in Haskell

I'm currently trying to figure out how to list a (gzipped) TAR archive in Haskell. Codec.Archive.Tar seems to be the right choice for the task, but I can't figure out how map the entryPath over the Entries monoid.
Let's assume the TAR contains the entries (only files) a.txt, b.txt, c.txt and is named foo.tar.gz. Here's my code to read the file:
import qualified Codec.Archive.Tar as Tar
import qualified Data.ByteString.Lazy as BS
import qualified Codec.Compression.GZip as GZip
foldEntryToPath :: Tar.Entry -> [String] -> [String]
foldEntryToPath entry list = list ++ [show $ Tar.entryPath entry]
-- Converts TAR errors to a string.
entryFailMapper :: String -> [String]
entryFailMapper err = [err]
main = do
fileContent <- fmap GZip.decompress $ BS.readFile "foo.tar.gz"
entries <- fmap Tar.read fileContent :: Tar.Entries
-- Here I don't know how to correctly apply fmap
entryPaths <- Tar.foldEntries foldEntryToPath [] entryFailMapper entries :: [String]
-- This should print ["a.txt", "b.txt", "c.txt"]
print entryPaths
Here's the error printed by runghc:
readtar.hs:14:49:
Expecting one more argument to `Tar.Entries'
In an expression type signature: Tar.Entries
In a stmt of a 'do' block:
entries <- fmap Tar.read fileContent :: Tar.Entries
In the expression:
do { fileContent <- fmap GZip.decompress
$ BS.readFile "foo.tar.gz";
entries <- fmap Tar.read fileContent :: Tar.Entries;
entryPaths <- Tar.foldEntries
foldEntryToPath [] (\ x -> [...]) entries ::
[String];
print entryPaths }
So far I have little knowledge of Haskell, but by reading the docs I don't know why Tar.Entries is a typeclass (is that the correct term when it says expecting n more arguments to <type>?) or what's the correct type to use.
Any help will be appreciated!
I think foldEntryToPath needs to be fixed:
foldEntryToPath :: Tar.Entry -> [String] -> [String]
foldEntryToPath entry list = (show $ Tar.entryPath entry) : list
And in main:
fileContent <- fmap GZip.decompress $ BS.readFile "foo.tar.gz"
let entries = Tar.read fileContent
let entryPaths = Tar.foldEntries foldEntryToPath [] entryFailMapper entries
print entryPaths
With a bit of fiddling around, I now have a full working example.
One of the main problems was the foldr-like behaviour of Tar.foldEntries. In reality, I have a ~25GB TAR file containing a few millions of entries. See the HaskellWiki for information on why this is a bad idea. (Note: Being efficient wasn't the question, but I think the foldEntries-free solution is better for this specific usecase.
Therefore I wrote my own recursive Tar.Entries -> [String] mapping function. Even if errors currently aren't handled particularly well, it should provide a good starting point.
import qualified Codec.Archive.Tar as Tar
import qualified Data.ByteString.Lazy as BS
import qualified Codec.Compression.GZip as GZip
entriesToPaths :: Tar.Entries Tar.FormatError -> [String]
entriesToPaths (Tar.Next entry entries) = [Tar.entryPath entry] ++ entriesToPaths entries
entriesToPaths Tar.Done = [] :: [String]
entriesToPaths (Tar.Fail e) = ["Error"]
main = do
fileContent <- fmap GZip.decompress $ BS.readFile "foo.tar.gz"
let entries = Tar.read fileContent
let entryPaths = entriesToPaths entries
-- This should print ["a.txt", "b.txt", "c.txt"]
print entryPaths

Resources