gopro-plus 0.2.0.0 → 0.3.0.0

raw patch · 4 files changed

+72/−36 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• gopro-plus.cabal +2/−2
• src/GoPro/Plus/Auth.hs +6/−7
• src/GoPro/Plus/Media.hs +31/−7
• src/GoPro/Plus/Upload.hs +33/−20

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 5e05f8a01680acbd25e66b1641f2c5a02799d5bf8e23075385e768184d45927c+-- hash: 4bb7255d2a4a022d5784c1045d89a42542f454252c098c0e9cd6953c1255c7a7  name:           gopro-plus-version:        0.2.0.0+version:        0.3.0.0 synopsis:       GoPro Plus Client API. description:    Please see the README on GitHub at <https://github.com/dustin/gopro-plus#readme> category:       Web

@@ -9,11 +9,10 @@ GoPro Plus authentication. -} -{-# LANGUAGE DeriveGeneric        #-}-{-# LANGUAGE FlexibleInstances    #-}-{-# LANGUAGE RecordWildCards      #-}-{-# LANGUAGE TemplateHaskell      #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE DeriveGeneric     #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards   #-}+{-# LANGUAGE TemplateHaskell   #-}  module GoPro.Plus.Auth (   authenticate, refreshAuth,@@ -83,7 +82,7 @@   goproAuth = ask  -- | Convenient function for passing around auth info.  You probably--- don't want to use this, but it can be conven ient when+-- don't want to use this, but it can be convenient when -- experimenting.-withAuth :: (Monad m, HasGoProAuth m) => AuthInfo -> AuthReader m a -> m a+withAuth :: AuthInfo -> AuthReader m a -> m a withAuth = flip runReaderT

@@ -20,7 +20,7 @@   fetchThumbnail,   -- * Data Types   PageInfo(..), current_page, per_page, total_items, total_pages,-  MediumID,+  MediumID, MediumType(..), ReadyToViewType(..),   Medium(..), medium_id, medium_camera_model, medium_captured_at,   medium_created_at, medium_file_size, medium_moments_count,   medium_ready_to_view, medium_source_duration, medium_type,@@ -49,8 +49,10 @@                                                genericParseJSON,                                                genericToEncoding, genericToJSON,                                                (.:))+import qualified Data.Aeson                   as J import           Data.Aeson.Types             (typeMismatch) import qualified Data.ByteString.Lazy         as BL+import           Data.Char                    (toLower, toUpper) import qualified Data.Map.Strict              as Map import qualified Data.Text                    as T import           Data.Time.Clock              (UTCTime)@@ -78,6 +80,29 @@  type MediumID = T.Text +data MediumType = Photo | Video | TimeLapse | TimeLapseVideo | Burst+  deriving (Show, Read, Eq)++instance ToJSON MediumType where+  toJSON = J.String . T.pack . show++instance FromJSON MediumType where+  parseJSON (J.String x) = pure . read . T.unpack $ x+  parseJSON invalid      = typeMismatch "Response" invalid++data ReadyToViewType = ViewReady | ViewFailure | ViewLoading+                     | ViewRegistered | ViewTranscoding | ViewProcessing | ViewUploading+  deriving (Show, Read, Eq)++instance ToJSON ReadyToViewType where+  toJSON = J.String . T.pack . fmap toLower . drop 4 . show++instance FromJSON ReadyToViewType where+  parseJSON (J.String s) = pure . read . trans . T.unpack $ s+    where trans (x:xs) = "View" <> (toUpper x : xs)+          trans []     = error "empty ready to view type"+  parseJSON invalid      = typeMismatch "Response" invalid+ data Medium = Medium {   _medium_id              :: MediumID,   _medium_camera_model    :: Maybe String,@@ -85,9 +110,9 @@   _medium_created_at      :: UTCTime,   _medium_file_size       :: Maybe Int,   _medium_moments_count   :: Int,-  _medium_ready_to_view   :: String,+  _medium_ready_to_view   :: ReadyToViewType,   _medium_source_duration :: Maybe String,-  _medium_type            :: String,+  _medium_type            :: MediumType,   _medium_token           :: String,   _medium_width           :: Maybe Int,   _medium_height          :: Maybe Int@@ -137,8 +162,8 @@ list :: (HasGoProAuth m, MonadIO m) => Int -> Int -> m ([Medium], PageInfo) list psize page = do   r <- jgetAuth ("https://api.gopro.com/media/search?fields=captured_at,created_at,file_size,id,moments_count,ready_to_view,source_duration,type,token,width,height,camera_model&order_by=created_at&per_page=" <> show psize <> "&page=" <> show page)-  pure $ (r ^.. media . folded,-          r ^. pages)+  pure (r ^.. media . folded,+        r ^. pages)  -- | List all media. listAll :: (HasGoProAuth m, MonadIO m) => m [Medium]@@ -146,8 +171,7 @@  -- | List all media while returned batches pass the given predicate. listWhile :: (HasGoProAuth m, MonadIO m) => ([Medium] -> Bool) -> m [Medium]-listWhile f = do-  Map.elems <$> dig 0 mempty+listWhile f = Map.elems <$> dig 0 mempty     where       dig n m = do         (ms, _) <- list 100 n

@@ -20,7 +20,7 @@   -- * Low-level upload parts.   runUpload, resumeUpload,   createMedium, createSource, createDerivative, createUpload,-  completeUpload, uploadChunk, markAvailable,+  completeUpload, getUpload, uploadChunk, markAvailable,   -- * Data Types   UploadID, DerivativeID,   UploadPart(..), uploadLength, uploadPart, uploadURL,@@ -62,7 +62,9 @@ import           GoPro.Plus.Auth              (AuthInfo (..), HasGoProAuth (..)) import           GoPro.Plus.Internal.AuthHTTP import           GoPro.Plus.Internal.HTTP-import           GoPro.Plus.Media             (Medium (..), MediumID, list,+import           GoPro.Plus.Media             (Medium (..), MediumID,+                                               MediumType (..),+                                               ReadyToViewType (..), list,                                                putMedium)  type UploadID = T.Text@@ -83,7 +85,7 @@  data Env m = Env {   fileList   :: [FilePath],-  mediumType :: T.Text,+  mediumType :: MediumType,   extension  :: T.Text,   filename   :: String,   mediumID   :: MediumID,@@ -92,15 +94,14 @@  -- | List all media in uploading state. listUploading :: (HasGoProAuth m, MonadIO m) => m [Medium]-listUploading = do-  filter (\Medium{..} -> _medium_ready_to_view == "uploading") . fst <$> list 30 1+listUploading = filter (\Medium{..} -> _medium_ready_to_view == ViewUploading) . fst <$> list 30 1  -- | Run an Uploader monad to create a single medium and upload the content for it. runUpload :: (HasGoProAuth m, MonadFail m, MonadIO m)           => [FilePath]   -- ^ The list of files to include in the medium.           -> Uploader m a -- ^ The action to perform.           -> m a          -- ^ The result of the inner action.-runUpload fileList a = resumeUpload fileList "" a+runUpload fileList = resumeUpload fileList ""  -- | Run an Uploader monad for which we already know the MediumID -- (i.e., we're resuming an upload we previously began).@@ -114,11 +115,11 @@     mediumType = fileType extension     logAction _ = pure () -    fileType "JPG" = "Photo"-    fileType _     = "Video"+    fileType "JPG" = Photo+    fileType _     = Video  -- | Override the detected medium type.-setMediumType :: Monad m => T.Text -> Uploader m ()+setMediumType :: Monad m => MediumType -> Uploader m () setMediumType t = modify (\m -> m{mediumType=t})  -- | Set the logging action to report retries (or whatever other@@ -139,7 +140,7 @@   AuthInfo{..} <- goproAuth   let m1 = J.Object (mempty & at "file_extension" ?~ J.String extension                      & at "filename" ?~ J.String (T.pack filename)-                     & at "type" ?~ J.String mediumType+                     & at "type" ?~ J.toJSON mediumType                      & at "on_public_profile" ?~ J.Bool False                      & at "content_title" ?~ J.String (T.pack filename)                      & at "content_source" ?~ J.String "web_media_library"@@ -207,28 +208,40 @@                      & at "access_token" ?~ J.String _access_token                      & at "gopro_user_id" ?~ J.String _resource_owner_id)   ur <- jpost "https://api.gopro.com/user-uploads" u1-   let Just upid = ur ^? key "id" . _String+  getUpload upid did part fsize++  where+    popts tok = authOpts tok & header "Accept" .~  ["application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]+    jpost :: (HasGoProAuth m, MonadIO m) => String -> J.Value -> m J.Value+    jpost u p = (_access_token <$> goproAuth) >>= \tok -> jpostVal (popts tok) u p++getUpload :: (HasGoProAuth m, MonadIO m)+          => UploadID+          -> DerivativeID+          -> Int+          -> Int+          -> Uploader m Upload+getUpload upid did part fsize = do+  Env{..} <- get+  AuthInfo{..} <- goproAuth++  let pages = (ceiling ((fromIntegral fsize :: Double) / fromIntegral chunkSize)) :: Int       upopts = authOpts _access_token & params .~ [("id", upid),                                                    ("page", "1"),-                                                   ("per_page", "100"),+                                                   ("per_page", (T.pack . show) pages),                                                    ("item_number", (T.pack . show) part),                                                    ("camera_position", "default"),                                                    ("file_size", (T.pack . show) fsize),                                                    ("part_size", (T.pack . show) chunkSize)]                & header "Accept" .~  ["application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]-  upaths <- (jgetWith upopts (T.unpack ("https://api.gopro.com/user-uploads/" <> did)))+  upaths <- jgetWith upopts (T.unpack ("https://api.gopro.com/user-uploads/" <> did))   let Just ups = (upaths :: J.Value) ^? key "_embedded" . key "authorizations" . _Array . to V.toList   pure $ Upload upid (fromJust $ traverse aChunk ups)    where-    popts tok = authOpts tok & header "Accept" .~  ["application/vnd.gopro.jk.user-uploads+json; version=2.0.0"]-    jpost :: (HasGoProAuth m, MonadIO m) => String -> J.Value -> m J.Value-    jpost u p = (_access_token <$> goproAuth) >>= \tok -> jpostVal (popts tok) u p-     tInt :: T.Text -> Integer     tInt = read . T.unpack-     aChunk v = liftA3 UploadPart (v ^? key "Content-Length" . _String . to tInt)                                  (v ^? key "part" . _Integer . to toInteger)                                  (v ^? key "url" . _String . to T.unpack)@@ -244,7 +257,7 @@     hSeek fh AbsoluteSeek ((_uploadPart - 1) * chunkSize)     void $ putWith defOpts _uploadURL =<< BL.hGet fh (fromIntegral _uploadLength) -    where policy = exponentialBackoff 2000000 <> limitRetries 5+    where policy = exponentialBackoff 2000000 <> limitRetries 9           retryMsg a = mconcat ["Retrying upload of ", show fp,                                 " part ", show _uploadPart, " attempt ", show a] @@ -282,7 +295,7 @@    _ <- liftIO $ putWith (popts _access_token) (T.unpack ("https://api.gopro.com/derivatives/" <> did)) d2 -  now <- liftIO $ getCurrentTime+  now <- liftIO getCurrentTime   let done = J.Object (mempty & at "upload_completed_at" ?~ J.toJSON now                        & at "client_updated_at" ?~ J.toJSON now                        & at "revision_number" ?~ J.Number 0