diff --git a/gopro-plus.cabal b/gopro-plus.cabal --- a/gopro-plus.cabal +++ b/gopro-plus.cabal @@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.31.2. +-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack -- --- hash: aad6d39dfff268773a2546434545e5c4ef4a88e542724369091bd0a343e5f2e6 +-- hash: 127fa4201fe98756bd46ca02b48f05168aac1d43f403d89bac1e8c5997f147a5 name: gopro-plus -version: 0.3.0.1 +version: 0.3.1.0 synopsis: GoPro Plus Client API. description: Please see the README on GitHub at category: Web @@ -86,6 +86,7 @@ , lens-aeson , mtl , random + , raw-strings-qq , retry , tasty , tasty-hunit 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 @@ -36,6 +36,7 @@ FileStuff(..), files, variations, sprites, sidecar_files, FileInfo(..), fileStuff, filename, Error(..), error_reason, error_code, error_description, error_id, + Moment(..), moment_id, moment_time, moments, -- * Low-level Junk putMedium ) where @@ -66,12 +67,13 @@ import GoPro.Plus.Internal.AuthHTTP import GoPro.Plus.Internal.HTTP -data PageInfo = PageInfo { - _current_page :: Int, - _per_page :: Int, - _total_items :: Int, - _total_pages :: Int - } deriving (Generic, Show) +data PageInfo = PageInfo + { _current_page :: Int + , _per_page :: Int + , _total_items :: Int + , _total_pages :: Int + } + deriving (Generic, Show, Eq) makeLenses ''PageInfo @@ -80,8 +82,12 @@ type MediumID = T.Text -data MediumType = Photo | Video | TimeLapse | TimeLapseVideo | Burst - deriving (Show, Read, Eq) +data MediumType = Photo + | Video + | TimeLapse + | TimeLapseVideo + | Burst + deriving (Show, Read, Eq) instance ToJSON MediumType where toJSON = J.String . T.pack . show @@ -90,9 +96,14 @@ 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) +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 @@ -103,20 +114,21 @@ trans [] = error "empty ready to view type" parseJSON invalid = typeMismatch "Response" invalid -data Medium = Medium { - _medium_id :: MediumID, - _medium_camera_model :: Maybe String, - _medium_captured_at :: UTCTime, - _medium_created_at :: UTCTime, - _medium_file_size :: Maybe Int, - _medium_moments_count :: Int, - _medium_ready_to_view :: ReadyToViewType, - _medium_source_duration :: Maybe String, - _medium_type :: MediumType, - _medium_token :: String, - _medium_width :: Maybe Int, - _medium_height :: Maybe Int - } deriving (Generic, Show) +data Medium = Medium + { _medium_id :: MediumID + , _medium_camera_model :: Maybe String + , _medium_captured_at :: UTCTime + , _medium_created_at :: UTCTime + , _medium_file_size :: Maybe Int + , _medium_moments_count :: Int + , _medium_ready_to_view :: ReadyToViewType + , _medium_source_duration :: Maybe String + , _medium_type :: MediumType + , _medium_token :: String + , _medium_width :: Maybe Int + , _medium_height :: Maybe Int + } + deriving (Generic, Show) makeLenses ''Medium @@ -143,10 +155,11 @@ n <- liftIO $ getStdRandom (randomR (1,4)) proxyAuth (thumbnailURL n m) -data Listing = Listing { - _media :: [Medium], - _pages :: PageInfo - } deriving (Generic, Show) +data Listing = Listing + { _media :: [Medium] + , _pages :: PageInfo + } + deriving (Generic, Show) makeLenses ''Listing @@ -181,14 +194,15 @@ else pure m' -data File = File { - _file_camera_position :: String, - _file_height :: Int, - _file_width :: Int, - _file_item_number :: Int, - _file_orientation :: Int, - _file_url :: String - } deriving (Generic, Show) +data File = File + { _file_camera_position :: String + , _file_height :: Int + , _file_width :: Int + , _file_item_number :: Int + , _file_orientation :: Int + , _file_url :: String + } + deriving (Generic, Show) makeLenses ''File @@ -197,14 +211,15 @@ fieldLabelModifier = dropPrefix "_file_" } -data Variation = Variation { - _var_height :: Int, - _var_width :: Int, - _var_label :: String, - _var_quality :: String, - _var_type :: String, - _var_url :: String - } deriving(Generic, Show) +data Variation = Variation + { _var_height :: Int + , _var_width :: Int + , _var_label :: String + , _var_quality :: String + , _var_type :: String + , _var_url :: String + } + deriving (Generic, Show) makeLenses ''Variation @@ -213,11 +228,12 @@ fieldLabelModifier = dropPrefix "_var_" } -data SpriteFrame = SpriteFrame { - _frame_count :: Int, - _frame_height :: Int, - _frame_width :: Int - } deriving(Generic, Show) +data SpriteFrame = SpriteFrame + { _frame_count :: Int + , _frame_height :: Int + , _frame_width :: Int + } + deriving (Generic, Show) makeLenses ''SpriteFrame @@ -226,14 +242,15 @@ fieldLabelModifier = dropPrefix "_frame_" } -data Sprite = Sprite { - _sprite_fps :: Double, - _sprite_frame :: SpriteFrame, - _sprite_height :: Int, - _sprite_width :: Int, - _sprite_type :: String, - _sprite_urls :: [String] - } deriving (Generic, Show) +data Sprite = Sprite + { _sprite_fps :: Double + , _sprite_frame :: SpriteFrame + , _sprite_height :: Int + , _sprite_width :: Int + , _sprite_type :: String + , _sprite_urls :: [String] + } + deriving (Generic, Show) makeLenses ''Sprite @@ -242,22 +259,24 @@ fieldLabelModifier = dropPrefix "_sprite_" } -data FileStuff = FileStuff { - _files :: [File], - _variations :: [Variation], - _sprites :: [Sprite], - _sidecar_files :: [Value] - } deriving (Generic, Show) +data FileStuff = FileStuff + { _files :: [File] + , _variations :: [Variation] + , _sprites :: [Sprite] + , _sidecar_files :: [Value] + } + deriving (Generic, Show) makeLenses ''FileStuff instance FromJSON FileStuff where parseJSON = genericParseJSON jsonOpts -data FileInfo = FileInfo { - _fileStuff :: FileStuff, - _filename :: String - } deriving (Generic, Show) +data FileInfo = FileInfo + { _fileStuff :: FileStuff + , _filename :: String + } + deriving (Generic, Show) makeLenses ''FileInfo @@ -277,12 +296,13 @@ retrieve :: (HasGoProAuth m, FromJSON j, MonadIO m) => MediumID -> m j retrieve k = jgetAuth (dlURL k) -data Error = Error { - _error_reason :: String, - _error_code :: Int, - _error_description :: String, - _error_id :: String - } deriving (Generic, Show) +data Error = Error + { _error_reason :: String + , _error_code :: Int + , _error_description :: String + , _error_id :: String + } + deriving (Generic, Show) makeLenses ''Error @@ -321,3 +341,35 @@ where v :: Value -> () v = const () + +-- | A moment of interestingness in a Medium. +data Moment = Moment + { _moment_id :: T.Text + , _moment_time :: Maybe Int + } + deriving (Show, Generic) + +makeLenses ''Moment + +instance FromJSON Moment where + parseJSON = genericParseJSON defaultOptions { + fieldLabelModifier = dropPrefix "_moment_" + } + +instance ToJSON Moment where + toEncoding = genericToEncoding jsonOpts{ fieldLabelModifier = dropPrefix "_moment_" } + toJSON = genericToJSON jsonOpts{ fieldLabelModifier = dropPrefix "_moment_" } + +newtype Moments = Moments { unMoments :: [Moment] } + +instance FromJSON Moments where + parseJSON (Object v) = do + o <- v .: "_embedded" + m <- o .: "moments" + Moments <$> traverse parseJSON (V.toList m) + + parseJSON invalid = typeMismatch "Response" invalid + +-- | Get the moments for the given medium. +moments :: (HasGoProAuth m, MonadIO m) => MediumID -> m [Moment] +moments mid = unMoments <$> jgetAuth ("https://api.gopro.com/media/" <> T.unpack mid <> "/moments?fields=time") diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,10 +1,34 @@ +{-# LANGUAGE QuasiQuotes #-} + +import Control.Lens +import qualified Data.Aeson as J +import qualified Data.ByteString.Lazy as BL +import Text.RawString.QQ (r) + import Test.Tasty import Test.Tasty.HUnit import Test.Tasty.QuickCheck as QC +import GoPro.Plus.Media + +exampleMedia :: BL.ByteString +exampleMedia = [r| +{"_pages":{"current_page":1,"per_page":100,"total_items":2169,"total_pages":22}, +"_embedded":{"errors":[],"media":[ +{"captured_at":"2020-04-06T15:51:32Z","content_title":"GOPR1991.MP4","content_type":null,"created_at":"2020-04-07T03:35:27Z","gopro_user_id":"uid","file_size":412808724,"height":1080,"fov":null,"id":"62NzWRrpPXm7o","moments_count":0,"on_public_profile":false,"orientation":1,"play_as":"video","ready_to_edit":true,"ready_to_view":"ready","resolution":"1080p","source_duration":"109710","token":"token1","type":"Video","width":1920}, +{"captured_at":"2020-04-06T00:33:22Z","content_title":null,"content_type":null,"created_at":"2020-04-06T01:39:39Z","gopro_user_id":"uid","file_size":7930021,"height":3000,"fov":null,"id":"EDavpqr4GVe8O","moments_count":0,"on_public_profile":false,"orientation":1,"play_as":"photo","ready_to_edit":true,"ready_to_view":"ready","resolution":"12000000","source_duration":"0","token":"token2","type":"Photo","width":4000}]}} +|] + +testSearchParser :: Assertion +testSearchParser = do + let l = J.decode exampleMedia :: Maybe Listing + assertEqual (show l) (Just (PageInfo 1 100 2169 22)) (l ^? _Just . pages) + assertEqual (show l) [Video, Photo] (l ^.. _Just . media . folded . medium_type) + assertEqual (show l) ["62NzWRrpPXm7o", "EDavpqr4GVe8O"] (l ^.. _Just . media . folded . medium_id) + tests :: [TestTree] tests = [ - testProperty "a test property" (\x -> (x::Int) == id x) + testCase "Parsing" testSearchParser ] main :: IO ()