{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}

module Stack.Types.PackageIndex
    ( PackageDownload (..)
    , HSPackageDownload (..)
    , PackageCache (..)
    , PackageCacheMap (..)
    , OffsetSize (..)
    -- ** PackageIndex, IndexName & IndexLocation
    , PackageIndex(..)
    , IndexName(..)
    , indexNameText
    , IndexLocation(..)
    , SimplifiedIndexLocation (..)
    , simplifyIndexLocation
    , HttpType (..)
    , HackageSecurity (..)
    ) where

import           Control.DeepSeq (NFData)
import           Control.Monad (mzero)
import           Data.Aeson.Extended
import           Data.ByteString (ByteString)
import qualified Data.Foldable as F
import           Data.Hashable (Hashable)
import           Data.Data (Data, Typeable)
import           Data.HashMap.Strict (HashMap)
import           Data.Int (Int64)
import           Data.Map (Map)
import qualified Data.Map.Strict as Map
import           Data.Store (Store)
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Text.Encoding (encodeUtf8, decodeUtf8)
import           Data.Word (Word64)
import           GHC.Generics (Generic)
import           Path
import           Stack.Types.BuildPlan (GitSHA1)
import           Stack.Types.PackageIdentifier

data PackageCache = PackageCache
    { pcOffsetSize :: {-# UNPACK #-}!OffsetSize
    , pcDownload :: !(Maybe PackageDownload)
    }
    deriving (Generic, Eq, Show, Data, Typeable)

instance Store PackageCache
instance NFData PackageCache

-- | offset in bytes into the 01-index.tar file for the .cabal file
-- contents, and size in bytes of the .cabal file
data OffsetSize = OffsetSize !Int64 !Int64
    deriving (Generic, Eq, Show, Data, Typeable)

instance Store OffsetSize
instance NFData OffsetSize

data PackageCacheMap = PackageCacheMap
    { pcmIdent :: !(Map PackageIdentifier PackageCache)
    -- ^ most recent revision of the package
    , pcmSHA :: !(HashMap GitSHA1 OffsetSize)
    -- ^ lookup via the GitSHA1 of the cabal file contents
    }
    deriving (Generic, Eq, Show, Data, Typeable)
instance Store PackageCacheMap
instance NFData PackageCacheMap

data PackageDownload = PackageDownload
    { pdSHA256 :: !ByteString
    , pdUrl    :: !ByteString
    , pdSize   :: !Word64
    }
    deriving (Show, Generic, Eq, Data, Typeable)
instance Store PackageDownload
instance NFData PackageDownload
instance FromJSON PackageDownload where
    parseJSON = withObject "PackageDownload" $ \o -> do
        hashes <- o .: "package-hashes"
        sha256 <- maybe mzero return (Map.lookup ("SHA256" :: Text) hashes)
        locs <- o .: "package-locations"
        url <-
            case reverse locs of
                [] -> mzero
                x:_ -> return x
        size <- o .: "package-size"
        return PackageDownload
            { pdSHA256 = encodeUtf8 sha256
            , pdUrl = encodeUtf8 url
            , pdSize = size
            }

-- | Hackage Security provides a different JSON format, we'll have our
-- own JSON parser for it.
newtype HSPackageDownload = HSPackageDownload { unHSPackageDownload :: PackageDownload }
instance FromJSON HSPackageDownload where
    parseJSON = withObject "HSPackageDownload" $ \o1 -> do
        o2 <- o1 .: "signed"
        Object o3 <- o2 .: "targets"
        Object o4:_ <- return $ F.toList o3
        len <- o4 .: "length"
        hashes <- o4 .: "hashes"
        sha256 <- hashes .: "sha256"
        return $ HSPackageDownload PackageDownload
            { pdSHA256 = encodeUtf8 sha256
            , pdSize = len
            , pdUrl = ""
            }

-- | Unique name for a package index
newtype IndexName = IndexName { unIndexName :: ByteString }
    deriving (Show, Eq, Ord, Hashable, Store)
indexNameText :: IndexName -> Text
indexNameText = decodeUtf8 . unIndexName
instance ToJSON IndexName where
    toJSON = toJSON . indexNameText

instance FromJSON IndexName where
    parseJSON = withText "IndexName" $ \t ->
        case parseRelDir (T.unpack t) of
            Left e -> fail $ "Invalid index name: " ++ show e
            Right _ -> return $ IndexName $ encodeUtf8 t

data HttpType = HTHackageSecurity !HackageSecurity | HTVanilla
    deriving (Show, Eq, Ord)

data HackageSecurity = HackageSecurity
    { hsKeyIds :: ![Text]
    , hsKeyThreshold :: !Int
    }
    deriving (Show, Eq, Ord)
instance FromJSON HackageSecurity where
    parseJSON = withObject "HackageSecurity" $ \o -> HackageSecurity
        <$> o .: "keyids"
        <*> o .: "key-threshold"

-- | Location of the package index. This ensures that at least one of Git or
-- HTTP is available.
data IndexLocation
    = ILGit !Text
    | ILHttp !Text !HttpType
    | ILGitHttp !Text !Text !HttpType
    deriving (Show, Eq, Ord)

-- | Simplified 'IndexLocation', which will either be a Git repo or HTTP URL.
data SimplifiedIndexLocation = SILGit !Text | SILHttp !Text !HttpType
    deriving (Show, Eq, Ord)

simplifyIndexLocation :: IndexLocation -> SimplifiedIndexLocation
simplifyIndexLocation (ILGit t) = SILGit t
simplifyIndexLocation (ILHttp t ht) = SILHttp t ht
-- Prefer HTTP over Git
simplifyIndexLocation (ILGitHttp _ t ht) = SILHttp t ht

-- | Information on a single package index
data PackageIndex = PackageIndex
    { indexName :: !IndexName
    , indexLocation :: !IndexLocation
    , indexDownloadPrefix :: !Text
    -- ^ URL prefix for downloading packages
    , indexGpgVerify :: !Bool
    -- ^ GPG-verify the package index during download. Only applies to Git
    -- repositories for now.
    , indexRequireHashes :: !Bool
    -- ^ Require that hashes and package size information be available for packages in this index
    }
    deriving Show
instance FromJSON (WithJSONWarnings PackageIndex) where
    parseJSON = withObjectWarnings "PackageIndex" $ \o -> do
        name <- o ..: "name"
        prefix <- o ..: "download-prefix"
        mgit <- o ..:? "git"
        mhttp <- o ..:? "http"
        mhackageSecurity <- o ..:? "hackage-security"
        let httpType = maybe HTVanilla HTHackageSecurity mhackageSecurity
        loc <-
            case (mgit, mhttp) of
                (Nothing, Nothing) -> fail $
                    "Must provide either Git or HTTP URL for " ++
                    T.unpack (indexNameText name)
                (Just git, Nothing) -> return $ ILGit git
                (Nothing, Just http) -> return $ ILHttp http httpType
                (Just git, Just http) -> return $ ILGitHttp git http httpType
        gpgVerify <- o ..:? "gpg-verify" ..!= False
        reqHashes <- o ..:? "require-hashes" ..!= False
        return PackageIndex
            { indexName = name
            , indexLocation = loc
            , indexDownloadPrefix = prefix
            , indexGpgVerify = gpgVerify
            , indexRequireHashes = reqHashes
            }