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: 28577c1446cea69369980bb3681d24a71ca38ae9c295c29333f0e6671cff1972 +-- hash: e57dbf9536773374bac2998b86c4f2901d748a645a488573462dfd7125d964c9 name: gopro-plus -version: 0.4.1.2 +version: 0.4.1.3 synopsis: GoPro Plus Client API. description: Please see the README on GitHub at category: Web @@ -87,6 +87,7 @@ , lens , lens-aeson , mtl + , quickcheck-instances , random , raw-strings-qq , retry 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 @@ -65,6 +65,7 @@ import GoPro.Plus.Internal.AuthHTTP import GoPro.Plus.Internal.HTTP +-- | Pagination info returned from lists. data PageInfo = PageInfo { _current_page :: Int , _per_page :: Int @@ -75,17 +76,26 @@ makeLenses ''PageInfo +dropPrefix :: String -> (String -> String) +dropPrefix s = drop (length s) + instance FromJSON PageInfo where parseJSON = genericParseJSON jsonOpts +instance ToJSON PageInfo where + toEncoding = genericToEncoding jsonOpts{ fieldLabelModifier = dropPrefix "_" } + toJSON = genericToJSON jsonOpts{ fieldLabelModifier = dropPrefix "_" } + +-- | GoPro-assigned identifier for an uploaded item. type MediumID = T.Text -data MediumType = Photo - | Video - | TimeLapse - | TimeLapseVideo - | Burst - deriving (Show, Read, Eq) +-- | Type of Media for a given item. +data MediumType = Photo -- ^ a still photo + | Video -- ^ normal video + | TimeLapse -- ^ a timelapse series of photos + | TimeLapseVideo -- ^ a timelapse video + | Burst -- ^ a set of photos taken in a burst + deriving (Bounded, Enum, Show, Read, Eq) instance ToJSON MediumType where toJSON = J.String . T.pack . show @@ -101,7 +111,7 @@ | ViewTranscoding | ViewProcessing | ViewUploading - deriving (Show, Read, Eq) + deriving (Bounded, Enum, Show, Read, Eq) instance ToJSON ReadyToViewType where toJSON = J.String . T.pack . fmap toLower . drop 4 . show @@ -126,13 +136,10 @@ , _medium_width :: Maybe Int , _medium_height :: Maybe Int } - deriving (Generic, Show) + deriving (Generic, Eq, Show) makeLenses ''Medium -dropPrefix :: String -> (String -> String) -dropPrefix s = drop (length s) - mediumMod :: String -> String mediumMod = dropPrefix "_medium_" @@ -159,7 +166,7 @@ { _media :: [Medium] , _pages :: PageInfo } - deriving (Generic, Show) + deriving (Generic, Eq, Show) makeLenses ''Listing @@ -171,6 +178,9 @@ Listing ms <$> v .: "_pages" parseJSON invalid = typeMismatch "Response" invalid +instance ToJSON Listing where + toJSON Listing{..} = object ["_embedded" .= object [ "media" .= _media], "_pages" .= _pages] + -- | List a page worth of media. list :: (HasGoProAuth m, MonadIO m) => Int -- ^ Number of items per page. @@ -428,7 +438,7 @@ { _moment_id :: T.Text , _moment_time :: Maybe Int } - deriving (Show, Generic) + deriving (Show, Eq, Generic) makeLenses ''Moment 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 @@ -34,7 +34,7 @@ import Control.Applicative (liftA3) import Control.Lens -import Control.Monad (void, when) +import Control.Monad (void, when, zipWithM_) import Control.Monad.Catch (MonadMask (..)) import Control.Monad.Fail (MonadFail (..)) import Control.Monad.IO.Class (MonadIO (..)) @@ -310,12 +310,12 @@ uploadMedium fps = runUpload fps $ do mid <- createMedium did <- createSource (length fps) - mapM_ (\(fp,n) -> do + zipWithM_ (\fp n -> do fsize <- toInteger . fileSize <$> (liftIO . getFileStatus) fp Upload{..} <- createUpload did n (fromInteger fsize) mapM_ (uploadChunk fp) _uploadParts completeUpload _uploadID did n fsize - ) $ zip fps [1..] + ) fps [1..] markAvailable did pure mid diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -1,16 +1,19 @@ -{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TypeApplications #-} import Control.Lens -import qualified Data.Aeson as J -import qualified Data.ByteString.Lazy as BL -import Data.Maybe (fromJust) -import Text.RawString.QQ (r) +import qualified Data.Aeson as J +import qualified Data.ByteString.Lazy as BL +import Data.Maybe (fromJust) +import Text.RawString.QQ (r) -import Generic.Random (genericArbitrary, uniform) -import Test.QuickCheck ((===)) +import Generic.Random (genericArbitrary, uniform) +import Test.QuickCheck (arbitraryBoundedEnum, (===)) +import Test.QuickCheck.Instances.Text +import Test.QuickCheck.Instances.Time import Test.Tasty import Test.Tasty.HUnit -import Test.Tasty.QuickCheck as QC +import Test.Tasty.QuickCheck as QC import GoPro.Plus.Media @@ -55,7 +58,13 @@ instance Arbitrary FileInfo where arbitrary = genericArbitrary uniform -instance Arbitrary FileStuff where arbitrary = genericArbitrary uniform +instance Arbitrary FileStuff where + arbitrary = do + _files <- vector =<< choose (0,3) + _variations <- vector =<< choose (0,3) + _sprites <- vector =<< choose (0,3) + _sidecar_files <- vector =<< choose (0,3) + pure FileStuff{..} instance Arbitrary Variation where arbitrary = genericArbitrary uniform @@ -67,14 +76,39 @@ instance Arbitrary File where arbitrary = genericArbitrary uniform -propRoundtripFileInfo :: FileInfo -> Property -propRoundtripFileInfo = fromJust . J.decode . J.encode >>= (===) +instance Arbitrary Medium where arbitrary = genericArbitrary uniform +instance Arbitrary Moment where arbitrary = genericArbitrary uniform + +instance Arbitrary ReadyToViewType where arbitrary = arbitraryBoundedEnum + +instance Arbitrary MediumType where arbitrary = arbitraryBoundedEnum + +instance Arbitrary PageInfo where arbitrary = genericArbitrary uniform + +instance Arbitrary Listing where arbitrary = genericArbitrary uniform + +propRTJSON :: (J.FromJSON j, J.ToJSON j, Eq j, Show j) => j -> Property +propRTJSON = fromJust . J.decode . J.encode >>= (===) + tests :: [TestTree] tests = [ testCase "Parsing" testSearchParser, testCase "FileInfo" testFileInfo, - testProperty "FileInfo round tripping" propRoundtripFileInfo + testGroup "JSON round tripping" $ [ + testProperty "FileInfo" (propRTJSON @FileInfo), + testProperty "Variation" (propRTJSON @Variation), + testProperty "SpriteFrame" (propRTJSON @SpriteFrame), + testProperty "SidecarFile" (propRTJSON @SidecarFile), + testProperty "Sprite" (propRTJSON @Sprite), + testProperty "File" (propRTJSON @File), + testProperty "MediumType" (propRTJSON @MediumType), + testProperty "ReadyToViewType" (propRTJSON @ReadyToViewType), + testProperty "Medium" (propRTJSON @Medium), + testProperty "Moment" (propRTJSON @Moment), + testProperty "Listing" (propRTJSON @Listing), + testProperty "PageInfo" (propRTJSON @PageInfo) + ] ] main :: IO ()