diff --git a/gopro-plus.cabal b/gopro-plus.cabal --- a/gopro-plus.cabal +++ b/gopro-plus.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4. +-- This file has been generated from package.yaml by hpack version 0.34.5. -- -- see: https://github.com/sol/hpack -- --- hash: 68c1e9163a8057cb37b7d179377d24c7517b740d7730613114203d9aaa90fe1e +-- hash: 57cf02eb87fe6fc679342279e3e8cce751af7a630f9ac8354e765009f2a67efa name: gopro-plus -version: 0.6.0.0 +version: 0.6.0.3 synopsis: GoPro Plus Client API. description: Please see the README on GitHub at category: Web diff --git a/src/GoPro/Plus/Internal/HTTP.hs b/src/GoPro/Plus/Internal/HTTP.hs --- a/src/GoPro/Plus/Internal/HTTP.hs +++ b/src/GoPro/Plus/Internal/HTTP.hs @@ -4,21 +4,22 @@ import Control.Lens import Control.Monad.IO.Class (MonadIO (..)) -import Data.Aeson (FromJSON (..), Options (..), - defaultOptions, fieldLabelModifier) +import Data.Aeson (FromJSON (..), Options (..), defaultOptions, fieldLabelModifier) import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import Data.Text (Text) import qualified Data.Text.Encoding as TE -import Network.Wreq (Options, asJSON, defaults, getWith, - header, postWith, responseBody) +import Network.Wreq (Options, asJSON, defaults, getWith, header, postWith, responseBody) import Network.Wreq.Types (Postable) userAgent :: BC.ByteString -userAgent = "github.com/dustin/gopro 0.1" +userAgent = "github.com/dustin/gopro-plus 0.6.0.3" defOpts :: Network.Wreq.Options defOpts = defaults & header "User-Agent" .~ [userAgent] + & header "Referer" .~ ["https://plus.gopro.com/"] + & header "Origin" .~ ["https://plus.gopro.com"] + & header "Accept-Language" .~ ["en-US,en;q=0.9"] authOpts :: Text -> Network.Wreq.Options authOpts tok = defOpts & header "Authorization" .~ ["Bearer " <> TE.encodeUtf8 tok] diff --git a/src/GoPro/Plus/Media.hs b/src/GoPro/Plus/Media.hs --- a/src/GoPro/Plus/Media.hs +++ b/src/GoPro/Plus/Media.hs @@ -51,7 +51,7 @@ import qualified Data.Aeson as J import Data.Aeson.Types (typeMismatch) import qualified Data.ByteString.Lazy as BL -import Data.Char (toLower, toUpper) +import Data.Char (toLower) import qualified Data.Map.Strict as Map import qualified Data.Text as T import Data.Time.Clock (UTCTime) @@ -111,16 +111,15 @@ | ViewTranscoding | ViewProcessing | ViewUploading - deriving (Bounded, Enum, Show, Read, Eq) + deriving (Bounded, Enum, Show, Read, Generic, Eq) instance ToJSON ReadyToViewType where - toJSON = J.String . T.pack . fmap toLower . drop 4 . show + toEncoding = genericToEncoding jsonOpts{ constructorTagModifier = fmap toLower . dropPrefix "View"} + toJSON = genericToJSON jsonOpts{ constructorTagModifier = fmap toLower . dropPrefix "View"} + instance FromJSON ReadyToViewType where - parseJSON (J.String s) = pure . read . trans . T.unpack $ s - where trans (x:xs) = "View" <> (toUpper x : xs) - trans [] = error "empty ready to view type" - parseJSON invalid = typeMismatch "Response" invalid + parseJSON = genericParseJSON jsonOpts{ constructorTagModifier = fmap toLower . dropPrefix "View"} data Medium = Medium { _medium_id :: MediumID diff --git a/src/GoPro/Plus/Upload.hs b/src/GoPro/Plus/Upload.hs --- a/src/GoPro/Plus/Upload.hs +++ b/src/GoPro/Plus/Upload.hs @@ -27,7 +27,7 @@ Upload(..), uploadID, uploadParts, -- * Uploader monad. Uploader, - setMediumType, setLogAction, + setMediumType, setLogAction, setChunkSize, -- * For your convenience. listUploading ) where @@ -41,6 +41,7 @@ import Control.Retry (RetryStatus (..), exponentialBackoff, limitRetries, recoverAll) import qualified Data.Aeson as J import Data.Aeson.Lens +import qualified Data.ByteString.Char8 as BC import qualified Data.ByteString.Lazy as BL import Data.Char (toUpper) import Data.List.NonEmpty (NonEmpty (..)) @@ -83,6 +84,7 @@ extension :: T.Text, filename :: String, mediumID :: MediumID, + chunkSize :: Integer, logAction :: (MonadMask m, Monad m) => String -> m () } @@ -97,6 +99,9 @@ -> m a -- ^ The result of the inner action. runUpload fileList = resumeUpload fileList "" +defaultChunkSize :: Integer +defaultChunkSize = 6*1024*1024 + -- | Run an Uploader monad for which we already know the MediumID -- (i.e., we're resuming an upload we previously began). resumeUpload :: (HasGoProAuth m, MonadIO m) => NonEmpty FilePath -> MediumID -> Uploader m a -> m a @@ -106,6 +111,7 @@ filename = takeFileName fp mediumType = fileType extension logAction _ = pure () + chunkSize = defaultChunkSize fileType "JPG" = Photo fileType _ = Video @@ -119,6 +125,10 @@ setLogAction :: (Monad m, MonadMask m) => (String -> m ()) -> Uploader m () setLogAction t = modify (\m -> m{logAction=t}) +-- | Set the individual chunk size for uploading parts of media. +setChunkSize :: (Monad m, MonadMask m) => Integer -> Uploader m () +setChunkSize t = modify (\m -> m{chunkSize=t}) + jpostVal :: (HasGoProAuth m, MonadIO m) => Options -> String -> J.Value -> m J.Value jpostVal opts u v = liftIO $ jpostWith opts u v @@ -182,9 +192,6 @@ makeLenses ''Upload -chunkSize :: Integer -chunkSize = 6291456 - -- | Create a new upload for a derivative. createUpload :: (HasGoProAuth m, MonadIO m) => DerivativeID -- ^ The derivative into which we're uploading. @@ -216,15 +223,16 @@ -> Uploader m Upload getUpload upid did part fsize = do AuthInfo{..} <- goproAuth + csize <- gets chunkSize - let pages = ceiling ((fromIntegral fsize :: Double) / fromIntegral chunkSize) :: Int + let pages = ceiling ((fromIntegral fsize :: Double) / fromIntegral csize) :: Int upopts = authOpts _access_token & params .~ [("id", upid), ("page", "1"), ("per_page", (T.pack . show) pages), ("item_number", (T.pack . show) part), ("camera_position", "default"), ("file_size", (T.pack . show) fsize), - ("part_size", (T.pack . show) chunkSize)] + ("part_size", (T.pack . show) csize)] & header "Accept" .~ ["application/vnd.gopro.jk.user-uploads+json; version=2.0.0"] upaths <- jgetWith upopts (T.unpack ("https://api.gopro.com/user-uploads/" <> did)) let Just ups = (upaths :: J.Value) ^? key "_embedded" . key "authorizations" . _Array . to V.toList @@ -244,9 +252,12 @@ -> Uploader m () uploadChunk fp UploadPart{..} = recoverAll policy $ \r -> do when (rsIterNumber r > 0) $ gets logAction >>= \f -> lift (f (retryMsg (rsIterNumber r))) + csize <- gets chunkSize liftIO $ withFile fp ReadMode $ \fh -> do - hSeek fh AbsoluteSeek ((_uploadPart - 1) * chunkSize) - void $ putWith defOpts _uploadURL =<< BL.hGet fh (fromIntegral _uploadLength) + hSeek fh AbsoluteSeek ((_uploadPart - 1) * csize) + bytes <- BL.hGet fh (fromIntegral _uploadLength) + let opts = defOpts & header "Content-Length" .~ [BC.pack . show . BL.length $ bytes] + void $ putWith opts _uploadURL bytes where policy = exponentialBackoff 2000000 <> limitRetries 9 retryMsg a = mconcat ["Retrying upload of ", show fp, @@ -261,13 +272,14 @@ -> Uploader m () completeUpload upid did part fsize = do AuthInfo{..} <- goproAuth + csize <- gets chunkSize let u2 = J.Object (mempty & at "id" ?~ J.String upid & at "item_number" ?~ J.Number (fromIntegral part) & at "camera_position" ?~ J.String "default" & at "complete" ?~ J.Bool True & at "derivative_id" ?~ J.String did & at "file_size" ?~ J.String ((T.pack . show) fsize) - & at "part_size" ?~ J.String ((T.pack . show) chunkSize)) + & at "part_size" ?~ J.String ((T.pack . show) csize)) void . liftIO $ putWith (popts _access_token) (T.unpack ("https://api.gopro.com/user-uploads/" <> did)) u2 where