module Codec.Archive.Zip.Util where
import Data.Bits ((.&.), shiftR, shiftL)
import Data.ByteString (ByteString)
import qualified Data.ByteString as B (length)
import Data.Time (UTCTime(..), TimeOfDay(..), fromGregorian, picosecondsToDiffTime, secondsToDiffTime, timeToTimeOfDay, toGregorian)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Data.Word (Word16, Word32)
import System.Time (ClockTime(..))
import Data.Conduit (Void, ConduitT)
import qualified Data.Conduit.List as CL (fold)
import Data.Digest.CRC32 (crc32Update)
import Data.Serialize.Get (Get, getWord32le, isEmpty, lookAhead, runGet, skip)
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
cond m a
conseq m a
altern = do
Bool
c <- m Bool
cond
if Bool
c then m a
conseq else m a
altern
many :: (Monad m, Functor m) => m (Maybe a) -> m [a]
many :: forall (m :: * -> *) a.
(Monad m, Functor m) =>
m (Maybe a) -> m [a]
many m (Maybe a)
p = do
Maybe a
r <- m (Maybe a)
p
case Maybe a
r of
Just a
x -> (a
xforall a. a -> [a] -> [a]
:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a.
(Monad m, Functor m) =>
m (Maybe a) -> m [a]
many m (Maybe a)
p
Maybe a
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return []
maybeEmpty :: Get a -> Get (Maybe a)
maybeEmpty :: forall a. Get a -> Get (Maybe a)
maybeEmpty Get a
p = do
Bool
e <- Get Bool
isEmpty
if Bool
e
then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
else forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get a
p
runGet' :: Get a -> ByteString -> a
runGet' :: forall a. Get a -> ByteString -> a
runGet' Get a
g ByteString
b =
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. HasCallStack => [Char] -> a
error forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a. Get a -> ByteString -> Either [Char] a
runGet Get a
g ByteString
b
signature :: Word32 -> Get ()
signature :: Word32 -> Get ()
signature Word32
sig = do
Word32
s <- forall a. Get a -> Get a
lookAhead Get Word32
getWord32le
if Word32
s forall a. Eq a => a -> a -> Bool
== Word32
sig
then Int -> Get ()
skip Int
4
else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Wrong signature."
data MSDOSDateTime = MSDOSDateTime
{ MSDOSDateTime -> Word16
msDOSDate :: Word16
, MSDOSDateTime -> Word16
msDOSTime :: Word16
} deriving (Int -> MSDOSDateTime -> ShowS
[MSDOSDateTime] -> ShowS
MSDOSDateTime -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MSDOSDateTime] -> ShowS
$cshowList :: [MSDOSDateTime] -> ShowS
show :: MSDOSDateTime -> [Char]
$cshow :: MSDOSDateTime -> [Char]
showsPrec :: Int -> MSDOSDateTime -> ShowS
$cshowsPrec :: Int -> MSDOSDateTime -> ShowS
Show)
msDOSDateTimeToUTCTime :: MSDOSDateTime -> UTCTime
msDOSDateTimeToUTCTime :: MSDOSDateTime -> UTCTime
msDOSDateTimeToUTCTime MSDOSDateTime
dosDateTime =
UTCTime { utctDay :: Day
utctDay = Integer -> Int -> Int -> Day
fromGregorian Integer
year Int
month Int
day
, utctDayTime :: DiffTime
utctDayTime =
Integer -> DiffTime
secondsToDiffTime forall a b. (a -> b) -> a -> b
$ Integer
hours forall a. Num a => a -> a -> a
* Integer
60 forall a. Num a => a -> a -> a
* Integer
60 forall a. Num a => a -> a -> a
+ Integer
minutes forall a. Num a => a -> a -> a
* Integer
60 forall a. Num a => a -> a -> a
+ Integer
seconds
}
where
seconds :: Integer
seconds = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
2 forall a. Num a => a -> a -> a
* (Word16
dosTime forall a. Bits a => a -> a -> a
.&. Word16
0x1F)
minutes :: Integer
minutes = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall a. Bits a => a -> Int -> a
shiftR Word16
dosTime Int
5) forall a. Bits a => a -> a -> a
.&. Word16
0x3F
hours :: Integer
hours = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Bits a => a -> Int -> a
shiftR Word16
dosTime Int
11
day :: Int
day = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Word16
dosDate forall a. Bits a => a -> a -> a
.&. Word16
0x1F
month :: Int
month = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ (forall a. Bits a => a -> Int -> a
shiftR Word16
dosDate Int
5) forall a. Bits a => a -> a -> a
.&. Word16
0xF
year :: Integer
year = Integer
1980 forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word16
dosDate Int
9)
dosDate :: Word16
dosDate = MSDOSDateTime -> Word16
msDOSDate MSDOSDateTime
dosDateTime
dosTime :: Word16
dosTime = MSDOSDateTime -> Word16
msDOSTime MSDOSDateTime
dosDateTime
utcTimeToMSDOSDateTime :: UTCTime -> MSDOSDateTime
utcTimeToMSDOSDateTime :: UTCTime -> MSDOSDateTime
utcTimeToMSDOSDateTime UTCTime
utcTime =
MSDOSDateTime { msDOSDate :: Word16
msDOSDate = Word16
dosDate
, msDOSTime :: Word16
msDOSTime = Word16
dosTime
}
where
dosTime :: Word16
dosTime = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
seconds forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftL Int
minutes Int
5 forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftL Int
hours Int
11
dosDate :: Word16
dosDate = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ Int
day forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftL Int
month Int
5 forall a. Num a => a -> a -> a
+ forall a. Bits a => a -> Int -> a
shiftL Int
year Int
9
seconds :: Int
seconds = forall a. Enum a => a -> Int
fromEnum (TimeOfDay -> Pico
todSec TimeOfDay
tod) forall a. Integral a => a -> a -> a
`div` Int
2
minutes :: Int
minutes = TimeOfDay -> Int
todMin TimeOfDay
tod
hours :: Int
hours = TimeOfDay -> Int
todHour TimeOfDay
tod
tod :: TimeOfDay
tod = DiffTime -> TimeOfDay
timeToTimeOfDay forall a b. (a -> b) -> a -> b
$ UTCTime -> DiffTime
utctDayTime UTCTime
utcTime
year :: Int
year = forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
year' forall a. Num a => a -> a -> a
- Int
1980
(Integer
year', Int
month, Int
day) = Day -> (Integer, Int, Int)
toGregorian forall a b. (a -> b) -> a -> b
$ UTCTime -> Day
utctDay UTCTime
utcTime
clockTimeToUTCTime :: ClockTime -> UTCTime
clockTimeToUTCTime :: ClockTime -> UTCTime
clockTimeToUTCTime (TOD Integer
seconds Integer
picoseconds) =
let utcTime :: UTCTime
utcTime = POSIXTime -> UTCTime
posixSecondsToUTCTime forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
seconds in
UTCTime
utcTime { utctDayTime :: DiffTime
utctDayTime = UTCTime -> DiffTime
utctDayTime UTCTime
utcTime
forall a. Num a => a -> a -> a
+ Integer -> DiffTime
picosecondsToDiffTime Integer
picoseconds
}
crc32Sink :: Monad m => ConduitT ByteString Void m Word32
crc32Sink :: forall (m :: * -> *). Monad m => ConduitT ByteString Void m Word32
crc32Sink =
forall (m :: * -> *) b a o.
Monad m =>
(b -> a -> b) -> b -> ConduitT a o m b
CL.fold forall a. CRC32 a => Word32 -> a -> Word32
crc32Update Word32
0
sizeSink :: Monad m => ConduitT ByteString Void m Int
sizeSink :: forall (m :: * -> *). Monad m => ConduitT ByteString Void m Int
sizeSink =
forall (m :: * -> *) b a o.
Monad m =>
(b -> a -> b) -> b -> ConduitT a o m b
CL.fold (\Int
acc ByteString
input -> ByteString -> Int
B.length ByteString
input forall a. Num a => a -> a -> a
+ Int
acc) Int
0