{-# LANGUAGE DeriveFunctor   #-}
{-# LANGUAGE DeriveGeneric   #-}
{-# LANGUAGE LambdaCase      #-}
{-# LANGUAGE OverloadedLists #-}
module Cardano.Wallet.API.Response (
    Metadata (..)
  , ResponseStatus(..)
  , APIResponse(..)
  , JSONValidationError(..)
  , UnsupportedMimeTypeError(..)
  -- * Generating responses for collections
  , respondWith
  , fromSlice
  -- * Generating responses for single resources
  , single

  -- * A slice of a collection
  , SliceOf(..)

  , ValidJSON
  ) where

import           Prelude
import           Universum (Buildable, Exception, Text)

import           Data.Aeson (FromJSON (..), ToJSON (..))
import           Formatting (bprint, build)
import qualified Formatting.Buildable
import           Generics.SOP.TH (deriveGeneric)
import           GHC.Generics (Generic)
import           Servant (err400, err415)
import           Test.QuickCheck

import           Cardano.Wallet.API.Indices (Indexable, IxSet)
import           Cardano.Wallet.API.Request (RequestParams (..))
import           Cardano.Wallet.API.Request.Filter (FilterOperations (..))
import           Cardano.Wallet.API.Request.Pagination (Page (..),
                     PaginationMetadata (..), PaginationParams (..),
                     PerPage (..))
import           Cardano.Wallet.API.Request.Sort (SortOperations (..))
import           Cardano.Wallet.API.Response.Filter.IxSet as FilterBackend
import           Cardano.Wallet.API.Response.JSend (HasDiagnostic (..),
                     ResponseStatus (..))
import           Cardano.Wallet.API.Response.Sort.IxSet as SortBackend
import           Cardano.Wallet.API.V1.Errors (ToServantError (..))
import           Cardano.Wallet.API.V1.Generic (jsendErrorGenericParseJSON,
                     jsendErrorGenericToJSON)
import           Pos.Util.Servant as ServantUtil


data SliceOf a = SliceOf {
    paginatedSlice :: [a]
  -- ^ A paginated fraction of the resource
  , paginatedTotal :: Int
  -- ^ The total number of entries
  }

instance Arbitrary a => Arbitrary (SliceOf a) where
  arbitrary = SliceOf <$> arbitrary <*> arbitrary

-- | Inefficient function to build a response out of a @generator@ function. When the data layer will
-- be rewritten the obvious solution is to slice & dice the data as soon as possible (aka out of the DB), in this order:
--
-- 1. Query/Filtering operations (affects the number of total entries for pagination);
-- 2. Sorting operations
-- 3. Pagination
--
-- See also <https://specs.openstack.org/openstack/api-wg/guidelines/pagination_filter_sort.html this document>, which
-- states:
-- "Paginating responses should be done after applying the filters in a query, because it’s possible for there
-- to be no matches in the first page of results, and returning an empty page is a poor API when the user explicitly
-- requested a number of results."
--
-- NOTE: We have chosen have an approach such that we are sorting the whole dataset after filtering and using
-- lazyness to avoid work. This might not be optimal in terms of performances and we might need to swap sorting
-- and pagination.
--
respondWith :: (Monad m, Indexable a)
            => RequestParams
            -> FilterOperations ixs a
            -- ^ Filtering operations to perform on the data.
            -> SortOperations a
            -- ^ Sorting operations to perform on the data.
            -> m (IxSet a)
            -- ^ The monadic action which produces the results.
            -> m (APIResponse [a])
respondWith RequestParams{..} fops sorts generator = do
    (theData, paginationMetadata) <- paginate rpPaginationParams . sortData sorts . applyFilters fops <$> generator
    return APIResponse {
             wrData = theData
           , wrStatus = SuccessStatus
           , wrMeta = Metadata paginationMetadata
           }

paginate :: PaginationParams -> [a] -> ([a], PaginationMetadata)
paginate params@PaginationParams{..} rawResultSet =
    let totalEntries = length rawResultSet
        (PerPage pp) = ppPerPage
        (Page cp)    = ppPage
        metadata     = paginationParamsToMeta params totalEntries
        slice        = take pp . drop ((cp - 1) * pp)
    in (slice rawResultSet, metadata)

paginationParamsToMeta :: PaginationParams -> Int -> PaginationMetadata
paginationParamsToMeta PaginationParams{..} totalEntries =
    let perPage@(PerPage pp) = ppPerPage
        currentPage          = ppPage
        totalPages = max 1 $ ceiling (fromIntegral totalEntries / (fromIntegral pp :: Double))
    in PaginationMetadata {
      metaTotalPages = totalPages
    , metaPage = currentPage
    , metaPerPage = perPage
    , metaTotalEntries = totalEntries
    }

fromSlice :: PaginationParams -> SliceOf a -> APIResponse [a]
fromSlice params (SliceOf theData totalEntries) = APIResponse {
      wrData   = theData
    , wrStatus = SuccessStatus
    , wrMeta   = Metadata (paginationParamsToMeta params totalEntries)
    }


--
-- Creating a better user experience when it comes to errors.
--

--
-- Error from parsing / validating JSON inputs
--

newtype JSONValidationError
    = JSONValidationFailed Text
    deriving (Eq, Show, Generic)

deriveGeneric ''JSONValidationError

instance ToJSON JSONValidationError where
    toJSON =
        jsendErrorGenericToJSON

instance FromJSON JSONValidationError where
    parseJSON =
        jsendErrorGenericParseJSON

instance Exception JSONValidationError

instance Arbitrary JSONValidationError where
    arbitrary =
        pure (JSONValidationFailed "JSON validation failed.")

instance Buildable JSONValidationError where
    build _ =
        bprint "Couldn't decode a JSON input."

instance HasDiagnostic JSONValidationError where
    getDiagnosticKey _ =
        "validationError"

instance ToServantError JSONValidationError where
    declareServantError _ =
        err400


newtype UnsupportedMimeTypeError
    = UnsupportedMimeTypePresent Text
    deriving (Eq, Show, Generic)

deriveGeneric ''UnsupportedMimeTypeError

instance ToJSON UnsupportedMimeTypeError where
    toJSON =
        jsendErrorGenericToJSON

instance FromJSON UnsupportedMimeTypeError where
    parseJSON =
        jsendErrorGenericParseJSON

instance Exception UnsupportedMimeTypeError

instance Arbitrary UnsupportedMimeTypeError where
    arbitrary =
        pure (UnsupportedMimeTypePresent "Delivered MIME-type is not supported.")

instance Buildable UnsupportedMimeTypeError where
    build (UnsupportedMimeTypePresent txt) =
        bprint build txt

instance HasDiagnostic UnsupportedMimeTypeError where
    getDiagnosticKey _ =
        "mimeContentTypeError"

instance ToServantError UnsupportedMimeTypeError where
    declareServantError _ =
        err415
