{-# LANGUAGE BangPatterns      #-}
{-# LANGUAGE DataKinds         #-}
{-# LANGUAGE DeriveGeneric     #-}
{-# LANGUAGE GADTs             #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies      #-}
module Cabal.Index (
    -- * Metadata construction
    indexMetadata,
    cachedHackageMetadata,
    -- ** Exceptions thrown
    MetadataParseError (..),
    InvalidHash (..),
    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.Simple.Utils           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 :: FilePath -> a -> (IndexEntry -> ByteString -> a -> IO a) -> IO a
foldIndex FilePath
fp a
ini IndexEntry -> ByteString -> a -> IO a
action = do
    ByteString
contents <- FilePath -> IO ByteString
LBS.readFile FilePath
fp
    Acc TarEntryOffset
_ a
result <- (Acc a -> Entry -> IO (Acc a))
-> (FormatError -> IO (Acc a))
-> Acc a
-> Entries FormatError
-> IO (Acc a)
forall a e.
(a -> Entry -> IO a) -> (e -> IO a) -> a -> Entries e -> IO a
foldEntries Acc a -> Entry -> IO (Acc a)
go FormatError -> IO (Acc a)
forall e a. Exception e => e -> IO a
throwIO (TarEntryOffset -> a -> Acc a
forall a. TarEntryOffset -> a -> Acc a
Acc TarEntryOffset
0 a
ini) (ByteString -> Entries FormatError
Tar.read ByteString
contents)
    a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result
  where
    go :: Acc a -> Entry -> IO (Acc a)
go (Acc TarEntryOffset
offset a
acc) Entry
entry = case Entry -> EntryContent
Tar.entryContent Entry
entry of
        -- file entry
        Tar.NormalFile ByteString
contents FileSize
_ -> do
            ByteString
bs <- ByteString -> IO ByteString
forall a. a -> IO a
evaluate (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
LBS.toStrict ByteString
contents
            IndexFileType
idxFile <- (FilePath -> IO IndexFileType)
-> (IndexFileType -> IO IndexFileType)
-> Either FilePath IndexFileType
-> IO IndexFileType
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (InvalidIndexFile -> IO IndexFileType
forall e a. Exception e => e -> IO a
throwIO (InvalidIndexFile -> IO IndexFileType)
-> (FilePath -> InvalidIndexFile) -> FilePath -> IO IndexFileType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> InvalidIndexFile
InvalidIndexFile) IndexFileType -> IO IndexFileType
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Either FilePath IndexFileType
elaborateIndexFile FilePath
fpath)
            let entry' :: IndexEntry
entry' = IndexEntry :: FilePath
-> IndexFileType
-> Permissions
-> Ownership
-> FileSize
-> TarEntryOffset
-> IndexEntry
IndexEntry
                    { entryPath :: FilePath
entryPath        = TarPath -> FilePath
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 :: FileSize
entryTime        = Entry -> FileSize
Tar.entryTime Entry
entry
                    , entryType :: IndexFileType
entryType        = IndexFileType
idxFile
                    , entryTarOffset :: TarEntryOffset
entryTarOffset   = TarEntryOffset
offset
                    }
            a
next <- IndexEntry -> ByteString -> a -> IO a
action IndexEntry
entry' ByteString
bs a
acc
            Acc a -> IO (Acc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TarEntryOffset -> a -> Acc a
forall a. TarEntryOffset -> a -> Acc a
Acc (Entry -> TarEntryOffset -> TarEntryOffset
Tar.nextEntryOffset Entry
entry TarEntryOffset
offset) a
next)

        -- all other entries
        EntryContent
_ -> Acc a -> IO (Acc a)
forall (m :: * -> *) a. Monad m => a -> m a
return (TarEntryOffset -> a -> Acc a
forall a. TarEntryOffset -> a -> Acc a
Acc (Entry -> TarEntryOffset -> TarEntryOffset
Tar.nextEntryOffset Entry
entry TarEntryOffset
offset) a
acc)
     where
       fpath :: FilePath
fpath = Entry -> FilePath
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 :: (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 IO a -> (a -> IO a) -> IO a
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        = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
acc

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

data IndexEntry = IndexEntry
    { IndexEntry -> FilePath
entryPath        :: !FilePath
    , IndexEntry -> IndexFileType
entryType        :: !IndexFileType
    , IndexEntry -> Permissions
entryPermissions :: !Tar.Permissions
    , IndexEntry -> Ownership
entryOwnership   :: !Tar.Ownership
    , IndexEntry -> FileSize
entryTime        :: !Tar.EpochTime
    , IndexEntry -> TarEntryOffset
entryTarOffset   :: !Tar.TarEntryOffset
    }
  deriving Int -> IndexEntry -> ShowS
[IndexEntry] -> ShowS
IndexEntry -> FilePath
(Int -> IndexEntry -> ShowS)
-> (IndexEntry -> FilePath)
-> ([IndexEntry] -> ShowS)
-> Show IndexEntry
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [IndexEntry] -> ShowS
$cshowList :: [IndexEntry] -> ShowS
show :: IndexEntry -> FilePath
$cshow :: IndexEntry -> FilePath
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 -> FilePath
(Int -> IndexFileType -> ShowS)
-> (IndexFileType -> FilePath)
-> ([IndexFileType] -> ShowS)
-> Show IndexFileType
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [IndexFileType] -> ShowS
$cshowList :: [IndexFileType] -> ShowS
show :: IndexFileType -> FilePath
$cshow :: IndexFileType -> FilePath
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 -> FilePath
(Int -> InvalidIndexFile -> ShowS)
-> (InvalidIndexFile -> FilePath)
-> ([InvalidIndexFile] -> ShowS)
-> Show InvalidIndexFile
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InvalidIndexFile] -> ShowS
$cshowList :: [InvalidIndexFile] -> ShowS
show :: InvalidIndexFile -> FilePath
$cshow :: InvalidIndexFile -> FilePath
showsPrec :: Int -> InvalidIndexFile -> ShowS
$cshowsPrec :: Int -> InvalidIndexFile -> ShowS
Show)

instance Exception InvalidIndexFile

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

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

-- | SHA256 digest. 256 bytes.
data SHA256 = SHA256 !Word64 !Word64 !Word64 !Word64
  deriving (SHA256 -> SHA256 -> Bool
(SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> Bool) -> Eq SHA256
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
Eq SHA256
-> (SHA256 -> SHA256 -> Ordering)
-> (SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> SHA256)
-> (SHA256 -> SHA256 -> SHA256)
-> Ord 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
$cp1Ord :: Eq SHA256
Ord)

-- | Hash strict 'ByteString'.
sha256 :: ByteString -> SHA256
sha256 :: ByteString -> SHA256
sha256 = ByteString -> SHA256
sha256Digest (ByteString -> SHA256)
-> (ByteString -> ByteString) -> ByteString -> SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
check (ByteString -> ByteString)
-> (ByteString -> ByteString) -> ByteString -> ByteString
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 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
32 = ByteString
bs
        | Bool
otherwise          = FilePath -> ByteString
forall a. HasCallStack => FilePath -> a
error (FilePath -> ByteString) -> FilePath -> ByteString
forall a b. (a -> b) -> a -> b
$ FilePath
"panic! SHA256.hash returned ByteStrign of length " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (ByteString -> Int
BS.length ByteString
bs) FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
" /= 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
    (   Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
0)) Int
56
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
1)) Int
48
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
2)) Int
40
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
3)) Int
32
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
4)) Int
24
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
5)) Int
16
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
6))  Int
8
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
7))  Int
0
    )
    (   Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
8)) Int
56
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs  Int
9)) Int
48
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
10)) Int
40
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
11)) Int
32
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
12)) Int
24
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
13)) Int
16
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
14))  Int
8
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
15))  Int
0
    )
    (   Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
16)) Int
56
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
17)) Int
48
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
18)) Int
40
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
19)) Int
32
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
20)) Int
24
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
21)) Int
16
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
22))  Int
8
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
23))  Int
0
    )
    (   Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
24)) Int
56
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
25)) Int
48
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
26)) Int
40
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
27)) Int
32
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
28)) Int
24
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
29)) Int
16
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int -> Word8
BS.Unsafe.unsafeIndex ByteString
bs Int
30))  Int
8
    Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftL (Word8 -> Word64
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 FilePath SHA256
mkSHA256 Text
t = case ByteString -> Either FilePath ByteString
Base16.decode (Text -> ByteString
TE.encodeUtf8 Text
t) of
    Left FilePath
err                      -> FilePath -> Either FilePath SHA256
forall a b. a -> Either a b
Left (FilePath -> Either FilePath SHA256)
-> FilePath -> Either FilePath SHA256
forall a b. (a -> b) -> a -> b
$ FilePath
"Base16 decoding failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
err
    Right ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 -> FilePath -> Either FilePath SHA256
forall a b. a -> Either a b
Left (FilePath -> Either FilePath SHA256)
-> FilePath -> Either FilePath SHA256
forall a b. (a -> b) -> a -> b
$ FilePath
"Base16 of wrong length, expected 32, got " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (ByteString -> Int
BS.length ByteString
bs)
             | Bool
otherwise          -> SHA256 -> Either FilePath SHA256
forall a b. b -> Either a b
Right (ByteString -> SHA256
sha256Digest ByteString
bs)

-- | Unsafe variant of 'mkSHA256'.
unsafeMkSHA256 :: Text -> SHA256
unsafeMkSHA256 :: Text -> SHA256
unsafeMkSHA256 = (FilePath -> SHA256)
-> (SHA256 -> SHA256) -> Either FilePath SHA256 -> SHA256
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either FilePath -> SHA256
forall a. HasCallStack => FilePath -> a
error SHA256 -> SHA256
forall a. a -> a
id (Either FilePath SHA256 -> SHA256)
-> (Text -> Either FilePath SHA256) -> Text -> SHA256
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either FilePath 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
    [ Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
56 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
48 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
40 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
32 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
24 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
a Int
16 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
a  Int
8 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)
    , Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
shiftR Word64
a  Int
0 Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Word64
0xff)

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

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

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

