{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}
module Cabal.Index (
    -- * Metadata construction
    indexMetadata,
    cachedHackageMetadata,
    -- ** Exceptions thrown
    MetadataParseError (..),
    InvalidData (..),
    InvalidIndexFile (..),
    NoHackageRepository (..),
    -- * Metadata types
    PackageInfo (..),
    piPreferredVersions,
    ReleaseInfo (..),
    -- ** Hashes
    SHA256 (..),
    sha256,
    mkSHA256,
    unsafeMkSHA256,
    getSHA256,

    {-
    MD5,
    validMD5,
    mkMD5,
    unsafeMkMD5,
    getMD5,
    -}
    -- * Generic folding
    foldIndex,
    IndexEntry (..),
    IndexFileType (..),
) where

import Prelude hiding (pi)

import Control.Exception (Exception, IOException, bracket, evaluate, handle, throwIO)
import Data.Bits         (shiftL, shiftR, (.&.), (.|.))
import Data.ByteString   (ByteString)
import Data.Int          (Int64)
import Data.Map.Strict   (Map)
import Data.Text         (Text)
import Data.Word         (Word32, Word64)
import GHC.Generics      (Generic)

import qualified Codec.Archive.Tar                   as Tar
import qualified Codec.Archive.Tar.Entry             as Tar
import qualified Codec.Archive.Tar.Index             as Tar
import qualified Crypto.Hash.SHA256                  as SHA256
import qualified Data.Aeson                          as A
import qualified Data.Binary                         as Binary
import qualified Data.Binary.Get                     as Binary.Get
import qualified Data.Binary.Put                     as Binary.Put
import qualified Data.ByteString                     as BS
import qualified Data.ByteString.Base16              as Base16
import qualified Data.ByteString.Lazy                as LBS
import qualified Data.ByteString.Unsafe              as BS.Unsafe
import qualified Data.Map.Strict                     as Map
import qualified Data.Text.Encoding                  as TE
import qualified Data.Time.Clock.POSIX               as Time
import qualified Distribution.Compat.CharParsing     as C
import qualified Distribution.Package                as C
import qualified Distribution.Parsec                 as C
import qualified Distribution.Parsec.FieldLineStream as C
import qualified Distribution.Pretty                 as C
import qualified Distribution.Utils.Generic          as C
import qualified Distribution.Version                as C
import qualified Lukko
import qualified System.Directory                    as D
import qualified System.FilePath                     as FP
import qualified Text.PrettyPrint                    as PP

import Data.Binary.Instances ()

import Cabal.Config (cfgRepoIndex, hackageHaskellOrg, readConfig)

-------------------------------------------------------------------------------
-- Generic folding
-------------------------------------------------------------------------------

-- | Fold over Hackage @01-index.tar@ file.
--
-- May throw 'Tar.FormatError' or 'InvalidIndexFile'.
foldIndex
    :: FilePath -- ^ path to the @01-index.tar@ file
    -> a        -- ^ initial value
    -> (IndexEntry -> ByteString -> a -> IO a)
    -> IO a
foldIndex :: forall a.
[Char] -> a -> (IndexEntry -> ByteString -> a -> IO a) -> IO a
foldIndex [Char]
fp a
ini IndexEntry -> ByteString -> a -> IO a
action = do
    ByteString
contents <- [Char] -> IO ByteString
LBS.readFile [Char]
fp
    Acc Word32
_ a
result <- forall a e.
(a -> Entry -> IO a) -> (e -> IO a) -> a -> Entries e -> IO a
foldEntries Acc a -> Entry -> IO (Acc a)
go forall e a. Exception e => e -> IO a
throwIO (forall a. Word32 -> a -> Acc a
Acc Word32
0 a
ini) (ByteString -> Entries FormatError
Tar.read ByteString
contents)
    forall (m :: * -> *) a. Monad m => a -> m a
return a
result
  where
    go :: Acc a -> Entry -> IO (Acc a)
go (Acc Word32
offset a
acc) Entry
entry = case Entry -> EntryContent
Tar.entryContent Entry
entry of
        -- file entry
        Tar.NormalFile ByteString
contents Int64
_ -> do
            ByteString
bs <- forall a. a -> IO a
evaluate forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict ByteString
contents
            IndexFileType
idxFile <- forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e a. Exception e => e -> IO a
throwIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> InvalidIndexFile
InvalidIndexFile) forall (m :: * -> *) a. Monad m => a -> m a
return ([Char] -> Either [Char] IndexFileType
elaborateIndexFile [Char]
fpath)
            let entry' :: IndexEntry
entry' = IndexEntry
                    { entryPath :: [Char]
entryPath        = TarPath -> [Char]
Tar.fromTarPath (Entry -> TarPath
Tar.entryTarPath Entry
entry)
                    , entryPermissions :: Permissions
entryPermissions = Entry -> Permissions
Tar.entryPermissions Entry
entry
                    , entryOwnership :: Ownership
entryOwnership   = Entry -> Ownership
Tar.entryOwnership Entry
entry
                    , entryTime :: Int64
entryTime        = Entry -> Int64
Tar.entryTime Entry
entry
                    , entryType :: IndexFileType
entryType        = IndexFileType
idxFile
                    , entryTarOffset :: Word32
entryTarOffset   = Word32
offset
                    }
            a
next <- IndexEntry -> ByteString -> a -> IO a
action IndexEntry
entry' ByteString
bs a
acc
            forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Word32 -> a -> Acc a
Acc (Entry -> Word32 -> Word32
Tar.nextEntryOffset Entry
entry Word32
offset) a
next)

        -- all other entries
        EntryContent
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Word32 -> a -> Acc a
Acc (Entry -> Word32 -> Word32
Tar.nextEntryOffset Entry
entry Word32
offset) a
acc)
     where
       fpath :: [Char]
fpath = Entry -> [Char]
Tar.entryPath Entry
entry

data Acc a = Acc !Tar.TarEntryOffset !a

foldEntries :: (a -> Tar.Entry -> IO a) -> (e -> IO a) -> a -> Tar.Entries e -> IO a
foldEntries :: forall a e.
(a -> Entry -> IO a) -> (e -> IO a) -> a -> Entries e -> IO a
foldEntries a -> Entry -> IO a
next e -> IO a
fail' = a -> Entries e -> IO a
go where
    go :: a -> Entries e -> IO a
go !a
acc (Tar.Next Entry
e Entries e
es) = a -> Entry -> IO a
next a
acc Entry
e forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
acc' -> a -> Entries e -> IO a
go a
acc' Entries e
es
    go  a
_   (Tar.Fail e
e)    = e -> IO a
fail' e
e
    go  a
acc Entries e
Tar.Done        = forall (m :: * -> *) a. Monad m => a -> m a
return a
acc

-------------------------------------------------------------------------------
-- IndexFile
-------------------------------------------------------------------------------

