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 []


------------------------------------------------------------------------------
-- Serialize utils.
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."


------------------------------------------------------------------------------
-- Time utils.
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
            }


------------------------------------------------------------------------------
-- Conduit utils.
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