instance C.Pretty SHA256 where
    pretty :: SHA256 -> Doc
pretty = FilePath -> Doc
PP.text (FilePath -> Doc) -> (SHA256 -> FilePath) -> SHA256 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FilePath
C.fromUTF8BS (ByteString -> FilePath)
-> (SHA256 -> ByteString) -> SHA256 -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Base16.encode (ByteString -> ByteString)
-> (SHA256 -> ByteString) -> SHA256 -> ByteString
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 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
showString FilePath
"unsafeMkSHA256 "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShowS
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
        SHA256 -> Get SHA256
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
(MD5 -> MD5 -> Bool) -> (MD5 -> MD5 -> Bool) -> Eq MD5
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
Eq MD5
-> (MD5 -> MD5 -> Ordering)
-> (MD5 -> MD5 -> Bool)
-> (MD5 -> MD5 -> Bool)
-> (MD5 -> MD5 -> Bool)
-> (MD5 -> MD5 -> Bool)
-> (MD5 -> MD5 -> MD5)
-> (MD5 -> MD5 -> MD5)
-> Ord 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
$cp1Ord :: Eq MD5
Ord)

instance Show MD5 where
    showsPrec :: Int -> MD5 -> ShowS
showsPrec Int
d (MD5 ByteString
bs)
        = Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10)
        (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ FilePath -> ShowS
showString FilePath
"unsafeMkMD5 "
        ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ShowS
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 FilePath MD5
mkMD5 Text
t = case ByteString -> Either FilePath ByteString
Base16.decode (Text -> ByteString
TE.encodeUtf8 Text
t) of
    Left FilePath
err                      -> FilePath -> Either FilePath MD5
forall a b. a -> Either a b
Left (FilePath -> Either FilePath MD5)
-> FilePath -> Either FilePath MD5
forall a b. (a -> b) -> a -> b
$ FilePath
"Base16 decoding failure: " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ FilePath
err
    Right ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
16 -> FilePath -> Either FilePath MD5
forall a b. a -> Either a b
Left (FilePath -> Either FilePath MD5)
-> FilePath -> Either FilePath MD5
forall a b. (a -> b) -> a -> b
$ FilePath
"Base16 of wrong length, expected 16, got " FilePath -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show (ByteString -> Int
BS.length ByteString
bs)
             | Bool
otherwise          -> MD5 -> Either FilePath MD5
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
(PackageInfo -> PackageInfo -> Bool)
-> (PackageInfo -> PackageInfo -> Bool) -> Eq PackageInfo
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 -> FilePath
(Int -> PackageInfo -> ShowS)
-> (PackageInfo -> FilePath)
-> ([PackageInfo] -> ShowS)
-> Show PackageInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PackageInfo] -> ShowS
$cshowList :: [PackageInfo] -> ShowS
show :: PackageInfo -> FilePath
$cshow :: PackageInfo -> FilePath
showsPrec :: Int -> PackageInfo -> ShowS
$cshowsPrec :: Int -> PackageInfo -> ShowS
Show, (forall x. PackageInfo -> Rep PackageInfo x)
-> (forall x. Rep PackageInfo x -> PackageInfo)
-> Generic PackageInfo
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 =
    (Version -> ReleaseInfo -> Bool)
