diff --git a/gopro-plus.cabal b/gopro-plus.cabal --- a/gopro-plus.cabal +++ b/gopro-plus.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: 5e05f8a01680acbd25e66b1641f2c5a02799d5bf8e23075385e768184d45927c +-- hash: 4bb7255d2a4a022d5784c1045d89a42542f454252c098c0e9cd6953c1255c7a7 name: gopro-plus -version: 0.2.0.0 +version: 0.3.0.0 synopsis: GoPro Plus Client API. description: Please see the README on GitHub at category: Web diff --git a/src/GoPro/Plus/Auth.hs b/src/GoPro/Plus/Auth.hs --- a/src/GoPro/Plus/Auth.hs +++ b/src/GoPro/Plus/Auth.hs @@ -9,11 +9,10 @@ GoPro Plus authentication. -} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE FlexibleInstances #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} -{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} module GoPro.Plus.Auth ( authenticate, refreshAuth, @@ -83,7 +82,7 @@ goproAuth = ask -- | Convenient function for passing around auth info. You probably --- don't want to use this, but it can be conven ient when +-- don't want to use this, but it can be convenient when -- experimenting. -withAuth :: (Monad m, HasGoProAuth m) => AuthInfo -> AuthReader m a -> m a +withAuth :: AuthInfo -> AuthReader m a -> m a withAuth = flip runReaderT 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 @@ -20,7 +20,7 @@ fetchThumbnail, -- * Data Types PageInfo(..), current_page, per_page, total_items, total_pages, - MediumID, + MediumID, MediumType(..), ReadyToViewType(..), Medium(..), medium_id, medium_camera_model, medium_captured_at, medium_created_at, medium_file_size, medium_moments_count, medium_ready_to_view, medium_source_duration, medium_type, @@ -49,8 +49,10 @@ genericParseJSON, genericToEncoding, genericToJSON, (.:)) +import qualified Data.Aeson as J import Data.Aeson.Types (typeMismatch) import qualified Data.ByteString.Lazy as BL +import Data.Char (toLower, toUpper) import qualified Data.Map.Strict as Map import qualified Data.Text as T import Data.Time.Clock (UTCTime) @@ -78,6 +80,29 @@ type MediumID = T.Text +data MediumType = Photo | Video | TimeLapse | TimeLapseVideo | Burst + deriving (Show, Read, Eq) + +instance ToJSON MediumType where + toJSON = J.String . T.pack . show + +instance FromJSON MediumType where + parseJSON (J.String x) = pure . read . T.unpack $ x + parseJSON invalid = typeMismatch "Response" invalid + +data ReadyToViewType = ViewReady | ViewFailure | ViewLoading + | ViewRegistered | ViewTranscoding | ViewProcessing | ViewUploading + deriving (Show, Read, Eq) + +instance ToJSON ReadyToViewType where + toJSON = J.String . T.pack . fmap toLower . drop 4 . show + +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 + data Medium = Medium { _medium_id :: MediumID, _medium_camera_model :: Maybe String, @@ -85,9 +110,9 @@ _medium_created_at :: UTCTime, _medium_file_size :: Maybe Int, _medium_moments_count :: Int, - _medium_ready_to_view :: String, + _medium_ready_to_view :: ReadyToViewType, _medium_source_duration :: Maybe String, - _medium_type :: String, + _medium_type :: MediumType, _medium_token :: String, _medium_width :: Maybe Int, _medium_height :: Maybe Int @@ -137,8 +162,8 @@ list :: (HasGoProAuth m, MonadIO m) => Int -> Int -> m ([Medium], PageInfo) list psize page = do r <- jgetAuth ("https://api.gopro.com/media/search?fields=captured_at,created_at,file_size,id,moments_count,ready_to_view,source_duration,type,token,width,height,camera_model&order_by=created_at&per_page=" <> show psize <> "&page=" <> show page) - pure $ (r ^.. media . folded, - r ^. pages) + pure (r ^.. media . folded, + r ^. pages) -- | List all media. listAll :: (HasGoProAuth m, MonadIO m) => m [Medium] @@ -146,8 +171,7 @@ -- | List all media while returned batches pass the given predicate. listWhile :: (HasGoProAuth m, MonadIO m) => ([Medium] -> Bool) -> m [Medium] -listWhile f = do - Map.elems <$> dig 0 mempty +listWhile f = Map.elems <$> dig 0 mempty where dig n m = do (ms, _) <- list 100 n 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 @@ -20,7 +20,7 @@ -- * Low-level upload parts. runUpload, resumeUpload, createMedium, createSource, createDerivative, createUpload, - completeUpload, uploadChunk, markAvailable, + completeUpload, getUpload, uploadChunk, markAvailable, -- * Data Types UploadID, DerivativeID, UploadPart(..), uploadLength, uploadPart, uploadURL, @@ -62,7 +62,9 @@ import GoPro.Plus.Auth (AuthInfo (..), HasGoProAuth (..)) import GoPro.Plus.Internal.AuthHTTP import GoPro.Plus.Internal.HTTP -import GoPro.Plus.Media (Medium (..), MediumID, list, +import GoPro.Plus.Media (Medium (..), MediumID, + MediumType (..), + ReadyToViewType (..), list, putMedium) type UploadID = T.Text @@ -83,7 +85,7 @@ data Env m = Env { fileList :: [FilePath], - mediumType :: T.Text, + mediumType :: MediumType, extension :: T.Text, filename :: String, mediumID :: MediumID, @@ -92,15 +94,14 @@ -- | List all media in uploading state. listUploading :: (HasGoProAuth m, MonadIO m) => m [Medium] -listUploading = do - filter (\Medium{..} -> _medium_ready_to_view == "uploading") . fst <$> list 30 1 +listUploading = filter (\Medium{..} -> _medium_ready_to_view == ViewUploading) . fst <$> list 30 1 -- | Run an Uploader monad to create a single medium and upload the content for it. runUpload :: (HasGoProAuth m, MonadFail m, MonadIO m) => [FilePath] -- ^ The list of files to include in the medium. -> Uploader m a -- ^ The action to perform. -> m a -- ^ The result of the inner action. -runUpload fileList a = resumeUpload fileList "" a +runUpload fileList = resumeUpload fileList "" -- | Run an Uploader monad for which we already know the MediumID -- (i.e., we're resuming an upload we previously began). @@ -114,11 +115,11 @@ mediumType = fileType extension logAction _ = pure () - fileType "JPG" = "Photo" - fileType _ = "Video" + fileType "JPG" = Photo + fileType _ = Video -- | Override the detected medium type. -setMediumType :: Monad m => T.Text -> Uploader m () +setMediumType :: Monad m => MediumType -> Uploader m () setMediumType t = modify (\m -> m{mediumType=t}) -- | Set the logging action to report retries (or whatever other @@ -139,7 +140,7 @@ AuthInfo{..} <- goproAuth let m1 = J.Object (mempty & at "file_extension" ?~ J.String extension & at "filename" ?~ J.String (T.pack filename) - & at "type" ?~ J.String mediumType + & at "type" ?~ J.toJSON mediumType & at "on_public_profile" ?~ J.Bool False & at "content_title" ?~ J.String (T.pack filename) & at "content_source" ?~ J.String "web_media_library" @@ -207,28 +208,40 @@ & at "access_token" ?~ J.String _access_token & at "gopro_user_id" ?~ J.String _resource_owner_id) ur <- jpost "https://api.gopro.com/user-uploads" u1 - let Just upid = ur ^? key "id" . _String + getUpload upid did part fsize + + where + popts tok = authOpts tok & header "Accept" .~ ["application/vnd.gopro.jk.user-uploads+json; version=2.0.0"] + jpost :: (HasGoProAuth m, MonadIO m) => String -> J.Value -> m J.Value + jpost u p = (_access_token <$> goproAuth) >>= \tok -> jpostVal (popts tok) u p + +getUpload :: (HasGoProAuth m, MonadIO m) + => UploadID + -> DerivativeID + -> Int + -> Int + -> Uploader m Upload +getUpload upid did part fsize = do + Env{..} <- get + AuthInfo{..} <- goproAuth + + let pages = (ceiling ((fromIntegral fsize :: Double) / fromIntegral chunkSize)) :: Int upopts = authOpts _access_token & params .~ [("id", upid), ("page", "1"), - ("per_page", "100"), + ("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)] & 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))) + 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 pure $ Upload upid (fromJust $ traverse aChunk ups) where - popts tok = authOpts tok & header "Accept" .~ ["application/vnd.gopro.jk.user-uploads+json; version=2.0.0"] - jpost :: (HasGoProAuth m, MonadIO m) => String -> J.Value -> m J.Value - jpost u p = (_access_token <$> goproAuth) >>= \tok -> jpostVal (popts tok) u p - tInt :: T.Text -> Integer tInt = read . T.unpack - aChunk v = liftA3 UploadPart (v ^? key "Content-Length" . _String . to tInt) (v ^? key "part" . _Integer . to toInteger) (v ^? key "url" . _String . to T.unpack) @@ -244,7 +257,7 @@ hSeek fh AbsoluteSeek ((_uploadPart - 1) * chunkSize) void $ putWith defOpts _uploadURL =<< BL.hGet fh (fromIntegral _uploadLength) - where policy = exponentialBackoff 2000000 <> limitRetries 5 + where policy = exponentialBackoff 2000000 <> limitRetries 9 retryMsg a = mconcat ["Retrying upload of ", show fp, " part ", show _uploadPart, " attempt ", show a] @@ -282,7 +295,7 @@ _ <- liftIO $ putWith (popts _access_token) (T.unpack ("https://api.gopro.com/derivatives/" <> did)) d2 - now <- liftIO $ getCurrentTime + now <- liftIO getCurrentTime let done = J.Object (mempty & at "upload_completed_at" ?~ J.toJSON now & at "client_updated_at" ?~ J.toJSON now & at "revision_number" ?~ J.Number 0