data IndexEntry = IndexEntry
    { IndexEntry -> [Char]
entryPath        :: !FilePath
    , IndexEntry -> IndexFileType
entryType        :: !IndexFileType
    , IndexEntry -> Permissions
entryPermissions :: !Tar.Permissions
    , IndexEntry -> Ownership
entryOwnership   :: !Tar.Ownership
    , IndexEntry -> Int64
entryTime        :: !Tar.EpochTime
    , IndexEntry -> Word32
entryTarOffset   :: !Tar.TarEntryOffset
    }
  deriving Int -> IndexEntry -> ShowS
[IndexEntry] -> ShowS
IndexEntry -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IndexEntry] -> ShowS
$cshowList :: [IndexEntry] -> ShowS
show :: IndexEntry -> [Char]
$cshow :: IndexEntry -> [Char]
showsPrec :: Int -> IndexEntry -> ShowS
$cshowsPrec :: Int -> IndexEntry -> ShowS
Show

-- | Varions files in @01-index.tar@.
data IndexFileType
    = CabalFile C.PackageName C.Version
    | PackageJson C.PackageName C.Version
    | PreferredVersions C.PackageName
  deriving (Int -> IndexFileType -> ShowS
[IndexFileType] -> ShowS
IndexFileType -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [IndexFileType] -> ShowS
$cshowList :: [IndexFileType] -> ShowS
show :: IndexFileType -> [Char]
$cshow :: IndexFileType -> [Char]
showsPrec :: Int -> IndexFileType -> ShowS
$cshowsPrec :: Int -> IndexFileType -> ShowS
Show)

-- | Thrown when when not a @.cabal@, @package.json@ or @preferred-versions@
-- file is encountered.
newtype InvalidIndexFile = InvalidIndexFile String
  deriving (Int -> InvalidIndexFile -> ShowS
[InvalidIndexFile] -> ShowS
InvalidIndexFile -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [InvalidIndexFile] -> ShowS
$cshowList :: [InvalidIndexFile] -> ShowS
show :: InvalidIndexFile -> [Char]
$cshow :: InvalidIndexFile -> [Char]
showsPrec :: Int -> InvalidIndexFile -> ShowS
$cshowsPrec :: Int -> InvalidIndexFile -> ShowS
Show)

instance Exception InvalidIndexFile

elaborateIndexFile :: FilePath -> Either String IndexFileType
elaborateIndexFile :: [Char] -> Either [Char] IndexFileType
elaborateIndexFile [Char]
fp = case [Char] -> [[Char]]
FP.splitDirectories [Char]
fp of
    [ [Char]
pn, [Char]
v, [Char]
pnF ]
        | Just PackageName
pn' <- forall a. Parsec a => [Char] -> Maybe a
C.simpleParsec [Char]
pn
        , Just Version
v'  <- forall a. Parsec a => [Char] -> Maybe a
C.simpleParsec [Char]
v
        , [Char]
pnF forall a. Eq a => a -> a -> Bool
== [Char]
pn forall a. [a] -> [a] -> [a]
++ [Char]
".cabal"
        -> forall a b. b -> Either a b
Right (PackageName -> Version -> IndexFileType
CabalFile PackageName
pn' Version
v')
    [ [Char]
pn, [Char]
v, [Char]
pj ]
        | Just PackageName
pn' <- forall a. Parsec a => [Char] -> Maybe a
C.simpleParsec [Char]
pn
        , Just Version
v'  <- forall a. Parsec a => [Char] -> Maybe a
C.simpleParsec [Char]
v
        , [Char]
pj forall a. Eq a => a -> a -> Bool
== [Char]
"package.json"
        -> forall a b. b -> Either a b
Right (PackageName -> Version -> IndexFileType
PackageJson PackageName
pn' Version
v')
    [ [Char]
pn, [Char]
pref ]
        | Just PackageName
pn' <- forall a. Parsec a => [Char] -> Maybe a
C.simpleParsec [Char]
pn
        , [Char]
pref forall a. Eq a => a -> a -> Bool
== [Char]
"preferred-versions"
        -> forall a b. b -> Either a b
Right (PackageName -> IndexFileType
PreferredVersions PackageName
pn')
    [[Char]]
xs -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> [Char]
show [[Char]]
xs

-------------------------------------------------------------------------------
-- SHA256
-------------------------------------------------------------------------------

-- | SHA256 digest. 256 bytes.
data SHA256 = SHA256 !Word64 !Word64 !Word64 !Word64
  deriving (SHA256 -> SHA256 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SHA256 -> SHA256 -> Bool
$c/= :: SHA256 -> SHA256 -> Bool
== :: SHA256 -> SHA256 -> Bool
$c== :: SHA256 -> SHA256 -> Bool
Eq, Eq SHA256
SHA256 -> SHA256 -> Bool
SHA256 -> SHA256 -> Ordering
SHA256 -> SHA256 -> SHA256
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SHA256 -> SHA256 -> SHA256
$cmin :: SHA256 -> SHA256 -> SHA256
max :: SHA256 -> SHA256 -> SHA256
$cmax :: SHA256 -> SHA256 -> SHA256
>= :: SHA256 -> SHA256 -> Bool
$c>= :: SHA256 -> SHA256 -> Bool
> :: SHA256 -> SHA256 -> Bool
$c> :: SHA256 -> SHA256 -> Bool
<= :: SHA256 -> SHA256 -> Bool
$c<= :: SHA256 -> SHA256 -> Bool
< :: SHA256 -> SHA256 -> Bool
$c< :: SHA256 -> SHA256 -> Bool
compare :: SHA256 -> SHA256 -> Ordering
$ccompare :: SHA256 -> SHA256 -> Ordering
Ord)

-- | Hash strict 'ByteString'.
sha256 :: ByteString -> SHA256
sha256 :: ByteString -> SHA256
sha256 = ByteString -> SHA256
sha256Digest forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
check forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
SHA256.hash
  where
    check :: ByteString -> ByteString
check ByteString
bs
        | ByteString -> Int
BS.length ByteString
bs forall a. Eq a => a -> a -> Bool
== Int
32 = ByteString
bs
        | Bool
otherwise          = forall a. HasCallStack => [Char] -> a
error forall a b. (a -> b) -> a -> b
$ [Char]
"panic! SHA256.hash returned ByteStrign of length " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (ByteString -> Int
BS.length ByteString
bs) forall a. [a] -> [a] -> [a]
++ [Char]
" /= 32"

-- unsafe construct. You should check the length of bytestring beforehand.
sha256Digest :: ByteString -> SHA256
sha256Digest :: ByteString -> SHA256
sha256Digest ByteString
bs = Word64 -> Word64 -> Word64 -> Word64 -> SHA256
SHA256
    (   forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
0)) Int
56
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
1)) Int
48
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
2)) Int
40
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
3)) Int
32
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
4)) Int
24
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
5)) Int
16
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
6))  Int
8
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
7))  Int
0
    )
    (   forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
8)) Int
56
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
9)) Int
48
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
10)) Int
40
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
11)) Int
32
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
12)) Int
24
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
13)) Int
16
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
14))  Int
8
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
15))  Int
0
    )
    (   forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
16)) Int
56
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
17)) Int
48
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
18)) Int
40
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
19)) Int
32
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
20)) Int
24
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
21)) Int
16
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
22))  Int
8
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
23))  Int
0
    )
    (   forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
24)) Int
56
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
25)) Int
48
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
26)) Int
40
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
27)) Int
32
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
28)) Int
24
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
29)) Int
16
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
30))  Int
8
    forall a. Bits a => a -> a -> a
