{-# 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 <- (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 (Word32 -> a -> Acc a
forall a. Word32 -> a -> Acc a
Acc Word32
0 a
ini) (ByteString -> Entries FormatError
Tar.read ByteString
contents)
    a -> IO a
forall a. a -> IO a
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 -> GenEntryContent LinkTarget
forall tarPath linkTarget.
GenEntry tarPath linkTarget -> GenEntryContent linkTarget
Tar.entryContent Entry
entry of
        -- file entry
        Tar.NormalFile ByteString
contents EpochTime
_ -> 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 <- ([Char] -> IO IndexFileType)
-> (IndexFileType -> IO IndexFileType)
-> Either [Char] 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)
-> ([Char] -> InvalidIndexFile) -> [Char] -> IO IndexFileType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> InvalidIndexFile
InvalidIndexFile) IndexFileType -> IO IndexFileType
forall a. a -> IO a
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
forall tarPath linkTarget. GenEntry tarPath linkTarget -> tarPath
Tar.entryTarPath Entry
entry)
                    , entryPermissions :: Permissions
entryPermissions = Entry -> Permissions
forall tarPath linkTarget.
GenEntry tarPath linkTarget -> Permissions
Tar.entryPermissions Entry
entry
                    , entryOwnership :: Ownership
entryOwnership   = Entry -> Ownership
forall tarPath linkTarget. GenEntry tarPath linkTarget -> Ownership
Tar.entryOwnership Entry
entry
                    , entryTime :: EpochTime
entryTime        = Entry -> EpochTime
forall tarPath linkTarget. GenEntry tarPath linkTarget -> EpochTime
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
            Acc a -> IO (Acc a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> a -> Acc a
forall a. Word32 -> a -> Acc a
Acc (Entry -> Word32 -> Word32
Tar.nextEntryOffset Entry
entry Word32
offset) a
next)

        -- all other entries
        GenEntryContent LinkTarget
_ -> Acc a -> IO (Acc a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32 -> a -> Acc a
forall a. Word32 -> a -> Acc a
Acc (Entry -> Word32 -> Word32
Tar.nextEntryOffset Entry
entry Word32
offset) a
acc)
     where
       fpath :: [Char]
