packages feed

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 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