.|. forall a. Bits a => a -> Int -> a
shiftL (forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
31))  Int
0
    )

-- | Make SHA256 from base16-encoded string.
mkSHA256 :: Text -> Either String SHA256
mkSHA256 :: Text -> Either [Char] SHA256
mkSHA256 Text
t = case ByteString -> Either [Char] ByteString
Base16.decode (Text -> ByteString
TE.encodeUtf8 Text
t) of
    Left [Char]
err                      -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Base16 decoding failure: " forall a. [a] -> [a] -> [a]
++ [Char]
err
    Right ByteString
bs | ByteString -> Int
BS.length ByteString
bs forall a. Eq a => a -> a -> Bool
/= Int
32 -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Base16 of wrong length, expected 32, got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (ByteString -> Int
BS.length ByteString
bs)
             | Bool
otherwise          -> forall a b. b -> Either a b
Right (ByteString -> SHA256
sha256Digest ByteString
bs)

-- | Unsafe variant of 'mkSHA256'.
unsafeMkSHA256 :: Text -> SHA256
unsafeMkSHA256 :: Text -> SHA256
unsafeMkSHA256 = 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 b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] SHA256
mkSHA256

-- | Get 'ByteString' representation of 'SHA256'.
getSHA256 :: SHA256 -> ByteString
getSHA256 :: SHA256 -> ByteString
getSHA256 (SHA256 Word64
a Word64
b Word64
c Word64
d) = [Word8] -> ByteString
BS.pack
    [ forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
56 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
48 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
40 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
32 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
24 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
16 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
a  Int
8 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
a  Int
0 forall a. Bits a => a -> a -> a
.&. Word64
0xff)

    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
b Int
56 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
b Int
48 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
b Int
40 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
b Int
32 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
b Int
24 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
b Int
16 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
b  Int
8 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
b  Int
0 forall a. Bits a => a -> a -> a
.&. Word64
0xff)

    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
c Int
56 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
c Int
48 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
c Int
40 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
c Int
32 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
c Int
24 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
c Int
16 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
c  Int
8 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
c  Int
0 forall a. Bits a => a -> a -> a
.&. Word64
0xff)

    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
d Int
56 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
d Int
48 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
d Int
40 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
d Int
32 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
d Int
24 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
d Int
16 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
d  Int
8 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall a. Bits a => a -> Int -> a
shiftR Word64
d  Int
0 forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    ]

instance C.Pretty SHA256 where
    pretty :: SHA256 -> Doc
pretty = [Char] -> Doc
PP.text forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C.fromUTF8BS forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. SHA256 -> ByteString
getSHA256

instance Show SHA256 where
    showsPrec :: Int -> SHA256 -> ShowS
showsPrec Int
d SHA256
h
        = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
        forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
showString [Char]
"unsafeMkSHA256 "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (ByteString -> ByteString
Base16.encode (SHA256 -> ByteString
getSHA256 SHA256
h))

instance Binary.Binary SHA256 where
    put :: SHA256 -> Put
put (SHA256 Word64
a Word64
b Word64
c Word64
d) = do
        Word64 -> Put
Binary.Put.putWord64be Word64
a
        Word64 -> Put
Binary.Put.putWord64be Word64
b
        Word64 -> Put
Binary.Put.putWord64be Word64
c
        Word64 -> Put
Binary.Put.putWord64be Word64
d
    get :: Get SHA256
get = do
        Word64
a <- Get Word64
Binary.Get.getWord64be
        Word64
b <- Get Word64
Binary.Get.getWord64be
        Word64
c <- Get Word64
Binary.Get.getWord64be
        Word64
d <- Get Word64
Binary.Get.getWord64be
        forall (m :: * -> *) a. Monad m => a -> m a
return (Word64 -> Word64 -> Word64 -> Word64 -> SHA256
SHA256 Word64
a Word64
b Word64
c Word64
d)

-------------------------------------------------------------------------------
-- MD5
-------------------------------------------------------------------------------

newtype MD5 = MD5 ByteString
  deriving (MD5 -> MD5 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MD5 -> MD5 -> Bool
$c/= :: MD5 -> MD5 -> Bool
== :: MD5 -> MD5 -> Bool
$c== :: MD5 -> MD5 -> Bool
Eq, Eq MD5
MD5 -> MD5 -> Bool
MD5 -> MD5 -> Ordering
MD5 -> MD5 -> MD5
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: MD5 -> MD5 -> MD5
$cmin :: MD5 -> MD5 -> MD5
max :: MD5 -> MD5 -> MD5
$cmax :: MD5 -> MD5 -> MD5
>= :: MD5 -> MD5 -> Bool
$c>= :: MD5 -> MD5 -> Bool
> :: MD5 -> MD5 -> Bool
$c> :: MD5 -> MD5 -> Bool
<= :: MD5 -> MD5 -> Bool
$c<= :: MD5 -> MD5 -> Bool
< :: MD5 -> MD5 -> Bool
$c< :: MD5 -> MD5 -> Bool
compare :: MD5 -> MD5 -> Ordering
$ccompare :: MD5 -> MD5 -> Ordering
Ord)

instance Show MD5 where
    showsPrec :: Int -> MD5 -> ShowS
showsPrec Int
d (MD5 ByteString
bs)
        = Bool -> ShowS -> ShowS
showParen (Int
d forall a. Ord a => a -> a -> Bool
> Int
10)
        forall a b. (a -> b) -> a -> b
$ [Char] -> ShowS
showString [Char]
"unsafeMkMD5 "
        forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows (ByteString -> ByteString
Base16.encode ByteString
bs)

-- | Make MD5 from base16-encoded string.
mkMD5 :: Text -> Either String MD5
mkMD5 :: Text -> Either [Char] MD5
mkMD5 Text
t = case ByteString -> Either [Char] ByteString
Base16.decode (Text -> ByteString
TE.encodeUtf8 Text
t) of
    Left [Char]
err                      -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Base16 decoding failure: " forall a. [a] -> [a] -> [a]
++ [Char]
err
    Right ByteString
bs | ByteString -> Int
BS.length ByteString
bs forall a. Eq a => a -> a -> Bool
/= Int
16 -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ [Char]
"Base16 of wrong length, expected 16, got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show (ByteString -> Int
BS.length ByteString
bs)
             | Bool
otherwise          -> forall a b. b -> Either a b
Right (ByteString -> MD5
MD5 ByteString
bs)

