gopro-plus 0.1.0.0 → 0.2.0.0
raw patch · 6 files changed
+214/−143 lines, 6 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
- GoPro.Plus.Auth: AuthResponse :: String -> Int -> String -> String -> AuthResponse
- GoPro.Plus.Auth: data AuthResponse
- GoPro.Plus.Auth: instance Data.Aeson.Types.FromJSON.FromJSON GoPro.Plus.Auth.AuthResponse
- GoPro.Plus.Auth: instance GHC.Generics.Generic GoPro.Plus.Auth.AuthResponse
- GoPro.Plus.Auth: instance GHC.Show.Show GoPro.Plus.Auth.AuthResponse
- GoPro.Plus.Internal.HTTP: type Token = String
- GoPro.Plus.Media: putRawMedium :: MonadIO m => Token -> String -> Value -> m Value
- GoPro.Plus.Upload: type UID = String
+ GoPro.Plus.Auth: AuthInfo :: Token -> Int -> Text -> Text -> AuthInfo
+ GoPro.Plus.Auth: class Monad m => HasGoProAuth m
+ GoPro.Plus.Auth: data AuthInfo
+ GoPro.Plus.Auth: goproAuth :: HasGoProAuth m => m AuthInfo
+ GoPro.Plus.Auth: instance Data.Aeson.Types.FromJSON.FromJSON GoPro.Plus.Auth.AuthInfo
+ GoPro.Plus.Auth: instance GHC.Base.Monad m => GoPro.Plus.Auth.HasGoProAuth (GoPro.Plus.Auth.AuthReader m)
+ GoPro.Plus.Auth: instance GHC.Generics.Generic GoPro.Plus.Auth.AuthInfo
+ GoPro.Plus.Auth: instance GHC.Show.Show GoPro.Plus.Auth.AuthInfo
+ GoPro.Plus.Auth: type AuthReader = ReaderT AuthInfo
+ GoPro.Plus.Auth: type Token = Text
+ GoPro.Plus.Auth: withAuth :: (Monad m, HasGoProAuth m) => AuthInfo -> AuthReader m a -> m a
+ GoPro.Plus.Internal.AuthHTTP: authOptsM :: HasGoProAuth m => m Options
+ GoPro.Plus.Internal.AuthHTTP: jgetAuth :: (HasGoProAuth m, MonadIO m, FromJSON a) => String -> m a
+ GoPro.Plus.Internal.AuthHTTP: jgetWithAuth :: (HasGoProAuth m, MonadIO m, FromJSON a) => Options -> String -> m a
+ GoPro.Plus.Internal.AuthHTTP: jpostAuth :: (HasGoProAuth m, MonadIO m, Postable a, FromJSON r) => String -> a -> m r
+ GoPro.Plus.Internal.AuthHTTP: jputAuth :: (HasGoProAuth m, MonadIO m, FromJSON j, Putable a) => String -> a -> m j
+ GoPro.Plus.Internal.AuthHTTP: proxyAuth :: (HasGoProAuth m, MonadIO m) => String -> m ByteString
+ GoPro.Plus.Media: putMedium :: (HasGoProAuth m, MonadIO m, Putable a) => MediumID -> a -> m ()
+ GoPro.Plus.Upload: instance GoPro.Plus.Auth.HasGoProAuth m => GoPro.Plus.Auth.HasGoProAuth (GoPro.Plus.Upload.Uploader m)
- GoPro.Plus.Auth: [_access_token] :: AuthResponse -> String
+ GoPro.Plus.Auth: [_access_token] :: AuthInfo -> Token
- GoPro.Plus.Auth: [_expires_in] :: AuthResponse -> Int
+ GoPro.Plus.Auth: [_expires_in] :: AuthInfo -> Int
- GoPro.Plus.Auth: [_refresh_token] :: AuthResponse -> String
+ GoPro.Plus.Auth: [_refresh_token] :: AuthInfo -> Text
- GoPro.Plus.Auth: [_resource_owner_id] :: AuthResponse -> String
+ GoPro.Plus.Auth: [_resource_owner_id] :: AuthInfo -> Text
- GoPro.Plus.Auth: access_token :: Lens' AuthResponse String
+ GoPro.Plus.Auth: access_token :: Lens' AuthInfo Token
- GoPro.Plus.Auth: authenticate :: MonadIO m => String -> String -> m AuthResponse
+ GoPro.Plus.Auth: authenticate :: MonadIO m => String -> String -> m AuthInfo
- GoPro.Plus.Auth: expires_in :: Lens' AuthResponse Int
+ GoPro.Plus.Auth: expires_in :: Lens' AuthInfo Int
- GoPro.Plus.Auth: refreshAuth :: MonadIO m => AuthResponse -> m AuthResponse
+ GoPro.Plus.Auth: refreshAuth :: MonadIO m => AuthInfo -> m AuthInfo
- GoPro.Plus.Auth: refresh_token :: Lens' AuthResponse String
+ GoPro.Plus.Auth: refresh_token :: Lens' AuthInfo Text
- GoPro.Plus.Auth: resource_owner_id :: Lens' AuthResponse String
+ GoPro.Plus.Auth: resource_owner_id :: Lens' AuthInfo Text
- GoPro.Plus.Internal.HTTP: authOpts :: String -> Options
+ GoPro.Plus.Internal.HTTP: authOpts :: Text -> Options
- GoPro.Plus.Internal.HTTP: jget :: (MonadIO m, FromJSON a) => Token -> String -> m a
+ GoPro.Plus.Internal.HTTP: jget :: (MonadIO m, FromJSON a) => Text -> String -> m a
- GoPro.Plus.Internal.HTTP: proxy :: MonadIO m => Token -> String -> m ByteString
+ GoPro.Plus.Internal.HTTP: proxy :: MonadIO m => Text -> String -> m ByteString
- GoPro.Plus.Media: delete :: MonadIO m => Token -> String -> m [Error]
+ GoPro.Plus.Media: delete :: (HasGoProAuth m, MonadIO m) => MediumID -> m [Error]
- GoPro.Plus.Media: fetchThumbnail :: MonadIO m => Token -> Medium -> m ByteString
+ GoPro.Plus.Media: fetchThumbnail :: (HasGoProAuth m, MonadIO m) => Medium -> m ByteString
- GoPro.Plus.Media: list :: MonadIO m => Token -> Int -> Int -> m ([Medium], PageInfo)
+ GoPro.Plus.Media: list :: (HasGoProAuth m, MonadIO m) => Int -> Int -> m ([Medium], PageInfo)
- GoPro.Plus.Media: listAll :: MonadIO m => Token -> m [Medium]
+ GoPro.Plus.Media: listAll :: (HasGoProAuth m, MonadIO m) => m [Medium]
- GoPro.Plus.Media: listWhile :: MonadIO m => Token -> ([Medium] -> Bool) -> m [Medium]
+ GoPro.Plus.Media: listWhile :: (HasGoProAuth m, MonadIO m) => ([Medium] -> Bool) -> m [Medium]
- GoPro.Plus.Media: medium :: (FromJSON j, MonadIO m) => Token -> MediumID -> m j
+ GoPro.Plus.Media: medium :: (HasGoProAuth m, FromJSON j, MonadIO m) => MediumID -> m j
- GoPro.Plus.Media: retrieve :: (FromJSON j, MonadIO m) => Token -> String -> m j
+ GoPro.Plus.Media: retrieve :: (HasGoProAuth m, FromJSON j, MonadIO m) => MediumID -> m j
- GoPro.Plus.Upload: completeUpload :: MonadIO m => UploadID -> DerivativeID -> Int -> Integer -> Uploader m ()
+ GoPro.Plus.Upload: completeUpload :: (HasGoProAuth m, MonadIO m) => UploadID -> DerivativeID -> Int -> Integer -> Uploader m ()
- GoPro.Plus.Upload: createDerivative :: MonadIO m => Int -> Text -> Text -> Uploader m DerivativeID
+ GoPro.Plus.Upload: createDerivative :: (HasGoProAuth m, MonadIO m) => Int -> Text -> Text -> Uploader m DerivativeID
- GoPro.Plus.Upload: createMedium :: MonadIO m => Uploader m MediumID
+ GoPro.Plus.Upload: createMedium :: (HasGoProAuth m, MonadIO m) => Uploader m MediumID
- GoPro.Plus.Upload: createSource :: MonadIO m => Int -> Uploader m DerivativeID
+ GoPro.Plus.Upload: createSource :: (HasGoProAuth m, MonadIO m) => Int -> Uploader m DerivativeID
- GoPro.Plus.Upload: createUpload :: MonadIO m => DerivativeID -> Int -> Int -> Uploader m Upload
+ GoPro.Plus.Upload: createUpload :: (HasGoProAuth m, MonadIO m) => DerivativeID -> Int -> Int -> Uploader m Upload
- GoPro.Plus.Upload: listUploading :: MonadIO m => Token -> m [Medium]
+ GoPro.Plus.Upload: listUploading :: (HasGoProAuth m, MonadIO m) => m [Medium]
- GoPro.Plus.Upload: markAvailable :: MonadIO m => DerivativeID -> Uploader m ()
+ GoPro.Plus.Upload: markAvailable :: (HasGoProAuth m, MonadIO m) => DerivativeID -> Uploader m ()
- GoPro.Plus.Upload: resumeUpload :: (MonadFail m, MonadIO m) => Token -> UID -> [FilePath] -> MediumID -> Uploader m a -> m a
+ GoPro.Plus.Upload: resumeUpload :: (HasGoProAuth m, MonadFail m, MonadIO m) => [FilePath] -> MediumID -> Uploader m a -> m a
- GoPro.Plus.Upload: runUpload :: (MonadFail m, MonadIO m) => Token -> UID -> [FilePath] -> Uploader m a -> m a
+ GoPro.Plus.Upload: runUpload :: (HasGoProAuth m, MonadFail m, MonadIO m) => [FilePath] -> Uploader m a -> m a
- GoPro.Plus.Upload: uploadMedium :: (MonadMask m, MonadFail m, MonadIO m) => Token -> UID -> [FilePath] -> m MediumID
+ GoPro.Plus.Upload: uploadMedium :: (HasGoProAuth m, MonadMask m, MonadFail m, MonadIO m) => [FilePath] -> m MediumID
Files
- gopro-plus.cabal +3/−2
- src/GoPro/Plus/Auth.hs +34/−13
- src/GoPro/Plus/Internal/AuthHTTP.hs +34/−0
- src/GoPro/Plus/Internal/HTTP.hs +6/−7
- src/GoPro/Plus/Media.hs +50/−43
- src/GoPro/Plus/Upload.hs +87/−78
gopro-plus.cabal view
@@ -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 <https://github.com/dustin/gopro-plus#readme> 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
src/GoPro/Plus/Auth.hs view
@@ -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
+ src/GoPro/Plus/Internal/AuthHTTP.hs view
@@ -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)
src/GoPro/Plus/Internal/HTTP.hs view
@@ -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
src/GoPro/Plus/Media.hs view
@@ -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 ()
src/GoPro/Plus/Upload.hs view
@@ -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