module Network.BackblazeB2.B2API
  ( Credentials(..)
  , credsFromEnv
  , AuthInfo(..)
  , ConnectInfo(..)
  , authorizeAccount

  , LibErr(..)

  , Bucket
  , BucketType(..)
  , BucketOpts(..)
  , emptyBucketOpts
  , BucketData(..)
  , createBucket

  , deleteBucket

  , AllBuckets(..)
  , listBuckets

  , BucketId
  , UploadUrlInfo(..)
  , getUploadUrl

  , startLargeFile
  , PartUploadUrlInfo(..)
  , getUploadPartUrl
  , PartUploadResp(..)
  , finishLargeFile

  , FileInfo(..)
  , defaultFileProps
  , FileProps(..)
  , Stream(..)
  , uploadFile
  , uploadPart

  , getFileInfo

  , ObjectMetadata(..)
  , ObjectConsumer(..)
  , downloadFileByName
  , downloadFileById

  , FileVersion(..)
  , deleteFileVersion

  , ObjectListArgs(..)
  , ObjectListResult(..)
  , ListResultObjectItem(..)
  , ListResultFolderItem(..)
  , listFileNames
  ) where

import           Data.Aeson                 ((.=))
import qualified Data.Aeson                 as Json
import qualified Data.Conduit               as C
import qualified Data.Map.Strict            as Map
import qualified Data.Text                  as T
import qualified Network.HTTP.Types.Header  as Hdr
import           System.Environment         (lookupEnv)

import           LocalPrelude

import           Network.BackblazeB2.Crypto
import           Network.BackblazeB2.Data
import           Network.BackblazeB2.Utils

-- | Creates `Credentials` from B2_APP_KEY_ID and B2_APP_KEY
-- environment variables.
credsFromEnv
    :: IO (Maybe Credentials)
credsFromEnv = do
    kIdMay <- fmap (fmap T.pack) $ lookupEnv "B2_APP_KEY_ID"
    keyMay <- fmap (fmap T.pack) $ lookupEnv "B2_APP_KEY"
    return $ Credentials <$> kIdMay <*> keyMay

authorizeAccount
    :: Credentials
    -> IO ConnectInfo
authorizeAccount c@(Credentials aId appKey) = do
    (ConnectInfo c . responseBody) <$>
        req GET url NoReqBody jsonResponse authOpt
  where
    url = https "api.backblazeb2.com" /: "b2api" /: "v2" /: "b2_authorize_account"
    authOpt = basicAuth (encodeUtf8 aId) (encodeUtf8 appKey)

createBucket
    :: (MonadReader ConnectInfo m, MonadIO m)
    => Bucket
    -> BucketType
    -> BucketOpts
    -> m BucketData
createBucket b bType bOpts = do
    accId <- asks (aiAccountId . authInfo)
    execRequest "b2_create_bucket" $
        Json.object ["accountId" .= accId,
                     "bucketName" .= b,
                     "bucketType" .= bType,
                     "bucketInfo" .= boBucketInfo bOpts,
                     "lifecycleRules" .= boLCRs bOpts]

deleteBucket
    :: (MonadReader ConnectInfo m, MonadIO m)
    => BucketId
    -> m BucketData
deleteBucket bucketId = do
    accId <- asks (aiAccountId . authInfo)
    execRequest "b2_delete_bucket" $
        Json.object [ "accountId" .= accId
                    , "bucketId" .= bucketId
                    ]

listBuckets
    :: (MonadReader ConnectInfo m, MonadIO m)
    => m AllBuckets
listBuckets = do
    accId <- asks (aiAccountId . authInfo)
    execRequest "b2_list_buckets" $ Json.object ["accountId" .= accId]

getUploadUrl
    :: (MonadReader ConnectInfo m, MonadIO m)
    => BucketId
    -> m UploadUrlInfo
getUploadUrl bId =
  execRequest "b2_get_upload_url" $ Json.object ["bucketId" .= bId]

startLargeFile
    :: (MonadReader ConnectInfo m, MonadIO m)
    => BucketId
    -> Object
    -> FileProps
    -> m FileInfo
startLargeFile bId obj props =
    execRequest "b2_start_large_file" $ Json.object
    [ "bucketId" .= bId
    , "fileName" .= obj
    , "contentType" .= fpContentType props
    , "fileInfo" .= (fpMetaInfo props <> lastModifiedMeta)
    ]
  where
    lastModifiedMeta =
        maybe Map.empty
        ((\(k, v) -> Map.singleton k v) . mkLastModifiedKV) $
        fpLastModified props

getUploadPartUrl
    :: (MonadReader ConnectInfo m, MonadIO m)
    => FileId
    -> m PartUploadUrlInfo
getUploadPartUrl fId =
    execRequest "b2_get_upload_part_url" $ Json.object [ "fileId" .= fId ]

finishLargeFile
    :: (MonadReader ConnectInfo m, MonadIO m)
    => FileId
    -> [Text]
    -> m FileInfo