{-
-- | Unsafe variant of 'mkMD5'.
unsafeMkMD5 :: Text -> MD5
unsafeMkMD5 = either error id . mkMD5

-- | Check invariants of 'MD5'
validMD5 :: MD5 -> Bool
validMD5 (MD5 bs) = BS.length bs == 16

-- | Get underlying 'ByteString' of 'MD5'.
getMD5 :: MD5 -> ByteString
getMD5 (MD5 bs) = bs
-}

-------------------------------------------------------------------------------
-- Metadata types
-------------------------------------------------------------------------------

-- | Package information.
data PackageInfo = PackageInfo
    { PackageInfo -> Map Version ReleaseInfo
piVersions  :: Map C.Version ReleaseInfo  -- ^ individual package releases
    , PackageInfo -> VersionRange
piPreferred :: C.VersionRange             -- ^ preferred versions range
    }
  deriving (PackageInfo -> PackageInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PackageInfo -> PackageInfo -> Bool
$c/= :: PackageInfo -> PackageInfo -> Bool
== :: PackageInfo -> PackageInfo -> Bool
$c== :: PackageInfo -> PackageInfo -> Bool
Eq, Int -> PackageInfo -> ShowS
[PackageInfo] -> ShowS
PackageInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PackageInfo] -> ShowS
$cshowList :: [PackageInfo] -> ShowS
show :: PackageInfo -> [Char]
$cshow :: PackageInfo -> [Char]
showsPrec :: Int -> PackageInfo -> ShowS
$cshowsPrec :: Int -> PackageInfo -> ShowS
Show, forall x. Rep PackageInfo x -> PackageInfo
forall x. PackageInfo -> Rep PackageInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PackageInfo x -> PackageInfo
$cfrom :: forall x. PackageInfo -> Rep PackageInfo x
Generic)

instance Binary.Binary PackageInfo

-- | Like 'piVersions', but return only 'piPreferred' versions.
piPreferredVersions :: PackageInfo -> Map C.Version ReleaseInfo
piPreferredVersions :: PackageInfo -> Map Version ReleaseInfo
piPreferredVersions PackageInfo
pi =
    forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\Version
v ReleaseInfo
_ -> Version
v Version -> VersionRange -> Bool
`C.withinRange` PackageInfo -> VersionRange
piPreferred PackageInfo
pi) (PackageInfo -> Map Version ReleaseInfo
piVersions PackageInfo
pi)

-- | Package's release information.
data ReleaseInfo = ReleaseInfo
    { ReleaseInfo -> Word32
riRevision    :: !Word32              -- ^ revision number
    , ReleaseInfo -> Word32
riTarOffset   :: !Tar.TarEntryOffset  -- ^ offset into tar file
    , ReleaseInfo -> SHA256
riCabalHash   :: !SHA256              -- ^ hash of the last revision of @.cabal@ file
    , ReleaseInfo -> Word64
riCabalSize   :: !Word64              -- ^ size of the last revision of @.cabal@ file
    , ReleaseInfo -> SHA256
riTarballHash :: !SHA256              -- ^ hash of the @.tar.gz@ file
    , ReleaseInfo -> Word64
riTarballSize :: !Word64              -- ^ size of the @.tar.gz@ file
    }
  deriving (ReleaseInfo -> ReleaseInfo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReleaseInfo -> ReleaseInfo -> Bool
$c/= :: ReleaseInfo -> ReleaseInfo -> Bool
== :: ReleaseInfo -> ReleaseInfo -> Bool
$c== :: ReleaseInfo -> ReleaseInfo -> Bool
Eq, Int -> ReleaseInfo -> ShowS
[ReleaseInfo] -> ShowS
ReleaseInfo -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ReleaseInfo] -> ShowS
$cshowList :: [ReleaseInfo] -> ShowS
show :: ReleaseInfo -> [Char]
$cshow :: ReleaseInfo -> [Char]
showsPrec :: Int -> ReleaseInfo -> ShowS
$cshowsPrec :: Int -> ReleaseInfo -> ShowS
Show, forall x. Rep ReleaseInfo x -> ReleaseInfo
forall x. ReleaseInfo -> Rep ReleaseInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReleaseInfo x -> ReleaseInfo
$cfrom :: forall x. ReleaseInfo -> Rep ReleaseInfo x
Generic)

instance Binary.Binary ReleaseInfo

-------------------------------------------------------------------------------
-- Metadata construction
-------------------------------------------------------------------------------

-- | Read index file and return the metadata about packages.
--
-- It takes about 6 seconds on my machine. Consider using 'cachedHackageMetadata'.
--
indexMetadata
    :: FilePath             -- ^ location
    -> Maybe Tar.EpochTime  -- ^ index state to stop
    -> IO (Map C.PackageName PackageInfo)
indexMetadata :: [Char] -> Maybe Int64 -> IO (Map PackageName PackageInfo)
indexMetadata [Char]
indexFilepath Maybe Int64
mindexState = do
    let shouldStop :: Tar.EpochTime -> Bool
        shouldStop :: Int64 -> Bool
shouldStop = case Maybe Int64
mindexState of
            Maybe Int64
Nothing         -> \Int64
_ -> Bool
False
            Just Int64
indexState -> \Int64
t -> Int64
t forall a. Ord a => a -> a -> Bool
>= Int64
indexState

    Map PackageName TmpPackageInfo
result <- forall a.
[Char] -> a -> (IndexEntry -> ByteString -> a -> IO a) -> IO a
foldIndex [Char]
indexFilepath forall k a. Map k a
Map.empty forall a b. (a -> b) -> a -> b
$ \IndexEntry
indexEntry ByteString
contents !Map PackageName TmpPackageInfo
m ->
        if Int64 -> Bool
shouldStop (IndexEntry -> Int64
entryTime IndexEntry
indexEntry)
        then forall (m :: * -> *) a. Monad m => a -> m a
return Map PackageName TmpPackageInfo
m
        else case IndexEntry -> IndexFileType
entryType IndexEntry
indexEntry of
            CabalFile PackageName
pn Version
ver -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe TmpPackageInfo -> Maybe TmpPackageInfo
f PackageName
pn Map PackageName TmpPackageInfo
m) where
                digest :: SHA256
                digest :: SHA256
digest = ByteString -> SHA256
sha256 ByteString
contents

                size :: Word64
                size :: Word64
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length ByteString
contents

                offset :: Tar.TarEntryOffset
                offset :: Word32
offset = IndexEntry -> Word32
entryTarOffset IndexEntry
indexEntry

                f :: Maybe TmpPackageInfo -> Maybe TmpPackageInfo
                f :: Maybe TmpPackageInfo -> Maybe TmpPackageInfo
