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
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
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
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
:: (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)