finishLargeFile fId sha1List =
    execRequest "b2_finish_large_file" $ Json.object
    [ "fileId" .= fId
    , "partSha1Array" .= sha1List
    ]

deleteFileVersion
    :: (MonadReader ConnectInfo m, MonadIO m)
    => FileVersion
    -> m FileVersion
deleteFileVersion fv = do
  execRequest "b2_delete_file_version" fv

getFileInfo
    :: (MonadReader ConnectInfo m, MonadIO m)
    => ObjectId
    -> m FileInfo
getFileInfo objId =
  execRequest "b2_get_file_info" $ Json.object ["fileId" .= objId]

listFileNames
    :: (MonadReader ConnectInfo m, MonadIO m)
    => ObjectListArgs
    -> m ObjectListResult
listFileNames listArgs =
  execRequest "b2_list_file_names" listArgs

-- | Performs the b2_upload_file call with a `Stream` that provides
-- the bytes for the file content.
uploadFile
    :: MonadIO m
    => UploadUrlInfo
    -> Object
    -> FileProps
    -> Stream
    -> m FileInfo
uploadFile uu objName fileProps src = do
    let UploadUrl (url, opts') = uuUploadUrl uu
        opts = opts'
            <> header "Authorization"
               (encodeUtf8 $ uuAuthorizationToken uu)
            <> header "X-Bz-File-Name" (urlEncode objName)
            <> header "Content-Type"
               (encodeUtf8 $ fpContentType fileProps)
            <> header "X-Bz-Content-Sha1" "hex_digits_at_end"
            <> optHeaders
        body = streamToReqBody $
               Stream { streamLength = streamLength src + 40
                      , streamSource = streamSource src C..| sha1Hasher
                      }
    fmap responseBody $ liftIO $ req POST url body jsonResponse opts

  where
    modTimeHdrOpt = fromMaybe mempty $
        ( header "X-Bz-Info-src_last_modified_millis"
        . show
        . getMilliEpoch
        . BBTimestamp
        ) <$> fpLastModified fileProps
    mkMetaHdr (k, v) = header
        (encodeUtf8 $ sformat ("X-Bz-Info-" % stext) k) $
        urlEncode v
    optHeaders = modTimeHdrOpt
              <> (mconcat $ map mkMetaHdr $
                  Map.toList $
                  fpMetaInfo fileProps)

uploadPart
    :: MonadIO m
    => PartUploadUrlInfo
    -> Int
    -> Stream
    -> m PartUploadResp
uploadPart pu partNumber src = do
    let UploadUrl (url, opts') = puuUploadUrl pu
        opts = opts'
            <> header "Authorization"
               (encodeUtf8 $ puuAuthorizationToken pu)
            <> header "X-Bz-Part-Number" (show partNumber)
            <> header "Content-Length" (show $ 40 + streamLength src)
            <> header "X-Bz-Content-Sha1" "hex_digits_at_end"
        body = streamToReqBody $
               Stream { streamLength = streamLength src + 40
                      , streamSource = streamSource src C..| sha1Hasher
                      }
    fmap responseBody $ liftIO $ req POST url body jsonResponse opts

-- | Download a file by name and pass the result to the provided
-- consumer.
downloadFileByName
    :: (MonadReader ConnectInfo m, MonadIO m)
    => Bucket
    -> Object
    -> Hdr.ByteRanges
    -> ObjectConsumer a
    -> m a
downloadFileByName bucketName objName ranges consumer = do
    authTok <- encodeUtf8 <$> asks (aiAuthorizationToken . authInfo)
    dlUrl <- asks (getDownloadUrl . authInfo)
    let objPathSegments = T.splitOn "/" objName
        appendSegs s []     = s
        appendSegs s (x:xs) = appendSegs (s /: x) xs

        url = (dlUrl /: "file" /: bucketName) `appendSegs` objPathSegments

        rangeOpt = bool (header "Range" $ Hdr.renderByteRanges ranges)
                   mempty $ null ranges
        opts = header "Authorization" authTok <> rangeOpt

    doRequest consumer (url, opts)

-- | downloadFileById downloads an object given its Id and calls the
-- provided consumer on it.
downloadFileById
    :: (MonadReader ConnectInfo m, MonadIO m)
    => ObjectId
    -> Hdr.ByteRanges
    -> ObjectConsumer a
    -> m a
downloadFileById objId ranges consumer = do
    authTok <- encodeUtf8 <$> asks (aiAuthorizationToken . authInfo)
    dlUrl <- asks (getDownloadUrl . authInfo)
    let url = dlUrl /: "b2api" /: "v2" /: "b2_download_file_by_id"
        rangeOpt = bool (header "Range" $ Hdr.renderByteRanges ranges)
                   mempty $ null ranges
        opts = header "Authorization" authTok
            <> ("fileId" =: objId)
            <> rangeOpt

    doRequest consumer (url, opts)