f Maybe TmpPackageInfo
Nothing = forall a. a -> Maybe a
Just TmpPackageInfo
                    { tmpPiVersions :: Map Version TmpReleaseInfo
tmpPiVersions  = forall k a. k -> a -> Map k a
Map.singleton Version
ver TmpReleaseInfo 
                        { tmpRiRevision :: Word32
tmpRiRevision    = Word32
0
                        , tmpRiTarOffset :: Word32
tmpRiTarOffset   = Word32
offset
                        , tmpRiCabalHash :: Maybe SHA256
tmpRiCabalHash   = forall a. a -> Maybe a
Just SHA256
digest
                        , tmpRiCabalSize :: Maybe Word64
tmpRiCabalSize   = forall a. a -> Maybe a
Just Word64
size
                        , tmpRiTarballHash :: Maybe SHA256
tmpRiTarballHash = forall a. Maybe a
Nothing
                        , tmpRiTarballSize :: Maybe Word64
tmpRiTarballSize = forall a. Maybe a
Nothing
                        }
                    , tmpPiPreferred :: VersionRange
tmpPiPreferred = VersionRange
C.anyVersion
                    }
                f (Just TmpPackageInfo
pi) = forall a. a -> Maybe a
Just TmpPackageInfo
pi { tmpPiVersions :: Map Version TmpReleaseInfo
tmpPiVersions = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter Maybe TmpReleaseInfo -> Maybe TmpReleaseInfo
g Version
ver (TmpPackageInfo -> Map Version TmpReleaseInfo
tmpPiVersions TmpPackageInfo
pi) }

                g :: Maybe TmpReleaseInfo -> Maybe TmpReleaseInfo
                g :: Maybe TmpReleaseInfo -> Maybe TmpReleaseInfo
g Maybe TmpReleaseInfo
Nothing                                       = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo Word32
0        Word32
offset (forall a. a -> Maybe a
Just SHA256
digest) (forall a. a -> Maybe a
Just Word64
size) forall a. Maybe a
Nothing forall a. Maybe a
Nothing
                g (Just (TmpReleaseInfo Word32
_r Word32
_o Maybe SHA256
Nothing Maybe Word64
_ Maybe SHA256
th Maybe Word64
ts)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo Word32
0        Word32
offset (forall a. a -> Maybe a
Just SHA256
digest) (forall a. a -> Maybe a
Just Word64
size) Maybe SHA256
th      Maybe Word64
ts
                g (Just (TmpReleaseInfo  Word32
r Word32
_o Maybe SHA256
_c      Maybe Word64
_ Maybe SHA256
th Maybe Word64
ts)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo (forall a. Enum a => a -> a
succ Word32
r) Word32
offset (forall a. a -> Maybe a
Just SHA256
digest) (forall a. a -> Maybe a
Just Word64
size) Maybe SHA256
th      Maybe Word64
ts

            PackageJson PackageName
pn Version
ver -> case forall a. FromJSON a => ByteString -> Either [Char] a
A.eitherDecodeStrict ByteString
contents of
                    Left [Char]
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> MetadataParseError
MetadataParseError (IndexEntry -> [Char]
entryPath IndexEntry
indexEntry) [Char]
err
                    Right (PJ (Signed (Targets Map [Char] Target
ts))) ->
                        case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ([Char]
"<repo>/package/" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
C.prettyShow PackageName
pn forall a. [a] -> [a] -> [a]
++ [Char]
"-" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
C.prettyShow Version
ver forall a. [a] -> [a] -> [a]
++ [Char]
".tar.gz") Map [Char] Target
ts of
                            Just Target
t  -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Target -> Maybe TmpPackageInfo -> Maybe TmpPackageInfo
f Target
t) PackageName
pn Map PackageName TmpPackageInfo
m)
                            Maybe Target
Nothing -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> MetadataParseError
MetadataParseError (IndexEntry -> [Char]
entryPath IndexEntry
indexEntry) forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid targets in " forall a. [a] -> [a] -> [a]
++ IndexEntry -> [Char]
entryPath IndexEntry
indexEntry forall a. [a] -> [a] -> [a]
++ [Char]
" -- " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> [Char]
show Map [Char] Target
ts
                      where
                        f :: Target -> Maybe TmpPackageInfo -> Maybe TmpPackageInfo
                        f :: Target -> Maybe TmpPackageInfo -> Maybe TmpPackageInfo
f Target
t Maybe TmpPackageInfo
Nothing   = forall a. a -> Maybe a
Just TmpPackageInfo
                            { tmpPiVersions :: Map Version TmpReleaseInfo
tmpPiVersions  = forall k a. k -> a -> Map k a
Map.singleton Version
ver forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo Word32
0 Word32
0 forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (Hashes -> SHA256
hashSHA256 (Target -> Hashes
targetHashes Target
t))) (forall a. a -> Maybe a
Just (Target -> Word64
targetLength Target
t))
                            , tmpPiPreferred :: VersionRange
tmpPiPreferred = VersionRange
C.anyVersion
                            }
                        f Target
t (Just TmpPackageInfo
pi) = forall a. a -> Maybe a
Just TmpPackageInfo
pi { tmpPiVersions :: Map Version TmpReleaseInfo
tmpPiVersions = forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (Target -> Maybe TmpReleaseInfo -> Maybe TmpReleaseInfo
g Target
t) Version
ver (TmpPackageInfo -> Map Version TmpReleaseInfo
tmpPiVersions TmpPackageInfo
pi) }

                        g :: Target -> Maybe TmpReleaseInfo -> Maybe TmpReleaseInfo
                        g :: Target -> Maybe TmpReleaseInfo -> Maybe TmpReleaseInfo
g Target
t Maybe TmpReleaseInfo
Nothing                               = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo Word32
0 Word32
0 forall a. Maybe a
Nothing forall a. Maybe a
Nothing (forall a. a -> Maybe a
Just (Hashes -> SHA256
hashSHA256 (Target -> Hashes
targetHashes Target
t))) (forall a. a -> Maybe a
Just (Target -> Word64
targetLength Target
t))
                        g Target
t (Just (TmpReleaseInfo Word32
r Word32
o Maybe SHA256
ch Maybe Word64
cs Maybe SHA256
_ Maybe Word64
_)) = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo Word32
r Word32
o Maybe SHA256
ch      Maybe Word64
cs      (forall a. a -> Maybe a
Just (Hashes -> SHA256
hashSHA256 (Target -> Hashes
targetHashes Target
t))) (forall a. a -> Maybe a
Just (Target -> Word64
targetLength Target
t))

            PreferredVersions PackageName
pn
                    | ByteString -> Bool
BS.null ByteString
contents -> forall (m :: * -> *) a. Monad m => a -> m a
return Map PackageName TmpPackageInfo
m
                    | Bool
otherwise        -> case forall a. ParsecParser a -> ByteString -> Either [Char] a
explicitEitherParsecBS ParsecParser VersionRange
preferredP ByteString
contents of
                        Right VersionRange
vr -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall k a.
Ord k =>
(Maybe a -> Maybe a) -> k -> Map k a -> Map k a
Map.alter (VersionRange -> Maybe TmpPackageInfo -> Maybe TmpPackageInfo
f VersionRange
vr) PackageName
pn Map PackageName TmpPackageInfo
m)
                        Left [Char]