-> Map Version ReleaseInfo -> Map Version ReleaseInfo
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 -> TarEntryOffset
riRevision  :: !Word32              -- ^ revision number
    , ReleaseInfo -> TarEntryOffset
riTarOffset :: !Tar.TarEntryOffset  -- ^ offset into tar file
    , ReleaseInfo -> SHA256
riCabal     :: !SHA256              -- ^ hash of the last revision of @.cabal@ file
    , ReleaseInfo -> SHA256
riTarball   :: !SHA256              -- ^ hash of the @.tar.gz@ file.
    }
  deriving (ReleaseInfo -> ReleaseInfo -> Bool
(ReleaseInfo -> ReleaseInfo -> Bool)
-> (ReleaseInfo -> ReleaseInfo -> Bool) -> Eq ReleaseInfo
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 -> FilePath
(Int -> ReleaseInfo -> ShowS)
-> (ReleaseInfo -> FilePath)
-> ([ReleaseInfo] -> ShowS)
-> Show ReleaseInfo
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [ReleaseInfo] -> ShowS
$cshowList :: [ReleaseInfo] -> ShowS
show :: ReleaseInfo -> FilePath
$cshow :: ReleaseInfo -> FilePath
showsPrec :: Int -> ReleaseInfo -> ShowS
$cshowsPrec :: Int -> ReleaseInfo -> ShowS
Show, (forall x. ReleaseInfo -> Rep ReleaseInfo x)
-> (forall x. Rep ReleaseInfo x -> ReleaseInfo)
-> Generic ReleaseInfo
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 :: FilePath -> Maybe FileSize -> IO (Map PackageName PackageInfo)
indexMetadata FilePath
indexFilepath Maybe FileSize
mindexState = do
    let shouldStop :: Tar.EpochTime -> Bool
        shouldStop :: FileSize -> Bool
shouldStop = case Maybe FileSize
mindexState of
            Maybe FileSize
Nothing         -> \FileSize
_ -> Bool
False
            Just FileSize
indexState -> \FileSize
t -> FileSize
t FileSize -> FileSize -> Bool
forall a. Ord a => a -> a -> Bool
>= FileSize
indexState

    Map PackageName TmpPackageInfo
result <- FilePath
-> Map PackageName TmpPackageInfo
-> (IndexEntry
    -> ByteString
    -> Map PackageName TmpPackageInfo
    -> IO (Map PackageName TmpPackageInfo))
-> IO (Map PackageName TmpPackageInfo)
forall a.
FilePath -> a -> (IndexEntry -> ByteString -> a -> IO a) -> IO a
foldIndex FilePath
indexFilepath Map PackageName TmpPackageInfo
forall k a. Map k a
Map.empty ((IndexEntry
  -> ByteString
  -> Map PackageName TmpPackageInfo
  -> IO (Map PackageName TmpPackageInfo))
 -> IO (Map PackageName TmpPackageInfo))
-> (IndexEntry
    -> ByteString
    -> Map PackageName TmpPackageInfo
    -> IO (Map PackageName TmpPackageInfo))
-> IO (Map PackageName TmpPackageInfo)
forall a b. (a -> b) -> a -> b
$ \IndexEntry
indexEntry ByteString
contents !Map PackageName TmpPackageInfo
m ->
        if FileSize -> Bool
shouldStop (IndexEntry -> FileSize
entryTime IndexEntry
indexEntry)
        then Map PackageName TmpPackageInfo
-> IO (Map PackageName TmpPackageInfo)
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 -> Map PackageName TmpPackageInfo
-> IO (Map PackageName TmpPackageInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe TmpPackageInfo -> Maybe TmpPackageInfo)
-> PackageName
-> Map PackageName TmpPackageInfo
-> Map PackageName TmpPackageInfo
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

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

                f :: Maybe TmpPackageInfo -> Maybe TmpPackageInfo
                f :: Maybe TmpPackageInfo -> Maybe TmpPackageInfo
f Maybe TmpPackageInfo
Nothing = TmpPackageInfo -> Maybe TmpPackageInfo
forall a. a -> Maybe a
Just TmpPackageInfo :: Map Version TmpReleaseInfo -> VersionRange -> TmpPackageInfo
TmpPackageInfo
                    { tmpPiVersions :: Map Version TmpReleaseInfo
tmpPiVersions  = Version -> TmpReleaseInfo -> Map Version TmpReleaseInfo
forall k a. k -> a -> Map k a
Map.singleton Version
ver (TarEntryOffset
-> TarEntryOffset -> Maybe SHA256 -> Maybe SHA256 -> TmpReleaseInfo
TmpReleaseInfo TarEntryOffset
0 TarEntryOffset
offset (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
digest) Maybe SHA256
forall a. Maybe a
Nothing)
                    , tmpPiPreferred :: VersionRange
tmpPiPreferred = VersionRange
C.anyVersion
                    }
                f (Just TmpPackageInfo
pi) = TmpPackageInfo -> Maybe TmpPackageInfo
forall a. a -> Maybe a
Just TmpPackageInfo
pi { tmpPiVersions :: Map Version TmpReleaseInfo
tmpPiVersions = (Maybe TmpReleaseInfo -> Maybe TmpReleaseInfo)
-> Version
-> Map Version TmpReleaseInfo
-> Map Version TmpReleaseInfo
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                                 = TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a. a -> Maybe a
Just (TmpReleaseInfo -> Maybe TmpReleaseInfo)
-> TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a b. (a -> b) -> a -> b
$ TarEntryOffset
-> TarEntryOffset -> Maybe SHA256 -> Maybe SHA256 -> TmpReleaseInfo
TmpReleaseInfo TarEntryOffset
0        TarEntryOffset
offset (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
digest) Maybe SHA256
forall a. Maybe a
Nothing
                g (Just (TmpReleaseInfo TarEntryOffset
_r TarEntryOffset
_o Maybe SHA256
Nothing Maybe SHA256
t)) = TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a. a -> Maybe a
Just (TmpReleaseInfo -> Maybe TmpReleaseInfo)
-> TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a b. (a -> b) -> a -> b
$ TarEntryOffset
-> TarEntryOffset -> Maybe SHA256 -> Maybe SHA256 -> TmpReleaseInfo
TmpReleaseInfo TarEntryOffset
0        TarEntryOffset
offset (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
digest) Maybe SHA256
t
                g (Just (TmpReleaseInfo  TarEntryOffset
r TarEntryOffset
_o Maybe SHA256
_c      Maybe SHA256
t)) = TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a. a -> Maybe a
Just (TmpReleaseInfo -> Maybe TmpReleaseInfo)
-> TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a b. (a -> b) -> a -> b
$ TarEntryOffset
-> TarEntryOffset -> Maybe SHA256 -> Maybe SHA256 -> TmpReleaseInfo
TmpReleaseInfo (TarEntryOffset -> TarEntryOffset
forall a. Enum a => a -> a
succ TarEntryOffset
r) TarEntryOffset
offset (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
digest) Maybe SHA256
t

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

            PreferredVersions PackageName
pn
                    | ByteString -> Bool
BS.null ByteString
contents -> Map PackageName TmpPackageInfo
-> IO (Map PackageName TmpPackageInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Map PackageName TmpPackageInfo
m
                    | Bool
otherwise        -> case ParsecParser VersionRange
-> ByteString -> Either FilePath VersionRange
forall a. ParsecParser a -> ByteString -> Either FilePath a
explicitEitherParsecBS ParsecParser VersionRange
preferredP ByteString
contents of
                        Right VersionRange
vr -> Map PackageName TmpPackageInfo
-> IO (Map PackageName TmpPackageInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe TmpPackageInfo -> Maybe TmpPackageInfo)
-> PackageName
-> Map PackageName TmpPackageInfo
-> Map PackageName TmpPackageInfo
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 FilePath
err -> MetadataParseError -> IO (Map PackageName TmpPackageInfo)
forall e a. Exception e => e -> IO a
throwIO (MetadataParseError -> IO (Map PackageName TmpPackageInfo))
-> MetadataParseError -> IO (Map PackageName TmpPackageInfo)
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> MetadataParseError
MetadataParseError (IndexEntry -> FilePath
entryPath IndexEntry
indexEntry) FilePath
err
                  where
                    preferredP :: ParsecParser VersionRange
preferredP = do
                        FilePath
_ <- FilePath -> ParsecParser FilePath
forall (m :: * -> *). CharParsing m => FilePath -> m FilePath
C.string (PackageName -> FilePath
forall a. Pretty a => a -> FilePath
C.prettyShow PackageName
pn)
                        ParsecParser ()
forall (m :: * -> *). CharParsing m => m ()
C.spaces
                        ParsecParser VersionRange
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 = TmpPackageInfo -> Maybe TmpPackageInfo
forall a. a -> Maybe a
Just TmpPackageInfo :: Map Version TmpReleaseInfo -> VersionRange -> TmpPackageInfo
TmpPackageInfo
                        { tmpPiVersions :: Map Version TmpReleaseInfo
tmpPiVersions  = Map Version TmpReleaseInfo
forall k a. Map k a
Map.empty
                        , tmpPiPreferred :: VersionRange
tmpPiPreferred = VersionRange
vr
                        }
                    f VersionRange
vr (Just TmpPackageInfo
pi) = TmpPackageInfo -> Maybe TmpPackageInfo
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 = Map PackageName TmpPackageInfo
-> (PackageName -> TmpPackageInfo -> IO PackageInfo)
-> IO (Map PackageName PackageInfo)
forall k v v'. Map k v -> (k -> v -> IO v') -> IO (Map k v')
ifor Map PackageName TmpPackageInfo
meta ((PackageName -> TmpPackageInfo -> IO PackageInfo)
 -> IO (Map PackageName PackageInfo))
-> (PackageName -> TmpPackageInfo -> IO PackageInfo)
-> IO (Map PackageName PackageInfo)
forall a b. (a -> b) -> a -> b
$ \PackageName
pn TmpPackageInfo
pi -> do
    Map Version ReleaseInfo
versions <- Map Version TmpReleaseInfo
-> (Version -> TmpReleaseInfo -> IO ReleaseInfo)
-> IO (Map Version ReleaseInfo)
forall k v v'. Map k v -> (k -> v -> IO v') -> IO (Map k v')
ifor (TmpPackageInfo -> Map Version TmpReleaseInfo
tmpPiVersions TmpPackageInfo
pi) ((Version -> TmpReleaseInfo -> IO ReleaseInfo)
 -> IO (Map Version ReleaseInfo))
-> (Version -> TmpReleaseInfo -> IO ReleaseInfo)
-> IO (Map Version ReleaseInfo)
forall a b. (a -> b) -> a -> b
$ \Version
ver TmpReleaseInfo
ri -> do
        SHA256
cabal   <- IO SHA256 -> (SHA256 -> IO SHA256) -> Maybe SHA256 -> IO SHA256
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InvalidHash -> IO SHA256
forall e a. Exception e => e -> IO a
throwIO (InvalidHash -> IO SHA256) -> InvalidHash -> IO SHA256
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> FilePath -> InvalidHash
InvalidHash PackageName
pn Version
ver FilePath
"cabal")   SHA256 -> IO SHA256
forall (m :: * -> *) a. Monad m => a -> m a
return (TmpReleaseInfo -> Maybe SHA256
tmpRiCabal   TmpReleaseInfo
ri)
        SHA256
tarball <- IO SHA256 -> (SHA256 -> IO SHA256) -> Maybe SHA256 -> IO SHA256
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InvalidHash -> IO SHA256
forall e a. Exception e => e -> IO a
throwIO (InvalidHash -> IO SHA256) -> InvalidHash -> IO SHA256
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> FilePath -> InvalidHash
InvalidHash PackageName
pn Version
ver FilePath
"tarball") SHA256 -> IO SHA256
forall (m :: * -> *) a. Monad m => a -> m a
return (TmpReleaseInfo -> Maybe SHA256
tmpRiTarball TmpReleaseInfo
ri)
        ReleaseInfo -> IO ReleaseInfo
forall (m :: * -> *) a. Monad m => a -> m a
return ReleaseInfo :: TarEntryOffset -> TarEntryOffset -> SHA256 -> SHA256 -> ReleaseInfo
ReleaseInfo
            { riRevision :: TarEntryOffset
riRevision  = TmpReleaseInfo -> TarEntryOffset
tmpRiRevision TmpReleaseInfo
ri
            , riTarOffset :: TarEntryOffset
riTarOffset = TmpReleaseInfo -> TarEntryOffset
tmpRiTarOffset TmpReleaseInfo
ri
            , riCabal :: SHA256
riCabal     = SHA256
cabal
            , riTarball :: SHA256
riTarball   = SHA256
tarball
            }

    PackageInfo -> IO PackageInfo
forall (m :: * -> *) a. Monad m => a -> m a
return PackageInfo :: Map Version ReleaseInfo -> VersionRange -> PackageInfo
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 :: Map k v -> (k -> v -> IO v') -> IO (Map k v')
ifor = ((k -> v -> IO v') -> Map k v -> IO (Map k v'))
-> Map k v -> (k -> v -> IO v') -> IO (Map k v')
forall a b c. (a -> b -> c) -> b -> a -> c
flip (k -> v -> IO v') -> Map k v -> IO (Map k v')
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 -> FilePath
(Int -> MetadataParseError -> ShowS)
-> (MetadataParseError -> FilePath)
-> ([MetadataParseError] -> ShowS)
-> Show MetadataParseError
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [MetadataParseError] -> ShowS
$cshowList :: [MetadataParseError] -> ShowS
show :: MetadataParseError -> FilePath
$cshow :: MetadataParseError -> FilePath
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 InvalidHash = InvalidHash C.PackageName C.Version String
  deriving (Int -> InvalidHash -> ShowS
[InvalidHash] -> ShowS
InvalidHash -> FilePath
(Int -> InvalidHash -> ShowS)
-> (InvalidHash -> FilePath)
-> ([InvalidHash] -> ShowS)
-> Show InvalidHash
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [InvalidHash] -> ShowS
$cshowList :: [InvalidHash] -> ShowS
show :: InvalidHash -> FilePath
$cshow :: InvalidHash -> FilePath
showsPrec :: Int -> InvalidHash -> ShowS
$cshowsPrec :: Int -> InvalidHash -> ShowS
Show)

instance Exception InvalidHash

-------------------------------------------------------------------------------
-- 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 -> TarEntryOffset
tmpRiRevision  :: !Word32              -- ^ revision number
    , TmpReleaseInfo -> TarEntryOffset
tmpRiTarOffset :: !Tar.TarEntryOffset  -- ^ offset into tar file
    , TmpReleaseInfo -> Maybe SHA256
tmpRiCabal     :: !(Maybe SHA256)      -- ^ hash of the last revision of @.cabal@ file
    , TmpReleaseInfo -> Maybe SHA256
tmpRiTarball   :: !(Maybe SHA256)      -- ^ hash 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 (FilePath, Map PackageName PackageInfo)
cachedHackageMetadata = do
    -- read config
    Config Identity
cfg <- IO (Config Identity)
readConfig
    FilePath
indexPath <- IO FilePath
-> (FilePath -> IO FilePath) -> Maybe FilePath -> IO FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (NoHackageRepository -> IO FilePath
forall e a. Exception e => e -> IO a
throwIO NoHackageRepository
NoHackageRepository)
        FilePath -> IO FilePath
forall (m :: * -> *) a. Monad m => a -> m a
return
        (Config Identity -> FilePath -> Maybe FilePath
cfgRepoIndex Config Identity
cfg FilePath
hackageHaskellOrg)

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

    -- lock the cache
    IO FD
-> (FD -> IO ())
-> (FD -> IO (FilePath, Map PackageName PackageInfo))
-> IO (FilePath, Map PackageName PackageInfo)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (SBool FileLockingSupported
-> FilePath -> IO (FDType FileLockingSupported)
forall (b :: Bool). SBool b -> FilePath -> IO (FDType b)
takeLock SBool FileLockingSupported
supported FilePath
cacheDir) (SBool FileLockingSupported -> FDType FileLockingSupported -> IO ()
forall (b :: Bool). SBool b -> FDType b -> IO ()
releaseLock SBool FileLockingSupported
supported) ((FD -> IO (FilePath, Map PackageName PackageInfo))
 -> IO (FilePath, Map PackageName PackageInfo))
-> (FD -> IO (FilePath, Map PackageName PackageInfo))
-> IO (FilePath, Map PackageName PackageInfo)
forall a b. (a -> b) -> a -> b
$ \FD
_ -> do
        (FileSize
size, FileSize
time) <- FilePath -> IO (FileSize, FileSize)
getStat FilePath
indexPath

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

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

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

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

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

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

    getStat :: FilePath -> IO (Int64, Int64)
    getStat :: FilePath -> IO (FileSize, FileSize)
getStat FilePath
p = do
        Integer
size <- FilePath -> IO Integer
D.getFileSize FilePath
p
        UTCTime
time <- FilePath -> IO UTCTime
D.getModificationTime FilePath
p
        (FileSize, FileSize) -> IO (FileSize, FileSize)
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer -> FileSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
size, POSIXTime -> FileSize
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 -> FilePath
(Int -> NoHackageRepository -> ShowS)
-> (NoHackageRepository -> FilePath)
-> ([NoHackageRepository] -> ShowS)
-> Show NoHackageRepository
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [NoHackageRepository] -> ShowS
$cshowList :: [NoHackageRepository] -> ShowS
show :: NoHackageRepository -> FilePath
$cshow :: NoHackageRepository -> FilePath
showsPrec :: Int -> NoHackageRepository -> ShowS
$cshowsPrec :: Int -> NoHackageRepository -> ShowS
Show

instance Exception NoHackageRepository

data Cache = Cache
    { Cache -> Magic
cacheMagic :: !Magic
    , Cache -> FileSize
cacheSize  :: !Int64
    , Cache -> FileSize
cacheTime  :: !Int64
    , Cache -> Map PackageName PackageInfo
cacheData  :: Map C.PackageName PackageInfo
    }
  deriving (forall x. Cache -> Rep Cache x)
-> (forall x. Rep Cache x -> Cache) -> Generic Cache
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
_ = Word64 -> Put
forall t. Binary t => t -> Put
Binary.put Word64
magicNumber
    get :: Get Magic
get = do
        Word64
m <- Get Word64
forall t. Binary t => Get t
Binary.get
        if Word64
m Word64 -> Word64 -> Bool
forall a. Eq a => a -> a -> Bool
== Word64
magicNumber then Magic -> Get Magic
forall (m :: * -> *) a. Monad m => a -> m a
return Magic
Magic else FilePath -> Get Magic
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"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 FileLockingSupported
sbool = SBool FileLockingSupported
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 :: ParsecParser a -> ByteString -> Either FilePath a
explicitEitherParsecBS ParsecParser a
parser
    = (ParseError -> Either FilePath a)
-> (a -> Either FilePath a)
-> Either ParseError a
-> Either FilePath a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Either FilePath a
forall a b. a -> Either a b
Left (FilePath -> Either FilePath a)
-> (ParseError -> FilePath) -> ParseError -> Either FilePath a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> FilePath
forall a. Show a => a -> FilePath
show) a -> Either FilePath a
forall a b. b -> Either a b
Right
    (Either ParseError a -> Either FilePath a)
