module Network.BackblazeB2.Utils where import qualified Data.Aeson as Json import qualified Data.ByteString as B import Data.CaseInsensitive (mk) import qualified Data.CaseInsensitive as CI import qualified Data.Map.Strict as Map import Data.Text.Read (decimal) import Data.Time (UTCTime) import qualified Network.HTTP.Client as HClient import qualified Network.HTTP.Types.Header as Hdr import qualified Network.HTTP.Types.URI as Uri import LocalPrelude import Network.BackblazeB2.Data urlEncode :: Text -> ByteString urlEncode = Uri.urlEncode False . encodeUtf8 urlDecode :: ByteString -> Text urlDecode = decodeUtf8LE . Uri.urlDecode True execRequest :: ( Json.FromJSON a, Json.ToJSON b, MonadIO m , MonadReader ConnectInfo m ) => Text -> b -> m a execRequest apiName body = do ci <- ask let ai = authInfo ci url = mkUrl apiName ai atok = encodeUtf8 $ aiAuthorizationToken ai auth = header "Authorization" atok fmap responseBody $ liftIO $ req POST url (ReqBodyJson body) jsonResponse auth where mkUrl :: Text -> AuthInfo -> Url 'Https mkUrl name ai = (aiApiUrl ai) /: "b2api" /: "v2" /: name mkLastModifiedKV :: UTCTime -> (Text, Text) mkLastModifiedKV t = ("src_last_modified_millis", show $ getMilliEpoch $ BBTimestamp t) parseObjectMetadataHeaders :: Hdr.ResponseHeaders -> Either LibErr ObjectMetadata parseObjectMetadataHeaders r = ObjectMetadata <$> parseCL <*> (toS <$> lookup Hdr.hContentType) <*> (toS <$> lookup (mk "X-Bz-File-Id")) <*> (urlDecode <$> lookup (mk "X-Bz-File-Name")) <*> (toS <$> lookup (mk "X-Bz-Content-Sha1")) <*> pure parseMeta <*> (lookup (mk "X-Bz-Upload-Timestamp") >>= parseTimestamp) <*> (toS <$> lookup Hdr.hCacheControl) where h = Map.fromList r lookup :: CI.CI ByteString -> Either LibErr ByteString lookup k = maybe (Left $ HeaderMissing k) Right $ Map.lookup k h parseCL :: Either LibErr Int64 parseCL = do val <- lookup Hdr.hContentLength either (Left . HeaderParseError Hdr.hContentLength val) (Right . fst) $ decimal $ decodeUtf8LE val isMetaHdr (k, _) = "x-bz-info-" `B.isPrefixOf` (CI.foldedCase k) dropLen = B.length "x-bz-info-" extractMeta (k, v) = (decodeUtf8LE $ B.drop dropLen $ CI.original k, urlDecode v) parseMeta = Map.fromList $ map extractMeta $ filter isMetaHdr r parseTimestamp :: ByteString -> Either LibErr BBTimestamp parseTimestamp = either (Left . JsonErr . toS) Right . Json.eitherDecodeStrict doRequest :: MonadIO m => ObjectConsumer b -> (Url scheme, Option scheme) -> m b doRequest consumer (url, opts) = liftIO $ reqBr GET url NoReqBody opts $ \r -> do let hdrs = HClient.responseHeaders r metaE = parseObjectMetadataHeaders hdrs case metaE of Left e -> throwIO e Right meta -> do let bodyReader = HClient.responseBody r (unObjectConsumer consumer) (meta, bodyReader)