err -> forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ [Char] -> [Char] -> MetadataParseError
MetadataParseError (IndexEntry -> [Char]
entryPath IndexEntry
indexEntry) [Char]
err
                  where
                    preferredP :: ParsecParser VersionRange
preferredP = do
                        [Char]
_ <- forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
C.string (forall a. Pretty a => a -> [Char]
C.prettyShow PackageName
pn)
                        forall (m :: * -> *). CharParsing m => m ()
C.spaces
                        forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
C.parsec

                    f :: C.VersionRange -> Maybe TmpPackageInfo -> Maybe TmpPackageInfo
                    f :: VersionRange -> Maybe TmpPackageInfo -> Maybe TmpPackageInfo
f VersionRange
vr Maybe TmpPackageInfo
Nothing = forall a. a -> Maybe a
Just TmpPackageInfo
                        { tmpPiVersions :: Map Version TmpReleaseInfo
tmpPiVersions  = forall k a. Map k a
Map.empty
                        , tmpPiPreferred :: VersionRange
tmpPiPreferred = VersionRange
vr
                        }
                    f VersionRange
vr (Just TmpPackageInfo
pi) = forall a. a -> Maybe a
Just TmpPackageInfo
pi { tmpPiPreferred :: VersionRange
tmpPiPreferred = VersionRange
vr }

    -- check invariants and return
    Map PackageName TmpPackageInfo -> IO (Map PackageName PackageInfo)
postCheck Map PackageName TmpPackageInfo
result

postCheck :: Map C.PackageName TmpPackageInfo -> IO (Map C.PackageName PackageInfo)
postCheck :: Map PackageName TmpPackageInfo -> IO (Map PackageName PackageInfo)
postCheck Map PackageName TmpPackageInfo
meta = forall k v v'. Map k v -> (k -> v -> IO v') -> IO (Map k v')
ifor Map PackageName TmpPackageInfo
meta forall a b. (a -> b) -> a -> b
$ \PackageName
pn TmpPackageInfo
pi -> do
    Map Version ReleaseInfo
versions <- forall k v v'. Map k v -> (k -> v -> IO v') -> IO (Map k v')
ifor (TmpPackageInfo -> Map Version TmpReleaseInfo
tmpPiVersions TmpPackageInfo
pi) forall a b. (a -> b) -> a -> b
$ \Version
ver TmpReleaseInfo
ri -> do
        SHA256
cabalHash   <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> [Char] -> InvalidData
InvalidHash PackageName
pn Version
ver [Char]
"cabal")   forall (m :: * -> *) a. Monad m => a -> m a
return (TmpReleaseInfo -> Maybe SHA256
tmpRiCabalHash   TmpReleaseInfo
ri)
        Word64
cabalSize   <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> [Char] -> InvalidData
InvalidSize PackageName
pn Version
ver [Char]
"cabal")   forall (m :: * -> *) a. Monad m => a -> m a
return (TmpReleaseInfo -> Maybe Word64
tmpRiCabalSize   TmpReleaseInfo
ri)
        SHA256
tarballHash <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> [Char] -> InvalidData
InvalidHash PackageName
pn Version
ver [Char]
"tarball") forall (m :: * -> *) a. Monad m => a -> m a
return (TmpReleaseInfo -> Maybe SHA256
tmpRiTarballHash TmpReleaseInfo
ri)
        Word64
tarballSize <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall e a. Exception e => e -> IO a
throwIO forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> [Char] -> InvalidData
InvalidSize PackageName
pn Version
ver [Char]
"tarball") forall (m :: * -> *) a. Monad m => a -> m a
return (TmpReleaseInfo -> Maybe Word64
tmpRiTarballSize TmpReleaseInfo
ri)
        forall (m :: * -> *) a. Monad m => a -> m a
return ReleaseInfo
            { riRevision :: Word32
riRevision    = TmpReleaseInfo -> Word32
tmpRiRevision TmpReleaseInfo
ri
            , riTarOffset :: Word32
riTarOffset   = TmpReleaseInfo -> Word32
tmpRiTarOffset TmpReleaseInfo
ri
            , riCabalHash :: SHA256
riCabalHash   = SHA256
cabalHash
            , riCabalSize :: Word64
riCabalSize   = Word64
cabalSize
            , riTarballHash :: SHA256
riTarballHash = SHA256
tarballHash
            , riTarballSize :: Word64
riTarballSize = Word64
tarballSize
            }

    forall (m :: * -> *) a. Monad m => a -> m a
return PackageInfo
        { piPreferred :: VersionRange
piPreferred = TmpPackageInfo -> VersionRange
tmpPiPreferred TmpPackageInfo
pi
        , piVersions :: Map Version ReleaseInfo
piVersions  = Map Version ReleaseInfo
versions
        }
  where
    ifor :: Map k v -> (k -> v -> IO v') -> IO (Map k v')
    ifor :: forall k v v'. Map k v -> (k -> v -> IO v') -> IO (Map k v')
ifor = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
Map.traverseWithKey

-- | Thrown when we cannot parse @package.json@ or @preferred-versions@ files.
data MetadataParseError = MetadataParseError FilePath String
  deriving (Int -> MetadataParseError -> ShowS
[MetadataParseError] -> ShowS
MetadataParseError -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MetadataParseError] -> ShowS
$cshowList :: [MetadataParseError] -> ShowS
show :: MetadataParseError -> [Char]
$cshow :: MetadataParseError -> [Char]
showsPrec :: Int -> MetadataParseError -> ShowS
$cshowsPrec :: Int -> MetadataParseError -> ShowS
Show)

instance Exception MetadataParseError

-- | Thrown if we fail consistency check, we don't know a hash for some file.
data InvalidData
    = InvalidHash C.PackageName C.Version String
    | InvalidSize C.PackageName C.Version String
  deriving (Int -> InvalidData -> ShowS
[InvalidData] -> ShowS
InvalidData -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [InvalidData] -> ShowS
$cshowList :: [InvalidData] -> ShowS
show :: InvalidData -> [Char]
$cshow :: InvalidData -> [Char]
showsPrec :: Int -> InvalidData -> ShowS
$cshowsPrec :: Int -> InvalidData -> ShowS
Show)

instance Exception InvalidData

-------------------------------------------------------------------------------
-- Temporary types for indexMetadata
-------------------------------------------------------------------------------

data TmpPackageInfo = TmpPackageInfo
    { TmpPackageInfo -> Map Version TmpReleaseInfo
tmpPiVersions  :: Map C.Version TmpReleaseInfo  -- ^ individual package releases
    , TmpPackageInfo -> VersionRange
tmpPiPreferred :: C.VersionRange                -- ^ preferred versions range
    }

