{-# LANGUAGE DeriveGeneric #-}
module Network.BackblazeB2.Data where

import qualified Conduit                   as C
import           Control.Monad.Fail        (fail)
import           Data.Aeson                ((.:), (.:?))
import qualified Data.Aeson                as Json
import qualified Data.Aeson.Types          as Json
import qualified Data.Char                 as Char
import qualified Data.Map.Strict           as Map
import qualified Data.Ratio                as R
import qualified Data.Scientific           as Sc
import           Data.Time                 (UTCTime)
import           Data.Time.Clock.POSIX     (posixSecondsToUTCTime,
                                            utcTimeToPOSIXSeconds)
import           Network.HTTP.Client       (HttpException (HttpExceptionRequest),
                                            HttpExceptionContent (StatusCodeException))
import           Network.HTTP.Req          (HttpException (VanillaHttpException),
                                            MonadHttp (..))
import qualified Network.HTTP.Req.Conduit  as RC
import qualified Network.HTTP.Types.Header as Hdr


import           LocalPrelude

-- | Connection info with accountId and applicationKey from Backblaze
-- B2 account UI.
data Credentials =
    Credentials
    { cAccountId      :: Text
    , cApplicationKey :: Text
    } deriving (Eq, Show)

instance MonadHttp IO where
    handleHttpException e =
        case e of
          stEx@(VanillaHttpException (HttpExceptionRequest _
                                      (StatusCodeException _ bs)))
              -> case Json.decodeStrict bs of
                   Nothing    -> throwIO stEx
                   Just b2Err -> throwIO $ LEServer b2Err
          v -> throwIO v

-- | Helper function for JSON conversion
labelModifierFn :: Int -> Json.Options
labelModifierFn n = Json.defaultOptions {
  Json.fieldLabelModifier = fixCase . drop n
  }
  where
    fixCase ""    = ""
    fixCase (h:t) = Char.toLower h : t

-- | TODO: Load the rest of the auth info response too!
data AuthInfo = AuthInfo
    { aiAccountId           :: Text
    , aiAuthorizationToken  :: Text
    , aiApiUrl              :: Url 'Https
    , aiDownloadUrl         :: Url 'Https
    , aiRecommendedPartSize :: Int64
    } deriving (Eq, Show)

instance Json.FromJSON AuthInfo where
    parseJSON (Json.Object v) = do
        accId <- v .: "accountId"
        authTok <- v .: "authorizationToken"
        apiUrlStr <- v .: "apiUrl"
        apiUrl <- case parseUrlHttps (encodeUtf8 apiUrlStr) of
                    Just (url, _) -> return url
                    _             -> fail "invalid url received."

        dwnUrlStr <- v .: "downloadUrl"
        dwnUrl <- case parseUrlHttps (encodeUtf8 dwnUrlStr) of
                    Just (url, _) -> return url
                    _             -> fail "invalid url received."
        rPsz <- v .: "recommendedPartSize"
        return $ AuthInfo accId authTok apiUrl dwnUrl rPsz
    parseJSON o = Json.typeMismatch "object" o

getDownloadUrl :: AuthInfo -> Url 'Https
getDownloadUrl ai = aiDownloadUrl ai

data ConnectInfo = ConnectInfo
  { creds    :: Credentials
  , authInfo :: AuthInfo
  } deriving (Show, Eq)

-- | High-level error type for all errors from library
data LibErr = LEServer BB2Error
            | JsonErr Text
            | NoAuthFound
            | HeaderMissing Hdr.HeaderName
            | HeaderParseError Hdr.HeaderName ByteString [Char]
--            | LEOther (NC.Response LByteString)
  deriving (Eq, Show)

instance Exception LibErr

tryLibErr :: MonadUnliftIO m => m a -> m (Either LibErr a)
tryLibErr act = try act

-- | Backblaze B2 Server error response
data BB2Error = BB2Error { bb2eStatus  :: Int
                         , bb2eCode    :: Text
                         , bb2eMessage :: Text
                         } deriving (Show, Eq, Generic)

instance Json.FromJSON BB2Error where
  parseJSON = Json.genericParseJSON $ labelModifierFn 4

type Bucket = Text

data BucketType = AllPublic | AllPrivate
                deriving (Eq, Show)

instance Json.FromJSON BucketType where
    parseJSON (Json.String "allPrivate") = return AllPrivate
    parseJSON (Json.String "allPublic")  = return AllPublic
    parseJSON o                          = Json.typeMismatch "string" o

instance Json.ToJSON BucketType where
    toJSON AllPrivate = Json.String "allPrivate"
    toJSON AllPublic  = Json.String "allPublic"

type BucketInfo = Map.Map Text Text

type BucketId = Text

type FileId = Text

data LifecycleRule = LifecycleRule {
    lcrFileNamePrefix            :: Text
  , lcrDaysFromUploadingToHiding :: Maybe Int64
  , lcrDaysFromHidingToDeleting  :: Maybe Int64
  } deriving (Show, Eq, Generic)

instance Json.ToJSON LifecycleRule where
  toJSON = Json.genericToJSON $ labelModifierFn 3
  toEncoding = Json.genericToEncoding $ labelModifierFn 3

instance Json.FromJSON LifecycleRule where
  parseJSON = Json.genericParseJSON $ labelModifierFn 3

data BucketOpts = BucketOpts {
    boBucketInfo :: Maybe BucketInfo
  , boLCRs       :: [LifecycleRule]
  } deriving (Show, Eq)

emptyBucketOpts :: BucketOpts
emptyBucketOpts = BucketOpts Nothing []

data BucketData = BucketData {
    brdAccountId      :: Text
  , brdBucketId       :: BucketId
  , brdBucketName     :: Bucket
  , brdBucketType     :: BucketType
  , brdBucketInfo     :: BucketInfo
  , brdLifecycleRules :: [LifecycleRule]
  , brdRevision       :: Int64
  } deriving (Show, Eq, Generic)

instance Json.FromJSON BucketData where
  parseJSON = Json.genericParseJSON $ labelModifierFn 3

data AllBuckets = AllBuckets {
  abBuckets :: [BucketData]
  } deriving (Show, Eq, Generic)

instance Json.FromJSON AllBuckets where
  parseJSON = Json.genericParseJSON $ labelModifierFn 2

newtype UploadUrl = UploadUrl { unUploadUrl :: (Url 'Https, Option 'Https)}

instance Json.FromJSON UploadUrl where
    parseJSON (Json.String s) =
        case parseUrlHttps (encodeUtf8 s) of
          Just (url, opts) -> return $ UploadUrl (url, opts)
          _                -> fail "Invalid url received."
    parseJSON o = Json.typeMismatch "string" o

data UploadUrlInfo = UploadUrlInfo
    { uuBucketId           :: BucketId
    , uuUploadUrl          :: UploadUrl
    , uuAuthorizationToken :: Text
    } deriving (Generic)

instance Json.FromJSON UploadUrlInfo where
    parseJSON = Json.genericParseJSON $ labelModifierFn 2

-- instance Json.FromJSON UploadUrl where
--     parseJSON (Json.Object v) = do
--         bId <- v .: "bucketId"
--         upUrlStr <- v .: "uploadUrl"
--         upUrl <- case parseUrlHttps (encodeUtf8 upUrlStr) of
--                    Just (url, opts) -> return (url, opts)
--                    Nothing          -> fail "invalid url received."
--         authTok <- v .: "authorizationToken"
--         return $ UploadUrl bId upUrl authTok
--     parseJSON o = Json.typeMismatch "object" o

data PartUploadUrlInfo =
    PartUploadUrlInfo
    { puuFileId             :: FileId
    , puuUploadUrl          :: UploadUrl
    , puuAuthorizationToken :: Text
    } deriving (Generic)

instance Json.FromJSON PartUploadUrlInfo where
    parseJSON = Json.genericParseJSON $ labelModifierFn 3

data PartUploadResp =
    PartUploadResp { purFileId          :: FileId
                   , purContentLength   :: Int64
                   , purContentSha1     :: Text
                   , purUploadTimestamp :: BBTimestamp
                   }
    deriving (Show, Generic)

instance Json.FromJSON PartUploadResp where
    parseJSON = Json.genericParseJSON $ labelModifierFn 3

-- | Type to allow easy conversion between BB2 timestamps
-- representation and UTCTime
newtype BBTimestamp = BBTimestamp { getBBTimestamp :: UTCTime }
  deriving (Eq, Show)

getMilliEpoch :: BBTimestamp -> Int64
getMilliEpoch (BBTimestamp t) =
  1000 * round (utcTimeToPOSIXSeconds t)

instance Json.FromJSON BBTimestamp where
  parseJSON = Json.withScientific "UnixMilliEpoch" $ \n ->
    let millis = fromIntegral <$> (Sc.toBoundedInteger n :: Maybe Int64)
    in case millis of
         Just m -> pure . BBTimestamp . posixSecondsToUTCTime .
                   fromRational $ m R.% 1000
         _ -> fail "could not parse milli-epoch time"

instance Json.ToJSON BBTimestamp where
  toJSON = Json.toJSON . getMilliEpoch
  toEncoding = Json.toEncoding . getMilliEpoch

data FileProps =
    FileProps
    { fpContentType  :: Text -- default value is `b2/x-auto`
    , fpLastModified :: Maybe UTCTime
    , fpMetaInfo     :: Map.Map Text Text -- Value is automatically
                                          -- percent encoded, Key is
                                          -- automatically prefixed
                                          -- with `X-Bz-Info-`
    } deriving (Show, Eq)

defaultFileProps :: FileProps
defaultFileProps = FileProps "b2/x-auto" Nothing Map.empty

data FileInfo =
    FileInfo
    { fiFileId          :: Text
    , fiFileName        :: Text
    , fiAccountId       :: Text
    , fiBucketId        :: BucketId
    , fiContentLength   :: Int64
    , fiContentSha1     :: Text
    , fiContentType     :: Text
    , fiFileInfo        :: Map.Map Text Text
    , fiAction          :: Text
    , fiUploadTimestamp :: BBTimestamp
    } deriving (Show, Eq, Generic)

instance Json.FromJSON FileInfo where
  parseJSON = Json.genericParseJSON $ labelModifierFn 2

data DownloadAuth = DownloadAuth {
    daBucketId           :: BucketId
  , daFileNamePrefix     :: Text
  , daAuthorizationToken :: Text
  } deriving (Show, Eq, Generic)

instance Json.FromJSON DownloadAuth where
  parseJSON = Json.genericParseJSON $ labelModifierFn 2

type Object = Text

type ObjectId = Text

data ObjectMetadata = ObjectMetadata {
    omContentLength   :: Int64
  , omContentType     :: Text
  , omObjectId        :: ObjectId
  , omObjectName      :: Object
  , omContentSha1     :: Text
  , omXBzInfo         :: Map Text Text
  , omUploadTimestamp :: BBTimestamp
  , omCacheControl    :: Text
  } deriving (Eq, Show)

data FileVersion = FileVersion {
    fvFileName :: Object
  , fvFileId   :: ObjectId
  } deriving (Show, Eq, Generic)

instance Json.FromJSON FileVersion where
  parseJSON = Json.genericParseJSON $ labelModifierFn 2

instance Json.ToJSON FileVersion where
  toJSON = Json.genericToJSON $ labelModifierFn 2
  toEncoding = Json.genericToEncoding $ labelModifierFn 2

data ObjectListArgs = ObjectListArgs {
    olaBucketId      :: BucketId
  , olaStartFileName :: Maybe Object
  , olaMaxFileCount  :: Maybe Int
  , olaPrefix        :: Maybe Object
  , olaDelimiter     :: Maybe Text
  } deriving (Show, Eq, Generic)

instance Json.ToJSON ObjectListArgs where
  toJSON = Json.genericToJSON $ labelModifierFn 3
  toEncoding = Json.genericToEncoding $ labelModifierFn 3

data ListResultObjectItem = ListResultObjectItem {
    lroiFileId          :: Text
  , lroiFileName        :: Object
  , lroiContentLength   :: Int64
  , lroiContentType     :: Maybe Text
  , lroiContentSha1     :: Maybe Text
  , lroiFileInfo        :: Maybe (Map.Map Text Text)
  , lroiAction          :: Text
  , lroiUploadTimestamp :: BBTimestamp
  } deriving (Show, Eq, Generic)

instance Json.FromJSON ListResultObjectItem where
  parseJSON = Json.genericParseJSON $ labelModifierFn 4

data ListResultFolderItem = ListResultFolderItem {
    lrfiFileName :: Object
  , lrfiAction   :: Text
  } deriving (Show, Eq, Generic)

instance Json.FromJSON ListResultFolderItem where
  parseJSON = Json.genericParseJSON $ labelModifierFn 4

data ListResultItem = LRIObject ListResultObjectItem
                    | LRIFolder ListResultFolderItem
                    deriving (Show, Eq)

instance Json.FromJSON ListResultItem where
  parseJSON v = (LRIObject <$> Json.parseJSON v)
            <|> (LRIFolder <$> Json.parseJSON v)

data ObjectListResult = ObjectListResult {
    olrFiles        :: [ListResultObjectItem]
  , olrFolders      :: [ListResultFolderItem]
  , olrNextFileName :: Maybe Object
  } deriving (Show, Eq, Generic)

instance Json.FromJSON ObjectListResult where
  parseJSON = Json.withObject "ObjectListResult" $ \o -> do
    nxt <- o .:? "nextFileName"
    listResultItems <- o .: "files"
    let (files, folders) = partitionIt listResultItems
    return $ ObjectListResult (reverse files) (reverse folders) nxt

    where
      partitionIt :: [ListResultItem] -> ([ListResultObjectItem],
                                          [ListResultFolderItem])
      partitionIt = flip foldl ([], []) $
        \(files, folders) item -> case item of
                                    LRIObject x -> (x:files, folders)
                                    LRIFolder x -> (files, x:folders)

-- | Stream type for uploading data to B2. It is made of a conduit and
-- a length representing the size of the stream in bytes.
data Stream = Stream
    { streamLength :: Int64
    , streamSource :: C.ConduitT () ByteString IO ()
    }

streamToReqBody :: Stream -> RC.ReqBodySource
streamToReqBody s =
    RC.ReqBodySource (streamLength s) (streamSource s)

-- | An object consumer is a function that receives object metadat and
-- an action that returns chunks of the body (returning an empty
-- bytestring when no more bytes are available).
newtype ObjectConsumer a =
    ObjectConsumer
    { unObjectConsumer :: (ObjectMetadata, IO ByteString) -> IO a
    }