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: b4c60409c9e9406365ffe3ec82ce27b60c07ebd5d0034067010866c7ef456fbd +-- hash: 5e05f8a01680acbd25e66b1641f2c5a02799d5bf8e23075385e768184d45927c name: gopro-plus -version: 0.1.0.0 +version: 0.2.0.0 synopsis: GoPro Plus Client API. description: Please see the README on GitHub at category: Web @@ -30,6 +30,7 @@ library exposed-modules: GoPro.Plus.Auth + GoPro.Plus.Internal.AuthHTTP GoPro.Plus.Internal.HTTP GoPro.Plus.Media GoPro.Plus.Upload 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,18 +9,23 @@ GoPro Plus authentication. -} -{-# LANGUAGE DeriveGeneric #-} -{-# LANGUAGE RecordWildCards #-} -{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE TypeSynonymInstances #-} module GoPro.Plus.Auth ( authenticate, refreshAuth, - AuthResponse(..), access_token, expires_in, refresh_token, resource_owner_id + AuthInfo(..), access_token, expires_in, refresh_token, resource_owner_id, + HasGoProAuth(..), withAuth, AuthReader, Token ) where import Control.Lens import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.Reader (ReaderT (..), ask, runReaderT) import Data.Aeson (FromJSON (..), genericParseJSON) +import Data.Text (Text) import Generics.Deriving.Base (Generic) import Network.Wreq (FormParam (..)) @@ -34,23 +39,28 @@ authURL :: String authURL = "https://api.gopro.com/v1/oauth2/token" +type Token = Text + -- | An Authentication response. -data AuthResponse = AuthResponse { - _access_token :: String +data AuthInfo = AuthInfo { + _access_token :: Token , _expires_in :: Int - , _refresh_token :: String - , _resource_owner_id :: String + , _refresh_token :: Text + , _resource_owner_id :: Text } deriving(Generic, Show) -instance FromJSON AuthResponse where +class Monad m => HasGoProAuth m where + goproAuth :: m AuthInfo + +instance FromJSON AuthInfo where parseJSON = genericParseJSON jsonOpts -makeLenses ''AuthResponse +makeLenses ''AuthInfo authenticate :: MonadIO m => String -- ^ Email/username -> String -- ^ Password - -> m AuthResponse + -> m AuthInfo authenticate username password = jpostWith defOpts authURL ["grant_type" := ("password" :: String), "client_id" := apiClientID, @@ -60,9 +70,20 @@ "password" := password] -- | Refresh authentication credentials using a refresh token. -refreshAuth :: MonadIO m => AuthResponse -> m AuthResponse -refreshAuth AuthResponse{..} = +refreshAuth :: MonadIO m => AuthInfo -> m AuthInfo +refreshAuth AuthInfo{..} = jpostWith defOpts authURL ["grant_type" := ("refresh_token" :: String), "client_id" := apiClientID, "client_secret" := apiClientSecret, "refresh_token" := _refresh_token] + +type AuthReader = ReaderT AuthInfo + +instance Monad m => HasGoProAuth (AuthReader m) where + goproAuth = ask + +-- | Convenient function for passing around auth info. You probably +-- don't want to use this, but it can be conven ient when +-- experimenting. +withAuth :: (Monad m, HasGoProAuth m) => AuthInfo -> AuthReader m a -> m a +withAuth = flip runReaderT diff --git a/src/GoPro/Plus/Internal/AuthHTTP.hs b/src/GoPro/Plus/Internal/AuthHTTP.hs new file mode 100644 --- /dev/null +++ b/src/GoPro/Plus/Internal/AuthHTTP.hs @@ -0,0 +1,34 @@ +module GoPro.Plus.Internal.AuthHTTP where + +import Control.Lens +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Aeson (FromJSON (..)) +import qualified Data.ByteString.Lazy as BL +import Network.Wreq (Options, asJSON, getWith, postWith, + putWith, responseBody) +import Network.Wreq.Types (Postable, Putable) + +import GoPro.Plus.Auth +import GoPro.Plus.Internal.HTTP + + +jgetAuth :: (HasGoProAuth m, MonadIO m, FromJSON a) => String -> m a +jgetAuth u = goproAuth >>= \AuthInfo{..} -> jgetWith (authOpts _access_token) u + + +authOptsM :: HasGoProAuth m => m Network.Wreq.Options +authOptsM = authOpts . _access_token <$> goproAuth + +jgetWithAuth :: (HasGoProAuth m, MonadIO m, FromJSON a) => Network.Wreq.Options -> String -> m a +jgetWithAuth opts u = view responseBody <$> liftIO (getWith opts u >>= asJSON) + +jputAuth :: (HasGoProAuth m, MonadIO m, FromJSON j, Putable a) => String -> a -> m j +jputAuth u a = authOptsM >>= \o -> view responseBody <$> liftIO (putWith o u a >>= asJSON) + + +-- | Proxy a request to GoPro with authentication. +proxyAuth :: (HasGoProAuth m, MonadIO m) => String -> m BL.ByteString +proxyAuth u = (_access_token <$> goproAuth) >>= \tok -> proxy tok u + +jpostAuth :: (HasGoProAuth m, MonadIO m, Postable a, FromJSON r) => String -> a -> m r +jpostAuth u v = authOptsM >>= \opts -> view responseBody <$> liftIO (postWith opts u v >>= asJSON) 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 @@ -6,6 +6,8 @@ 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.Types (Postable) @@ -16,26 +18,23 @@ defOpts :: Network.Wreq.Options defOpts = defaults & header "User-Agent" .~ [userAgent] - -authOpts :: String -> Network.Wreq.Options -authOpts tok = defOpts & header "Authorization" .~ ["Bearer " <> BC.pack tok] +authOpts :: Text -> Network.Wreq.Options +authOpts tok = defOpts & header "Authorization" .~ ["Bearer " <> TE.encodeUtf8 tok] & header "Accept" .~ ["application/vnd.gopro.jk.media+json; version=2.0.0"] & header "Content-Type" .~ ["application/json"] -type Token = String - jsonOpts :: Data.Aeson.Options jsonOpts = defaultOptions { fieldLabelModifier = dropWhile (== '_') } -- | Proxy a request to GoPro with authentication. -proxy :: MonadIO m => Token -> String -> m BL.ByteString +proxy :: MonadIO m => Text -> String -> m BL.ByteString proxy tok u = do r <- liftIO $ getWith (authOpts tok) u pure $ r ^. responseBody -jget :: (MonadIO m, FromJSON a) => Token -> String -> m a +jget :: (MonadIO m, FromJSON a) => Text -> String -> m a jget tok = jgetWith (authOpts tok) jgetWith :: (MonadIO m, FromJSON a) => Network.Wreq.Options -> String -> m a 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 @@ -37,28 +37,31 @@ FileInfo(..), fileStuff, filename, Error(..), error_reason, error_code, error_description, error_id, -- * Low-level Junk - putRawMedium + putMedium ) where import Control.Lens -import Control.Monad.IO.Class (MonadIO (..)) -import Data.Aeson (FromJSON (..), Options (..), - ToJSON (..), Value (..), - defaultOptions, fieldLabelModifier, - genericParseJSON, genericToEncoding, - genericToJSON, (.:)) -import Data.Aeson.Types (typeMismatch) -import qualified Data.ByteString.Lazy as BL -import qualified Data.Map.Strict as Map -import qualified Data.Text as T -import Data.Time.Clock (UTCTime) -import qualified Data.Vector as V -import Generics.Deriving.Base (Generic) -import Network.Wreq (asJSON, deleteWith, putWith, - responseBody) -import System.Random (getStdRandom, randomR) - +import Control.Monad.IO.Class (MonadIO (..)) +import Data.Aeson (FromJSON (..), Options (..), + ToJSON (..), Value (..), + defaultOptions, + fieldLabelModifier, + genericParseJSON, + genericToEncoding, genericToJSON, + (.:)) +import Data.Aeson.Types (typeMismatch) +import qualified Data.ByteString.Lazy as BL +import qualified Data.Map.Strict as Map +import qualified Data.Text as T +import Data.Time.Clock (UTCTime) +import qualified Data.Vector as V +import Generics.Deriving.Base (Generic) +import Network.Wreq (asJSON, deleteWith, responseBody) +import Network.Wreq.Types (Putable) +import System.Random (getStdRandom, randomR) +import GoPro.Plus.Auth +import GoPro.Plus.Internal.AuthHTTP import GoPro.Plus.Internal.HTTP data PageInfo = PageInfo { @@ -110,10 +113,10 @@ thumbnailURL n Medium{_medium_token} = "https://images-0" <> show n <> ".gopro.com/resize/450wwp/" <> _medium_token -- | Fetch thumbnail data for the given medium. -fetchThumbnail :: MonadIO m => Token -> Medium -> m BL.ByteString -fetchThumbnail tok m = do +fetchThumbnail :: (HasGoProAuth m, MonadIO m) => Medium -> m BL.ByteString +fetchThumbnail m = do n <- liftIO $ getStdRandom (randomR (1,4)) - proxy tok (thumbnailURL n m) + proxyAuth (thumbnailURL n m) data Listing = Listing { _media :: [Medium], @@ -131,23 +134,23 @@ parseJSON invalid = typeMismatch "Response" invalid -- | List a page worth of media. -list :: MonadIO m => Token -> Int -> Int -> m ([Medium], PageInfo) -list tok psize page = do - r <- jget tok ("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) +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) -- | List all media. -listAll :: MonadIO m => Token -> m [Medium] -listAll tok = listWhile tok (const True) +listAll :: (HasGoProAuth m, MonadIO m) => m [Medium] +listAll = listWhile (const True) -- | List all media while returned batches pass the given predicate. -listWhile :: MonadIO m => Token -> ([Medium] -> Bool) -> m [Medium] -listWhile tok f = do +listWhile :: (HasGoProAuth m, MonadIO m) => ([Medium] -> Bool) -> m [Medium] +listWhile f = do Map.elems <$> dig 0 mempty where dig n m = do - (ms, _) <- list tok 100 n + (ms, _) <- list 100 n let m' = Map.union m . Map.fromList . map (\md@Medium{..} -> (_medium_id, md)) $ ms if (not . null) ms && f ms then dig (n + 1) m' @@ -241,14 +244,14 @@ FileInfo fs <$> v .: "filename" parseJSON invalid = typeMismatch "Response" invalid -dlURL :: String -> String -dlURL k = "https://api.gopro.com/media/" <> k <> "/download" +dlURL :: MediumID -> String +dlURL k = "https://api.gopro.com/media/" <> T.unpack k <> "/download" -- | Get download descriptors for a given medium. The format is -- typically 'FileInfo', but it can be useful to map it into something -- else. -retrieve :: (FromJSON j, MonadIO m) => Token -> String -> m j -retrieve tok k = jget tok (dlURL k) +retrieve :: (HasGoProAuth m, FromJSON j, MonadIO m) => MediumID -> m j +retrieve k = jgetAuth (dlURL k) data Error = Error { _error_reason :: String, @@ -274,19 +277,23 @@ parseJSON invalid = typeMismatch "Response" invalid -- | Delete an item. -delete :: MonadIO m => Token -> String -> m [Error] -delete tok k = do +delete :: (HasGoProAuth m, MonadIO m) => MediumID -> m [Error] +delete k = do + tok <- _access_token <$> goproAuth let u = "https://api.gopro.com/media?ids=" <> k - Errors r <- view responseBody <$> liftIO (deleteWith (authOpts tok) u >>= asJSON) + Errors r <- view responseBody <$> liftIO (deleteWith (authOpts tok) (T.unpack u) >>= asJSON) pure r -mediumURL :: String -> String -mediumURL = ("https://api.gopro.com/media/" <>) +mediumURL :: MediumID -> String +mediumURL = ("https://api.gopro.com/media/" <>) . T.unpack -- | Get the current 'Medium' record for the given Medium ID. -medium :: (FromJSON j, MonadIO m) => Token -> MediumID -> m j -medium tok = jget tok . mediumURL . T.unpack - -putRawMedium :: MonadIO m => Token -> String -> Value -> m Value -putRawMedium tok mid v = view responseBody <$> liftIO (putWith (authOpts tok) (mediumURL mid) v >>= asJSON) +medium :: (HasGoProAuth m, FromJSON j, MonadIO m) => MediumID -> m j +medium = jgetAuth . mediumURL +-- | Put a Medium. It's probably best to get a raw JSON Value and update it in place. +putMedium :: (HasGoProAuth m, MonadIO m, Putable a) => MediumID -> a -> m () +putMedium mid = fmap v . jputAuth (mediumURL mid) + where + v :: Value -> () + v = const () 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 @@ -22,7 +22,7 @@ createMedium, createSource, createDerivative, createUpload, completeUpload, uploadChunk, markAvailable, -- * Data Types - UID, UploadID, DerivativeID, + UploadID, DerivativeID, UploadPart(..), uploadLength, uploadPart, uploadURL, Upload(..), uploadID, uploadParts, -- * Uploader monad. @@ -32,36 +32,39 @@ listUploading ) where -import Control.Applicative (liftA3) +import Control.Applicative (liftA3) import Control.Lens -import Control.Monad (void, when) -import Control.Monad.Catch (MonadMask (..)) -import Control.Monad.Fail (MonadFail (..)) -import Control.Monad.IO.Class (MonadIO (..)) -import Control.Monad.State (StateT (..), evalStateT, get, gets, - lift, modify) -import Control.Retry (RetryStatus (..), exponentialBackoff, - limitRetries, recoverAll) -import qualified Data.Aeson as J +import Control.Monad (void, when) +import Control.Monad.Catch (MonadMask (..)) +import Control.Monad.Fail (MonadFail (..)) +import Control.Monad.IO.Class (MonadIO (..)) +import Control.Monad.State (StateT (..), evalStateT, get, + gets, lift, modify) +import Control.Retry (RetryStatus (..), + exponentialBackoff, limitRetries, + recoverAll) +import qualified Data.Aeson as J import Data.Aeson.Lens -import qualified Data.ByteString.Lazy as BL -import Data.Char (toUpper) -import Data.Maybe (fromJust) -import qualified Data.Text as T -import Data.Time.Clock.POSIX (getCurrentTime) -import qualified Data.Vector as V -import Network.Wreq (Options, header, params, putWith) -import Prelude hiding (fail) -import System.FilePath.Posix (takeExtension, takeFileName) -import System.IO (IOMode (..), SeekMode (..), hSeek, - withFile) -import System.Posix.Files (fileSize, getFileStatus) -import UnliftIO (MonadUnliftIO (..)) +import qualified Data.ByteString.Lazy as BL +import Data.Char (toUpper) +import Data.Maybe (fromJust) +import qualified Data.Text as T +import Data.Time.Clock.POSIX (getCurrentTime) +import qualified Data.Vector as V +import Network.Wreq (Options, header, params, putWith) +import Prelude hiding (fail) +import System.FilePath.Posix (takeExtension, takeFileName) +import System.IO (IOMode (..), SeekMode (..), + hSeek, withFile) +import System.Posix.Files (fileSize, getFileStatus) +import UnliftIO (MonadUnliftIO (..)) +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, list, + putMedium) -type UID = String type UploadID = T.Text type DerivativeID = T.Text @@ -75,9 +78,10 @@ get >>= \st -> StateT $ \_ -> withRunInIO $ \run -> (,st) <$> inner (run . flip evalStateT st) +instance HasGoProAuth m => HasGoProAuth (Uploader m) where + goproAuth = lift goproAuth + data Env m = Env { - token :: Token, - userID :: UID, fileList :: [FilePath], mediumType :: T.Text, extension :: T.Text, @@ -87,24 +91,23 @@ } -- | List all media in uploading state. -listUploading :: MonadIO m => Token -> m [Medium] -listUploading tok = do - filter (\Medium{..} -> _medium_ready_to_view == "uploading") . fst <$> list tok 30 1 +listUploading :: (HasGoProAuth m, MonadIO m) => m [Medium] +listUploading = do + filter (\Medium{..} -> _medium_ready_to_view == "uploading") . fst <$> list 30 1 -- | Run an Uploader monad to create a single medium and upload the content for it. -runUpload :: (MonadFail m, MonadIO m) - => Token -- ^ GoPro Plus authentication token. - -> UID -- ^ GoPro Plus user ID. - -> [FilePath] -- ^ The list of files to include in the medium. +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 token userID fileList a = resumeUpload token userID fileList "" a +runUpload fileList a = resumeUpload fileList "" a -- | Run an Uploader monad for which we already know the MediumID -- (i.e., we're resuming an upload we previously began). -resumeUpload :: (MonadFail m, MonadIO m) => Token -> UID -> [FilePath] -> MediumID -> Uploader m a -> m a -resumeUpload _ _ [] _ _ = fail "empty file list" -resumeUpload token userID fileList@(fp:_) mediumID a = evalStateT a Env{..} +resumeUpload :: (HasGoProAuth m, MonadFail m, MonadIO m) => [FilePath] -> MediumID -> Uploader m a -> m a +resumeUpload [] _ _ = fail "empty file list" +resumeUpload fileList@(fp:_) mediumID a = + goproAuth >>= \AuthInfo{..} -> evalStateT a Env{..} where extension = T.pack . fmap toUpper . drop 1 . takeExtension $ filename filename = takeFileName fp @@ -123,37 +126,42 @@ setLogAction :: (Monad m, MonadMask m) => (String -> m ()) -> Uploader m () setLogAction t = modify (\m -> m{logAction=t}) -jpostVal :: MonadIO m => Options -> String -> J.Value -> m J.Value +jpostVal :: (HasGoProAuth m, MonadIO m) => Options -> String -> J.Value -> m J.Value jpostVal opts u v = liftIO $ jpostWith opts u v +jpostAuthVal :: (HasGoProAuth m, MonadIO m) => String -> J.Value -> m J.Value +jpostAuthVal = jpostAuth + -- | Create a new medium (e.g., video, photo, etc...) and return its ID. -createMedium :: MonadIO m => Uploader m MediumID +createMedium :: (HasGoProAuth m, MonadIO m) => Uploader m MediumID createMedium = do Env{..} <- get + 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 "on_public_profile" ?~ J.Bool False & at "content_title" ?~ J.String (T.pack filename) & at "content_source" ?~ J.String "web_media_library" - & at "access_token" ?~ J.String (T.pack token) - & at "gopro_user_id" ?~ J.String (T.pack userID)) - m <- fromJust . preview (key "id" . _String) <$> jpostVal (authOpts token) "https://api.gopro.com/media" m1 + & at "access_token" ?~ J.String _access_token + & at "gopro_user_id" ?~ J.String _resource_owner_id) + m <- fromJust . preview (key "id" . _String) <$> jpostAuthVal "https://api.gopro.com/media" m1 modify (\s -> s{mediumID=m}) pure m -- | Convenient action for creating a Source derivative. -createSource :: MonadIO m => Int -> Uploader m DerivativeID +createSource :: (HasGoProAuth m, MonadIO m) => Int -> Uploader m DerivativeID createSource nparts = createDerivative nparts "Source" "Source" -- | Create a new derivative of the current medium containing the given number of parts. -createDerivative :: MonadIO m +createDerivative :: (HasGoProAuth m, MonadIO m) => Int -- ^ The number of parts this derivative contains. -> T.Text -- ^ The "type" of this derivative. -> T.Text -- ^ The label of this derivative. -> Uploader m DerivativeID createDerivative nparts typ lbl = do Env{..} <- get + AuthInfo{..} <- goproAuth let d1 = J.Object (mempty & at "medium_id" ?~ J.String mediumID & at "file_extension" ?~ J.String extension & at "type" ?~ J.String typ @@ -162,9 +170,9 @@ & at "item_count" ?~ J.Number (fromIntegral nparts) & at "camera_positions" ?~ J.String "default" & at "on_public_profile" ?~ J.Bool False - & at "access_token" ?~ J.String (T.pack token) - & at "gopro_user_id" ?~ J.String (T.pack userID)) - fromJust . preview (key "id" . _String) <$> jpostVal (authOpts token) "https://api.gopro.com/derivatives" d1 + & at "access_token" ?~ J.String _access_token + & at "gopro_user_id" ?~ J.String _resource_owner_id) + fromJust . preview (key "id" . _String) <$> jpostAuthVal "https://api.gopro.com/derivatives" d1 data UploadPart = UploadPart { _uploadLength :: Integer, @@ -185,37 +193,38 @@ chunkSize = 6291456 -- | Create a new upload for a derivative. -createUpload :: MonadIO m +createUpload :: (HasGoProAuth m, MonadIO m) => DerivativeID -- ^ The derivative into which we're uploading. -> Int -- ^ The part number (1-based) being uploaded. -> Int -- ^ The size of the file being uploaded in this part. -> Uploader m Upload createUpload did part fsize = do Env{..} <- get + AuthInfo{..} <- goproAuth let u1 = J.Object (mempty & at "derivative_id" ?~ J.String did & at "camera_position" ?~ J.String "default" & at "item_number" ?~ J.Number (fromIntegral part) - & at "access_token" ?~ J.String (T.pack token) - & at "gopro_user_id" ?~ J.String (T.pack userID)) - ur <- jpost token "https://api.gopro.com/user-uploads" u1 + & 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 - upopts = authOpts token & params .~ [("id", upid), - ("page", "1"), - ("per_page", "100"), - ("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"] + upopts = authOpts _access_token & params .~ [("id", upid), + ("page", "1"), + ("per_page", "100"), + ("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))) 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 :: MonadIO m => String -> String -> J.Value -> m J.Value - jpost tok = jpostVal (popts tok) + 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 @@ -240,7 +249,7 @@ " part ", show _uploadPart, " attempt ", show a] -- | Mark the given upload for the given derivative as complete. -completeUpload :: MonadIO m +completeUpload :: (HasGoProAuth m, MonadIO m) => UploadID -- ^ The upload ID. -> DerivativeID -- ^ The derivative ID. -> Int -- ^ The part number within the derivative. @@ -248,6 +257,7 @@ -> Uploader m () completeUpload upid did part fsize = do Env{..} <- get + AuthInfo{..} <- goproAuth let u2 = J.Object (mempty & at "id" ?~ J.String upid & at "item_number" ?~ J.Number (fromIntegral part) & at "camera_position" ?~ J.String "default" @@ -255,42 +265,41 @@ & at "derivative_id" ?~ J.String did & at "file_size" ?~ J.String ((T.pack . show) fsize) & at "part_size" ?~ J.String ((T.pack . show) chunkSize)) - void . liftIO $ putWith (popts token) (T.unpack ("https://api.gopro.com/user-uploads/" <> did)) u2 + void . liftIO $ putWith (popts _access_token) (T.unpack ("https://api.gopro.com/user-uploads/" <> did)) u2 where popts tok = authOpts tok & header "Accept" .~ ["application/vnd.gopro.jk.user-uploads+json; version=2.0.0"] -- | Mark the given derivative as availble to use. This also updates -- the medium record marking it as having completed its upload. -markAvailable :: MonadIO m => DerivativeID -> Uploader m () +markAvailable :: (HasGoProAuth m, MonadIO m) => DerivativeID -> Uploader m () markAvailable did = do Env{..} <- get + AuthInfo{..} <- goproAuth let d2 = J.Object (mempty & at "available" ?~ J.Bool True - & at "access_token" ?~ J.String (T.pack token) - & at "gopro_user_id" ?~ J.String (T.pack userID)) + & at "access_token" ?~ J.String _access_token + & at "gopro_user_id" ?~ J.String _resource_owner_id) - _ <- liftIO $ putWith (popts token) (T.unpack ("https://api.gopro.com/derivatives/" <> did)) d2 + _ <- liftIO $ putWith (popts _access_token) (T.unpack ("https://api.gopro.com/derivatives/" <> did)) d2 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 - & at "access_token" ?~ J.String (T.pack token) - & at "gopro_user_id" ?~ J.String (T.pack userID)) + & at "access_token" ?~ J.String _access_token + & at "gopro_user_id" ?~ J.String _resource_owner_id) - void . liftIO $ putWith (popts token) (T.unpack ("https://api.gopro.com/media/" <> mediumID)) done + putMedium mediumID done where popts tok = authOpts tok & header "Accept" .~ ["application/vnd.gopro.jk.user-uploads+json; version=2.0.0"] -- | Convenience action to upload a single medium. -uploadMedium :: (MonadMask m, MonadFail m, MonadIO m) - => Token -- ^ Bearer token. - -> UID -- ^ User ID. - -> [FilePath] -- ^ Parts of a single medium to upload (e.g., a video file). +uploadMedium :: (HasGoProAuth m, MonadMask m, MonadFail m, MonadIO m) + => [FilePath] -- ^ Parts of a single medium to upload (e.g., a video file). -> m MediumID -uploadMedium _ _ [] = fail "no files provided" -uploadMedium tok uid fps = runUpload tok uid fps $ do +uploadMedium [] = fail "no files provided" +uploadMedium fps = runUpload fps $ do mid <- createMedium did <- createSource (length fps) mapM_ (\(fp,n) -> do