data TmpReleaseInfo = TmpReleaseInfo
    { TmpReleaseInfo -> Word32
tmpRiRevision    :: !Word32               -- ^ revision number
    , TmpReleaseInfo -> Word32
tmpRiTarOffset   :: !Tar.TarEntryOffset   -- ^ offset into tar file
    , TmpReleaseInfo -> Maybe SHA256
tmpRiCabalHash   :: !(Maybe SHA256)       -- ^ hash of the last revision of @.cabal@ file
    , TmpReleaseInfo -> Maybe Word64
tmpRiCabalSize   :: !(Maybe Word64)       -- ^ size of the last revision of @.cabal@ file
    , TmpReleaseInfo -> Maybe SHA256
tmpRiTarballHash :: !(Maybe SHA256)       -- ^ hash of the @.tar.gz@ file.
    , TmpReleaseInfo -> Maybe Word64
tmpRiTarballSize :: !(Maybe Word64)       -- ^ size of the @.tar.gz@ file.
    }

-------------------------------------------------------------------------------
-- Hackage
-------------------------------------------------------------------------------

-- | Read the config and then Hackage index metadata.
--
-- This method caches the result in @XDG_CACHE/cabal-parsers@ directory.
--
-- Returns the location of index tarball and its contents.
--
cachedHackageMetadata :: IO (FilePath, Map C.PackageName PackageInfo)
cachedHackageMetadata :: IO ([Char], Map PackageName PackageInfo)
cachedHackageMetadata = do
    -- read config
    Config Identity
cfg <- IO (Config Identity)
readConfig
    [Char]
indexPath <- forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (forall e a. Exception e => e -> IO a
throwIO NoHackageRepository
NoHackageRepository)
        forall (m :: * -> *) a. Monad m => a -> m a
return
        (Config Identity -> [Char] -> Maybe [Char]
cfgRepoIndex Config Identity
cfg [Char]
hackageHaskellOrg)

    -- cache directory
    [Char]
cacheDir <- XdgDirectory -> [Char] -> IO [Char]
D.getXdgDirectory XdgDirectory
D.XdgCache [Char]
"cabal-parsers"
    Bool -> [Char] -> IO ()
D.createDirectoryIfMissing Bool
True [Char]
cacheDir
    let cacheFile :: [Char]
cacheFile = [Char]
cacheDir [Char] -> ShowS
FP.</> [Char]
"hackage.binary"

    -- lock the cache
    forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall (b :: Bool). SBool b -> [Char] -> IO (FDType b)
takeLock SBool 'True
supported [Char]
cacheDir) (forall (b :: Bool). SBool b -> FDType b -> IO ()
releaseLock SBool 'True
supported) forall a b. (a -> b) -> a -> b
$ \FD
_ -> do
        (Int64
size, Int64
time) <- [Char] -> IO (Int64, Int64)
getStat [Char]
indexPath

        Maybe Cache
mcache <- [Char] -> IO (Maybe Cache)
readCache [Char]
cacheFile
        case Maybe Cache
mcache of
            Just Cache
cache | Cache -> Int64
cacheSize Cache
cache forall a. Eq a => a -> a -> Bool
== Int64
size Bool -> Bool -> Bool
&& Cache -> Int64
cacheTime Cache
cache forall a. Eq a => a -> a -> Bool
== Int64
time ->
                forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
indexPath, Cache -> Map PackageName PackageInfo
cacheData Cache
cache)
            Maybe Cache
_ -> do
                Map PackageName PackageInfo
meta <- [Char] -> Maybe Int64 -> IO (Map PackageName PackageInfo)
indexMetadata [Char]
indexPath forall a. Maybe a
Nothing
                [Char] -> ByteString -> IO ()
LBS.writeFile [Char]
cacheFile forall a b. (a -> b) -> a -> b
$ forall a. Binary a => a -> ByteString
Binary.encode Cache
                    { cacheMagic :: Magic
cacheMagic = Magic
Magic
                    , cacheTime :: Int64
cacheTime  = Int64
time
                    , cacheSize :: Int64
cacheSize  = Int64
size
                    , cacheData :: Map PackageName PackageInfo
cacheData  = Map PackageName PackageInfo
meta
                    }
                forall (m :: * -> *) a. Monad m => a -> m a
return ([Char]
indexPath, Map PackageName PackageInfo
meta)

  where
    readCache :: FilePath -> IO (Maybe Cache)
    readCache :: [Char] -> IO (Maybe Cache)
readCache [Char]
fp = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle forall a. IOException -> IO (Maybe a)
onIOError forall a b. (a -> b) -> a -> b
$ do
        ByteString
contents <- [Char] -> IO ByteString
LBS.readFile [Char]
fp
        case forall a.
Binary a =>
ByteString
-> Either (ByteString, Int64, [Char]) (ByteString, Int64, a)
Binary.decodeOrFail ByteString
contents of
            Right (ByteString
lo,Int64
_,Cache
x) | ByteString -> Bool
LBS.null ByteString
lo -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just Cache
x)
            Either (ByteString, Int64, [Char]) (ByteString, Int64, Cache)
_                            -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

    onIOError :: IOException -> IO (Maybe a)
    onIOError :: forall a. IOException -> IO (Maybe a)
onIOError IOException
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing

    supported :: SBool Lukko.FileLockingSupported
    supported :: SBool 'True
supported = forall (b :: Bool). SBoolI b => SBool b
sbool

    takeLock :: SBool b -> FilePath -> IO (FDType b)
    takeLock :: forall (b :: Bool). SBool b -> [Char] -> IO (FDType b)
takeLock SBool b
STrue  [Char]
dir = do
        FD
fd <- [Char] -> IO FD
Lukko.fdOpen ([Char]
dir [Char] -> ShowS
FP.</> [Char]
"lock")
        FD -> LockMode -> IO ()
Lukko.fdLock FD
fd LockMode
Lukko.ExclusiveLock
        forall (m :: * -> *) a. Monad m => a -> m a
return FD
fd
    takeLock SBool b
SFalse [Char]
_   = forall (m :: * -> *) a. Monad m => a -> m a
return ()

    releaseLock :: SBool b -> FDType b -> IO ()
    releaseLock :: forall (b :: Bool). SBool b -> FDType b -> IO ()
releaseLock SBool b
STrue  FDType b
fd = FD -> IO ()
Lukko.fdUnlock FDType b
fd forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> FD -> IO ()
Lukko.fdClose FDType b
fd
    releaseLock SBool b
SFalse () = forall (m :: * -> *) a. Monad m => a -> m a
return ()

    getStat :: FilePath -> IO (Int64, Int64)
    getStat :: [Char] -> IO (Int64, Int64)
getStat [Char]
p = do
        Integer
size <- [Char] -> IO Integer
D.getFileSize [Char]
p
        UTCTime
time <- [Char] -> IO UTCTime
D.getModificationTime [Char]
p
        forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size, forall a b. (RealFrac a, Integral b) => a -> b
truncate (UTCTime -> POSIXTime
Time.utcTimeToPOSIXSeconds UTCTime
time))

data NoHackageRepository = NoHackageRepository
  deriving Int -> NoHackageRepository -> ShowS