fpath = Entry -> [Char]
forall linkTarget. GenEntry TarPath linkTarget -> [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 -> GenEntries TarPath LinkTarget e -> IO a
go where
    go :: a -> GenEntries TarPath LinkTarget e -> IO a
go !a
acc (Tar.Next Entry
e GenEntries TarPath LinkTarget e
es) = a -> Entry -> IO a
next a
acc Entry
e IO a -> (a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
acc' -> a -> GenEntries TarPath LinkTarget e -> IO a
go a
acc' GenEntries TarPath LinkTarget e
es
    go  a
_   (Tar.Fail e
e)    = e -> IO a
fail' e
e
    go  a
acc GenEntries TarPath LinkTarget e
Tar.Done        = a -> IO a
forall a. a -> IO a
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 -> EpochTime
entryTime        :: !Tar.EpochTime
    , IndexEntry -> Word32
entryTarOffset   :: !Tar.TarEntryOffset
    }
  deriving Int -> IndexEntry -> ShowS
[IndexEntry] -> ShowS
IndexEntry -> [Char]
(Int -> IndexEntry -> ShowS)
-> (IndexEntry -> [Char])
-> ([IndexEntry] -> ShowS)
-> Show IndexEntry
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexEntry -> ShowS
showsPrec :: Int -> IndexEntry -> ShowS
$cshow :: IndexEntry -> [Char]
show :: IndexEntry -> [Char]
$cshowList :: [IndexEntry] -> ShowS
showList :: [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]
(Int -> IndexFileType -> ShowS)
-> (IndexFileType -> [Char])
-> ([IndexFileType] -> ShowS)
-> Show IndexFileType
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IndexFileType -> ShowS
showsPrec :: Int -> IndexFileType -> ShowS
$cshow :: IndexFileType -> [Char]
show :: IndexFileType -> [Char]
$cshowList :: [IndexFileType] -> ShowS
showList :: [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]
(Int -> InvalidIndexFile -> ShowS)
-> (InvalidIndexFile -> [Char])
-> ([InvalidIndexFile] -> ShowS)
-> Show InvalidIndexFile
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidIndexFile -> ShowS
showsPrec :: Int -> InvalidIndexFile -> ShowS
$cshow :: InvalidIndexFile -> [Char]
show :: InvalidIndexFile -> [Char]
$cshowList :: [InvalidIndexFile] -> ShowS
showList :: [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' <- [Char] -> Maybe PackageName
forall a. Parsec a => [Char] -> Maybe a
C.simpleParsec [Char]
pn
        , Just Version
v'  <- [Char] -> Maybe Version
forall a. Parsec a => [Char] -> Maybe a
C.simpleParsec [Char]
v
        , [Char]
pnF [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
pn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".cabal"
        -> IndexFileType -> Either [Char] IndexFileType
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' <- [Char] -> Maybe PackageName
forall a. Parsec a => [Char] -> Maybe a
C.simpleParsec [Char]
pn
        , Just Version
v'  <- [Char] -> Maybe Version
forall a. Parsec a => [Char] -> Maybe a
C.simpleParsec [Char]
v
        , [Char]
pj [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"package.json"
        -> IndexFileType -> Either [Char] IndexFileType
forall a b. b -> Either a b
Right (PackageName -> Version -> IndexFileType
PackageJson PackageName
pn' Version
v')
    [ [Char]
pn, [Char]
pref ]
        | Just PackageName
pn' <- [Char] -> Maybe PackageName
forall a. Parsec a => [Char] -> Maybe a
C.simpleParsec [Char]
pn
        , [Char]
pref [Char] -> [Char] -> Bool
forall a. Eq a => a -> a -> Bool
== [Char]
"preferred-versions"
        -> IndexFileType -> Either [Char] IndexFileType
forall a b. b -> Either a b
Right (PackageName -> IndexFileType
PreferredVersions PackageName
pn')
    [[Char]]
xs -> [Char] -> Either [Char] IndexFileType
forall a b. a -> Either a b
Left ([Char] -> Either [Char] IndexFileType)
-> [Char] -> Either [Char] IndexFileType
forall a b. (a -> b) -> a -> b
$ [[Char]] -> [Char]
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
(SHA256 -> SHA256 -> Bool)
-> (SHA256 -> SHA256 -> Bool) -> Eq SHA256
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SHA256 -> SHA256 -> Bool
== :: SHA256 -> SHA256 -> Bool
$c/= :: SHA256 -> SHA256 -> Bool
/= :: 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
$ccompare :: SHA256 -> SHA256 -> Ordering
compare :: SHA256 -> SHA256 -> Ordering
$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
>= :: SHA256 -> SHA256 -> Bool
$cmax :: SHA256 -> SHA256 -> SHA256
max :: SHA256 -> SHA256 -> SHA256
$cmin :: SHA256 -> SHA256 -> SHA256
min :: SHA256 -> SHA256 -> 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          = [Char] -> ByteString
forall a. HasCallStack => [Char] -> a
error ([Char] -> ByteString) -> [Char] -> ByteString
forall a b. (a -> b) -> a -> b
$ [Char]
"panic! SHA256.hash returned ByteStrign of length " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
BS.length ByteString
bs) [Char] -> ShowS
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
    (   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 [Char] SHA256
mkSHA256 Text
t = case ByteString -> Either [Char] ByteString
Base16.decode (Text -> ByteString
TE.encodeUtf8 Text
t) of
    Left [Char]
err                      -> [Char] -> Either [Char] SHA256
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SHA256) -> [Char] -> Either [Char] SHA256
forall a b. (a -> b) -> a -> b
$ [Char]
"Base16 decoding failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err
    Right ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
32 -> [Char] -> Either [Char] SHA256
forall a b. a -> Either a b
Left ([Char] -> Either [Char] SHA256) -> [Char] -> Either [Char] SHA256
forall a b. (a -> b) -> a -> b
$ [Char]
"Base16 of wrong length, expected 32, got " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
BS.length ByteString
bs)
             | Bool
otherwise          -> SHA256 -> Either [Char] 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 = ([Char] -> SHA256)
-> (SHA256 -> SHA256) -> Either [Char] SHA256 -> SHA256
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either [Char] -> SHA256
forall a. HasCallStack => [Char] -> a
error SHA256 -> SHA256
forall a. a -> a
id (Either [Char] SHA256 -> SHA256)
-> (Text -> Either [Char] SHA256) -> Text -> SHA256
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
    [ 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 = [Char] -> Doc
PP.text ([Char] -> Doc) -> (SHA256 -> [Char]) -> SHA256 -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Char]
C.fromUTF8BS (ByteString -> [Char])
-> (SHA256 -> ByteString) -> SHA256 -> [Char]
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
$ [Char] -> ShowS
showString [Char]
"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 a. a -> Get a
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
$c== :: MD5 -> MD5 -> Bool
== :: MD5 -> MD5 -> Bool
$c/= :: MD5 -> MD5 -> Bool
/= :: 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
$ccompare :: MD5 -> MD5 -> Ordering
compare :: MD5 -> MD5 -> Ordering
$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
>= :: MD5 -> MD5 -> Bool
$cmax :: MD5 -> MD5 -> MD5
max :: MD5 -> MD5 -> MD5
$cmin :: MD5 -> MD5 -> MD5
min :: MD5 -> MD5 -> 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
$ [Char] -> ShowS
showString [Char]
"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 [Char] MD5
mkMD5 Text
t = case ByteString -> Either [Char] ByteString
Base16.decode (Text -> ByteString
TE.encodeUtf8 Text
t) of
    Left [Char]
err                      -> [Char] -> Either [Char] MD5
forall a b. a -> Either a b
Left ([Char] -> Either [Char] MD5) -> [Char] -> Either [Char] MD5
forall a b. (a -> b) -> a -> b
$ [Char]
"Base16 decoding failure: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
err
    Right ByteString
bs | ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
16 -> [Char] -> Either [Char] MD5
forall a b. a -> Either a b
Left ([Char] -> Either [Char] MD5) -> [Char] -> Either [Char] MD5
forall a b. (a -> b) -> a -> b
$ [Char]
"Base16 of wrong length, expected 16, got " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> [Char]
forall a. Show a => a -> [Char]
show (ByteString -> Int
BS.length ByteString
bs)
             | Bool
otherwise          -> MD5 -> Either [Char] 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
$c== :: PackageInfo -> PackageInfo -> Bool
== :: PackageInfo -> PackageInfo -> Bool
$c/= :: PackageInfo -> PackageInfo -> Bool
/= :: PackageInfo -> PackageInfo -> Bool
Eq, Int -> PackageInfo -> ShowS
[PackageInfo] -> ShowS
PackageInfo -> [Char]
(Int -> PackageInfo -> ShowS)
-> (PackageInfo -> [Char])
-> ([PackageInfo] -> ShowS)
-> Show PackageInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PackageInfo -> ShowS
showsPrec :: Int -> PackageInfo -> ShowS
$cshow :: PackageInfo -> [Char]
show :: PackageInfo -> [Char]
$cshowList :: [PackageInfo] -> ShowS
showList :: [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
$cfrom :: forall x. PackageInfo -> Rep PackageInfo x
from :: forall x. PackageInfo -> Rep PackageInfo x
$cto :: forall x. Rep PackageInfo x -> PackageInfo
to :: forall x. Rep PackageInfo x -> PackageInfo
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 -> 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
(ReleaseInfo -> ReleaseInfo -> Bool)
-> (ReleaseInfo -> ReleaseInfo -> Bool) -> Eq ReleaseInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ReleaseInfo -> ReleaseInfo -> Bool
== :: ReleaseInfo -> ReleaseInfo -> Bool
$c/= :: ReleaseInfo -> ReleaseInfo -> Bool
/= :: ReleaseInfo -> ReleaseInfo -> Bool
Eq, Int -> ReleaseInfo -> ShowS
[ReleaseInfo] -> ShowS
ReleaseInfo -> [Char]
(Int -> ReleaseInfo -> ShowS)
-> (ReleaseInfo -> [Char])
-> ([ReleaseInfo] -> ShowS)
-> Show ReleaseInfo
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ReleaseInfo -> ShowS
showsPrec :: Int -> ReleaseInfo -> ShowS
$cshow :: ReleaseInfo -> [Char]
show :: ReleaseInfo -> [Char]
$cshowList :: [ReleaseInfo] -> ShowS
showList :: [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
$cfrom :: forall x. ReleaseInfo -> Rep ReleaseInfo x
from :: forall x. ReleaseInfo -> Rep ReleaseInfo x
$cto :: forall x. Rep ReleaseInfo x -> ReleaseInfo
to :: forall x. Rep ReleaseInfo x -> ReleaseInfo
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 EpochTime -> IO (Map PackageName PackageInfo)
indexMetadata [Char]
indexFilepath Maybe EpochTime
mindexState = do
    let shouldStop :: Tar.EpochTime -> Bool
        shouldStop :: EpochTime -> Bool
shouldStop = case Maybe EpochTime
mindexState of
            Maybe EpochTime
Nothing         -> \EpochTime
_ -> Bool
False
            Just EpochTime
indexState -> \EpochTime
t -> EpochTime
t EpochTime -> EpochTime -> Bool
forall a. Ord a => a -> a -> Bool
>= EpochTime
indexState

    Map PackageName TmpPackageInfo
result <- [Char]
-> Map PackageName TmpPackageInfo
-> (IndexEntry
    -> ByteString
    -> Map PackageName TmpPackageInfo
    -> IO (Map PackageName TmpPackageInfo))
-> IO (Map PackageName TmpPackageInfo)
forall a.
[Char] -> a -> (IndexEntry -> ByteString -> a -> IO a) -> IO a
foldIndex [Char]
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 EpochTime -> Bool
shouldStop (IndexEntry -> EpochTime
entryTime IndexEntry
indexEntry)
        then Map PackageName TmpPackageInfo
-> IO (Map PackageName TmpPackageInfo)
forall a. a -> IO a
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 a. a -> IO a
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

                size :: Word64
                size :: Word64
size = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Int -> Word64
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 = TmpPackageInfo -> Maybe TmpPackageInfo
forall a. a -> Maybe a
Just TmpPackageInfo
                    { tmpPiVersions :: Map Version TmpReleaseInfo
tmpPiVersions  = Version -> TmpReleaseInfo -> Map Version TmpReleaseInfo
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   = SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
digest
                        , tmpRiCabalSize :: Maybe Word64
tmpRiCabalSize   = Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
size
                        , tmpRiTarballHash :: Maybe SHA256
tmpRiTarballHash = Maybe SHA256
forall a. Maybe a
Nothing
                        , tmpRiTarballSize :: Maybe Word64
tmpRiTarballSize = Maybe Word64
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.alter g ver (tmpPiVersions 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
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo Word32
0        Word32
offset (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
digest) (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
size) Maybe SHA256
forall a. Maybe a
Nothing Maybe Word64
forall a. Maybe a
Nothing
                g (Just (TmpReleaseInfo Word32
_r Word32
_o Maybe SHA256
Nothing Maybe Word64
_ Maybe SHA256
th Maybe Word64
ts)) = TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a. a -> Maybe a
Just (TmpReleaseInfo -> Maybe TmpReleaseInfo)
-> TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo Word32
0        Word32
offset (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
digest) (Word64 -> Maybe Word64
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)) = TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a. a -> Maybe a
Just (TmpReleaseInfo -> Maybe TmpReleaseInfo)
-> TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo (Word32 -> Word32
forall a. Enum a => a -> a
succ Word32
r) Word32
offset (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just SHA256
digest) (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just Word64
size) Maybe SHA256
th      Maybe Word64
ts

            PackageJson PackageName
pn Version
ver -> case ByteString -> Either [Char] PJ
forall a. FromJSON a => ByteString -> Either [Char] a
A.eitherDecodeStrict ByteString
contents of
                    Left [Char]
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
$ [Char] -> [Char] -> MetadataParseError
MetadataParseError (IndexEntry -> [Char]
entryPath IndexEntry
indexEntry) [Char]
err
                    Right (PJ (Signed (Targets Map [Char] Target
ts))) ->
                        case [Char] -> Map [Char] Target -> Maybe Target
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup ([Char]
"<repo>/package/" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ PackageName -> [Char]
forall a. Pretty a => a -> [Char]
C.prettyShow PackageName
pn [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
"-" [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> [Char]
forall a. Pretty a => a -> [Char]
C.prettyShow Version
ver [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
".tar.gz") Map [Char] Target
ts of
                            Just Target
t  -> Map PackageName TmpPackageInfo
-> IO (Map PackageName TmpPackageInfo)
forall a. a -> IO a
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
$ [Char] -> [Char] -> MetadataParseError
MetadataParseError (IndexEntry -> [Char]
entryPath IndexEntry
indexEntry) ([Char] -> MetadataParseError) -> [Char] -> MetadataParseError
forall a b. (a -> b) -> a -> b
$ [Char]
"Invalid targets in " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ IndexEntry -> [Char]
entryPath IndexEntry
indexEntry [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ [Char]
" -- " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Map [Char] Target -> [Char]
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   = TmpPackageInfo -> Maybe TmpPackageInfo
forall a. a -> Maybe a
Just TmpPackageInfo
                            { tmpPiVersions :: Map Version TmpReleaseInfo
tmpPiVersions  = Version -> TmpReleaseInfo -> Map Version TmpReleaseInfo
forall k a. k -> a -> Map k a
Map.singleton Version
ver (TmpReleaseInfo -> Map Version TmpReleaseInfo)
-> TmpReleaseInfo -> Map Version TmpReleaseInfo
forall a b. (a -> b) -> a -> b
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo Word32
0 Word32
0 Maybe SHA256
forall a. Maybe a
Nothing Maybe Word64
forall a. Maybe a
Nothing (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just (Hashes -> SHA256
hashSHA256 (Target -> Hashes
targetHashes Target
t))) (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Target -> Word64
targetLength 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.alter (g t) ver (tmpPiVersions 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
$ Word32
-> Word32
-> Maybe SHA256
-> Maybe Word64
-> Maybe SHA256
-> Maybe Word64
-> TmpReleaseInfo
TmpReleaseInfo Word32
0 Word32
0 Maybe SHA256
forall a. Maybe a
Nothing Maybe Word64
forall a. Maybe a
Nothing (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just (Hashes -> SHA256
hashSHA256 (Target -> Hashes
targetHashes Target
t))) (Word64 -> Maybe Word64
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
_)) = TmpReleaseInfo -> Maybe TmpReleaseInfo
forall a. a -> Maybe a
Just (TmpReleaseInfo -> Maybe TmpReleaseInfo)
-> TmpReleaseInfo -> Maybe TmpReleaseInfo
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      (SHA256 -> Maybe SHA256
forall a. a -> Maybe a
Just (Hashes -> SHA256
hashSHA256 (Target -> Hashes
targetHashes Target
t))) (Word64 -> Maybe Word64
forall a. a -> Maybe a
Just (Target -> Word64
targetLength Target
t))

            PreferredVersions PackageName
pn
                    | ByteString -> Bool
BS.null ByteString
contents -> Map PackageName TmpPackageInfo
-> IO (Map PackageName TmpPackageInfo)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Map PackageName TmpPackageInfo
m
                    | Bool
otherwise        -> case ParsecParser VersionRange
-> ByteString -> Either [Char] VersionRange
forall a. ParsecParser a -> ByteString -> Either [Char] a
explicitEitherParsecBS ParsecParser VersionRange
preferredP ByteString
contents of
                        Right VersionRange
vr -> Map PackageName TmpPackageInfo
-> IO (Map PackageName TmpPackageInfo)
forall a. a -> IO a
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 [Char]
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
$ [Char] -> [Char] -> MetadataParseError
MetadataParseError (IndexEntry -> [Char]
entryPath IndexEntry
indexEntry) [Char]
err
                  where
                    preferredP :: ParsecParser VersionRange
preferredP = do
                        [Char]
_ <- [Char] -> ParsecParser [Char]
forall (m :: * -> *). CharParsing m => [Char] -> m [Char]
C.string (PackageName -> [Char]
forall a. Pretty a => a -> [Char]
C.prettyShow PackageName
pn)
                        ParsecParser ()
forall (m :: * -> *). CharParsing m => m ()
C.spaces
                        ParsecParser VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m VersionRange
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
                        { 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 = 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
cabalHash   <- IO SHA256 -> (SHA256 -> IO SHA256) -> Maybe SHA256 -> IO SHA256
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InvalidData -> IO SHA256
forall e a. Exception e => e -> IO a
throwIO (InvalidData -> IO SHA256) -> InvalidData -> IO SHA256
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> [Char] -> InvalidData
InvalidHash PackageName
pn Version
ver [Char]
"cabal")   SHA256 -> IO SHA256
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TmpReleaseInfo -> Maybe SHA256
tmpRiCabalHash   TmpReleaseInfo
ri)
        Word64
cabalSize   <- IO Word64 -> (Word64 -> IO Word64) -> Maybe Word64 -> IO Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InvalidData -> IO Word64
forall e a. Exception e => e -> IO a
throwIO (InvalidData -> IO Word64) -> InvalidData -> IO Word64
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> [Char] -> InvalidData
InvalidSize PackageName
pn Version
ver [Char]
"cabal")   Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TmpReleaseInfo -> Maybe Word64
tmpRiCabalSize   TmpReleaseInfo
ri)
        SHA256
tarballHash <- IO SHA256 -> (SHA256 -> IO SHA256) -> Maybe SHA256 -> IO SHA256
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InvalidData -> IO SHA256
forall e a. Exception e => e -> IO a
throwIO (InvalidData -> IO SHA256) -> InvalidData -> IO SHA256
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> [Char] -> InvalidData
InvalidHash PackageName
pn Version
ver [Char]
"tarball") SHA256 -> IO SHA256
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TmpReleaseInfo -> Maybe SHA256
tmpRiTarballHash TmpReleaseInfo
ri)
        Word64
tarballSize <- IO Word64 -> (Word64 -> IO Word64) -> Maybe Word64 -> IO Word64
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (InvalidData -> IO Word64
forall e a. Exception e => e -> IO a
throwIO (InvalidData -> IO Word64) -> InvalidData -> IO Word64
forall a b. (a -> b) -> a -> b
$ PackageName -> Version -> [Char] -> InvalidData
InvalidSize PackageName
pn Version
ver [Char]
"tarball") Word64 -> IO Word64
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (TmpReleaseInfo -> Maybe Word64
tmpRiTarballSize TmpReleaseInfo
ri)
        ReleaseInfo -> IO ReleaseInfo
forall a. a -> IO a
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
            }

    PackageInfo -> IO PackageInfo
forall a. a -> IO a
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 = ((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 -> [Char]
(Int -> MetadataParseError -> ShowS)
-> (MetadataParseError -> [Char])
-> ([MetadataParseError] -> ShowS)
-> Show MetadataParseError
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MetadataParseError -> ShowS
showsPrec :: Int -> MetadataParseError -> ShowS
$cshow :: MetadataParseError -> [Char]
show :: MetadataParseError -> [Char]
$cshowList :: [MetadataParseError] -> ShowS
showList :: [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]
(Int -> InvalidData -> ShowS)
-> (InvalidData -> [Char])
-> ([InvalidData] -> ShowS)
-> Show InvalidData
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> InvalidData -> ShowS
showsPrec :: Int -> InvalidData -> ShowS
$cshow :: InvalidData -> [Char]
show :: InvalidData -> [Char]
$cshowList :: [InvalidData] -> ShowS
showList :: [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 <- IO [Char] -> ([Char] -> IO [Char]) -> Maybe [Char] -> IO [Char]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe
        (NoHackageRepository -> IO [Char]
forall e a. Exception e => e -> IO a
throwIO NoHackageRepository
NoHackageRepository)
        [Char] -> IO [Char]
forall a. a -> IO a
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
    IO FD
-> (FD -> IO ())
-> (FD -> IO ([Char], Map PackageName PackageInfo))
-> IO ([Char], Map PackageName PackageInfo)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (SBool FileLockingSupported
-> [Char] -> IO (FDType FileLockingSupported)
forall (b :: Bool). SBool b -> [Char] -> IO (FDType b)
takeLock SBool FileLockingSupported
supported [Char]
cacheDir) (SBool FileLockingSupported -> FDType FileLockingSupported -> IO ()
forall (b :: Bool). SBool b -> FDType b -> IO ()
releaseLock SBool FileLockingSupported
supported) ((FD -> IO ([Char], Map PackageName PackageInfo))
 -> IO ([Char], Map PackageName PackageInfo))
-> (FD -> IO ([Char], Map PackageName PackageInfo))
-> IO ([Char], Map PackageName PackageInfo)
forall a b. (a -> b) -> a -> b
$ \FD
_ -> do
        (EpochTime
size, EpochTime
time) <- [Char] -> IO (EpochTime, EpochTime)
getStat [Char]
indexPath

        Maybe Cache
mcache <- [Char] -> IO (Maybe Cache)
readCache [Char]
cacheFile
        case Maybe Cache
mcache of
            Just Cache
cache | Cache -> EpochTime
cacheSize Cache
cache EpochTime -> EpochTime -> Bool
forall a. Eq a => a -> a -> Bool
== EpochTime
size Bool -> Bool -> Bool
&& Cache -> EpochTime
cacheTime Cache
cache EpochTime -> EpochTime -> Bool
forall a. Eq a => a -> a -> Bool
== EpochTime
time ->
                ([Char], Map PackageName PackageInfo)
-> IO ([Char], Map PackageName PackageInfo)
forall a. a -> IO a
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 EpochTime -> IO (Map PackageName PackageInfo)
indexMetadata [Char]
indexPath Maybe EpochTime
forall a. Maybe a
Nothing
                [Char] -> ByteString -> IO ()
LBS.writeFile [Char]
cacheFile (ByteString -> IO ()) -> ByteString -> IO ()
forall a b. (a -> b) -> a -> b
$ Cache -> ByteString
forall a. Binary a => a -> ByteString
Binary.encode Cache
                    { cacheMagic :: Magic
cacheMagic = Magic
Magic
                    , cacheTime :: EpochTime
cacheTime  = EpochTime
time
                    , cacheSize :: EpochTime
cacheSize  = EpochTime
size
                    , cacheData :: Map PackageName PackageInfo
cacheData  = Map PackageName PackageInfo
meta
                    }
                ([Char], Map PackageName PackageInfo)
-> IO ([Char], Map PackageName PackageInfo)
forall a. a -> IO a
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 = (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 <- [Char] -> IO ByteString
LBS.readFile [Char]
fp
        case ByteString
-> Either
     (ByteString, EpochTime, [Char]) (ByteString, EpochTime, Cache)
forall a.
Binary a =>
ByteString
-> Either
     (ByteString, EpochTime, [Char]) (ByteString, EpochTime, a)
Binary.decodeOrFail ByteString
contents of
            Right (ByteString
lo,EpochTime
_,Cache
x) | ByteString -> Bool
LBS.null ByteString
lo -> Maybe Cache -> IO (Maybe Cache)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Cache -> Maybe Cache
forall a. a -> Maybe a
Just Cache
x)
            Either
  (ByteString, EpochTime, [Char]) (ByteString, EpochTime, Cache)
_                            -> Maybe Cache -> IO (Maybe Cache)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Cache
forall a. Maybe a
Nothing

    onIOError :: IOException -> IO (Maybe a)
    onIOError :: forall a. IOException -> IO (Maybe a)
onIOError IOException
_ = Maybe a -> IO (Maybe a)
forall a. a -> IO 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 :: 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
        FD -> IO FD
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return FD
fd
    takeLock SBool b
SFalse [Char]
_   = () -> IO ()
forall a. a -> IO a
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 FD
FDType b
fd IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

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

instance Exception NoHackageRepository

data Cache = Cache
    { Cache -> Magic
cacheMagic :: !Magic
    , Cache -> EpochTime
cacheSize  :: !Int64
    , Cache -> EpochTime
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
$cfrom :: forall x. Cache -> Rep Cache x
from :: forall x. Cache -> Rep Cache x
$cto :: forall x. Rep Cache x -> Cache
to :: forall x. Rep Cache x -> Cache
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 a. a -> Get a
forall (m :: * -> *) a. Monad m => a -> m a
return Magic
Magic else [Char] -> Get Magic
forall a. [Char] -> Get a
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 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 :: forall a. ParsecParser a -> ByteString -> Either [Char] a
explicitEitherParsecBS ParsecParser a
parser
    = (ParseError -> Either [Char] a)
-> (a -> Either [Char] a) -> Either ParseError a -> Either [Char] a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Either [Char] a
forall a b. a -> Either a b
Left ([Char] -> Either [Char] a)
-> (ParseError -> [Char]) -> ParseError -> Either [Char] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> [Char]
forall a. Show a => a -> [Char]
show) a -> Either [Char] a
forall a b. b -> Either a b
Right
    (Either ParseError a -> Either [Char] a)
-> (ByteString -> Either ParseError a)
-> ByteString
-> Either [Char] a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecParser a -> [Char] -> FieldLineStream -> Either ParseError a
forall a.
ParsecParser a -> [Char] -> FieldLineStream -> Either ParseError a
C.runParsecParser (ParsecParser a
parser ParsecParser a -> ParsecParser () -> ParsecParser a
forall a b. ParsecParser a -> ParsecParser b -> ParsecParser a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecParser ()
forall (m :: * -> *). CharParsing m => m ()
C.spaces) [Char]
"<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 -> [Char]
(Int -> PJ -> ShowS)
-> (PJ -> [Char]) -> ([PJ] -> ShowS) -> Show PJ
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PJ -> ShowS
showsPrec :: Int -> PJ -> ShowS
$cshow :: PJ -> [Char]
show :: PJ -> [Char]
$cshowList :: [PJ] -> ShowS
showList :: [PJ] -> ShowS
Show

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

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

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

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

instance A.FromJSON PJ where
    parseJSON :: Value -> Parser PJ
parseJSON = [Char] -> (Object -> Parser PJ) -> Value -> Parser PJ
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"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 -> Key -> Parser (Signed Targets)
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 = [Char]
-> (Object -> Parser (Signed a)) -> Value -> Parser (Signed a)
forall a. [Char] -> (Object -> Parser a) -> Value -> Parser a
A.withObject [Char]
"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 -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"_type"
        Value
A.Null             <- Object
obj Object -> Key -> Parser Value
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"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 -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"targets"

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

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

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