-> (ByteString -> Either ParseError a)
-> ByteString
-> Either FilePath a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecParser a
-> FilePath -> FieldLineStream -> Either ParseError a
forall a.
ParsecParser a
-> FilePath -> FieldLineStream -> Either ParseError a
C.runParsecParser (ParsecParser a
parser ParsecParser a -> ParsecParser () -> ParsecParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecParser ()
forall (m :: * -> *). CharParsing m => m ()
C.spaces) FilePath
"<eitherParsec>"
    (FieldLineStream -> Either ParseError a)
-> (ByteString -> FieldLineStream)
-> ByteString
-> Either ParseError a
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 -> FilePath
(Int -> PJ -> ShowS)
-> (PJ -> FilePath) -> ([PJ] -> ShowS) -> Show PJ
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [PJ] -> ShowS
$cshowList :: [PJ] -> ShowS
show :: PJ -> FilePath
$cshow :: PJ -> FilePath
showsPrec :: Int -> PJ -> ShowS
$cshowsPrec :: Int -> PJ -> ShowS
Show

newtype Signed a = Signed a
  deriving Int -> Signed a -> ShowS
[Signed a] -> ShowS
Signed a -> FilePath
(Int -> Signed a -> ShowS)
-> (Signed a -> FilePath)
-> ([Signed a] -> ShowS)
-> Show (Signed a)
forall a. Show a => Int -> Signed a -> ShowS
forall a. Show a => [Signed a] -> ShowS
forall a. Show a => Signed a -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Signed a] -> ShowS
$cshowList :: forall a. Show a => [Signed a] -> ShowS
show :: Signed a -> FilePath
$cshow :: forall a. Show a => Signed a -> FilePath
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 -> FilePath
(Int -> Targets -> ShowS)
-> (Targets -> FilePath) -> ([Targets] -> ShowS) -> Show Targets
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Targets] -> ShowS
$cshowList :: [Targets] -> ShowS
show :: Targets -> FilePath
$cshow :: Targets -> FilePath
showsPrec :: Int -> Targets -> ShowS
$cshowsPrec :: Int -> Targets -> ShowS
Show

data Target = Target
    { Target -> Word
_targetLength :: Word
    , Target -> Hashes
targetHashes :: Hashes
    }
  deriving Int -> Target -> ShowS
[Target] -> ShowS
Target -> FilePath
(Int -> Target -> ShowS)
-> (Target -> FilePath) -> ([Target] -> ShowS) -> Show Target
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Target] -> ShowS
$cshowList :: [Target] -> ShowS
show :: Target -> FilePath
$cshow :: Target -> FilePath
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 -> FilePath
(Int -> Hashes -> ShowS)
-> (Hashes -> FilePath) -> ([Hashes] -> ShowS) -> Show Hashes
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Hashes] -> ShowS
$cshowList :: [Hashes] -> ShowS
show :: Hashes -> FilePath
$cshow :: Hashes -> FilePath
showsPrec :: Int -> Hashes -> ShowS
$cshowsPrec :: Int -> Hashes -> ShowS
Show

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

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

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

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

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