[NoHackageRepository] -> ShowS
NoHackageRepository -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [NoHackageRepository] -> ShowS
$cshowList :: [NoHackageRepository] -> ShowS
show :: NoHackageRepository -> [Char]
$cshow :: NoHackageRepository -> [Char]
showsPrec :: Int -> NoHackageRepository -> ShowS
$cshowsPrec :: Int -> NoHackageRepository -> ShowS
Show

instance Exception NoHackageRepository

data Cache = Cache
    { Cache -> Magic
cacheMagic :: !Magic
    , Cache -> Int64
cacheSize  :: !Int64
    , Cache -> Int64
cacheTime  :: !Int64
    , Cache -> Map PackageName PackageInfo
cacheData  :: Map C.PackageName PackageInfo
    }
  deriving forall x. Rep Cache x -> Cache
forall x. Cache -> Rep Cache x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cache x -> Cache
$cfrom :: forall x. Cache -> Rep Cache x
Generic

instance Binary.Binary Cache

-- special type to make binary fail early
data Magic = Magic

instance Binary.Binary Magic where
    put :: Magic -> Put
put Magic
_ = forall t. Binary t => t -> Put
Binary.put Word64
magicNumber
    get :: Get Magic
get = do
        Word64
m <- forall t. Binary t => Get t
Binary.get
        if Word64
m forall a. Eq a => a -> a -> Bool
== Word64
magicNumber then forall (m :: * -> *) a. Monad m => a -> m a
return Magic
Magic else forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Got wrong magic number"

magicNumber :: Word64
magicNumber :: Word64
magicNumber = Word64
0xF000F000F0004000

-------------------------------------------------------------------------------
-- mini bool-singetons
-------------------------------------------------------------------------------

class SBoolI (b :: Bool) where
    type FDType b
    sbool :: SBool b

instance SBoolI 'True where
    type FDType 'True = Lukko.FD
    sbool :: SBool 'True
sbool = SBool 'True
STrue

instance SBoolI 'False where
    type FDType 'False = ()
    sbool :: SBool 'False
sbool = SBool 'False
SFalse

data SBool (b :: Bool) where
    STrue  :: SBool 'True
    SFalse :: SBool 'False

-------------------------------------------------------------------------------
-- Cabal utils
-------------------------------------------------------------------------------

explicitEitherParsecBS :: C.ParsecParser a -> ByteString -> Either String a
explicitEitherParsecBS :: forall a. ParsecParser a -> ByteString -> Either [Char] a
explicitEitherParsecBS ParsecParser a
parser
    = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> [Char]
show) forall a b. b -> Either a b
Right
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a.
ParsecParser a -> [Char] -> FieldLineStream -> Either ParseError a
C.runParsecParser (ParsecParser a
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
C.spaces) [Char]
"<eitherParsec>"
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FieldLineStream
C.fieldLineStreamFromBS

-------------------------------------------------------------------------------
-- package.json
-------------------------------------------------------------------------------

-- |
--
-- @
-- {
--   "signatures": [],
--   "signed": {
--     "_type": "Targets",
--     "expires": null,
--     "targets": {
--       "<repo>/package/gruff-0.2.1.tar.gz": {
--         "hashes": {
--           "md5":"f551ecaf18e8ec807a9f0f5b69c7ed5a",
--           "sha256":"727408b14173594bbe88dad4240cb884063a784b74afaeaad5fb56c9f042afbd"
--         },
--         "length": 75691
--       }
--     },
--     "version":0
--   }
-- }
-- @
newtype PJ = PJ (Signed Targets)
  deriving Int -> PJ -> ShowS
[PJ] -> ShowS
PJ -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [PJ] -> ShowS
$cshowList :: [PJ] -> ShowS
show :: PJ -> [Char]
$cshow :: PJ -> [Char]
showsPrec :: Int -> PJ -> ShowS
$cshowsPrec :: Int -> PJ -> ShowS
Show

newtype Signed a = Signed a
  deriving Int -> Signed a -> ShowS
forall a. Show a => Int -> Signed a -> ShowS
forall a. Show a => [Signed a] -> ShowS
forall a. Show a => Signed a -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Signed a] -> ShowS
$cshowList :: forall a. Show a => [Signed a] -> ShowS
show :: Signed a -> [Char]
$cshow :: forall a. Show a => Signed a -> [Char]
showsPrec :: Int -> Signed a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Signed a -> ShowS
Show

newtype Targets = Targets (Map FilePath Target)
  deriving Int -> Targets -> ShowS
[Targets] -> ShowS
Targets -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Targets] -> ShowS
$cshowList :: [Targets] -> ShowS
show :: Targets -> [Char]
$cshow :: Targets -> [Char]
showsPrec :: Int -> Targets -> ShowS
$cshowsPrec :: Int -> Targets -> ShowS
Show

data Target = Target
    { Target -> Word64
targetLength :: !Word64
    , Target -> Hashes
targetHashes :: !Hashes
    }
  deriving Int -> Target -> ShowS
[Target] -> ShowS
Target -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> [Char]
$cshow :: Target -> [Char]
showsPrec :: Int -> Target -> ShowS
$cshowsPrec :: Int -> Target -> ShowS
Show

data Hashes = Hashes
    { Hashes -> MD5
_hashMD5   :: !MD5
    , Hashes -> SHA256
hashSHA256 :: !SHA256
    }
  deriving Int -> Hashes -> ShowS
[Hashes] -> ShowS
Hashes -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Hashes] -> ShowS
$cshowList :: [Hashes] -> ShowS
show :: Hashes -> [Char]
$cshow :: Hashes -> [Char]
showsPrec :: Int -> Hashes -> ShowS
$cshowsPrec :: Int -> Hashes -> ShowS
Show

instance A.FromJSON PJ where
    parseJSON :: Value -> Parser PJ
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"package.json" forall a b. (a -> b) -> a -> b
$ \Object
obj ->
        Signed Targets -> PJ
PJ forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"signed"

instance A.FromJSON a => A.FromJSON (Signed a) where
    parseJSON :: Value -> Parser (Signed a)
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"signed (targets)" forall a b. (a -> b) -> a -> b
$ \Object
obj -> do
        A.String Text
"Targets" <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"_type"
        Value
A.Null             <- Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"expires"
        forall a. a -> Signed a
Signed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"targets"

instance A.FromJSON Targets where
    parseJSON :: Value -> Parser Targets
parseJSON = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Map [Char] Target -> Targets
Targets forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromJSON a => Value -> Parser a
A.parseJSON

instance A.FromJSON Target where
    parseJSON :: Value -> Parser Target
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Target" forall a b. (a -> b) -> a -> b
$ \Object
obj -> Word64 -> Hashes -> Target
Target
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"length"
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"hashes"

instance A.FromJSON Hashes where
    parseJSON :: Value -> Parser Hashes
parseJSON = forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"Hashes" forall a b. (a -> b) -> a -> b
$ \Object
obj -> MD5 -> SHA256 -> Hashes
Hashes
        forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"md5"    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] MD5
mkMD5)
        forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
obj forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"sha256" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either [Char] SHA256
mkSHA256)